diff options
Diffstat (limited to 'lisp')
438 files changed, 14669 insertions, 9480 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0739e79cf7a..2cbbc7e00f1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,390 +1,2176 @@ -2009-09-27 Chong Yidong <cyd@stupidchicken.com> +2009-09-28 Eric Ludlam <zappo@gnu.org> - * cedet/ede/system.el (ede-upload-html-documentation) - (ede-upload-distribution, ede-edit-web-page) - (ede-web-browse-home): Autoload. + CEDET (development tools) package merged. - * cedet/ede/proj-elisp.el: Add autoload for - semantic-ede-proj-target-grammar. + * cedet/*.el: + * cedet/ede/*.el: + * cedet/semantic/*.el: + * cedet/srecode/*.el: New files. - * cedet/semantic.el (navigate-menu): Show menu items only if - semantic-mode is enabled. +2009-09-28 Michael Albinus <michael.albinus@gmx.de> - * cedet/ede.el: Remove comments. + * Makefile.in (ELCFILES): Add net/tramp-imap.elc. - * cedet/cedet.el (cedet-menu-map): Minor doc fix. + * net/tramp.el (top): Require tramp-imap. - * cedet/semantic/grammar.el: - * cedet/semantic/grammar-wy.el: - * cedet/semantic/ede-grammar.el: New files. + * net/tramp-smb.el (tramp-smb-handle-directory-files-and-attributes): + Use `tramp-compat-handle-file-attributes'. - * cedet/semantic/db-mode.el (global-semanticdb-minor-mode): Define - using define-minor-mode, so that the usual mode variable exists. +2009-09-28 Teodor Zlatanov <tzz@lifelogs.com> -2009-09-27 Chong Yidong <cyd@stupidchicken.com> + * net/tramp-imap.el: New package. + +2009-09-28 Eric Ludlam <zappo@gnu.org> + + * emacs-lisp/chart.el: + * emacs-lisp/eieio-base.el: + * emacs-lisp/eieio-comp.el: + * emacs-lisp/eieio-custom.el: + * emacs-lisp/eieio-datadebug.el: + * emacs-lisp/eieio-opt.el: + * emacs-lisp/eieio-speedbar.el: + * emacs-lisp/eieio.el: New files. - * cedet/ede.el (global-ede-mode-map): Move menu to - global-ede-mode-map. - (ede-minor-mode, global-ede-mode): Use define-minor-mode. + * cedet/cedet-cscope.el: + * cedet/cedet-files.el: + * cedet/cedet-global.el: + * cedet/cedet-idutils.el: + * cedet/data-debug.el: + * cedet/inversion.el: + * cedet/mode-local.el: + * cedet/pulse.el: New files. - * cedet/semantic.el (semantic-mode-map): Use cedet-menu-map. +2009-09-27 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * cedet/cedet.el (cedet-menu-map): New var. Don't require - Semantic etc. + * whitespace.el (whitespace-trailing-regexp) + (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp): + Fix doc string. 2009-09-27 Chong Yidong <cyd@stupidchicken.com> - * cedet/semantic/symref/list.el: Require semantic/complete. - (semantic-symref-symbol): Use - semantic-complete-read-tag-buffer-deep. + * menu-bar.el: Remove menu-bar-ediff-misc-menu from the Tools + menu. - * cedet/semantic/ia.el (semantic-ia-complete-symbol-menu): Remove. - (semantic-ia-complete-symbol): Use semantic-complete-symbol. + * ediff-hook.el: Move menu-bar-ediff-misc-menu into + menu-bar-ediff-menu. - * cedet/semantic/idle.el (semantic-idle-scheduler-work-timer): - Change timeout to 1. Doc fix. + * emacs-lisp/lisp-mode.el: Add doc-string-elt property to + define-overloadable-function. - * cedet/semantic/edit.el (semantic-change-hooks): Add - semantic-edits-change-function-handle-changes directly. + * progmodes/autoconf.el: Provide autoconf as well, so that this + file can be `require'd. - * cedet/semantic/util.el (semantic--completion-cache): Move to - semantic.el. - (semantic-symbol-start): Remove unneeded function. + * emacs-lisp/cl-macs.el (deftype): Add to cl-loaddefs. - * cedet/semantic.el (semantic--completion-cache): Move here from - semantic/util.el - (semantic-clear-toplevel-cache, semantic--set-buffer-cache) - (semantic-fetch-tags): Reset semantic--completion-cache. - (semantic-force-refresh): New function - (semantic-mode-map): New variable. + * emacs-lisp/autoload.el (generated-autoload-feature) + (generated-autoload-load-name): New vars. + (autoload-rubric, autoload-generate-file-autoloads): Use them. + (make-autoload): Recognize define-overloadable-function and + defclass forms (for EIEIO). - * cedet/semantic/senator.el: New file. + * Makefile.in (update-subdirs): Exclude cedet directory. - * cedet/ede.el: Fix autoload. - (ede-customize-forms-menu): Handle null projects. +2009-09-27 Adrian Robert <Adrian.B.Robert@gmail.com> -2009-09-26 Chong Yidong <cyd@stupidchicken.com> + * term/ns-win.el: Don't set the region face background. (Bug#4381) - * cedet/srecode/mode.el (srecode-menu-bar): Use - semantic-menu-item. + * faces.el: Default light-background background for region face to + ns_selection_color under NS. - * cedet/srecode/expandproto.el (senator-tag-ring): Declare - senator-tag-ring. +2009-09-27 Teodor Zlatanov <tzz@lifelogs.com> - * cedet/semantic/lex.el (semantic-lex-reset-hooks): Doc fix. + * net/imap-hash.el: New library, see NEWS. - * cedet/semantic/idle.el - (semantic-before-idle-scheduler-reparse-hook) - (semantic-after-idle-scheduler-reparse-hook): Rename from *-hooks. - Make old name an obsolete alias. + * Makefile.in (ELCFILES): Add imap-hash.el. - * cedet/semantic/edit.el (semantic-after-partial-cache-change-hook) - (semantic-change-hooks, semantic-edits-new-change-hooks) - (semantic-edits-delete-change-hooks) - (semantic-edits-move-change-hook) - (semantic-edits-reparse-change-hooks) - (semantic-edits-incremental-reparse-failed-hooks): Doc fixes. - (semantic-edits-incremental-reparse-failed-hook): Rename from - semantic-edits-incremental-reparse-failed-hooks. - (semantic-edits-incremental-fail): Use new var name. +2009-09-27 Stefan Monnier <monnier@iro.umontreal.ca> - * cedet/semantic/debug.el (semantic-debug-mode): Rename hook - symbols. + * help.el (help-for-help-internal): Don't purecopy the text (bug#4560). + * isearch.el (isearch-help-for-help-internal): Purecopy the second arg. + * help-macro.el (make-help-screen): Avoid using an ambiguous function + definition where the docstring could be taken for the return value. - * cedet/semantic/db-mode.el (semanticdb-mode-hook): Rename from - semanticdb-mode-hooks. - (global-semanticdb-minor-mode): Use the new name. - (semanticdb-hooks): Use semantic-init-db-hook instead of obsolete - alias semantic-init-db-hooks. +2009-09-26 Glenn Morris <rgm@gnu.org> - * cedet/semantic/db-global.el (semanticdb-enable-gnu-global-databases): - Use semantic-init-hook instead of obsolete alias - semantic-init-hooks. + * mail/rmailmm.el (rmail-mime-show-images, rmail-mime-bulk-handler): + Add option to only show images below a certain size. + (rmail-mime-multipart-handler): Remove unnecessary save-match-data and + save-excursion calls. - * cedet/semantic/decorate/mode.el - (semantic-decorate-pending-decoration-hook): Rename from - semantic-decorate-pending-decoration-hooks. Make old name an - obsolete alias. +2009-09-26 Eli Zaretskii <eliz@gnu.org> - * cedet/srecode/map.el (srecode-map-validate-file-for-mode): Use - semantic-init-hook instead of obsolete alias semantic-init-hooks. + * makefile.w32-in (WINS_ALMOST): Add cedet (with its + subdirectories) and eieio. - * cedet/semantic/fw.el (semantic-find-file-noselect): Use - semantic-init-hook instead of obsolete alias semantic-init-hooks. +2009-09-26 Alan Mackenzie <acm@muc.de> - * cedet/ede/project-am.el (project-am-with-makefile-current): Use - semantic-init-hook instead of obsolete alias semantic-init-hooks. + * progmodes/cc-engine.el (c-beginning-of-statement-1): Correct + buggy bracketing. - * cedet/semantic/util.el (semantic-describe-buffer): Use - semantic-init-hook and semantic-init-db-hook instead of obsolete - aliases. + * progmodes/cc-langs.el (c-nonlabel-token-key): Allow quoted + character constants (as case labels). - * cedet/semantic/util-modes.el (semantic-mode-line-update) - (semantic-toggle-minor-mode-globally): Use semantic-init-hook - instead of obsolete alias semantic-init-hooks. - (semantic-show-parser-state-mode-setup): Use new hook names. +2009-09-25 Juri Linkov <juri@jurta.org> -2009-09-26 Chong Yidong <cyd@stupidchicken.com> + * files.el (safe-local-eval-forms): Allow time-stamp in + before-save-hook (Bug#4554). - Synch to Eric Ludlam's upstream CEDET repository. +2009-09-25 Drew Adams <drew.adams@oracle.com> - * cedet/semantic/bovine/c.el (semantic-c-parse-token-hack-depth): - New var. - (semantic-c-parse-lexical-token): Save match data when setting up - the secondary parse buffer. Allow recursion. Protect against - initializing the major mode from throwing errors, ie user hooks. + * menu-bar.el (list-buffers-directory): Doc fix. - * cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string): - Protect installing a major mode from throwing errors. +2009-09-25 Stefan Monnier <monnier@iro.umontreal.ca> -2009-09-21 Chong Yidong <cyd@stupidchicken.com> + * log-edit.el (log-edit-changelog-entries): Avoid inf-loops. + Try and avoid copying twice the same paragraph. + (log-edit-changelog-paragraph, log-edit-changelog-subparagraph): + Remove save-excursion. + (log-edit-changelog-entry): Do it here instead. - * cedet/semantic.el (semantic-parser-working-message): Use a less - technical parsing message. - (semantic-mode): Require semantic/db-ebrowse if we need to. +2009-09-25 Juanma Barranquero <lekktu@gmail.com> - * cedet/semantic/util-modes.el (semantic-highlight-func-mode): Doc - fix. + * bs.el (bs--get-file-name): Use `list-buffers-directory' + when available, instead of hardcoding mode names. Doc fix. -2009-09-21 Chong Yidong <cyd@stupidchicken.com> + * menu-bar.el (list-buffers-directory): Add docstring. + Make automatically buffer-local. - * cedet/semantic/db.el (semanticdb--inhibit-make-directory): New - var. - (semanticdb-save-all-db): Use it. + * dired.el (dired-mode): + * files.el (cd-absolute): + * pcvs.el (cvs-temp-buffer): + * pcvs-util.el (cvs-get-buffer-create): + * shell.el (shell-mode): + * vc-dir.el (vc-dir-mode): + Don't make `list-buffers-directory' buffer local. - * cedet/semantic/db-file.el (semanticdb-default-save-directory): - Save in user-emacs-directory instead of the home directory. - (semanticdb-file-directory-exists-p): Avoid prompting the user - multiple times. +2009-09-25 Devon Sean McCullough <emacs-hacker@Jovi.Net> -2009-09-21 Chong Yidong <cyd@stupidchicken.com> + * comint.el (comint-exec, comint-run, make-comint): + Doc fixes (Bug#4542). - * help-fns.el (describe-function-1): Call - overload-docstring-extension for mode-local functions. +2009-09-25 Glenn Morris <rgm@gnu.org> - * cedet/mode-local.el: - * cedet/semantic/mru-bookmark.el: - * cedet/pulse.el: Remove advice. + * mail/rmailmm.el (rmail-mime): New custom group. + Move all defcustoms in this file into this group. + (rmail-mime-media-type-handlers-alist): Revert previous change. + (rmail-mime-show-images): New option. + (rmail-mime-total-number-of-bulk-attachments): Remove variable and all + references to it, since it wasn't actually used for anything. + (rmail-mime-insert-image): New function. + (rmail-mime-image): Use rmail-mime-insert-image. + (rmail-mime-bulk-handler): Remove optional `image' argument, instead + obey the value of `rmail-mime-show-images' option. Print the size of + attachments. - * cedet/semantic.el: Add autoloads for semantic/idle functions. +2009-09-25 David Engster <deng@randomsample.de> - * cedet/semantic/util.el (semantic--completion-cache): New var. - (semantic-symbol-start, semantic-find-tag-for-completion) - (semantic-complete-symbol): New functions, adapted from Senator. + * progmodes/hideshow.el (hs-show-block): Run `hs-show-hook'. (Bug#4548) - * bindings.el (complete-symbol): Try semantic-complete-symbol if - no tag table is active. +2009-09-24 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * cedet/semantic/idle.el (define-semantic-idle-service): Doc fix. + * whitespace.el: Does not highlight trailing spaces While point is + at end of line. Does not highligt spaces at beginning of buffer + while point is at beginning of buffer. Does not highlight spaces + at end of buffer while point is at end of buffer. (Bug#4177) + New version 12.0. + (whitespace-display-mappings): Adjust initialization. + (whitespace-point, whitespace-font-lock-refontify): New vars. + (whitespace-color-on, whitespace-color-off): Adjust code. + (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp) + (whitespace-empty-at-eob-regexp, whitespace-space-regexp) + (whitespace-tab-regexp, whitespace-post-command-hook): New funs. -2009-09-21 Chong Yidong <cyd@stupidchicken.com> +2009-09-24 Chong Yidong <cyd@stupidchicken.com> - * menu-bar.el: Remove ediff-misc from Tools menu. + * nxml/nxml-mode.el: Alias xml-mode to nxml-mode. - * cedet/semantic.el (semantic-init-hook) - (semantic-init-mode-hook, semantic-init-db-hook): Rename - from *-hooks, to follow hook naming conventions. - (semantic-submode-list, semantic-default-submodes): New vars. - (semantic-mode): New mode. - (semantic-parser-working-message): Add ellipses to parse message. + * textmodes/sgml-mode.el: Remove xml-mode alias. - * cedet/semantic/bovine/c.el: - * cedet/semantic/bovine/make.el: - * cedet/semantic/bovine/scm.el: - * cedet/semantic/wisent/java-tags.el: - * cedet/semantic/wisent/javascript.el: Don't set hooks directly. - This is now done in semantic-mode. + * files.el (auto-mode-alist, conf-mode-maybe) + (magic-fallback-mode-alist): Revert 2009-09-18 and 2009-09-21 changes. - * cedet/semantic/decorate/mode.el (global-semantic-decoration-mode): - Autoload. +2009-09-24 Alan Mackenzie <acm@muc.de> - * cedet/srecode/compile.el: - * cedet/srecode/insert.el: - * cedet/srecode/mode.el: Fix require statements. + * progmodes/cc-cmds.el (c-scan-conditionals): A new function like + c-forward-conditionals, but it doesn't move point and doesn't set + the mark. + (c-up-conditional, c-up-conditional-with-else, c-down-conditional) + (c-down-conditional-with-else, c-backward-conditional) + (c-forward-conditional): Refactor to use c-scan-conditionals. + +2009-09-24 Juanma Barranquero <lekktu@gmail.com> + + * help-fns.el (help-downcase-arguments): New option, defaulting to nil. + (help-default-arg-highlight): Remove. + (help-highlight-arg): New function. + (help-do-arg-highlight): Use it. + Suggested by Drew Adams <drew.adams@oracle.com>. (Bug#4510, bug#4520) + +2009-09-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * term.el (term-set-scroll-region, term-handle-ansi-escape): + Undo last change, which didn't fix the problem and introduced others. + +2009-09-24 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el: Don't require speedbar. + (gdb-jsonify-buffer): Handle case where "=" is part of value string. + +2009-09-24 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-fancy-display): Always run the hook. + + * term/ns-win.el (ns-reg-to-script): Define for compiler. + + * mail/rmailmm.el (rmail-mime-multipart-handler): Accept the case where + there is no newline after the final mime boundary. (Bug#4539) + Move markers on insertion so that any buttons inserted don't end up in + the next part of a multipart message. + (rmail-mime-media-type-handlers-alist): Doc fix. Add image handler. + (rmail-mime-bulk-handler): Optionally handle images. + (rmail-mime-image): New button action. + (rmail-mime-image-handler): New function. + (rmail-mime-mode): New mode. + (rmail-mime): Doc fix. Use rmail-mime-mode (for font-lock). + +2009-09-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (minibuffer-force-complete): Cycle the list, rather + than just dropping elements from it (bug#4504). + + * term.el (term-set-scroll-region): Don't move cursor any more. + (term-handle-ansi-escape): Call term-goto here instead. + Suggested by Ivan Kanis <apple@kanis.eu>. + + * term.el: Require CL. + (term-ansi-reset): New function. + (term-mode, term-emulate-terminal, term-handle-colors-array): Use it. + (term-handle-colors-array): Simplify. + +2009-09-24 Juanma Barranquero <lekktu@gmail.com> + + * allout.el (allout-overlay-interior-modification-handler) + (allout-obtain-passphrase): + * epa-file.el (epa-file-write-region): + * ps-print.el (ps-begin-job): + * vc-hooks.el (vc-toggle-read-only): + * vc-rcs.el (vc-rcs-rollback): + * vc-sccs.el (vc-sccs-rollback): + * vc.el (vc-deduce-fileset, vc-next-action, vc-register-with) + (vc-version-diff, vc-revert, vc-rollback): + * wdired.el (wdired-check-kill-buffer): + * emacs-lisp/authors.el (authors): + * net/socks.el (socks-open-connection): + * net/zeroconf.el (zeroconf-service-add-hook): + * obsolete/vc-mcvs.el (vc-mcvs-register): + * progmodes/gdb-mi.el (def-gdb-thread-buffer-gud-command) + (gdb-select-frame): + * progmodes/grep.el (lgrep, rgrep): + * progmodes/idlw-help.el (idlwave-help-check-locations) + (idlwave-help-html-link, idlwave-help-assistant-open-link): + * textmodes/ispell.el (ispell-find-aspell-dictionaries): + * textmodes/reftex-toc.el (reftex-toc-promote-prepare) + (reftex-toc-rename-label): Fix typos in error messages. + + * dired-aux.el (dired-do-shell-command): Reflow docstring. + (dired-copy-how-to-fn): Doc fix. + (dired-files-attributes, dired-read-shell-command): + Fix typos in docstrings. + + * dired-x.el (dired-enable-local-variables, dired-filename-at-point) + (dired-x-find-file-other-window): Reflow docstrings. + (dired-omit-marker-char, dired-read-shell-command) + (dired-x-submit-report): Fix typos in docstrings. + + * shell.el (shell-mode-hook): + * view.el (View-scroll-line-forward): + * progmodes/inf-lisp.el (inferior-lisp-mode-hook): + Fix typos in docstrings. + + * net/dig.el (dig-invoke): Fix typo in docstring. + (query-dig): Reflow docstring. + + * progmodes/idlwave.el (idlwave-create-user-catalog-file) + (idlwave-quoted, idlwave-rinfo-max-source-lines): Doc fixes. + (idlwave-abbrev-move, idlwave-auto-routine-info-updates) + (idlwave-begin-block-reg, idlwave-begin-unit-reg) + (idlwave-beginning-of-subprogram, idlwave-block-jump-out) + (idlwave-block-match-regexp, idlwave-calculate-paren-indent) + (idlwave-check-abbrev, idlwave-class-file-or-buffer) + (idlwave-class-found-in, idlwave-complete, idlwave-complete-in-buffer) + (idlwave-completion-map, idlwave-current-indent) + (idlwave-custom-ampersand-surround, idlwave-customize) + (idlwave-default-font-lock-items, idlwave-default-insert-timestamp) + (idlwave-define-abbrev, idlwave-determine-class-special) + (idlwave-do-action, idlwave-doc-header, idlwave-doc-modification) + (idlwave-end-block-reg, idlwave-end-of-statement) + (idlwave-end-of-statement0, idlwave-end-of-subprogram) + (idlwave-end-unit-reg, idlwave-entry-find-keyword) + (idlwave-explicit-class-listed, idlwave-file-header) + (idlwave-fill-paragraph, idlwave-find-class-definition) + (idlwave-fix-keywords, idlwave-hang-indent-regexp, idlwave-hard-tab) + (idlwave-idlwave_routine_info-compiled, idlwave-in-comment) + (idlwave-in-quote, idlwave-indent-action-table) + (idlwave-indent-expand-table, idlwave-indent-line) + (idlwave-indent-subprogram, idlwave-indent-to-open-paren) + (idlwave-is-comment-line, idlwave-is-comment-or-empty-line) + (idlwave-is-continuation-line, idlwave-is-pointer-dereference) + (idlwave-kill-autoloaded-buffers, idlwave-lib-p, idlwave-look-at) + (idlwave-make-tags, idlwave-mode, idlwave-mode-abbrev-table) + (idlwave-mouse-active-rinfo, idlwave-newline, idlwave-no-change-comment) + (idlwave-outlawed-buffers, idlwave-popup-select) + (idlwave-previous-statement, idlwave-rescan-catalog-directories) + (idlwave-routine-entry-compare, idlwave-routine-info.pro) + (idlwave-scan-all-buffers-for-routine-info, idlwave-scan-class-info) + (idlwave-shell-automatic-start, idlwave-shell-explicit-file-name) + (idlwave-show-begin, idlwave-split-line, idlwave-split-link-target) + (idlwave-statement-type, idlwave-struct-skip) + (idlwave-substitute-link-target, idlwave-toggle-comment-region) + (idlwave-update-current-buffer-info, idlwave-use-library-catalogs) + (idlwave-what-module-find-class): Fix typos in docstrings. + (idlwave-all-method-classes, idlwave-calc-hanging-indent) + (idlwave-calculate-cont-indent, idlwave-expand-equal) + (idlwave-find-module, idlwave-find-structure-definition) + (idlwave-init-rinfo-when-idle-after, idlwave-insert-source-location) + (idlwave-list-load-path-shadows, idlwave-next-statement) + (idlwave-routine-entry-compare-twins, idlwave-routine-info) + (idlwave-routines, idlwave-sintern-rinfo-list, idlwave-statement-match) + (idlwave-template): Reflow docstrings. + + * progmodes/idlw-shell.el (idlwave-shell-syntax-error): Doc fix. + (idlwave-shell-batch-command, idlwave-shell-bp-alist) + (idlwave-shell-bp-get, idlwave-shell-bp-overlays) + (idlwave-shell-bp-query, idlwave-shell-break-here, idlwave-shell-buffer) + (idlwave-shell-display-line, idlwave-shell-display-wframe) + (idlwave-shell-electric-debug-mode, idlwave-shell-examine-select) + (idlwave-shell-file-name-chars, idlwave-shell-filter-bp) + (idlwave-shell-goto-frame, idlwave-shell-halt-messages-re) + (idlwave-shell-highlighting-and-faces, idlwave-shell-idl-wframe) + (idlwave-shell-mode-hook, idlwave-shell-mode-line-info) + (idlwave-shell-mode-map, idlwave-shell-module-source-filter) + (idlwave-shell-mouse-help, idlwave-shell-mouse-print) + (idlwave-shell-pc-frame, idlwave-shell-pending-commands) + (idlwave-shell-print, idlwave-shell-quit, idlwave-shell-redisplay) + (idlwave-shell-scan-for-state, idlwave-shell-send-command) + (idlwave-shell-sentinel-hook, idlwave-shell-separate-examine-output) + (idlwave-shell-shell-command, idlwave-shell-sources-alist) + (idlwave-shell-sources-bp, idlwave-shell-sources-filter) + (idlwave-shell-step, idlwave-shell-use-breakpoint-glyph) + (idlwave-toolbar-add-everywhere, idlwave-toolbar-toggle): + Fix typos in docstrings. + (idlwave-shell-bp, idlwave-shell-clear-current-bp) + (idlwave-shell-hide-output, idlwave-shell-mode) + (idlwave-shell-run-region, idlwave-shell-set-bp-in-module): + Reflow docstrings. + + * textmodes/bibtex.el (bibtex-sort-entry-class): Fix group name. + +2009-09-24 Ivan Kanis <apple@kanis.eu> + + * term.el (term-bold-attribute): New var. + (term-handle-colors-array): Use it. + +2009-09-23 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-version): New variable. + (gdb-non-stop-handler): Set gdb-version. + (gdb-gud-context-command, gdb-current-context-command, gdb-stopped): + Condition "--thread" option on gdb-version. + (gdb-invalidate-threads): Remove unused argument. + +2009-09-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/flyspell.el (sgml-mode-flyspell-verify): Pass limit args + to looking-back to avoid ridiculous slow down in large files (bug#4511). + +2009-09-23 Glenn Morris <rgm@gnu.org> + + * mail/rmail.el (rmail-reply): Don't try to add a References header when + replying to mail without References or Message-Id. (Bug#4525) + +2009-09-23 Adrian Robert <Adrian.B.Robert@gmail.com> + + * term/ns-win.el (ns-reg-to-script): New variable. + +2009-09-23 Daiki Ueno <ueno@unixuser.org> + + * epg.el (epg-wait-for-status): Preserve existing 'error results. + +2009-09-22 Sam Steingold <sds@gnu.org> + + * vc-hg.el (vc-hg-print-log): Fix shortlog arg passing. + (vc-hg-outgoing, vc-hg-incoming): Bump okstatus in `vc-hg-command' + to 1 because hg returns status 1 when nothing is found. + Bind `vc-short-log' for the sake of `vc-hg-log-view-mode'. + +2009-09-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/fill.el: Convert to utf-8 encoding. + (fill-french-nobreak-p): Remove redundant » and « inherited from our + pre-unicode days. + + * add-log.el (change-log-fill-forward-paragraph): New function. + (change-log-mode): Use it so fill-region DTRT. + Set fill-indent-according-to-mode here rather than in + change-log-fill-paragraph. + (change-log-fill-paragraph): Remove. + +2009-09-22 Juanma Barranquero <lekktu@gmail.com> + + * info.el (Info-try-follow-nearest-node): Use the URL extracted by + `Info-get-token', instead of `browse-url-url-at-point'. (Bug#4508) + +2009-09-22 Glenn Morris <rgm@gnu.org> + + * calendar/calendar.el (calendar-mode-map): Make mouse-1 and 3 clicks on + the scroll-bar scroll the calendar window rather than the buffer. + + * calendar/cal-menu.el (cal-menu-scroll-menu): Add a sub-section with + commands that move point (as opposed to scrolling). + + * emulation/tpu-edt.el (tpu-copy-keyfile): Fix condition-case handler. + + * emacs-lisp/elint.el (elint): New custom group. + (elint-log-buffer): Make it a defcustom. + (elint-scan-preloaded, elint-ignored-warnings) + (elint-directory-skip-re): New options. + (elint-builtin-variables): Doc fix. + (elint-preloaded-env): New variable. + (elint-unknown-builtin-args): Add an entry for encode-time. + (elint-extra-errors): Make it a variable rather than a constant. + (elint-preloaded-skip-re): New constant. + (elint-directory): Skip files matching elint-directory-skip-re. + (elint-features): New variable, local to linted buffers. + (elint-update-env): Initialize elint-features. Possibly add + elint-preloaded-env to the buffer's environment. + (elint-get-top-forms): Bind elint-current-pos, for log messages. + Skip quoted forms. + (elint-init-form): New function, extracted from elint-init-env. + Make non-list forms a warning rather than an error. + Add the mode-map for define-derived-mode. Handle define-minor-mode, + easy-menu-define, put that adds an error-condition, and provide. + When requiring cl, also require cl-macs. Really require cl, to handle + some cl macros. Store required libraries in the list elint-features, + so as not to re-load them. Treat cc-require like require. + (elint-init-env): Call elint-init-form to do the work. + Handle eval-and-compile and such like. + (elint-add-required-env): Do not clear messages. + (elint-special-forms): Add handlers for function, defalias, if, when, + unless, and, or. + (elint-form): Add optional argument to ignore elint-special-forms, + useful to prevent recursive calls from handlers. Doc fix. + Respect elint-ignored-warnings. + (elint-form): Respect elint-ignored-warnings. + (elint-bound-variable, elint-bound-function): New variables. + (elint-unbound-variable): Respect elint-bound-variable. + (elint-get-args): Respect elint-bound-function. + (elint-check-cond-form): Add some simple handling for (f)boundp and + featurep tests. + (elint-check-defalias-form): New handler. + (elint-check-let-form): Make an empty let a warning rather than an + error. + (elint-check-setq-form): Make an empty setq a warning rather than an + error. Respect elint-ignored-warnings. + (elint-check-defvar-form): Accept null doc-strings. + (elint-check-conditional-form): New handler. Does some simple-minded + checking of featurep and (f)boundp tests. + (elint-put-function-args): New function. + (elint-initialize): Use elint-scan-doc-file rather than + elint-find-builtin-variables. Use elint-put-function-args. + Possibly scan preloaded-file-list. + (elint-scan-doc-file): Rename from elint-find-builtin-variables and + extend to handle functions as well. + +2009-09-22 Lennart Borgman <lennart.borgman@gmail.com> + + * linum.el (linum-delete-overlays, linum-update-window): + Do not modify the right margin. (Bug#3971) + +2009-09-21 Chong Yidong <cyd@stupidchicken.com> -2009-09-20 Chong Yidong <cyd@stupidchicken.com> + * files.el (conf-mode-maybe, magic-fallback-mode-alist): Use + nxml-mode instead of xml-mode. - * cedet/semantic/decorate/mode.el (global-semantic-decoration-mode): - Autoload. +2009-09-21 Kevin Ryde <user42@zip.com.au> - * cedet/ede/cpp-root.el (ede-set-project-variables): Fix featurep. + * net/dig.el: Add "Keywords: comm", as per net-utils.el. (Bug#4501) - * cedet/srecode/mode.el (global-srecode-minor-mode): Fix require. +2009-09-21 Stefan Monnier <monnier@iro.umontreal.ca> - * cedet/srecode/insert.el (srecode--insert-into-buffer): Fix - require. + * net/dig.el (dig-mode): Use define-derived-mode. - * cedet/cedet.el: Require srecode. +2009-09-20 Dan Nicolaescu <dann@ics.uci.edu> - * cedet/ede/system.el: Add local vars for autoloading. - (ede-vc-project-directory): Autoload. + * vc-dispatcher.el (vc-do-command): Return the process object in + the asynchronous case. Use when instead of if. Do not run + vc-exec-after to display a message if not enabled. - * cedet/ede/pmake.el (ede-proj-makefile-create): Require - ede/srecode. - (ede-proj-makefile-create): Fix require. + * vc-git.el (vc-git-dir-extra-headers): Add keymap and mouse-face + properties to the stash strings. + (vc-git-stash-list): Return a list of strings. + (vc-git-stash-get-at-point, vc-git-stash-delete-at-point) + (vc-git-stash-show-at-point): New functions. + (vc-git-stash-map): New keymap. - * cedet/srecode/compile.el (srecode-compile-split-code) - (srecode-compile-parse-inserter): Fix compiler warning. - (srecode-compile-templates): Fix require. + * register.el (ctl-x-r-map): Define the keys here instead of + using autoload. -2009-09-20 Chong Yidong <cyd@stupidchicken.com> +2009-09-20 Thierry Volpiatto <thierry.volpiatto@gmail.com> (tiny change) - * cedet/ede/speedbar.el (ede-speedbar-file-setup): Add autoload. + * bookmark.el (bookmark-write-file): Avoid calling `pp' with large + list, to workaround performance problem (bug#4485). - * cedet/ede.el, cedet/ede/*.el: New files. +2009-09-20 Nick Roberts <nickrob@snap.net.nz> - * cedet/cedet.el: Require ede. + * progmodes/gud.el (gud-sentinel): Revert indavertant change. - * progmodes/autoconf.el: Provide autoconf as well. +2009-09-20 Daiki Ueno <ueno@unixuser.org> - * files.el (auto-mode-alist): Use emacs-lisp-mode for Project.ede. - (auto-mode-alist): Use srecode-template-mode for .srt files. + * epa-file.el (epa-file-cache-passphrase-for-symmetric-encryption): + Document that this option is not recommended to use. - * cedet/semantic/bovine/gcc.el (semantic-gcc-test-output-parser) - (semantic-gcc-test-output-parser-this-machine): - * cedet/semantic/symref/filter.el (semantic-symref-test-count-hits-in-tag) - (semantic-symref-hits-in-region): Require semantic/idle. +2009-09-19 Glenn Morris <rgm@gnu.org> - * cedet/semantic/db-global.el (semanticdb-test-gnu-global): - * cedet/semantic/tag-write.el (semantic-tag-write-test) - (semantic-tag-write-list-test): - * cedet/semantic/lex-spp.el (semantic-lex-spp-write-test) - (semantic-lex-spp-write-utest): - * cedet/semantic/lex.el (semantic-lex-test-region) - (semantic-lex-test-full-depth): - * cedet/semantic/idle.el (semantic-idle-pnf-test): - * cedet/semantic/fw.el (semantic-test-data-cache) - (semantic-test-throw-on-input): - * cedet/semantic/format.el (semantic-test-all-format-tag-functions): - * cedet/semantic/complete.el (semantic-complete-test): - * cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-run-tests) - (semanticdb-ebrowse-dump): Test functions moved to - semantic-tests.el in the test/ directory. + * calc/calc-graph.el (calc-graph-lookup): Avoid assignment to free + variable `var'. - * cedet/semantic/db-ref.el (semanticdb-ref-test): Doc fix. + * calc/calc-alg.el (var): + * calc/calcalg2.el (var): Define for compiler. 2009-09-19 Chong Yidong <cyd@stupidchicken.com> - Synch to Eric Ludlam's upstream CEDET repository. + * emacs-lisp/advice.el (ad-get-argument, ad-set-argument): + Doc fix (Bug#3932). + + * subr.el (baud-rate): Remove long-obsolete function (Bug#4372). + + * time-stamp.el (time-stamp-month-dd-yyyy) + (time-stamp-dd/mm/yyyy, time-stamp-mon-dd-yyyy) + (time-stamp-dd-mon-yy, time-stamp-yy/mm/dd) + (time-stamp-yyyy/mm/dd, time-stamp-yyyy-mm-dd) + (time-stamp-yymmdd, time-stamp-hh:mm:ss, time-stamp-hhmm): + Remove functions that have been obsolete since 1995 (Bug#4436). + + * progmodes/sh-script.el (sh-learn-buffer-indent): Pop to the + indent buffer only if called interactively (Bug#4452). + +2009-09-19 Juanma Barranquero <lekktu@gmail.com> + Eli Zaretskii <eliz@gnu.org> + + This fixes bug#4197 (merged to bug#865, though not identical). + * server.el (server-auth-dir): Add docstring note about FAT32. + (server-ensure-safe-dir): Accept FAT32 directories as "safe", + but warn against using them. + +2009-09-19 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-var-update-handler-1): Include case of + older GDB where there is no has_more field. + +2009-09-19 Glenn Morris <rgm@gnu.org> + + * pgg-pgp.el (pgg-pgp-encrypt-region): Add missing mapconcat separator. + +2009-09-18 Chong Yidong <cyd@stupidchicken.com> + + * files.el (auto-mode-alist): Change default for XML files to nXML + mode (Bug#4169). + +2009-09-18 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-ensure-safe-dir): Pass 'integer + to `file-attributes', as suggested. + +2009-09-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * dired-aux.el (dired-query-alist): Remove spurious backslash. + (dired-query): Use read-key. + +2009-09-18 Adrian Robert <Adrian.B.Robert@gmail.com> + + * cus-start.el (ns-use-qd-smoothing): Remove. + +2009-09-18 Glenn Morris <rgm@gnu.org> + + * allout.el (top-level): Remove unnecessary progn. + + * progmodes/js.el (js-end-of-defun): Remove malformed and unneeded let. + + * emacs-lisp/derived.el (define-derived-mode): Fix paren typo in + definition of abbrev table. + + * speedbar.el (speedbar-track-mouse): + * net/eudc-bob.el (eudc-bob-pipe-object-to-external-program): + * net/eudc.el (eudc-expand-inline): + * net/newst-backend.el (newsticker--cache-read-feed): + * nxml/nxml-outln.el (nxml-end-of-heading): Fix typos in + condition-case handlers. + +2009-09-18 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-frame-address): New variable. + (gdb-var-list): Add an element for has_more field. + (gdb-non-stop-handler): Enable pretty printing for STL containers. + (gdb-var-create-handler, gdb-var-list-children-handler-1) + (gdb-var-update-handler-1): Parse output of dynamic variable + objects (STL containers). + (gdb-var-delete-1): Pass var1 as an explicit second argument. + (gdb-get-field): Delete alias. Use bindat-get-field directly. + + * progmodes/gud.el (gud-speedbar-item-info): Adjust for change to + gdb-var-list. + (gud-speedbar-buttons): Make node expandable if expression "has more" + children. + +2009-09-17 Juanma Barranquero <lekktu@gmail.com> + + * startup.el (emacs-quick-startup): Remove variable and all uses. + (command-line): Set `inhibit-x-resources' instead. + (command-line-1): Use `inhibit-x-resources' instead. + +2009-09-17 Chong Yidong <cyd@stupidchicken.com> + + * subr.el: Fix last change to avoid using the `unless' macro, + which breaks bootstrapping. + +2009-09-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (push, pop, dolist, dotimes, declare): Don't overwrite CL's + extended definitions, in case we reload subr.el after having + loaded CL. + (eval-next-after-load): Mark as obsolete. + +2009-09-17 Juri Linkov <juri@jurta.org> + + * menu-bar.el (menu-bar-search-menu, menu-bar-edit-menu) + (menu-bar-options-menu, menu-bar-showhide-fringe-menu) + (menu-bar-showhide-menu, menu-bar-tools-menu) + (menu-bar-describe-menu, menu-bar-help-menu) + (minibuffer-local-completion-map, minibuffer-local-map): + Fix list quoting. + +2009-09-17 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-form): Always check the function + arguments, whether or not it has a handler. + + * ansi-color.el (ansi-color-get-face-1): Fix typo in handler. + + * simple.el (hard-newline): Give it a doc-string. + + * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table): + (lisp-mode-syntax-table): Give them doc-strings. + +2009-09-17 Dan Nicolaescu <dann@ics.uci.edu> + + * menu-bar.el (menu-bar-file-menu, menu-bar-file-menu) + (menu-bar-i-search-menu, menu-bar-edit-menu, menu-bar-custom-menu) + (menu-bar-options-menu, menu-bar-showhide-menu) + (menu-bar-showhide-fringe-ind-menu, menu-bar-showhide-fringe-menu) + (menu-bar-showhide-scroll-bar-menu, menu-bar-showhide-menu) + (menu-bar-options-menu, menu-bar-line-wrapping-menu) + (menu-bar-options-menu, menu-bar-tools-menu) + (menu-bar-describe-menu, menu-bar-search-documentation-menu) + (menu-bar-help-menu): + (menu-bar-make-mm-toggle, menu-bar-make-toggle): Purecopy the + string arguments. + + * ediff-hook.el (menu-bar-ediff-menu, menu-bar-ediff-merge-menu) + (menu-bar-epatch-menu, menu-bar-ediff-misc-menu): Add purecopy + calls for the menu names and :help. + +2009-09-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (minor-mode-menu-from-indicator): Pay attention + to :minor-mode-function (bug#4455). + +2009-09-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * startup.el (command-line): Initialize the window-system after + processing the command-line. - * cedet/semantic/db.el (semanticdb-get-buffer): Wrap find-file in - save-match-data. + * textmodes/page.el (what-page): Make sure we don't inf-loop if + page-delimiter matches the empty string. - * cedet/semantic/db-global.el (semanticdb-test-gnu-global): Wrap - find-file in save-match-data. +2009-09-16 Glenn Morris <rgm@gnu.org> - * cedet/semantic/util.el (semantic-file-tag-table) - (semantic-recursive-find-nonterminal-by-name): Wrap find-file in - save-match-data. + * emacs-lisp/bytecomp.el (byte-compile-not-obsolete-vars): Rename from + byte-compile-not-obsolete-var. It's a list now. + (byte-compile-not-obsolete-funcs): New variable. + (byte-compile-warn-obsolete): Don't warn about functions if they are in + byte-compile-not-obsolete-funcs. + (byte-compile-variable-ref, byte-compile-defvar): Update for + byte-compile-not-obsolete-vars name-change and list nature. + (byte-compile-maybe-guarded): Suppress warnings about obsolete functions + and variables behind (f)boundp tests. + * net/tramp-compat.el (byte-compile-not-obsolete-vars): Set if bound. - * cedet/semantic/tag.el (semantic-tag-buffer): Wrap find-file in - save-match-data. +2009-09-15 Dan Nicolaescu <dann@ics.uci.edu> - * cedet/semantic/tag-file.el (semantic-go-to-tag): Wrap the "goto" - part with save-match-data. + * vc-git.el (vc-git-log-view-mode): Undo inadvertent change. - * cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string): - Save match data around calling the major mode to enable. +2009-09-15 Stefan Monnier <monnier@iro.umontreal.ca> - * cedet/semantic/format.el (semantic-format-tag-short-doc-default): - Wrap find-file in save-match-data. + * Makefile.in (compile-onefile): Use byte-compile-refresh-preloaded. + * emacs-lisp/bytecomp.el (byte-compile-refresh-preloaded): + Don't autoload. - * cedet/semantic/fw.el (semantic-find-file-noselect): Wrap - find-file in save-match-data +2009-09-15 Stephen Eglen <stephen@gnu.org> + + * iswitchb.el (iswitchb-read-buffer): When selecting a match from + the virtual-buffers, use the name of the buffer specified by + find-file-noselect, as the match may be a symlink. (This was a + problem if the target and the symlink had different names.) + +2009-09-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * custom.el (custom-initialize-default, custom-initialize-set): CSE. + + * desktop.el (desktop-path): Check user-emacs-directory. + + * emacs-lisp/bytecomp.el (byte-compile-refresh-preloaded): New function. + + * loadup.el: Use after-load-functions to GC after loading each file. + Remove the explicit GC calls that used to be sprinkled around. + + * subr.el (after-load-functions): New hook. + (do-after-load-evaluation): Run it. Use string-match-p to detect + `obsolete' packages, rather than painfully extracting the relevant + directory name. + +2009-09-15 Glenn Morris <rgm@gnu.org> + + * apropos.el (apropos-documentation-check-doc-file): Avoid assignment to + free variable `doc'. + + * dired.el (dired-mode-map): Add menu entry for async shell command. + + * help-fns.el (find-lisp-object-file-name): When looking for autoloaded + variables, also consider the .elc files, since the .el files are + normally gzipped (subsequent code locates the .el.gz from the .elc). + + * calc/calc-prog.el (arglist): Define for compiler. + + * calendar/diary-lib.el (diary-display-function): Change the default to + fancy display. + (body): Define for compiler. + + * emacs-lisp/bytecomp.el (byte-compile-keep-pending) + (byte-compile-file-form, byte-compile-lambda) + (byte-compile-top-level-body, byte-compile-form) + (byte-compile-variable-ref, byte-compile-setq) + (byte-compile-setq-default, byte-compile-body) + (byte-compile-body-do-effect, byte-compile-and, byte-compile-or) + (batch-byte-compile): Give some more local variables with common names + a "bytecomp-" prefix to avoid masking warnings about free variables. + + * startup.el (command-line-1): Give local variables with common names a + distinguishing prefix, so as not to hide free variable warnings during + bootstrap. + + * mail/rmailmm.el (rmail-mime-save): If file exists, don't try to be + clever and add a suffix to make a unique name, just let the user decide + whether or not to overwrite it. If the input is a directory, write the + default filename to that directory. (Bug#4388) + (rmail-mime-bulk-handler): Ensure the save button's 'directory property + is a filename-as-a-directory. + +2009-09-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/page.el (what-page): Don't move to beginning of line. + See <87tyz5ajte.fsf@x2.delysid.org> in emacs-devel. + +2009-09-15 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el (vc-git-dir-extra-headers): Show the remote location. + +2009-09-14 Dan Nicolaescu <dann@ics.uci.edu> + + * bindings.el (mode-line-mode-menu): Add purecopy calls for :help. + * help.el (help-for-help-internal): Add purecopy calls for text. + + * vc.el (top): print-log method now takes an optional SHORTLOG + argument. Add a new method: root. + (vc-root-diff, vc-print-root-log): New functions. + (vc-log-short-style): New variable. + (vc-print-log-internal): Add support for showing short logs. + + * vc-hooks.el (vc-prefix-map, vc-menu-map): Add bindings for + vc-print-root-log and vc-print-root-diff. + + * vc-bzr.el (vc-bzr-log-view-mode, vc-bzr-print-log): + * vc-git.el (vc-git-print-log, vc-git-log-view-mode): + * vc-hg.el (vc-hg-print-log, vc-hg-log-view-mode): Add support for + short logs. + + * vc-cvs.el (vc-cvs-print-log): + * vc-mtn.el (vc-mtn-print-log): + * vc-rcs.el (vc-rcs-print-log): + * vc-sccs.el (vc-sccs-print-log): + * vc-svn.el (vc-svn-print-log): Add an optional argument shortlog + that is ignored for now. + + * vc-mtn.el (vc-mtn-annotate-command): + * vc-svn.el (vc-svn-annotate-command): Run asynchronously. + +2009-09-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el: Add mapping for backspace/delete/clear/tab/escape/return + to function-key-map, and give them ascii-character property. + * term/x-win.el (x-alternatives-map): + * term/ns-win.el (ns-alternatives-map): + * term/internal.el (msdos-key-remapping-map): + * w32-fns.el (x-alternatives-map): Remove redundant mappings. + +2009-09-14 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/elint.el (elint-add-required-env): Revert to not using + temp-buffers (2009-09-12). + +2009-09-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/ispell.el (ispell-command-loop): Improve last fix, using + the new read-key function. 2009-09-13 Chong Yidong <cyd@stupidchicken.com> - Synch to Eric Ludlam's upstream CEDET repository. + * term/x-win.el (x-menu-bar-open): Only call accelerate-menu if it + is defined (Bug#4405). - * cedet/semantic/tag-write.el (semantic-tag-write-list-slot-value): - Autoload. +2009-09-13 Vincent Belaïche <vincent.belaiche@gmail.com> - * cedet/semantic/analyze/fcn.el (semantic-analyze-dereference-metatype-1) - (semantic-analyze-type): Require semantic/scope. - (semantic-analyze-select-best-tag): Require semantic/db-typecache. - (semantic-analyze-dereference-metatype): Move up to avoid compiler - warning. + * recentf.el (recentf-cleanup): Use a hash table to find + duplicates (Bug#4407). + +2009-09-13 Per Starbäck <per@starback.se> (tiny change) + + * textmodes/ispell.el (ispell-command-loop): Convert keys such as + kp-0 to ascii equivalents (Bug#4325). + +2009-09-13 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/cperl-mode.el (cperl-init-faces): Revert last change. + + * eshell/em-hist.el: + * eshell/em-dirs.el (eshell-complete-user-reference): + Declare pcomplete functions and variables to avoid compiler warnings. + +2009-09-13 Leo <sdl.web@gmail.com> (tiny change) + + * eshell/em-script.el (eshell-login-script, eshell-rc-script): + * eshell/em-dirs.el (eshell-last-dir-ring-file-name): + * eshell/em-alias.el (eshell-aliases-file): + * eshell/em-hist.el (eshell-history-file-name): + Use expand-file-name instead of concat to make file names (Bug#4308). + +2009-09-13 Glenn Morris <rgm@gnu.org> + + * ediff-merg.el (ediff-do-merge): + * filesets.el (filesets-run-cmd): + * emulation/ws-mode.el (ws-show-markers, ws-move-block, ws-delete-block) + (ws-find-marker-0, ws-find-marker-1, ws-find-marker-2, ws-find-marker-3) + (ws-find-marker-4, ws-find-marker-5, ws-find-marker-6, ws-find-marker-7) + (ws-find-marker-8, ws-find-marker-9, ws-goto-block-begin) + (ws-goto-block-end, ws-goto-last-cursorposition, ws-copy-block): + Replace empty `let's with `progn'. + +2009-09-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * mail/sendmail.el (send-mail-function): + * tooltip.el (tooltip-mode): + * simple.el (transient-mark-mode): + * rfn-eshadow.el (file-name-shadow-mode): + * frame.el (blink-cursor-mode): + * font-core.el (global-font-lock-mode): + * files.el (temporary-file-directory) + (small-temporary-file-directory, auto-save-file-name-transforms): + * epa-hook.el (auto-encryption-mode): + * composite.el (global-auto-composition-mode): + Use custom-initialize-delay. + * startup.el (command-line): Don't explicitly call + custom-reevaluate-setting for all the above vars. + * custom.el (custom-initialize-safe-set) + (custom-initialize-safe-default): Delete. + +2009-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * term/x-win.el (x-initialize-window-system): + * term/w32-win.el (w32-initialize-window-system): + * term/ns-win.el (ns-initialize-window-system): Don't call + mouse-wheel-mode since it's enabled globally by default already. + + * mwheel.el (mouse-wheel-mode): Make sure the new defvar doesn't + actually define the variable, but only silences the byte-compiler. + (mouse-wheel-change-button): Check whether mouse-wheel-mode is bound + before looking it up. + (mouse-wheel-scroll-amount): Also reset the bindings if this value + is changed. + +2009-09-12 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/elint.el (elint-file): Make max-lisp-eval-depth at least + 1000. + (elint-add-required-env): Don't beep on error. + (elint-forms): In case of error, return ENV unchanged. + (elint-init-env): Skip non-list forms. + (elint-log): Handle unknown file positions. + +2009-09-12 Daiki Ueno <ueno@unixuser.org> + + * epg.el (epg-make-context): Add autoload cookie. + (epg-list-keys, epg-cancel, epg-start-decrypt, epg-decrypt-file) + (epg-decrypt-string, epg-start-verify, epg-verify-file) + (epg-verify-string, epg-start-sign, epg-sign-file) + (epg-sign-string, epg-start-encrypt, epg-encrypt-file) + (epg-encrypt-string, epg-start-export-keys) + (epg-export-keys-to-file, epg-export-keys-to-string) + (epg-start-import-keys, epg-import-keys-from-file) + (epg-import-keys-from-string, epg-start-receive-keys) + (epg-receive-keys, epg-import-keys-from-server) + (epg-start-delete-keys, epg-delete-keys, epg-start-sign-keys) + (epg-sign-keys, epg-start-generate-key) + (epg-generate-key-from-file, epg-generate-key-from-string): + Remove autoload cookie. + +2009-09-12 Eli Zaretskii <eliz@gnu.org> + + * dos-fns.el (dos-reevaluate-defcustoms): Comment out the + reevaluation of trash-directory. + + * mwheel.el: Fix last change. + (mouse-wheel-mode): New defvar. + (mouse-wheel-mode): Remove autoload cookie. + +2009-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * mwheel.el (mwheel-installed-bindings): New var. + (mouse-wheel-mode): Use it, so as to make sure we really remove all + the bindings we set last time. Use custom-initialize-delay. + * loadup.el: Load mwheel after term/*-win.el. + * startup.el (command-line): Don't reevaluate mouse-wheel-down-event + and mouse-wheel-up-event now that their first evaluation is done + sufficiently late to be correct. + + * startup.el (tutorial-directory): Make it a defcustom. + Use custom-initialize-delay rather than eval-at-startup to set it. + * image.el (image-load-path): Make it a defcustom. + Use custom-initialize-delay rather than eval-at-startup to set it. + * subr.el (eval-at-startup): Remove. + * font-lock.el (lisp-font-lock-keywords-2): Remove eval-at-startup. + + * subr.el (do-after-load-evaluation): Warn the user after loading an + obsolete package. + +2009-09-12 Glenn Morris <rgm@gnu.org> + + * proced.el (proced-mark-alt): Remove alias. + (proced-mode-map): Remove proced-mark-alt. + + * emacs-lisp/lisp-mode.el (emacs-lisp-mode-map): Add menu entries to + Elint file and directory. Remove initialization entry. + + * emacs-lisp/elint.el (elint-file, elint-directory): New autoloaded + commands. + (elint-current-buffer): Set mode-line-process. + (elint-init-env): Handle define-derived-mode. + Fix declare-function with unspecified arglist. Guard against odd + defalias statements (eg iso-insert's 8859-1-map). + (elint-add-required-env): Use a temp buffer. + (elint-form): Just print the function/macro name, not the whole form. + Return env unchanged if we fail to parse a macro. + (elint-forms): Guard against parse errors. + (elint-output): New function, to handle batch mode. + (elint-log-message): Add optional argument. Use elint-output. + (elint-set-mode-line): New function. + +2009-09-12 Andreas Politz <politza@fh-trier.de> (tiny change) + + * emacs-lisp/elp.el (elp-not-profilable): Add more + functions (Bug#4233). + +2009-09-12 Chong Yidong <cyd@stupidchicken.com> + + * emulation/pc-select.el (scroll-down-mark, scroll-down-nomark) + (scroll-up-mark, scroll-up-nomark): Doc fix (Bug#4190). + +2009-09-11 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-var-list-children-regexp): Delete. + (gdb-var-list-children): Use json parsing. + +2009-09-11 Daniel Colascione <dan.colascione@gmail.com> + + * progmodes/js.el (js--proper-indentation): Handle the case where + char-before is null. Reported by Deniz Dogan. + +2009-09-11 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/cl-macs.el (help-add-fundoc-usage): Declare. + +2009-09-11 Daiki Ueno <ueno@unixuser.org> + + * epg.el (epg-cipher-algorithm-alist): Add CAMELLIA. + (epg-digest-algorithm-alist): Add SHA224. + (epg-context-set-passphrase-callback) + (epg-context-set-progress-callback): Add description about + callback function. + +2009-09-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * custom.el (custom-delayed-init-variables): New var. + (custom-initialize-delay): New function. + * startup.el (command-line): "Re"evaluate all vars in + custom-delayed-init-variables. Don't reevaluate abbrev-file-name + explicitly any more. + * abbrev.el (abbrev-file-name): Use custom-initialize-delay + to avoid creating a ~/.emacs.d at build-time (bug#4347). + + * proced.el (proced-mode-map): Prefer "m" for proced-mark (bug#4362). + +2009-09-11 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-var-update-regexp): Delete. + (gdb-var-update-handler): Use json parsing. + +2009-09-11 Juanma Barranquero <lekktu@gmail.com> + + * vc-annotate.el (vc-annotate): Use the main file's coding-system to + decode annotated text, regardless of language environment. (Bug#2741) + +2009-09-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * Makefile.in (autoloads): Make rmail.el writable as well. - * cedet/semantic/wisent/java-tags.el: - * cedet/semantic/wisent/javat-wy.el: New files. +2009-09-11 Glenn Morris <rgm@gnu.org> - * cedet/semantic/wisent/java.el: - * cedet/semantic/wisent/java-wy.el: Files removed. + * dired-aux.el, dired-x.el: Put autoloads in dired.el rather than + loaddefs.el. + * dired.el: Regenerate with extracted autoloads. + * Makefile.in (autoloads): Make dired.el writable. - * cedet/semantic/java.el (semantic-java-prototype-function) - (semantic-java-prototype-variable, semantic-java-prototype-type): - Doc fix - (java-mode::semantic-format-tag-prototype): Renamed from - semantic-format-prototype-tag, which didn't match the overloadable + * ibuf-ext.el: Put autoloads in ibuffer.el rather than loaddefs.el. + * ibuffer.el: Regenerate with extracted autoloads. + * Makefile.in (autoloads): Make ibuffer.el writable. + + * paths.el (prune-directory-list, gnus-nntp-service, rmail-file-name): + * version.el (emacs-copyright, emacs-major-version) + (emacs-minor-version): Reformat doc-strings for make-docfile. + + * apropos.el (apropos-documentation-check-doc-file): Exclude unbound + functions and variables, since they must be stuff specific to some other + platform. + (apropos-print): Make mouse-click message less specific about button. + + * emacs-lisp/cl-macs.el (define-compiler-macro): Add a property + that records where a macro was defined. + * help-fns.el (describe-function-1): Mention if a function has a + compiler-macro. + * help-mode.el (help-function-cmacro): New button. + + * locate.el (top-level): Always require dired. + (locate-mode-map): Initialize inside the defvar. + + * net/ange-ftp.el (dired-compress-file): Declare. + (ange-ftp-dired-compress-file): Add doc string. + + * term/ns-win.el (x-display-name, x-setup-function-keys): + Unify doc-strings with X versions. + +2009-09-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/crisp.el (crisp-mode-map): Move initialization + into declaration. + (crisp-mode): Use define-minor-mode. + + * progmodes/xscheme.el (xscheme-evaluation-commands): + Put a :advertised-binding property rather than using + advertised-xscheme-send-previous-expression. + (advertised-xscheme-send-previous-expression): Declare obsolete. + * emulation/crisp.el (crisp-mode-map): Use `undo' rather than + `advertised-undo'. + (crisp-mode): Add corresponding bindings to + undo's :advertised-binding instead. + * dired.el (dired-mode-map): Put a :advertised-binding property rather + than using dired-advertised-find-file. + (dired-advertised-find-file): + * simple.el (advertised-undo): + * wid-edit.el (advertised-widget-backward): Declare obsolete. + (widget-keymap): Put a :advertised-binding property rather + than using advertised-widget-backward. + * bindings.el (ctl-x-map): Put a :advertised-binding property rather + than using advertised-undo. + * tutorial.el (tutorial--default-keys): Adjust accordingly. + +2009-09-10 Simon South <ssouth@slowcomputing.org> + + * progmodes/delphi.el (delphi-tab): Indent region when Transient + Mark mode is enabled and region is active; otherwise indent or + insert TAB as usual. + (delphi-mode): Update description of TAB-key binding. + +2009-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (define-key-rebound-commands): Mark obsolete. + * startup.el (precompute-menubar-bindings): Remove. + (normal-top-level): Remove obsolete code that tried to precompute + menubar bindings. + * loadup.el (define-key-rebound-commands): Don't bother fiddling with + define-key-rebound-commands and precompute-menubar-bindings. + +2009-09-10 Teodor Zlatanov <tzz@lifelogs.com> + + * net/imap.el (imap-interactive-login): Better messages. + (imap-open): Fix bug with renamed buffer on reconnect. + (imap-authenticate): Add buffer-local imap-last-authenticator variable + for easier debugging and cleaner code. On successful (guessed based on + server capabilities) secondary authentication, set imap-state + correctly. + (imap-last-authenticator): Define imap-last-authenticator as a variable + to avoid warnings. + +2009-09-10 Glenn Morris <rgm@gnu.org> + + * pcvs.el (cvs-mode-find-file): Use forward-line rather than goto-line. + + * emacs-lisp/bytecomp.el (byte-compile-function-environment): Doc fix. + (byte-compile-file-form-autoload): Don't warn about unknown functions + where the autoload statement comes after the use. + (with-no-warnings): Give it a byte-hunk-handler like than of progn, so + that any handlers inside the body (eg require) are in turn respected. + + * emacs-lisp/byte-opt.el (degrees-to-radians): Mark as free from side + effects. + + * emacs-lisp/derived.el (define-derived-mode): Give the mode's map, + and syntax and abbrev tables basic docs, if they don't have any. + + * emacs-lisp/easy-mmode.el (easy-mmode-defmap): Add doc-string. + + * international/mule-cmds.el (top-level): Require cl when compiling. + (view-hello-file): Use default-value rather than + default-enable-multibyte-characters. + + * progmodes/fortran.el: Move all safe and risky properties into the + defcustoms. + + * mail/rmailedit.el, mail/rmailkwd.el, mail/rmailmm.el: + * mail/rmailmsc.el, mail/rmailsort.el, mail/rmailsum.el: + * mail/undigest.el: + Put autoloads in rmail.el rather than loaddefs.el. + * mail/rmail.el: Regenerate with extracted autoloads. + + * mail/rmailsum.el (rmail-user-mail-address-regexp): Move to rmail.el. + * mail/rmail.el (rmail-user-mail-address-regexp): Move from rmailsum.el. + +2009-09-10 Nick Roberts <nickrob@snap.net.nz> + + Reported in thread for Bug#4375. + * progmodes/gud.el (gud-tooltip-print-command): Use MI command + "-data-evaluate-expression" instead of print. + * progmodes/gdb-mi.el (gdb-tooltip-print-1): Ditto. + (gdb-tooltip-print): Parse output from above MI command. + (gdb): Revert 2009-08-11 change. User should detach inferior + manually. + + Remove the word "separate" from IO functions as inferior + output is now never displayed in the GUD buffer. + +2009-09-10 Juanma Barranquero <lekktu@gmail.com> + + * startup.el (command-line-normalize-file-name): On Windows and + MS-DOS, also convert C:\/ and C:\\ (two backslashes) into C:/. + +2009-09-10 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-text-char-description): Propertize escape + character sequences with the `escape-glyph' face. (Bug#4344) + + * simple.el (shell-command): Set asynchronous process filter to + `comint-output-filter'. (Bug#4343) + + * progmodes/grep.el (grep-template): Add "<X>" to docstring. + (grep-files-aliases): Add "all". Move "el" and "ch" to the top of + the list. Move "asm" to the bottom. + (grep-find-ignored-directories): Add `choice' with nil value + to empty the list easily. + (grep-find-ignored-files): New option. + (grep-files-history): Set to nil by default instead of '("ch" "el"). + (grep-compute-defaults): Add "<X>" to `grep-template'. + (grep-read-files): Bind new local variables `default-alias' and + `default-extension'. Use a list of default values for the file prompt. + (lgrep): Add `--exclude=' command line options composed from + `grep-find-ignored-files'. + (rgrep): Add `-name' command line options composed from + `grep-find-ignored-files'. (Bug#4301) + +2009-09-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * diff-mode.el (diff-hunk-kill): Fix the search of the next hunk + (bug#4368). + +2009-09-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * calendar/time-date.el (autoload): + Expand define-obsolete-function-alias into defalias and make-obsolete + for old Emacsen that Gnus supports. + (with-no-warnings): Define it for old Emacsen. + (time-to-seconds): Don't use (featurep 'xemacs) to check if float-time + is available. + (time-to-number-of-days): Don't use (featurep 'xemacs) to check if + float-time is available; suppress compile warning for time-to-seconds. + +2009-09-09 Teodor Zlatanov <tzz@lifelogs.com> + + * net/imap.el (imap-message-map): Docstring fix. + +2009-09-09 Glenn Morris <rgm@gnu.org> + + * ffap.el (ffap-file-at-point): Handle absolute (non-remote) files with + line numbers too. (Bug#4374) + +2009-09-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * smerge-mode.el (smerge-remove-props, smerge-refine): + Use with-silent-modifications (bug#4342). + + * subr.el (with-silent-modifications): New macro. + +2009-09-07 Juanma Barranquero <lekktu@gmail.com> + + * files.el (top-level): Require `cl' when compiling. + +2009-09-07 Glenn Morris <rgm@gnu.org> + + * files.el (auto-mode-alist): Use delphi-mode for .dpr files. + + * proced.el (proced-mode-map): Bind "d" to proced-mark-alt. + (proced-mark-alt): New alias, to control the advertised key. (Bug#4362) + +2009-09-06 Nick Roberts <nickrob@snap.net.nz> + + * vc-git.el (vc-git-annotate-command): Use separator to parse + arguments correctly. + +2009-09-06 Eli Zaretskii <eliz@gnu.org> + + * proced.el (proced-mode): Doc fix. + +2009-09-06 Julian Scheid <julians37@gmail.com> (tiny change) + + * net/tramp.el (tramp-perl-file-attributes): Print "nil" when + lstat fails. + (tramp-do-file-attributes-with-ls): Check for file existence at + remote end. + (tramp-do-file-attributes-with-stat): Likewise. + (tramp-convert-file-attributes): Return nil when attr is nil. + +2009-09-05 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-entry): Add help-echo and follow-link + properties to this button. + (diary-fancy-display): Don't extend the button to the final newline. + (diary-fancy-display-mode): Continue to define "q" as a local key. + + * calendar/cal-china.el (holiday-chinese): Make it slightly more + efficient. + + * font-lock.el (lisp-font-lock-keywords-2): Add letf. + + * emacs-lisp/bytecomp.el (emacs-lisp-file-regexp): Doc fix. + (byte-compile-dest-file-function): New option. + (byte-compile-dest-file): Doc fix. + Obey byte-compile-dest-file-function. + (byte-compile-cl-file-p): New function. + (byte-compile-eval): Only suppress noruntime warnings about cl functions + if the cl-functions warning is enabled. Use byte-compile-cl-file-p. + (byte-compile-eval): Check for non-nil byte-compile-cl-functions rather + than for file being previously loaded. + (byte-compile-find-cl-functions): Use byte-compile-cl-file-p. + (byte-compile-file-form-require): Handle the case where requiring a file + indirectly causes CL to be loaded. + +2009-09-05 Karl Fogel <kfogel@red-bean.com> + + * files.el (find-alternate-file): Run `kill-buffer-hook' manually + before killing the old buffer, since by the time `kill-buffer' is + run so many buffer variables have been set to nil that it may not + behave as expected. (Bug#4061) + +2009-09-05 Karl Fogel <kfogel@red-bean.com> + + * files.el (find-alternate-file): If the old buffer is modified + and visiting a file, behave similarly to `kill-buffer' when + killing it, thus reverting to the pre-1.878 behavior; see + http://lists.gnu.org/archive/html/emacs-devel/2009-09/msg00101.html + for discussion. Also, consult `buffer-file-name' as a variable + not as a function, for consistency with the rest of the code. + +2009-09-04 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-insert-directory): Handle "--dired" + also when adding a new directory. + + * net/tramp-compat.el (tramp-compat-line-beginning-position): New + defun. + +2009-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (locate-file-completion-table): Make it provide boundary + information, so partial-completion works better. + +2009-09-04 Leo <sdl.web@gmail.com> (tiny change) + + * mail/footnote.el (Footnote-text-under-cursor): + Check footnote-text-marker-alist before using it (bug#4324). + +2009-09-04 Glenn Morris <rgm@gnu.org> + + * play/5x5.el, play/decipher.el, play/gametree.el, play/handwrite.el: + * play/hanoi.el, play/landmark.el, play/mpuz.el, play/pong.el: + * play/solitaire.el, play/tetris.el: + Remove leading * from defcustom and defface docs. + + * calendar/diary-lib.el (diary-fancy-display): Only switch modes if + necessary. + (diary-fancy-overriding-map): New variable. + (diary-fancy-display-mode): Set minor-mode-overriding-map-alist. + Use view-mode. + + * vc-rcs.el (vc-rcs-annotate-command): Use forward-line rather than + goto-line. + +2009-09-03 Glenn Morris <rgm@gnu.org> + + * arc-mode.el (archive-mode): + * dos-fns.el (set-default-process-coding-system): + * man.el (Man-getpage-in-background): + * menu-bar.el (menu-bar-describe-menu): + * server.el (server-process-filter): + * startup.el (command-line): + * tar-mode.el (tar-header-block-tokenize, tar-extract): + * w32-fns.el (set-default-process-coding-system): + * x-dnd.el (x-dnd-handle-file-name): + * international/mule-cmds.el (mule-menu-keymap) + (set-default-coding-systems, language-info-alist, set-language-info) + (set-language-environment, standard-display-european-internal) + (set-locale-environment): + * international/mule-diag.el (mule-diag): + * mail/emacsbug.el (report-emacs-bug): + * mail/rmail.el (rmail-mode): + * mail/sendmail.el (mail-setup): + Use default-value rather than default-enable-multibyte-characters. + + * progmodes/f90.el: Move all safe properties into the defcustoms. + (f90-get-correct-indent, f90-indent-region, f90-abbrev-start): Use memq. + + * calendar/appt.el (appt-check): + * calendar/diary-lib.el (diary-set-header, diary-live-p) + (diary-check-diary-file, diary-list-entries) + (diary-include-other-diary-files, diary-simple-display) + (diary-fancy-display, diary-print-entries) + (diary-mark-included-diary-files, diary-make-entry): + Don't call substitute-in-file-name on diary-file. + +2009-09-03 Eduard Wiebe <usenet@pusto.de> + Stefan Monnier <monnier@iro.umontreal.ca> + + * mail/footnote.el (footnote-prefix): Make it a defcustom. + (footnote-mode-map): Move initialization into the declaration. + (footnote-minor-mode-map): Define it rather than changing global-map. + (footnote-mode): Use define-minor-mode. + +2009-09-02 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-file-attributes-with-ls) + (tramp-do-file-attributes-with-perl) + (tramp-do-file-attributes-with-stat): Rename from + `tramp-handle-file-attributes-with-*'. + (tramp-handle-file-attributes): Use them. + (tramp-do-directory-files-and-attributes-with-perl) + (tramp-do-directory-files-and-attributes-with-stat): Rename from + `tramp-handle-directory-files-and-attributes-with-*'. + (tramp-handle-directory-files-and-attributes): Use them. + (tramp-method-out-of-band-p): Additional parameter SIZE. + (tramp-do-copy-or-rename-file, tramp-handle-file-local-copy) + (tramp-handle-write-region): Use it. + (tramp-handle-insert-directory): Use "?\ " for compatibility reasons. + (tramp-handle-vc-registered): Check, whether the first run did + return files to be tested. + (tramp-advice-make-auto-save-file-name): Do not call directly + `tramp-handle-make-auto-save-file-name', because this would bypass + the locking mechanism. + + * net/tramp-compat.el (top): Autoload used functions from tramp.el. + (file-remote-p, process-file, start-file-process, set-file-times) + (tramp-compat-file-attributes): Compatibility functions shall not + call directly `tramp-handle-*', because this would bypass the + locking mechanism. + (tramp-compat-number-sequence): New defun. + +2009-09-02 Glenn Morris <rgm@gnu.org> + + * calendar/time-date.el (time-to-seconds): In Emacs, make it an obsolete + alias for float-time. + (time-to-number-of-days): In Emacs, use float-time. + * net/newst-backend.el (time-add): Suppress warnings from compat function. + * time.el (emacs-uptime, emacs-init-time): + * net/rcirc.el (rcirc-keepalive, rcirc-handler-ctcp-KEEPALIVE): + Use float-time rather than time-to-seconds. + + * minibuffer.el (completion-initials-expand): Fix typo. + + * faces.el (modeline, modeline-inactive, modeline-highlight) + (modeline-buffer-id): + * info.el (info-menu-5): Mark these face aliases as obsolete. + +2009-09-01 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-current-context-command): Move the + space ... + (gdb-gud-context-call): ... to here for pre GDB 7.0 when there is + no "--thread" option. + (gdb-stopped): Don't print "Switched to thread" message when it is + unchanged. + +2009-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-try-completion) + (completion-all-completions): Remove ill-defined (and + mistakenly installed and luckily never used nor documented) + `completion-styles' property. + (completion-initials-expand, completion-initials-all-completions) + (completion-initials-try-completion): New functions. + (completion-styles-alist): Add doc to each entry. + Add new `initials' entry. + +2009-09-01 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-var-create-handler): Remove redundant + MI command -var-evaluate-expression. + (gdb-var-list-children-regexp): Update from regexp-1 in gdb-ui.el + and tweak for case of string child. + (gdb-var-list-children-handler): Update from handler-1 in gdb-ui.el. + +2009-09-01 Glenn Morris <rgm@gnu.org> + + * add-log.el (change-log-date-face, change-log-name-face) + (change-log-email-face, change-log-file-face, change-log-list-face) + (change-log-conditionals-face, change-log-function-face) + (change-log-acknowledgement-face): + * cus-edit.el (custom-invalid-face, custom-rogue-face) + (custom-modified-face, custom-set-face, custom-changed-face) + (custom-saved-face, custom-button-face, custom-button-pressed-face) + (custom-documentation-face, custom-state-face, custom-comment-face) + (custom-comment-tag-face, custom-variable-tag-face) + (custom-variable-button-face, custom-face-tag-face) + (custom-group-tag-face-1, custom-group-tag-face): + * diff-mode.el (diff-header-face, diff-file-header-face) + (diff-index-face, diff-hunk-header-face, diff-removed-face) + (diff-added-face, diff-changed-face, diff-function-face) + (diff-context-face, diff-nonexistent-face): + * generic-x.el (show-tabs-tab-face, show-tabs-space-face): + * hilit-chg.el (highlight-changes-face, highlight-changes-delete-face): + * info.el (Info-title-1-face, Info-title-2-face, Info-title-3-face) + (Info-title-4-face): + * isearch.el (isearch-lazy-highlight-face): + * log-view.el (log-view-file-face, log-view-message-face): + * paren.el (show-paren-match-face, show-paren-mismatch-face): + * pcvs-info.el (cvs-header-face, cvs-filename-face, cvs-unknown-face) + (cvs-handled-face, cvs-need-action-face, cvs-marked-face) + (cvs-msg-face): + * smerge-mode.el (smerge-mine-face, smerge-other-face) + (smerge-base-face, smerge-markers-face): + * wid-edit.el (widget-documentation-face, widget-button-face) + (widget-field-face, widget-single-line-field-face) + (widget-inactive-face, widget-button-pressed-face): + * woman.el (woman-italic-face, woman-bold-face, woman-unknown-face) + (woman-addition-face): + * eshell/em-ls.el (eshell-ls-directory-face, eshell-ls-symlink-face) + (eshell-ls-executable-face, eshell-ls-readonly-face) + (eshell-ls-unreadable-face, eshell-ls-special-face) + (eshell-ls-missing-face, eshell-ls-archive-face) + (eshell-ls-backup-face, eshell-ls-product-face) + (eshell-ls-clutter-face): + * eshell/em-prompt.el (eshell-prompt-face): + * eshell/esh-test.el (eshell-test-ok-face, eshell-test-failed-face): + * obsolete/old-whitespace.el (whitespace-highlight-face): + * progmodes/antlr-mode.el (antlr-font-lock-default-face) + (antlr-font-lock-keyword-face, antlr-font-lock-syntax-face) + (antlr-font-lock-ruledef-face, antlr-font-lock-tokendef-face) + (antlr-font-lock-ruleref-face, antlr-font-lock-tokenref-face) + (antlr-font-lock-literal-face): + * progmodes/ebrowse.el (ebrowse-tree-mark-face) + (ebrowse-root-class-face, ebrowse-file-name-face) + (ebrowse-default-face, ebrowse-member-attribute-face) + (ebrowse-member-class-face, ebrowse-progress-face): + * progmodes/make-mode.el (makefile-space-face): + * progmodes/sh-script.el (sh-heredoc-face): + * textmodes/flyspell.el (flyspell-incorrect-face) + (flyspell-duplicate-face): + * textmodes/tex-mode.el (tex-math-face, tex-verbatim-face): + * textmodes/texinfo.el (texinfo-heading-face): + Mark face aliases with "-face" suffix as obsolete. + + * mail/feedmail.el (file-name-buffer-file-type-alist): Define for + compiler. + + * net/eudc-bob.el (eudc-bob-generic-menu, eudc-bob-image-menu) + (eudc-bob-sound-menu): Use defvar rather than defconst, since + easy-menu-define wants to modify these. + + * net/net-utils.el (nslookup): Use make-comint rather than comint-run. + + * net/browse-url.el (browse-url-file-url): + * term/internal.el (dos-codepage-setup): + Use default-value rather than default-enable-multibyte-characters. + + * progmodes/etags.el (etags-goto-tag-location): + * progmodes/flymake.el (flymake-highlight-line) + (flymake-goto-file-and-line, flymake-goto-line): + * progmodes/gdb-mi.el (gdb-mouse-until, gdb-mouse-jump) + (gdb-goto-breakpoint): + * progmodes/idlw-shell.el (idlwave-shell-move-to-bp): + * progmodes/python.el (python-find-function) + (python-pdbtrack-track-stack-file): + * progmodes/verilog-mode.el (verilog-surelint-off): + * term/ns-win.el (ns-open-file-select-line): + * textmodes/bibtex.el (bibtex-validate, bibtex-validate-globally): + Use forward-line rather than goto-line. + + * textmodes/reftex-cite.el (reftex-offer-bib-menu): + * textmodes/reftex-index.el (reftex-display-index): + * textmodes/reftex-ref.el (reftex-offer-label-menu): + * textmodes/reftex-toc.el (reftex-toc): + Remove unnecessary bindings of default-major-mode (all are followed by + major-mode check and possible mode switch). - * cedet/semantic/bovine/c.el (semantic-c-dereference-namespace-alias): - Deal correctly with nested namespaces. Make sure type actually - exists in original namespace. +2009-08-31 Nick Roberts <nickrob@snap.net.nz> - * cedet/semantic/lex-spp.el (semantic-lex-spp-hack-depth): New. - (semantic-lex-spp-lex-text-string): Use above to enable recursion. + * progmodes/gdb-mi.el (gdb-breakpoints-list-handler-custom): + Handle watchpoints (bug#4282). + (def-gdb-thread-buffer-command): Enable thread to be selected by + clicking without selecting threads buffer first. + (gdb-current-context-command): Use selected frame so that "up", + "down" etc work in the GUD buffer. + (gdb-update): Find selected frame before rendering stack buffer. + (gdb-frame-handler): Set gdb-frame-number for stack buffer. - * cedet/semantic/format.el: Whitespace cleanup. - (semantic-test-all-format-tag-functions): Move to end. - (semantic-format-tag-prototype, semantic-format-tag-name) - (semantic-format-tag-name-default): Revert to original upstream - positions. +2009-08-31 Stefan Monnier <monnier@iro.umontreal.ca> - * cedet/semantic/elp.el: File removed. + * progmodes/sym-comp.el (displayed-completions): Remove. + (symbol-complete): Use minibuffer-complete. - * cedet/semantic/analyze.el (semantic-adebug-analyze): New - function, moved here from semantic/adebug. Require data-debug. +2009-08-31 Glenn Morris <rgm@gnu.org> - * cedet/semantic/adebug.el: Declare external semanticdb functions. - (semantic-adebug-analyze, semantic-adebug-edebug-expr): Deleted. + * emacs-lisp/byte-run.el (define-obsolete-face-alias): New macro. + + * apropos.el (apropos-symbols-internal): + Handle (obsolete) face aliases. + + * faces.el (describe-face): Adjust the output format to be more like + describe-variable, and to mention (obsolete) face aliases. + Adjust the whitespace so that help-setup-xref works. + + * calendar/calendar.el (calendar-today-face, diary-face, holiday-face): + * calendar/diary-lib.el (diary-button-face): + Mark these face aliases as obsolete. + + * calendar/calendar.el (calendar-today): Doc fix. + +2009-08-31 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-control-all-threads) + (gdb-control-current-thread): Force tool bar update. + (gdb-non-stop-handler): New function. + (gdb-init-1): Use it to test if non-stop mode is supported. + Remove unused gdbmi buffer type. - * emacs-lisp/eieio.el (eieio-unbound): Default value is now robust - to recompile. +2009-08-30 Kevin Rodgers <kevin.d.rodgers@gmail.com> - * emacs-lisp/eieio-datadebug.el: Add eieio objects to the list of - data debug things to recognize. + * progmodes/grep.el (grep-read-files): Strip trailing <N> from + buffer names not visiting a file (e.g. cloned buffers). (Bug#4210) - * emacs-lisp/eieio-comp.el: Synch to upstream. +2009-08-30 Nick Roberts <nickrob@snap.net.nz> - * cedet/data-debug.el: Don't require eieio and semantic/tag. - If eieio is loaded, require eieio-datadebug. - (data-debug-insert-ring-button): Do not be specific about the ring - contents. - (data-debug-thing-alist): Remove eieio and semantic specific - entries. - (data-debug-add-specialized-thing): New function. + * comint.el (comint-exec-1): Check command is non-null first. + Part of gdb-mi.el change (2009-08-28). - * cedet/cedet.el: Update commentary. +2009-08-30 Stefan Monnier <monnier@iro.umontreal.ca> - * cedet/cedet-edebug.el: Require edebug and debug. + * emacs-lisp/lisp.el (lisp-complete-symbol): Use minibuffer-complete. -2009-09-07 Chong Yidong <cyd@stupidchicken.com> +2009-08-30 Juanma Barranquero <lekktu@gmail.com> - * emacs-lisp/autoload.el (make-autoload): Handle defclass form. + * subr.el (do-after-load-evaluation): Fix last change: use `mapc' + instead of `dolist' to avoid a recursive require when bootstrapping. - * emacs-lisp/eieio.el (eieio-defclass-autoload): Autoload. +2009-08-30 Stefan Monnier <monnier@iro.umontreal.ca> -2009-09-05 Chong Yidong <cyd@stupidchicken.com> + * emacs-lisp/lisp.el (field-complete): Use minibuffer-complete. - * emacs-lisp/autoload.el (generated-autoload-load-name): New var. - (autoload-generate-file-autoloads): Use it. - (make-autoload): Handle define-overloadable-function. + * net/ldap.el (ldap-search-internal): Use with-current-buffer and push. - * emacs-lisp/lisp-mode.el (define-overloadable-function): Add - doc-string-elt property for define-overloadable-function. + * net/imap.el (imap-send-command): Simplify. + (imap-wait-for-tag): point-max -> buffer-size. -2009-09-02 Chong Yidong <cyd@stupidchicken.com> + * net/ange-ftp.el (internal-ange-ftp-mode): Use define-derived-mode. - * emacs-lisp/autoload.el (generated-autoload-feature): New var. - (autoload-rubric): Use it. + * emacs-lisp/easy-mmode.el (define-minor-mode): Don't use symbol-value + with constant argument. - * Makefile.in (setwins): Ignore CEDET subdirectories when making - subdirs.el. + * emacs-lisp/debug.el (debugger-setup-buffer): Make it multibyte. - * emacs-lisp/cl-loaddefs.el (deftype): Add autoload for deftype. + * emacs-lisp/cl.el (cl-macro-environment): Don't define it here. - * emacs-lisp/cl-macs.el (deftype): Add autoload. + * emacs-lisp/checkdoc.el (checkdoc-force-history-flag): + Change default, since most of our files don't have a history. + (checkdoc-display-status-buffer): Don't use a hidden buffer to show to + the user. + + * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions): + Add comint-run. + + * calc/calc.el: Improve commenting convention. + (calc-digit-map, toplevel): Simplify. + + * comint.el (comint-insert-input): Be careful to only set point if we + don't delegate to some other command. + + * proced.el (proced-signal-list): Make it an alist. + (proced-grammar-alist): Capitalize names. + (proced-send-signal): Use a non-hidden buffer (since it's displayed). + Disable undo manually and make it read-only. + Use completion-annotate-function. + + * minibuffer.el (minibuffer-message): If the current buffer is not + a minibuffer, insert the message in the echo area rather than at the + end of the buffer. + (completion-annotate-function): New variable. + (minibuffer-completion-help): Use it. + (completion--embedded-envvar-table): Environment vars are + always case-sensitive. + +2009-08-30 Glenn Morris <rgm@gnu.org> + + * progmodes/fortran.el (fortran-start-prog-re): New constant, extracted + from fortran-current-defun. + (fortran-beginning-of-subprogram): Be more precise about finding the + start, to avoid an infinite loop in end-of-defun. (Bug#4259) + (fortran-end-of-subprogram): Simplify. + (fortran-current-defun): Use fortran-start-prog-re. + +2009-08-29 Juanma Barranquero <lekktu@gmail.com> + + * subr.el (do-after-load-evaluation): Simplify. + +2009-08-29 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el (vc-print-log-internal): Move RCS/CVS specific code ... + + * vc-rcs.el (vc-rcs-print-log-cleanup): ... here. New function. + (vc-rcs-print-log): Use it. + + * vc-cvs.el (vc-cvs-print-log): Use vc-rcs-print-log-cleanup. + +2009-08-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * paths.el (abbrev-file-name): Move to abbrev.el. + * abbrev.el (abbrev-file-name): Move from paths.el. + Obey user-emacs-directory. + * calc/calc.el (calc-settings-file): Don't autoload and instead obey + user-emacs-directory. + * dos-fns.el (dos-reevaluate-defcustoms): Don't reevaluate + abbrev-file-name and calc-settings-file any more. + * startup.el (command-line): Recompute abbrev-file-name and + abbreviated-home-dir. + (normal-no-mouse-startup-screen): Improve the generic code and get rid + of the special code for when C-h bindings haven't been changed. + (display-startup-echo-area-message): Use with-current-buffer. + (command-line-1): Use a list of strings, rather than a list of lists + of strings for longopts. + + * files.el (get-free-disk-space): Use / for default-directory. + + * textmodes/ispell.el (ispell-accept-output, ispell-command-loop): + Use with-current-buffer. + + * emacs-lisp/bytecomp.el (byte-compile-const-symbol-p): + Recognize immutable variables like most-positive-fixnum. + (byte-compile-setq-default): Check and warn if trying to assign + to an immutable variable, or a non-variable. + + * progmodes/cc-vars.el (c-comment-continuation-stars): + * progmodes/cc-engine.el (c-looking-at-bos): + * progmodes/cc-cmds.el (c-toggle-auto-state) + (c-forward-into-nomenclature, c-backward-into-nomenclature) + (c-comment-line-break-function): Add version of obsolescence. + +2009-08-28 Juri Linkov <juri@jurta.org> + + * files.el (magic-fallback-mode-alist): Add ZIP magic number + associated with `archive-mode'. + + * image.el (image-type-header-regexps): Use only JPEG magic number + to determine JPEG images, and don't use `image-jpeg-p' because + Emacs can display non-JFIF non-Exif JPEG images. + +2009-08-28 Juanma Barranquero <lekktu@gmail.com> + + * arc-mode.el (archive-mode): + * emacs-lisp/re-builder.el (re-builder-unload-function): + Protect against the default value of `major-mode' being nil. + +2009-08-28 Juanma Barranquero <lekktu@gmail.com> + + * international/ucs-normalize.el (ucs-normalize-sort, quick-check-list): + Fix typos in docstrings. + + * progmodes/js.el (js--macro-decl-re): Doc fix. + (js--plain-method-re, js--split-name): Refloc docstring. + (js--class-styles, js--make-merged-item, js--splice-into-items): + Fix typos in docstrings; reflow docstrings. + (js--maybe-join, js--function-prologue-beginning, js--flush-caches) + (js--variable-decl-matcher, js--inside-pitem-p) + (js--parse-state-at-point, js--get-all-known-symbols) + (js--symbol-history, js-find-symbol, js--js-references) + (js--moz-interactor, js--js-encode-value, js--read-tab): + Fix typos in docstrings. + +2009-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/reftex.el (reftex-get-file-buffer-force): + * progmodes/verilog-mode.el (verilog-batch-execute-func): + * emulation/viper.el (viper-go-away, viper-set-hooks): + * emacs-lisp/re-builder.el (re-builder-unload-function): + * emacs-lisp/bytecomp.el (byte-compile-file): + * ses.el (ses-unload-function): + * hexl.el (hexl-find-file): + * files.el (normal-mode): + * ehelp.el (with-electric-help): + * autoinsert.el (auto-insert-alist): + * arc-mode.el (archive-mode): + Use (default-value 'major-mode) instead of default-major-mode. + + * textmodes/ispell.el (ispell-check-version, ispell-send-string): + * international/mule.el (load-with-code-conversion): + * emacs-lisp/debug.el (debug): + * ediff-vers.el (ediff-rcs-get-output-buffer): + * dired.el (dired-internal-noselect): Don't let-bind + default-major-mode around code that doesn't use it. + E.g. buffer creation via get-buffer-create doesn't use it. + +2009-08-28 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (all): Replace "'(lambda" by "(lambda". + (tramp-handle-file-local-copy): Unset `file-name-handler-alist' + when writing the temp file. Otherwise, epa-file gets confused. + (tramp-register-file-name-handlers): Make it a defun. Move also + `epa-file-handler' to the front of `file-name-handler-alist'. + +2009-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * net/tramp.el (tramp-shell-prompt-pattern): Allow a prompt to + start right after a ^M. + (tramp-root-regexp, tramp-completion-file-name-regexp-unified) + (tramp-completion-file-name-regexp-separate) + (tramp-completion-file-name-regexp-url): Use \\` and \\'. + (tramp-handle-file-attributes, tramp-set-file-uid-gid): + Don't modify last-coding-system-used by accident. + (tramp-completion-file-name-handler): Apply the checks here, + instead during registration. + (tramp-register-file-name-handlers) Renamed from + `tramp-register-file-name-handler'. Register both + `tramp-file-name-handler' and `tramp-completion-file-name-handler'. + (tramp-register-completion-file-name-handler): Remove. (Bug#4260) + +2009-08-28 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-mi.el (gdb-use-separate-io-buffer): + Remove variable ... + (gdb-init-1, gdb-display-separate-io-buffer) + (gdb-frame-separate-io-buffer, gdb-setup-windows): ... and + references to it. + (gdb-inferior-io-mode): Use make-comint-in-buffer. + (gdb-inferior-filter): Use comint-output-filter to stop + echoing and remove ^M characters. + +2009-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/viper-init.el (viper-restore-cursor-type): + * emulation/cua-base.el (cua--update-indications): + Replace default-cursor-type with (default-value 'cursor-type). + + * mail/sendmail.el (mail-recover-1): + * international/mule-diag.el (describe-current-coding-system-briefly) + (describe-current-coding-system): + * international/mule-cmds.el (select-safe-coding-system) + (select-message-coding-system) + (set-language-environment-coding-systems, set-locale-environment): + * hexl.el (hexl-insert-multibyte-char): + * dos-w32.el (find-buffer-file-type-coding-system): + * simple.el (what-cursor-position): + Replace uses of default-buffer-file-coding-system + with (default-value 'buffer-file-coding-system). + + * emacs-lisp/edebug.el (edebug-display, edebug-outside-excursion): + Replace uses of default-cursor-in-non-selected-windows + with (default-value 'cursor-in-non-selected-windows). + Use with-current-buffer. + + * mail/feedmail.el: Use CL macros. + (feedmail-run-the-queue, feedmail-send-it-immediately): + * dos-w32.el (find-buffer-file-type): Replace uses of + default-buffer-file-type with (default-value 'buffer-file-type). + +2009-08-28 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-list-entries, diary-goto-entry) + (diary-show-all-entries, diary-mark-entries, diary-make-entry): + Use default-value of major-mode rather than default-major-mode. + +2009-08-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * Makefile.in (update-elcfiles): Report left over elc files. + + * mail/mailalias.el (build-mail-aliases): Use with-temp-buffer, + expand-file-name and with-current-buffer. + (mail-get-names, mail-directory): Use with-current-buffer. + + * vc.el (vc-read-revision): New function. + (vc-version-diff, vc-merge): Use it. + +2009-08-27 Sam Steingold <sds@gnu.org> + + * simple.el (kill-do-not-save-duplicates): New user option. + (kill-new): When it is non-nil, and the new string is the same as + the latest kill, set replace to t to avoid duplicates in kill-ring. + +2009-08-27 Julian Scheid <julians37@gmail.com> (tiny change) + + * net/tramp.el (tramp-handle-process-file): Do not flush all + caches when `process-file-side-effects' is set. + (tramp-handle-vc-registered): Use `tramp-get-file-exists-command' + instead of `tramp-find-file-exists-command'. + Unset `process-file-side-effects'. + +2009-08-27 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): New method "rsyncc". + (top): Add completion function for "rsyncc". + (tramp-message-show-message): New defvar. + (tramp-message, tramp-error): Use it. + (tramp-do-copy-or-rename-file-directly): Extend check for direct + remote copying. + (tramp-do-copy-or-rename-file-out-of-band): Handle new + `tramp-methods' entry `copy-env' of "rsyncc". + (tramp-vc-registered-read-file-names): New defconst. + (tramp-vc-registered-file-names): New defvar. + (tramp-handle-vc-registered): Implement optimization strategy. + (tramp-run-real-handler): Add `tramp-vc-file-name-handler'. + (tramp-vc-file-name-handler): New defun. + (tramp-get-ls-command, tramp-get-test-command) + (tramp-get-file-exists-command, tramp-get-remote-ln) + (tramp-get-remote-perl, tramp-get-remote-stat) + (tramp-get-remote-id): Remove superfluous `with-current-buffer'. + + * net/tramp-cache.el (top): Autoload `tramp-time-less-p'. + (tramp-cache-inhibit-cache): Extend doc string. It allows also + timestamps. + (tramp-get-file-property): Check for timestamps in + `tramp-cache-inhibit-cache'. + (tramp-set-file-property): Write timestamp. + +2009-08-27 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) + + * language/japan-util.el (japanese-symbol-table): Add entries for + cp932-2-byte. + + * international/characters.el: Add category `j' to cp932-2-byte. + +2009-08-27 Kenichi Handa <handa@m17n.org> + + * international/fontset.el (build-default-fontset-data): New macro. + (setup-default-fontset): Use build-default-fontset-data for CJK, + tibetan, ethiopic, and ipa. + +2009-08-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * cus-start.el (default-major-mode): Customize `major-mode' instead. + (enable-multibyte-characters): Not customizable any more. + + * subr.el (default-mode-line-format, default-header-line-format) + (default-line-spacing, default-abbrev-mode, default-ctl-arrow) + (default-direction-reversed, default-truncate-lines) + (default-left-margin, default-tab-width, default-case-fold-search) + (default-left-margin-width, default-right-margin-width) + (default-left-fringe-width, default-right-fringe-width) + (default-fringes-outside-margins, default-scroll-bar-width) + (default-vertical-scroll-bar, default-indicate-empty-lines) + (default-indicate-buffer-boundaries, default-fringe-indicator-alist) + (default-fringe-cursor-alist, default-scroll-up-aggressively) + (default-scroll-down-aggressively, default-fill-column) + (default-cursor-type, default-buffer-file-type) + (default-cursor-in-non-selected-windows) + (default-buffer-file-coding-system, default-major-mode) + (default-enable-multibyte-characters): Mark as obsolete. + +2009-08-27 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-dir.el (vc-dir-update): Remove debug helper. + + * vc-cvs.el (vc-cvs-update-changelog): Fix typo. + +2009-08-26 Sam Steingold <sds@gnu.org> + + * simple.el (save-interprogram-paste-before-kill): New user option. + (kill-new): When `save-interprogram-paste-before-kill' is non-nil, + save the interprogram-paste into kill-ring before overriding it + with the Emacs kill. + +2009-08-26 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el (vc-trunk-p): Rename to vc-rcs-trunk-p and move to vc-rcs.el. + (vc-minor-part): Rename to vc-rcs-minor-part and move to vc-rcs.el. + (vc-default-previous-revision): Rename to vc-rcs-previous-revision + and move to vc-rcs.el. + (vc-default-next-revision): Rename to vc-rcs-next-revision and + move to vc-rcs.el. + (vc-cvs-update-changelog): Move to vc-cvs.el, use vc-call-backend. + (vc-rcs-update-changelog): Remove. + (vc-update-changelog-rcs2log): Rename to vc-rcs-update-changelog + and move to vc-rcs.el. + + * vc-rcs.el (vc-rcs-latest-on-branch-p, vc-rcs-checkin) + (vc-rcs-checkout, vc-rcs-rollback): Adjust for the vc-rcs-trunk-p + renaming. + (vc-rcs-trunk-p, vc-rcs-minor-part, vc-rcs-previous-revision) + (vc-rcs-next-revision, vc-rcs-update-changelog): Move here from + vc.el, renamed to be RCS specific. + + * vc-cvs.el (vc-cvs-previous-revision, vc-cvs-next-revision): + New functions. + (vc-cvs-update-changelog): Move here from vc.el. + + * vc-sccs.el (vc-sccs-previous-revision, vc-sccs-next-revision): + New functions. + +2009-08-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-lapcode): Fix up last change. + +2009-08-26 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el (vc-git-register): Use "git add" for directories. + (vc-git-stash, vc-git-stash-show): New functions. + (vc-git-extra-menu-map): Bind them. + + * vc-dir.el (vc-dir-node-directory, vc-dir-update): Get the parent + directory correctly in case the item is a directory itself. + + * vc.el: Document the desired behavior for reverted files in the + `added' state. + (vc-default-prettify-state-info): Remove function, unused. + + * vc-bzr.el (vc-bzr-prettify-state-info): Remove function, unused. + +2009-08-26 Glenn Morris <rgm@gnu.org> + + * bindings.el (standard-mode-line-format): Reposition dashes in + which-func entry. (Bug#4217) + + * files.el (enable-local-variables, enable-local-eval) + (safe-local-variable-values, safe-local-eval-forms): Mark as risky in + the defcustoms. + (auto-mode-alist, ignored-local-variables) + (save-some-buffers-action-alist): Move risky declarations to the + definitions. + (dabbrev-case-fold-search, dabbrev-case-replace, display-time-string) + (font-lock-defaults, format-alist, imenu--index-alist) + (imenu-generic-expression, input-method-alist, minor-mode-alist) + (mode-line-buffer-identification, mode-line-client, mode-line-modes) + (mode-line-modified, mode-line-mule-info, mode-line-position) + (mode-line-process, mode-line-remote, outline-level) + (parse-time-rules, rmail-output-file-alist) + (special-display-buffer-names, vc-mode): + Move risky declarations to the relevant files. + * bindings.el (mode-line-client, mode-line-mule-info, mode-line-remote) + (mode-line-modified, mode-line-process, mode-line-position) + (mode-line-modes, mode-line-buffer-identification, minor-mode-alist) + * font-core.el (font-lock-defaults): + * format.el (format-alist): + * vc-hooks.el (vc-mode): + * window.el (special-display-buffer-names): + * international/mule-cmds.el (input-method-alist): + Define riskiness here (dumped file) rather than in files.el. + * dabbrev.el (dabbrev-case-fold-search, dabbrev-case-replace): + * imenu.el (imenu-generic-expression, imenu--index-alist): + * outline.el (outline-level): + * time.el (display-time-string): + * calendar/parse-time.el (parse-time-rules): + * mail/rmailout.el (rmail-output-file-alist): + Autoload riskiness here, rather than placing in files.el. + +2009-08-26 Andreas Schwab <schwab@linux-m68k.org> + + * emacs-lisp/bytecomp.el (byte-compile-lapcode): Signal overflow. + +2009-08-25 Michael Albinus <michael.albinus@gmx.de> + + * simple.el (process-file-side-effects): New defvar. + + * dired-aux.el (dired-show-file-type): + * vc.el (vc-diff-internal): + * vc-arch.el (vc-arch-diff): + * vc-bzr.el (vc-bzr-sha1, vc-bzr-revision-completion-table): + * vc-cvs.el (vc-cvs-state, vc-cvs-diff, vc-cvs-revision-table): + * vc-git.el (vc-git-registered, vc-git-working-revision) + (vc-git-find-revision, vc-git-diff, vc-git-revision-table) + (vc-git--empty-db-p): + * vc-hooks.el (vc-user-login-name): + * vc-svn.el (vc-svn-registered, vc-svn-state) + (vc-svn-dir-extra-headers, vc-svn-find-revision): + * progmodes/grep.el (grep-probe): Let-bind + `process-file-side-effects' with nil. + + * net/dbus.el (dbus-ping): Add optional parameter TIMEOUT. + + * net/tramp-gvfs.el (top): Use timeout of 100 msec pinging GVFS + daemon. Replace ping by checking for running service for bluez + and zeroconf. (Bug#4239) + +2009-08-25 Kevin Ryde <user42@zip.com.au> + + * net/dig.el (dig): Add autoload cookie. + +2009-08-25 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-eval): Fix test for cl in + load-history for absolute file-names. + (byte-compile-file-form-require): Warn about use of the cl package. + + * format.el (format-alist): Doc fix. + + * play/bubbles.el (top-level): Don't require cl at run-time. + + * progmodes/verilog-mode.el (top-level): Don't require lucid (and hence + run-time cl). + +2009-08-24 Dmitry Dzhus <dima@sphinx.net.ru> + + * progmodes/gdb-mi.el (gdb-mapcar*): Replacement for `mapcar*' + from cl package. + (gdb-table-add-row, gdb-table-string): Use `gdb-mapcar*'. + +2009-08-24 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-alg.el (math-trig-rewrite) + (math-hyperbolic-trig-rewrite): New functions. + (calc-simplify): Simplify trig functions when asked. + +2009-08-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * diff-mode.el (diff-find-source-location): Avoid goto-line. + +2009-08-24 Kenichi Handa <handa@m17n.org> + + * language/ind-util.el (mapthread): Delete it. + (combinatorial): New function. + (indian--puthash-cv): Use combinatorial instead of mapthread. + +2009-08-22 Kevin Ryde <user42@zip.com.au> + + * emacs-lisp/checkdoc.el (checkdoc-force-history-flag) + (checkdoc-arguments-in-order-flag): Add safe-local-variable booleanp. + (checkdoc-symbol-words): Add safe-local-variable for list of strings. + Clarify docstring that the value is strings not symbols. + (checkdoc-list-of-strings-p): New function. + +2009-08-22 Glenn Morris <rgm@gnu.org> + + * files.el (auto-mode-alist): + * hippie-exp.el (he-concat-directory-file-name): + * lpr.el (lpr-windows-system, printer-name): + * ls-lisp.el (ls-lisp-emulation, ls-lisp-use-insert-directory-program): + * ps-print.el (ps-windows-system): + * startup.el (command-line): + * emulation/viper-ex.el (viper-glob-function): + * international/mule-cmds.el (set-language-environment-coding-systems): + * net/ange-ftp.el (ange-ftp-write-region): + * obsolete/fast-lock.el (fast-lock-cache-name): + Remove code for defunct system-types emx, macos, mswindows, next-mach, + unisoft-unix, vax-vms, win32, w32. + + * calendar/diary-lib.el (diary-mark-entries-1): Only mark all days of a + given name if the pattern is not more specific. + + * calendar/lunar.el (lunar-phase-names): New option. + (lunar-phase): Doc fix. + (lunar-cycles-per-year): New constant. + (lunar-index): New function. + (lunar-phase-list, diary-lunar-phases): Use lunar-index. + (lunar-phase-name): Use lunar-phase-names. + (calendar-lunar-phases): Use format. + (lunar-new-moon-on-or-after): Use lunar-cycles-per-year. + + * progmodes/cperl-mode.el (cperl-imenu-name-and-position): + Copy imenu-example--name-and-position function here for own use. + (cperl-xsub-scan): Use cperl-imenu-name-and-position. + + * bs.el (bs--redisplay): + * cus-edit.el (custom-redraw): + * ibuffer.el (ibuffer-bury-buffer): + * server.el (server-goto-line-column): + * startup.el (command-line-1): + * strokes.el (strokes-xpm-for-stroke): + * term.el (term-display-buffer-line): + * view.el (View-goto-line): + * calc/calc.el (calc-do, calc-trail-buffer): + * play/gamegrid.el (gamegrid-add-score-insecure): + * progmodes/ada-mode.el (ada-compile-goto-error): + * progmodes/ada-xref.el (ada-xref-find-in-modified-ali): + (ebrowse-select-1st-to-9nth): + * progmodes/cperl-mode.el (cperl-time-fontification): + * progmodes/ebrowse.el (ebrowse-toggle-file-name-display) + * progmodes/gud.el (gud-display-line): + (idlwave-shell-display-line): + * progmodes/idlw-shell.el (idlwave-shell-goto-frame) + * progmodes/make-mode.el (makefile-browser-toggle): + (vhdl-speedbar-port-copy, vhdl-compose-components-package): + * progmodes/vhdl-mode.el (vhdl-speedbar-find-file) + * textmodes/picture.el (picture-draw-rectangle): + * textmodes/reftex-index.el (reftex-index-goto-letter): + (reftex-select-jump-to-previous): + * textmodes/reftex-sel.el (reftex-find-start-point) + * textmodes/reftex-toc.el (reftex-toc, reftex-toc-restore-region): + (rst-straighten-deco-spacing, rst-section-tree, rst-toc): + * textmodes/rst.el (rst-promote-region, rst-straighten-decorations) + * textmodes/tex-mode.el (tex-compilation-parse-errors): + * textmodes/two-column.el (2C-associated-buffer): + Use forward-line rather than goto-line. + + * emulation/vi.el (vi-goto-line): Don't warn about non-interactive + goto-line. + + * international/ucs-normalize.el (nfd, decomposition-translation-alist) + (decomposition-char-recursively, alist-list-to-vector, quick-check-list) + (quick-check-list-to-regexp): Declare. + + * progmodes/make-mode.el (makefile-browser-insert-selection): + Use goto-char rather than goto-line. + + * progmodes/prolog.el (compilation-error-regexp-alist) + (compilation-forget-errors): Declare. + +2009-08-22 Juri Linkov <juri@jurta.org> + + * progmodes/grep.el (lgrep, rgrep): At the beginning + set `dir' to `default-directory' unless `dir' is a non-nil + readable directory. (Bug#4052) + (lgrep, rgrep): Change a weird way to report an error + from using `read-string' to using `error'. + Instead of using interactive arguments in the function body, + add new argument `confirm'. 2009-08-21 Stefan Monnier <monnier@iro.umontreal.ca> @@ -583,18 +2369,16 @@ * progmodes/cperl-mode.el (cperl-electric-paren): Don't expand abbrev (Bug#3943). -2007-10-08 Ilya Zakharevich <ilyaz@cpan.org> +2009-08-16 Ilya Zakharevich <ilyaz@cpan.org> * progmodes/cperl-mode.el: Merge upstream 6.2. (cperl-mode-syntax-table): Modify syntax entry for ["'`]. (cperl-forward-re): Check cperl-brace-recursing. (cperl-highlight-charclass): New function. (cperl-find-pods-heres): Use it. - (cperl-fill-paragraph): Synch to save-excursion placement used - upstream. + (cperl-fill-paragraph): Synch to save-excursion placement used upstream. (cperl-beautify-regexp-piece): Fix column calculation. - (cperl-make-regexp-x): Handle case where point is between "q" and - "rs". + (cperl-make-regexp-x): Handle case where point is between "q" and "rs". (cperl-beautify-level): Don't process entire regexp. (cperl-build-manpage, cperl-perldoc): Bind Man-switches before calling man. @@ -633,7 +2417,7 @@ * whitespace.el (whitespace-style): Doc fix (Bug#3661). -2009-08-16 Jan Seeger <jan.seeger@thenybble.de> (tiny change) +2009-08-16 Jan Seeger <jan.seeger@thenybble.de> (tiny change) * calendar/parse-time.el (parse-time-string-chars): Compute using character classes, to handle non-ascii characters (Bug#3190). @@ -699,7 +2483,7 @@ * progmodes/hideshow.el (hs-special-modes-alist): Add js-mode entry. 2009-08-14 Daniel Colascione <dan.colascione@gmail.com> - Karl Landstrom <karl.landstrom@brgeight.se> + Karl Landstrom <karl.landstrom@brgeight.se> * progmodes/js.el: New file. @@ -784,9 +2568,9 @@ (gdb-place-breakpoints, gdb-get-location): Rewritten without `goto-line'. (gdb-invalidate-disassembly): Do not refresh upon receiving - 'update signal. Instead, update all disassembly buffers only after + 'update signal. Instead, update all disassembly buffers only after threads list. - (gdb): Send -target-detach when buffer is killed (#3794). + (gdb): Send -target-detach when buffer is killed (Bug#3794). (gdb-starting): Moved -data-list-register-names... (gdb-stopped): ...here so it's sent when first thread stops. (gdb-registers-handler-custom): Do nothing if register names are @@ -796,7 +2580,7 @@ from `gdb-mi.el' to avoid extra tangling. * progmodes/gdb-mi.el (gdb-gud-context-call): Reverting previous - change which breaks `gud-def' definitions. used in `gdb'. + change which breaks `gud-def' definitions used in `gdb'. (gdb-update-gud-running): No extra fuss for updating frame number. 2009-08-10 Stefan Monnier <monnier@iro.umontreal.ca> @@ -854,7 +2638,7 @@ (gdb-control-current-thread): Interactive setters for `gdb-gud-control-all-threads' to use in menu. (gdb-show-run-p): Show «Go» when process is not active. - (gud-tool-bar-map): Add non-stop/A,T indicator. Uses + (gud-tool-bar-map): Add non-stop/A,T indicator. Uses gud/thread.xpm and gud/all.xpm. 2009-08-08 Yoni Rabkin <yoni@rabkins.net> @@ -955,8 +2739,7 @@ 2009-08-04 Dmitry Dzhus <dima@sphinx.net.ru> * progmodes/gdb-mi.el (gdb-frame-number): Initialize with nil. - (gdb-overlay-arrow-position): Renamed to - `gdb-disassembly-position'. + (gdb-overlay-arrow-position): Rename to `gdb-disassembly-position'. (gdb-overlay-arrow-position, gdb-thread-position) (gdb-disassembly-position): Declare variables. (gdb-wait-for-pending): Function now. @@ -1032,8 +2815,8 @@ (gdb-wait-for-pending): New macro to deal with congestion problems. (gdb-breakpoints-list-handler-custom): Don't fail on pending breakpoints. - (gdb-invalidate-disassembly): Use 'fullname instead of 'file. This - fixes problem similar to one described in bug 3947. + (gdb-invalidate-disassembly): Use 'fullname instead of 'file. + This fixes problem similar to one described in bug 3947. (gud-menu-map): More menu items. (gdb-init-1): Reset `gdb-thread-number' to nil. @@ -1050,7 +2833,7 @@ customization options. (gdb-gud-context-command, gdb-gud-context-call): New wrappers for GUD commands. - (gdb): `gud-def' definitions changed to use `gdb-gud-context-call' + (gdb): `gud-def' definitions changed to use `gdb-gud-context-call'. (gdb-init-1): Activate non-stop mode if `gdb-non-stop' is enabled. (gdb-setq-thread-number, gdb-update-gud-running): New functions to set `gdb-thread-number' and update `gud-running' properly. @@ -1088,7 +2871,7 @@ (gdb-get-subscribers, gdb-emit-signal, gdb-buf-publisher) (gdb-update): We now store all GDB buffers in a list so that they can be updated by traversing a list instead of calling invalidate - triggers explicitly + triggers explicitly. (def-gdb-trigger-and-handler): New macro to define trigger-handler pair for GDB buffer. (gdb-stack-buffer-name): Add thread information. @@ -1098,12 +2881,12 @@ (def-gdb-thread-buffer-simple-command) (gdb-display-stack-for-thread, gdb-display-locals-for-thread) (gdb-display-registers-for-thread, gdb-frame-stack-for-thread) - (gdb-frame-locals-for-thread, gdb-frame-registers-for-thread): New - commands which show buffers bound to thread. + (gdb-frame-locals-for-thread, gdb-frame-registers-for-thread): + New commands which show buffers bound to thread. (gdb-stack-list-locals-regexp): Removed unused regexp. - * progmodes/gdb-mi.el (gdb-breakpoints-buffer-name,gdb-locals-buffer-name) - (gdb-registers-buffer-name) + * progmodes/gdb-mi.el (gdb-breakpoints-buffer-name) + (gdb-locals-buffer-name, gdb-registers-buffer-name) (gdb-memory-buffer-name, gdb-stack-buffer-name): Do not switch to (gud-comint-buffer) in *-buffer-name functions because (gdb-get-target-string) already does that. @@ -1114,9 +2897,9 @@ (gdb-thread-number): New variable. (gdb-current-context-command): New macro which adds --thread option to command. - (gdb-threads-mode-map): Select thread with SPC + (gdb-threads-mode-map): Select thread with SPC. (gdb-thread-list-handler-custom): Mark current thread with overlay - arrow. Synchronize GDB thread and Emacs thread. + arrow. Synchronize GDB thread and Emacs thread. (gdb-select-thread): New command which selects current thread. (gdb-invalidate-frames, gdb-invalidate-locals) (gdb-invalidate-registers): Use --thread option. @@ -1138,14 +2921,14 @@ 2009-08-03 Michael Albinus <michael.albinus@gmx.de> - * net/tramp.el (tramp-rfn-eshadow-update-overlay-regexp) New - defconst. + * net/tramp.el (tramp-rfn-eshadow-update-overlay-regexp): + New defconst. (tramp-rfn-eshadow-update-overlay): Use it. (Bug#4004) 2009-08-02 Kevin Ryde <user42@zip.com.au> - * net/newst-backend.el (newsticker--raw-url-list-defaults): Update - freshmeat link. Delete newsforge.com as it seems gone. + * net/newst-backend.el (newsticker--raw-url-list-defaults): + Update freshmeat link. Delete newsforge.com as it seems gone. 2009-08-02 Chong Yidong <cyd@stupidchicken.com> @@ -1156,7 +2939,7 @@ * help-fns.el (describe-variable): Treat list return values from dir-locals-find-file properly (Bug#4005). -2009-08-02 Julian Scheid <julians37@googlemail.com> (tiny change) +2009-08-02 Julian Scheid <julians37@googlemail.com> (tiny change) * net/tramp.el (tramp-debug-message): Print also microseconds. @@ -1177,7 +2960,7 @@ 2009-08-02 Jason Rumney <jasonr@gnu.org> * minibuffer.el (read-file-name): Treat confirm options to - MUSTMATCH as nil when invoking x-file-dialog. (Bug#3969) + MUSTMATCH as nil when invoking x-file-dialog. (Bug#3969) 2009-08-02 Chong Yidong <cyd@stupidchicken.com> @@ -1214,7 +2997,7 @@ * calc/calc.el (calc-mode-map): Add keybinding for `calc-transpose-lines'. -2009-07-29 Vincent Belaïche <vincent.belaiche@gmail.com> +2009-07-29 Vincent Belaïche <vincent.belaiche@gmail.com> * calc/calc-misc.el (calc-transpose-lines): New function. @@ -1229,7 +3012,7 @@ * vc-git.el (vc-git-checkin): Fix typo. -2009-07-28 Steve Yegge <steve.yegge@gmail.com>> +2009-07-28 Steve Yegge <steve.yegge@gmail.com> * progmodes/js2-mode.el: New file. @@ -1289,8 +3072,7 @@ 2009-07-24 Kenichi Handa <handa@m17n.org> * international/characters.el: Fix setting of category ?C, ?|, ?K, - and ?H. Fix setting of case for Latin Extended and Greek - Extended. + and ?H. Fix setting of case for Latin Extended and Greek Extended. (build-unicode-category-table): Fix range checks. 2009-07-24 Dan Nicolaescu <dann@ics.uci.edu> @@ -1536,7 +3318,7 @@ 2009-07-18 Alan Mackenzie <acm@muc.de> - * progmodes/cc-mode.el (c-before-hack-hook), + * progmodes/cc-mode.el (c-before-hack-hook) (c-postprocess-file-styles): Give invocation of `c-set-style' DONT-OVERRIDE parameter of t. Already set style variables will thus not be overridden by style settings given by `c-file-syle'. @@ -1667,7 +3449,7 @@ copy-region-as-kill before setting the mark, to let select-active-regions work. -2009-06-28 David De La Harpe Golden <david@harpegolden.net> +2009-07-15 David De La Harpe Golden <david@harpegolden.net> * simple.el (deactivate-mark): If select-active-regions is non-nil, copy the selection data into a string. @@ -1717,12 +3499,12 @@ 2009-07-13 Jan Djärv <jan.h.d@swipnet.se> - * term/ns-win.el (x-select-font): defailias x-select-font to + * term/ns-win.el (x-select-font): defalias x-select-font to ns-popup-font-panel instead of generate-fontset-menu. 2009-07-12 Eli Zaretskii <eliz@gnu.org> - * desktop.el (desktop-buffers-not-to-save): Remove ".log". (Bug#3833) + * desktop.el (desktop-buffers-not-to-save): Remove ".log". (Bug#3833) 2009-07-12 Peter Jolly <peter@jollys.org> (tiny change) @@ -1846,7 +3628,7 @@ * progmodes/gdb-mi.el (gdb-init-1): Set mode name for disassembly buffer properly. (gdb-breakpoints-list-handler-custom): Replacement for - `gdb-break-list-handler'. Using real parser instead of regexps + `gdb-break-list-handler'. Using real parser instead of regexps now. (gdb-place-breakpoints): Replacement for `gdb-break-list-custom'. Use `gdb-breakpoints-list' instead of parsing breakpoints buffer @@ -1858,14 +3640,14 @@ disassembly buffer. (gdb-toggle-breakpoint, gdb-delete-breakpoint) (gdb-goto-breakpoint): Using `gdb-breakpoint' text properties - instead of parsing breakpoints buffer. Fixed old menu references + instead of parsing breakpoints buffer. Fixed old menu references in `gud-menu-map'. * fadr.el: Remove. - * progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el + * progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el. (gdb-memory-address): New variable which holds top address of - memory page shown in memory buffer + memory page shown in memory buffer. (gdb-memory-repeat-count, gdb-memory-format, gdb-memory-unit): New customization variables. New functions: @@ -1904,13 +3686,13 @@ * net/tramp.el (tramp-handle-write-region): Flush file properties in case of short track. -2009-07-07 Michael McNamara <mac@mail.brushroad.com> +2009-07-06 Michael McNamara <mac@mail.brushroad.com> * verilog-mode.el (verilog-error-regexp-emacs-alist): Coded custom representation of verilog error regular expressions to work with Emacs-22's new format. (verilog-error-regexp-xemacs-alist): Coded custom representation - of verilog error regular expressions to work with XEmacs format + of verilog error regular expressions to work with XEmacs format. (verilog-error-regexp-add-xemacs): Hook routine to install verilog error recognition into XEmacs. (verilog-error-regexp-add-emacs): Hook routine to install verilog @@ -1935,7 +3717,7 @@ * subr.el (eval-after-load): Doc fix. -2009-07-06 Vincent Belaïche <vincent.belaiche@gmail.com> +2009-07-06 Vincent Belaïche <vincent.belaiche@gmail.com> * calc/calc-embed.el (calc-embedded-make-info): Don't force when `calc-embedded-word' is called twice. @@ -1949,7 +3731,7 @@ * dired-aux.el (dired-show-file-type): Handle remote files. -2009-03-22 Jari Aalto <jari.aalto@cante.net> +2009-07-05 Jari Aalto <jari.aalto@cante.net> * desktop.el (desktop-globals-to-save): Add file-name-history (Bug#2750). @@ -2157,7 +3939,7 @@ had been). (verilog-leap-to-case-head): Support priority/unique case statements. (verilog-auto-lineup): Rework to give users radio buttons to - select the various styles of automatic lineup + select the various styles of automatic lineup. (verilog-error-regexp-alist): Rework to support the XEmacs style of error regular expressions from compilers, lint tools & simulators. Note that GNU Emacs has made it impossible for a mode @@ -2181,7 +3963,7 @@ (verilog-mode): Alter the definition of verilog-font-lock-defualts to avoid circular calls if syntax-ppss is a function (as is the case now in 22.x GNU Emacs) as that function would sometimes call - itself, leading to (nearly) infinite recursion + itself, leading to (nearly) infinite recursion. (verilog-ovm-begin-re, verilog-ovm-end-re) (verilog-ovm-statement-re, verilog-leap-to-head) (verilog-backward-token): Add support for OVM macros. Some are @@ -2189,9 +3971,9 @@ and end. (verilog-defun-level-not-generate-re, verilog-defun-level-re) (verilog-defun-level-generate-only-re): Really fix the defun-list - compilation issue + compilation issue. (verilog-calc-1) (verilog-beg-of-statement): Enhance support for - coverpoint, constraint and cross statements + coverpoint, constraint and cross statements. (verilog-defun-level-list, verilog-generate-defun-level-list) (verilog-all-defun-level-list): Redo these specifications - it is too hard to support eval-when compile aggregation of lists also @@ -2202,7 +3984,7 @@ without load. (verilog-beg-block-re-ordered): Support indenting virtual/protected tasks and functions. - (verilog-defun-level-list,verilog-in-generate-region-p) + (verilog-defun-level-list, verilog-in-generate-region-p) (verilog-backward-ws&directives, verilog-calc-1): Speed up indentation of some module items (generate items). (verilog-forward-sexp, verilog-leap-to-head): Support stepping @@ -2242,7 +4024,7 @@ (verilog-read-sub-decls-expr, verilog-read-sub-decls-line) (verilog-read-sub-decls-sig, verilog-symbol-detick-text): Fix dotted nets {a.b,c.d} and excaped identifiers being mis-included - in AUTOINOUT. Reported by Matthew Lovell. + in AUTOINOUT. Reported by Matthew Lovell. (verilog-read-always-signals-recurse): Fix AUTORESET "if (a<=b)" causing use of <= assignments. Reported by Alex Reed. (verilog-read-decls): Fix triand, trior, wand, wor to be @@ -2254,13 +4036,13 @@ (verilog-sk-header-tmpl): Fix verilog-header inserting error on Windows systems. Reported by Michael Potts. (verilog-read-module-name): Fix AUTOINST when the child module - declaration's name is a tick define. Reported by Elliot Mednick. + declaration's name is a tick define. Reported by Elliot Mednick. (verilog-read-decls): Fix V2K parameter bit subscripts getting - passed to next parameter's definition. Reported by Bruce T. + passed to next parameter's definition. Reported by Bruce T. (verilog-read-decls): Fix detecting "parameter int" when using AUTOINSTPARAM. Reported by Bruce T. (verilog-goto-defun): Fix goto not finding modules unless first - perform a verilog-auto expansion. Suggested by Lawrence Butcher. + perform a verilog-auto expansion. Suggested by Lawrence Butcher. (verilog-mode): Expand -f flag arguments on entry to mode so verilog-goto-defun will work. Reported by Lawrence Butcher. (verilog-getopt): Expand environment variables in -f file @@ -2324,10 +4106,10 @@ 2009-06-25 AgustÃn MartÃn <agustin.martin@hispalinux.es> * textmodes/ispell.el: Add `ispell-looking-back' XEmacs - compatibility function for `looking-back' + compatibility function for `looking-back'. * textmodes/flyspell.el (sgml-mode-flyspell-verify): - Use `ispell-looking-back' + Use `ispell-looking-back'. 2009-06-24 Michael Albinus <michael.albinus@gmx.de> @@ -2362,7 +4144,7 @@ * cus-start.el: Add entry for `recenter-redisplay'. -2009-06-22 Dan Nicolaescu <dann@ics.uci.edu> +2009-06-23 Dan Nicolaescu <dann@ics.uci.edu> * vc-hooks.el (vc-stay-local-p, vc-state, vc-working-revision): Add an optional argument for the backend, use it instead of diff --git a/lisp/Makefile.in b/lisp/Makefile.in index c75e2dac12c..60eb7a319dc 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -1,6 +1,6 @@ # Maintenance productions for the Lisp directory -# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -# 2008, 2009 Free Software Foundation, Inc. +# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +# 2009 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -91,16 +91,15 @@ setwins_almost=subdirs=`(cd $$wd; find . -type d -print)`; \ esac; \ done -# Find all subdirectories except `cedet' +# Find all subdirectories in which we might want to create subdirs.el -setwins_nocedet=subdirs=`(cd $$wd; find . -type d -print)`; \ +setwins_for_subdirs=subdirs=`(cd $$wd; find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */cedet* ) ;; \ *) wins="$$wins $$wd/$$file" ;; \ esac; \ done - # `compile-main' tends to be slower than `recompile' but can be parallelized # with "make -j" and results in more deterministic compilation warnings. # cus-load and finder-inf are not explicitly requested by anything, so @@ -143,7 +142,8 @@ finder-data: doit # are identified by being the value of `generated-autoload-file'. autoloads: $(LOADDEFS) doit chmod +w $(lisp)/ps-print.el $(lisp)/emulation/tpu-edt.el \ - $(lisp)/emacs-lisp/cl-loaddefs.el + $(lisp)/emacs-lisp/cl-loaddefs.el $(lisp)/mail/rmail.el \ + $(lisp)/dired.el $(lisp)/ibuffer.el wd=$(lisp); $(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins @@ -153,7 +153,7 @@ autoloads: $(LOADDEFS) doit $(lisp)/subdirs.el: $(MAKE) $(MFLAGS) update-subdirs update-subdirs: doit - wd=$(lisp); $(setwins_nocedet); \ + wd=$(lisp); $(setwins_for_subdirs); \ for file in $$wins; do \ $(srcdir)/update-subdirs $$file; \ done; @@ -193,6 +193,12 @@ update-elclist: chmod +w $(lisp)/Makefile.in; \ mv -f temp-elcfiles $(lisp)/Makefile.in; \ fi + -(COLLATE=C ls $(lisp)/*.elc $(lisp)/*/*.elc | sed 's/elc$$/el/'; \ + COLLATE=C ls $(lisp)/*.el $(lisp)/*/*.el; \ + COLLATE=C ls $(lisp)/*.el $(lisp)/*/*.el) | \ + sort | uniq -u | while read extra; do \ + echo "Found left over byte-compiled file: $${extra}c !!" ;\ + done ## Explicitly list the .elc files, for the sake of parallel builds. ## http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-05/msg00016.html @@ -842,6 +848,7 @@ ELCFILES = \ $(lisp)/net/hmac-def.elc \ $(lisp)/net/hmac-md5.elc \ $(lisp)/net/imap.elc \ + $(lisp)/net/imap-hash.elc \ $(lisp)/net/ldap.elc \ $(lisp)/net/mairix.elc \ $(lisp)/net/net-utils.elc \ @@ -872,6 +879,7 @@ ELCFILES = \ $(lisp)/net/tramp-ftp.elc \ $(lisp)/net/tramp-gvfs.elc \ $(lisp)/net/tramp-gw.elc \ + $(lisp)/net/tramp-imap.elc \ $(lisp)/net/tramp-smb.elc \ $(lisp)/net/tramp-uu.elc \ $(lisp)/net/tramp.elc \ @@ -1289,9 +1297,11 @@ ELCFILES = \ # (e.g. src/Makefile.in may have a dependency for ../lisp/foo.elc where we # only know of $(lisp)/foo.elc). So instead we provide a direct way for # src/Makefile.in to rebuild a particular Lisp file, no questions asked. +# Use byte-compile-refresh-preloaded to try and work around some of +# the most common problems of not bootstrapping from a clean state. compile-onefile: @echo Compiling $(THEFILE) - @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $(THEFILE) + @$(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $(THEFILE) # Files MUST be compiled one by one. If we compile several files in a # row (i.e., in the same instance of Emacs) we can't make sure that diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 4a2c57ddd60..f45f4c1860c 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -27,7 +27,6 @@ ;; Todo: -;; - Make abbrev-file-name obey user-emacs-directory. ;; - Cleanup name space. ;;; Code: @@ -39,6 +38,12 @@ :link '(custom-manual "(emacs)Abbrevs") :group 'abbrev) +(defcustom abbrev-file-name + (locate-user-emacs-file "abbrev_defs" ".abbrev_defs") + "Default name of file from which to read abbrevs." + :initialize 'custom-initialize-delay + :type 'file) + (defcustom only-global-abbrevs nil "Non-nil means user plans to use global abbrevs only. This makes the commands that normally define mode-specific abbrevs diff --git a/lisp/add-log.el b/lisp/add-log.el index 30c9520a66d..c3e8364f1f1 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -1,7 +1,8 @@ ;;; add-log.el --- change log maintenance commands for Emacs ;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: tools @@ -180,64 +181,59 @@ Note: The search is conducted only within 10%, at the beginning of the file." "Face used to highlight dates in date lines." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-date-face 'face-alias 'change-log-date) +(define-obsolete-face-alias 'change-log-date-face 'change-log-date "22.1") (defface change-log-name '((t (:inherit font-lock-constant-face))) "Face for highlighting author names." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-name-face 'face-alias 'change-log-name) +(define-obsolete-face-alias 'change-log-name-face 'change-log-name "22.1") (defface change-log-email '((t (:inherit font-lock-variable-name-face))) "Face for highlighting author email addresses." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-email-face 'face-alias 'change-log-email) +(define-obsolete-face-alias 'change-log-email-face 'change-log-email "22.1") (defface change-log-file '((t (:inherit font-lock-function-name-face))) "Face for highlighting file names." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-file-face 'face-alias 'change-log-file) +(define-obsolete-face-alias 'change-log-file-face 'change-log-file "22.1") (defface change-log-list '((t (:inherit font-lock-keyword-face))) "Face for highlighting parenthesized lists of functions or variables." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-list-face 'face-alias 'change-log-list) +(define-obsolete-face-alias 'change-log-list-face 'change-log-list "22.1") (defface change-log-conditionals '((t (:inherit font-lock-variable-name-face))) "Face for highlighting conditionals of the form `[...]'." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-conditionals-face 'face-alias 'change-log-conditionals) +(define-obsolete-face-alias 'change-log-conditionals-face + 'change-log-conditionals "22.1") (defface change-log-function '((t (:inherit font-lock-variable-name-face))) "Face for highlighting items of the form `<....>'." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-function-face 'face-alias 'change-log-function) +(define-obsolete-face-alias 'change-log-function-face + 'change-log-function "22.1") (defface change-log-acknowledgement '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." :version "21.1" :group 'change-log) -;; backward-compatibility alias -(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) +(define-obsolete-face-alias 'change-log-acknowledgement-face + 'change-log-acknowledgement "22.1") (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") @@ -1033,8 +1029,10 @@ Runs `change-log-mode-hook'. indent-tabs-mode t tab-width 8 show-trailing-whitespace t) - (set (make-local-variable 'fill-paragraph-function) - 'change-log-fill-paragraph) + (set (make-local-variable 'fill-forward-paragraph-function) + 'change-log-fill-forward-paragraph) + ;; Make sure we call `change-log-indent' when filling. + (set (make-local-variable 'fill-indent-according-to-mode) t) ;; Avoid that filling leaves behind a single "*" on a line. (add-hook 'fill-nobreak-predicate '(lambda () @@ -1090,23 +1088,12 @@ file were isearch was started." (cadr (member (file-name-nondirectory (buffer-file-name buffer)) files)))))) -;; It might be nice to have a general feature to replace this. The idea I -;; have is a variable giving a regexp matching text which should not be -;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". -;; But I don't feel up to implementing that today. -(defun change-log-fill-paragraph (&optional justify) - "Fill the paragraph, but preserve open parentheses at beginning of lines. -Prefix arg means justify as well." - (interactive "P") - (let ((end (progn (forward-paragraph) (point))) - (beg (progn (backward-paragraph) (point))) - ;; Add lines starting with whitespace followed by a left paren or an +(defun change-log-fill-forward-paragraph (n) + "Cut paragraphs so filling preserves open parentheses at beginning of lines." + (let (;; Add lines starting with whitespace followed by a left paren or an ;; asterisk. - (paragraph-start (concat paragraph-start "\\|\\s *\\(?:\\s(\\|\\*\\)")) - ;; Make sure we call `change-log-indent'. - (fill-indent-according-to-mode t)) - (fill-region beg end justify) - t)) + (paragraph-start (concat paragraph-start "\\|\\s *\\(?:\\s(\\|\\*\\)"))) + (forward-paragraph n))) (defcustom add-log-current-defun-header-regexp "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]" diff --git a/lisp/allout.el b/lisp/allout.el index 98f729c93a9..bead3bde7f7 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1,7 +1,7 @@ ;;; allout.el --- extensive outline mode for use alone and with other modes -;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> @@ -87,15 +87,14 @@ ;; Most of the requires here are for stuff covered by autoloads. ;; Since just byte-compiling doesn't trigger autoloads, so that ;; "function not found" warnings would occur without these requires. - (progn - (require 'pgg) - (require 'pgg-gpg) - (require 'overlay) - ;; `cl' is required for `assert'. `assert' is not covered by a standard - ;; autoload, but it is a macro, so that eval-when-compile is sufficient - ;; to byte-compile it in, or to do the require when the buffer evalled. - (require 'cl) - )) + (require 'pgg) + (require 'pgg-gpg) + (require 'overlay) + ;; `cl' is required for `assert'. `assert' is not covered by a standard + ;; autoload, but it is a macro, so that eval-when-compile is sufficient + ;; to byte-compile it in, or to do the require when the buffer evalled. + (require 'cl) + ) ;;;_* USER CUSTOMIZATION VARIABLES: @@ -2205,10 +2204,10 @@ internal functions use this feature cohesively bunch changes." (concat "Modify concealed text? (\"no\" just aborts," " \\[keyboard-quit] also reconceals) ")))) (progn (goto-char start) - (error "Concealed-text change refused."))) + (error "Concealed-text change refused"))) (quit (allout-flag-region ol-start ol-end nil) (allout-flag-region ol-start ol-end t) - (error "Concealed-text change abandoned, text reconcealed.")))) + (error "Concealed-text change abandoned, text reconcealed")))) (goto-char start)))) ;;;_ > allout-before-change-handler (beg end) (defun allout-before-change-handler (beg end) @@ -6334,7 +6333,7 @@ of the availability of a cached copy." nil) t)) (progn (pgg-remove-passphrase-from-cache cache-id t) - (error "Wrong passphrase.")))) + (error "Wrong passphrase")))) ;; No verifier string -- force confirmation by repetition of ;; (new) passphrase: ((or fetch-pass (not cached)) @@ -6356,7 +6355,7 @@ of the availability of a cached copy." ;; recurse to this routine: (pgg-read-passphrase prompt-sans-hint cache-id t)) (pgg-remove-passphrase-from-cache cache-id t) - (error "Confirmation failed.")))))))) + (error "Confirmation failed")))))))) ;;;_ > allout-encrypted-topic-p () (defun allout-encrypted-topic-p () "True if the current topic is encryptable and encrypted." diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 66f128a2e83..e343f560169 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -604,7 +604,7 @@ property of `ansi-color-faces-vector' and `ansi-color-names-vector'." ANSI-CODE is used as an index into the vector." (condition-case nil (aref ansi-color-map ansi-code) - ('args-out-of-range nil))) + (args-out-of-range nil))) (defun ansi-color-get-face (escape-seq) "Create a new face by applying all the parameters in ESCAPE-SEQ. diff --git a/lisp/apropos.el b/lisp/apropos.el index ca9be2f36f8..f66ba95400a 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -649,8 +649,19 @@ thus be found in `load-history'." (apropos-documentation-property symbol 'widget-documentation t)) (when (facep symbol) - (apropos-documentation-property - symbol 'face-documentation t)) + (let ((alias (get symbol 'face-alias))) + (if alias + (if (facep alias) + (format "%slias for the face `%s'." + (if (get symbol 'obsolete-face) + "Obsolete a" + "A") + alias) + ;; Never happens in practice because fails + ;; (facep symbol) test. + "(alias for undefined face)") + (apropos-documentation-property + symbol 'face-documentation t)))) (when (get symbol 'custom-group) (apropos-documentation-property symbol 'group-documentation t))))) @@ -810,7 +821,7 @@ Returns list of symbols and documentation found." ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. (defun apropos-documentation-check-doc-file () - (let (type symbol (sepa 2) sepb) + (let (type symbol (sepa 2) sepb doc) (insert ?\^_) (backward-char) (insert-file-contents (concat doc-directory internal-doc-file-name)) @@ -829,7 +840,14 @@ Returns list of symbols and documentation found." 3) ; variable documentation symbol (read) doc (buffer-substring (1+ (point)) (1- sepb))) - (when (apropos-true-hit-doc doc) + (when (and (apropos-true-hit-doc doc) + ;; The DOC file lists all built-in funcs and vars. + ;; If any are not currently bound, they can + ;; only be platform-specific stuff (eg NS) not + ;; in use on the current platform. + ;; So we exclude them. + (cond ((= 3 type) (boundp symbol)) + ((= 2 type) (fboundp symbol)))) (or (and (setq apropos-item (assq symbol apropos-accumulator)) (setcar (cdr apropos-item) (apropos-score-doc doc))) @@ -965,8 +983,7 @@ If non-nil TEXT is a string that will be printed as a heading." (insert "If moving the mouse over text changes the text's color, " "you can click\n" - "mouse-2 (second button from right) on that text to " - "get more information.\n")) + "or press return on that text to get more information.\n")) (insert "In this buffer, go to the name of the command, or function," " or variable,\n" (substitute-command-keys diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index e812a47ddc6..3b7603b8c0e 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1,7 +1,7 @@ ;;; arc-mode.el --- simple editing of archives -;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Morten Welinder <terra@gnu.org> ;; Keywords: archives msdog editing major-mode @@ -638,7 +638,7 @@ archive. ;; mode on and off. You can corrupt things that way. (if (zerop (buffer-size)) ;; At present we cannot create archives from scratch - (funcall default-major-mode) + (funcall (or (default-value 'major-mode) 'fundamental-mode)) (if (and (not force) archive-files) nil (let* ((type (archive-find-type)) (typename (capitalize (symbol-name type)))) @@ -698,7 +698,7 @@ archive. (or file-name-coding-system default-file-name-coding-system locale-coding-system)) - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) (set-buffer-multibyte 'to)) (archive-summarize nil) (setq buffer-read-only t)))) diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 17a9e4258a2..0fbc3d66c79 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -128,7 +128,7 @@ If this contains a %s, that will be replaced by the matching rule." (("/bin/.*[^/]\\'" . "Shell-Script mode magic number") lambda () - (if (eq major-mode default-major-mode) + (if (eq major-mode (default-value 'major-mode)) (sh-mode))) (ada-mode . ada-header) diff --git a/lisp/bindings.el b/lisp/bindings.el index 6e23b972ad9..139a4853918 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1,7 +1,8 @@ ;;; bindings.el --- define standard key bindings and some variables ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -23,26 +24,6 @@ ;;; Commentary: -;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -;;; Special formatting conventions are used in this file! -;;; -;;; A backslash-newline is used at the beginning of a documentation string -;;; when that string should be stored in the file etc/DOCnnn, not in core. -;;; -;;; Such strings read into Lisp as numbers (during the pure-loading phase). -;;; -;;; But you must obey certain rules to make sure the string is understood -;;; and goes into etc/DOCnnn properly. -;;; -;;; The doc string must appear in the standard place in a call to -;;; defun, autoload, defvar or defconst. No Lisp macros are recognized. -;;; The open-paren starting the definition must appear in column 0. -;;; -;;; In defvar and defconst, there is an additional rule: -;;; The double-quote that starts the string must be on the same -;;; line as the defvar or defconst. -;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ;;; Code: (defun make-mode-line-mouse-map (mouse function) "\ @@ -172,6 +153,8 @@ corresponding to the mode line clicked." (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" ""))) help-echo "emacsclient frame")) "Mode-line control for identifying emacsclient frames.") +;; Autoload all risky properties if this file no longer dumped. +(put 'mode-line-client 'risky-local-variable t) (defvar mode-line-mule-info `("" @@ -213,6 +196,7 @@ mnemonics of the following coding systems: ;; coding system for encoding text to send to buffer process (if any)." ) +(put 'mode-line-mule-info 'risky-local-variable t) (make-variable-buffer-local 'mode-line-mule-info) ;; MSDOS frames have window-system, but want the Fn identification. @@ -234,6 +218,7 @@ Value is used for `mode-line-frame-identification', which see." Mode-line control for displaying info on process status. Normally nil in most modes, since there is no process to display.") +(put 'mode-line-process 'risky-local-variable t) (make-variable-buffer-local 'mode-line-process) (defvar mode-line-modified @@ -264,6 +249,7 @@ Normally nil in most modes, since there is no process to display.") 'mouse-face 'mode-line-highlight)) "Mode-line control for displaying whether current buffer is modified.") +(put 'mode-line-modified 'risky-local-variable t) (make-variable-buffer-local 'mode-line-modified) (defvar mode-line-remote @@ -280,6 +266,7 @@ Normally nil in most modes, since there is no process to display.") "Current directory is local: ") default-directory))))))) "Mode-line flag to show if default-directory for current buffer is remote.") +(put 'mode-line-remote 'risky-local-variable t) (make-variable-buffer-local 'mode-line-remote) @@ -288,9 +275,11 @@ Normally nil in most modes, since there is no process to display.") "Mode-line control for displaying the position in the buffer. Normally displays the buffer percentage and, optionally, the buffer size, the line number and the column number.") +(put 'mode-line-position 'risky-local-variable t) (defvar mode-line-modes nil "Mode-line control for displaying major and minor modes.") +(put 'mode-line-modes 'risky-local-variable t) (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") @@ -356,7 +345,7 @@ mouse-3: Remove current window from display") (propertize " " 'help-echo help-echo) 'mode-line-modes `(which-func-mode ("" which-func-format ,dashes)) - `(global-mode-string (,dashes global-mode-string)) + `(global-mode-string ("" global-mode-string ,dashes)) (propertize "-%-" 'help-echo help-echo))) (standard-mode-line-modes (list @@ -469,6 +458,7 @@ Its default value is (\"%12b\") with some text properties added. Major modes that edit things other than ordinary files may change this \(e.g. Info, Dired,...)") +(put 'mode-line-buffer-identification 'risky-local-variable t) (make-variable-buffer-local 'mode-line-buffer-identification) (defun unbury-buffer () "\ @@ -517,49 +507,49 @@ Switch to the most recently selected buffer other than the current one." ;; Global ones can go on the menubar (Options --> Show/Hide). (define-key mode-line-mode-menu [overwrite-mode] `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode - :help "Overwrite mode: typed characters replace existing text" + :help ,(purecopy "Overwrite mode: typed characters replace existing text") :button (:toggle . overwrite-mode))) (define-key mode-line-mode-menu [outline-minor-mode] `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode ;; XXX: This needs a good, brief description. - :help "" + :help ,(purecopy "") :button (:toggle . (bound-and-true-p outline-minor-mode)))) (define-key mode-line-mode-menu [highlight-changes-mode] `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode - :help "Show changes in the buffer in a distinctive color" + :help ,(purecopy "Show changes in the buffer in a distinctive color") :button (:toggle . (bound-and-true-p highlight-changes-mode)))) (define-key mode-line-mode-menu [hide-ifdef-mode] `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode - :help "Show/Hide code within #ifdef constructs" + :help ,(purecopy "Show/Hide code within #ifdef constructs") :button (:toggle . (bound-and-true-p hide-ifdef-mode)))) (define-key mode-line-mode-menu [glasses-mode] `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode - :help "Insert virtual separators to make long identifiers easy to read" + :help ,(purecopy "Insert virtual separators to make long identifiers easy to read") :button (:toggle . (bound-and-true-p glasses-mode)))) (define-key mode-line-mode-menu [font-lock-mode] `(menu-item ,(purecopy "Font Lock") font-lock-mode - :help "Syntax coloring" + :help ,(purecopy "Syntax coloring") :button (:toggle . font-lock-mode))) (define-key mode-line-mode-menu [flyspell-mode] `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode - :help "Spell checking on the fly" + :help ,(purecopy "Spell checking on the fly") :button (:toggle . (bound-and-true-p flyspell-mode)))) (define-key mode-line-mode-menu [auto-revert-tail-mode] `(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode - :help "Revert the tail of the buffer when buffer grows" + :help ,(purecopy "Revert the tail of the buffer when buffer grows") :enable (buffer-file-name) :button (:toggle . (bound-and-true-p auto-revert-tail-mode)))) (define-key mode-line-mode-menu [auto-revert-mode] `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode - :help "Revert the buffer when the file on disk changes" + :help ,(purecopy "Revert the buffer when the file on disk changes") :button (:toggle . (bound-and-true-p auto-revert-mode)))) (define-key mode-line-mode-menu [auto-fill-mode] `(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode - :help "Automatically insert new lines" + :help ,(purecopy "Automatically insert new lines") :button (:toggle . auto-fill-function))) (define-key mode-line-mode-menu [abbrev-mode] `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode - :help "Automatically expand abbreviations" + :help ,(purecopy "Automatically expand abbreviations") :button (:toggle . abbrev-mode))) (defun mode-line-minor-mode-help (event) @@ -575,6 +565,7 @@ STRING is included in the mode line if VARIABLE's value is non-nil. Actually, STRING need not be a string; any possible mode-line element is okay. See `mode-line-format'.") +(put 'minor-mode-alist 'risky-local-variable t) ;; Don't use purecopy here--some people want to change these strings. (setq minor-mode-alist '((abbrev-mode " Abbrev") @@ -678,20 +669,13 @@ With a prefix argument, this command does completion within the collection of symbols listed in the index of the manual for the language you are using." (interactive "P") - (cond (arg - (info-complete-symbol)) - ;; Don't autoload etags if we have no tags table. - ((or tags-table-list - tags-file-name) - (complete-tag)) - ((and (fboundp 'semantic-active-p) - (semantic-active-p) - (fboundp 'semantic-complete-symbol)) - (semantic-complete-symbol)) - (t - (error "%s" (substitute-command-keys - "No tags table loaded; \ -use \\[visit-tags-table] to load one"))))) + (if arg + (info-complete-symbol) + (if (fboundp 'complete-tag) + (complete-tag) + ;; Don't autoload etags if we have no tags table. + (error "%s" (substitute-command-keys + "No tags table loaded; use \\[visit-tags-table] to load one"))))) ;; Reduce total amount of space we must allocate during this function ;; that we will not need to keep permanently. @@ -753,7 +737,8 @@ use \\[visit-tags-table] to load one"))))) (define-key ctl-x-map "\e\e" 'repeat-complex-command) ;; New binding analogous to M-:. (define-key ctl-x-map "\M-:" 'repeat-complex-command) -(define-key ctl-x-map "u" 'advertised-undo) +(define-key ctl-x-map "u" 'undo) +(put 'undo :advertised-binding [?\C-x ?u]) ;; Many people are used to typing C-/ on X terminals and getting C-_. (define-key global-map [?\C-/] 'undo) (define-key global-map "\C-_" 'undo) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index debfac03140..bd8511cda71 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1301,7 +1301,12 @@ for a file, defaulting to the file defined by variable (let ((print-length nil) (print-level nil)) (bookmark-insert-file-format-version-stamp) - (pp bookmark-alist (current-buffer)) + (insert "(") + ;; Rather than a single call to `pp' we make one per bookmark. + ;; Apparently `pp' has a poor algorithmic complexity, so this + ;; scales a lot better. bug#4485. + (dolist (i bookmark-alist) (pp i (current-buffer))) + (insert ")") (let ((version-control (cond ((null bookmark-version-control) nil) diff --git a/lisp/bs.el b/lisp/bs.el index 727216c9531..54924196bf0 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1,7 +1,7 @@ ;;; bs.el --- menu for selecting and displaying buffers -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de> ;; Maintainer: Olaf Sylvester <Olaf.Sylvester@netsurf.de> ;; Keywords: convenience @@ -575,10 +575,11 @@ a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'." "Redisplay whole Buffer Selection Menu. If KEEP-LINE-P is non-nil the point will stay on current line. SORT-DESCRIPTION is an element of `bs-sort-functions'." - (let ((line (1+ (count-lines 1 (point))))) + (let ((line (count-lines 1 (point)))) (bs-show-in-buffer (bs-buffer-list nil sort-description)) (when keep-line-p - (goto-line line)) + (goto-char (point-min)) + (forward-line line)) (beginning-of-line))) (defun bs--goto-current-buffer () @@ -1326,13 +1327,12 @@ ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu." (defun bs--get-file-name (start-buffer all-buffers) "Return string for column 'File' in Buffer Selection Menu. This is the variable `buffer-file-name' of current buffer. -If current mode is `dired-mode' or `shell-mode' it returns the -default directory. +If not visiting a file, `list-buffers-directory' is returned instead. START-BUFFER is the buffer where we started buffer selection. ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu." - (propertize (if (member major-mode '(shell-mode dired-mode)) - default-directory - (or buffer-file-name "")) + (propertize (or buffer-file-name + (bound-and-true-p list-buffers-directory) + "") 'mouse-face 'highlight 'help-echo "mouse-2: select this buffer, mouse-3: select in other frame")) diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 9b3083f83d3..e23ed7c50ca 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -51,8 +51,17 @@ (defun calc-simplify () (interactive) (calc-slow-wrapper - (calc-with-default-simplification - (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1)))))) + (let ((top (calc-top-n 1))) + (if (calc-is-inverse) + (setq top + (let ((calc-simplify-mode nil)) + (math-normalize (math-trig-rewrite top))))) + (if (calc-is-hyperbolic) + (setq top + (let ((calc-simplify-mode nil)) + (math-normalize (math-hyperbolic-trig-rewrite top))))) + (calc-with-default-simplification + (calc-enter-result 1 "simp" (math-simplify top)))))) (defun calc-simplify-extended () (interactive) @@ -303,7 +312,48 @@ (defalias 'calcFunc-esimplify 'math-simplify-extended) -;; math-top-only is local to math-simplify, but is used by +;;; Rewrite the trig functions in a form easier to simplify. +(defun math-trig-rewrite (fn) + "Rewrite trigonometric functions in terms of sines and cosines." + (cond + ((not (consp fn)) + fn) + ((eq (car-safe fn) 'calcFunc-sec) + (list '/ 1 (cons 'calcFunc-cos (math-trig-rewrite (cdr fn))))) + ((eq (car-safe fn) 'calcFunc-csc) + (list '/ 1 (cons 'calcFunc-sin (math-trig-rewrite (cdr fn))))) + ((eq (car-safe fn) 'calcFunc-tan) + (let ((newfn (math-trig-rewrite (cdr fn)))) + (list '/ (cons 'calcFunc-sin newfn) + (cons 'calcFunc-cos newfn)))) + ((eq (car-safe fn) 'calcFunc-cot) + (let ((newfn (math-trig-rewrite (cdr fn)))) + (list '/ (cons 'calcFunc-cos newfn) + (cons 'calcFunc-sin newfn)))) + (t + (mapcar 'math-trig-rewrite fn)))) + +(defun math-hyperbolic-trig-rewrite (fn) + "Rewrite hyperbolic functions in terms of sinhs and coshs." + (cond + ((not (consp fn)) + fn) + ((eq (car-safe fn) 'calcFunc-sech) + (list '/ 1 (cons 'calcFunc-cosh (math-hyperbolic-trig-rewrite (cdr fn))))) + ((eq (car-safe fn) 'calcFunc-csch) + (list '/ 1 (cons 'calcFunc-sinh (math-hyperbolic-trig-rewrite (cdr fn))))) + ((eq (car-safe fn) 'calcFunc-tanh) + (let ((newfn (math-hyperbolic-trig-rewrite (cdr fn)))) + (list '/ (cons 'calcFunc-sinh newfn) + (cons 'calcFunc-cosh newfn)))) + ((eq (car-safe fn) 'calcFunc-coth) + (let ((newfn (math-hyperbolic-trig-rewrite (cdr fn)))) + (list '/ (cons 'calcFunc-cosh newfn) + (cons 'calcFunc-sinh newfn)))) + (t + (mapcar 'math-hyperbolic-trig-rewrite fn)))) + +;; math-top-only is local to math-simplify, but is used by ;; math-simplify-step, which is called by math-simplify. (defvar math-top-only) @@ -406,7 +456,7 @@ aaa temp) (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr) - (eq (car aaa) '-) + (eq (car aaa) '-) (eq (car math-simplify-expr) '-) t)) (progn (setcar (cdr (cdr math-simplify-expr)) temp) @@ -449,7 +499,7 @@ (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp)))) (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) safe) - (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) + (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) (nth 1 aaa) nil nil t)) (progn (setcar (cdr math-simplify-expr) temp) @@ -463,7 +513,7 @@ (setcar (cdr (cdr aa)) 1))) (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1))) - (math-div (math-mul (nth 2 math-simplify-expr) + (math-div (math-mul (nth 2 math-simplify-expr) (nth 1 (nth 1 math-simplify-expr))) (nth 2 (nth 1 math-simplify-expr))) math-simplify-expr))) @@ -474,18 +524,18 @@ (defun math-simplify-divide () (let ((np (cdr math-simplify-expr)) (nover nil) - (nn (and (or (eq (car math-simplify-expr) '/) + (nn (and (or (eq (car math-simplify-expr) '/) (not (Math-realp (nth 2 math-simplify-expr)))) (math-common-constant-factor (nth 2 math-simplify-expr)))) n op) (if nn (progn - (setq n (and (or (eq (car math-simplify-expr) '/) + (setq n (and (or (eq (car math-simplify-expr) '/) (not (Math-realp (nth 1 math-simplify-expr)))) (math-common-constant-factor (nth 1 math-simplify-expr)))) (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) (progn - (setcar (cdr math-simplify-expr) + (setcar (cdr math-simplify-expr) (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) (setcar (cdr (cdr math-simplify-expr)) (math-cancel-common-factor (nth 2 math-simplify-expr) nn)) @@ -499,7 +549,7 @@ (setcar (cdr (cdr math-simplify-expr)) (math-cancel-common-factor (nth 2 math-simplify-expr) n)) (if (and (math-negp n) - (setq op (assq (car math-simplify-expr) + (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))) (setcar math-simplify-expr (nth 1 op)))))))) (if (and (eq (car-safe (car np)) '/) @@ -526,15 +576,15 @@ (defvar math-simplify-divisor-nover) (defvar math-simplify-divisor-dover) -(defun math-simplify-divisor (np dp math-simplify-divisor-nover +(defun math-simplify-divisor (np dp math-simplify-divisor-nover math-simplify-divisor-dover) (cond ((eq (car-safe (car dp)) '/) - (math-simplify-divisor np (cdr (car dp)) - math-simplify-divisor-nover + (math-simplify-divisor np (cdr (car dp)) + math-simplify-divisor-nover math-simplify-divisor-dover) (and (math-known-scalarp (nth 1 (car dp)) t) (math-simplify-divisor np (cdr (cdr (car dp))) - math-simplify-divisor-nover + math-simplify-divisor-nover (not math-simplify-divisor-dover)))) ((or (or (eq (car math-simplify-expr) '/) (let ((signs (math-possible-signs (car np)))) @@ -544,7 +594,7 @@ math-living-dangerously))) (math-numberp (car np))) (let (d - (safe t) + (safe t) (scalar (math-known-scalarp (car np)))) (while (and (eq (car-safe (setq d (car dp))) '*) safe) @@ -555,10 +605,10 @@ (math-simplify-one-divisor np dp)))))) (defun math-simplify-one-divisor (np dp) - (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover + (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover math-simplify-divisor-dover t)) op) - (if temp + (if temp (progn (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq))) (math-known-negp (car dp)) @@ -566,7 +616,7 @@ (setcar math-simplify-expr (nth 1 op))) (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp)) (setcar dp 1)) - (and math-simplify-divisor-dover (not math-simplify-divisor-nover) + (and math-simplify-divisor-dover (not math-simplify-divisor-nover) (eq (car math-simplify-expr) '/) (eq (car-safe (car dp)) 'calcFunc-sqrt) (Math-integerp (nth 1 (car dp))) @@ -667,7 +717,7 @@ (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr)) (eq (car n) '-) nil) (setq np (cdr n))) - (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil + (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil (eq np (cdr math-simplify-expr))) (math-simplify-divide) (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr))))) @@ -734,12 +784,12 @@ (and n (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (list 'calcFunc-sqrt (math-sub 1 (math-sqr + (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) (math-div (nth 1 (nth 1 math-simplify-expr)) (list 'calcFunc-sqrt - (math-add 1 (math-sqr + (math-add 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) (and m (integerp (car m)) @@ -764,12 +814,12 @@ (and n (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (list 'calcFunc-sqrt + (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) (math-div 1 (list 'calcFunc-sqrt - (math-add 1 + (math-add 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) (and m (integerp (car m)) @@ -792,17 +842,17 @@ (and n (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (math-div + (math-div 1 - (list 'calcFunc-sqrt + (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (math-div + (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) (list 'calcFunc-sqrt - (math-add 1 + (math-add 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))) (math-defsimplify calcFunc-csc @@ -819,13 +869,13 @@ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (math-div + (math-div 1 - (list 'calcFunc-sqrt (math-sub 1 (math-sqr + (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) (math-div (list 'calcFunc-sqrt - (math-add 1 (math-sqr + (math-add 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) (nth 1 (nth 1 math-simplify-expr)))))) @@ -971,7 +1021,7 @@ (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) math-living-dangerously - (list 'calcFunc-sqrt + (list 'calcFunc-sqrt (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) math-living-dangerously @@ -995,7 +1045,7 @@ (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) math-living-dangerously - (list 'calcFunc-sqrt + (list 'calcFunc-sqrt (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) math-living-dangerously @@ -1040,9 +1090,9 @@ (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) math-living-dangerously - (math-div + (math-div 1 - (list 'calcFunc-sqrt + (list 'calcFunc-sqrt (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) math-living-dangerously @@ -1060,9 +1110,9 @@ (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) math-living-dangerously - (math-div + (math-div 1 - (list 'calcFunc-sqrt + (list 'calcFunc-sqrt (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) math-living-dangerously @@ -1155,7 +1205,7 @@ (defun math-simplify-sqrt () (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) - (math-div (list 'calcFunc-sqrt + (math-div (list 'calcFunc-sqrt (math-mul (nth 1 (nth 1 math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr)))) (nth 2 (nth 1 math-simplify-expr)))) @@ -1166,7 +1216,7 @@ (math-mul (math-normalize (list 'calcFunc-sqrt fac)) (math-normalize (list 'calcFunc-sqrt - (math-cancel-common-factor + (math-cancel-common-factor (nth 1 math-simplify-expr) fac)))))) (and math-living-dangerously (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-) @@ -1180,7 +1230,7 @@ (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) 'calcFunc-cos) (list 'calcFunc-sin - (nth 1 (nth 1 (nth 2 + (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr)))))))) (and (eq (car-safe (nth 1 math-simplify-expr)) '-) (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1) @@ -1320,7 +1370,7 @@ (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^) (list '^ (nth 1 (nth 1 math-simplify-expr)) - (math-mul (nth 2 math-simplify-expr) + (math-mul (nth 2 math-simplify-expr) (nth 2 (nth 1 math-simplify-expr))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) (list '^ @@ -1328,9 +1378,9 @@ (math-div (nth 2 math-simplify-expr) 2))) (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) (list (car (nth 1 math-simplify-expr)) - (list '^ (nth 1 (nth 1 math-simplify-expr)) + (list '^ (nth 1 (nth 1 math-simplify-expr)) (nth 2 math-simplify-expr)) - (list '^ (nth 2 (nth 1 math-simplify-expr)) + (list '^ (nth 2 (nth 1 math-simplify-expr)) (nth 2 math-simplify-expr)))))) (and (math-equal-int (nth 1 math-simplify-expr) 10) (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10) @@ -1339,7 +1389,7 @@ (math-simplify-exp (nth 2 math-simplify-expr))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) (not math-integrating) - (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) + (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) (nth 2 math-simplify-expr)))) (and (equal (nth 1 math-simplify-expr) '(var i var-i)) (math-imaginary-i) @@ -1353,14 +1403,14 @@ (integerp (nth 2 math-simplify-expr)) (>= (nth 2 math-simplify-expr) 2) (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) - (math-mul (math-pow (nth 1 math-simplify-expr) + (math-mul (math-pow (nth 1 math-simplify-expr) (- (nth 2 math-simplify-expr) 2)) (math-sub 1 (math-sqr (list 'calcFunc-sin (nth 1 (nth 1 math-simplify-expr))))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) - (math-mul (math-pow (nth 1 math-simplify-expr) + (math-mul (math-pow (nth 1 math-simplify-expr) (- (nth 2 math-simplify-expr) 2)) (math-add 1 (math-sqr @@ -1393,14 +1443,14 @@ (or (and (math-looks-negp (nth 1 math-simplify-expr)) (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) - (list 'calcFunc-conj + (list 'calcFunc-conj (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr))))))) (math-defsimplify calcFunc-erfc (or (and (math-looks-negp (nth 1 math-simplify-expr)) (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr))))) (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) - (list 'calcFunc-conj + (list 'calcFunc-conj (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr))))))) @@ -1602,13 +1652,14 @@ (car p)))) ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), -;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose), +;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose), ;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x. -;; The variables math-is-poly-degree and math-is-poly-loose are local to -;; math-is-polynomial, but are used by math-is-poly-rec +;; These variables are local to math-is-polynomial, but are used by +;; math-is-poly-rec. (defvar math-is-poly-degree) (defvar math-is-poly-loose) +(defvar var) (defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose) (let* ((math-poly-base-variable (if math-is-poly-loose @@ -1694,7 +1745,7 @@ (let ((p2 (math-is-poly-rec (nth 2 expr) negpow))) (and p2 (or (null math-is-poly-degree) - (<= (- (+ (length p1) (length p2)) 2) + (<= (- (+ (length p1) (length p2)) 2) math-is-poly-degree)) (math-poly-mul p1 p2)))))) ((eq (car expr) '/) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index cb50cf9ab26..c2ca50ac6f7 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -227,7 +227,8 @@ (or found (let ((varname (concat "PlotData" (int-to-string - (1+ (length calc-graph-var-cache)))))) + (1+ (length calc-graph-var-cache))))) + var) (setq var (list 'var (intern varname) (intern (concat "var-" varname))) found (cons thing var) @@ -279,9 +280,9 @@ (defvar var-DUMMY2) (defvar var-PlotRejects) -;; The following variables are local to calc-graph-plot, but are +;; The following variables are local to calc-graph-plot, but are ;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d, -;; calc-graph-recompute-2d, calc-graph-compute-3d and +;; calc-graph-recompute-2d, calc-graph-compute-3d and ;; calc-graph-format-data, which are called by calc-graph-plot. (defvar calc-graph-yvalue) (defvar calc-graph-yvec) @@ -725,7 +726,7 @@ calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value)))) calc-graph-zp (nconc calc-graph-zp (cons '(skip) (copy-sequence (cdr (car calc-graph-yvalue))))))) - (setq calc-graph-numsteps (1- (* calc-graph-numsteps + (setq calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3))))) (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0) (error "Can't plot an empty vector")) @@ -1098,9 +1099,9 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (buffer-substring (match-beginning 1) (match-end 1))))))) (unless yerr - (setq lenbl (or (equal mode "lines") + (setq lenbl (or (equal mode "lines") (equal mode "linespoints")) - penbl (or (equal mode "points") + penbl (or (equal mode "points") (equal mode "linespoints"))) (if lines (or (eq lines t) @@ -1117,7 +1118,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (setq errform (condition-case nil (math-contains-sdev-p - (eval (intern + (eval (intern (concat "var-" (save-excursion (re-search-backward ":\\(.*\\)\\}") @@ -1134,7 +1135,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (if penbl "linespoints" "lines") (if penbl "points" "dots")))) (if (and pstyle (> pstyle 0)) - (insert " " + (insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1") " " (int-to-string pstyle)) (if (and lstyle (> lstyle 0)) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 6de8613e13b..87e143c6502 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -199,7 +199,7 @@ (while (progn (setq cmd-base-default (concat "User-" keyname)) - (setq cmd (completing-read + (setq cmd (completing-read (concat "Define M-x command name (default calc-" cmd-base-default "): ") @@ -224,7 +224,7 @@ "That name conflicts with a built-in Emacs function. Replace this function? ")))))) (while (progn - (setq cmd-base-default + (setq cmd-base-default (if cmd-base (if (string-match "\\`User-.+" cmd-base) @@ -233,16 +233,16 @@ (substring cmd-base 5)) cmd-base) (concat "User" keyname))) - (setq func + (setq func (concat "calcFunc-" - (completing-read + (completing-read (concat "Define algebraic function name (default " cmd-base-default "): ") (mapcar (lambda (x) (substring x 9)) (all-completions "calcFunc-" obarray)) - (lambda (x) - (fboundp + (lambda (x) + (fboundp (intern (concat "calcFunc-" x)))) nil))) (setq func @@ -270,7 +270,7 @@ (setq calc-user-formula-alist arglist) (while (progn - (setq calc-user-formula-alist + (setq calc-user-formula-alist (read-from-minibuffer "Function argument list: " (if arglist (prin1-to-string arglist) @@ -284,7 +284,7 @@ func (y-or-n-p "Leave it symbolic for non-constant arguments? "))) - (setq calc-user-formula-alist + (setq calc-user-formula-alist (mapcar (function (lambda (x) (or (cdr (assq x '((nil . arg-nil) (t . arg-t)))) @@ -328,6 +328,7 @@ (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) (message ""))) +(defvar arglist) ; dynamically bound in all callers (defun calc-default-formula-arglist (form) (if (consp form) (if (eq (car form) 'var) @@ -382,14 +383,14 @@ (if (eq calc-language 'unform) (error "Can't define formats for unformatted mode")) (let* ((comp (calc-top 1)) - (func (intern + (func (intern (concat "calcFunc-" (completing-read "Define format for which function: " (mapcar (lambda (x) (substring x 9)) (all-completions "calcFunc-" obarray)) - (lambda (x) - (fboundp + (lambda (x) + (fboundp (intern (concat "calcFunc-" x)))))))) (comps (get func 'math-compose-forms)) entry entry2 @@ -402,7 +403,7 @@ (setq arglist (sort arglist 'string-lessp)) (while (progn - (setq calc-user-formula-alist + (setq calc-user-formula-alist (read-from-minibuffer "Composition argument list: " (if arglist (prin1-to-string arglist) @@ -417,9 +418,9 @@ (cons (setq entry (list calc-language)) comps))) (or (setq entry2 (assq (length calc-user-formula-alist) (cdr entry))) (setcdr entry - (cons (setq entry2 + (cons (setq entry2 (list (length calc-user-formula-alist))) (cdr entry)))) - (setcdr entry2 + (setcdr entry2 (list 'lambda calc-user-formula-alist (calc-fix-user-formula comp)))) (calc-pop-stack 1) (calc-do-refresh)))) @@ -503,8 +504,8 @@ (switch-to-buffer calc-original-buffer)) ;; The variable calc-lang is local to calc-write-parse-table, but is -;; used by calc-write-parse-table-part which is called by -;; calc-write-parse-table. The variable is also local to +;; used by calc-write-parse-table-part which is called by +;; calc-write-parse-table. The variable is also local to ;; calc-read-parse-table, but is used by calc-fix-token-name which ;; is called (indirectly) by calc-read-parse-table. (defvar calc-lang) @@ -691,10 +692,10 @@ (let* ((mac (elt (nth 1 (nth 3 cmd)) 1)) (str (edmacro-format-keys mac t)) (kys (nth 3 (nth 3 cmd)))) - (calc-edit-mode + (calc-edit-mode (list 'calc-edit-macro-finish-edit cmdname kys) - t (format (concat - "Editing keyboard macro (%s, bound to %s).\n" + t (format (concat + "Editing keyboard macro (%s, bound to %s).\n" "Original keys: %s \n") cmdname kys (elt (nth 1 (nth 3 cmd)) 0))) (insert str "\n") @@ -710,7 +711,7 @@ (if (and defn (calc-valid-formula-func func)) (let ((niceexpr (math-format-nice-expr defn (frame-width)))) (calc-wrapper - (calc-edit-mode + (calc-edit-mode (list 'calc-finish-formula-edit (list 'quote func)) nil (format (concat @@ -792,7 +793,7 @@ (when match (kill-line 1) (setq line (concat line (substring curline 0 match)))) - (setq line (replace-regexp-in-string "SPC" " SPC " + (setq line (replace-regexp-in-string "SPC" " SPC " (replace-regexp-in-string " " "" line))) (insert line "\t\t\t") (if (> (current-column) 24) @@ -817,7 +818,7 @@ (setq line (concat line curline)) (kill-line 1) (setq curline (calc-edit-macro-command))) - (when match + (when match (kill-line 1) (setq line (concat line (substring curline 0 match)))) (setq line (replace-regexp-in-string " " "" line)) @@ -844,7 +845,7 @@ (setq line (concat line curline)) (kill-line 1) (setq curline (calc-edit-macro-command))) - (when match + (when match (kill-line 1) (setq line (concat line (substring curline 0 match)))) (setq line (replace-regexp-in-string " " "" line)) @@ -1019,8 +1020,8 @@ Redefine the corresponding command." (mapcar (lambda (x) (substring x 9)) (all-completions "calcFunc-" obarray)) - (lambda (x) - (fboundp + (lambda (x) + (fboundp (intern (concat "calcFunc-" x)))) t))))) (and (eq key ?\M-x) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index b291969b7f5..d38d6b7dbde 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,7 +1,7 @@ ;;; calc.el --- the GNU Emacs calculator -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -227,9 +227,10 @@ :tag "Calc" :group 'applications) -;;;###autoload +;; Do not autoload, so it is evaluated at run-time rather than at dump time. +;; ;;;###autoload (defcustom calc-settings-file - (convert-standard-filename "~/.calc.el") + (locate-user-emacs-file "calc.el" ".calc.el") "File in which to record permanent settings." :group 'calc :type '(file)) @@ -1042,25 +1043,13 @@ Used by `calc-user-invocation'.") map) "The key map for Calc.") - - (defvar calc-digit-map (let ((map (make-keymap))) - (if (featurep 'xemacs) - (map-keymap (function - (lambda (keys bind) - (define-key map keys - (if (eq bind 'undefined) - 'undefined 'calcDigit-nondigit)))) - calc-mode-map) - (let ((cmap (nth 1 calc-mode-map)) - (dmap (nth 1 map)) - (i 0)) - (while (< i 128) - (aset dmap i - (if (eq (aref cmap i) 'undefined) - 'undefined 'calcDigit-nondigit)) - (setq i (1+ i))))) + (map-keymap (lambda (key bind) + (define-key map (vector key) + (if (eq bind 'undefined) + 'undefined 'calcDigit-nondigit))) + calc-mode-map) (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-key)) "_0123456789.e+-:n#@oh'\"mspM") (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter)) @@ -1077,15 +1066,13 @@ Used by `calc-user-invocation'.") (define-key calc-digit-map x 'calcDigit-backspace) (define-key calc-mode-map x 'calc-pop) (define-key calc-mode-map - (if (vectorp x) - (if (featurep 'xemacs) - (if (= (length x) 1) - (vector (if (consp (aref x 0)) - (cons 'meta (aref x 0)) - (list 'meta (aref x 0)))) - "\e\C-d") - (vconcat "\e" x)) - (concat "\e" x)) + (if (and (vectorp x) (featurep 'xemacs)) + (if (= (length x) 1) + (vector (if (consp (aref x 0)) + (cons 'meta (aref x 0)) + (list 'meta (aref x 0)))) + "\e\C-d") + (vconcat "\e" x)) 'calc-pop-above)) (error nil))) (if calc-scan-for-dels @@ -1615,11 +1602,13 @@ See calc-keypad for details." (and (memq 'position-point calc-command-flags) (if (eq major-mode 'calc-mode) (progn - (goto-line calc-final-point-line) + (goto-char (point-min)) + (forward-line (1- calc-final-point-line)) (move-to-column calc-final-point-column)) (save-current-buffer (calc-select-buffer) - (goto-line calc-final-point-line) + (goto-char (point-min)) + (forward-line (1- calc-final-point-line)) (move-to-column calc-final-point-column)))) (unless (memq 'keep-flags calc-command-flags) (save-excursion @@ -2019,7 +2008,8 @@ See calc-keypad for details." (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) (save-excursion (set-buffer calc-trail-buffer) - (goto-line 2) + (goto-char (point-min)) + (forward-line 1) (setq calc-trail-pointer (point-marker)))) calc-trail-buffer) @@ -2432,101 +2422,101 @@ largest Emacs integer.") ;;;; Arithmetic routines. -;;; -;;; An object as manipulated by one of these routines may take any of the -;;; following forms: -;;; -;;; integer An integer. For normalized numbers, this format -;;; is used only for -;;; negative math-small-integer-size + 1 to -;;; math-small-integer-size - 1 -;;; -;;; (bigpos N0 N1 N2 ...) A big positive integer, -;;; N0 + N1*math-bignum-digit-size -;;; + N2*(math-bignum-digit-size)^2 ... -;;; (bigneg N0 N1 N2 ...) A big negative integer, -;;; - N0 - N1*math-bignum-digit-size ... -;;; Each digit N is in the range -;;; 0 ... math-bignum-digit-size -1. -;;; Normalized, always at least three N present, -;;; and the most significant N is nonzero. -;;; -;;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers. -;;; Normalized, DEN > 1. -;;; -;;; (float NUM EXP) A floating-point number, NUM * 10^EXP; -;;; NUM is a small or big integer, EXP is a small int. -;;; Normalized, NUM is not a multiple of 10, and -;;; abs(NUM) < 10^calc-internal-prec. -;;; Normalized zero is stored as (float 0 0). -;;; -;;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above. -;;; Normalized, IMAG is nonzero. -;;; -;;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA -;;; is neither zero nor 180 degrees (pi radians). -;;; -;;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a -;;; vector of vectors. -;;; -;;; (hms H M S) Angle in hours-minutes-seconds form. All three -;;; components have the same sign; H and M must be -;;; numerically integers; M and S are expected to -;;; lie in the range [0,60). -;;; -;;; (date N) A date or date/time object. N is an integer to -;;; store a date only, or a fraction or float to -;;; store a date and time. -;;; -;;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized, -;;; SIGMA > 0. X is any complex number and SIGMA -;;; is real numbers; or these may be symbolic -;;; expressions where SIGMA is assumed real. -;;; -;;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[]. -;;; LO and HI are any real numbers, or symbolic -;;; expressions which are assumed real, and LO < HI. -;;; For [LO..HI], if LO = HI normalization produces LO, -;;; and if LO > HI normalization produces [LO..LO). -;;; For other intervals, if LO > HI normalization -;;; sets HI equal to LO. -;;; -;;; (mod N M) Number modulo M. When normalized, 0 <= N < M. -;;; N and M are real numbers. -;;; -;;; (var V S) Symbolic variable. V is a Lisp symbol which -;;; represents the variable's visible name. S is -;;; the symbol which actually stores the variable's -;;; value: (var pi var-pi). -;;; -;;; In general, combining rational numbers in a calculation always produces -;;; a rational result, but if either argument is a float, result is a float. - -;;; In the following comments, [x y z] means result is x, args must be y, z, -;;; respectively, where the code letters are: -;;; -;;; O Normalized object (vector or number) -;;; V Normalized vector -;;; N Normalized number of any type -;;; N Normalized complex number -;;; R Normalized real number (float or rational) -;;; F Normalized floating-point number -;;; T Normalized rational number -;;; I Normalized integer -;;; B Normalized big integer -;;; S Normalized small integer -;;; D Digit (small integer, 0..999) -;;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol) -;;; or normalized vector element list (without "vec") -;;; P Predicate (truth value) -;;; X Any Lisp object -;;; Z "nil" -;;; -;;; Lower-case letters signify possibly un-normalized values. -;;; "L.D" means a cons of an L and a D. -;;; [N N; n n] means result will be normalized if argument is. -;;; Also, [Public] marks routines intended to be called from outside. -;;; [This notation has been neglected in many recent routines.] +;; +;; An object as manipulated by one of these routines may take any of the +;; following forms: +;; +;; integer An integer. For normalized numbers, this format +;; is used only for +;; negative math-small-integer-size + 1 to +;; math-small-integer-size - 1 +;; +;; (bigpos N0 N1 N2 ...) A big positive integer, +;; N0 + N1*math-bignum-digit-size +;; + N2*(math-bignum-digit-size)^2 ... +;; (bigneg N0 N1 N2 ...) A big negative integer, +;; - N0 - N1*math-bignum-digit-size ... +;; Each digit N is in the range +;; 0 ... math-bignum-digit-size -1. +;; Normalized, always at least three N present, +;; and the most significant N is nonzero. +;; +;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers. +;; Normalized, DEN > 1. +;; +;; (float NUM EXP) A floating-point number, NUM * 10^EXP; +;; NUM is a small or big integer, EXP is a small int. +;; Normalized, NUM is not a multiple of 10, and +;; abs(NUM) < 10^calc-internal-prec. +;; Normalized zero is stored as (float 0 0). +;; +;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above. +;; Normalized, IMAG is nonzero. +;; +;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA +;; is neither zero nor 180 degrees (pi radians). +;; +;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a +;; vector of vectors. +;; +;; (hms H M S) Angle in hours-minutes-seconds form. All three +;; components have the same sign; H and M must be +;; numerically integers; M and S are expected to +;; lie in the range [0,60). +;; +;; (date N) A date or date/time object. N is an integer to +;; store a date only, or a fraction or float to +;; store a date and time. +;; +;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized, +;; SIGMA > 0. X is any complex number and SIGMA +;; is real numbers; or these may be symbolic +;; expressions where SIGMA is assumed real. +;; +;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[]. +;; LO and HI are any real numbers, or symbolic +;; expressions which are assumed real, and LO < HI. +;; For [LO..HI], if LO = HI normalization produces LO, +;; and if LO > HI normalization produces [LO..LO). +;; For other intervals, if LO > HI normalization +;; sets HI equal to LO. +;; +;; (mod N M) Number modulo M. When normalized, 0 <= N < M. +;; N and M are real numbers. +;; +;; (var V S) Symbolic variable. V is a Lisp symbol which +;; represents the variable's visible name. S is +;; the symbol which actually stores the variable's +;; value: (var pi var-pi). +;; +;; In general, combining rational numbers in a calculation always produces +;; a rational result, but if either argument is a float, result is a float. + +;; In the following comments, [x y z] means result is x, args must be y, z, +;; respectively, where the code letters are: +;; +;; O Normalized object (vector or number) +;; V Normalized vector +;; N Normalized number of any type +;; N Normalized complex number +;; R Normalized real number (float or rational) +;; F Normalized floating-point number +;; T Normalized rational number +;; I Normalized integer +;; B Normalized big integer +;; S Normalized small integer +;; D Digit (small integer, 0..999) +;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol) +;; or normalized vector element list (without "vec") +;; P Predicate (truth value) +;; X Any Lisp object +;; Z "nil" +;; +;; Lower-case letters signify possibly un-normalized values. +;; "L.D" means a cons of an L and a D. +;; [N N; n n] means result will be normalized if argument is. +;; Also, [Public] marks routines intended to be called from outside. +;; [This notation has been neglected in many recent routines.] (defvar math-eval-rules-cache) (defvar math-eval-rules-cache-other) @@ -2658,7 +2648,7 @@ largest Emacs integer.") -;;; True if A is a floating-point real or complex number. [P x] [Public] +;; True if A is a floating-point real or complex number. [P x] [Public] (defun math-floatp (a) (cond ((eq (car-safe a) 'float) t) ((memq (car-safe a) '(cplx polar mod sdev intv)) @@ -2670,7 +2660,7 @@ largest Emacs integer.") -;;; Verify that A is a complete object and return A. [x x] [Public] +;; Verify that A is a complete object and return A. [x x] [Public] (defun math-check-complete (a) (cond ((integerp a) a) ((eq (car-safe a) 'incomplete) @@ -2680,7 +2670,7 @@ largest Emacs integer.") -;;; Coerce integer A to be a bignum. [B S] +;; Coerce integer A to be a bignum. [B S] (defun math-bignum (a) (if (>= a 0) (cons 'bigpos (math-bignum-big a)) @@ -2693,7 +2683,7 @@ largest Emacs integer.") (math-bignum-big (/ a math-bignum-digit-size))))) -;;; Build a normalized floating-point number. [F I S] +;; Build a normalized floating-point number. [F I S] (defun math-make-float (mant exp) (if (eq mant 0) '(float 0 0) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index aead48ddc01..f222360ed48 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -198,7 +198,7 @@ (prefix-numeric-value nterms)))))) -;; The following are global variables used by math-derivative and some +;; The following are global variables used by math-derivative and some ;; related functions (defvar math-deriv-var) (defvar math-deriv-total) @@ -416,7 +416,7 @@ (list 'calcFunc-sec u))))))) (put 'calcFunc-sec\' 'math-derivative-1 - (function (lambda (u) (math-to-radians-2 + (function (lambda (u) (math-to-radians-2 (math-mul (math-normalize (list 'calcFunc-sec u)) @@ -424,7 +424,7 @@ (list 'calcFunc-tan u))))))) (put 'calcFunc-csc\' 'math-derivative-1 - (function (lambda (u) (math-neg + (function (lambda (u) (math-neg (math-to-radians-2 (math-mul (math-normalize @@ -657,14 +657,14 @@ ;; which are called (directly or indirectly) by math-try-integral. (defvar math-integ-depth) ;; math-integ-level is a local variable for math-try-integral, but is used -;; by math-integral, math-do-integral, math-tracing-integral, -;; math-sub-integration, math-integrate-by-parts and -;; math-integrate-by-substitution, which are called (directly or +;; by math-integral, math-do-integral, math-tracing-integral, +;; math-sub-integration, math-integrate-by-parts and +;; math-integrate-by-substitution, which are called (directly or ;; indirectly) by math-try-integral. (defvar math-integ-level) ;; math-integral-limit is a local variable for calcFunc-integ, but is -;; used by math-tracing-integral, math-sub-integration and -;; math-try-integration. +;; used by math-tracing-integral, math-sub-integration and +;; math-try-integration. (defvar math-integral-limit) (defmacro math-tracing-integral (&rest parts) @@ -828,11 +828,11 @@ ;; used by math-sub-integration. (defvar math-old-integ) -;; The variables math-t1, math-t2 and math-t3 are local to +;; The variables math-t1, math-t2 and math-t3 are local to ;; math-do-integral, math-try-solve-for and math-decompose-poly, but -;; are used by functions they call (directly or indirectly); +;; are used by functions they call (directly or indirectly); ;; math-do-integral calls math-do-integral-methods; -;; math-try-solve-for calls math-try-solve-prod, +;; math-try-solve-for calls math-try-solve-prod, ;; math-solve-find-root-term and math-solve-find-root-in-prod; ;; math-decompose-poly calls math-solve-poly-funny-powers and ;; math-solve-crunch-poly. @@ -1075,12 +1075,12 @@ (list 'calcFunc-integfailed expr))) ;; math-so-far is a local variable for math-do-integral-methods, but -;; is used by math-integ-try-linear-substitutions and +;; is used by math-integ-try-linear-substitutions and ;; math-integ-try-substitutions. (defvar math-so-far) ;; math-integ-expr is a local variable for math-do-integral-methods, -;; but is used by math-integ-try-linear-substitutions and +;; but is used by math-integ-try-linear-substitutions and ;; math-integ-try-substitutions. (defvar math-integ-expr) @@ -1253,8 +1253,8 @@ temp (let (calc-next-why) (math-simplify-extended (math-solve-for (math-sub v temp) 0 v nil))) - temp (if (and (eq (car-safe temp) '/) - (math-zerop (nth 2 temp))) + temp (if (and (eq (car-safe temp) '/) + (math-zerop (nth 2 temp))) nil temp))))) (setcar (cdr math-cur-record) 'busy))))) @@ -1675,7 +1675,7 @@ (math-defintegral calcFunc-sec (and (equal u math-integ-var) (math-from-radians-2 - (list 'calcFunc-ln + (list 'calcFunc-ln (math-add (list 'calcFunc-sec u) (list 'calcFunc-tan u)))))) @@ -1683,7 +1683,7 @@ (math-defintegral calcFunc-csc (and (equal u math-integ-var) (math-from-radians-2 - (list 'calcFunc-ln + (list 'calcFunc-ln (math-sub (list 'calcFunc-csc u) (list 'calcFunc-cot u)))))) @@ -1882,13 +1882,14 @@ (defvar math-tabulate-initial nil) (defvar math-tabulate-function nil) -;; The variables calc-low and calc-high are local to calcFunc-table, -;; but are used by math-scan-for-limits. +;; These variables are local to calcFunc-table, but are used by +;; math-scan-for-limits. (defvar calc-low) (defvar calc-high) +(defvar var) (defun calcFunc-table (expr var &optional calc-low calc-high step) - (or calc-low + (or calc-low (setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf))) (or calc-high (setq calc-high calc-low calc-low 1)) (and (or (math-infinitep calc-low) (math-infinitep calc-high)) @@ -2348,23 +2349,23 @@ (defvar math-solve-ranges nil) (defvar math-solve-sign) -;;; Attempt to reduce math-solve-lhs = math-solve-rhs to +;;; Attempt to reduce math-solve-lhs = math-solve-rhs to ;;; math-solve-var = math-solve-rhs', where math-solve-var appears -;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs'; +;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs'; ;;; return math-solve-rhs'. ;;; Uses global values: math-solve-var, math-solve-full. (defvar math-solve-var) (defvar math-solve-full) -;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign -;; are local to math-try-solve-for, but are used by math-try-solve-prod. -;; (math-solve-lhs and math-solve-rhs are is also local to +;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign +;; are local to math-try-solve-for, but are used by math-try-solve-prod. +;; (math-solve-lhs and math-solve-rhs are is also local to ;; math-decompose-poly, but used by math-solve-poly-funny-powers.) (defvar math-solve-lhs) (defvar math-solve-rhs) (defvar math-try-solve-sign) -(defun math-try-solve-for +(defun math-try-solve-for (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly) (let (math-t1 math-t2 math-t3) (cond ((equal math-solve-lhs math-solve-var) @@ -2395,7 +2396,7 @@ (setq math-t2 (funcall math-t1 '(var SOLVEDUM SOLVEDUM))) (eq (math-expr-contains-count math-t2 '(var SOLVEDUM SOLVEDUM)) 1) (setq math-t3 (math-solve-above-dummy math-t2)) - (setq math-t1 (math-try-solve-for + (setq math-t1 (math-try-solve-for (math-sub (nth 1 (nth 1 math-solve-lhs)) (math-expr-subst math-t2 math-t3 @@ -2407,8 +2408,8 @@ (and math-try-solve-sign (- math-try-solve-sign)))) ((and (not (eq math-solve-full 't)) (math-try-solve-prod))) ((and (not no-poly) - (setq math-t2 - (math-decompose-poly math-solve-lhs + (setq math-t2 + (math-decompose-poly math-solve-lhs math-solve-var 15 math-solve-rhs))) (setq math-t1 (cdr (nth 1 math-t2)) math-t1 (let ((math-solve-ranges math-solve-ranges)) @@ -2419,7 +2420,7 @@ ((= (length math-t1) 3) (apply 'math-solve-quadratic (car math-t2) math-t1)) ((= (length math-t1) 2) - (apply 'math-solve-linear + (apply 'math-solve-linear (car math-t2) math-try-solve-sign math-t1)) (math-solve-full (math-poly-all-roots (car math-t2) math-t1)) @@ -2474,7 +2475,7 @@ ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 2 math-solve-lhs) (math-sub (nth 1 math-solve-lhs) math-solve-rhs) - (and math-try-solve-sign + (and math-try-solve-sign (- math-try-solve-sign)))) ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 1 math-solve-lhs) @@ -2488,7 +2489,7 @@ (nth 2 math-solve-lhs))))) ((eq (car math-solve-lhs) 'calcFunc-log) (cond ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)) - (math-try-solve-for (nth 1 math-solve-lhs) + (math-try-solve-for (nth 1 math-solve-lhs) (math-pow (nth 2 math-solve-lhs) math-solve-rhs))) ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 2 math-solve-lhs) (math-pow @@ -2503,7 +2504,7 @@ (and math-try-solve-sign math-t1 (if (integerp math-t1) (* math-t1 math-try-solve-sign) - (funcall math-t1 math-solve-lhs + (funcall math-t1 math-solve-lhs math-try-solve-sign))))) ((and (symbolp (car math-solve-lhs)) (setq math-t1 (get (car math-solve-lhs) 'math-inverse-n)) @@ -2521,12 +2522,12 @@ (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 2 math-solve-lhs) (math-div math-solve-rhs (nth 1 math-solve-lhs)) - (math-solve-sign math-try-solve-sign + (math-solve-sign math-try-solve-sign (nth 1 math-solve-lhs)))) ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 1 math-solve-lhs) (math-div math-solve-rhs (nth 2 math-solve-lhs)) - (math-solve-sign math-try-solve-sign + (math-solve-sign math-try-solve-sign (nth 2 math-solve-lhs)))) ((Math-zerop math-solve-rhs) (math-solve-prod (let ((math-solve-ranges math-solve-ranges)) @@ -2536,12 +2537,12 @@ (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 2 math-solve-lhs) (math-div (nth 1 math-solve-lhs) math-solve-rhs) - (math-solve-sign math-try-solve-sign + (math-solve-sign math-try-solve-sign (nth 1 math-solve-lhs)))) ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)) (math-try-solve-for (nth 1 math-solve-lhs) (math-mul math-solve-rhs (nth 2 math-solve-lhs)) - (math-solve-sign math-try-solve-sign + (math-solve-sign math-try-solve-sign (nth 2 math-solve-lhs)))) ((setq math-t1 (math-try-solve-for (math-sub (nth 1 math-solve-lhs) (math-mul (nth 2 math-solve-lhs) @@ -2581,14 +2582,14 @@ (math-normalize math-t2))) ((math-looks-negp (nth 2 math-solve-lhs)) (math-try-solve-for - (list '^ (nth 1 math-solve-lhs) + (list '^ (nth 1 math-solve-lhs) (math-neg (nth 2 math-solve-lhs))) (math-div 1 math-solve-rhs))) ((and (eq math-solve-full t) (Math-integerp (nth 2 math-solve-lhs)) (math-known-realp (nth 1 math-solve-lhs))) (setq math-t1 (math-normalize - (list 'calcFunc-nroot math-solve-rhs + (list 'calcFunc-nroot math-solve-rhs (nth 2 math-solve-lhs)))) (if (math-evenp (nth 2 math-solve-lhs)) (setq math-t1 (math-solve-get-sign math-t1))) @@ -2596,7 +2597,7 @@ (nth 1 math-solve-lhs) math-t1 (and math-try-solve-sign (math-oddp (nth 2 math-solve-lhs)) - (math-solve-sign math-try-solve-sign + (math-solve-sign math-try-solve-sign (nth 2 math-solve-lhs))))) (t (math-try-solve-for (nth 1 math-solve-lhs) @@ -2628,7 +2629,7 @@ (nth 2 math-solve-lhs)))) (and math-try-solve-sign (math-oddp (nth 2 math-solve-lhs)) - (math-solve-sign math-try-solve-sign + (math-solve-sign math-try-solve-sign (nth 2 math-solve-lhs))))))))) (t nil))) @@ -2665,7 +2666,7 @@ (setq math-t2 (math-mul (or math-poly-mult-powers 1) (let ((calc-prefer-frac t)) (math-div 1 math-poly-frac-powers))) - math-t1 (math-is-polynomial + math-t1 (math-is-polynomial (math-simplify (calcFunc-expand math-t1)) math-solve-b 50)))) ;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2". @@ -2694,7 +2695,7 @@ (setq math-t3 (cons scale (cdr math-t3)) math-t1 new-t1)))) (setq scale (1- scale))) - (setq math-t3 (list (math-mul (car math-t3) math-t2) + (setq math-t3 (list (math-mul (car math-t3) math-t2) (math-mul count math-t2))) (<= (1- (length math-t1)) max-degree))))) @@ -2733,7 +2734,7 @@ (and (not (equal math-solve-b math-solve-lhs)) (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs) (setq math-t3 '(1 0) math-t2 1 - math-t1 (math-is-polynomial math-solve-lhs + math-t1 (math-is-polynomial math-solve-lhs math-solve-b 50)) (if (and (equal math-poly-neg-powers '(1)) (memq math-poly-mult-powers '(nil 1)) @@ -3217,7 +3218,7 @@ (and (not (math-expr-contains (nth 2 x) math-solve-var)) (math-solve-find-root-in-prod (nth 1 x)))))))) -;; The variable math-solve-vars is local to math-solve-system, +;; The variable math-solve-vars is local to math-solve-system, ;; but is used by math-solve-system-rec. (defvar math-solve-vars) @@ -3282,7 +3283,7 @@ (while (and e2 (setq res2 (or (and (eq (car e2) eprev) res2) - (math-solve-for (car e2) 0 + (math-solve-for (car e2) 0 math-solve-system-vv math-solve-full)))) (setq eprev (car e2) @@ -3313,8 +3314,8 @@ solns))) (if elim s - (cons (cons - math-solve-system-vv + (cons (cons + math-solve-system-vv (apply 'append math-solve-system-res)) s))))) (not math-solve-system-res)))) @@ -3350,9 +3351,9 @@ (lambda (r) (if math-solve-simplifying (math-simplify - (math-expr-subst + (math-expr-subst (car x) math-solve-system-vv r)) - (math-expr-subst + (math-expr-subst (car x) math-solve-system-vv r)))) (car res2))) x (cdr x) diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 3c39cd9960e..86856f2c124 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -331,8 +331,7 @@ displayed in a window: (cons 'appt-make-list diary-hook)))) (diary)) (let* ((diary-display-function 'appt-make-list) - (d-buff (find-buffer-visiting - (substitute-in-file-name diary-file))) + (d-buff (find-buffer-visiting diary-file)) (selective (if d-buff ; diary buffer exists (with-current-buffer d-buff @@ -343,8 +342,7 @@ displayed in a window: (if d-buff ;; Displays the diary buffer. (or selective (diary-show-all-entries)) - (and (setq d-buff (find-buffer-visiting - (substitute-in-file-name diary-file))) + (and (setq d-buff (find-buffer-visiting diary-file)) (kill-buffer d-buff))))) (error nil))) (setq appt-prev-comp-time cur-comp-time diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index b806b691adb..03591cf9716 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -517,37 +517,42 @@ Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian." If MONTH, DAY (Chinese) is visible, returns the corresponding Gregorian date as the list (((month day year) STRING)). Returns nil if it is not visible in the current calendar window." - ;; This is calendar-nongregorian-visible-p adapted for the form of - ;; chinese dates: (cycle year month day) as opposed to (month day year). - (let* ((m1 displayed-month) - (y1 displayed-year) - (m2 displayed-month) - (y2 displayed-year) - ;; Absolute date of first/last dates in calendar window. - (start-date (progn - (calendar-increment-month m1 y1 -1) - (calendar-absolute-from-gregorian (list m1 1 y1)))) - (end-date (progn - (calendar-increment-month m2 y2 1) - (calendar-absolute-from-gregorian - (list m2 (calendar-last-day-of-month m2 y2) y2)))) - ;; Local date of first/last date in calendar window. - (local-start (calendar-chinese-from-absolute start-date)) - ;; A basic optimization. We only care about the year part, - ;; and the Chinese year can only change if Jan or Feb are - ;; visible. FIXME can we do more? - (local-end (if (memq displayed-month '(12 1 2 3)) - (calendar-chinese-from-absolute end-date) - local-start)) - ;; When Chinese New Year is visible on the far right of the - ;; calendar, what is the earliest Chinese month in the - ;; previous year that might still visible? This test doesn't - ;; have to be precise. - (local (if (< month 10) local-end local-start)) - (cycle (car local)) - (year (cadr local)) - (date (calendar-gregorian-from-absolute - (calendar-chinese-to-absolute (list cycle year month day))))) + (let ((date + (calendar-gregorian-from-absolute + ;; A basic optimization. Chinese year can only change if + ;; Jan or Feb are visible. FIXME can we do more? + (if (memq displayed-month '(12 1 2 3)) + ;; This is calendar-nongregorian-visible-p adapted for + ;; the form of chinese dates: (cycle year month day) as + ;; opposed to (month day year). + (let* ((m1 displayed-month) + (y1 displayed-year) + (m2 displayed-month) + (y2 displayed-year) + ;; Absolute date of first/last dates in calendar window. + (start-date (progn + (calendar-increment-month m1 y1 -1) + (calendar-absolute-from-gregorian + (list m1 1 y1)))) + (end-date (progn + (calendar-increment-month m2 y2 1) + (calendar-absolute-from-gregorian + (list m2 (calendar-last-day-of-month m2 y2) + y2)))) + ;; Local date of first/last date in calendar window. + (local-start (calendar-chinese-from-absolute start-date)) + (local-end (calendar-chinese-from-absolute end-date)) + ;; When Chinese New Year is visible on the far + ;; right of the calendar, what is the earliest + ;; Chinese month in the previous year that might + ;; still visible? This test doesn't have to be precise. + (local (if (< month 10) local-end local-start)) + (cycle (car local)) + (year (cadr local))) + (calendar-chinese-to-absolute (list cycle year month day))) + ;; Simple form for when new years are not visible. + (+ (cadr (assoc month (calendar-chinese-year displayed-year))) + (1- day)))))) (if (calendar-date-is-visible-p date) (list (list date string))))) diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index d60daaafc1c..e39e181dbed 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -145,12 +145,23 @@ (defconst cal-menu-scroll-menu '("Scroll" + ["Scroll Commands" nil :help "Commands that scroll the visible window"] ["Forward 1 Month" calendar-scroll-left] ["Forward 3 Months" calendar-scroll-left-three-months] ["Forward 1 Year" (calendar-scroll-left 12) :keys "4 C-v"] ["Backward 1 Month" calendar-scroll-right] ["Backward 3 Months" calendar-scroll-right-three-months] - ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"]) + ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"] + "--" + ["Motion Commands" nil :help "Commands that move point"] + ["Forward 1 Day" calendar-forward-day] + ["Forward 1 Week" calendar-forward-week] + ["Forward 1 Month" calendar-forward-month] + ["Forward 1 Year" calendar-forward-year] + ["Backward 1 Day" calendar-backward-day] + ["Backward 1 Week" calendar-backward-week] + ["Backward 1 Month" calendar-backward-month] + ["Backward 1 Year" calendar-backward-year]) "Key map for \"Scroll\" menu in the calendar.") (declare-function x-popup-menu "xmenu.c" (position menu)) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index d601cf6a22c..2617c8004b7 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -214,10 +214,10 @@ If nil, make an icon of the frame. If non-nil, delete the frame." (defface calendar-today '((t (:underline t))) "Face for indicating today's date in the calendar. -See `calendar-today-marker'." +See the variable `calendar-today-marker'." :group 'calendar-faces) -;; Backward-compatibility alias. FIXME make obsolete. -(put 'calendar-today-face 'face-alias 'calendar-today) + +(define-obsolete-face-alias 'calendar-today-face 'calendar-today "22.1") (defface diary '((((min-colors 88) (class color) (background light)) @@ -234,8 +234,8 @@ See `calendar-today-marker'." Used to mark diary entries in the calendar (see `diary-entry-marker'), and to highlight the date header in the fancy diary." :group 'calendar-faces) -;; Backward-compatibility alias. FIXME make obsolete. -(put 'diary-face 'face-alias 'diary) + +(define-obsolete-face-alias 'diary-face 'diary "22.1") (defface holiday '((((class color) (background light)) @@ -247,8 +247,8 @@ and to highlight the date header in the fancy diary." "Face for indicating in the calendar dates that have holidays. See `calendar-holiday-marker'." :group 'calendar-faces) -;; Backward-compatibility alias. FIXME make obsolete. -(put 'holiday-face 'face-alias 'holiday) + +(define-obsolete-face-alias 'holiday-face 'holiday "22.1") ;; These briefly checked font-lock-mode, but that is broken, since it ;; is a buffer-local variable, and which buffer happens to be current @@ -1594,6 +1594,14 @@ line." (define-key map [down-mouse-2] (easy-menu-binding cal-menu-global-mouse-menu)) + ;; Left-click moves us forward in time, right-click backwards. + ;; cf scroll-bar.el. + (define-key map [vertical-scroll-bar mouse-1] 'calendar-scroll-left) + (define-key map [vertical-scroll-bar drag-mouse-1] 'calendar-scroll-left) + ;; down-mouse-2 stays as scroll-bar-drag. + (define-key map [vertical-scroll-bar mouse-3] 'calendar-scroll-right) + (define-key map [vertical-scroll-bar drag-mouse-3] 'calendar-scroll-right) + map) "Keymap for `calendar-mode'.") @@ -2337,6 +2345,7 @@ The date is marked with `calendar-today-marker'. You might want to add this function to `calendar-today-visible-hook'." (calendar-mark-visible-date (calendar-cursor-to-date) calendar-today-marker)) +;; FIXME why the car? Almost every usage calls list on the args. (defun calendar-date-compare (date1 date2) "Return t if DATE1 is before DATE2, nil otherwise. The actual dates are in the car of DATE1 and DATE2." diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 0081170d8ac..9ed28c403a9 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -71,8 +71,8 @@ are holidays." "Face used for buttons in the fancy diary display." :version "22.1" :group 'calendar-faces) -;; Backward-compatibility alias. FIXME make obsolete. -(put 'diary-button-face 'face-alias 'diary-button) + +(define-obsolete-face-alias 'diary-button-face 'diary-button "22.1") ;; Face markup of calendar and diary displays: Any entry line that ;; ends with [foo:value] where foo is a face attribute (except :box @@ -151,10 +151,9 @@ Used for example by the appointment package - see `appt-activate'." (define-obsolete-variable-alias 'diary-display-hook 'diary-display-function "23.1") -(defcustom diary-display-function 'diary-simple-display +(defcustom diary-display-function 'diary-fancy-display "Function used to display the diary. -The default is `diary-simple-display'; `diary-fancy-display' is -an alternative. +The two standard options are `diary-fancy-display' and `diary-simple-display'. For historical reasons, `nil' is the same as `diary-simple-display' \(so you must use `ignore' for no display). Also for historical @@ -167,14 +166,14 @@ form of ((MONTH DAY YEAR) STRING), where string is the diary entry for the given date. This can be used, for example, to produce a different buffer for display (perhaps combined with holidays), or hard copy output." - :type '(choice (const diary-simple-display :tag "Basic display") - (const diary-fancy-display :tag "Fancy display") + :type '(choice (const diary-fancy-display :tag "Fancy display") + (const diary-simple-display :tag "Basic display") (const ignore :tag "No display") (const nil :tag "Obsolete way to choose basic display") (hook :tag "Obsolete form with list of display functions")) :initialize 'custom-initialize-default :set 'diary-set-maybe-redraw - :version "23.1" + :version "23.2" ; simple->fancy :group 'diary) (define-obsolete-variable-alias 'list-diary-entries-hook @@ -355,9 +354,7 @@ template following the rules above." (defun diary-set-header (symbol value) "Set SYMBOL's value to VALUE, and redraw the diary header if necessary." (let ((oldvalue (symbol-value symbol)) - (dbuff (and diary-file - (find-buffer-visiting - (substitute-in-file-name diary-file))))) + (dbuff (and diary-file (find-buffer-visiting diary-file)))) (custom-set-default symbol value) (and dbuff (not (equal value oldvalue)) @@ -410,8 +407,7 @@ Only used if `diary-header-line-flag' is non-nil." (defun diary-live-p () "Return non-nil if the diary is being displayed." (or (get-buffer diary-fancy-buffer) - (and diary-file - (find-buffer-visiting (substitute-in-file-name diary-file))))) + (and diary-file (find-buffer-visiting diary-file)))) ;;;###cal-autoload (defun diary-set-maybe-redraw (symbol value) @@ -463,12 +459,11 @@ of days of diary entries displayed." (defun diary-check-diary-file () "Check that the file specified by `diary-file' exists and is readable. If so, return the expanded file name, otherwise signal an error." - (let ((d-file (substitute-in-file-name diary-file))) - (if (and d-file (file-exists-p d-file)) - (if (file-readable-p d-file) - d-file - (error "Diary file `%s' is not readable" diary-file)) - (error "Diary file `%s' does not exist" diary-file)))) + (if (and diary-file (file-exists-p diary-file)) + (if (file-readable-p diary-file) + diary-file + (error "Diary file `%s' is not readable" diary-file)) + (error "Diary file `%s' does not exist" diary-file))) ;;;###autoload (defun diary (&optional arg) @@ -659,7 +654,7 @@ any entries were found." ;; regexp moves us past the end of date, onto the next line. ;; Trailing whitespace after date not allowed (see diary-file). (if (and (bolp) (not (looking-at "[ \t]"))) - ;; Diary entry that consists only of date. + ;; Diary entry that consists only of date. (backward-char 1) ;; Found a nonempty diary entry--make it ;; visible and add it to the list. @@ -746,18 +741,17 @@ LIST-ONLY is non-nil, in which case it just returns the list." (when (> number 0) (let* ((original-date date) ; save for possible use in the hooks (date-string (calendar-date-string date)) - (d-file (substitute-in-file-name diary-file)) - (diary-buffer (find-buffer-visiting d-file)) + (diary-buffer (find-buffer-visiting diary-file)) diary-entries-list file-glob-attrs) (message "Preparing diary...") (save-excursion (if (not diary-buffer) - (set-buffer (find-file-noselect d-file t)) + (set-buffer (find-file-noselect diary-file t)) (set-buffer diary-buffer) (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t))) ;; Setup things like the header-line-format and invisibility-spec. - (if (eq major-mode default-major-mode) + (if (eq major-mode (default-value 'major-mode)) (diary-mode) ;; This kludge is to make customizations to ;; diary-header-line-flag after diary has been displayed @@ -827,12 +821,10 @@ the variable `diary-include-string'." (while (re-search-forward (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string)) nil t) - (let ((diary-file (substitute-in-file-name - (match-string-no-properties 1))) - (diary-list-include-blanks nil) + (let ((diary-file (match-string-no-properties 1)) (diary-list-entries-hook 'diary-include-other-diary-files) (diary-display-function 'ignore) - (diary-hook nil)) + diary-hook diary-list-include-blanks) (if (file-exists-p diary-file) (if (file-readable-p diary-file) (unwind-protect @@ -895,7 +887,7 @@ in the mode line. This is an option for `diary-display-function'." ;; to display the diary. (let* ((pop-up-frames (or pop-up-frames (window-dedicated-p (selected-window)))) - (dbuff (find-buffer-visiting (substitute-in-file-name diary-file))) + (dbuff (find-buffer-visiting diary-file)) (empty (diary-display-no-entries))) ;; This may be too wide, but when simple diary is used there is ;; nowhere else for the holidays to go. Also, it is documented in @@ -915,9 +907,9 @@ in the mode line. This is an option for `diary-display-function'." (define-obsolete-function-alias 'simple-diary-display 'diary-simple-display "23.1") -(define-button-type 'diary-entry - 'action #'diary-goto-entry - 'face 'diary-button) +(define-button-type 'diary-entry 'action #'diary-goto-entry + 'face 'diary-button 'help-echo "Find this diary entry" + 'follow-link t) (defun diary-goto-entry (button) "Jump to the diary entry for the BUTTON at point." @@ -934,7 +926,7 @@ in the mode line. This is an option for `diary-display-function'." (file-exists-p file) (find-file-other-window file) (progn - (when (eq major-mode default-major-mode) (diary-mode)) + (when (eq major-mode (default-value 'major-mode)) (diary-mode)) (goto-char (point-min)) (if (re-search-forward (format "%s.*\\(%s\\)" (regexp-quote (nth 2 locator)) @@ -951,8 +943,7 @@ holiday), unless `diary-list-include-blanks' is non-nil. This is an option for `diary-display-function'." ;; Turn off selective-display in the diary file's buffer. - (with-current-buffer - (find-buffer-visiting (substitute-in-file-name diary-file)) + (with-current-buffer (find-buffer-visiting diary-file) (diary-unhide-everything)) (unless (car (diary-display-no-entries)) ; no entries ;; Prepare the fancy diary buffer. @@ -1008,7 +999,7 @@ This is an option for `diary-display-function'." this-loc marks temp-face) (unless (zerop (length this-entry)) (if (setq this-loc (nth 3 entry)) - (insert-button (concat this-entry "\n") + (insert-button this-entry ;; (MARKER FILENAME SPECIFIER LITERAL) 'locator (list (car this-loc) (cadr this-loc) @@ -1016,7 +1007,8 @@ This is an option for `diary-display-function'." (or (nth 2 this-loc) (nth 1 entry))) :type 'diary-entry) - (insert this-entry ?\n)) + (insert this-entry)) + (insert ?\n) ;; Doesn't make sense to check font-lock-mode - see ;; comments above diary-entry-marker in calendar.el. (and ; font-lock-mode @@ -1027,7 +1019,11 @@ This is an option for `diary-display-function'." (overlay-put (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face))))))) - (diary-fancy-display-mode) + ;; FIXME can't remember what this check was for. + ;; To prevent something looping, or a minor optimization? + (if (eq major-mode 'diary-fancy-display-mode) + (run-hooks 'diary-fancy-display-mode-hook) + (diary-fancy-display-mode)) (calendar-set-mode-line date-string) (message "Preparing diary...done")))) @@ -1052,8 +1048,7 @@ the actual printing." (if diary-buffer (with-current-buffer diary-buffer (run-hooks 'diary-print-entries-hook)) - (or (setq diary-buffer - (find-buffer-visiting (substitute-in-file-name diary-file))) + (or (setq diary-buffer (find-buffer-visiting diary-file)) (error "You don't have a diary buffer!")) ;; Name affects printing? (setq temp-buffer (get-buffer-create " *Printable Diary Entries*")) @@ -1094,7 +1089,7 @@ is created." (window-dedicated-p (selected-window))))) (with-current-buffer (or (find-buffer-visiting d-file) (find-file-noselect d-file t)) - (when (eq major-mode default-major-mode) (diary-mode)) + (when (eq major-mode (default-value 'major-mode)) (diary-mode)) (diary-unhide-everything) (display-buffer (current-buffer))))) @@ -1246,7 +1241,9 @@ function that converts absolute dates to dates of the appropriate type. " (buffer-substring-no-properties (point) (line-end-position)) file-glob-attrs))) - (if dd-name + ;; Only mark all days of a given name if the pattern + ;; contains no more specific elements. + (if (and dd-name (not (or d-pos m-pos y-pos))) (calendar-mark-days-named (cdr (assoc-string dd-name (calendar-make-alist @@ -1287,7 +1284,7 @@ diary entries." file-glob-attrs) (with-current-buffer (find-file-noselect (diary-check-diary-file) t) (save-excursion - (when (eq major-mode default-major-mode) (diary-mode)) + (when (eq major-mode (default-value 'major-mode)) (diary-mode)) (setq calendar-mark-diary-entries-flag t) (message "Marking diary entries...") (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) @@ -1391,8 +1388,7 @@ the variable `diary-include-string'." (while (re-search-forward (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string)) nil t) - (let* ((diary-file (substitute-in-file-name - (match-string-no-properties 1))) + (let* ((diary-file (match-string-no-properties 1)) (diary-mark-entries-hook 'diary-mark-included-diary-files) (dbuff (find-buffer-visiting diary-file))) (if (file-exists-p diary-file) @@ -1980,8 +1976,8 @@ If omitted, NONMARKING defaults to nil and FILE defaults to `diary-file'." (let ((pop-up-frames (or pop-up-frames (window-dedicated-p (selected-window))))) - (find-file-other-window (substitute-in-file-name (or file diary-file)))) - (when (eq major-mode default-major-mode) (diary-mode)) + (find-file-other-window (or file diary-file))) + (when (eq major-mode (default-value 'major-mode)) (diary-mode)) (widen) (diary-unhide-everything) (goto-char (point-max)) @@ -2356,6 +2352,11 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." (setq end (line-beginning-position 2))) (font-lock-default-fontify-region beg end verbose)) +(defvar diary-fancy-overriding-map (let ((map (make-sparse-keymap))) + (define-key map "q" 'quit-window) + map) + "Keymap overriding minor-mode maps in `diary-fancy-display-mode'.") + (define-derived-mode diary-fancy-display-mode fundamental-mode "Diary" "Major mode used while displaying diary entries using Fancy Display." @@ -2364,7 +2365,10 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." t nil nil nil (font-lock-fontify-region-function . diary-fancy-font-lock-fontify-region-function))) - (local-set-key "q" 'quit-window)) + (local-set-key "q" 'quit-window) + (set (make-local-variable 'minor-mode-overriding-map-alist) + (list (cons t diary-fancy-overriding-map))) + (view-mode 1)) (define-obsolete-function-alias 'fancy-diary-display-mode 'diary-fancy-display-mode "23.1") @@ -2379,6 +2383,7 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." ;; `diary-outlook-formats'. (defvar subject) ; bound in diary-from-outlook-gnus +(defvar body) (defun diary-from-outlook-internal (&optional test-only) "Snarf a diary entry from a message assumed to be from MS Outlook. diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 1e779452886..1b5cd36b23c 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -44,17 +44,28 @@ ;; calendar-astro-to-absolute and v versa are cal-autoloads. ;;;(require 'cal-julian) +(defcustom lunar-phase-names + '("New Moon" "First Quarter Moon" "Full Moon" "Last Quarter Moon") + "List of names for the lunar phases." + :type '(list + (string :tag "New Moon") + (string :tag "First Quarter Moon") + (string :tag "Full Moon") + (string :tag "Last Quarter Moon")) + :group 'calendar + :version "23.2") + (defun lunar-phase (index) "Local date and time of lunar phase INDEX. Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900; remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, -3 last quarter." +3 last quarter. Returns a list (DATE TIME PHASE)." (let* ((phase (mod index 4)) (index (/ index 4.0)) (time (/ index 1236.85)) (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900)) 0.75933 - (* 29.53058868 index) + (* 29.53058868 index) ; FIXME 29.530588853? (* 0.0001178 time time) (* -0.000000155 time time time) (* 0.00033 @@ -136,28 +147,37 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, (adj (dst-adjust-time date time))) (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) +(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853 + "Mean number of lunar cycles per 365.25 day year.") + +;; FIXME new-moon index; use in lunar-phase-list implies always below. +(defun lunar-index (date) + "Return the lunar index for Gregorian date DATE. +This is 4 times the approximate number of new moons since 1 Jan 1900. +The factor of 4 allows (mod INDEX 4) to represent the four quarters." + (* 4 (truncate + (* lunar-cycles-per-year + ;; Years since 1900, as a real. + (+ (calendar-extract-year date) + (/ (calendar-day-number date) 366.0) + -1900))))) + (defun lunar-phase-list (month year) "List of lunar phases for three months starting with Gregorian MONTH, YEAR." - (let* ((end-month month) - (end-year year) - (start-month month) - (start-year year) - (end-date (progn + (let* ((index (lunar-index (list month 1 year))) + (new-moon (lunar-phase index)) + (end-date (let ((end-month month) + (end-year year)) (calendar-increment-month end-month end-year 3) (list (list end-month 1 end-year)))) + ;; Alternative for start-date: +;;; (calendar-gregorian-from-absolute +;;; (1- (calendar-absolute-from-gregorian (list month 1 year)))) (start-date (progn - (calendar-increment-month start-month start-year -1) - (list (list start-month - (calendar-last-day-of-month - start-month start-year) - start-year)))) - (index (* 4 (truncate - (* 12.3685 - (+ year - ( / (calendar-day-number (list month 1 year)) - 366.0) - -1900))))) - (new-moon (lunar-phase index)) + (calendar-increment-month month year -1) + (list (list month + (calendar-last-day-of-month month year) + year)))) list) (while (calendar-date-compare new-moon end-date) (if (calendar-date-compare start-date new-moon) @@ -169,10 +189,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, (defun lunar-phase-name (phase) "Name of lunar PHASE. 0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter." - (cond ((= 0 phase) "New Moon") - ((= 1 phase) "First Quarter Moon") - ((= 2 phase) "Full Moon") - ((= 3 phase) "Last Quarter Moon"))) + (nth phase lunar-phase-names)) (defvar displayed-month) ; from calendar-generate (defvar displayed-year) @@ -204,14 +221,9 @@ use instead of point." (insert (mapconcat (lambda (x) - (let ((date (car x)) - (time (cadr x)) - (phase (nth 2 x))) - (concat (calendar-date-string date) - ": " - (lunar-phase-name phase) - " " - time))) + (format "%s: %s %s" (calendar-date-string (car x)) + (lunar-phase-name (nth 2 x)) + (cadr x))) (lunar-phase-list m1 y1) "\n"))) (message "Computing phases of the moon...done")))) @@ -244,13 +256,7 @@ This function is suitable for execution in a .emacs file." "Moon phases diary entry. An optional parameter MARK specifies a face or single-character string to use when highlighting the day in the calendar." - (let* ((index (* 4 - (truncate - (* 12.3685 - (+ (calendar-extract-year date) - ( / (calendar-day-number date) - 366.0) - -1900))))) + (let* ((index (lunar-index date)) (phase (lunar-phase index))) (while (calendar-date-compare phase (list date)) (setq index (1+ index) @@ -385,7 +391,7 @@ as governed by the values of `calendar-daylight-savings-starts', (floor (calendar-astro-to-absolute d)))) (year (+ (calendar-extract-year date) (/ (calendar-day-number date) 365.25))) - (k (floor (* (- year 2000.0) 12.3685))) + (k (floor (* (- year 2000.0) lunar-cycles-per-year))) (date (lunar-new-moon-time k)) (a-date (progn (while (< date d) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 56a2fd715d2..b0e8cac51e5 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -175,6 +175,7 @@ ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) "(slots predicate extractor...)") +;;;###autoload(put 'parse-time-rules 'risky-local-variable t) ;;;###autoload (defun parse-time-string (string) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 3478f9646ea..ec0c8dc8bee 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -111,14 +111,30 @@ and type 2 is the list (HIGH LOW MICRO)." (timezone-make-date-arpa-standard date))) (error (error "Invalid date: %s" date)))) -;;;###autoload -(defun time-to-seconds (time) - "Convert time value TIME to a floating point number. -You can use `float-time' instead." - (with-decoded-time-value ((high low micro time)) - (+ (* 1.0 high 65536) - low - (/ micro 1000000.0)))) +;; Bit of a mess. Emacs has float-time since at least 21.1. +;; This file is synced to Gnus, and XEmacs packages may have been written +;; using time-to-seconds from the Gnus library. +;;;###autoload(if (and (fboundp 'float-time) +;;;###autoload (subrp (symbol-function 'float-time))) +;;;###autoload (progn +;;;###autoload (defalias 'time-to-seconds 'float-time) +;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) +;;;###autoload (autoload 'time-to-seconds "time-date")) + +(eval-and-compile + (unless (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defun time-to-seconds (time) + "Convert time value TIME to a floating point number." + (with-decoded-time-value ((high low micro time)) + (+ (* 1.0 high 65536) + low + (/ micro 1000000.0)))))) + +(eval-when-compile + (unless (fboundp 'with-no-warnings) + (defmacro with-no-warnings (&rest body) + `(progn ,@body)))) ;;;###autoload (defun seconds-to-time (seconds) @@ -242,10 +258,17 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (- (/ (1- year) 100)) ; - century years (/ (1- year) 400)))) ; + Gregorian leap years -(defun time-to-number-of-days (time) - "Return the number of days represented by TIME. +(eval-and-compile + (if (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defun time-to-number-of-days (time) + "Return the number of days represented by TIME. +The number of days will be returned as a floating point number." + (/ (float-time time) (* 60 60 24))) + (defun time-to-number-of-days (time) + "Return the number of days represented by TIME. The number of days will be returned as a floating point number." - (/ (time-to-seconds time) (* 60 60 24))) + (/ (with-no-warnings (time-to-seconds time)) (* 60 60 24))))) ;;;###autoload (defun safe-date-to-time (date) diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index 74cbbb11b3f..930aa3098d5 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -25,8 +25,10 @@ ;;; Code: +(declare-function inversion-check-version "inversion") + (defvar cedet-cscope-min-version "16.0" - "Minimum version of GNU global required.") + "Minimum version of CScope required.") (defcustom cedet-cscope-command "cscope" "Command name for the CScope executable." @@ -119,12 +121,10 @@ the error code." nil t)))) -(declare-function inversion-check-version "inversion") - (defun cedet-cscope-version-check (&optional noerror) "Check the version of the installed CScope command. If optional programatic argument NOERROR is non-nil, then -instead of throwing an error if Global isn't available, then +instead of throwing an error if CScope isn't available, then return nil." (interactive) (require 'inversion) diff --git a/lisp/cedet/cedet-edebug.el b/lisp/cedet/cedet-edebug.el deleted file mode 100644 index 09af834853c..00000000000 --- a/lisp/cedet/cedet-edebug.el +++ /dev/null @@ -1,127 +0,0 @@ -;;; cedet-edebug.el --- Special EDEBUG augmentation code - -;;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 -;; Keywords: OO, lisp - -;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Some aspects of EDEBUG are not extensible. It is possible to extend -;; edebug through other means, such as alias or advice, but those don't stack -;; very well when there are multiple tools trying to do the same sort of thing. -;; -;; This package provides a way to extend some aspects of edebug, such as value -;; printing. - -;;; Code: -(require 'edebug) -(require 'debug) - -(defvar cedet-edebug-prin1-extensions nil - "An alist of of code that can extend PRIN1 for edebug. -Each entry has the value: (CONDITION . PRIN1COMMAND).") - -(defun cedet-edebug-prin1-recurse (object) - "Recurse into OBJECT for prin1 on `cedet-edebug-prin1-to-string'." - (concat "(" (mapconcat 'cedet-edebug-prin1-to-string object " ") ")")) - -(defun cedet-edebug-rebuild-prin1 () - "Rebuild the function `cedet-edebug-prin1-to-string'. -Use the values of `cedet-edebug-prin1-extensions' as the means of -constructing the function." - (interactive) - (let ((c cedet-edebug-prin1-extensions) - (code nil)) - (while c - (setq code (append (list (list (car (car c)) - (cdr (car c)))) - code)) - (setq c (cdr c))) - (fset 'cedet-edebug-prin1-to-string-inner - `(lambda (object &optional noescape) - "Display eieio OBJECT in fancy format. Overrides the edebug default. -Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." - (cond - ,@(nreverse code) - (t (prin1-to-string object noescape))))) - )) - -(defun cedet-edebug-prin1-to-string (object &optional noescape) - "CEDET version of `edebug-prin1-to-string' that adds specialty -print methods for very large complex objects." - (if (not (fboundp 'cedet-edebug-prin1-to-string-inner)) - ;; Recreate the official fcn now. - (cedet-edebug-rebuild-prin1)) - - ;; Call the auto-generated version. - ;; This is not going to be available at compile time. - (with-no-warnings - (cedet-edebug-prin1-to-string-inner object noescape))) - - -(defun cedet-edebug-add-print-override (testfcn printfcn) - "Add a new EDEBUG print override. -TESTFCN is a routine that returns nil if the first argument -passed to it is not to use PRINTFCN. -PRINTFCN accepts an object identified by TESTFCN and -returns a string. -New tests are always added to the END of the list of tests. -See `cedet-edebug-prin1-extensions' for the official list." - (condition-case nil - (add-to-list 'cedet-edebug-prin1-extensions - (cons testfcn printfcn) - t) - (error ;; That failed, it must be an older version of Emacs - ;; withouth the append argument for `add-to-list' - ;; Doesn't handle the don't add twice case, but that's a - ;; development thing and developers probably use new emacsen. - (setq cedet-edebug-prin1-extensions - (append cedet-edebug-prin1-extensions - (list (cons testfcn printfcn)))))) - ;; whack the old implementation to force a rebuild. - (fmakunbound 'cedet-edebug-prin1-to-string-inner)) - -;;; NOTE TO SELF. Make this system used as an extension -;;; and then autoload the below. -(add-hook 'edebug-setup-hook - (lambda () - (require 'cedet-edebug) - ;; I suspect this isn't the best way to do this, but when - ;; cust-print was used on my system all my objects - ;; appeared as "#1 =" which was not useful. This allows - ;; edebug to print my objects in the nice way they were - ;; meant to with `object-print' and `class-name' - (defalias 'edebug-prin1-to-string 'cedet-edebug-prin1-to-string) - ;; Add a fancy binding into EDEBUG's keymap for ADEBUG. - (define-key edebug-mode-map "A" 'data-debug-edebug-expr) - )) - -;;; DEBUG MODE TOO -;; This seems like as good a place as any to stick this hack. -(add-hook 'debugger-mode-hook - (lambda () - (require 'cedet-edebug) - ;; Add a fancy binding into the debug mode map for ADEBUG. - (define-key debugger-mode-map "A" 'data-debug-edebug-expr) - )) - -(provide 'cedet-edebug) - -;;; cedet-edebug.el ends here diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el index 0f71df697f6..b7d9b5dbdbd 100644 --- a/lisp/cedet/cedet-files.el +++ b/lisp/cedet/cedet-files.el @@ -25,20 +25,13 @@ ;; which are a part of CEDET. ;;; Code: -(defvar cedet-dir-sep-char (if (boundp 'directory-sep-char) - (symbol-value 'directory-sep-char) - ?/) - "Character used for directory separation. -Obsoleted in some versions of Emacs. Needed in others.") - (defun cedet-directory-name-to-file-name (referencedir &optional testmode) "Convert the REFERENCEDIR (a full path name) into a filename. -Converts directory seperation characters into ! characters. +Convert directory seperation characters into ! characters. Optional argument TESTMODE is used by tests to avoid conversion to the file's truename, and dodging platform tricks." - (let ((file referencedir) - dir-sep-string) + (let ((file referencedir)) ;; Expand to full file name (when (not testmode) (setq file (file-truename file))) @@ -51,23 +44,20 @@ to the file's truename, and dodging platform tricks." ;; case of backing up remote files). (when (not testmode) (setq file (expand-file-name (convert-standard-filename file)))) - (setq dir-sep-string (char-to-string cedet-dir-sep-char)) - ;; Normalize DOSish file names: convert all slashes to - ;; directory-sep-char, downcase the drive letter, if any, - ;; and replace the leading "x:" with "/drive_x". + ;; Normalize DOSish file names. (if (eq (aref file 1) ?:) - (setq file (concat dir-sep-string + (setq file (concat "/" "drive_" (char-to-string (downcase (aref file 0))) - (if (eq (aref file 2) cedet-dir-sep-char) + (if (eq (aref file 2) ?/) "" - dir-sep-string) + "/") (substring file 2))))) ;; Make the name unique by substituting directory ;; separators. It may not really be worth bothering about ;; doubling `!'s in the original name... (setq file (subst-char-in-string - cedet-dir-sep-char ?! + ?/ ?! (replace-regexp-in-string "!" "!!" file))) file)) @@ -94,116 +84,9 @@ specific conversions during tests." ;; Handle the \\file\name nomenclature on some windows boxes. (when (string-match "^!" file) - (setq file (concat "//" (substring file 1)))) - ) - + (setq file (concat "//" (substring file 1))))) file)) -;;; Tests -;; -(defvar cedet-files-utest-list - '( - ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" ) - ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" ) - ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" ) - ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" ) - ) - "List of different file names to test. -Each entry is a cons cell of ( FNAME . CONVERTED ) -where FNAME is some file name, and CONVERTED is what it should be -converted into.") - -(defun cedet-files-utest () - "Test out some file name conversions." - (interactive) - - (let ((idx 0)) - (dolist (FT cedet-files-utest-list) - - (setq idx (+ idx 1)) - - (let ((dir->file (cedet-directory-name-to-file-name (car FT) t)) - (file->dir (cedet-file-name-to-directory-name (cdr FT) t)) - ) - - (unless (string= (cdr FT) dir->file) - (error "Failed: %d. Found: %S Wanted: %S" - idx dir->file (cdr FT)) - ) - - (unless (string= file->dir (car FT)) - (error "Failed: %d. Found: %S Wanted: %S" - idx file->dir (car FT)) - ) - - )))) - - -;;; Compatibility -;; -;; replace-regexp-in-string is in subr.el in Emacs 21. Provide -;; here for compatibility. - -(when (not (fboundp 'replace-regexp-in-string)) - -(defun replace-regexp-in-string (regexp rep string &optional - fixedcase literal subexp start) - "Replace all matches for REGEXP with REP in STRING. - -Return a new string containing the replacements. - -Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the -arguments with the same names of function `replace-match'. If START -is non-nil, start replacements at that index in STRING. - -REP is either a string used as the NEWTEXT arg of `replace-match' or a -function. If it is a function it is applied to each match to generate -the replacement passed to `replace-match'; the match-data at this -point are such that match 0 is the function's argument. - -To replace only the first match (if any), make REGEXP match up to \\' -and replace a sub-expression, e.g. - (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1) - => \" bar foo\"" - - ;; To avoid excessive consing from multiple matches in long strings, - ;; don't just call `replace-match' continually. Walk down the - ;; string looking for matches of REGEXP and building up a (reversed) - ;; list MATCHES. This comprises segments of STRING which weren't - ;; matched interspersed with replacements for segments that were. - ;; [For a `large' number of replacements it's more efficient to - ;; operate in a temporary buffer; we can't tell from the function's - ;; args whether to choose the buffer-based implementation, though it - ;; might be reasonable to do so for long enough STRING.] - (let ((l (length string)) - (start (or start 0)) - matches str mb me) - (save-match-data - (while (and (< start l) (string-match regexp string start)) - (setq mb (match-beginning 0) - me (match-end 0)) - ;; If we matched the empty string, make sure we advance by one char - (when (= me mb) (setq me (min l (1+ mb)))) - ;; Generate a replacement for the matched substring. - ;; Operate only on the substring to minimize string consing. - ;; Set up match data for the substring for replacement; - ;; presumably this is likely to be faster than munging the - ;; match data directly in Lisp. - (string-match regexp (setq str (substring string mb me))) - (setq matches - (cons (replace-match (if (stringp rep) - rep - (funcall rep (match-string 0 str))) - fixedcase literal str subexp) - (cons (substring string start mb) ; unmatched prefix - matches))) - (setq start me)) - ;; Reconstruct a string from the pieces. - (setq matches (cons (substring string start l) matches)) ; leftover - (apply #'concat (nreverse matches))))) - -) - (provide 'cedet-files) ;;; cedet-files.el ends here diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 2cc74f6635e..35a963af577 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -23,6 +23,8 @@ ;; ;; Basic support for calling GNU Global, and testing version numbers. +(declare-function inversion-check-version "inversion") + (defvar cedet-global-min-version "5.0" "Minimum version of GNU global required.") @@ -57,16 +59,14 @@ SCOPE is the scope of the search, such as 'project or 'subdirs." "c") ((eq texttype 'regexp) "g") - (t "r"))) - ) + (t "r")))) (cedet-gnu-global-call (list (concat flgs scopeflgs stflag) searchtext)))) (defun cedet-gnu-global-call (flags) "Call GNU Global with the list of FLAGS." (let ((b (get-buffer-create "*CEDET Global*")) - (cd default-directory) - ) + (cd default-directory)) (save-excursion (set-buffer b) (setq default-directory cd) @@ -104,8 +104,7 @@ Return a fully qualified filename." "Return the root of any GNU Global scanned project. If a default starting DIR is not specified, the current buffer's `default-directory' is used." - (let ((default-directory (or dir default-directory)) - ) + (let ((default-directory (or dir default-directory))) (save-excursion (set-buffer (cedet-gnu-global-call (list "-pq"))) (goto-char (point-min)) @@ -113,8 +112,6 @@ If a default starting DIR is not specified, the current buffer's (file-name-as-directory (buffer-substring (point) (point-at-eol))))))) -(declare-function inversion-check-version "inversion") - (defun cedet-gnu-global-version-check (&optional noerror) "Check the version of the installed GNU Global command. If optional programatic argument NOERROR is non-nil, then diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el index f550e2af506..3635f7fc8ae 100644 --- a/lisp/cedet/cedet-idutils.el +++ b/lisp/cedet/cedet-idutils.el @@ -28,6 +28,8 @@ ;;; Code: +(declare-function inversion-check-version "inversion") + (defvar cedet-idutils-min-version "4.0" "Minimum version of ID Utils required.") @@ -71,8 +73,8 @@ Note: Scope is not yet supported." ;; t means 'symbol (t (list "-l" "-w")))) ) - (cedet-idutils-lid-call (append resultflg scopeflgs stflag (list searchtext)))) - )) + (cedet-idutils-lid-call (append resultflg scopeflgs stflag + (list searchtext)))))) (defun cedet-idutils-fnid-call (flags) "Call ID Utils fnid with the list of FLAGS. @@ -142,8 +144,6 @@ the error code." t)) (error nil))))) -(declare-function inversion-check-version "inversion") - (defun cedet-idutils-version-check (&optional noerror) "Check the version of the installed ID Utils command. If optional programatic argument NOERROR is non-nil, then diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 65da831660e..54c0c933739 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -605,7 +605,7 @@ Argument LIST-O-O is the list of objects to choose from." (defun ede-menu-obj-of-class-p (class) "Return non-nil if some member of `ede-object' is a child of CLASS." (if (listp ede-object) - (ede-or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object)) + (eval (cons 'or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object))) (obj-of-class-p ede-object class))) (defun ede-build-forms-menu (menu-def) @@ -1838,7 +1838,7 @@ See also `ede-map-subprojects'." (defmethod ede-map-any-target-p ((this ede-project) proc) "For project THIS, map PROC to all targets and return if any non-nil. Return the first non-nil value returned by PROC." - (ede-or (ede-map-targets this proc))) + (eval (cons 'or (ede-map-targets this proc)))) ;;; Some language specific methods. @@ -1931,15 +1931,6 @@ If VARIABLE is not project local, just use set." rs)) -;;; Lame stuff -;; -(defun ede-or (arg) - "Do `or' like stuff to ARG because you can't apply `or'." - (while (and arg (not (car arg))) - (setq arg (cdr arg))) - arg) - - ;;; Debugging. (defun ede-adebug-project () diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 348bc3e302b..420ae77e4b4 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -614,7 +614,7 @@ Some compilers only use the first element in the dependencies, others have a list of intermediates (object files), and others don't care. This allows customization of how these elements appear." (let* ((c (ede-proj-compilers this)) - (io (ede-or (mapcar 'ede-compiler-intermediate-objects-p c))) + (io (eval (cons 'or (mapcar 'ede-compiler-intermediate-objects-p c)))) (out nil)) (if io (progn diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 90b65ea8a8e..4c94b18f8f6 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -1,4 +1,4 @@ -;;; ede-proj-comp.el --- EDE Generic Project compiler/rule driver +;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver ;;; Copyright (C) 1999, 2000, 2001, 2004, 2005, 2007, 2009 ;;; Free Software Foundation, Inc. diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 1838bad00e0..b2ec7124605 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; -;; Handle Emacs Lisp in and EDE Project file. +;; Handle Emacs Lisp in an EDE Project file. (require 'ede/proj) (require 'ede/pmake) diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index d74050e758f..185af9cf389 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -1,4 +1,4 @@ -;;; ede-proj.el --- EDE Generic Project file driver +;;; ede/proj.el --- EDE Generic Project file driver ;;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2007, 2008, 2009 ;;; Free Software Foundation, Inc. diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el index 95608c4df0d..7bd0b9696a0 100644 --- a/lisp/cedet/inversion.el +++ b/lisp/cedet/inversion.el @@ -74,6 +74,7 @@ (defvar inversion-version "1.3" "Current version of InVersion.") + (defvar inversion-incompatible-version "0.1alpha1" "An earlier release which is incompatible with this release.") @@ -429,64 +430,6 @@ INSTALLDIR path." (error "Outdated %s %s just installed" package (car newver))) ))))) -;;; Inversion tests -;; -(defun inversion-unit-test () - "Test inversion to make sure it can identify different version strings." - (interactive) - (let ((c1 (inversion-package-version 'inversion)) - (c1i (inversion-package-incompatibility-version 'inversion)) - (c2 (inversion-decode-version "1.3alpha2")) - (c3 (inversion-decode-version "1.3beta4")) - (c4 (inversion-decode-version "1.3 beta5")) - (c5 (inversion-decode-version "1.3.4")) - (c6 (inversion-decode-version "2.3alpha")) - (c7 (inversion-decode-version "1.3")) - (c8 (inversion-decode-version "1.3pre1")) - (c9 (inversion-decode-version "2.4 (patch 2)")) - (c10 (inversion-decode-version "2.4 (patch 3)")) - (c11 (inversion-decode-version "2.4.2.1")) - (c12 (inversion-decode-version "2.4.2.2")) - ) - (if (not (and - (inversion-= c1 c1) - (inversion-< c1i c1) - (inversion-< c2 c3) - (inversion-< c3 c4) - (inversion-< c4 c5) - (inversion-< c5 c6) - (inversion-< c2 c4) - (inversion-< c2 c5) - (inversion-< c2 c6) - (inversion-< c3 c5) - (inversion-< c3 c6) - (inversion-< c7 c6) - (inversion-< c4 c7) - (inversion-< c2 c7) - (inversion-< c8 c6) - (inversion-< c8 c7) - (inversion-< c4 c8) - (inversion-< c2 c8) - (inversion-< c9 c10) - (inversion-< c10 c11) - (inversion-< c11 c12) - ;; Negatives - (not (inversion-< c3 c2)) - (not (inversion-< c4 c3)) - (not (inversion-< c5 c4)) - (not (inversion-< c6 c5)) - (not (inversion-< c7 c2)) - (not (inversion-< c7 c8)) - (not (inversion-< c12 c11)) - ;; Test the tester on inversion - (not (inversion-test 'inversion inversion-version)) - ;; Test that we throw an error - (inversion-test 'inversion "0.0.0") - (inversion-test 'inversion "1000.0") - )) - (error "Inversion tests failed") - (message "Inversion tests passed.")))) - ;;; URL and downloading code ;; (defun inversion-locate-package-files (package directory &optional version) @@ -568,34 +511,31 @@ The package should have VERSION available for download." (copy-file (cdr (car files)) dest)))))) -(defun inversion-upgrade-package (package &optional directory) - "Try to upgrade PACKAGE in DIRECTORY is available." - (interactive "sPackage to upgrade: ") - (if (stringp package) (setq package (intern package))) - (if (not directory) - ;; Hope that the package maintainer specified. - (setq directory (symbol-value (or (intern-soft - (concat (symbol-name package) - "-url")) - (intern-soft - (concat (symbol-name package) - "-directory")))))) - (let ((files (inversion-locate-package-files-and-split - package directory)) - (cver (inversion-package-version package)) - (newer nil)) - (mapc (lambda (f) - (if (inversion-< cver (inversion-decode-version (car f))) - (setq newer (cons f newer)))) - files) - newer - )) - -;; (inversion-upgrade-package -;; 'semantic -;; "/ftp@ftp1.sourceforge.net:/pub/sourceforge/cedet") - -;; "/ftp@ftp1.sourceforge.net:/pub/sourceforge/cedet" +;;; How we upgrade packages in Emacs has yet to be ironed out. + +;; (defun inversion-upgrade-package (package &optional directory) +;; "Try to upgrade PACKAGE in DIRECTORY is available." +;; (interactive "sPackage to upgrade: ") +;; (if (stringp package) (setq package (intern package))) +;; (if (not directory) +;; ;; Hope that the package maintainer specified. +;; (setq directory (symbol-value (or (intern-soft +;; (concat (symbol-name package) +;; "-url")) +;; (intern-soft +;; (concat (symbol-name package) +;; "-directory")))))) +;; (let ((files (inversion-locate-package-files-and-split +;; package directory)) +;; (cver (inversion-package-version package)) +;; (newer nil)) +;; (mapc (lambda (f) +;; (if (inversion-< cver (inversion-decode-version (car f))) +;; (setq newer (cons f newer)))) +;; files) +;; newer +;; )) + (provide 'inversion) ;;; inversion.el ends here diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index c528612a63c..c56b609d19a 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -32,7 +32,7 @@ ;; that nature, and also provides reasonable defaults. ;; ;; There are buffer local variables, and frame local variables. -;; This library give the illusion of mode specific variables. +;; This library gives the illusion of mode specific variables. ;; ;; You should use a mode-local variable or override to allow extension ;; only if you expect a mode author to provide that extension. If a @@ -42,12 +42,10 @@ ;; To Do: ;; Allow customization of a variable for a specific mode? ;; -;; Add mecro for defining the '-default' functionality. - -;;; History: -;; +;; Add macro for defining the '-default' functionality. ;;; Code: + (eval-when-compile (require 'cl)) ;;; Misc utilities @@ -112,27 +110,25 @@ which mode local bindings have been activated." (eq mode-local--init-mode major-mode)) (defun mode-local-post-major-mode-change () - "`post-command-hook' run when there is a `major-mode' change. -This makes sure mode local init type stuff can occur." + "Initialize mode-local facilities. +This is run from `find-file-hook', and from `post-command-hook' +after changing the major mode." (remove-hook 'post-command-hook 'mode-local-post-major-mode-change nil) (let ((buffers mode-local-changed-mode-buffers)) (setq mode-local-changed-mode-buffers nil) (mode-local-map-file-buffers - #'(lambda () - ;; Make sure variables are set up for this mode. - (activate-mode-local-bindings) - (run-hooks 'mode-local-init-hook)) - #'(lambda () - (not (mode-local-initialized-p))) + (lambda () + ;; Make sure variables are set up for this mode. + (activate-mode-local-bindings) + (run-hooks 'mode-local-init-hook)) + (lambda () + (not (mode-local-initialized-p))) buffers))) (defun mode-local-on-major-mode-change () "Function called in `change-major-mode-hook'." (add-to-list 'mode-local-changed-mode-buffers (current-buffer)) (add-hook 'post-command-hook 'mode-local-post-major-mode-change t nil)) - -(add-hook 'find-file-hook 'mode-local-post-major-mode-change) -(add-hook 'change-major-mode-hook 'mode-local-on-major-mode-change) ;;; Mode lineage ;; @@ -739,106 +735,46 @@ invoked interactively." (when (setq mode (intern-soft mode)) (mode-local-describe-bindings-1 mode (interactive-p)))) -;;; Font-lock support -;; -(defconst mode-local-font-lock-keywords - (eval-when-compile - (let* ( - ;; Variable declarations - (kv (regexp-opt - '( - "defconst-mode-local" - "defvar-mode-local" - ) t)) - ;; Function declarations - (kf (regexp-opt - '( - "define-mode-local-override" - "define-child-mode" - "define-overload" - "define-overloadable-function" - ;;"make-obsolete-overload" - "with-mode-local" - ) t)) - ;; Regexp depths - (kv-depth (regexp-opt-depth kv)) - (kf-depth (regexp-opt-depth kf)) - ) - `((,(concat - ;; Declarative things - "(\\(" kv "\\|" kf "\\)" - ;; Whitespaces & names - "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?" - ) - (1 font-lock-keyword-face) - (,(+ 1 kv-depth kf-depth 1) - (cond ((match-beginning 2) - font-lock-type-face) - ((match-beginning ,(+ 1 kv-depth 1)) - font-lock-function-name-face) - ) - nil t) - (,(+ 1 kv-depth kf-depth 1 1) - (cond ((match-beginning 2) - font-lock-variable-name-face) - ) - nil t))) - )) - "Highlighted keywords.") - - -;;; find-func support (Emacs 21.4, or perhaps 22.1) -;; -(condition-case nil - ;; Try to get find-func so we can modify it. - (require 'find-func) - (error nil)) - -(when (boundp 'find-function-regexp) - (unless (string-match "ine-overload" find-function-regexp) - (if (string-match "(def\\\\(" find-function-regexp) - (let ((end (match-end 0)) - ) - (setq find-function-regexp - (concat (substring find-function-regexp 0 end) - "ine-overload\\|ine-mode-local-override\\|" - "ine-child-mode\\|" - (substring find-function-regexp end))))) - ) - ;; The regexp for variables is a little more kind. - ) - -;; TODO: Add XEmacs support -;; (when (fboundp 'font-lock-add-keywords) -;; (font-lock-add-keywords 'emacs-lisp-mode -;; mode-local-font-lock-keywords)) +;; ;;; find-func support (Emacs 21.4, or perhaps 22.1) +;; ;; +;; (condition-case nil +;; ;; Try to get find-func so we can modify it. +;; (require 'find-func) +;; (error nil)) + +;; (when (boundp 'find-function-regexp) +;; (unless (string-match "ine-overload" find-function-regexp) +;; (if (string-match "(def\\\\(" find-function-regexp) +;; (let ((end (match-end 0)) +;; ) +;; (setq find-function-regexp +;; (concat (substring find-function-regexp 0 end) +;; "ine-overload\\|ine-mode-local-override\\|" +;; "ine-child-mode\\|" +;; (substring find-function-regexp end))))))) ;;; edebug support ;; (defun mode-local-setup-edebug-specs () "Define edebug specification for mode local macros." (def-edebug-spec setq-mode-local - (symbolp &rest symbolp form) - ) + (symbolp &rest symbolp form)) (def-edebug-spec defvar-mode-local - (&define symbolp name def-form [ &optional stringp ] ) - ) + (&define symbolp name def-form [ &optional stringp ] )) (def-edebug-spec defconst-mode-local - defvar-mode-local - ) + defvar-mode-local) (def-edebug-spec define-overload - (&define name lambda-list stringp def-body) - ) + (&define name lambda-list stringp def-body)) (def-edebug-spec define-overloadable-function - (&define name lambda-list stringp def-body) - ) + (&define name lambda-list stringp def-body)) (def-edebug-spec define-mode-local-override - (&define name symbolp lambda-list stringp def-body) - ) - ) + (&define name symbolp lambda-list stringp def-body))) (add-hook 'edebug-setup-hook 'mode-local-setup-edebug-specs) +(add-hook 'find-file-hook 'mode-local-post-major-mode-change) +(add-hook 'change-major-mode-hook 'mode-local-on-major-mode-change) + (provide 'mode-local) ;;; mode-local.el ends here diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index aa9003e682c..d28d5a1f651 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -54,7 +54,6 @@ ;; ;; Pulse is a part of CEDET. http://cedet.sf.net - (defun pulse-available-p () "Return non-nil if pulsing is available on the current frame." (condition-case nil @@ -90,24 +89,6 @@ this flag is ignored." Face used for temporary highlighting of tags for effect." :group 'pulse) -;;; Compatibility -(defalias 'pulse-overlay-live-p 'overlay-buffer) -(defalias 'pulse-overlay-put 'overlay-put) -(defalias 'pulse-overlay-get 'overlay-get) -(defalias 'pulse-overlay-delete 'delete-overlay) -(defalias 'pulse-make-overlay 'make-overlay) - -(when (featurep 'xemacs) - (defalias 'pulse-overlay-live-p - (lambda (o) - (and (extent-live-p o) - (not (extent-detached-p o)) - (bufferp (extent-buffer o))))) - (defalias 'pulse-overlay-put 'set-extent-property) - (defalias 'pulse-overlay-get 'extent-property) - (defalias 'pulse-overlay-delete 'delete-extent) - (defalias 'pulse-make-overlay 'make-extent)) - ;;; Code: ;; (defun pulse-int-to-hex (int &optional nb-digits) @@ -190,55 +171,7 @@ Be sure to call `pulse-reset-face' after calling pulse." (pulse-reset-face face) (while (and (pulse-lighten-highlight) (sit-for pulse-delay)) - nil)) - )) - -(defun pulse-test (&optional no-error) - "Test the lightening function for pulsing a line. -When optional NO-ERROR Don't throw an error if we can't run tests." - (interactive) - (if (or (not pulse-flag) (not (pulse-available-p))) - (if no-error - nil - (error (concat "Pulse test only works on versions of Emacs" - " that support pulsing"))) - ;; Run the tests - (when (interactive-p) - (message "<Press a key> Pulse one line.") - (read-char)) - (pulse-momentary-highlight-one-line (point)) - (when (interactive-p) - (message "<Press a key> Pulse a region.") - (read-char)) - (pulse-momentary-highlight-region (point) - (save-excursion - (condition-case nil - (forward-char 30) - (error nil)) - (point))) - (when (interactive-p) - (message "<Press a key> Pulse line a specific color.") - (read-char)) - (pulse-momentary-highlight-one-line (point) 'modeline) - (when (interactive-p) - (message "<Press a key> Pulse a pre-existing overlay.") - (read-char)) - (let* ((start (point-at-bol)) - (end (save-excursion - (end-of-line) - (when (not (eobp)) - (forward-char 1)) - (point))) - (o (pulse-make-overlay start end)) - ) - (pulse-momentary-highlight-overlay o) - (if (pulse-overlay-live-p o) - (pulse-overlay-delete o) - (error "Non-temporary overlay was deleted!")) - ) - (when (interactive-p) - (message "Done!")))) - + nil)))) ;;; Convenience Functions ;; @@ -248,26 +181,24 @@ When optional NO-ERROR Don't throw an error if we can't run tests." (defun pulse-momentary-highlight-overlay (o &optional face) "Pulse the overlay O, unhighlighting before next command. Optional argument FACE specifies the fact to do the highlighting." - (pulse-overlay-put o 'original-face (pulse-overlay-get o 'face)) + (overlay-put o 'original-face (overlay-get o 'face)) (add-to-list 'pulse-momentary-overlay o) (if (or (not pulse-flag) (not (pulse-available-p))) ;; Provide a face... clear on next command (progn - (pulse-overlay-put o 'face (or face 'pulse-highlight-start-face)) + (overlay-put o 'face (or face 'pulse-highlight-start-face)) (add-hook 'pre-command-hook 'pulse-momentary-unhighlight) ) ;; pulse it. (unwind-protect (progn - (pulse-overlay-put o 'face 'pulse-highlight-face) + (overlay-put o 'face 'pulse-highlight-face) ;; The pulse function puts FACE onto 'pulse-highlight-face. ;; Thus above we put our face on the overlay, but pulse ;; with a reference face needed for the color. (pulse face)) - (pulse-momentary-unhighlight)) - ) - ) + (pulse-momentary-unhighlight)))) (defun pulse-momentary-unhighlight () "Unhighlight a line recently highlighted." @@ -277,10 +208,10 @@ Optional argument FACE specifies the fact to do the highlighting." ;; clear the starting face (mapc (lambda (ol) - (pulse-overlay-put ol 'face (pulse-overlay-get ol 'original-face)) - (pulse-overlay-put ol 'original-face nil) + (overlay-put ol 'face (overlay-get ol 'original-face)) + (overlay-put ol 'original-face nil) ;; Clear the overlay if it needs deleting. - (when (pulse-overlay-get ol 'pulse-delete) (pulse-overlay-delete ol))) + (when (overlay-get ol 'pulse-delete) (delete-overlay ol))) pulse-momentary-overlay) ;; Clear the variable. @@ -290,8 +221,7 @@ Optional argument FACE specifies the fact to do the highlighting." (pulse-reset-face) ;; Remove this hook. - (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight) - ) + (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)) (defun pulse-momentary-highlight-one-line (point &optional face) "Highlight the line around POINT, unhighlighting before next command. @@ -302,15 +232,14 @@ Optional argument FACE specifies the face to do the highlighting." (when (not (eobp)) (forward-char 1)) (point)))) - (pulse-momentary-highlight-region start end face) - )) + (pulse-momentary-highlight-region start end face))) (defun pulse-momentary-highlight-region (start end &optional face) "Highlight between START and END, unhighlighting before next command. Optional argument FACE specifies the fact to do the highlighting." - (let ((o (pulse-make-overlay start end))) + (let ((o (make-overlay start end))) ;; Mark it for deletion - (pulse-overlay-put o 'pulse-delete t) + (overlay-put o 'pulse-delete t) (pulse-momentary-highlight-overlay o face))) ;;; Random integration with other tools diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index dfed8a8c194..5e78513b0ad 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -29,7 +29,6 @@ ;; implementations. Each parser outputs a parse tree in a similar format ;; designed to handle typical functional and object oriented languages. -(require 'assoc) (require 'cedet) (require 'semantic/tag) (require 'semantic/lex) diff --git a/lisp/cedet/semantic/adebug.el b/lisp/cedet/semantic/adebug.el deleted file mode 100644 index cbe2985f6e5..00000000000 --- a/lisp/cedet/semantic/adebug.el +++ /dev/null @@ -1,406 +0,0 @@ -;;; semantic/adebug.el --- Semantic Application Debugger - -;;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> - -;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Semantic datastructure debugger for semantic applications. -;; Uses data-debug for core implementation. -;; -;; Goals: -;; -;; Inspect all known details of a TAG in a buffer. -;; -;; Analyze the list of active semantic databases, and the tags therin. -;; -;; Allow interactive navigation of the analysis process, tags, etc. - -(require 'eieio) -(require 'data-debug) -(require 'semantic) -(require 'semantic/tag) -(require 'semantic/format) - -(declare-function semanticdb-get-database "semantic/db") -(declare-function semanticdb-directory-loaded-p "semantic/db") -(declare-function semanticdb-file-table "semantic/db") -(declare-function semanticdb-needs-refresh-p "semantic/db") -(declare-function semanticdb-full-filename "semantic/db") - -;;; Code: - -;;; SEMANTIC TAG STUFF -;; -(defun data-debug-insert-tag-parts (tag prefix &optional parent) - "Insert all the parts of TAG. -PREFIX specifies what to insert at the start of each line. -PARENT specifires any parent tag." - (data-debug-insert-thing (semantic-tag-name tag) - prefix - "Name: " - parent) - (insert prefix "Class: '" (format "%S" (semantic-tag-class tag)) "\n") - (when (semantic-tag-with-position-p tag) - (let ((ol (semantic-tag-overlay tag)) - (file (semantic-tag-file-name tag)) - (start (semantic-tag-start tag)) - (end (semantic-tag-end tag)) - ) - (insert prefix "Position: " - (if (and (numberp start) (numberp end)) - (format "%d -> %d in " start end) - "") - (if file (file-name-nondirectory file) "unknown-file") - (if (semantic-overlay-p ol) - " <live tag>" - "") - "\n") - (data-debug-insert-thing ol prefix - "Position Data: " - parent) - )) - (let ((attrprefix (concat (make-string (length prefix) ? ) "# "))) - (insert prefix "Attributes:\n") - (data-debug-insert-property-list - (semantic-tag-attributes tag) attrprefix tag) - (insert prefix "Properties:\n") - (data-debug-insert-property-list - (semantic-tag-properties tag) attrprefix tag) - ) - - ) - -(defun data-debug-insert-tag-parts-from-point (point) - "Call `data-debug-insert-tag-parts' based on text properties at POINT." - (let ((tag (get-text-property point 'ddebug)) - (parent (get-text-property point 'ddebug-parent)) - (indent (get-text-property point 'ddebug-indent)) - start - ) - (end-of-line) - (setq start (point)) - (forward-char 1) - (data-debug-insert-tag-parts tag - (concat (make-string indent ? ) - "| ") - parent) - (goto-char start) - )) - -(defun data-debug-insert-tag (tag prefix prebuttontext &optional parent) - "Insert TAG into the current buffer at the current point. -PREFIX specifies text to insert in front of TAG. -PREBUTTONTEXT is text appearing btewen the prefix and TAG. -Optional PARENT is the parent tag containing TAG. -Add text properties needed to allow tag expansion later." - (let ((start (point)) - (end nil) - (str (semantic-format-tag-uml-abbreviate tag parent t)) - (tip (semantic-format-tag-prototype tag parent t)) - ) - (insert prefix prebuttontext str "\n") - (setq end (point)) - (put-text-property start end 'ddebug tag) - (put-text-property start end 'ddebug-parent parent) - (put-text-property start end 'ddebug-indent(length prefix)) - (put-text-property start end 'ddebug-prefix prefix) - (put-text-property start end 'help-echo tip) - (put-text-property start end 'ddebug-function - 'data-debug-insert-tag-parts-from-point) - - )) - -;;; TAG LISTS -;; -(defun data-debug-insert-tag-list (taglist prefix &optional parent) - "Insert the tag list TAGLIST with PREFIX. -Optional argument PARENT specifies the part of TAGLIST." - (condition-case nil - (while taglist - (cond ((and (consp taglist) (semantic-tag-p (car taglist))) - (data-debug-insert-tag (car taglist) prefix "" parent)) - ((consp taglist) - (data-debug-insert-thing (car taglist) prefix "" parent)) - (t (data-debug-insert-thing taglist prefix "" parent))) - (setq taglist (cdr taglist))) - (error nil))) - -(defun data-debug-insert-taglist-from-point (point) - "Insert the taglist found at the taglist button at POINT." - (let ((taglist (get-text-property point 'ddebug)) - (parent (get-text-property point 'ddebug-parent)) - (indent (get-text-property point 'ddebug-indent)) - start - ) - (end-of-line) - (setq start (point)) - (forward-char 1) - (data-debug-insert-tag-list taglist - (concat (make-string indent ? ) - "* ") - parent) - (goto-char start) - - )) - -(defun data-debug-insert-tag-list-button (taglist prefix prebuttontext &optional parent) - "Insert a single summary of a TAGLIST. -PREFIX is the text that preceeds the button. -PREBUTTONTEXT is some text between PREFIX and the taglist button. -PARENT is the tag that represents the parent of all the tags." - (let ((start (point)) - (end nil) - (str (format "#<TAG LIST: %d entries>" (safe-length taglist))) - (tip nil)) - (insert prefix prebuttontext str) - (setq end (point)) - (put-text-property (- end (length str)) end 'face 'font-lock-function-name-face) - (put-text-property start end 'ddebug taglist) - (put-text-property start end 'ddebug-parent parent) - (put-text-property start end 'ddebug-indent(length prefix)) - (put-text-property start end 'ddebug-prefix prefix) - (put-text-property start end 'help-echo tip) - (put-text-property start end 'ddebug-function - 'data-debug-insert-taglist-from-point) - (insert "\n") - )) - -;;; SEMANTICDB FIND RESULTS -;; -(defun data-debug-insert-find-results (findres prefix) - "Insert the find results FINDRES with PREFIX." - ;; ( (DBOBJ TAG TAG TAG) (DBOBJ TAG TAG TAG) ... ) - (let ((cnt 1)) - (while findres - (let* ((dbhit (car findres)) - (db (car dbhit)) - (tags (cdr dbhit))) - (data-debug-insert-thing db prefix (format "DB %d: " cnt)) - (data-debug-insert-thing tags prefix (format "HITS %d: " cnt)) - ) - (setq findres (cdr findres) - cnt (1+ cnt))))) - -(defun data-debug-insert-find-results-from-point (point) - "Insert the find results found at the find results button at POINT." - (let ((findres (get-text-property point 'ddebug)) - (indent (get-text-property point 'ddebug-indent)) - start - ) - (end-of-line) - (setq start (point)) - (forward-char 1) - (data-debug-insert-find-results findres - (concat (make-string indent ? ) - "!* ") - ) - (goto-char start) - )) - -(declare-function semanticdb-find-result-prin1-to-string "semantic/db-find") - -(defun data-debug-insert-find-results-button (findres prefix prebuttontext) - "Insert a single summary of a find results FINDRES. -PREFIX is the text that preceeds the button. -PREBUTTONTEXT is some text between prefix and the find results button." - (require 'semantic/db-find) - (let ((start (point)) - (end nil) - (str (semanticdb-find-result-prin1-to-string findres)) - (tip nil)) - (insert prefix prebuttontext str) - (setq end (point)) - (put-text-property (- end (length str)) end 'face 'font-lock-function-name-face) - (put-text-property start end 'ddebug findres) - (put-text-property start end 'ddebug-indent(length prefix)) - (put-text-property start end 'ddebug-prefix prefix) - (put-text-property start end 'help-echo tip) - (put-text-property start end 'ddebug-function - 'data-debug-insert-find-results-from-point) - (insert "\n") - )) - -(defun data-debug-insert-db-and-tag-button (dbtag prefix prebuttontext) - "Insert a single summary of short list DBTAG of format (DB . TAG). -PREFIX is the text that preceeds the button. -PREBUTTONTEXT is some text between prefix and the find results button." - (let ((start (point)) - (end nil) - (str (concat "(#<db/tag " - (object-name-string (car dbtag)) - " / " - (semantic-format-tag-name (cdr dbtag) nil t) - ")")) - (tip nil)) - (insert prefix prebuttontext str) - (setq end (point)) - (put-text-property (- end (length str)) end 'face 'font-lock-function-name-face) - (put-text-property start end 'ddebug dbtag) - (put-text-property start end 'ddebug-indent(length prefix)) - (put-text-property start end 'ddebug-prefix prefix) - (put-text-property start end 'help-echo tip) - (put-text-property start end 'ddebug-function - 'data-debug-insert-db-and-tag-from-point) - (insert "\n") - )) - -(defun data-debug-insert-db-and-tag-from-point (point) - "Insert the find results found at the find results button at POINT." - (let ((dbtag (get-text-property point 'ddebug)) - (indent (get-text-property point 'ddebug-indent)) - start - ) - (end-of-line) - (setq start (point)) - (forward-char 1) - (data-debug-insert-thing (car dbtag) (make-string indent ? ) - "| DB ") - (data-debug-insert-tag (cdr dbtag) (concat (make-string indent ? ) - "| ") - "TAG ") - (goto-char start) - )) - -;;; DEBUG COMMANDS -;; -;; Various commands to output aspects of the current semantic environment. -(defun semantic-adebug-bovinate () - "The same as `bovinate'. Display the results in a debug buffer." - (interactive) - (let* ((start (current-time)) - (out (semantic-fetch-tags)) - (end (current-time))) - - (message "Retrieving tags took %.2f seconds." - (semantic-elapsed-time start end)) - - (data-debug-new-buffer (concat "*" (buffer-name) " ADEBUG*")) - (data-debug-insert-tag-list out "* ")) - ) - -(defun semantic-adebug-searchdb (regex) - "Search the semanticdb for REGEX for the current buffer. -Display the results as a debug list." - (interactive "sSymbol Regex: ") - (let ((start (current-time)) - (fr (semanticdb-find-tags-by-name-regexp regex)) - (end (current-time))) - - (data-debug-new-buffer (concat "*SEMANTICDB SEARCH: " - regex - " ADEBUG*")) - (message "Search of tags took %.2f seconds." - (semantic-elapsed-time start end)) - - (data-debug-insert-find-results fr "*"))) - -(defun semanticdb-debug-file-tag-check (startfile) - "Report debug info for checking STARTFILE for up-to-date tags." - (interactive "FFile to Check (default = current-buffer): ") - (require 'semantic/db) - (let* ((file (file-truename startfile)) - (default-directory (file-name-directory file)) - (db (or - ;; This line will pick up system databases. - (semanticdb-directory-loaded-p default-directory) - ;; this line will make a new one if needed. - (semanticdb-get-database default-directory))) - (tab (semanticdb-file-table db file)) - ) - (with-output-to-temp-buffer "*DEBUG STUFF*" - (princ "Starting file is: ") - (princ startfile) - (princ "\nTrueName is: ") - (princ file) - (when (not (file-exists-p file)) - (princ "\nFile does not exist!")) - (princ "\nDirectory Part is: ") - (princ default-directory) - (princ "\nFound Database is: ") - (princ (object-print db)) - (princ "\nFound Table is: ") - (if tab (princ (object-print tab)) (princ "nil")) - (princ "\n\nAction Summary: ") - (cond - ((and tab - ;; Is this in a buffer? - (find-buffer-visiting (semanticdb-full-filename tab)) - ) - (princ "Found Buffer: ") - (prin1 (find-buffer-visiting (semanticdb-full-filename tab))) - ) - ((and tab - ;; Is table fully loaded, or just a proxy? - (number-or-marker-p (oref tab pointmax)) - ;; Is this table up to date with the file? - (not (semanticdb-needs-refresh-p tab))) - (princ "Found table, no refresh needed.\n Pointmax is: ") - (prin1 (oref tab pointmax)) - ) - (t - (princ "Found table that needs refresh.") - (if (not tab) - (princ "\n No Saved Point.") - (princ "\n Saved pointmax: ") - (prin1 (oref tab pointmax)) - (princ " Needs Refresh: ") - (prin1 (semanticdb-needs-refresh-p tab)) - ) - )) - ;; Buffer isn't loaded. The only clue we have is if the file - ;; is somehow different from our mark in the semanticdb table. - (let* ((stats (file-attributes file)) - (actualsize (nth 7 stats)) - (actualmod (nth 5 stats)) - ) - - (if (or (not tab) - (not (slot-boundp tab 'tags)) - (not (oref tab tags))) - (princ "\n No tags in table.") - (princ "\n Number of known tags: ") - (prin1 (length (oref tab tags)))) - - (princ "\n File Size is: ") - (prin1 actualsize) - (princ "\n File Mod Time is: ") - (princ (format-time-string "%Y-%m-%d %T" actualmod)) - (when tab - (princ "\n Saved file size is: ") - (prin1 (oref tab fsize)) - (princ "\n Saved Mod time is: ") - (princ (format-time-string "%Y-%m-%d %T" - (oref tab lastmodtime))) - ) - ) - ) - ;; Force load - (semanticdb-file-table-object file) - nil - )) - -;; (semanticdb-debug-file-tag-check "/usr/lib/gcc/i486-linux-gnu/4.2/include/stddef.h") -;; (semanticdb-debug-file-tag-check "/usr/include/stdlib.h") - - - -(provide 'semantic/adebug) - -;;; semantic/adebug.el ends here diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index 55f8db4aaad..4948bba794e 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -63,15 +63,16 @@ ;; constants - Some datatypes define elements of themselves as a ;; constant. These need to be returned as there would be no ;; other possible completions. -;; + (require 'semantic) (require 'semantic/format) (require 'semantic/ctxt) -(require 'semantic/sort) -(eval-when-compile (require 'semantic/find)) (require 'semantic/scope) +(require 'semantic/sort) (require 'semantic/analyze/fcn) +(eval-when-compile (require 'semantic/find)) + (declare-function data-debug-new-buffer "data-debug") (declare-function data-debug-insert-object-slots "eieio-datadebug") @@ -715,7 +716,7 @@ Optional argument CTXT is the context to show." (pulse-momentary-highlight-region (car bounds) (cdr bounds)))))) (defcustom semantic-analyze-summary-function 'semantic-format-tag-prototype - "*Function to use when creating items in Imenu. + "Function to use when creating items in Imenu. Some useful functions are found in `semantic-format-tag-functions'." :group 'semantic :type semantic-format-tag-custom-list) diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el index c0914cefe4c..5d858e59949 100644 --- a/lisp/cedet/semantic/analyze/complete.el +++ b/lisp/cedet/semantic/analyze/complete.el @@ -49,24 +49,6 @@ Used as options when completing.") "Do nothing with TYPE." nil) -;; Old impl of the above. I'm not sure what the issue is -; (let ((ans -; (:override-with-args -; ((semantic-analyze-find-tag (semantic-tag-name type))) -; ;; Be default, we don't know. -; nil)) -; (out nil)) -; (dolist (elt ans) -; (cond -; ((stringp elt) -; (push (semantic-tag-new-variable -; elt (semantic-tag-name type) nil) -; out)) -; ((semantic-tag-p elt) -; (push elt out)) -; (t nil))) -; (nreverse out))) - (defun semantic-analyze-tags-of-class-list (tags classlist) "Return the tags in TAGS that are of classes in CLASSLIST." (let ((origc tags)) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index e0059896fb3..c86a79a226d 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -25,10 +25,7 @@ ;;; Code: -(require 'mode-local) (require 'semantic) -(require 'semantic/tag) - (eval-when-compile (require 'semantic/find)) (declare-function semanticdb-typecache-merge-streams "semantic/db-typecache") diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index a9d06c16db0..d11fc16e07c 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -32,7 +32,12 @@ ;;; Code: (require 'semantic) -(require 'semantic/bovine/debug) + +(declare-function semantic-create-bovine-debug-error-frame + "semantic/bovine/debug") +(declare-function semantic-bovine-debug-create-frame + "semantic/bovine/debug") +(declare-function semantic-debug-break "semantic/debug") ;;; Variables ;; @@ -149,15 +154,18 @@ list of semantic tokens found." (not (listp (car lte)))) ;; GRAMMAR SOURCE DEBUGGING! - (if semantic-debug-enabled + (if (and (boundp 'semantic-debug-enabled) + semantic-debug-enabled) (let* ((db-nt (semantic-bovinate-nonterminal-db-nt)) (db-ml (cdr (assq db-nt table))) (db-mlen (length db-ml)) (db-midx (- db-mlen (length matchlist))) (db-tlen (length (nth db-midx db-ml))) (db-tidx (- db-tlen (length lte))) - (frame (semantic-bovine-debug-create-frame - db-nt db-midx db-tidx cvl (car s))) + (frame (progn + (require 'semantic/bovine/debug) + (semantic-bovine-debug-create-frame + db-nt db-midx db-tidx cvl (car s)))) (cmd (semantic-debug-break frame)) ) (cond ((eq 'fail cmd) (setq lte '(trash 0 . 0))) @@ -266,12 +274,12 @@ list of semantic tokens found." (error ;; On error just move forward the stream of lexical tokens (setq result (list (cdr starting-stream) nil)) - (if semantic-debug-enabled - (let ((frame (semantic-create-bovine-debug-error-frame - debug-condition))) - (semantic-debug-break frame) - )) - )) + (when (and (boundp 'semantic-debug-enabled) + semantic-debug-enabled) + (require 'semantic/bovine/debug) + (let ((frame (semantic-create-bovine-debug-error-frame + debug-condition))) + (semantic-debug-break frame))))) result)) ;; Make it the default parser diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el index e68a04a352c..e6be8a6822e 100644 --- a/lisp/cedet/semantic/bovine/c-by.el +++ b/lisp/cedet/semantic/bovine/c-by.el @@ -25,7 +25,9 @@ ;;; Code: +(require 'semantic/lex) (eval-when-compile (require 'semantic/bovine)) + (declare-function semantic-c-reconstitute-token "semantic/bovine/c") (declare-function semantic-c-reconstitute-template "semantic/bovine/c") (declare-function semantic-expand-c-tag "semantic/bovine/c") @@ -2185,12 +2187,6 @@ semantic-flex-keywords-obarray semantic-c-by--keyword-table semantic-equivalent-major-modes '(c-mode c++-mode) )) - - -;;; Analyzers -;; -(require 'semantic/lex) - ;;; Epilogue ;; diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 0d250e2795f..b9077a2ef0b 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -29,14 +29,11 @@ (require 'semantic) (require 'semantic/analyze) (require 'semantic/bovine/gcc) -(require 'semantic/format) (require 'semantic/idle) (require 'semantic/lex-spp) -(require 'backquote) (require 'semantic/bovine/c-by) (eval-when-compile - ;; For semantic-find-tags-* macros: (require 'semantic/find)) (declare-function semantic-brute-find-tag-by-attribute "semantic/find") diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el index d3319836fef..19e35d0682b 100644 --- a/lisp/cedet/semantic/bovine/make-by.el +++ b/lisp/cedet/semantic/bovine/make-by.el @@ -25,7 +25,9 @@ ;;; Code: +(require 'semantic/lex) (eval-when-compile (require 'semantic/bovine)) + ;;; Prologue ;; @@ -380,15 +382,6 @@ semantic-flex-keywords-obarray semantic-make-by--keyword-table )) - -;;; Analyzers -;; -(require 'semantic/lex) - - -;;; Epilogue -;; - (provide 'semantic/bovine/make-by) ;;; semantic/bovine/make-by.el ends here diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index ac7d084a384..9f3edcfbe9b 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -30,10 +30,10 @@ (require 'semantic) (require 'semantic/bovine/make-by) (require 'semantic/analyze) -(require 'semantic/format) +(require 'semantic/dep) -(eval-when-compile - (require 'semantic/dep)) +(declare-function semantic-analyze-possible-completions-default + "semantic/analyze/complete") ;;; Code: (define-lex-analyzer semantic-lex-make-backslash-no-newline @@ -179,6 +179,7 @@ This is the same as a regular prototype." "Return a list of possible completions in a Makefile. Uses default implementation, and also gets a list of filenames." (save-excursion + (require 'semantic/analyze/complete) (set-buffer (oref context buffer)) (let* ((normal (semantic-analyze-possible-completions-default context)) (classes (oref context :prefixclass)) diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el index 936b229f8b6..82a8ae6ffa3 100644 --- a/lisp/cedet/semantic/bovine/scm-by.el +++ b/lisp/cedet/semantic/bovine/scm-by.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'semantic/lex) + (eval-when-compile (require 'semantic/bovine)) ;;; Prologue @@ -184,15 +186,6 @@ semantic-flex-keywords-obarray semantic-scm-by--keyword-table )) - -;;; Analyzers -;; -(require 'semantic/lex) - - -;;; Epilogue -;; - (provide 'semantic/bovine/scm-by) ;;; semantic/bovine/scm-by.el ends here diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index 091486cc382..82a7dde039b 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -27,9 +27,7 @@ (require 'semantic) (require 'semantic/bovine/scm-by) (require 'semantic/format) - -(eval-when-compile - (require 'semantic/dep)) +(require 'semantic/dep) ;;; Code: diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index c591c1588e7..cbf3d9da9ae 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -107,9 +107,8 @@ ;; `semantic-complete-inline-tag-engine' will complete text in ;; a buffer. -(require 'eieio) -(require 'eieio-opt) (require 'semantic) +(require 'eieio-opt) (require 'semantic/analyze) (require 'semantic/ctxt) (require 'semantic/decorate) @@ -119,24 +118,8 @@ ;; For the semantic-find-tags-for-completion macro. (require 'semantic/find)) -(eval-when-compile - (condition-case nil - ;; Tooltip not available in older emacsen. - (require 'tooltip) - (error nil)) - ) - ;;; Code: -;;; Compatibility -;; -(if (fboundp 'minibuffer-contents) - (eval-and-compile (defalias 'semantic-minibuffer-contents 'minibuffer-contents)) - (eval-and-compile (defalias 'semantic-minibuffer-contents 'buffer-string))) -(if (fboundp 'delete-minibuffer-contents) - (eval-and-compile (defalias 'semantic-delete-minibuffer-contents 'delete-minibuffer-contents)) - (eval-and-compile (defalias 'semantic-delete-minibuffer-contents 'erase-buffer))) - (defvar semantic-complete-inline-overlay nil "The overlay currently active while completing inline.") @@ -158,14 +141,14 @@ For inline completion, this is the text wrapped in the inline completion overlay." (if semantic-complete-inline-overlay (semantic-complete-inline-text) - (semantic-minibuffer-contents))) + (minibuffer-contents))) (defun semantic-completion-delete-text () "Delete the text that is actively being completed. Presumably if you call this you will insert something new there." (if semantic-complete-inline-overlay (semantic-complete-inline-delete-text) - (semantic-delete-minibuffer-contents))) + (delete-minibuffer-contents))) (defun semantic-completion-message (fmt &rest args) "Display the string FMT formatted with ARGS at the end of the minibuffer." @@ -2107,26 +2090,6 @@ use `semantic-complete-analyze-inline' to complete." (error nil)) )) -;; @TODO - I can't find where this fcn is used. Delete? - -;;;;###autoload -;(defun semantic-complete-inline-project () -; "Perform inline completion for any symbol in the current project. -;`semantic-analyze-possible-completions' is used to determine the -;possible values. -;The function returns immediately, leaving the buffer in a mode that -;will perform the completion." -; (interactive) -; ;; Only do this if we are not already completing something. -; (if (not (semantic-completion-inline-active-p)) -; (semantic-complete-inline-tag-project)) -; ;; Report a message if things didn't startup. -; (if (and (interactive-p) -; (not (semantic-completion-inline-active-p))) -; (message "Inline completion not needed.")) -; ) - -;; End (provide 'semantic/complete) ;; Local variables: diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 6101f3a8b66..8c6237f542c 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -50,23 +50,18 @@ ;; Call it a second time to refresh the Emacs DB with the file. ;; +(require 'ebrowse) +(require 'semantic) +(require 'semantic/db-file) + (eval-when-compile ;; For generic function searching. (require 'eieio) (require 'eieio-opt) - ) -(require 'semantic/db-file) -(require 'semantic/find) + (require 'semantic/find)) (declare-function semantic-add-system-include "semantic/dep") -(eval-and-compile - ;; Hopefully, this will allow semanticdb-ebrowse to compile under - ;; XEmacs, it just won't run if a user attempts to use it. - (condition-case nil - (require 'ebrowse) - (error nil))) - ;;; Code: (defvar semanticdb-ebrowse-default-file-name "BROWSE" "The EBROWSE file name used for system caches.") diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 817d716ab74..e7ce7fcbdef 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -118,7 +118,6 @@ (require 'semantic/db) (require 'semantic/db-ref) (eval-when-compile - (require 'eieio) (require 'semantic/find)) ;;; Code: @@ -841,17 +840,6 @@ Examines the variable `semanticdb-find-lost-includes'." (data-debug-insert-stuff-list scanned "*") ))) -;;; FIND results and edebug -;; -(eval-after-load "cedet-edebug" - '(progn - (cedet-edebug-add-print-override - '(semanticdb-find-results-p object) - '(semanticdb-find-result-prin1-to-string object) ) - )) - - - ;;; API Functions ;; ;; Once you have a search result, use these routines to operate @@ -1339,12 +1327,14 @@ Returns a table of all matching tags." "In TABLE, find all occurances of tags whose parent is the PARENT type. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." + (require 'semantic/find) (semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table)))) (defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags) "In TABLE, find all occurances of tags whose parent is the PARENT type. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." + (require 'semantic/find) (semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table)))) ;;; Deep Searches diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el index 42203806fd4..e9d3794558d 100644 --- a/lisp/cedet/semantic/db-javascript.el +++ b/lisp/cedet/semantic/db-javascript.el @@ -35,8 +35,8 @@ (eval-when-compile ;; For generic function searching. (require 'eieio) - (require 'eieio-opt) - ) + (require 'eieio-opt)) + ;;; Code: (defvar semanticdb-javascript-tags '(("eval" function diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index ae612217232..c526515f248 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -23,17 +23,9 @@ ;; ;; Major mode for managing Semantic Databases automatically. -(require 'semantic/db) ;;; Code: -;; Moved into semantic/db.el: -;; (defvar semanticdb-current-database nil -;; "For a given buffer, this is the currently active database.") -;; (make-variable-buffer-local 'semanticdb-current-database) - -;; (defvar semanticdb-current-table nil -;; "For a given buffer, this is the currently active database table.") -;; (make-variable-buffer-local 'semanticdb-current-table) +(require 'semantic/db) (declare-function semantic-lex-spp-set-dynamic-table "semantic/lex-spp") diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index ece8ea765ef..bc25d31f19e 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -29,18 +29,18 @@ ;; By default, assume one database per directory. ;; -(require 'eieio) +;;; Code: + (require 'eieio-base) (require 'semantic) -(eval-when-compile - (require 'semantic/lex-spp)) + +(declare-function semantic-lex-spp-save-table "semantic/lex-spp") ;;; Variables: (defgroup semanticdb nil "Parser Generator Persistent Database interface." - :group 'semantic - ) -;;; Code: + :group 'semantic) + (defvar semanticdb-database-list nil "List of all active databases.") diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el index 4623332c567..70c082e4e98 100644 --- a/lisp/cedet/semantic/decorate.el +++ b/lisp/cedet/semantic/decorate.el @@ -135,29 +135,6 @@ instead of read-only." (member 'semantic-overlay-signal-read-only (semantic-overlay-get o 'modification-hooks))))) -;;; backwards compatability - -(semantic-alias-obsolete 'semantic-highlight-token - 'semantic-highlight-tag) -(semantic-alias-obsolete 'semantic-unhighlight-token - 'semantic-unhighlight-tag) -(semantic-alias-obsolete 'semantic-momentary-highlight-token - 'semantic-momentary-highlight-tag) -(semantic-alias-obsolete 'semantic-set-token-face - 'semantic-set-tag-face) -(semantic-alias-obsolete 'semantic-set-token-invisible - 'semantic-set-tag-invisible) -(semantic-alias-obsolete 'semantic-token-invisible-p - 'semantic-tag-invisible-p) -(semantic-alias-obsolete 'semantic-set-token-intangible - 'semantic-set-tag-intangible) -(semantic-alias-obsolete 'semantic-token-intangible-p - 'semantic-tag-intangible-p) -(semantic-alias-obsolete 'semantic-set-token-read-only - 'semantic-set-tag-read-only) -(semantic-alias-obsolete 'semantic-token-read-only-p - 'semantic-tag-read-only-p) - ;;; Secondary overlays ;; ;; Some types of decoration require a second overlay to be made. diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 3ee2664d7bc..66c7c1224f8 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -40,12 +40,11 @@ (require 'semantic/decorate) (require 'semantic/tag-ls) (require 'semantic/util-modes) -(eval-when-compile (require 'cl)) ;;; Styles List ;; (defcustom semantic-decoration-styles nil - "*List of active decoration styles. + "List of active decoration styles. It is an alist of \(NAME . FLAG) elements, where NAME is a style name and FLAG is non-nil if the style is enabled. See also `define-semantic-decoration-style' which will automatically @@ -209,7 +208,6 @@ The setting of FCN will be removed after it is run." (semantic-make-local-hook 'semantic-decorate-flush-pending-decorations) (add-hook 'semantic-decorate-pending-decoration-hook fcn nil t))) -;;;;###autoload (defun semantic-decorate-flush-pending-decorations (&optional buffer) "Flush any pending decorations for BUFFER. Flush functions from `semantic-decorate-pending-decoration-hook'." @@ -250,7 +248,7 @@ If ARG is nil, then toggle." 'semantic-decoration-mode arg))) (defcustom semantic-decoration-mode-hook nil - "*Hook run at the end of function `semantic-decoration-mode'." + "Hook run at the end of function `semantic-decoration-mode'." :group 'semantic :type 'hook) @@ -295,7 +293,6 @@ minor mode is enabled." ) semantic-decoration-mode) -;;;;###autoload (defun semantic-decoration-mode (&optional arg) "Minor mode for decorating tags. Decorations are specified in `semantic-decoration-styles'. @@ -395,7 +392,6 @@ Return non-nil if the decoration style is enabled." :selected `(semantic-decoration-style-enabled-p ,(car style)) )) -;;;;###autoload (defun semantic-build-decoration-mode-menu (&rest ignore) "Create a menu listing all the known decorations for toggling. IGNORE any input arguments." diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index 0eaf41c06e9..9feeee294f6 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -83,9 +83,6 @@ just the lexical token and not the string." (semantic-doc-snarf-comment-for-tag nosnarf))) )) -(make-obsolete-overload 'semantic-find-documentation - 'semantic-documentation-for-tag) - (defun semantic-doc-snarf-comment-for-tag (nosnarf) "Snarf up the comment at POINT for `semantic-documentation-for-tag'. Attempt to strip out comment syntactic sugar. @@ -121,9 +118,6 @@ If NOSNARF is 'lex, then return the lex token." ;; Now return the text. ct)))) -(semantic-alias-obsolete 'semantic-find-documentation - 'semantic-documentation-for-tag) - (provide 'semantic/doc) ;; Local variables: diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index 0a7475081be..9886685cb5d 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -44,11 +44,13 @@ ;; ;; 4) ... +;;; Code: + (require 'semantic) (require 'semantic/tag) -;;; Code: - +(declare-function semantic-tag-protected-p "semantic/tag-ls") + ;;; Overlay Search Routines ;; ;; These routines provide fast access to tokens based on a buffer that @@ -346,8 +348,6 @@ See `semantic-tag-protected-p' for details on which tags are returned." semantic-tag-class type)) (:override))) -(declare-function semantic-tag-protected-p "semantic/tag-ls") - (defun semantic-find-tags-by-scope-protection-default (scopeprotection parent &optional table) "Find all tags accessable by SCOPEPROTECTION. @@ -402,8 +402,6 @@ attempting to do completions." ,regexp (semantic-flatten-tags-table ,table))) ;;; Specialty Searches -;; -(declare-function semantic-tag-external-member-parent "semantic/sort") (defun semantic-find-tags-external-children-of-type (type &optional table) "Find all tags in whose parent is TYPE in TABLE. @@ -695,115 +693,6 @@ details are available of findable." (semantic-tag-type-members current) nil)))) (nreverse (cons current returnme)))) - -;;; Compatibility Aliases -(semantic-alias-obsolete 'semantic-find-nonterminal-by-overlay - 'semantic-find-tag-by-overlay) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-overlay-in-region - 'semantic-find-tag-by-overlay-in-region) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-overlay-next - 'semantic-find-tag-by-overlay-next) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-overlay-prev - 'semantic-find-tag-by-overlay-prev) - -(semantic-alias-obsolete 'semantic-find-nonterminal-parent-by-overlay - 'semantic-find-tag-parent-by-overlay) - -(semantic-alias-obsolete 'semantic-current-nonterminal - 'semantic-current-tag) - -(semantic-alias-obsolete 'semantic-current-nonterminal-parent - 'semantic-current-tag-parent) - -(semantic-alias-obsolete 'semantic-current-nonterminal-of-type - 'semantic-current-tag-of-class) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-name - 'semantic-brute-find-first-tag-by-name) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-token - 'semantic-brute-find-tag-by-class) - -(semantic-alias-obsolete 'semantic-find-nonterminal-standard - 'semantic-brute-find-tag-standard) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-type - 'semantic-brute-find-tag-by-type) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-type-regexp - 'semantic-brute-find-tag-by-type-regexp) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-name-regexp - 'semantic-brute-find-tag-by-name-regexp) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-property - 'semantic-brute-find-tag-by-property) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-extra-spec - 'semantic-brute-find-tag-by-attribute) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-extra-spec-value - 'semantic-brute-find-tag-by-attribute-value) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-function - 'semantic-brute-find-tag-by-function) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-function-first-match - 'semantic-brute-find-first-tag-by-function) - -(semantic-alias-obsolete 'semantic-find-nonterminal-by-position - 'semantic-brute-find-tag-by-position) - -(semantic-alias-obsolete 'semantic-find-innermost-nonterminal-by-position - 'semantic-brute-find-innermost-tag-by-position) - -;;; TESTING -;; -(defun semantic-find-benchmark () - "Run some simple benchmarks to see how we are doing. -Optional argument ARG is the number of iterations to run." - (interactive) - (require 'benchmark) - (let ((f-name nil) - (b-name nil) - (f-comp) - (b-comp) - (f-regex) - ) - (garbage-collect) - (setq f-name - (benchmark-run-compiled - 1000 (semantic-find-first-tag-by-name "class3" - "test/test.cpp"))) - (garbage-collect) - (setq b-name - (benchmark-run-compiled - 1000 (semantic-brute-find-first-tag-by-name "class3" - "test/test.cpp"))) - (garbage-collect) - (setq f-comp - (benchmark-run-compiled - 1000 (semantic-find-tags-for-completion "method" - "test/test.cpp"))) - (garbage-collect) - (setq b-comp - (benchmark-run-compiled - 1000 (semantic-brute-find-tag-by-name-regexp "^method" - "test/test.cpp"))) - (garbage-collect) - (setq f-regex - (benchmark-run-compiled - 1000 (semantic-find-tags-by-name-regexp "^method" - "test/test.cpp"))) - - (message "Name [new old] [ %.3f %.3f ] Complete [newc/new old] [ %.3f/%.3f %.3f ]" - (car f-name) (car b-name) - (car f-comp) (car f-regex) - (car b-comp)) - )) (provide 'semantic/find) diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index d4c04a172c4..13945931b3f 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el @@ -66,9 +66,6 @@ would claim as a parent. COLOR indicates that the generated text should be colored using `font-lock'.") -(semantic-varalias-obsolete 'semantic-token->text-functions - 'semantic-format-tag-functions) - (defvar semantic-format-tag-custom-list (append '(radio) (mapcar (lambda (f) (list 'const f)) @@ -77,9 +74,6 @@ COLOR indicates that the generated text should be colored using "A List used by customizeable variables to choose a tag to text function. Use this variable in the :type field of a customizable variable.") -(semantic-varalias-obsolete 'semantic-token->text-custom-list - 'semantic-format-tag-custom-list) - (defcustom semantic-format-use-images-flag ezimage-use-images "Non-nil means semantic format functions use images. Images can be used as icons instead of some types of text strings." @@ -123,17 +117,13 @@ is a symbol representing a face. Faces used are generated in `font-lock' for consistency, and will not be used unless font lock is a feature.") -(semantic-varalias-obsolete 'semantic-face-alist - 'semantic-format-face-alist) - - ;;; Coloring Functions ;; (defun semantic--format-colorize-text (text face-class) "Apply onto TEXT a color associated with FACE-CLASS. -FACE-CLASS is a tag type found in `semantic-face-alist'. See this variable -for details on adding new types." +FACE-CLASS is a tag type found in `semantic-format-face-alist'. +See that variable for details on adding new types." (if (featurep 'font-lock) (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) (newtext (concat text))) @@ -141,13 +131,10 @@ for details on adding new types." newtext) text)) -(make-obsolete 'semantic-colorize-text - 'semantic--format-colorize-text) - (defun semantic--format-colorize-merge-text (precoloredtext face-class) "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS. -FACE-CLASS is a tag type found in 'semantic-face-alist'. See this -variable for details on adding new types." +FACE-CLASS is a tag type found in `semantic-formatface-alist'. +See that variable for details on adding new types." (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) (newtext (concat precoloredtext)) ) @@ -381,10 +368,6 @@ This is a simple C like default." (setq str (concat prefix name suffix)) str)) -;; Semantic 1.2.x had this misspelling. Keep it for backwards compatibiity. -(semantic-alias-obsolete - 'semantic-summerize-nonterminal 'semantic-format-tag-summarize) - ;;;###autoload (define-overloadable-function semantic-format-tag-summarize (tag &optional parent color) "Summarize TAG in a reasonable way. @@ -728,38 +711,7 @@ Optional argument COLOR means highlight the prototype with font-lock colors." (setq text (concat prot cp type)) (if color (setq text (semantic--format-uml-post-colorize text tag parent))) - text - )) - -;;; Compatibility and aliases -;; -(semantic-alias-obsolete 'semantic-prin1-nonterminal - 'semantic-format-tag-prin1) - -(semantic-alias-obsolete 'semantic-name-nonterminal - 'semantic-format-tag-name) - -(semantic-alias-obsolete 'semantic-abbreviate-nonterminal - 'semantic-format-tag-abbreviate) - -(semantic-alias-obsolete 'semantic-summarize-nonterminal - 'semantic-format-tag-summarize) - -(semantic-alias-obsolete 'semantic-prototype-nonterminal - 'semantic-format-tag-prototype) - -(semantic-alias-obsolete 'semantic-concise-prototype-nonterminal - 'semantic-format-tag-concise-prototype) - -(semantic-alias-obsolete 'semantic-uml-abbreviate-nonterminal - 'semantic-format-tag-uml-abbreviate) - -(semantic-alias-obsolete 'semantic-uml-prototype-nonterminal - 'semantic-format-tag-uml-prototype) - -(semantic-alias-obsolete 'semantic-uml-concise-prototype-nonterminal - 'semantic-format-tag-uml-concise-prototype) - + text)) (provide 'semantic/format) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index a2e4d0f26c2..9f9bcaaea23 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -1,4 +1,4 @@ -;;; semantic-fw.el --- Framework for Semantic +;;; semantic/fw.el --- Framework for Semantic ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, ;;; 2007, 2008, 2009 Free Software Foundation, Inc. @@ -34,142 +34,42 @@ (require 'semantic/loaddefs) ;;; Compatibility -;; -(if (featurep 'xemacs) - (progn - (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer) - (defalias 'semantic-overlay-live-p - (lambda (o) - (and (extent-live-p o) - (not (extent-detached-p o)) - (bufferp (extent-buffer o))))) - (defalias 'semantic-make-overlay - (lambda (beg end &optional buffer &rest rest) - "Xemacs `make-extent', supporting the front/rear advance options." - (let ((ol (make-extent beg end buffer))) - (when rest - (set-extent-property ol 'start-open (car rest)) - (setq rest (cdr rest))) - (when rest - (set-extent-property ol 'end-open (car rest))) - ol))) - (defalias 'semantic-overlay-put 'set-extent-property) - (defalias 'semantic-overlay-get 'extent-property) - (defalias 'semantic-overlay-properties 'extent-properties) - (defalias 'semantic-overlay-move 'set-extent-endpoints) - (defalias 'semantic-overlay-delete 'delete-extent) - (defalias 'semantic-overlays-at - (lambda (pos) - (condition-case nil - (extent-list nil pos pos) - (error nil)) - )) - (defalias 'semantic-overlays-in - (lambda (beg end) (extent-list nil beg end))) - (defalias 'semantic-overlay-buffer 'extent-buffer) - (defalias 'semantic-overlay-start 'extent-start-position) - (defalias 'semantic-overlay-end 'extent-end-position) - (defalias 'semantic-overlay-size 'extent-length) - (defalias 'semantic-overlay-next-change 'next-extent-change) - (defalias 'semantic-overlay-previous-change 'previous-extent-change) - (defalias 'semantic-overlay-lists - (lambda () (list (extent-list)))) - (defalias 'semantic-overlay-p 'extentp) - (defalias 'semantic-event-window 'event-window) - (defun semantic-read-event () - (let ((event (next-command-event))) - (if (key-press-event-p event) - (let ((c (event-to-character event))) - (if (char-equal c (quit-char)) - (keyboard-quit) - c))) - event)) - (defun semantic-popup-menu (menu) - "Blockinig version of `popup-menu'" - (popup-menu menu) - ;; Wait... - (while (popup-up-p) (dispatch-event (next-event)))) - ) - ;; Emacs Bindings - (defalias 'semantic-buffer-local-value 'buffer-local-value) - (defalias 'semantic-overlay-live-p 'overlay-buffer) - (defalias 'semantic-make-overlay 'make-overlay) - (defalias 'semantic-overlay-put 'overlay-put) - (defalias 'semantic-overlay-get 'overlay-get) - (defalias 'semantic-overlay-properties 'overlay-properties) - (defalias 'semantic-overlay-move 'move-overlay) - (defalias 'semantic-overlay-delete 'delete-overlay) - (defalias 'semantic-overlays-at 'overlays-at) - (defalias 'semantic-overlays-in 'overlays-in) - (defalias 'semantic-overlay-buffer 'overlay-buffer) - (defalias 'semantic-overlay-start 'overlay-start) - (defalias 'semantic-overlay-end 'overlay-end) - (defalias 'semantic-overlay-size 'overlay-size) - (defalias 'semantic-overlay-next-change 'next-overlay-change) - (defalias 'semantic-overlay-previous-change 'previous-overlay-change) - (defalias 'semantic-overlay-lists 'overlay-lists) - (defalias 'semantic-overlay-p 'overlayp) - (defalias 'semantic-read-event 'read-event) - (defalias 'semantic-popup-menu 'popup-menu) - (defun semantic-event-window (event) - "Extract the window from EVENT." - (car (car (cdr event)))) - ) - -(if (and (not (featurep 'xemacs)) - (>= emacs-major-version 21)) - (defalias 'semantic-make-local-hook 'identity) - (defalias 'semantic-make-local-hook 'make-local-hook) - ) - -(if (featurep 'xemacs) - (defalias 'semantic-mode-line-update 'redraw-modeline) - (defalias 'semantic-mode-line-update 'force-mode-line-update)) - -;; Since Emacs 22 major mode functions should use `run-mode-hooks' to -;; run major mode hooks. -(defalias 'semantic-run-mode-hooks - (if (fboundp 'run-mode-hooks) - 'run-mode-hooks - 'run-hooks)) - -;; Fancy compat useage now handled in cedet-compat -(defalias 'semantic-subst-char-in-string 'subst-char-in-string) +(defalias 'semantic-buffer-local-value 'buffer-local-value) +(defalias 'semantic-overlay-live-p 'overlay-buffer) +(defalias 'semantic-make-overlay 'make-overlay) +(defalias 'semantic-overlay-put 'overlay-put) +(defalias 'semantic-overlay-get 'overlay-get) +(defalias 'semantic-overlay-properties 'overlay-properties) +(defalias 'semantic-overlay-move 'move-overlay) +(defalias 'semantic-overlay-delete 'delete-overlay) +(defalias 'semantic-overlays-at 'overlays-at) +(defalias 'semantic-overlays-in 'overlays-in) +(defalias 'semantic-overlay-buffer 'overlay-buffer) +(defalias 'semantic-overlay-start 'overlay-start) +(defalias 'semantic-overlay-end 'overlay-end) +(defalias 'semantic-overlay-size 'overlay-size) +(defalias 'semantic-overlay-next-change 'next-overlay-change) +(defalias 'semantic-overlay-previous-change 'previous-overlay-change) +(defalias 'semantic-overlay-lists 'overlay-lists) +(defalias 'semantic-overlay-p 'overlayp) +(defalias 'semantic-read-event 'read-event) +(defalias 'semantic-popup-menu 'popup-menu) +(defalias 'semantic-make-local-hook 'identity) +(defalias 'semantic-mode-line-update 'force-mode-line-update) +(defalias 'semantic-run-mode-hooks 'run-mode-hooks) +(defalias 'semantic-compile-warn 'byte-compile-warn) +(defalias 'semantic-menu-item 'identity) + +(defun semantic-event-window (event) + "Extract the window from EVENT." + (car (car (cdr event)))) (defun semantic-delete-overlay-maybe (overlay) "Delete OVERLAY if it is a semantic token overlay." (if (semantic-overlay-get overlay 'semantic) (semantic-overlay-delete overlay))) -(defalias 'semantic-compile-warn - (eval-when-compile - (if (fboundp 'byte-compile-warn) - 'byte-compile-warn - 'message))) - -(if (not (fboundp 'string-to-number)) - (defalias 'string-to-number 'string-to-int)) - -;;; Menu Item compatibility -;; -(defun semantic-menu-item (item) - "Build an XEmacs compatible menu item from vector ITEM. -That is remove the unsupported :help stuff." - (if (featurep 'xemacs) - (let ((n (length item)) - (i 0) - slot l) - (while (< i n) - (setq slot (aref item i)) - (if (and (keywordp slot) - (eq slot :help)) - (setq i (1+ i)) - (setq l (cons slot l))) - (setq i (1+ i))) - (apply #'vector (nreverse l))) - item)) - ;;; Positional Data Cache ;; (defvar semantic-cache-data-overlays nil @@ -316,21 +216,11 @@ FUNCTION does not have arguments. When FUNCTION is entered `current-buffer' is a selected Semantic enabled buffer." (mode-local-map-file-buffers function #'semantic-active-p)) -(defalias 'semantic-map-mode-buffers - 'mode-local-map-mode-buffers) - -(semantic-alias-obsolete 'semantic-fetch-overload - 'fetch-overload) +(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers) (semantic-alias-obsolete 'define-mode-overload-implementation 'define-mode-local-override) -(semantic-alias-obsolete 'semantic-with-mode-bindings - 'with-mode-local) - -(semantic-alias-obsolete 'define-semantic-child-mode - 'define-child-mode) - (defun semantic-install-function-overrides (overrides &optional transient mode) "Install the function OVERRIDES in the specified environment. OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD @@ -421,65 +311,65 @@ FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'" )) -;;; Editor goodies ;-) -;; -(defconst semantic-fw-font-lock-keywords - (eval-when-compile - (let* ( - ;; Variable declarations - (vl nil) - (kv (if vl (regexp-opt vl t) "")) - ;; Function declarations - (vf '( - "define-lex" - "define-lex-analyzer" - "define-lex-block-analyzer" - "define-lex-regex-analyzer" - "define-lex-spp-macro-declaration-analyzer" - "define-lex-spp-macro-undeclaration-analyzer" - "define-lex-spp-include-analyzer" - "define-lex-simple-regex-analyzer" - "define-lex-keyword-type-analyzer" - "define-lex-sexp-type-analyzer" - "define-lex-regex-type-analyzer" - "define-lex-string-type-analyzer" - "define-lex-block-type-analyzer" - ;;"define-mode-overload-implementation" - ;;"define-semantic-child-mode" - "define-semantic-idle-service" - "define-semantic-decoration-style" - "define-wisent-lexer" - "semantic-alias-obsolete" - "semantic-varalias-obsolete" - "semantic-make-obsolete-overload" - "defcustom-mode-local-semantic-dependency-system-include-path" - )) - (kf (if vf (regexp-opt vf t) "")) - ;; Regexp depths - (kv-depth (if kv (regexp-opt-depth kv) nil)) - (kf-depth (if kf (regexp-opt-depth kf) nil)) - ) - `((,(concat - ;; Declarative things - "(\\(" kv "\\|" kf "\\)" - ;; Whitespaces & names - "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?" - ) - (1 font-lock-keyword-face) - (,(+ 1 kv-depth kf-depth 1) - (cond ((match-beginning 2) - font-lock-type-face) - ((match-beginning ,(+ 1 kv-depth 1)) - font-lock-function-name-face) - ) - nil t) - (,(+ 1 kv-depth kf-depth 1 1) - (cond ((match-beginning 2) - font-lock-variable-name-face) - ) - nil t))) - )) - "Highlighted Semantic keywords.") +;; ;;; Editor goodies ;-) +;; ;; +;; (defconst semantic-fw-font-lock-keywords +;; (eval-when-compile +;; (let* ( +;; ;; Variable declarations +;; (vl nil) +;; (kv (if vl (regexp-opt vl t) "")) +;; ;; Function declarations +;; (vf '( +;; "define-lex" +;; "define-lex-analyzer" +;; "define-lex-block-analyzer" +;; "define-lex-regex-analyzer" +;; "define-lex-spp-macro-declaration-analyzer" +;; "define-lex-spp-macro-undeclaration-analyzer" +;; "define-lex-spp-include-analyzer" +;; "define-lex-simple-regex-analyzer" +;; "define-lex-keyword-type-analyzer" +;; "define-lex-sexp-type-analyzer" +;; "define-lex-regex-type-analyzer" +;; "define-lex-string-type-analyzer" +;; "define-lex-block-type-analyzer" +;; ;;"define-mode-overload-implementation" +;; ;;"define-semantic-child-mode" +;; "define-semantic-idle-service" +;; "define-semantic-decoration-style" +;; "define-wisent-lexer" +;; "semantic-alias-obsolete" +;; "semantic-varalias-obsolete" +;; "semantic-make-obsolete-overload" +;; "defcustom-mode-local-semantic-dependency-system-include-path" +;; )) +;; (kf (if vf (regexp-opt vf t) "")) +;; ;; Regexp depths +;; (kv-depth (if kv (regexp-opt-depth kv) nil)) +;; (kf-depth (if kf (regexp-opt-depth kf) nil)) +;; ) +;; `((,(concat +;; ;; Declarative things +;; "(\\(" kv "\\|" kf "\\)" +;; ;; Whitespaces & names +;; "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?" +;; ) +;; (1 font-lock-keyword-face) +;; (,(+ 1 kv-depth kf-depth 1) +;; (cond ((match-beginning 2) +;; font-lock-type-face) +;; ((match-beginning ,(+ 1 kv-depth 1)) +;; font-lock-function-name-face) +;; ) +;; nil t) +;; (,(+ 1 kv-depth kf-depth 1 1) +;; (cond ((match-beginning 2) +;; font-lock-variable-name-face) +;; ) +;; nil t))) +;; )) +;; "Highlighted Semantic keywords.") ;; (when (fboundp 'font-lock-add-keywords) ;; (font-lock-add-keywords 'emacs-lisp-mode @@ -494,4 +384,4 @@ FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'" (provide 'semantic/fw) -;;; semantic-fw.el ends here +;;; semantic/fw.el ends here diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 5d947551d48..f47275bdcf6 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -40,26 +40,11 @@ (declare-function semantic-analyze-tags-of-class-list "semantic/analyze/complete") - -;; (eval-when-compile -;; (require 'semantic/analyze)) - (eval-when-compile (require 'eldoc) (require 'semantic/edit) (require 'semantic/find)) -;;(require 'semantic/wisent) -;; (require 'font-lock) -;; (require 'pp) - -;; (eval-when-compile -;; ;; (require 'senator) -;; (require 'semantic/edit) -;; (require 'semantic/find) -;; (require 'semantic/format) -;; (require 'semantic/idle)) - ;;;; ;;;; Set up lexer @@ -1156,8 +1141,8 @@ END is the limit of the search." ;; grammar mode! ("[\r\n\t ]+:\\sw+\\>" 0 font-lock-builtin-face) - ;; Append the Semantic keywords - ,@semantic-fw-font-lock-keywords + ;; ;; Append the Semantic keywords + ;; ,@semantic-fw-font-lock-keywords ) "Font Lock keywords used to highlight Semantic grammar buffers.") diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el index 263541b8af9..c1d9276ff1e 100644 --- a/lisp/cedet/semantic/html.el +++ b/lisp/cedet/semantic/html.el @@ -29,18 +29,13 @@ ;; ToDo: Find <script> tags, and parse the contents in other ;; parsers, such as javascript, php, shtml, or others. +;;; Code: + (require 'semantic) (require 'semantic/format) -(condition-case nil - ;; This is not installed in all versions of Emacs. - (require 'sgml-mode) ;; html-mode is in here. - (error - (require 'psgml-mode) ;; XEmacs uses psgml, and html-mode is in here. - )) +(require 'sgml-mode) -;;; Code: -(eval-when-compile - (require 'semantic/ctxt)) +(defvar semantic-command-separation-character) (defvar semantic-html-super-regex "<\\(h[1-9]\\|title\\|script\\|body\\|a +href\\)\\>" diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 86cef704069..02170154298 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -226,12 +226,6 @@ minor mode is enabled." (semantic-add-minor-mode 'semantic-idle-scheduler-mode "ARP" nil) - -(semantic-alias-obsolete 'semantic-auto-parse-mode - 'semantic-idle-scheduler-mode) -(semantic-alias-obsolete 'global-semantic-auto-parse-mode - 'global-semantic-idle-scheduler-mode) - ;;; SERVICES services ;; @@ -488,18 +482,6 @@ datasets." ;; This part ALWAYS happens, and other services occur ;; afterwards. -;; (defcustom semantic-idle-scheduler-no-working-message t -;; "*If non-nil, disable display of working messages during parse." -;; :group 'semantic -;; :type 'boolean) - -;; (defcustom semantic-idle-scheduler-working-in-modeline-flag nil -;; "*Non-nil means show working messages in the mode line. -;; Typically, parsing will show messages in the minibuffer. -;; This will move the parse message into the modeline." -;; :group 'semantic -;; :type 'boolean) - (defvar semantic-before-idle-scheduler-reparse-hook nil "Hook run before option `semantic-idle-scheduler' begins parsing. If any hook function throws an error, this variable is reset to nil. @@ -835,11 +817,6 @@ current tag to display information." (if (> (length str) w) (setq str (substring str 0 w))))) (eldoc-message str)))) - -(semantic-alias-obsolete 'semantic-summary-mode - 'semantic-idle-summary-mode) -(semantic-alias-obsolete 'global-semantic-summary-mode - 'global-semantic-idle-summary-mode) ;;; Current symbol highlight ;; diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 8fc11734c2f..edd377f2ab4 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1102,6 +1102,7 @@ where a valid symbol is 'system, or nil." (defvar semantic-lex-spp-macro-max-length-to-save 200 "*Maximum length of an SPP macro before we opt to not save it.") +;;;###autoload (defun semantic-lex-spp-table-write-slot-value (value) "Write out the VALUE of a slot for EIEIO. The VALUE is a spp lexical table." @@ -1184,11 +1185,14 @@ If BUFFER is not provided, use the current buffer." ) (def-edebug-spec define-lex-spp-include-analyzer - (&define name stringp stringp form def-body) - ) - )) - + (&define name stringp stringp form def-body)))) (provide 'semantic/lex-spp) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: semantic/loaddefs +;; generated-autoload-load-name: "semantic/lex-spp" +;; End: + ;;; semantic-lex-spp.el ends here diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 93b062971c1..eb6d46df473 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1,4 +1,4 @@ -;;; lex.el --- Lexical Analyzer builder +;;; semantic/lex.el --- Lexical Analyzer builder ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, ;;; 2007, 2008, 2009 Free Software Foundation, Inc. @@ -182,33 +182,9 @@ ;; eliminate unneeded if statements to speed the lexer. (require 'semantic/fw) + ;;; Code: -;;; Compatibility -;; -(eval-and-compile - (if (not (fboundp 'with-syntax-table)) - -;; Copied from Emacs 21 for compatibility with released Emacses. -(defmacro with-syntax-table (table &rest body) - "With syntax table of current buffer set to a copy of TABLE, evaluate BODY. -The syntax table of the current buffer is saved, BODY is evaluated, and the -saved table is restored, even in case of an abnormal exit. -Value is what BODY returns." - (let ((old-table (make-symbol "table")) - (old-buffer (make-symbol "buffer"))) - `(let ((,old-table (syntax-table)) - (,old-buffer (current-buffer))) - (unwind-protect - (progn - (set-syntax-table (copy-syntax-table ,table)) - ,@body) - (save-current-buffer - (set-buffer ,old-buffer) - (set-syntax-table ,old-table)))))) - -)) - ;;; Semantic 2.x lexical analysis ;; (defun semantic-lex-map-symbols (fun table &optional property) @@ -2074,4 +2050,4 @@ return LENGTH tokens." ;; generated-autoload-load-name: "semantic/lex" ;; End: -;;; semantic-lex.el ends here +;;; semantic/lex.el ends here diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index aaee9f905bc..3300d09b3b1 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -36,6 +36,7 @@ (require 'semantic/sort) (require 'semantic/util) (require 'speedbar) +(declare-function semanticdb-file-stream "semantic/db") (defcustom semantic-sb-autoexpand-length 1 "*Length of a semantic bucket to autoexpand in place. diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index d8761b49d43..36d4d808ca2 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -31,9 +31,7 @@ ;; Originally written in semantic-util.el ;; -(require 'assoc) (require 'semantic) -(require 'semantic/db) (eval-when-compile (require 'semantic/find)) @@ -159,25 +157,6 @@ Return the sorted list." "Sort TAGS by name, then type in increasing order with side effects. Return the sorted list." (sort tags (lambda (a b) (semantic-tag-lessp-name-then-type b a)))) - - -(semantic-alias-obsolete 'semantic-sort-tokens-by-name-increasing - 'semantic-sort-tags-by-name-increasing) -(semantic-alias-obsolete 'semantic-sort-tokens-by-name-decreasing - 'semantic-sort-tags-by-name-decreasing) -(semantic-alias-obsolete 'semantic-sort-tokens-by-type-increasing - 'semantic-sort-tags-by-type-increasing) -(semantic-alias-obsolete 'semantic-sort-tokens-by-type-decreasing - 'semantic-sort-tags-by-type-decreasing) -(semantic-alias-obsolete 'semantic-sort-tokens-by-name-increasing-ci - 'semantic-sort-tags-by-name-increasing-ci) -(semantic-alias-obsolete 'semantic-sort-tokens-by-name-decreasing-ci - 'semantic-sort-tags-by-name-decreasing-ci) -(semantic-alias-obsolete 'semantic-sort-tokens-by-type-increasing-ci - 'semantic-sort-tags-by-type-increasing-ci) -(semantic-alias-obsolete 'semantic-sort-tokens-by-type-decreasing-ci - 'semantic-sort-tags-by-type-decreasing-ci) - ;;; Unique ;; @@ -489,11 +468,7 @@ include the default behavior, and merely extend your own." ;; means something completely different. (let ((tp (semantic-tag-get-attribute tag :parent))) (when (stringp tp) - tp) - )) - -(semantic-alias-obsolete 'semantic-nonterminal-external-member-parent - 'semantic-tag-external-member-parent) + tp))) (define-overloadable-function semantic-tag-external-member-p (parent tag) "Return non-nil if PARENT is the parent of TAG. @@ -516,11 +491,7 @@ include the default behavior, and merely extend your own." ;; means something completely different. (let ((tp (semantic-tag-external-member-parent tag))) (and (stringp tp) - (string= (semantic-tag-name parent) tp)) - )) - -(semantic-alias-obsolete 'semantic-nonterminal-external-member-p - 'semantic-tag-external-member-p) + (string= (semantic-tag-name parent) tp)))) (define-overloadable-function semantic-tag-external-member-children (tag &optional usedb) "Return the list of children which are not *in* TAG. @@ -586,11 +557,7 @@ See `semantic-tag-external-class' for details." (semanticdb-find-tags-by-name (semantic-tag-name tag))))) (semanticdb-strip-find-results m 'name)) ;; Presumably, if the tag is faux, it is not local. - nil - )) - -(semantic-alias-obsolete 'semantic-nonterminal-external-member-children - 'semantic-tag-external-member-children) + nil)) (provide 'semantic/sort) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index aabf72763a9..bea148b1c21 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -65,8 +65,6 @@ ;; Your tool should then create an instance of `semantic-symref-result'. (require 'semantic) -(require 'eieio) -;; (require 'ede) (defvar ede-minor-mode) (declare-function data-debug-new-buffer "data-debug") diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index d7fe7d5017e..f558db99877 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -87,12 +87,13 @@ PARENT can also be a `semanticdb-table' object." t)) ((semantic-tag-get-attribute tag :line) ;; The tag has a line number in it. Go there. - (goto-line (semantic-tag-get-attribute tag :line))) + (goto-char (point-min)) + (forward-line (1- (semantic-tag-get-attribute tag :line)))) ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line)) ;; The tag has a line number in it. Go there. - (goto-line (semantic-tag-get-attribute parent :line)) - (re-search-forward (semantic-tag-name tag) nil t) - ) + (goto-char (point-min)) + (forward-line (1- (semantic-tag-get-attribute parent :line))) + (re-search-forward (semantic-tag-name tag) nil t)) (t ;; Take a guess that the tag has a unique name, and just ;; search for it from the beginning of the buffer. diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 9e430aca800..82d628cbf38 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -245,32 +245,6 @@ STREAM-OR-BUFFER with a tag stream value, or nil." Return the name of TAG found in the toplevel STREAM." (semantic-tag-name tag)) -;;; Compatibility aliases. -;; -(semantic-alias-obsolete 'semantic-nonterminal-protection - 'semantic-tag-protection) -(semantic-alias-obsolete 'semantic-nonterminal-protection-default - 'semantic-tag-protection-default) -(semantic-alias-obsolete 'semantic-nonterminal-abstract - 'semantic-tag-abstract-p) -(semantic-alias-obsolete 'semantic-nonterminal-abstract-default - 'semantic-tag-abstract-p-default) -(semantic-alias-obsolete 'semantic-nonterminal-leaf - 'semantic-tag-leaf-p) -(semantic-alias-obsolete 'semantic-nonterminal-leaf-default - 'semantic-tag-leaf-p-default) -(semantic-alias-obsolete 'semantic-nonterminal-static-default - 'semantic-tag-static-p-default) -(semantic-alias-obsolete 'semantic-nonterminal-full-name - 'semantic-tag-full-name) -(semantic-alias-obsolete 'semantic-nonterminal-full-name-default - 'semantic-tag-full-name-default) - -;; TEMPORARY within betas of CEDET 1.0 -(semantic-alias-obsolete 'semantic-tag-static 'semantic-tag-static-p) -(semantic-alias-obsolete 'semantic-tag-leaf 'semantic-tag-leaf-p) -(semantic-alias-obsolete 'semantic-tag-abstract 'semantic-tag-abstract-p) - (provide 'semantic/tag-ls) ;; Local variables: diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index a16e558c58c..608f4f403ee 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1250,15 +1250,6 @@ This function is for internal use only." (message "A Rule must return a single tag-line list!") (debug tag) nil)) - -;; @todo - I think we've waited long enough. Lets find out. -;; -;; ;; Compatibility code to be removed in future versions. -;; (unless semantic-tag-expand-function -;; ;; This line throws a byte compiler warning. -;; (setq semantic-tag-expand-function semantic-expand-nonterminal) -;; ) - ;; Expand based on local configuration (if semantic-tag-expand-function (or (funcall semantic-tag-expand-function tag) @@ -1336,19 +1327,6 @@ This function is overridable with the symbol `insert-foreign-tag'." change-log-mode (foreign-tag) "Insert foreign tags into log-edit mode." (insert (concat "(" (semantic-format-tag-name foreign-tag) "): "))) - - -;;; EDEBUG display support -;; -(eval-after-load "cedet-edebug" - '(progn - (cedet-edebug-add-print-override - '(semantic-tag-p object) - '(concat "#<TAG " (semantic-format-tag-name object) ">")) - (cedet-edebug-add-print-override - '(and (listp object) (semantic-tag-p (car object))) - '(cedet-edebug-prin1-recurse object)) - )) ;;; Compatibility ;; @@ -1357,66 +1335,6 @@ This function is overridable with the symbol `insert-foreign-tag'." (defconst semantic-token-incompatible-version semantic-tag-incompatible-version) -(semantic-alias-obsolete 'semantic-token-name - 'semantic-tag-name) - -(semantic-alias-obsolete 'semantic-token-token - 'semantic-tag-class) - -(semantic-alias-obsolete 'semantic-token-extra-specs - 'semantic-tag-attributes) - -(semantic-alias-obsolete 'semantic-token-properties - 'semantic-tag-properties) - -(semantic-alias-obsolete 'semantic-token-properties-cdr - 'semantic--tag-properties-cdr) - -(semantic-alias-obsolete 'semantic-token-overlay - 'semantic-tag-overlay) - -(semantic-alias-obsolete 'semantic-token-overlay-cdr - 'semantic--tag-overlay-cdr) - -(semantic-alias-obsolete 'semantic-token-start - 'semantic-tag-start) - -(semantic-alias-obsolete 'semantic-token-end - 'semantic-tag-end) - -(semantic-alias-obsolete 'semantic-token-extent - 'semantic-tag-bounds) - -(semantic-alias-obsolete 'semantic-token-buffer - 'semantic-tag-buffer) - -(semantic-alias-obsolete 'semantic-token-put - 'semantic--tag-put-property) - -(semantic-alias-obsolete 'semantic-token-put-no-side-effect - 'semantic--tag-put-property-no-side-effect) - -(semantic-alias-obsolete 'semantic-token-get - 'semantic--tag-get-property) - -(semantic-alias-obsolete 'semantic-token-add-extra-spec - 'semantic-tag-put-attribute) - -(semantic-alias-obsolete 'semantic-token-extra-spec - 'semantic-tag-get-attribute) - -(semantic-alias-obsolete 'semantic-token-type - 'semantic-tag-type) - -(semantic-alias-obsolete 'semantic-token-modifiers - 'semantic-tag-modifiers) - -(semantic-alias-obsolete 'semantic-token-docstring - 'semantic-tag-docstring) - -(semantic-alias-obsolete 'semantic-token-type-parts - 'semantic-tag-type-members) - (defsubst semantic-token-type-parent (tag) "Return the parent of the type that TAG describes. The return value is a list. A value of nil means no parents. @@ -1430,136 +1348,12 @@ interfaces, or abstract classes which are parents of TAG." use `semantic-tag-type-superclass' \ and `semantic-tag-type-interfaces' instead") -(semantic-alias-obsolete 'semantic-token-type-parent-superclass - 'semantic-tag-type-superclasses) - -(semantic-alias-obsolete 'semantic-token-type-parent-implement - 'semantic-tag-type-interfaces) - -(semantic-alias-obsolete 'semantic-token-type-extra-specs - 'semantic-tag-attributes) - -(semantic-alias-obsolete 'semantic-token-type-extra-spec - 'semantic-tag-get-attribute) - -(semantic-alias-obsolete 'semantic-token-type-modifiers - 'semantic-tag-modifiers) - -(semantic-alias-obsolete 'semantic-token-function-args - 'semantic-tag-function-arguments) - -(semantic-alias-obsolete 'semantic-token-function-extra-specs - 'semantic-tag-attributes) - -(semantic-alias-obsolete 'semantic-token-function-extra-spec - 'semantic-tag-get-attribute) - -(semantic-alias-obsolete 'semantic-token-function-modifiers - 'semantic-tag-modifiers) - -(semantic-alias-obsolete 'semantic-token-function-throws - 'semantic-tag-function-throws) - -(semantic-alias-obsolete 'semantic-token-function-parent - 'semantic-tag-function-parent) - -(semantic-alias-obsolete 'semantic-token-function-destructor - 'semantic-tag-function-destructor-p) - -(semantic-alias-obsolete 'semantic-token-variable-default - 'semantic-tag-variable-default) - -(semantic-alias-obsolete 'semantic-token-variable-extra-specs - 'semantic-tag-attributes) - -(semantic-alias-obsolete 'semantic-token-variable-extra-spec - 'semantic-tag-get-attribute) - -(semantic-alias-obsolete 'semantic-token-variable-modifiers - 'semantic-tag-modifiers) - -(semantic-alias-obsolete 'semantic-token-variable-const - 'semantic-tag-variable-constant-p) - -(semantic-alias-obsolete 'semantic-token-variable-optsuffix - 'semantic-tag-variable-optsuffix) - -(semantic-alias-obsolete 'semantic-token-include-system - 'semantic-tag-include-system-p) - -(semantic-alias-obsolete 'semantic-token-p - 'semantic-tag-p) - -(semantic-alias-obsolete 'semantic-token-with-position-p - 'semantic-tag-with-position-p) - (semantic-alias-obsolete 'semantic-tag-make-assoc-list 'semantic-tag-make-plist) -(semantic-alias-obsolete 'semantic-nonterminal-children - 'semantic-tag-children-compatibility) - -(semantic-alias-obsolete 'semantic-narrow-to-token - 'semantic-narrow-to-tag) - -(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token - 'semantic-with-buffer-narrowed-to-current-tag) - -(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token - 'semantic-with-buffer-narrowed-to-tag) - -(semantic-alias-obsolete 'semantic-deoverlay-token - 'semantic--tag-unlink-from-buffer) - -(semantic-alias-obsolete 'semantic-overlay-token - 'semantic--tag-link-to-buffer) - -(semantic-alias-obsolete 'semantic-deoverlay-list - 'semantic--tag-unlink-list-from-buffer) - -(semantic-alias-obsolete 'semantic-overlay-list - 'semantic--tag-link-list-to-buffer) - -(semantic-alias-obsolete 'semantic-deoverlay-cache - 'semantic--tag-unlink-cache-from-buffer) - -(semantic-alias-obsolete 'semantic-overlay-cache - 'semantic--tag-link-cache-to-buffer) - -(semantic-alias-obsolete 'semantic-cooked-token-p - 'semantic--tag-expanded-p) - (semantic-varalias-obsolete 'semantic-expand-nonterminal 'semantic-tag-expand-function) -(semantic-alias-obsolete 'semantic-raw-to-cooked-token - 'semantic--tag-expand) - -;; Lets test this out during this short transition. -(semantic-alias-obsolete 'semantic-clone-tag - 'semantic-tag-clone) - -(semantic-alias-obsolete 'semantic-token - 'semantic-tag) - -(semantic-alias-obsolete 'semantic-token-new-variable - 'semantic-tag-new-variable) - -(semantic-alias-obsolete 'semantic-token-new-function - 'semantic-tag-new-function) - -(semantic-alias-obsolete 'semantic-token-new-type - 'semantic-tag-new-type) - -(semantic-alias-obsolete 'semantic-token-new-include - 'semantic-tag-new-include) - -(semantic-alias-obsolete 'semantic-token-new-package - 'semantic-tag-new-package) - -(semantic-alias-obsolete 'semantic-equivalent-tokens-p - 'semantic-equivalent-tag-p) - (provide 'semantic/tag) ;; Local variables: diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index b6db19a7485..6b64287840e 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -30,20 +30,6 @@ ;;; Code: (require 'semantic) -(eval-when-compile - (require 'semantic/decorate) - ) - -;;; Compatibility -(if (fboundp 'propertize) - (defalias 'semantic-propertize 'propertize) - (defsubst semantic-propertize (string &rest properties) - "Return a copy of STRING with text properties added. -Dummy implementation for compatibility which just return STRING and -ignore PROPERTIES." - string) - ) - ;;; Group for all semantic enhancing modes (defgroup semantic-modes nil "Minor modes associated with the Semantic architecture." @@ -53,7 +39,7 @@ ignore PROPERTIES." ;;;; Semantic minor modes stuff ;;;; (defcustom semantic-update-mode-line t - "*If non-nil, show enabled minor modes in the mode line. + "If non-nil, show enabled minor modes in the mode line. Only minor modes that are not turned on globally are shown in the mode line." :group 'semantic @@ -67,8 +53,8 @@ line." #'semantic-mode-line-update))) (defcustom semantic-mode-line-prefix - (semantic-propertize "S" 'face 'bold) - "*Prefix added to minor mode indicators in the mode line." + (propertize "S" 'face 'bold) + "Prefix added to minor mode indicators in the mode line." :group 'semantic :type 'string :require 'semantic/util-modes @@ -216,7 +202,7 @@ If ARG is nil, then toggle." ;;;###autoload (defcustom global-semantic-highlight-edits-mode nil - "*If non-nil enable global use of variable `semantic-highlight-edits-mode'. + "If non-nil enable global use of variable `semantic-highlight-edits-mode'. When this mode is enabled, changes made to a buffer are highlighted until the buffer is reparsed." :group 'semantic @@ -228,7 +214,7 @@ until the buffer is reparsed." (global-semantic-highlight-edits-mode (if val 1 -1)))) (defcustom semantic-highlight-edits-mode-hook nil - "*Hook run at the end of function `semantic-highlight-edits-mode'." + "Hook run at the end of function `semantic-highlight-edits-mode'." :group 'semantic :type 'hook) @@ -238,7 +224,7 @@ until the buffer is reparsed." (:background "gray20")) (((class color) (background light)) (:background "gray90"))) - "*Face used to show dirty tokens in `semantic-highlight-edits-mode'." + "Face used to show dirty tokens in `semantic-highlight-edits-mode'." :group 'semantic-faces) (defun semantic-highlight-edits-new-change-hook-fcn (overlay) @@ -329,7 +315,7 @@ If ARG is nil, then toggle." ;;;###autoload (defcustom global-semantic-show-unmatched-syntax-mode nil - "*If non-nil, enable global use of `semantic-show-unmatched-syntax-mode'. + "If non-nil, enable global use of `semantic-show-unmatched-syntax-mode'. When this mode is enabled, syntax in the current buffer which the semantic parser cannot match is highlighted with a red underline." :group 'semantic @@ -341,7 +327,7 @@ semantic parser cannot match is highlighted with a red underline." (global-semantic-show-unmatched-syntax-mode (if val 1 -1)))) (defcustom semantic-show-unmatched-syntax-mode-hook nil - "*Hook run at the end of function `semantic-show-unmatched-syntax-mode'." + "Hook run at the end of function `semantic-show-unmatched-syntax-mode'." :group 'semantic :type 'hook) @@ -350,7 +336,7 @@ semantic parser cannot match is highlighted with a red underline." (:underline "red")) (((class color) (background light)) (:underline "red"))) - "*Face used to show unmatched syntax in. + "Face used to show unmatched syntax in. The face is used in `semantic-show-unmatched-syntax-mode'." :group 'semantic-faces) @@ -534,7 +520,7 @@ minor mode is enabled. ;;;###autoload (defcustom global-semantic-show-parser-state-mode nil - "*If non-nil enable global use of `semantic-show-parser-state-mode'. + "If non-nil enable global use of `semantic-show-parser-state-mode'. When enabled, the current parse state of the current buffer is displayed in the mode line. See `semantic-show-parser-state-marker' for details on what is displayed." @@ -556,7 +542,7 @@ If ARG is nil, then toggle." 'semantic-show-parser-state-mode arg))) (defcustom semantic-show-parser-state-mode-hook nil - "*Hook run at the end of function `semantic-show-parser-state-mode'." + "Hook run at the end of function `semantic-show-parser-state-mode'." :group 'semantic :type 'hook) @@ -735,7 +721,7 @@ If ARG is nil, then toggle." ;;;###autoload (defcustom global-semantic-stickyfunc-mode nil - "*If non-nil, enable global use of `semantic-stickyfunc-mode'. + "If non-nil, enable global use of `semantic-stickyfunc-mode'. This minor mode only works for Emacs 21 or later. When enabled, the header line is enabled, and the first line of the current function or method is displayed in it. @@ -750,7 +736,7 @@ This makes it appear that the first line of that tag is (global-semantic-stickyfunc-mode (if val 1 -1)))) (defcustom semantic-stickyfunc-mode-hook nil - "*Hook run at the end of function `semantic-stickyfunc-mode'." + "Hook run at the end of function `semantic-stickyfunc-mode'." :group 'semantic :type 'hook) @@ -860,7 +846,7 @@ Use the command `semantic-stickyfunc-mode' to change this variable.") ;; Not Emacs or a window system means no scrollbar or fringe, ;; and perhaps not even a header line to worry about. "") - "*String used to indent the stickyfunc header. + "String used to indent the stickyfunc header. Customize this string to match the space used by scrollbars and fringe so it does not appear that the code is moving left/right when it lands in the sticky line." @@ -1050,7 +1036,7 @@ If ARG is nil, then toggle." ;;;###autoload (defcustom global-semantic-highlight-func-mode nil - "*If non-nil, enable global use of `semantic-highlight-func-mode'. + "If non-nil, enable global use of `semantic-highlight-func-mode'. When enabled, the first line of the current tag is highlighted." :group 'semantic :group 'semantic-modes @@ -1061,7 +1047,7 @@ When enabled, the first line of the current tag is highlighted." (global-semantic-highlight-func-mode (if val 1 -1)))) (defcustom semantic-highlight-func-mode-hook nil - "*Hook run at the end of function `semantic-highlight-func-mode'." + "Hook run at the end of function `semantic-highlight-func-mode'." :group 'semantic :type 'hook) diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 7889656bd7e..669bf68f432 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -26,20 +26,17 @@ ;; Semantic utility API for use with semantic tag tables. ;; -(require 'assoc) (require 'semantic) +(eval-when-compile + (require 'semantic/db-find) + ;; For semantic-find-tags-by-class, semantic--find-tags-by-function, + ;; and semantic-brute-find-tag-standard: + (require 'semantic/find)) + (declare-function data-debug-insert-stuff-list "data-debug") (declare-function data-debug-insert-thing "data-debug") -(declare-function semanticdb-file-stream "semantic/db") -(declare-function semanticdb-abstract-table-child-p "semantic/db") -(declare-function semanticdb-refresh-table "semantic/db") -(declare-function semanticdb-get-tags "semantic/db") -(declare-function semanticdb-find-results-p "semantic/db-find") - -;; For semantic-find-tags-by-class, semantic--find-tags-by-function, -;; and semantic-brute-find-tag-standard: -(eval-when-compile (require 'semantic/find)) +(declare-function semantic-ctxt-current-symbol-and-bounds "semantic/ctxt") ;;; Code: @@ -368,19 +365,9 @@ Argument P is the point to search from in the current buffer." "Display info about something under the cursor using generic methods." (interactive) (require 'semantic/find) - (let ( - ;(name (thing-at-point 'symbol)) - (strm (cdr (semantic-fetch-tags))) + (let ((strm (cdr (semantic-fetch-tags))) (res nil)) -; (if name - (setq res -; (semantic-find-nonterminal-by-name name strm) -; (semantic-find-nonterminal-by-type name strm) -; (semantic-recursive-find-nonterminal-by-name name (current-buffer)) - (semantic-brute-find-tag-by-position (point) strm) - - ) -; ) + (setq res (semantic-brute-find-tag-by-position (point) strm)) (if res (progn (pop-to-buffer "*SEMANTIC HACK RESULTS*") @@ -459,7 +446,9 @@ This uses `semanticdb' when available." (error nil)) (or result ;; If the analyzer fails, then go into boring completion. - (if (and (featurep 'semantic/db) (semanticdb-minor-mode-p)) + (if (and (featurep 'semantic/db) + (semanticdb-minor-mode-p) + (require 'semantic/db-find)) (semanticdb-fast-strip-find-results (semanticdb-deep-find-tags-for-completion prefix)) (semantic-deep-find-tags-for-completion prefix (current-buffer)))))) @@ -469,6 +458,7 @@ This uses `semanticdb' when available." When called from a program, optional arg PREDICATE is a predicate determining which symbols are considered." (interactive) + (require 'semantic/ctxt) (let* ((start (car (nth 2 (semantic-ctxt-current-symbol-and-bounds (point))))) (pattern (regexp-quote (buffer-substring start (point)))) diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el index 162b443e6ad..e3614d8b591 100644 --- a/lisp/cedet/semantic/wisent/wisent.el +++ b/lisp/cedet/semantic/wisent/wisent.el @@ -7,7 +7,6 @@ ;; Maintainer: David Ponce <david@dponce.com> ;; Created: 30 January 2002 ;; Keywords: syntax -;; X-RCS: $Id: wisent.el,v 1.39 2009/01/10 00:15:49 zappo Exp $ ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el index eb09ed260bd..a0c8ec62816 100644 --- a/lisp/cedet/srecode/expandproto.el +++ b/lisp/cedet/srecode/expandproto.el @@ -26,6 +26,7 @@ (require 'ring) (require 'semantic) (require 'semantic/analyze) +(require 'semantic/senator) (require 'srecode/insert) (require 'srecode/dictionary) diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 73a722b518d..d085fbac34f 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -30,7 +30,6 @@ (require 'srecode/insert) (require 'srecode/find) (require 'srecode/map) -;; (require 'senator) (require 'semantic/decorate) (require 'semantic/wisent) diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index 178ec44a8de..22969db2323 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el @@ -37,8 +37,8 @@ (require 'srecode/dictionary) (require 'semantic/find) (require 'semantic/format) +(require 'semantic/senator) (require 'ring) -;;(require 'senator) ;;; The SEMANTIC TAG inserter diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 004e4a86848..9034544482c 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -738,30 +738,6 @@ When optional BUFFER is provided, search that buffer." (nreverse ans)))) - -;;; MMM-Mode support ?? -;;(condition-case nil -;; (require 'mmm-mode) -;; (error (message "SRecoder Template Mode: No multi-mode not support."))) -;; -;;(defun srecode-template-add-submode () -;; "Add a submode to the current template file using mmm-mode. -;;If mmm-mode isn't available, then do nothing." -;; (if (not (featurep 'mmm-mode)) -;; nil ;; Nothing to do. -;; ;; Else, set up mmm-mode in this buffer. -;; (let ((submode (semantic-find-tags-by-name "mode"))) -;; (if (not submode) -;; nil ;; Nothing to do. -;; ;; Well, we have a mode, lets try turning on mmm-mode. -;; -;; ;; (mmm-mode-on) -;; -;; -;; -;; )))) -;; - (provide 'srecode/srt-mode) ;; The autoloads in this file must go into the global loaddefs.el, not diff --git a/lisp/comint.el b/lisp/comint.el index 4fa9f7c3ced..cc04bd90209 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -686,7 +686,8 @@ PROGRAM should be either a string denoting an executable program to create via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP connection to be opened via `open-network-stream'. If there is already a running process in that buffer, it is not restarted. Optional fourth arg -STARTFILE is the name of a file to send the contents of to the process. +STARTFILE is the name of a file, whose contents are sent to the +process as its initial input. If PROGRAM is a string, any more args are arguments to PROGRAM." (or (fboundp 'start-file-process) @@ -709,7 +710,8 @@ PROGRAM should be either a string denoting an executable program to create via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP connection to be opened via `open-network-stream'. If there is already a running process in that buffer, it is not restarted. Optional third arg -STARTFILE is the name of a file to send the contents of the process to. +STARTFILE is the name of a file, whose contents are sent to the +process as its initial input. If PROGRAM is a string, any more args are arguments to PROGRAM." (apply #'make-comint-in-buffer name nil program startfile switches)) @@ -728,7 +730,7 @@ See `make-comint' and `comint-exec'." (defun comint-exec (buffer name command startfile switches) "Start up a process named NAME in buffer BUFFER for Comint modes. -Runs the given COMMAND with SWITCHES with output to STARTFILE. +Runs the given COMMAND with SWITCHES, and initial input from STARTFILE. Blasts any old process running in the buffer. Doesn't set the buffer mode. You can use this to cheaply run a series of processes in the same Comint buffer. The hook `comint-exec-hook' is run after each exec." @@ -790,7 +792,7 @@ buffer. The hook `comint-exec-hook' is run after each exec." default-directory "/")) proc decoding encoding changed) - (let ((exec-path (if (file-name-directory command) + (let ((exec-path (if (and command (file-name-directory command)) ;; If the command has slashes, make sure we ;; first look relative to the current directory. (cons default-directory exec-path) exec-path))) @@ -816,7 +818,9 @@ 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-click')." (interactive "e") - (mouse-set-point event) + ;; Don't set the mouse here, since it may otherwise change the behavior + ;; of the command on which we fallback if there's no field at point. + ;; (mouse-set-point event) (let ((pos (posn-point (event-end event))) field input) (with-selected-window (posn-window (event-end event)) @@ -833,15 +837,16 @@ by the global keymap (usually `mouse-yank-at-click')." (fun (and last-key (lookup-key global-map (vector last-key))))) (and fun (not (eq fun 'comint-insert-input)) (call-interactively fun))) - ;; Otherwise, insert the previous input. - (goto-char (point-max)) - ;; First delete any old unsent input at the end - (delete-region - (or (marker-position comint-accum-marker) - (process-mark (get-buffer-process (current-buffer)))) - (point)) - ;; Insert the input at point - (insert input)))) + (with-selected-window (posn-window (event-end event)) + ;; Otherwise, insert the previous input. + (goto-char (point-max)) + ;; First delete any old unsent input at the end + (delete-region + (or (marker-position comint-accum-marker) + (process-mark (get-buffer-process (current-buffer)))) + (point)) + ;; Insert the input at point + (insert input))))) ;; Input history processing in a buffer ;; =========================================================================== diff --git a/lisp/composite.el b/lisp/composite.el index 77eea9cb4ec..c9f16e2f518 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -773,8 +773,10 @@ Auto Composition mode in all buffers (this is the default)." ;;;###autoload (define-global-minor-mode global-auto-composition-mode auto-composition-mode turn-on-auto-composition-if-enabled - :extra-args (dummy) - :initialize 'custom-initialize-safe-default + ;; This :extra-args' appears to be the result of a naive copy&paste + ;; from global-font-lock-mode. + ;; :extra-args (dummy) + :initialize 'custom-initialize-delay :init-value (not noninteractive) :group 'auto-composition :version "23.1") diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9ad6a05fe1a..4c3597db6d9 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,7 +1,7 @@ ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages ;; -;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Maintainer: FSF @@ -1813,8 +1813,7 @@ item in another window.\n\n")) (:weight bold :slant italic :underline t))) "Face used when the customize item is invalid." :group 'custom-magic-faces) -;; backward-compatibility alias -(put 'custom-invalid-face 'face-alias 'custom-invalid) +(define-obsolete-face-alias 'custom-invalid-face 'custom-invalid "22.1") (defface custom-rogue '((((class color)) (:foreground "pink" :background "black")) @@ -1822,8 +1821,7 @@ item in another window.\n\n")) (:underline t))) "Face used when the customize item is not defined for customization." :group 'custom-magic-faces) -;; backward-compatibility alias -(put 'custom-rogue-face 'face-alias 'custom-rogue) +(define-obsolete-face-alias 'custom-rogue-face 'custom-rogue "22.1") (defface custom-modified '((((min-colors 88) (class color)) (:foreground "white" :background "blue1")) @@ -1833,8 +1831,7 @@ item in another window.\n\n")) (:slant italic :bold))) "Face used when the customize item has been modified." :group 'custom-magic-faces) -;; backward-compatibility alias -(put 'custom-modified-face 'face-alias 'custom-modified) +(define-obsolete-face-alias 'custom-modified-face 'custom-modified "22.1") (defface custom-set '((((min-colors 88) (class color)) (:foreground "blue1" :background "white")) @@ -1844,8 +1841,7 @@ item in another window.\n\n")) (:slant italic))) "Face used when the customize item has been set." :group 'custom-magic-faces) -;; backward-compatibility alias -(put 'custom-set-face 'face-alias 'custom-set) +(define-obsolete-face-alias 'custom-set-face 'custom-set "22.1") (defface custom-changed '((((min-colors 88) (class color)) (:foreground "white" :background "blue1")) @@ -1855,8 +1851,7 @@ item in another window.\n\n")) (:slant italic))) "Face used when the customize item has been changed." :group 'custom-magic-faces) -;; backward-compatibility alias -(put 'custom-changed-face 'face-alias 'custom-changed) +(define-obsolete-face-alias 'custom-changed-face 'custom-changed "22.1") (defface custom-themed '((((min-colors 88) (class color)) (:foreground "white" :background "blue1")) @@ -1870,8 +1865,7 @@ item in another window.\n\n")) (defface custom-saved '((t (:underline t))) "Face used when the customize item has been saved." :group 'custom-magic-faces) -;; backward-compatibility alias -(put 'custom-saved-face 'face-alias 'custom-saved) +(define-obsolete-face-alias 'custom-saved-face 'custom-saved "22.1") (defconst custom-magic-alist '((nil "#" underline "\ @@ -2068,8 +2062,7 @@ and `face'." "Face for custom buffer buttons if `custom-raised-buttons' is non-nil." :version "21.1" :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-button-face 'face-alias 'custom-button) +(define-obsolete-face-alias 'custom-button-face 'custom-button "22.1") (defface custom-button-mouse '((((type x w32 ns) (class color)) @@ -2105,8 +2098,8 @@ and `face'." "Face for pressed custom buttons if `custom-raised-buttons' is non-nil." :version "21.1" :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed) +(define-obsolete-face-alias 'custom-button-pressed-face + 'custom-button-pressed "22.1") (defface custom-button-pressed-unraised '((default :inherit custom-button-unraised) @@ -2124,8 +2117,8 @@ and `face'." (defface custom-documentation '((t nil)) "Face used for documentation strings in customization buffers." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-documentation-face 'face-alias 'custom-documentation) +(define-obsolete-face-alias 'custom-documentation-face + 'custom-documentation "22.1") (defface custom-state '((((class color) (background dark)) @@ -2136,8 +2129,7 @@ and `face'." (t nil)) "Face used for State descriptions in the customize buffer." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-state-face 'face-alias 'custom-state) +(define-obsolete-face-alias 'custom-state-face 'custom-state "22.1") (defface custom-link '((t :inherit link)) @@ -2192,9 +2184,10 @@ and `face'." (when (and (>= pos from) (<= pos to)) (condition-case nil (progn - (if (> column 0) - (goto-line line) - (goto-line (1+ line))) + (goto-char (point-min)) + (forward-line (if (> column 0) + (1- line) + line)) (move-to-column column)) (error nil))))) @@ -2369,8 +2362,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." "Face used for comments on variables or faces." :version "21.1" :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-comment-face 'face-alias 'custom-comment) +(define-obsolete-face-alias 'custom-comment-face 'custom-comment "22.1") ;; like font-lock-comment-face (defface custom-comment-tag @@ -2383,8 +2375,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (t (:weight bold))) "Face used for the comment tag on variables or faces." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag) +(define-obsolete-face-alias 'custom-comment-tag-face 'custom-comment-tag "22.1") (define-widget 'custom-comment 'string "User comment." @@ -2437,14 +2428,14 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (t (:weight bold))) "Face used for unpushable variable tags." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag) +(define-obsolete-face-alias 'custom-variable-tag-face + 'custom-variable-tag "22.1") (defface custom-variable-button '((t (:underline t :weight bold))) "Face used for pushable variable tags." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-variable-button-face 'face-alias 'custom-variable-button) +(define-obsolete-face-alias 'custom-variable-button-face + 'custom-variable-button "22.1") (defcustom custom-variable-default-form 'edit "Default form of displaying variable values." @@ -3216,8 +3207,7 @@ Only match frames that support the specified face attributes.") `((t :inherit custom-variable-tag)) "Face used for face tags." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-face-tag-face 'face-alias 'custom-face-tag) +(define-obsolete-face-alias 'custom-face-tag-face 'custom-face-tag "22.1") (defcustom custom-face-default-form 'selected "Default form of displaying face definition." @@ -3801,8 +3791,7 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." (t (:weight bold))) "Face used for group tags." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1) +(define-obsolete-face-alias 'custom-group-tag-face-1 'custom-group-tag-1 "22.1") (defface custom-group-tag `((((class color) @@ -3817,8 +3806,7 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." (t (:weight bold))) "Face used for low level group tags." :group 'custom-faces) -;; backward-compatibility alias -(put 'custom-group-tag-face 'face-alias 'custom-group-tag) +(define-obsolete-face-alias 'custom-group-tag-face 'custom-group-tag "22.1") (define-widget 'custom-group 'custom "Customize group." @@ -4647,7 +4635,7 @@ The following commands are available: \\<widget-keymap>\ Move to next button, link or editable field. \\[widget-forward] -Move to previous button, link or editable field. \\[advertised-widget-backward] +Move to previous button, link or editable field. \\[widget-backward] \\<custom-field-keymap>\ Complete content of editable text field. \\[widget-complete] \\<custom-mode-map>\ diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 11b03887ac0..970431d46cd 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -38,8 +38,7 @@ (garbage-collection-messages alloc boolean) ;; buffer.c (mode-line-format mode-line sexp) ;Hard to do right. - (default-major-mode internal function) - (enable-multibyte-characters mule boolean) + (major-mode internal function) (case-fold-search matching boolean) (fill-column fill integer) (left-margin fill integer) @@ -274,7 +273,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const alt) (const hyper) (const super)) "23.1") (ns-antialias-text ns boolean "23.1") - (ns-use-qd-smoothing ns boolean "23.1") ;; process.c (delete-exited-processes processes-basics boolean) ;; syntax.c diff --git a/lisp/custom.el b/lisp/custom.el index 07533253d76..e3d3d9a63a0 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -57,9 +57,9 @@ Otherwise, VALUE will be evaluated and used as the default binding for symbol." (unless (default-boundp symbol) ;; Use the saved value if it exists, otherwise the standard setting. - (set-default symbol (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) + (set-default symbol (eval (if (get symbol 'saved-value) + (car (get symbol 'saved-value)) + value))))) (defun custom-initialize-set (symbol value) "Initialize SYMBOL based on VALUE. @@ -70,31 +70,9 @@ if any, or VALUE." (unless (default-boundp symbol) (funcall (or (get symbol 'custom-set) 'set-default) symbol - (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) - -(defun custom-initialize-safe-set (symbol value) - "Like `custom-initialize-set', but catches errors. -If an error occurs during initialization, SYMBOL is set to nil -and no error is thrown. This is meant for use in pre-loaded files -where some variables or functions used to compute VALUE may not yet -be defined. You can then re-evaluate VALUE in startup.el, for instance -using `custom-reevaluate-setting'." - (condition-case nil - (custom-initialize-set symbol value) - (error (set-default symbol nil)))) - -(defun custom-initialize-safe-default (symbol value) - "Like `custom-initialize-default', but catches errors. -If an error occurs during initialization, SYMBOL is set to nil -and no error is thrown. This is meant for use in pre-loaded files -where some variables or functions used to compute VALUE may not yet -be defined. You can then re-evaluate VALUE in startup.el, for instance -using `custom-reevaluate-setting'." - (condition-case nil - (custom-initialize-default symbol value) - (error (set-default symbol nil)))) + (eval (if (get symbol 'saved-value) + (car (get symbol 'saved-value)) + value))))) (defun custom-initialize-reset (symbol value) "Initialize SYMBOL based on VALUE. @@ -130,6 +108,21 @@ For the standard setting, use `set-default'." (t (set-default symbol (eval value))))) +(defvar custom-delayed-init-variables nil + "List of variables whose initialization is pending.") + +(defun custom-initialize-delay (symbol value) + "Delay initialization of SYMBOL to the next Emacs start. +This is used in files that are preloaded, so that the initialization is +done in the run-time context rather than the build-time context. +This also has the side-effect that the (delayed) initialization is performed +with the :setter." + ;; Until the var is actually initialized, it is kept unbound. + ;; This seemed to be at least as good as setting it to an arbitrary + ;; value like nil (evaluating `value' is not an option because it + ;; may have undesirable side-effects). + (push symbol custom-delayed-init-variables)) + (defun custom-declare-variable (symbol default doc &rest args) "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. DEFAULT should be an expression to evaluate to compute the default value, diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index cbab591d4bf..ab9cae6fed8 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -145,6 +145,7 @@ Any other non-nil version means case is not significant." (const :tag "like search" case-fold-search) (other :tag "on" t)) :group 'dabbrev) +;;;###autoload(put 'dabbrev-case-fold-search 'risky-local-variable t) (defcustom dabbrev-upcase-means-case-search nil "The significance of an uppercase character in an abbreviation. @@ -185,6 +186,7 @@ This variable has an effect only when the value of (const :tag "based on `case-replace'" case-replace) (other :tag "on" t)) :group 'dabbrev) +;;;###autoload(put 'dabbrev-case-replace 'risky-local-variable t) (defcustom dabbrev-abbrev-char-regexp nil "Regexp to recognize a character in an abbreviation or expansion. diff --git a/lisp/desktop.el b/lisp/desktop.el index 5eebfd17aee..29230e07cb5 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -220,7 +220,7 @@ the normal hook `desktop-not-loaded-hook' is run." :group 'desktop :version "22.2") -(defcustom desktop-path '("." "~") +(defcustom desktop-path (list "." user-emacs-directory "~") "List of directories to search for the desktop file. The base name of the file is specified in `desktop-base-file-name'." :type '(repeat directory) diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 624b0ccfb3e..93a8a418806 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -1,7 +1,7 @@ ;;; diff-mode.el --- a mode for viewing/editing context diffs -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: convenience patch diff @@ -242,8 +242,7 @@ try to refine the current hunk, as well." (t :weight bold)) "`diff-mode' face inherited by hunk and index header faces." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-header-face 'face-alias 'diff-header) +(define-obsolete-face-alias 'diff-header-face 'diff-header "22.1") (defvar diff-header-face 'diff-header) (defface diff-file-header @@ -258,40 +257,35 @@ try to refine the current hunk, as well." (t :weight bold)) ; :height 1.3 "`diff-mode' face used to highlight file header lines." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-file-header-face 'face-alias 'diff-file-header) +(define-obsolete-face-alias 'diff-file-header-face 'diff-file-header "22.1") (defvar diff-file-header-face 'diff-file-header) (defface diff-index '((t :inherit diff-file-header)) "`diff-mode' face used to highlight index header lines." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-index-face 'face-alias 'diff-index) +(define-obsolete-face-alias 'diff-index-face 'diff-index "22.1") (defvar diff-index-face 'diff-index) (defface diff-hunk-header '((t :inherit diff-header)) "`diff-mode' face used to highlight hunk header lines." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-hunk-header-face 'face-alias 'diff-hunk-header) +(define-obsolete-face-alias 'diff-hunk-header-face 'diff-hunk-header "22.1") (defvar diff-hunk-header-face 'diff-hunk-header) (defface diff-removed '((t :inherit diff-changed)) "`diff-mode' face used to highlight removed lines." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-removed-face 'face-alias 'diff-removed) +(define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1") (defvar diff-removed-face 'diff-removed) (defface diff-added '((t :inherit diff-changed)) "`diff-mode' face used to highlight added lines." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-added-face 'face-alias 'diff-added) +(define-obsolete-face-alias 'diff-added-face 'diff-added "22.1") (defvar diff-added-face 'diff-added) (defface diff-changed @@ -301,8 +295,7 @@ try to refine the current hunk, as well." :foreground "yellow" :weight bold :slant italic)) "`diff-mode' face used to highlight changed lines." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-changed-face 'face-alias 'diff-changed) +(define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1") (defvar diff-changed-face 'diff-changed) (defface diff-indicator-removed @@ -330,24 +323,21 @@ try to refine the current hunk, as well." '((t :inherit diff-header)) "`diff-mode' face used to highlight function names produced by \"diff -p\"." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-function-face 'face-alias 'diff-function) +(define-obsolete-face-alias 'diff-function-face 'diff-function "22.1") (defvar diff-function-face 'diff-function) (defface diff-context '((((class color grayscale) (min-colors 88)) :inherit shadow)) "`diff-mode' face used to highlight context and other side-information." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-context-face 'face-alias 'diff-context) +(define-obsolete-face-alias 'diff-context-face 'diff-context "22.1") (defvar diff-context-face 'diff-context) (defface diff-nonexistent '((t :inherit diff-file-header)) "`diff-mode' face used to highlight nonexistent files in recursive diffs." :group 'diff-mode) -;; backward-compatibility alias -(put 'diff-nonexistent-face 'face-alias 'diff-nonexistent) +(define-obsolete-face-alias 'diff-nonexistent-face 'diff-nonexistent "22.1") (defvar diff-nonexistent-face 'diff-nonexistent) (defconst diff-yank-handler '(diff-yank-function)) @@ -556,7 +546,8 @@ If the prefix ARG is given, restrict the view to the current file instead." (interactive) (diff-beginning-of-hunk) (let* ((start (point)) - (nexthunk (when (re-search-forward diff-hunk-header-re nil t) + ;; Search the second match, since we're looking at the first. + (nexthunk (when (re-search-forward diff-hunk-header-re nil t 2) (match-beginning 0))) (firsthunk (ignore-errors (goto-char start) @@ -1598,7 +1589,7 @@ NOPROMPT, if non-nil, means not to prompt the user." (when (> (prefix-numeric-value other-file) 8) (setq diff-jump-to-old-file other)) (with-current-buffer buf - (goto-line (string-to-number line)) + (goto-char (point-min)) (forward-line (1- (string-to-number line))) (let* ((orig-pos (point)) (switched nil) ;; FIXME: Check for case where both OLD and NEW are found. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 2e31e9cd90d..e179a484ac3 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,4 +1,4 @@ -;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*- +;;; dired-aux.el --- less commonly used parts of dired ;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003, ;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. @@ -196,7 +196,7 @@ condition. Two file items are considered to match if they are equal (defun dired-files-attributes (dir) "Return a list of all file names and attributes from DIR. -List has a form of (file-name full-file-name (attribute-list))" +List has a form of (file-name full-file-name (attribute-list))." (mapcar (lambda (file-name) (let ((full-file-name (expand-file-name file-name dir))) @@ -488,7 +488,7 @@ to the end of the list of defaults just after the default value." ;; This is an extra function so that you can redefine it, e.g., to use gmhist. (defun dired-read-shell-command (prompt arg files) - "Read a dired shell command prompting with PROMPT (using read-shell-command). + "Read a dired shell command prompting with PROMPT (using `read-shell-command'). ARG is the prefix arg and may be used to indicate in the prompt which FILES are affected." (minibuffer-with-setup-hook @@ -551,9 +551,9 @@ This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. Type \\[dired-do-redisplay] to redisplay the marked files. -When COMMAND runs, its working directory is the top-level directory of -the Dired buffer, so output files usually are created there instead of -in a subdir. +When COMMAND runs, its working directory is the top-level directory +of the Dired buffer, so output files usually are created there +instead of in a subdir. In a noninteractive call (from Lisp code), you must specify the list of file names explicitly with the FILE-LIST argument, which @@ -867,7 +867,7 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") failures))))) (defvar dired-query-alist - '((?\y . y) (?\040 . y) ; `y' or SPC means accept once + '((?y . y) (?\040 . y) ; `y' or SPC means accept once (?n . n) (?\177 . n) ; `n' or DEL skips once (?! . yes) ; `!' accepts rest (?q . no) (?\e . no) ; `q' or ESC skips rest @@ -876,10 +876,10 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ;;;###autoload (defun dired-query (qs-var qs-prompt &rest qs-args) - ;; Query user and return nil or t. - ;; Store answer in symbol VAR (which must initially be bound to nil). - ;; Format PROMPT with ARGS. - ;; Binding variable help-form will help the user who types the help key. + "Query user and return nil or t. +Store answer in symbol VAR (which must initially be bound to nil). +Format PROMPT with ARGS. +Binding variable `help-form' will help the user who types the help key." (let* ((char (symbol-value qs-var)) (action (cdr (assoc char dired-query-alist)))) (cond ((eq 'yes action) @@ -897,13 +897,12 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ;; Actually it looks nicer without cursor-in-echo-area - you can ;; look at the dired buffer instead of at the prompt to decide. (apply 'message qprompt qs-args) - (setq char (set qs-var (read-char))) - (while (not (setq elt (assoc char dired-query-alist))) - (message "Invalid char - type %c for help." help-char) + (while (progn (setq char (set qs-var (read-key))) + (not (setq elt (assoc char dired-query-alist)))) + (message "Invalid key - type %c for help." help-char) (ding) (sit-for 1) - (apply 'message qprompt qs-args) - (setq char (set qs-var (read-char)))) + (apply 'message qprompt qs-args)) ;; Display the question with the answer. (message "%s" (concat (apply 'format qprompt qs-args) (char-to-string char))) @@ -1607,7 +1606,7 @@ Optional arg HOW-TO determiness how to treat the target. ;; symlinks. (defvar dired-copy-how-to-fn nil - "nil or a function used by `dired-do-copy' to determine target. + "Either nil or a function used by `dired-do-copy' to determine target. See HOW-TO argument for `dired-do-create-files'.") ;;;###autoload @@ -2427,15 +2426,21 @@ with the command \\[tags-loop-continue]." If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is true then the type of the file linked to by FILE is printed instead." (interactive (list (dired-get-filename t) current-prefix-arg)) - (with-temp-buffer - (if deref-symlinks - (process-file "file" nil t t "-L" "--" file) - (process-file "file" nil t t "--" file)) - (when (bolp) - (backward-delete-char 1)) - (message "%s" (buffer-string)))) + (let (process-file-side-effects) + (with-temp-buffer + (if deref-symlinks + (process-file "file" nil t t "-L" "--" file) + (process-file "file" nil t t "--" file)) + (when (bolp) + (backward-delete-char 1)) + (message "%s" (buffer-string))))) (provide 'dired-aux) +;; Local Variables: +;; byte-compile-dynamic: t +;; generated-autoload-file: "dired.el" +;; End: + ;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60 ;;; dired-aux.el ends here diff --git a/lisp/dired-x.el b/lisp/dired-x.el index f5505a71e85..e00cae3a80c 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1,4 +1,4 @@ -;;; dired-x.el --- extra Dired functionality -*-byte-compile-dynamic: t;-*- +;;; dired-x.el --- extra Dired functionality ;; Copyright (C) 1993, 1994, 1997, 2001, 2002, 2003, 2004, 2005, 2006, ;; 2007, 2008, 2009 Free Software Foundation, Inc. @@ -208,8 +208,8 @@ The value can be t, nil or something else. A value of t means local-variables lists are obeyed; nil means they are ignored; anything else means query. -This temporarily overrides the value of `enable-local-variables' when listing -a directory. See also `dired-local-variables-file'." +This temporarily overrides the value of `enable-local-variables' when +listing a directory. See also `dired-local-variables-file'." :type 'boolean :group 'dired-x) @@ -553,7 +553,7 @@ need to match the entire file name.") ;; \017=^O for Omit - other packages can chose other control characters. (defvar dired-omit-marker-char ?\017 - "Temporary marker used by dired-omit. + "Temporary marker used by Dired-Omit. Should never be used as marker by the user or other packages.") (defun dired-omit-startup () @@ -1209,7 +1209,7 @@ See `dired-guess-shell-alist-user'." ;; REDEFINE. ;; Redefine dired-aux.el's version: (defun dired-read-shell-command (prompt arg files) - "Read a dired shell command prompting with PROMPT (using read-shell-command). + "Read a dired shell command prompting with PROMPT (using `read-shell-command'). ARG is the prefix arg and may be used to indicate in the prompt which FILES are affected. This is an extra function so that you can redefine it." @@ -1325,7 +1325,7 @@ for more info." ;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the ;;; list each time. ;;; -;; * If NOSELECT is non-nil then just run `find-file-noselect' on each +;; * If NOSELECT is non-nil then just run `find-file-noselect' on each ;;; element of FILE-LIST. ;;; ;; * If NOSELECT is nil then calculate the `size' of the window for each file @@ -1682,8 +1682,8 @@ or to test if that file exists. Use minibuffer after snatching filename." May create a new window, or reuse an existing one. See the function `display-buffer'. -Identical to `find-file-other-window' except when called interactively, with a -prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. +Identical to `find-file-other-window' except when called interactively, with +a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename." (interactive (list (read-filename-at-point "Find file: "))) @@ -1694,8 +1694,8 @@ or to test if that file exists. Use minibuffer after snatching filename." ;; Fixme: This should probably use `thing-at-point'. -- fx (defun dired-filename-at-point () "Get the filename closest to point, but do not change position. -Has a preference for looking backward when not directly on a symbol. Not -perfect - point must be in middle of or end of filename." +Has a preference for looking backward when not directly on a symbol. +Not perfect - point must be in middle of or end of filename." (let ((filename-chars "-.[:alnum:]_/:$+@") start end filename prefix) @@ -1775,7 +1775,7 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." (defun dired-x-submit-report () "Submit via `reporter.el' a bug report on program. -Send report on `dired-x-file' version `dired-x-version,' to +Send report on `dired-x-file' version `dired-x-version', to `dired-x-maintainer' at address `dired-x-help-address' listing variables `dired-x-variable-list' in the message." (interactive) @@ -1791,5 +1791,10 @@ variables `dired-x-variable-list' in the message." ;; As Barry Warsaw would say: "This might be useful..." (provide 'dired-x) +;; Local Variables: +;; byte-compile-dynamic: t +;; generated-autoload-file: "dired.el" +;; End: + ;; arch-tag: 71a43ba2-7a00-4793-a028-0613dd7765ae ;;; dired-x.el ends here diff --git a/lisp/dired.el b/lisp/dired.el index 55c1245b1fa..1785c787e7b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -765,23 +765,14 @@ for a remote directory. This feature is used by Auto Revert Mode." ;; like find-file does. ;; Optional argument MODE is passed to dired-find-buffer-nocreate, ;; see there. - (let* (dirname - buffer - ;; note that buffer already is in dired-mode, if found - new-buffer-p - (old-buf (current-buffer))) - (if (consp dir-or-list) - (setq dirname (car dir-or-list)) - (setq dirname dir-or-list)) - ;; Look for an existing buffer. - (setq buffer (dired-find-buffer-nocreate dirname mode) - new-buffer-p (null buffer)) + (let* ((old-buf (current-buffer)) + (dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list)) + ;; Look for an existing buffer. + (buffer (dired-find-buffer-nocreate dirname mode)) + ;; Note that buffer already is in dired-mode, if found. + (new-buffer-p (null buffer))) (or buffer - (let ((default-major-mode 'fundamental-mode)) - ;; We don't want default-major-mode to run hooks and set auto-fill - ;; or whatever, now that dired-mode does not - ;; kill-all-local-variables any longer. - (setq buffer (create-file-buffer (directory-file-name dirname))))) + (setq buffer (create-file-buffer (directory-file-name dirname)))) (set-buffer buffer) (if (not new-buffer-p) ; existing buffer ... (cond (switches ; ... but new switches @@ -1301,7 +1292,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "d" 'dired-flag-file-deletion) (define-key map "e" 'dired-find-file) (define-key map "f" 'dired-find-file) - (define-key map "\C-m" 'dired-advertised-find-file) + (define-key map "\C-m" 'dired-find-file) + (put 'dired-find-file :advertised-binding "\C-m") (define-key map "g" 'revert-buffer) (define-key map "h" 'describe-mode) (define-key map "i" 'dired-maybe-insert-subdir) @@ -1649,9 +1641,12 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." '(menu-item "Symlink to..." dired-do-symlink :visible (fboundp 'make-symbolic-link) :help "Make symbolic links for current or marked files")) + (define-key map [menu-bar operate async-command] + '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command + :help "Run a shell command asynchronously on current or marked files")) (define-key map [menu-bar operate command] '(menu-item "Shell Command..." dired-do-shell-command - :help "Run a shell command on each of marked files")) + :help "Run a shell command on current or marked files")) (define-key map [menu-bar operate delete] '(menu-item "Delete" dired-do-delete :help "Delete current file or all marked files")) @@ -1694,7 +1689,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. Type \\[dired-unmark] to Unmark a file or all files of a subdirectory. Type \\[dired-unmark-backward] to back up one line and unflag. Type \\[dired-do-flagged-delete] to eXecute the deletions requested. -Type \\[dired-advertised-find-file] to Find the current line's file +Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or dired directory in Other window. Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer. @@ -1755,10 +1750,10 @@ Keybindings: (set (make-local-variable 'dired-directory) (or dirname default-directory)) ;; list-buffers uses this to display the dir being edited in this buffer. - (set (make-local-variable 'list-buffers-directory) - (expand-file-name (if (listp dired-directory) - (car dired-directory) - dired-directory))) + (setq list-buffers-directory + (expand-file-name (if (listp dired-directory) + (car dired-directory) + dired-directory))) (set (make-local-variable 'dired-actual-switches) (or switches dired-listing-switches)) (set (make-local-variable 'font-lock-defaults) @@ -1868,7 +1863,7 @@ Creates a buffer if necessary." (error "File no longer exists; type `g' to update dired buffer"))))) ;; Force C-m keybinding rather than `f' or `e' in the mode doc: -(defalias 'dired-advertised-find-file 'dired-find-file) +(define-obsolete-function-alias 'dired-advertised-find-file 'dired-find-file "23.2") (defun dired-find-file () "In Dired, visit the file or directory named on this line." (interactive) @@ -3453,6 +3448,507 @@ Ask means pop up a menu for the user to select one of copy, move or link." '(dired-mode . dired-restore-desktop-buffer)) +;;; Start of automatically extracted autoloads. + +;;;### (autoloads (dired-show-file-type dired-do-query-replace-regexp +;;;;;; dired-do-search dired-do-isearch-regexp dired-do-isearch +;;;;;; dired-isearch-filenames-regexp dired-isearch-filenames dired-isearch-filenames-setup +;;;;;; dired-hide-all dired-hide-subdir dired-tree-down dired-tree-up +;;;;;; dired-kill-subdir dired-mark-subdir-files dired-goto-subdir +;;;;;; dired-prev-subdir dired-insert-subdir dired-maybe-insert-subdir +;;;;;; dired-downcase dired-upcase dired-do-symlink-regexp dired-do-hardlink-regexp +;;;;;; dired-do-copy-regexp dired-do-rename-regexp dired-do-rename +;;;;;; dired-do-hardlink dired-do-symlink dired-do-copy dired-create-directory +;;;;;; dired-rename-file dired-copy-file dired-relist-file dired-remove-file +;;;;;; dired-add-file dired-do-redisplay dired-do-load dired-do-byte-compile +;;;;;; dired-do-compress dired-query dired-compress-file dired-do-kill-lines +;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command +;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown +;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "19cd0d559197e5587fe27e1a81fb2644") +;;; Generated autoloads from dired-aux.el + +(autoload 'dired-diff "dired-aux" "\ +Compare file at point with file FILE using `diff'. +FILE defaults to the file at the mark. (That's the mark set by +\\[set-mark-command], not by Dired's \\[dired-mark] command.) +The prompted-for file is the first file given to `diff'. +With prefix arg, prompt for second argument SWITCHES, +which is options for `diff'. + +\(fn FILE &optional SWITCHES)" t nil) + +(autoload 'dired-backup-diff "dired-aux" "\ +Diff this file with its backup file or vice versa. +Uses the latest backup, if there are several numerical backups. +If this file is a backup, diff it with its original. +The backup file is the first file given to `diff'. +With prefix arg, prompt for argument SWITCHES which is options for `diff'. + +\(fn &optional SWITCHES)" t nil) + +(autoload 'dired-compare-directories "dired-aux" "\ +Mark files with different file attributes in two dired buffers. +Compare file attributes of files in the current directory +with file attributes in directory DIR2 using PREDICATE on pairs of files +with the same name. Mark files for which PREDICATE returns non-nil. +Mark files with different names if PREDICATE is nil (or interactively +with empty input at the predicate prompt). + +PREDICATE is a Lisp expression that can refer to the following variables: + + size1, size2 - file size in bytes + mtime1, mtime2 - last modification time in seconds, as a float + fa1, fa2 - list of file attributes + returned by function `file-attributes' + + where 1 refers to attribute of file in the current dired buffer + and 2 to attribute of file in second dired buffer. + +Examples of PREDICATE: + + (> mtime1 mtime2) - mark newer files + (not (= size1 size2)) - mark files with different sizes + (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes + (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID + (= (nth 3 fa1) (nth 3 fa2)))) and GID. + +\(fn DIR2 PREDICATE)" t nil) + +(autoload 'dired-do-chmod "dired-aux" "\ +Change the mode of the marked (or next ARG) files. +Symbolic modes like `g+w' are allowed. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-chgrp "dired-aux" "\ +Change the group of the marked (or next ARG) files. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-chown "dired-aux" "\ +Change the owner of the marked (or next ARG) files. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-touch "dired-aux" "\ +Change the timestamp of the marked (or next ARG) files. +This calls touch. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-print "dired-aux" "\ +Print the marked (or next ARG) files. +Uses the shell command coming from variables `lpr-command' and +`lpr-switches' as default. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-clean-directory "dired-aux" "\ +Flag numerical backups for deletion. +Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. +Positive prefix arg KEEP overrides `dired-kept-versions'; +Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. + +To clear the flags on these files, you can use \\[dired-flag-backup-files] +with a prefix argument. + +\(fn KEEP)" t nil) + +(autoload 'dired-do-async-shell-command "dired-aux" "\ +Run a shell command COMMAND on the marked files asynchronously. + +Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand, +adds `* &' surrounded by whitespace and executes the command asynchronously. +The output appears in the buffer `*Async Shell Command*'. + +\(fn COMMAND &optional ARG FILE-LIST)" t nil) + +(autoload 'dired-do-shell-command "dired-aux" "\ +Run a shell command COMMAND on the marked files. +If no files are marked or a specific numeric prefix arg is given, +the next ARG files are used. Just \\[universal-argument] means the current file. +The prompt mentions the file(s) or the marker, as appropriate. + +If there is a `*' in COMMAND, surrounded by whitespace, this runs +COMMAND just once with the entire file list substituted there. + +If there is no `*', but there is a `?' in COMMAND, surrounded by +whitespace, this runs COMMAND on each file individually with the +file name substituted for `?'. + +Otherwise, this runs COMMAND on each file individually with the +file name added at the end of COMMAND (separated by a space). + +`*' and `?' when not surrounded by whitespace have no special +significance for `dired-do-shell-command', and are passed through +normally to the shell, but you must confirm first. To pass `*' by +itself to the shell as a wildcard, type `*\"\"'. + +If COMMAND produces output, it goes to a separate buffer. + +This feature does not try to redisplay Dired buffers afterward, as +there's no telling what files COMMAND may have changed. +Type \\[dired-do-redisplay] to redisplay the marked files. + +When COMMAND runs, its working directory is the top-level directory +of the Dired buffer, so output files usually are created there +instead of in a subdir. + +In a noninteractive call (from Lisp code), you must specify +the list of file names explicitly with the FILE-LIST argument, which +can be produced by `dired-get-marked-files', for example. + +\(fn COMMAND &optional ARG FILE-LIST)" t nil) + +(autoload 'dired-run-shell-command "dired-aux" "\ +Not documented + +\(fn COMMAND)" nil nil) + +(autoload 'dired-do-kill-lines "dired-aux" "\ +Kill all marked lines (not the files). +With a prefix argument, kill that many lines starting with the current line. +\(A negative argument kills backward.) +If you use this command with a prefix argument to kill the line +for a file that is a directory, which you have inserted in the +Dired buffer as a subdirectory, then it deletes that subdirectory +from the buffer as well. +To kill an entire subdirectory (without killing its line in the +parent directory), go to its directory header line and use this +command with a prefix argument (the value does not matter). + +\(fn &optional ARG FMT)" t nil) + +(autoload 'dired-compress-file "dired-aux" "\ +Not documented + +\(fn FILE)" nil nil) + +(autoload 'dired-query "dired-aux" "\ +Query user and return nil or t. +Store answer in symbol VAR (which must initially be bound to nil). +Format PROMPT with ARGS. +Binding variable `help-form' will help the user who types the help key. + +\(fn QS-VAR QS-PROMPT &rest QS-ARGS)" nil nil) + +(autoload 'dired-do-compress "dired-aux" "\ +Compress or uncompress marked (or next ARG) files. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-byte-compile "dired-aux" "\ +Byte compile marked (or next ARG) Emacs Lisp files. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-load "dired-aux" "\ +Load the marked (or next ARG) Emacs Lisp files. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-redisplay "dired-aux" "\ +Redisplay all marked (or next ARG) files. +If on a subdir line, redisplay that subdirectory. In that case, +a prefix arg lets you edit the `ls' switches used for the new listing. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\<dired-mode-map>\\[dired-reset-subdir-switches]. +See Info node `(emacs)Subdir switches' for more details. + +\(fn &optional ARG TEST-FOR-SUBDIR)" t nil) + +(autoload 'dired-add-file "dired-aux" "\ +Not documented + +\(fn FILENAME &optional MARKER-CHAR)" nil nil) + +(autoload 'dired-remove-file "dired-aux" "\ +Not documented + +\(fn FILE)" nil nil) + +(autoload 'dired-relist-file "dired-aux" "\ +Create or update the line for FILE in all Dired buffers it would belong in. + +\(fn FILE)" nil nil) + +(autoload 'dired-copy-file "dired-aux" "\ +Not documented + +\(fn FROM TO OK-FLAG)" nil nil) + +(autoload 'dired-rename-file "dired-aux" "\ +Not documented + +\(fn FILE NEWNAME OK-IF-ALREADY-EXISTS)" nil nil) + +(autoload 'dired-create-directory "dired-aux" "\ +Create a directory called DIRECTORY. + +\(fn DIRECTORY)" t nil) + +(autoload 'dired-do-copy "dired-aux" "\ +Copy all marked (or next ARG) files, or copy the current file. +This normally preserves the last-modified date when copying. +When operating on just the current file, you specify the new name. +When operating on multiple or marked files, you specify a directory, +and new copies of these files are made in that directory +with the same names that the files currently have. The default +suggested for the target directory depends on the value of +`dired-dwim-target', which see. + +This command copies symbolic links by creating new ones, +like `cp -d'. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-symlink "dired-aux" "\ +Make symbolic links to current file or all marked (or next ARG) files. +When operating on just the current file, you specify the new name. +When operating on multiple or marked files, you specify a directory +and new symbolic links are made in that directory +with the same names that the files currently have. The default +suggested for the target directory depends on the value of +`dired-dwim-target', which see. + +For relative symlinks, use \\[dired-do-relsymlink]. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-hardlink "dired-aux" "\ +Add names (hard links) current file or all marked (or next ARG) files. +When operating on just the current file, you specify the new name. +When operating on multiple or marked files, you specify a directory +and new hard links are made in that directory +with the same names that the files currently have. The default +suggested for the target directory depends on the value of +`dired-dwim-target', which see. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-rename "dired-aux" "\ +Rename current file or all marked (or next ARG) files. +When renaming just the current file, you specify the new name. +When renaming multiple or marked files, you specify a directory. +This command also renames any buffers that are visiting the files. +The default suggested for the target directory depends on the value +of `dired-dwim-target', which see. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-do-rename-regexp "dired-aux" "\ +Rename selected files whose names match REGEXP to NEWNAME. + +With non-zero prefix argument ARG, the command operates on the next ARG +files. Otherwise, it operates on all the marked files, or the current +file if none are marked. + +As each match is found, the user must type a character saying + what to do with it. For directions, type \\[help-command] at that time. +NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'. +REGEXP defaults to the last regexp used. + +With a zero prefix arg, renaming by regexp affects the absolute file name. +Normally, only the non-directory part of the file name is used and changed. + +\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) + +(autoload 'dired-do-copy-regexp "dired-aux" "\ +Copy selected files whose names match REGEXP to NEWNAME. +See function `dired-do-rename-regexp' for more info. + +\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) + +(autoload 'dired-do-hardlink-regexp "dired-aux" "\ +Hardlink selected files whose names match REGEXP to NEWNAME. +See function `dired-do-rename-regexp' for more info. + +\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) + +(autoload 'dired-do-symlink-regexp "dired-aux" "\ +Symlink selected files whose names match REGEXP to NEWNAME. +See function `dired-do-rename-regexp' for more info. + +\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) + +(autoload 'dired-upcase "dired-aux" "\ +Rename all marked (or next ARG) files to upper case. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-downcase "dired-aux" "\ +Rename all marked (or next ARG) files to lower case. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-maybe-insert-subdir "dired-aux" "\ +Insert this subdirectory into the same dired buffer. +If it is already present, just move to it (type \\[dired-do-redisplay] to refresh), + else inserts it at its natural place (as `ls -lR' would have done). +With a prefix arg, you may edit the ls switches used for this listing. + You can add `R' to the switches to expand the whole tree starting at + this subdirectory. +This function takes some pains to conform to `ls -lR' output. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\<dired-mode-map>\\[dired-reset-subdir-switches]. +See Info node `(emacs)Subdir switches' for more details. + +\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil) + +(autoload 'dired-insert-subdir "dired-aux" "\ +Insert this subdirectory into the same dired buffer. +If it is already present, overwrites previous entry, + else inserts it at its natural place (as `ls -lR' would have done). +With a prefix arg, you may edit the `ls' switches used for this listing. + You can add `R' to the switches to expand the whole tree starting at + this subdirectory. +This function takes some pains to conform to `ls -lR' output. + +\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil) + +(autoload 'dired-prev-subdir "dired-aux" "\ +Go to previous subdirectory, regardless of level. +When called interactively and not on a subdir line, go to this subdir's line. + +\(fn ARG &optional NO-ERROR-IF-NOT-FOUND NO-SKIP)" t nil) + +(autoload 'dired-goto-subdir "dired-aux" "\ +Go to end of header line of DIR in this dired buffer. +Return value of point on success, otherwise return nil. +The next char is either \\n, or \\r if DIR is hidden. + +\(fn DIR)" t nil) + +(autoload 'dired-mark-subdir-files "dired-aux" "\ +Mark all files except `.' and `..' in current subdirectory. +If the Dired buffer shows multiple directories, this command +marks the files listed in the subdirectory that point is in. + +\(fn)" t nil) + +(autoload 'dired-kill-subdir "dired-aux" "\ +Remove all lines of current subdirectory. +Lower levels are unaffected. + +\(fn &optional REMEMBER-MARKS)" t nil) + +(autoload 'dired-tree-up "dired-aux" "\ +Go up ARG levels in the dired tree. + +\(fn ARG)" t nil) + +(autoload 'dired-tree-down "dired-aux" "\ +Go down in the dired tree. + +\(fn)" t nil) + +(autoload 'dired-hide-subdir "dired-aux" "\ +Hide or unhide the current subdirectory and move to next directory. +Optional prefix arg is a repeat factor. +Use \\[dired-hide-all] to (un)hide all directories. + +\(fn ARG)" t nil) + +(autoload 'dired-hide-all "dired-aux" "\ +Hide all subdirectories, leaving only their header lines. +If there is already something hidden, make everything visible again. +Use \\[dired-hide-subdir] to (un)hide a particular subdirectory. + +\(fn ARG)" t nil) + +(autoload 'dired-isearch-filenames-setup "dired-aux" "\ +Set up isearch to search in Dired file names. +Intended to be added to `isearch-mode-hook'. + +\(fn)" nil nil) + +(autoload 'dired-isearch-filenames "dired-aux" "\ +Search for a string using Isearch only in file names in the Dired buffer. + +\(fn)" t nil) + +(autoload 'dired-isearch-filenames-regexp "dired-aux" "\ +Search for a regexp using Isearch only in file names in the Dired buffer. + +\(fn)" t nil) + +(autoload 'dired-do-isearch "dired-aux" "\ +Search for a string through all marked files using Isearch. + +\(fn)" t nil) + +(autoload 'dired-do-isearch-regexp "dired-aux" "\ +Search for a regexp through all marked files using Isearch. + +\(fn)" t nil) + +(autoload 'dired-do-search "dired-aux" "\ +Search through all marked files for a match for REGEXP. +Stops when a match is found. +To continue searching for next match, use command \\[tags-loop-continue]. + +\(fn REGEXP)" t nil) + +(autoload 'dired-do-query-replace-regexp "dired-aux" "\ +Do `query-replace-regexp' of FROM with TO, on all marked files. +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]. + +\(fn FROM TO &optional DELIMITED)" t nil) + +(autoload 'dired-show-file-type "dired-aux" "\ +Print the type of FILE, according to the `file' command. +If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is +true then the type of the file linked to by FILE is printed instead. + +\(fn FILE &optional DEREF-SYMLINKS)" t nil) + +;;;*** + +;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" +;;;;;; "1a0298749959c80c24c73b8bec5f1f74") +;;; Generated autoloads from dired-x.el + +(autoload 'dired-jump "dired-x" "\ +Jump to dired buffer corresponding to current buffer. +If in a file, dired the current directory and move to file's line. +If in Dired already, pop up a level and goto old directory's line. +In case the proper dired file line cannot be found, refresh the dired +buffer and try again. + +\(fn &optional OTHER-WINDOW)" t nil) + +(autoload 'dired-do-relsymlink "dired-x" "\ +Relative symlink all marked (or next ARG) files into a directory. +Otherwise make a relative symbolic link to the current file. +This creates relative symbolic links like + + foo -> ../bar/foo + +not absolute ones like + + foo -> /ugly/file/name/that/may/change/any/day/bar/foo + +For absolute symlinks, use \\[dired-do-symlink]. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;; End of automatically extracted autoloads. + (provide 'dired) (run-hooks 'dired-load-hook) ; for your customizations diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 78a2e6b7755..91dc4a7fd34 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -216,14 +216,11 @@ X frame." (defun standard-display-european (arg) "Semi-obsolete way to toggle display of ISO 8859 European characters. -This function is semi-obsolete; if you want to do your editing with -unibyte characters, it is better to `set-language-environment' coupled -with either the `--unibyte' option or the EMACS_UNIBYTE environment -variable, or else customize `enable-multibyte-characters'. +This function is semi-obsolete; you probably don't need it, or else you +probably should use `set-language-environment' or `set-locale-environment'. -With prefix argument, this command enables European character display -if ARG is positive, disables it otherwise. Otherwise, it toggles -European character display. +This function enables European character display if ARG is positive, +disables it if negative. Otherwise, it toggles European character display. When this mode is enabled, characters in the range of 160 to 255 display not as octal escapes, but as accented characters. Codes 146 @@ -231,10 +228,9 @@ and 160 display as apostrophe and space, even though they are not the ASCII codes for apostrophe and space. Enabling European character display with this command noninteractively -from Lisp code also selects Latin-1 as the language environment, and -selects unibyte mode for all Emacs buffers \(both existing buffers and -those created subsequently). This provides increased compatibility -for users who call this function in `.emacs'." +from Lisp code also selects Latin-1 as the language environment. +This provides increased compatibility for users who call this function +in `.emacs'." (if (or (<= (prefix-numeric-value arg) 0) (and (null arg) diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index 37a1a9c1d16..fadf09c70c2 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -1,7 +1,7 @@ ;;; dos-fns.el --- MS-Dos specific functions -;; Copyright (C) 1991, 1993, 1995, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1993, 1995, 1996, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Maintainer: Morten Welinder <terra@diku.dk> ;; Keywords: internal @@ -211,7 +211,7 @@ returned unaltered." ;; Override settings chosen at startup. (defun set-default-process-coding-system () (setq default-process-coding-system - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-dos) '(raw-text-dos . raw-text-dos)))) @@ -224,17 +224,11 @@ returned unaltered." ;; see if the list of defcustom's below is up to date, run the command ;; "M-x apropos-value RET ~/\. RET". (defun dos-reevaluate-defcustoms () - ;; This was computed in paths.el, but that was at dump time. - (setq abbrev-file-name - (if (msdos-long-file-names) - "~/.abbrev_defs" - "~/_abbrev.defs")) - ;; This was computed in loaddefs.el, but that was at dump time. - (setq calc-settings-file - (if (msdos-long-file-names) - "~/.calc.el" - "~/_calc.el")) - (custom-reevaluate-setting 'trash-directory)) + ;; This is not needed in Emacs 23.2 and later, as trash-directory is + ;; initialized as nil. But something like this might become + ;; necessary in the future, so I'm keeping it here as a reminder. + ;(custom-reevaluate-setting 'trash-directory) + ) (add-hook 'before-init-hook 'dos-reevaluate-defcustoms) diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index ae6ed5dc366..9bec5b7a1db 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -72,15 +72,12 @@ against the file name, and TYPE is nil for text, t for binary.") (setq alist (cdr alist))) found))) -;; Silence compiler. Defined in src/buffer.c on DOS_NT. -(defvar default-buffer-file-type) - ;; Don't check for untranslated file systems here. (defun find-buffer-file-type (filename) (let ((match (find-buffer-file-type-match filename)) (code)) (if (not match) - default-buffer-file-type + (default-value 'buffer-file-type) (setq code (cdr match)) (cond ((memq code '(nil t)) code) ((and (symbolp code) (fboundp code)) @@ -105,7 +102,7 @@ and whether the file exists: If the match is nil (for dos-text): `undecided-dos' Otherwise: If the file exists: `undecided' - If the file does not exist: default-buffer-file-coding-system + If the file does not exist default value of `buffer-file-coding-system' Note that the CAR of arguments to `insert-file-contents' operation could be a cons cell of the form \(FILENAME . BUFFER\), where BUFFER is a buffer @@ -172,8 +169,8 @@ set to the appropriate coding system, and the value of (text '(undecided-dos . undecided-dos)) (undecided-unix '(undecided-unix . undecided-unix)) (undecided '(undecided . undecided)) - (t (cons default-buffer-file-coding-system - default-buffer-file-coding-system)))) + (t (cons (default-value 'buffer-file-coding-system) + (default-value 'buffer-file-coding-system))))) ((eq op 'write-region) (if buffer-file-coding-system (cons buffer-file-coding-system diff --git a/lisp/ediff-hook.el b/lisp/ediff-hook.el index f2b3e0d437f..92afb838b85 100644 --- a/lisp/ediff-hook.el +++ b/lisp/ediff-hook.el @@ -147,114 +147,114 @@ (list 'menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu)) (define-key menu-bar-ediff-menu [separator-ediff-misc] '("--")) (define-key menu-bar-ediff-menu [window] - '(menu-item "This Window and Next Window" compare-windows - :help "Compare the current window and the next window")) + `(menu-item ,(purecopy "This Window and Next Window") compare-windows + :help ,(purecopy "Compare the current window and the next window"))) (define-key menu-bar-ediff-menu [ediff-windows-linewise] - '(menu-item "Windows Line-by-line..." ediff-windows-linewise - :help "Compare windows line-wise")) + `(menu-item ,(purecopy "Windows Line-by-line...") ediff-windows-linewise + :help ,(purecopy "Compare windows line-wise"))) (define-key menu-bar-ediff-menu [ediff-windows-wordwise] - '(menu-item "Windows Word-by-word..." ediff-windows-wordwise - :help "Compare windows word-wise")) + `(menu-item ,(purecopy "Windows Word-by-word...") ediff-windows-wordwise + :help ,(purecopy "Compare windows word-wise"))) (define-key menu-bar-ediff-menu [separator-ediff-windows] '("--")) (define-key menu-bar-ediff-menu [ediff-regions-linewise] - '(menu-item "Regions Line-by-line..." ediff-regions-linewise - :help "Compare regions line-wise")) + `(menu-item ,(purecopy "Regions Line-by-line...") ediff-regions-linewise + :help ,(purecopy "Compare regions line-wise"))) (define-key menu-bar-ediff-menu [ediff-regions-wordwise] - '(menu-item "Regions Word-by-word..." ediff-regions-wordwise - :help "Compare regions word-wise")) + `(menu-item ,(purecopy "Regions Word-by-word...") ediff-regions-wordwise + :help ,(purecopy "Compare regions word-wise"))) (define-key menu-bar-ediff-menu [separator-ediff-regions] '("--")) (define-key menu-bar-ediff-menu [ediff-dir-revision] - '(menu-item "Directory Revisions..." ediff-directory-revisions - :help "Compare directory files with their older versions")) + `(menu-item ,(purecopy "Directory Revisions...") ediff-directory-revisions + :help ,(purecopy "Compare directory files with their older versions"))) (define-key menu-bar-ediff-menu [ediff-revision] - '(menu-item "File with Revision..." ediff-revision - :help "Compare file with its older versions")) + `(menu-item ,(purecopy "File with Revision...") ediff-revision + :help ,(purecopy "Compare file with its older versions"))) (define-key menu-bar-ediff-menu [separator-ediff-directories] '("--")) (define-key menu-bar-ediff-menu [ediff-directories3] - '(menu-item "Three Directories..." ediff-directories3 - :help "Compare files common to three directories simultaneously")) + `(menu-item ,(purecopy "Three Directories...") ediff-directories3 + :help ,(purecopy "Compare files common to three directories simultaneously"))) (define-key menu-bar-ediff-menu [ediff-directories] - '(menu-item "Two Directories..." ediff-directories - :help "Compare files common to two directories simultaneously")) + `(menu-item ,(purecopy "Two Directories...") ediff-directories + :help ,(purecopy "Compare files common to two directories simultaneously"))) (define-key menu-bar-ediff-menu [separator-ediff-files] '("--")) (define-key menu-bar-ediff-menu [ediff-buffers3] - '(menu-item "Three Buffers..." ediff-buffers3 - :help "Compare three buffers simultaneously")) + `(menu-item ,(purecopy "Three Buffers...") ediff-buffers3 + :help ,(purecopy "Compare three buffers simultaneously"))) (define-key menu-bar-ediff-menu [ediff-files3] - '(menu-item "Three Files..." ediff-files3 - :help "Compare three files simultaneously")) + `(menu-item ,(purecopy "Three Files...") ediff-files3 + :help ,(purecopy "Compare three files simultaneously"))) (define-key menu-bar-ediff-menu [ediff-buffers] - '(menu-item "Two Buffers..." ediff-buffers - :help "Compare two buffers simultaneously")) + `(menu-item ,(purecopy "Two Buffers...") ediff-buffers + :help ,(purecopy "Compare two buffers simultaneously"))) (define-key menu-bar-ediff-menu [ediff-files] - '(menu-item "Two Files..." ediff-files - :help "Compare two files simultaneously")) + `(menu-item ,(purecopy "Two Files...") ediff-files + :help ,(purecopy "Compare two files simultaneously"))) ;; define ediff merge menu (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] - '(menu-item "Directory Revisions with Ancestor..." + `(menu-item ,(purecopy "Directory Revisions with Ancestor...") ediff-merge-directory-revisions-with-ancestor - :help "Merge versions of the files in the same directory by comparing the files with common ancestors")) + :help ,(purecopy "Merge versions of the files in the same directory by comparing the files with common ancestors"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] - '(menu-item "Directory Revisions..." ediff-merge-directory-revisions - :help "Merge versions of the files in the same directory (without using ancestor information)")) + `(menu-item ,(purecopy "Directory Revisions...") ediff-merge-directory-revisions + :help ,(purecopy "Merge versions of the files in the same directory (without using ancestor information)"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] - '(menu-item "Revisions with Ancestor..." + `(menu-item ,(purecopy "Revisions with Ancestor...") ediff-merge-revisions-with-ancestor - :help "Merge versions of the same file by comparing them with a common ancestor")) + :help ,(purecopy "Merge versions of the same file by comparing them with a common ancestor"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] - '(menu-item "Revisions..." ediff-merge-revisions - :help "Merge versions of the same file (without using ancestor information)")) + `(menu-item ,(purecopy "Revisions...") ediff-merge-revisions + :help ,(purecopy "Merge versions of the same file (without using ancestor information)"))) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] - '(menu-item "Directories with Ancestor..." + `(menu-item ,(purecopy "Directories with Ancestor...") ediff-merge-directories-with-ancestor - :help "Merge files common to a pair of directories by comparing the files with common ancestors")) + :help ,(purecopy "Merge files common to a pair of directories by comparing the files with common ancestors"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] - '(menu-item "Directories..." ediff-merge-directories - :help "Merge files common to a pair of directories")) + `(menu-item ,(purecopy "Directories...") ediff-merge-directories + :help ,(purecopy "Merge files common to a pair of directories"))) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] - '(menu-item "Buffers with Ancestor..." ediff-merge-buffers-with-ancestor - :help "Merge buffers by comparing their contents with a common ancestor")) + `(menu-item ,(purecopy "Buffers with Ancestor...") ediff-merge-buffers-with-ancestor + :help ,(purecopy "Merge buffers by comparing their contents with a common ancestor"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] - '(menu-item "Buffers..." ediff-merge-buffers - :help "Merge buffers (without using ancestor information)")) + `(menu-item ,(purecopy "Buffers...") ediff-merge-buffers + :help ,(purecopy "Merge buffers (without using ancestor information)"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] - '(menu-item "Files with Ancestor..." ediff-merge-files-with-ancestor - :help "Merge files by comparing them with a common ancestor")) + `(menu-item ,(purecopy "Files with Ancestor...") ediff-merge-files-with-ancestor + :help ,(purecopy "Merge files by comparing them with a common ancestor"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-files] - '(menu-item "Files..." ediff-merge-files - :help "Merge files (without using ancestor information)")) + `(menu-item ,(purecopy "Files...") ediff-merge-files + :help ,(purecopy "Merge files (without using ancestor information)"))) ;; define epatch menu (define-key menu-bar-epatch-menu [ediff-patch-buffer] - '(menu-item "To a Buffer..." ediff-patch-buffer - :help "Apply a patch to the contents of a buffer")) + `(menu-item ,(purecopy "To a Buffer...") ediff-patch-buffer + :help ,(purecopy "Apply a patch to the contents of a buffer"))) (define-key menu-bar-epatch-menu [ediff-patch-file] - '(menu-item "To a File..." ediff-patch-file - :help "Apply a patch to a file")) + `(menu-item ,(purecopy "To a File...") ediff-patch-file + :help ,(purecopy "Apply a patch to a file"))) ;; define ediff miscellanea (define-key menu-bar-ediff-misc-menu [emultiframe] - '(menu-item "Toggle use of separate control buffer frame" + `(menu-item ,(purecopy "Use separate control buffer frame") ediff-toggle-multiframe - :help "Switch between the single-frame presentation mode and the multi-frame mode")) + :help ,(purecopy "Switch between the single-frame presentation mode and the multi-frame mode"))) (define-key menu-bar-ediff-misc-menu [eregistry] - '(menu-item "List Ediff Sessions" ediff-show-registry - :help "List all active Ediff sessions; it is a convenient way to find and resume such a session")) + `(menu-item ,(purecopy "List Ediff Sessions") ediff-show-registry + :help ,(purecopy "List all active Ediff sessions; it is a convenient way to find and resume such a session"))) (define-key menu-bar-ediff-misc-menu [ediff-cust] - '(menu-item "Customize Ediff" ediff-customize - :help "Change some of the parameters that govern the behavior of Ediff")) + `(menu-item ,(purecopy "Customize Ediff") ediff-customize + :help ,(purecopy "Change some of the parameters that govern the behavior of Ediff"))) (define-key menu-bar-ediff-misc-menu [ediff-doc] - '(menu-item "Ediff Manual" ediff-documentation - :help "Bring up the Ediff manual"))) + `(menu-item ,(purecopy "Ediff Manual") ediff-documentation + :help ,(purecopy "Bring up the Ediff manual")))) (provide 'ediff-hook) diff --git a/lisp/ediff-merg.el b/lisp/ediff-merg.el index ca90e0923f0..971c7636932 100644 --- a/lisp/ediff-merg.el +++ b/lisp/ediff-merg.el @@ -226,7 +226,7 @@ Buffer B." ;;(let ((reg-A (ediff-get-region-contents n 'A ediff-control-buffer)) ;; (reg-B (ediff-get-region-contents n 'B ediff-control-buffer)) ;; (reg-C (ediff-get-region-contents n 'C ediff-control-buffer))) - (let () + (progn ;; if region was edited since it was first set by default (if (or (ediff-merge-changed-from-default-p n) diff --git a/lisp/ediff-vers.el b/lisp/ediff-vers.el index 71f4465eb7b..f634890451d 100644 --- a/lisp/ediff-vers.el +++ b/lisp/ediff-vers.el @@ -137,10 +137,8 @@ comparison or merge operations are being performed." ;; Optional NAME is name to use instead of `*RCS-output*'. ;; This is a modified version from rcs.el v1.1. I use it here to make ;; Ediff immune to changes in rcs.el - (let* ((default-major-mode 'fundamental-mode) ; no frills! - (buf (get-buffer-create name))) - (save-excursion - (set-buffer buf) + (let ((buf (get-buffer-create name))) + (with-current-buffer buf (setq buffer-read-only nil default-directory (file-name-directory (expand-file-name file))) (erase-buffer)) diff --git a/lisp/ehelp.el b/lisp/ehelp.el index d8e7ea57deb..8f1eeefa95a 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -96,7 +96,7 @@ (defun electric-help-mode () "`with-electric-help' temporarily places its buffer in this mode. -\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)" +\(On exit from `with-electric-help', the buffer is put in default `major-mode'.)" (setq buffer-read-only t) (setq mode-name "Help") (setq major-mode 'help) @@ -131,7 +131,7 @@ If THUNK returns non-nil, we don't do those things. When the user exits (with `electric-help-exit', or otherwise), the help buffer's window disappears (i.e., we use `save-window-excursion'), and -BUFFER is put into `default-major-mode' (or `fundamental-mode')." +BUFFER is put into default `major-mode' (or `fundamental-mode')." (setq buffer (get-buffer-create (or buffer "*Help*"))) (let ((one (one-window-p t)) (config (current-window-configuration)) @@ -143,8 +143,7 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode')." (goto-char (window-start (selected-window)))) (let ((pop-up-windows t)) (pop-to-buffer buffer)) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (when (and minheight (< (window-height) minheight)) (enlarge-window (- minheight (window-height)))) (electric-help-mode) @@ -177,7 +176,7 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode')." ;; afterwards. It's also not clear that `help-mode' is always ;; the right thing, maybe we should add an optional parameter. (condition-case () - (funcall (or default-major-mode 'fundamental-mode)) + (funcall (or (default-value 'major-mode) 'fundamental-mode)) (error nil)) (set-window-configuration config) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index f9f80cdcbb6..8342f14ec5b 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2781,7 +2781,8 @@ to be accessed, it returns a list with the index and name." (list (- index (length reqopt-args)) rest-arg))))) (defun ad-get-argument (arglist index) - "Return form to access ARGLIST's actual argument at position INDEX." + "Return form to access ARGLIST's actual argument at position INDEX. +INDEX counts from zero." (let ((argument-access (ad-access-argument arglist index))) (cond ((consp argument-access) (ad-element-access @@ -2789,7 +2790,8 @@ to be accessed, it returns a list with the index and name." (argument-access)))) (defun ad-set-argument (arglist index value-form) - "Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM." + "Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM. +INDEX counts from zero." (let ((argument-access (ad-access-argument arglist index))) (cond ((consp argument-access) ;; should this check whether there actually is something to set? diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 3578f2cfe91..cd3c2d465d5 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -866,7 +866,7 @@ buffer *Authors Errors* containing references to unknown files." (unless (file-exists-p (expand-file-name "src/emacs.c" root)) (unless (y-or-n-p (format "Not the root directory of Emacs: %s, continue? " root)) - (error "Not the root directory."))) + (error "Not the root directory"))) (dolist (log logs) (when (string-match "ChangeLog\\(.[0-9]+\\)?$" log) (message "Scanning %s..." log) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 9dad31af0e3..bf00bbb4420 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -43,7 +43,7 @@ trailer starting with a FormFeed character.") (put 'generated-autoload-file 'safe-local-variable 'stringp) (defvar generated-autoload-feature nil - "*Feature that `generated-autoload-file' should provide. + "Feature for `generated-autoload-file' to provide. If nil, this defaults to `generated-autoload-file', sans extension.") ;;;###autoload (put 'generated-autoload-feature 'safe-local-variable 'symbolp) @@ -267,8 +267,8 @@ information contained in FILE." ";;; Code:\n\n" " \n" "(provide '" - (if (and (symbolp generated-autoload-feature) - generated-autoload-feature) + (if (and generated-autoload-feature + (symbolp generated-autoload-feature)) (format "%s" generated-autoload-feature) (file-name-sans-extension basename)) ")\n" diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 779505e2191..ab464a86d37 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1,7 +1,7 @@ ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -1221,6 +1221,7 @@ next-window nth nthcdr number-to-string parse-colon-path plist-get plist-member prefix-numeric-value previous-window prin1-to-string propertize + degrees-to-radians radians-to-degrees rassq rassoc read-from-string regexp-quote region-beginning region-end reverse round sin sqrt string string< string= string-equal string-lessp string-to-char diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index c03ccee2481..b6408f2c14c 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -1,7 +1,7 @@ ;;; byte-run.el --- byte-compiler support for inlining -;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -180,6 +180,21 @@ Info node `(elisp)Variable Aliases' for more details." (defvaralias ,obsolete-name ,current-name ,docstring) (make-obsolete-variable ,obsolete-name ,current-name ,when))) +;; FIXME This is only defined in this file because the variable- and +;; function- versions are too. Unlike those two, this one is not used +;; by the byte-compiler (would be nice if it could warn about obsolete +;; faces, but it doesn't really do anything special with faces). +;; It only really affects M-x describe-face output. +(defmacro define-obsolete-face-alias (obsolete-face current-face + &optional when) + "Make OBSOLETE-FACE a face alias for CURRENT-FACE and mark it obsolete. +The optional string WHEN gives the Emacs version where OBSOLETE-FACE +became obsolete." + `(progn + (put ,obsolete-face 'face-alias ,current-face) + ;; Used by M-x describe-face. + (put ,obsolete-face 'obsolete-face (or ,when t)))) + (defmacro dont-compile (&rest body) "Like `progn', but the body always runs interpreted (not compiled). If you think you need this, you're probably making a mistake somewhere." diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4ab701bf55c..7903bf6a1d9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -156,6 +156,7 @@ ;; Some versions of `file' can be customized to recognize that. (require 'backquote) +(eval-when-compile (require 'cl)) (or (fboundp 'defsubst) ;; This really ought to be loaded already! @@ -199,11 +200,18 @@ (defcustom emacs-lisp-file-regexp "\\.el\\'" "Regexp which matches Emacs Lisp source files. -You may want to redefine the function `byte-compile-dest-file' -if you change this variable." +If you change this, you might want to set `byte-compile-dest-file-function'." :group 'bytecomp :type 'regexp) +(defcustom byte-compile-dest-file-function nil + "Function for the function `byte-compile-dest-file' to call. +It should take one argument, the name of an Emacs Lisp source +file name, and return the name of the compiled file." + :group 'bytecomp + :type '(choice (const nil) function) + :version "23.2") + ;; This enables file name handlers such as jka-compr ;; to remove parts of the file name that should not be copied ;; through to the output file name. @@ -217,15 +225,21 @@ if you change this variable." (or (fboundp 'byte-compile-dest-file) ;; The user may want to redefine this along with emacs-lisp-file-regexp, ;; so only define it if it is undefined. + ;; Note - redefining this function is obsolete as of 23.2. + ;; Customize byte-compile-dest-file-function instead. (defun byte-compile-dest-file (filename) "Convert an Emacs Lisp source file name to a compiled file name. -If FILENAME matches `emacs-lisp-file-regexp' (by default, files -with the extension `.el'), add `c' to it; otherwise add `.elc'." - (setq filename (byte-compiler-base-file-name filename)) - (setq filename (file-name-sans-versions filename)) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc"))))) +If `byte-compile-dest-file-function' is non-nil, uses that +function to do the work. Otherwise, if FILENAME matches +`emacs-lisp-file-regexp' (by default, files with the extension `.el'), +adds `c' to it; otherwise adds `.elc'." + (if byte-compile-dest-file-function + (funcall byte-compile-dest-file-function filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc")))))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") @@ -426,11 +440,14 @@ else the global value will be modified." (defvar byte-compile-interactive-only-functions '(beginning-of-buffer end-of-buffer replace-string replace-regexp insert-file insert-buffer insert-file-literally previous-line next-line - goto-line) + goto-line comint-run) "List of commands that are not meant to be called from Lisp.") -(defvar byte-compile-not-obsolete-var nil - "If non-nil, this is a variable that shouldn't be reported as obsolete.") +(defvar byte-compile-not-obsolete-vars nil + "If non-nil, a list of variables that shouldn't be reported as obsolete.") + +(defvar byte-compile-not-obsolete-funcs nil + "If non-nil, a list of functions that shouldn't be reported as obsolete.") (defcustom byte-compile-generate-call-tree nil "Non-nil means collect call-graph information when compiling. @@ -518,7 +535,8 @@ This is so we can inline them when necessary. Each element looks like (FUNCTIONNAME . DEFINITION). It is \(FUNCTIONNAME . nil) when a function is redefined as a macro. It is \(FUNCTIONNAME . t) when all we know is that it was defined, -and we don't know the definition.") +and we don't know the definition. For an autoloaded function, DEFINITION +has the form (autoload . FILENAME).") (defvar byte-compile-unresolved-functions nil "Alist of undefined functions to which calls have been compiled. @@ -854,13 +872,20 @@ otherwise pop it") (t ; Absolute jump (setq pc (car (cdr (car bytes)))) ; Pick PC from tag (setcar (cdr bytes) (logand pc 255)) - (setcar bytes (lsh pc -8)))) + (setcar bytes (lsh pc -8)) + ;; FIXME: Replace this by some workaround. + (if (> (car bytes) 255) (error "Bytecode overflow")))) (setq patchlist (cdr patchlist)))) (apply 'unibyte-string (nreverse bytes)))) ;;; compile-time evaluation +(defun byte-compile-cl-file-p (file) + "Return non-nil if FILE is one of the CL files." + (and (stringp file) + (string-match "^cl\\>" (file-name-nondirectory file)))) + (defun byte-compile-eval (form) "Eval FORM and mark the functions defined therein. Each function's symbol gets added to `byte-compile-noruntime-functions'." @@ -877,7 +902,15 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." old-autoloads) ;; Make sure the file was not already loaded before. (unless (or (assoc (car xs) hist-orig) - (equal (car xs) "cl")) + ;; Don't give both the "noruntime" and + ;; "cl-functions" warning for the same function. + ;; FIXME This seems incorrect - these are two + ;; independent warnings. For example, you may be + ;; choosing to see the cl warnings but ignore them. + ;; You probably don't want to ignore noruntime in the + ;; same way. + (and (byte-compile-warning-enabled-p 'cl-functions) + (byte-compile-cl-file-p (car xs)))) (dolist (s xs) (cond ((symbolp s) @@ -897,19 +930,23 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (push (cdr s) old-autoloads))))))) (when (byte-compile-warning-enabled-p 'cl-functions) (let ((hist-new load-history)) - ;; Go through load-history, look for newly loaded files - ;; and mark all the functions defined therein. - (while (and hist-new (not (eq hist-new hist-orig))) - (let ((xs (pop hist-new))) - ;; Make sure the file was not already loaded before. - (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig))) - (byte-compile-find-cl-functions))))))))) + ;; Go through load-history, looking for the cl files. + ;; Since new files are added at the start of load-history, + ;; we scan the new history until the tail matches the old. + (while (and (not byte-compile-cl-functions) + hist-new (not (eq hist-new hist-orig))) + ;; We used to check if the file had already been loaded, + ;; but it is better to check non-nil byte-compile-cl-functions. + (and (byte-compile-cl-file-p (car (pop hist-new))) + (byte-compile-find-cl-functions)))))))) (defun byte-compile-eval-before-compile (form) "Evaluate FORM for `eval-and-compile'." (let ((hist-nil-orig current-load-list)) (prog1 (eval form) ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. + ;; FIXME Why does it do that - just as a hack? + ;; There are other ways to do this nowadays. (let ((tem current-load-list)) (while (not (eq tem hist-nil-orig)) (when (equal (car tem) '(require . cl)) @@ -1109,14 +1146,15 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (obsolete (or funcp (get symbol 'byte-obsolete-variable))) (instead (car obsolete)) (asof (if funcp (nth 2 obsolete) (cdr obsolete)))) - (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol - (if funcp "function" "variable") - (if asof (concat " (as of Emacs " asof ")") "") - (cond ((stringp instead) - (concat "; " instead)) - (instead - (format "; use `%s' instead." instead)) - (t ".")))))) + (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs)) + (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol + (if funcp "function" "variable") + (if asof (concat " (as of Emacs " asof ")") "") + (cond ((stringp instead) + (concat "; " instead)) + (instead + (format "; use `%s' instead." instead)) + (t "."))))))) (defun byte-compile-report-error (error-info) "Report Lisp error in compilation. ERROR-INFO is the error data." @@ -1404,15 +1442,16 @@ extra args." (defvar byte-compile-cl-functions nil "List of functions defined in CL.") +;; Can't just add this to cl-load-hook, because that runs just before +;; the forms from cl.el get added to load-history. (defun byte-compile-find-cl-functions () (unless byte-compile-cl-functions (dolist (elt load-history) - (when (and (stringp (car elt)) - (string-match - "^cl\\>" (file-name-nondirectory (car elt)))) - (dolist (e (cdr elt)) - (when (memq (car-safe e) '(autoload defun)) - (push (cdr e) byte-compile-cl-functions))))))) + (and (byte-compile-cl-file-p (car elt)) + (dolist (e (cdr elt)) + ;; Includes the cl-foo functions that cl autoloads. + (when (memq (car-safe e) '(autoload defun)) + (push (cdr e) byte-compile-cl-functions))))))) (defun byte-compile-cl-warn (form) "Warn if FORM is a call of a function from the CL package." @@ -1501,7 +1540,14 @@ If ANY-VALUE is nil, only return non-nil if the value of the symbol is the symbol itself." (or (memq symbol '(nil t)) (keywordp symbol) - (if any-value (memq symbol byte-compile-const-variables)))) + (if any-value + (or (memq symbol byte-compile-const-variables) + ;; FIXME: We should provide a less intrusive way to find out + ;; is a variable is "constant". + (and (boundp symbol) + (condition-case nil + (progn (set symbol (symbol-value symbol)) nil) + (setting-constant t))))))) (defmacro byte-compile-constp (form) "Return non-nil if FORM is a constant." @@ -1583,6 +1629,7 @@ Files in subdirectories of DIRECTORY are processed also." ;; of the boundp test in byte-compile-variable-ref. ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00237.html ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00134.html +;; Note that similar considerations apply to command-line-1 in startup.el. ;;;###autoload (defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg bytecomp-force) @@ -1743,12 +1790,12 @@ The value is non-nil if there were no errors, nil if errors." (set-buffer-multibyte nil)) ;; Run hooks including the uncompression hook. ;; If they change the file name, then change it for the output also. - (let ((buffer-file-name bytecomp-filename) - (default-major-mode 'emacs-lisp-mode) - ;; Ignore unsafe local variables. - ;; We only care about a few of them for our purposes. - (enable-local-variables :safe) - (enable-local-eval nil)) + (letf ((buffer-file-name bytecomp-filename) + ((default-value 'major-mode) 'emacs-lisp-mode) + ;; Ignore unsafe local variables. + ;; We only care about a few of them for our purposes. + (enable-local-variables :safe) + (enable-local-eval nil)) ;; Arg of t means don't alter enable-local-variables. (normal-mode t) (setq bytecomp-filename buffer-file-name)) @@ -2192,17 +2239,17 @@ list that represents a doc string reference. (insert (nth 2 info))))) nil) -(defun byte-compile-keep-pending (form &optional handler) +(defun byte-compile-keep-pending (form &optional bytecomp-handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form t))) - (if handler + (if bytecomp-handler (let ((for-effect t)) ;; To avoid consing up monstrously large forms at load time, we split ;; the output regularly. (and (memq (car-safe form) '(fset defalias)) (nthcdr 300 byte-compile-output) (byte-compile-flush-pending)) - (funcall handler form) + (funcall bytecomp-handler form) (if for-effect (byte-compile-discard))) (byte-compile-form form t)) @@ -2223,13 +2270,13 @@ list that represents a doc string reference. (defun byte-compile-file-form (form) (let ((byte-compile-current-form nil) ; close over this for warnings. - handler) + bytecomp-handler) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) - (setq handler (get (car form) 'byte-hunk-handler))) - (cond ((setq form (funcall handler form)) + (setq bytecomp-handler (get (car form) 'byte-hunk-handler))) + (cond ((setq form (funcall bytecomp-handler form)) (byte-compile-flush-pending) (byte-compile-output-file-form form)))) ((eq form (setq form (macroexpand form byte-compile-macro-environment))) @@ -2260,13 +2307,25 @@ list that represents a doc string reference. (eval (nth 5 form)) ;Macro (eval form)) ;Define the autoload. ;; Avoid undefined function warnings for the autoload. - (if (and (consp (nth 1 form)) + (when (and (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) (symbolp (nth 1 (nth 1 form)))) - (push (cons (nth 1 (nth 1 form)) - (cons 'autoload (cdr (cdr form)))) - byte-compile-function-environment)) + (push (cons (nth 1 (nth 1 form)) + (cons 'autoload (cdr (cdr form)))) + byte-compile-function-environment) + ;; If an autoload occurs _before_ the first call to a function, + ;; byte-compile-callargs-warn does not add an entry to + ;; byte-compile-unresolved-functions. Here we mimic the logic + ;; of byte-compile-callargs-warn so as not to warn if the + ;; autoload comes _after_ the function call. + ;; Alternatively, similar logic could go in + ;; byte-compile-warn-about-unresolved-functions. + (or (memq (nth 1 (nth 1 form)) byte-compile-noruntime-functions) + (setq byte-compile-unresolved-functions + (delq (assq (nth 1 (nth 1 form)) + byte-compile-unresolved-functions) + byte-compile-unresolved-functions)))) (if (stringp (nth 3 form)) form ;; No doc string, so we can compile this as a normal form. @@ -2319,11 +2378,23 @@ list that represents a doc string reference. (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) - (let ((args (mapcar 'eval (cdr form)))) + (let ((args (mapcar 'eval (cdr form))) + (hist-orig load-history) + hist-new) (apply 'require args) - ;; Detect (require 'cl) in a way that works even if cl is already loaded. - (if (member (car args) '("cl" cl)) - (byte-compile-disable-warning 'cl-functions))) + (when (byte-compile-warning-enabled-p 'cl-functions) + ;; Detect (require 'cl) in a way that works even if cl is already loaded. + (if (member (car args) '("cl" cl)) + (progn + (byte-compile-warn "cl package required at runtime") + (byte-compile-disable-warning 'cl-functions)) + ;; We may have required something that causes cl to be loaded, eg + ;; the uncompiled version of a file that requires cl when compiling. + (setq hist-new load-history) + (while (and (not byte-compile-cl-functions) + hist-new (not (eq hist-new hist-orig))) + (and (byte-compile-cl-file-p (car (pop hist-new))) + (byte-compile-find-cl-functions)))))) (byte-compile-keep-pending form 'byte-compile-normal-call)) (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) @@ -2334,6 +2405,14 @@ list that represents a doc string reference. ;; Return nil so the forms are not output twice. nil) +(put 'with-no-warnings 'byte-hunk-handler + 'byte-compile-file-form-with-no-warnings) +(defun byte-compile-file-form-with-no-warnings (form) + ;; cf byte-compile-file-form-progn. + (let (byte-compile-warnings) + (mapc 'byte-compile-file-form (cdr form)) + nil)) + ;; This handler is not necessary, but it makes the output from dont-compile ;; and similar macros cleaner. (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) @@ -2630,76 +2709,79 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; of the list FUN and `byte-compile-set-symbol-position' is not called. ;; Use this feature to avoid calling `byte-compile-set-symbol-position' ;; for symbols generated by the byte compiler itself. -(defun byte-compile-lambda (fun &optional add-lambda) +(defun byte-compile-lambda (bytecomp-fun &optional add-lambda) (if add-lambda - (setq fun (cons 'lambda fun)) - (unless (eq 'lambda (car-safe fun)) - (error "Not a lambda list: %S" fun)) + (setq bytecomp-fun (cons 'lambda bytecomp-fun)) + (unless (eq 'lambda (car-safe bytecomp-fun)) + (error "Not a lambda list: %S" bytecomp-fun)) (byte-compile-set-symbol-position 'lambda)) - (byte-compile-check-lambda-list (nth 1 fun)) - (let* ((arglist (nth 1 fun)) + (byte-compile-check-lambda-list (nth 1 bytecomp-fun)) + (let* ((bytecomp-arglist (nth 1 bytecomp-fun)) (byte-compile-bound-variables (nconc (and (byte-compile-warning-enabled-p 'free-vars) - (delq '&rest (delq '&optional (copy-sequence arglist)))) + (delq '&rest + (delq '&optional (copy-sequence bytecomp-arglist)))) byte-compile-bound-variables)) - (body (cdr (cdr fun))) - (doc (if (stringp (car body)) - (prog1 (car body) + (bytecomp-body (cdr (cdr bytecomp-fun))) + (bytecomp-doc (if (stringp (car bytecomp-body)) + (prog1 (car bytecomp-body) ;; Discard the doc string ;; unless it is the last element of the body. - (if (cdr body) - (setq body (cdr body)))))) - (int (assq 'interactive body))) + (if (cdr bytecomp-body) + (setq bytecomp-body (cdr bytecomp-body)))))) + (bytecomp-int (assq 'interactive bytecomp-body))) ;; Process the interactive spec. - (when int + (when bytecomp-int (byte-compile-set-symbol-position 'interactive) ;; Skip (interactive) if it is in front (the most usual location). - (if (eq int (car body)) - (setq body (cdr body))) - (cond ((consp (cdr int)) - (if (cdr (cdr int)) + (if (eq bytecomp-int (car bytecomp-body)) + (setq bytecomp-body (cdr bytecomp-body))) + (cond ((consp (cdr bytecomp-int)) + (if (cdr (cdr bytecomp-int)) (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string int))) + (prin1-to-string bytecomp-int))) ;; If the interactive spec is a call to `list', don't ;; compile it, because `call-interactively' looks at the ;; args of `list'. Actually, compile it to get warnings, ;; but don't use the result. - (let ((form (nth 1 int))) + (let ((form (nth 1 bytecomp-int))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) (if (eq (car-safe form) 'list) - (byte-compile-top-level (nth 1 int)) - (setq int (list 'interactive - (byte-compile-top-level (nth 1 int))))))) - ((cdr int) + (byte-compile-top-level (nth 1 bytecomp-int)) + (setq bytecomp-int (list 'interactive + (byte-compile-top-level + (nth 1 bytecomp-int))))))) + ((cdr bytecomp-int) (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string int))))) + (prin1-to-string bytecomp-int))))) ;; Process the body. - (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) + (let ((compiled (byte-compile-top-level + (cons 'progn bytecomp-body) nil 'lambda))) ;; Build the actual byte-coded function. (if (and (eq 'byte-code (car-safe compiled)) (not (byte-compile-version-cond byte-compile-compatibility))) (apply 'make-byte-code - (append (list arglist) + (append (list bytecomp-arglist) ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. - (if (or doc int) - (list doc)) + (if (or bytecomp-doc bytecomp-int) + (list bytecomp-doc)) ;; optionally, the interactive spec. - (if int - (list (nth 1 int))))) + (if bytecomp-int + (list (nth 1 bytecomp-int))))) (setq compiled - (nconc (if int (list int)) + (nconc (if bytecomp-int (list bytecomp-int)) (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) (compiled (list compiled))))) - (nconc (list 'lambda arglist) - (if (or doc (stringp (car compiled))) - (cons doc (cond (compiled) - (body (list nil)))) + (nconc (list 'lambda bytecomp-arglist) + (if (or bytecomp-doc (stringp (car compiled))) + (cons bytecomp-doc (cond (compiled) + (bytecomp-body (list nil)))) compiled)))))) (defun byte-compile-constants-vector () @@ -2843,13 +2925,14 @@ If FORM is a lambda or a macro, byte-compile it as a function." ((cdr body) (cons 'progn (nreverse body))) ((car body))))) -;; Given BODY, compile it and return a new body. -(defun byte-compile-top-level-body (body &optional for-effect) - (setq body (byte-compile-top-level (cons 'progn body) for-effect t)) - (cond ((eq (car-safe body) 'progn) - (cdr body)) - (body - (list body)))) +;; Given BYTECOMP-BODY, compile it and return a new body. +(defun byte-compile-top-level-body (bytecomp-body &optional for-effect) + (setq bytecomp-body + (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) + (cond ((eq (car-safe bytecomp-body) 'progn) + (cdr bytecomp-body)) + (bytecomp-body + (list bytecomp-body)))) (put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function) (defun byte-compile-declare-function (form) @@ -2889,29 +2972,33 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq for-effect nil)) (t (byte-compile-variable-ref 'byte-varref form)))) ((symbolp (car form)) - (let* ((fn (car form)) - (handler (get fn 'byte-compile))) - (when (byte-compile-const-symbol-p fn) - (byte-compile-warn "`%s' called as a function" fn)) + (let* ((bytecomp-fn (car form)) + (bytecomp-handler (get bytecomp-fn 'byte-compile))) + (when (byte-compile-const-symbol-p bytecomp-fn) + (byte-compile-warn "`%s' called as a function" bytecomp-fn)) (and (byte-compile-warning-enabled-p 'interactive-only) - (memq fn byte-compile-interactive-only-functions) + (memq bytecomp-fn byte-compile-interactive-only-functions) (byte-compile-warn "`%s' used from Lisp code\n\ -That command is designed for interactive use only" fn)) - (if (and handler +That command is designed for interactive use only" bytecomp-fn)) + (when (byte-compile-warning-enabled-p 'callargs) + (if (memq bytecomp-fn + '(custom-declare-group custom-declare-variable + custom-declare-face)) + (byte-compile-nogroup-warn form)) + (byte-compile-callargs-warn form)) + (if (and bytecomp-handler ;; Make sure that function exists. This is important ;; for CL compiler macros since the symbol may be ;; `cl-byte-compile-compiler-macro' but if CL isn't ;; loaded, this function doesn't exist. - (or (not (memq handler '(cl-byte-compile-compiler-macro))) - (functionp handler)) + (or (not (memq bytecomp-handler + '(cl-byte-compile-compiler-macro))) + (functionp bytecomp-handler)) (not (and (byte-compile-version-cond byte-compile-compatibility) - (get (get fn 'byte-opcode) 'emacs19-opcode)))) - (funcall handler form) - (when (byte-compile-warning-enabled-p 'callargs) - (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face)) - (byte-compile-nogroup-warn form)) - (byte-compile-callargs-warn form)) + (get (get bytecomp-fn 'byte-opcode) + 'emacs19-opcode)))) + (funcall bytecomp-handler form) (byte-compile-normal-call form)) (if (byte-compile-warning-enabled-p 'cl-functions) (byte-compile-cl-warn form)))) @@ -2938,37 +3025,40 @@ That command is designed for interactive use only" fn)) (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. (byte-compile-out 'byte-call (length (cdr form)))) -(defun byte-compile-variable-ref (base-op var) - (when (symbolp var) - (byte-compile-set-symbol-position var)) - (if (or (not (symbolp var)) - (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref)))) +(defun byte-compile-variable-ref (base-op bytecomp-var) + (when (symbolp bytecomp-var) + (byte-compile-set-symbol-position bytecomp-var)) + (if (or (not (symbolp bytecomp-var)) + (byte-compile-const-symbol-p bytecomp-var + (not (eq base-op 'byte-varref)))) (byte-compile-warn (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'") ((eq base-op 'byte-varset) "variable assignment to %s `%s'") (t "variable reference to %s `%s'")) - (if (symbolp var) "constant" "nonvariable") - (prin1-to-string var)) - (and (get var 'byte-obsolete-variable) - (not (eq var byte-compile-not-obsolete-var)) - (byte-compile-warn-obsolete var)) + (if (symbolp bytecomp-var) "constant" "nonvariable") + (prin1-to-string bytecomp-var)) + (and (get bytecomp-var 'byte-obsolete-variable) + (not (memq bytecomp-var byte-compile-not-obsolete-vars)) + (byte-compile-warn-obsolete bytecomp-var)) (if (byte-compile-warning-enabled-p 'free-vars) (if (eq base-op 'byte-varbind) - (push var byte-compile-bound-variables) - (or (boundp var) - (memq var byte-compile-bound-variables) + (push bytecomp-var byte-compile-bound-variables) + (or (boundp bytecomp-var) + (memq bytecomp-var byte-compile-bound-variables) (if (eq base-op 'byte-varset) - (or (memq var byte-compile-free-assignments) + (or (memq bytecomp-var byte-compile-free-assignments) (progn - (byte-compile-warn "assignment to free variable `%s'" var) - (push var byte-compile-free-assignments))) - (or (memq var byte-compile-free-references) + (byte-compile-warn "assignment to free variable `%s'" + bytecomp-var) + (push bytecomp-var byte-compile-free-assignments))) + (or (memq bytecomp-var byte-compile-free-references) (progn - (byte-compile-warn "reference to free variable `%s'" var) - (push var byte-compile-free-references)))))))) - (let ((tmp (assq var byte-compile-variables))) + (byte-compile-warn "reference to free variable `%s'" + bytecomp-var) + (push bytecomp-var byte-compile-free-references)))))))) + (let ((tmp (assq bytecomp-var byte-compile-variables))) (unless tmp - (setq tmp (list var)) + (setq tmp (list bytecomp-var)) (push tmp byte-compile-variables)) (byte-compile-out base-op tmp))) @@ -3460,26 +3550,32 @@ That command is designed for interactive use only" fn)) (byte-defop-compiler-1 quote-form) (defun byte-compile-setq (form) - (let ((args (cdr form))) - (if args - (while args - (byte-compile-form (car (cdr args))) - (or for-effect (cdr (cdr args)) + (let ((bytecomp-args (cdr form))) + (if bytecomp-args + (while bytecomp-args + (byte-compile-form (car (cdr bytecomp-args))) + (or for-effect (cdr (cdr bytecomp-args)) (byte-compile-out 'byte-dup 0)) - (byte-compile-variable-ref 'byte-varset (car args)) - (setq args (cdr (cdr args)))) + (byte-compile-variable-ref 'byte-varset (car bytecomp-args)) + (setq bytecomp-args (cdr (cdr bytecomp-args)))) ;; (setq), with no arguments. (byte-compile-form nil for-effect)) (setq for-effect nil))) (defun byte-compile-setq-default (form) - (let ((args (cdr form)) + (let ((bytecomp-args (cdr form)) setters) - (while args - (setq setters - (cons (list 'set-default (list 'quote (car args)) (car (cdr args))) - setters)) - (setq args (cdr (cdr args)))) + (while bytecomp-args + (let ((var (car bytecomp-args))) + (if (or (not (symbolp var)) + (byte-compile-const-symbol-p var t)) + (byte-compile-warn + "variable assignment to %s `%s'" + (if (symbolp var) "constant" "nonvariable") + (prin1-to-string var))) + (push (list 'set-default (list 'quote var) (car (cdr bytecomp-args))) + setters)) + (setq bytecomp-args (cdr (cdr bytecomp-args)))) (byte-compile-form (cons 'progn (nreverse setters))))) (defun byte-compile-quote (form) @@ -3491,14 +3587,14 @@ That command is designed for interactive use only" fn)) ;;; control structures -(defun byte-compile-body (body &optional for-effect) - (while (cdr body) - (byte-compile-form (car body) t) - (setq body (cdr body))) - (byte-compile-form (car body) for-effect)) +(defun byte-compile-body (bytecomp-body &optional for-effect) + (while (cdr bytecomp-body) + (byte-compile-form (car bytecomp-body) t) + (setq bytecomp-body (cdr bytecomp-body))) + (byte-compile-form (car bytecomp-body) for-effect)) -(defsubst byte-compile-body-do-effect (body) - (byte-compile-body body for-effect) +(defsubst byte-compile-body-do-effect (bytecomp-body) + (byte-compile-body bytecomp-body for-effect) (setq for-effect nil)) (defsubst byte-compile-form-do-effect (form) @@ -3579,7 +3675,7 @@ CONDITION is a variable whose value is a test in an `if' or `cond'. BODY is the code to compile in the first arm of the if or the body of the cond clause. If CONDITION's value is of the form (fboundp 'foo) or (boundp 'foo), the relevant warnings from BODY about foo's -being undefined will be suppressed. +being undefined (or obsolete) will be suppressed. If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs), that suppresses all warnings during execution of BODY." @@ -3595,7 +3691,14 @@ that suppresses all warnings during execution of BODY." (append bound-list byte-compile-bound-variables) byte-compile-bound-variables))) (unwind-protect - (progn ,@body) + ;; If things not being bound at all is ok, so must them being obsolete. + ;; Note that we add to the existing lists since Tramp (ab)uses + ;; this feature. + (let ((byte-compile-not-obsolete-vars + (append byte-compile-not-obsolete-vars bound-list)) + (byte-compile-not-obsolete-funcs + (append byte-compile-not-obsolete-funcs fbound-list))) + ,@body) ;; Maybe remove the function symbol from the unresolved list. (dolist (fbound fbound-list) (when fbound @@ -3661,10 +3764,10 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-and (form) (let ((failtag (byte-compile-make-tag)) - (args (cdr form))) - (if (null args) + (bytecomp-args (cdr form))) + (if (null bytecomp-args) (byte-compile-form-do-effect t) - (byte-compile-and-recursion args failtag)))) + (byte-compile-and-recursion bytecomp-args failtag)))) ;; Handle compilation of a nontrivial `and' call. ;; We use tail recursion so we can use byte-compile-maybe-guarded. @@ -3680,10 +3783,10 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-or (form) (let ((wintag (byte-compile-make-tag)) - (args (cdr form))) - (if (null args) + (bytecomp-args (cdr form))) + (if (null bytecomp-args) (byte-compile-form-do-effect nil) - (byte-compile-or-recursion args wintag)))) + (byte-compile-or-recursion bytecomp-args wintag)))) ;; Handle compilation of a nontrivial `or' call. ;; We use tail recursion so we can use byte-compile-maybe-guarded. @@ -3723,7 +3826,8 @@ that suppresses all warnings during execution of BODY." (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope (varlist (reverse (car (cdr form))))) (dolist (var varlist) - (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var))) + (byte-compile-variable-ref 'byte-varbind + (if (consp var) (car var) var))) (byte-compile-body-do-effect (cdr (cdr form))) (byte-compile-out 'byte-unbind (length (car (cdr form)))))) @@ -3939,7 +4043,7 @@ that suppresses all warnings during execution of BODY." fun var string)) `(put ',var 'variable-documentation ,string)) (if (cddr form) ; `value' provided - (let ((byte-compile-not-obsolete-var var)) + (let ((byte-compile-not-obsolete-vars (list var))) (if (eq fun 'defconst) ;; `defconst' sets `var' unconditionally. (let ((tmp (make-symbol "defconst-tmp-var"))) @@ -4012,7 +4116,8 @@ that suppresses all warnings during execution of BODY." (byte-compile-form (cons 'progn (cdr form))))) ;; Warn about misuses of make-variable-buffer-local. -(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local) +(byte-defop-compiler-1 make-variable-buffer-local + byte-compile-make-variable-buffer-local) (defun byte-compile-make-variable-buffer-local (form) (if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote) (byte-compile-warning-enabled-p 'make-local)) @@ -4248,7 +4353,7 @@ already up-to-date." (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "`batch-byte-compile' is to be used only with -batch")) - (let ((error nil)) + (let ((bytecomp-error nil)) (while command-line-args-left (if (file-directory-p (expand-file-name (car command-line-args-left))) ;; Directory as argument. @@ -4265,7 +4370,7 @@ already up-to-date." (file-exists-p bytecomp-dest) (file-newer-than-file-p bytecomp-source bytecomp-dest)) (if (null (batch-byte-compile-file bytecomp-source)) - (setq error t))))) + (setq bytecomp-error t))))) ;; Specific file argument (if (or (not noforce) (let* ((bytecomp-source (car command-line-args-left)) @@ -4273,9 +4378,9 @@ already up-to-date." (or (not (file-exists-p bytecomp-dest)) (file-newer-than-file-p bytecomp-source bytecomp-dest)))) (if (null (batch-byte-compile-file (car command-line-args-left))) - (setq error t)))) + (setq bytecomp-error t)))) (setq command-line-args-left (cdr command-line-args-left))) - (kill-emacs (if error 1 0)))) + (kill-emacs (if bytecomp-error 1 0)))) (defun batch-byte-compile-file (bytecomp-file) (if debug-on-error @@ -4302,6 +4407,25 @@ already up-to-date." (prin1-to-string (cdr err))) nil)))) +(defun byte-compile-refresh-preloaded () + "Reload any Lisp file that was changed since Emacs was dumped. +Use with caution." + (let* ((argv0 (car command-line-args)) + (emacs-file (executable-find argv0))) + (if (not (and emacs-file (file-executable-p emacs-file))) + (message "Can't find %s to refresh preloaded Lisp files" argv0) + (dolist (f (reverse load-history)) + (setq f (car f)) + (if (string-match "elc\\'" f) (setq f (substring f 0 -1))) + (when (and (file-readable-p f) + (file-newer-than-file-p f emacs-file)) + (message "Reloading stale %s" (file-name-nondirectory f)) + (condition-case nil + (load f 'noerror nil 'nosuffix) + ;; Probably shouldn't happen, but in case of an error, it seems + ;; at least as useful to ignore it as it is to stop compilation. + (error nil))))))) + ;;;###autoload (defun batch-byte-recompile-directory (&optional arg) "Run `byte-recompile-directory' on the dirs remaining on the command line. diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 1da35286eba..ba7982df731 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -515,9 +515,8 @@ cons cells of the form (NAME . NUM). See SORT for more details." (defun chart-goto-xy (x y) "Move cursor to position X Y in buffer, and add spaces and CRs if needed." - (let ((indent-tabs-mode nil) - (num (goto-line (1+ y)))) + (num (progn (goto-char (point-min)) (forward-line y)))) (if (and (= 0 num) (/= 0 (current-column))) (newline 1)) (if (eobp) (newline num)) (if (< x 0) (setq x 0)) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index fad8d25ab6b..b49638b8229 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -218,11 +218,12 @@ have doc strings." :type 'boolean) ;;;###autoload(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) -(defcustom checkdoc-force-history-flag t +(defcustom checkdoc-force-history-flag nil "Non-nil means that files should have a History section or ChangeLog file. This helps document the evolution of, and recent changes to, the package." :group 'checkdoc :type 'boolean) +;;;###autoload(put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) (defcustom checkdoc-permit-comma-termination-flag nil "Non-nil means the first line of a docstring may end with a comma. @@ -270,6 +271,7 @@ the same order as they appear in the argument list. No mention is made in the style guide relating to order." :group 'checkdoc :type 'boolean) +;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable 'booleanp) (defvar checkdoc-style-hooks nil "Hooks called after the standard style check is completed. @@ -307,11 +309,19 @@ Do not set this by hand, use a function like `checkdoc-current-buffer' with a universal argument.") (defcustom checkdoc-symbol-words nil - "A list of symbols which also happen to make good words. -These symbol-words are ignored when unquoted symbols are searched for. + "A list of symbol names (strings) which also happen to make good words. +These words are ignored when unquoted symbols are searched for. This should be set in an Emacs Lisp file's local variables." :group 'checkdoc :type '(repeat (symbol :tag "Word"))) +;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable 'checkdoc-list-of-strings-p) + +;;;###autoload +(defun checkdoc-list-of-strings-p (obj) + ;; this is a function so it might be shared by checkdoc-proper-noun-list + ;; and/or checkdoc-ispell-lisp-words in the future + (and (listp obj) + (not (memq nil (mapcar 'stringp obj))))) (defvar checkdoc-proper-noun-list '("ispell" "xemacs" "emacs" "lisp") @@ -501,7 +511,7 @@ the users will view as each check is completed." CHECK is a list of four strings stating the current status of each test; the nth string describes the status of the nth test." (let (temp-buffer-setup-hook) - (with-output-to-temp-buffer " *Checkdoc Status*" + (with-output-to-temp-buffer "*Checkdoc Status*" (princ-list "Buffer comments and tags: " (nth 0 check) "\n" "Documentation style: " (nth 1 check) "\n" @@ -509,7 +519,7 @@ test; the nth string describes the status of the nth test." "Unwanted Spaces: " (nth 3 check) ))) (shrink-window-if-larger-than-buffer - (get-buffer-window " *Checkdoc Status*")) + (get-buffer-window "*Checkdoc Status*")) (message nil) (sit-for 0)) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 941e19110e7..49eef8a68d8 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -1,7 +1,7 @@ -;;; cl-extra.el --- Common Lisp features, part 2 -*-byte-compile-dynamic: t;-*- +;;; cl-extra.el --- Common Lisp features, part 2 -;; Copyright (C) 1993, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Keywords: extensions @@ -820,6 +820,8 @@ This also does some trivial optimizations to make the form prettier." (run-hooks 'cl-extra-load-hook) ;; Local variables: +;; byte-compile-dynamic: t +;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 45deeed859a..28dc269cbb8 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,7 +10,7 @@ ;;;;;; 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" "7988f2bc52c60f3e7cac9970430d1df3") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "d2000926c438cbd72f37587241cab7ed") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ @@ -282,7 +282,7 @@ Not documented ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "cf5886214d1cef9ba1bb60aac14ca156") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "f6bd68f91847390d47f57b6aac6be023") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3050f64a7c0..a0b0d2e092b 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -222,10 +222,16 @@ its argument list allows full Common Lisp conventions." (defconst lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) -(defvar cl-macro-environment nil) +(defvar cl-macro-environment nil + "Keep the list of currently active macros. +It is a list of elements of the form either: +- (SYMBOL . FUNCTION) where FUNCTION is the macro expansion function. +- (SYMBOL-NAME . EXPANSION) where SYMBOL-NAME is the name of a symbol macro.") (defvar bind-block) (defvar bind-defs) (defvar bind-enquote) (defvar bind-inits) (defvar bind-lets) (defvar bind-forms) +(declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) + (defun cl-transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (orig-args args) (bind-defs nil) (bind-enquote nil) @@ -2544,8 +2550,22 @@ and then returning foo." (cons (if (memq '&whole args) (delq '&whole args) (cons '--cl-whole-arg-- args)) body)) (list 'or (list 'get (list 'quote func) '(quote byte-compile)) - (list 'put (list 'quote func) '(quote byte-compile) - '(quote cl-byte-compile-compiler-macro))))) + (list 'progn + (list 'put (list 'quote func) '(quote byte-compile) + '(quote cl-byte-compile-compiler-macro)) + ;; This is so that describe-function can locate + ;; the macro definition. + (list 'let + (list (list + 'file + (or buffer-file-name + (and (boundp 'byte-compile-current-file) + (stringp byte-compile-current-file) + byte-compile-current-file)))) + (list 'if 'file + (list 'put (list 'quote func) + '(quote compiler-macro-file) + '(file-name-nondirectory file)))))))) ;;;###autoload (defun compiler-macroexpand (form) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index beed29678d4..2045a05a97a 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -246,7 +246,7 @@ one value." ;;; Macros. -(defvar cl-macro-environment nil) +(defvar cl-macro-environment) (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand) (defalias 'macroexpand 'cl-macroexpand))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index fcb6dfcc279..baad2559e0c 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -119,8 +119,7 @@ first will be printed into the backtrace buffer." (let (debugger-value (debug-on-error nil) (debug-on-quit nil) - (debugger-buffer (let ((default-major-mode 'fundamental-mode)) - (get-buffer-create "*Backtrace*"))) + (debugger-buffer (get-buffer-create "*Backtrace*")) (debugger-old-buffer (current-buffer)) (debugger-step-after-exit nil) (debugger-will-be-back nil) @@ -267,7 +266,7 @@ first will be printed into the backtrace buffer." That buffer should be current already." (setq buffer-read-only nil) (erase-buffer) - (set-buffer-multibyte nil) + (set-buffer-multibyte t) ;Why was it nil ? -stef (setq buffer-undo-list t) (let ((standard-output (current-buffer)) (print-escape-newlines t) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 8b2bb8ca861..ef30d7ca33f 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -1,8 +1,8 @@ ;;; derived.el --- allow inheritance of major modes ;; (formerly mode-clone.el) -;; Copyright (C) 1993, 1994, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1999, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: David Megginson (dmeggins@aix1.uottawa.ca) ;; Maintainer: FSF @@ -193,7 +193,7 @@ See Info node `(elisp)Derived Modes' for more details." parent child docstring syntax abbrev)) `(progn - (unless (get ',hook 'variable-documentation) + (unless (get ',hook 'variable-documentation) (put ',hook 'variable-documentation ,(format "Hook run when entering %s mode. No problems result if this variable is not bound. @@ -202,16 +202,25 @@ No problems result if this variable is not bound. (unless (boundp ',map) (put ',map 'definition-name ',child)) (defvar ,map (make-sparse-keymap)) + (unless (get ',map 'variable-documentation) + (put ',map 'variable-documentation + ,(format "Keymap for `%s'." child))) ,(if declare-syntax `(progn (unless (boundp ',syntax) (put ',syntax 'definition-name ',child)) - (defvar ,syntax (make-syntax-table)))) + (defvar ,syntax (make-syntax-table)) + (unless (get ',syntax 'variable-documentation) + (put ',syntax 'variable-documentation + ,(format "Syntax table for `%s'." child))))) ,(if declare-abbrev `(progn (put ',abbrev 'definition-name ',child) (defvar ,abbrev - (progn (define-abbrev-table ',abbrev nil) ,abbrev)))) + (progn (define-abbrev-table ',abbrev nil) ,abbrev)) + (unless (get ',abbrev 'variable-documentation) + (put ',abbrev 'variable-documentation + ,(format "Abbrev table for `%s'." child))))) (put ',child 'derived-mode-parent ',parent) ,(if group `(put ',child 'custom-mode-group ,group)) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 91dc673f26c..12458f3a6b9 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -1,7 +1,7 @@ ;;; easy-mmode.el --- easy definition for major and minor modes -;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> ;; Maintainer: Stefan Monnier <monnier@gnu.org> @@ -263,8 +263,7 @@ With zero or negative ARG turn mode off. (add-minor-mode ',mode ',lighter ,(if keymap keymap-sym - `(if (boundp ',keymap-sym) - (symbol-value ',keymap-sym))))))) + `(if (boundp ',keymap-sym) ,keymap-sym)))))) ;;; ;;; make global minor mode @@ -453,6 +452,9 @@ Valid keywords and arguments are: ;;;###autoload (defmacro easy-mmode-defmap (m bs doc &rest args) + "Define a constant M whose value is the result of `easy-mmode-define-keymap'. +The M, BS, and ARGS arguments are as per that function. DOC is +the constant's documentation." `(defconst ,m (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) ,doc)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 562a9d7a1c1..fe47074bf97 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -352,8 +352,7 @@ Return the result of the last expression in BODY." (edebug:s-r-end (point-max-marker))) (unwind-protect (progn ,@body) - (save-excursion - (set-buffer (marker-buffer edebug:s-r-beg)) + (with-current-buffer (marker-buffer edebug:s-r-beg) (narrow-to-region edebug:s-r-beg edebug:s-r-end))))) ;;; Display @@ -2579,15 +2578,16 @@ MSG is printed after `::::} '." (edebug-outside-o-a-p overlay-arrow-position) (edebug-outside-o-a-s overlay-arrow-string) (edebug-outside-c-i-e-a cursor-in-echo-area) - (edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows)) + (edebug-outside-d-c-i-n-s-w + (default-value 'cursor-in-non-selected-windows))) (unwind-protect (let ((overlay-arrow-position overlay-arrow-position) (overlay-arrow-string overlay-arrow-string) (cursor-in-echo-area nil) - (default-cursor-in-non-selected-windows t) (unread-command-events unread-command-events) ;; any others?? ) + (setq-default cursor-in-non-selected-windows t) (if (not (buffer-name edebug-buffer)) (let ((debug-on-error nil)) (error "Buffer defining %s not found" edebug-function))) @@ -2782,10 +2782,8 @@ MSG is printed after `::::} '." ;; Restore edebug-buffer's outside point. ;; (edebug-trace "restore edebug-buffer point: %s" ;; edebug-buffer-outside-point) - (let ((current-buffer (current-buffer))) - (set-buffer edebug-buffer) - (goto-char edebug-buffer-outside-point) - (set-buffer current-buffer)) + (with-current-buffer edebug-buffer + (goto-char edebug-buffer-outside-point)) ;; ... nothing more. ) (with-timeout-unsuspend edebug-with-timeout-suspend) @@ -2794,8 +2792,8 @@ MSG is printed after `::::} '." unread-command-events edebug-outside-unread-command-events overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s - cursor-in-echo-area edebug-outside-c-i-e-a - default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) + cursor-in-echo-area edebug-outside-c-i-e-a) + (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) ))) @@ -2851,8 +2849,7 @@ MSG is printed after `::::} '." (let ((edebug-buffer-read-only buffer-read-only) ;; match-data must be done in the outside buffer (edebug-outside-match-data - (save-excursion ; might be unnecessary now?? - (set-buffer edebug-outside-buffer) ; in case match buffer different + (with-current-buffer edebug-outside-buffer ; in case match buffer different (match-data))) ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions)) @@ -3605,8 +3602,8 @@ Return the result of the last expression." (overlay-arrow-position edebug-outside-o-a-p) (overlay-arrow-string edebug-outside-o-a-s) (cursor-in-echo-area edebug-outside-c-i-e-a) - (default-cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) ) + (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) (unwind-protect (save-excursion ; of edebug-buffer (set-buffer edebug-outside-buffer) @@ -3642,14 +3639,16 @@ Return the result of the last expression." edebug-outside-o-a-p overlay-arrow-position edebug-outside-o-a-s overlay-arrow-string edebug-outside-c-i-e-a cursor-in-echo-area - edebug-outside-d-c-i-n-s-w default-cursor-in-non-selected-windows - ) + edebug-outside-d-c-i-n-s-w (default-value + 'cursor-in-non-selected-windows) + ) ;; Restore the outside saved values; don't alter ;; the outside binding loci. (setcdr edebug-outside-pre-command-hook pre-command-hook) (setcdr edebug-outside-post-command-hook post-command-hook) + (setq-default cursor-in-non-selected-windows t) )) ; let )) diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 71ebf79d554..d0661d6f72a 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -34,13 +34,12 @@ (require 'custom) ;;; Compatibility -;; -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'eieio-overlay-lists (lambda () (list (extent-list)))) - (defalias 'eieio-overlay-lists 'overlay-lists) - ) - ) + +;; (eval-and-compile +;; (if (featurep 'xemacs) +;; (defalias 'eieio-overlay-lists (lambda () (list (extent-list)))) +;; (defalias 'eieio-overlay-lists 'overlay-lists))) + ;;; Code: (defclass eieio-widget-test-class nil ((a-string :initarg :a-string @@ -109,14 +108,7 @@ Updates occur regardless of the current customization group.") (defun eieio-slot-value-create (widget) "Create the value of WIDGET." - (let ((chil nil) - ) -; (setq chil (cons (widget-create-child-and-convert -; widget 'visibility -; :help-echo "Hide the value of this option." -; :action 'eieio-custom-toggle-parent -; t) -; chil)) + (let ((chil nil)) (setq chil (cons (widget-create-child-and-convert widget (widget-get widget :childtype) @@ -355,7 +347,7 @@ These groups are specified with the `:group' slot flag." (toggle-read-only -1) (kill-all-local-variables) (erase-buffer) - (let ((all (eieio-overlay-lists))) + (let ((all (overlay-lists))) ;; Delete all the overlays. (mapc 'delete-overlay (car all)) (mapc 'delete-overlay (cdr all))) diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index b6c116e064d..0e74d5d2e55 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -33,26 +33,21 @@ (defun data-debug-insert-object-slots (object prefix) "Insert all the slots of OBJECT. PREFIX specifies what to insert at the start of each line." - (let ((attrprefix (concat (make-string (length prefix) ? ) "] ")) - ) - (data-debug/eieio-insert-slots object attrprefix) - ) - ) + (let ((attrprefix (concat (make-string (length prefix) ? ) "] "))) + (data-debug/eieio-insert-slots object attrprefix))) (defun data-debug-insert-object-slots-from-point (point) "Insert the object slots found at the object button at POINT." (let ((object (get-text-property point 'ddebug)) (indent (get-text-property point 'ddebug-indent)) - start - ) + start) (end-of-line) (setq start (point)) (forward-char 1) (data-debug-insert-object-slots object (concat (make-string indent ? ) "~ ")) - (goto-char start) - )) + (goto-char start))) (defun data-debug-insert-object-button (object prefix prebuttontext) "Insert a button representing OBJECT. @@ -77,9 +72,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." (put-text-property start end 'help-echo tip) (put-text-property start end 'ddebug-function 'data-debug-insert-object-slots-from-point) - (insert "\n") - ) - ) + (insert "\n"))) ;;; METHODS ;; @@ -118,8 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." " ") 'font-lock-keyword-face)) ) - (setq publa (cdr publa) publd (cdr publd))) - ))) + (setq publa (cdr publa) publd (cdr publd)))))) ;;; Augment the Data debug thing display list. (data-debug-add-specialized-thing (lambda (thing) (object-p thing)) diff --git a/lisp/emacs-lisp/eieio-doc.el b/lisp/emacs-lisp/eieio-doc.el deleted file mode 100644 index 35de848c51c..00000000000 --- a/lisp/emacs-lisp/eieio-doc.el +++ /dev/null @@ -1,368 +0,0 @@ -;;; eieio-doc.el --- create texinfo documentation for an eieio class - -;;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2004, 2005 -;;; Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 -;; Keywords: OO, lisp, docs - -;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Outputs into the current buffer documentation in texinfo format - -(require 'eieio-opt) - -;; for a class, all it's children, and all it's slots. - -;;; Code: -(defvar eieiodoc-currently-in-node nil - "String representing the node we go BACK to.") - -(defvar eieiodoc-current-section-level nil - "String represending what type of section header to use.") - -(defvar eieiodoc-prev-class nil - "Non-nil when while `eieiodoc-recurse' is running. -Can be referenced from the recursed function.") - -(defvar eieiodoc-next-class nil - "Non-nil when `eieiodoc-recurse' is running. -Can be referenced from the recursed function.") - -(defun eieiodoc-class-nuke (root-class indexstring &optional skiplist) - "Call `eieiodoc-class' after nuking everything from POINT on. -ROOT-CLASS, INDEXSTRING, and SKIPLIST are the same as `eieiodoc-class'." - (delete-region (point) (point-max)) - (sit-for 0) - (eieiodoc-class root-class indexstring skiplist)) - -(defvar eieiodoc--class-indexstring) -(defvar eieiodoc--class-root) - -(defun eieiodoc-class (root-class indexstring &optional skiplist) - "Create documentation starting with ROOT-CLASS. -The first job is to create an indented menu of all the classes -starting with `root-class' and including all it's children. Once this -is done, @nodes are created for all the subclasses. Each node is then -documented with a description of the class, a brief inheritance tree -\(with xrefs) and a list of all slots in a big table. Where each slot -is inherited from is also documented. In addition, each class is -documented in the index referenced by INDEXSTRING, a two letter code -described in the texinfo manual. - -The optional third argument SKIPLIST is a list of object not to put -into any menus, nodes or lists." - (interactive - (list (intern-soft - (completing-read "Class: " (eieio-build-class-alist) nil t)) - (read-string "Index name (2 chars): "))) - (if (looking-at "[ \t\n]+@end ignore") - (goto-char (match-end 0))) - (save-excursion - (setq eieiodoc-currently-in-node - (if (re-search-backward "@node \\([^,]+\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "Top") - eieiodoc-current-section-level - (if (re-search-forward "@\\(chapter\\|\\(sub\\)*section\\)" - (+ (point) 500) t) - (progn - (goto-char (match-beginning 0)) - (cond ((looking-at "@chapter") "section") - ((looking-at "@section") "subsection") - ((looking-at "@\\(sub\\)+section") "subsubsection") - (t "subsubsection"))) - "subsubsection"))) - (save-excursion - (eieiodoc-main-menu root-class skiplist) - (insert "\n") - (let ((eieiodoc--class-indexstring indexstring) - (eieiodoc--class-root root-class)) - (eieiodoc-recurse root-class 'eieiodoc-one-node nil skiplist)))) - -(defun eieiodoc-main-menu (class skiplist) - "Create a menu of all classes under CLASS indented the correct amount. -SKIPLIST is a list of objects to skip" - (end-of-line) - (insert "\n@menu\n") - (eieiodoc-recurse class (lambda (class level) - (insert "* " (make-string level ? ) - (symbol-name class) " ::\n")) - nil skiplist) - (insert "@end menu\n")) - -(defun eieiodoc-one-node (class level) - "Create a node for CLASS, and for all subclasses of CLASS in order. -This function should only be called by `eieiodoc-class' -Argument LEVEL is the current level of recursion we have hit." - (message "Building node for %s" class) - (insert "\n@node " (symbol-name class) ", " - (if eieiodoc-next-class (symbol-name eieiodoc-next-class) " ") ", " - (if eieiodoc-prev-class (symbol-name eieiodoc-prev-class) " ") ", " - eieiodoc-currently-in-node "\n" - "@comment node-name, next, previous, up\n" - "@" eieiodoc-current-section-level " " (symbol-name class) "\n" - "@" eieiodoc--class-indexstring - "index " (symbol-name class) "\n\n") - ;; Now lets create a nifty little inheritance tree - (let ((cl class) - (revlist nil) - (depth 0)) - (while cl - (setq revlist (cons cl revlist) - cl (class-parent cl))) - (insert "@table @asis\n@item Inheritance Tree:\n") - (while revlist - (insert "@table @code\n@item " - (if (and (child-of-class-p (car revlist) eieiodoc--class-root) - (not (eq class (car revlist)))) - (concat "@w{@xref{" (symbol-name (car revlist)) "}.}") - (symbol-name (car revlist))) - "\n") - (setq revlist (cdr revlist) - depth (1+ depth))) - (let ((clist (reverse (aref (class-v class) class-children)))) - (if (not clist) - (insert "No children") - (insert "@table @asis\n@item Children:\n") - (while clist - (insert "@w{@xref{" (symbol-name (car clist)) "}") - (if (cdr clist) (insert ",") (insert ".")) - (insert "} ") - (setq clist (cdr clist))) - (insert "\n@end table\n") - )) - (while (> depth 0) - (insert "\n@end table\n") - (setq depth (1- depth))) - (insert "@end table\n\n ")) - ;; Now lets build some documentation by extracting information from - ;; the class description vector - (let* ((cv (class-v class)) - (docs (aref cv class-public-doc)) - (names (aref cv class-public-a)) - (deflt (aref cv class-public-d)) - (prot (aref cv class-protection)) - (typev (aref cv class-public-type)) - (i 0) - (set-one nil) - (anchor nil) - ) - ;; doc of the class itself - (insert (eieiodoc-texify-docstring (documentation class) class) - "\n\n@table @asis\n") - (if names - (progn - (setq anchor (point)) - (insert "@item Slots:\n\n@table @code\n") - (while names - (if (eieiodoc-one-attribute class (car names) (car docs) - (car prot) (car deflt) (aref typev i)) - (setq set-one t)) - (setq names (cdr names) - docs (cdr docs) - prot (cdr prot) - deflt (cdr deflt) - i (1+ i))) - (insert "@end table\n\n") - (if (not set-one) (delete-region (point) anchor)) - )) - (insert "@end table\n") - ;; Finally, document all the methods associated with this class. - (let ((methods (eieio-all-generic-functions class)) - (doc nil)) - (if (not methods) nil - (if (string= eieiodoc-current-section-level "subsubsection") - (insert "@" eieiodoc-current-section-level) - (insert "@sub" eieiodoc-current-section-level)) - (insert " Specialized Methods\n\n") - (while methods - (setq doc (eieio-method-documentation (car methods) class)) - (insert "@deffn Method " (symbol-name (car methods))) - (if (not doc) - (insert "\n Undocumented") - (if (car doc) - (progn - (insert " :BEFORE ") - (eieiodoc-output-deffn-args (car (car doc))) - (insert "\n") - (eieiodoc-insert-and-massage-docstring-with-args - (cdr (car doc)) (car (car doc)) class))) - (setq doc (cdr doc)) - (if (car doc) - (progn - (insert " :PRIMARY ") - (eieiodoc-output-deffn-args (car (car doc))) - (insert "\n") - (eieiodoc-insert-and-massage-docstring-with-args - (cdr (car doc)) (car (car doc)) class))) - (setq doc (cdr doc)) - (if (car doc) - (progn - (insert " :AFTER ") - (eieiodoc-output-deffn-args (car (car doc))) - (insert "\n") - (eieiodoc-insert-and-massage-docstring-with-args - (cdr (car doc)) (car (car doc)) class))) - (insert "\n@end deffn\n\n")) - (setq methods (cdr methods))))) - )) - -(defun eieiodoc-insert-and-massage-docstring-with-args (doc arglst class) - "Update DOC with texinfo strings using ARGLST with @var. -Argument CLASS is the class passed to `eieiodoc-texify-docstring'." - (let ((start (point)) - (end nil) - (case-fold-search nil)) - ;; Insert the text - (insert (eieiodoc-texify-docstring doc class)) - (setq end (point)) - (save-restriction - (narrow-to-region start end) - (save-excursion - ;; Now find arguments - (while arglst - (goto-char (point-min)) - (while (re-search-forward (upcase (symbol-name (car arglst))) nil t) - (replace-match "@var{\\&}" t)) - (setq arglst (cdr arglst))))))) - -(defun eieiodoc-output-deffn-args (arglst) - "Output ARGLST for a deffn." - (while arglst - (insert (symbol-name (car arglst)) " ") - (setq arglst (cdr arglst)))) - -(defun eieiodoc-one-attribute (class attribute doc priv deflt type) - "Create documentation of CLASS for a single ATTRIBUTE. -Assume this attribute is inside a table, so it is initiated with the -@item indicator. If this attribute is not inserted (because it is -contained in the parent) then return nil, else return t. -DOC is the documentation to use, PRIV is non-nil if it is a private slot, -and DEFLT is the default value. TYPE is the symbol describing what type -validation is done on that slot." - (let ((pv (eieiodoc-parent-diff class attribute)) - (ia (eieio-attribute-to-initarg class attribute)) - (set-me nil)) - (if (or (eq pv t) (not ia)) - nil ;; same in parent or no init arg - (setq set-me t) - (insert "@item " (if priv "Private: " "") - (symbol-name ia)) - (if (and type (not (eq type t))) - (insert "\nType: @code{" (format "%S" type) "}")) - (if (not (eq deflt eieio-unbound)) - (insert " @*\nDefault Value: @code{"(format "%S" deflt) "}")) - (insert "\n\n") - (if (eq pv 'default) - ;; default differs only, xref the parent - ;; This should be upgraded to actually search for the last - ;; differing default (or the original.) - (insert "@xref{" (symbol-name (class-parent class)) "}.\n") - (insert (if doc (eieiodoc-texify-docstring doc class) "Not Documented") - "\n@refill\n\n"))) - set-me)) -;;; -;; Utilities -;; -(defun eieiodoc-recurse (rclass func &optional level skiplist) - "Recurse down all children of RCLASS, calling FUNC on each one. -LEVEL indicates the current depth below the first call we are. The -function FUNC will be called with RCLASS and LEVEL. This will then -recursivly call itself once for each child class of RCLASS. The -optional fourth argument SKIPLIST is a list of objects to ignore while -recursing." - - (if (not level) (setq level 0)) - - ;; we reverse the children so they appear in the same order as it - ;; does in the code that creates them. - (let* ((children (reverse (aref (class-v rclass) class-children))) - (ocnc eieiodoc-next-class) - (eieiodoc-next-class (or (car children) ocnc)) - (eieiodoc-prev-class eieiodoc-prev-class)) - - (if (not (member rclass skiplist)) - (progn - (apply func (list rclass level)) - - (setq eieiodoc-prev-class rclass))) - - (while children - (setq eieiodoc-next-class (or (car (cdr children)) ocnc)) - (setq eieiodoc-prev-class (eieiodoc-recurse (car children) func (1+ level))) - (setq children (cdr children))) - ;; return the previous class so that the prev/next node gets it right - eieiodoc-prev-class)) - -(defun eieiodoc-parent-diff (class slot) - "Return nil if the parent of CLASS does not have slot SLOT. -Return t if it does, and return 'default if the default has changed." - (let ((df nil) (err t) - (scoped-class (class-parent class)) - (eieio-skip-typecheck)) - (condition-case nil - (setq df (eieio-oref-default (class-parent class) slot) - err nil) - (invalid-slot-name (setq df nil)) - (error (setq df nil))) - (if err - nil - (if (equal df (eieio-oref-default class slot)) - t - 'default)))) - -(defun eieiodoc-texify-docstring (string class) - "Take STRING, (a normal doc string), and convert it into a texinfo string. -For instances where CLASS is the class being referenced, do not Xref -that class. - - `function' => @dfn{function} - `variable' => @code{variable} - `class' => @code{class} @xref{class} - `unknown' => @code{unknonwn} - 'quoteme => @code{quoteme} - non-nil => non-@code{nil} - t => @code{t} - :tag => @code{:tag} - [ stuff ] => @code{[ stuff ]} - Key => @kbd{Key}" - (while (string-match "`\\([-a-zA-Z0-9]+\\)'" string) - (let* ((vs (substring string (match-beginning 1) (match-end 1))) - (v (intern-soft vs))) - (setq string - (concat - (replace-match (concat - (if (and (not (class-p v))(fboundp v)) - "@dfn{" "@code{") - vs "}" - (if (and (class-p v) (not (eq v class))) - (concat " @xref{" vs "}."))) - nil t string))))) - (while (string-match "\\( \\|^\\|-\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([ ,]\\|$\\)" string) - (setq string (replace-match "@code{\\2}" t nil string 2))) - (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string) - (setq string (replace-match "@code{\\2}" t nil string 2))) - (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|$\\)" string) - (setq string (replace-match "@kbd{\\2}" t nil string 2))) - string) - -(provide 'eieio-doc) - -;;; eieio-doc.el ends here diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index db39909c998..846ea61da34 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -70,9 +70,9 @@ Argument CH-PREFIX is another character prefix to display." )) ;;; CLASS COMPLETION / DOCUMENTATION -;;;###autoload + (defalias 'describe-class 'eieio-describe-class) -;;;###autoload + (defun eieio-describe-class (class &optional headerfcn) "Describe a CLASS defined by a string or symbol. If CLASS is actually an object, then also display current values of that obect. @@ -300,14 +300,11 @@ are not abstract." (or histvar 'eieio-read-class)))) ;;; METHOD COMPLETION / DOC -;; -;;;###autoload + (defalias 'describe-method 'eieio-describe-generic) -;;;###autoload (defalias 'describe-generic 'eieio-describe-generic) -;;;###autoload (defalias 'eieio-describe-method 'eieio-describe-generic) -;;;###autoload + (defun eieio-describe-generic (generic) "Describe the generic function GENERIC. Also extracts information about all methods specific to this generic." diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index ff7dc823430..bd318278018 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -40,11 +40,12 @@ ;;; Code: +(require 'cl) +(eval-when-compile (require 'eieio-comp)) + (defvar eieio-version "1.2" "Current version of EIEIO.") -(require 'cl) - (defun eieio-version () "Display the current version of EIEIO." (interactive) @@ -172,9 +173,6 @@ Stored outright without modifications or stripping.") (autoload 'byte-compile-file-form-defmethod "eieio-comp" "This function is used to byte compile methods in a nice way.") (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) - -(eval-when-compile (require 'eieio-comp)) - ;;; Important macros used in eieio. ;; @@ -192,7 +190,6 @@ CLASS is a symbol." (eq (aref (class-v ,class) 0) 'defclass) (error nil))) -;;;###autoload (defmacro eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." `(condition-case nil @@ -332,6 +329,7 @@ wish, and reference them using the function `class-option'." (defvar eieio-defclass-autoload-map (make-vector 7 nil) "Symbol map of superclasses we find in autoloads.") +;; We autoload this because it's used in `make-autoload'. ;;;###autoload (defun eieio-defclass-autoload (cname superclasses filename doc) "Create autoload symbols for the EIEIO class CNAME. @@ -2736,19 +2734,6 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." ) ) -(eval-after-load "cedet-edebug" - '(progn - (cedet-edebug-add-print-override '(class-p object) '(class-name object) ) - (cedet-edebug-add-print-override '(eieio-object-p object) '(object-print object) ) - (cedet-edebug-add-print-override '(and (listp object) - (or (class-p (car object)) (eieio-object-p (car object)))) - '(cedet-edebug-prin1-recurse object) ) - )) - -;; Done in cedet/data-debug.el: -;; (eval-after-load "data-debug" -;; '(require 'eieio-datadebug)) - ;;; Interfacing with imenu in emacs lisp mode ;; (Only if the expression is defined) ;; @@ -2782,28 +2767,13 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." (autoload 'describe-class "eieio-opt" "Describe CLASS defined by a string or symbol" t) (autoload 'eieio-describe-generic "eieio-opt" "Describe GENERIC defined by a string or symbol" t) (autoload 'describe-generic "eieio-opt" "Describe GENERIC defined by a string or symbol" t) -(autoload 'eieiodoc-class "eieio-doc" "Create texinfo documentation about a class hierarchy." t) (autoload 'customize-object "eieio-custom" "Create a custom buffer editing OBJ.") -;; make sure this shows up after the help mode hook. -(add-hook 'temp-buffer-show-hook 'eieio-help-mode-augmentation-maybee t) -;; (require 'advice) -;; (defadvice describe-variable (around eieio-describe activate) -;; "Display the full documentation of FUNCTION (a symbol). -;; Returns the documentation as a string, also." -;; (if (class-p (ad-get-arg 0)) -;; (eieio-describe-class (ad-get-arg 0)) -;; ad-do-it)) - -;; (defadvice describe-function (around eieio-describe activate) -;; "Display the full documentation of VARIABLE (a symbol). -;; Returns the documentation as a string, also." -;; (if (generic-p (ad-get-arg 0)) -;; (eieio-describe-generic (ad-get-arg 0)) -;; (if (class-p (ad-get-arg 0)) -;; (eieio-describe-constructor (ad-get-arg 0)) -;; ad-do-it))) - (provide 'eieio) + +;; Local variables: +;; byte-compile-warnings: (not cl-functions) +;; End: + ;;; eieio ends here diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index d144a66a61a..27e7a7f293a 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -38,37 +38,118 @@ ;;; To do: -;; * List of variables and functions defined in dumped lisp files. ;; * Adding type checking. (Stop that sniggering!) +;; * Make eval-when-compile be sensitive to the difference between +;; funcs and macros. +;; * Requires within function bodies. +;; * Handle defstruct. +;; * Prevent recursive requires. ;;; Code: -(defvar elint-log-buffer "*Elint*" - "*The buffer to insert lint messages in.") +(defgroup elint nil + "Linting for Emacs Lisp." + :prefix "elint-" + :group 'maint) + +(defcustom elint-log-buffer "*Elint*" + "The buffer in which to log lint messages." + :type 'string + :safe 'stringp + :group 'elint) + +(defcustom elint-scan-preloaded t + "Non-nil means to scan `preloaded-file-list' when initializing. +Otherwise, just scan the DOC file for functions and variables. +This is faster, but less accurate, since it misses undocumented features. +This may result in spurious warnings about unknown functions, etc." + :type 'boolean + :safe 'booleanp + :group 'elint + :version "23.2") + +(defcustom elint-ignored-warnings nil + "If non-nil, a list of issue types that Elint should ignore. +This is useful if Elint has trouble understanding your code and +you need to suppress lots of spurious warnings. The valid list elements +are as follows, and suppress messages about the indicated features: + undefined-functions - calls to unknown functions + unbound-reference - reference to unknown variables + unbound-assignment - assignment to unknown variables + macro-expansions - failure to expand macros + empty-let - let-bindings with empty variable lists" + :type '(choice (const :tag "Don't suppress any warnings" nil) + (repeat :tag "List of issues to ignore" + (choice (const undefined-functions + :tag "Calls to unknown functions") + (const unbound-reference + :tag "Reference to unknown variables") + (const unbound-assignment + :tag "Assignment to unknown variables") + (const macro-expansion + :tag "Failure to expand macros") + (const empty-let + :tag "Let-binding with empty varlist")))) + :safe (lambda (value) (or (null value) + (and (listp value) + (equal value + (mapcar + (lambda (e) + (if (memq e + '(undefined-functions + unbound-reference + unbound-assignment + macro-expansion + empty-let)) + e)) + value))))) + :version "23.2" + :group 'elint) + +(defcustom elint-directory-skip-re "\\(ldefs-boot\\|loaddefs\\)\\.el\\'" + "If nil, a regexp matching files to skip when linting a directory." + :type '(choice (const :tag "Lint all files" nil) + (regexp :tag "Regexp to skip")) + :safe 'string-or-null-p + :group 'elint + :version "23.2") ;;; ;;; Data ;;; - ;; FIXME does this serve any useful purpose now elint-builtin-variables exists? (defconst elint-standard-variables '(local-write-file-hooks vc-mode) "Standard buffer local variables, excluding `elint-builtin-variables'.") (defvar elint-builtin-variables nil - "List of built-in variables. Set by `elint-initialize'.") + "List of built-in variables. Set by `elint-initialize'. +This is actually all those documented in the DOC file, which includes +built-in variables and those from dumped Lisp files.") (defvar elint-autoloaded-variables nil "List of `loaddefs.el' variables. Set by `elint-initialize'.") -;; FIXME dumped variables and functions. +(defvar elint-preloaded-env nil + "Environment defined by the preloaded (dumped) Lisp files. +Set by `elint-initialize', if `elint-scan-preloaded' is non-nil.") -(defconst elint-unknown-builtin-args nil +(defconst elint-unknown-builtin-args + ;; encode-time allows extra arguments for use with decode-time. + ;; For some reason, some people seem to like to use them in other cases. + '((encode-time second minute hour day month year &rest zone)) "Those built-ins for which we can't find arguments, if any.") -(defconst elint-extra-errors '(file-locked file-supersession ftp-error) +(defvar elint-extra-errors '(file-locked file-supersession ftp-error) "Errors without error-message or error-confitions properties.") +(defconst elint-preloaded-skip-re + (regexp-opt '("loaddefs.el" "loadup.el" "cus-start" "language/" + "eucjp-ms" "mule-conf" "/characters" "/charprop" + "cp51932")) + "Regexp matching elements of `preloaded-file-list' to ignore. +We ignore them because they contain no definitions of use to Elint.") + ;;; ;;; ADT: top-form ;;; @@ -152,6 +233,54 @@ This environment can be passed to `macroexpand'." ;;; ;;;###autoload +(defun elint-file (file) + "Lint the file FILE." + (interactive "fElint file: ") + (setq file (expand-file-name file)) + (or elint-builtin-variables + (elint-initialize)) + (let ((dir (file-name-directory file))) + (let ((default-directory dir)) + (elint-display-log)) + (elint-set-mode-line t) + (with-current-buffer elint-log-buffer + (unless (string-equal default-directory dir) + (elint-log-message (format " \nLeaving directory `%s'" + default-directory) t) + (elint-log-message (format "Entering directory `%s'" dir) t) + (setq default-directory dir)))) + (let ((str (format "Linting file %s" file))) + (message "%s..." str) + (or noninteractive + (elint-log-message (format " \n%s at %s" str (current-time-string)) t)) + ;; elint-current-buffer clears log. + (with-temp-buffer + (insert-file-contents file) + (let ((buffer-file-name file) + (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))) + (with-syntax-table emacs-lisp-mode-syntax-table + (mapc 'elint-top-form (elint-update-env))))) + (elint-set-mode-line) + (message "%s...done" str))) + +;; cf byte-recompile-directory. +;;;###autoload +(defun elint-directory (directory) + "Lint all the .el files in DIRECTORY. +A complicated directory may require a lot of memory." + (interactive "DElint directory: ") + (let ((elint-running t)) + (dolist (file (directory-files directory t)) + ;; Bytecomp has emacs-lisp-file-regexp. + (when (and (string-match "\\.el\\'" file) + (file-readable-p file) + (not (auto-save-file-name-p file))) + (if (string-match elint-directory-skip-re file) + (message "Skipping file %s" file) + (elint-file file))))) + (elint-set-mode-line)) + +;;;###autoload (defun elint-current-buffer () "Lint the current buffer. If necessary, this first calls `elint-initalize'." @@ -161,12 +290,14 @@ If necessary, this first calls `elint-initalize'." (elint-clear-log (format "Linting %s" (or (buffer-file-name) (buffer-name)))) (elint-display-log) + (elint-set-mode-line t) (mapc 'elint-top-form (elint-update-env)) ;; Tell the user we're finished. This is terribly klugy: we set - ;; elint-top-form-logged so elint-log-message doesn't print the - ;; ** top form ** header... - (let ((elint-top-form-logged t)) - (elint-log-message "\nLinting finished.\n"))) + ;; elint-top-form-logged so elint-log-message doesn't print the + ;; ** top form ** header... + (elint-set-mode-line) + (elint-log-message "\nLinting finished.\n" t)) + ;;;###autoload (defun elint-defun () @@ -199,6 +330,12 @@ Will be local in linted buffers.") "The last time the buffers env was updated. Is measured in buffer-modified-ticks and is local in linted buffers.") +;; This is a minor optimization. It is local to every buffer, and so +;; does not prevent recursive requirs. It does not list the requires +;; of requires. +(defvar elint-features nil + "List of all libraries this buffer has required, or that have been provided.") + (defun elint-update-env () "Update the elint environment in the current buffer. Don't do anything if the buffer hasn't been changed since this @@ -212,26 +349,37 @@ Returns the forms." elint-buffer-forms ;; Remake env (set (make-local-variable 'elint-buffer-forms) (elint-get-top-forms)) + (set (make-local-variable 'elint-features) nil) (set (make-local-variable 'elint-buffer-env) (elint-init-env elint-buffer-forms)) + (if elint-preloaded-env + (elint-env-add-env elint-preloaded-env elint-buffer-env)) (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick)) elint-buffer-forms)) (defun elint-get-top-forms () "Collect all the top forms in the current buffer." (save-excursion - (let ((tops nil)) + (let (tops) (goto-char (point-min)) (while (elint-find-next-top-form) - (let ((pos (point))) - (condition-case nil - (setq tops (cons - (elint-make-top-form (read (current-buffer)) pos) - tops)) - (end-of-file - (goto-char pos) - (error "Missing ')' in top form: %s" - (buffer-substring pos (line-end-position))))))) + (let ((elint-current-pos (point))) + ;; non-list check could be here too. errors may be out of seq. + ;; quoted check cannot be elsewhere, since quotes skipped. + (if (looking-back "'") + ;; Eg cust-print.el uses ' as a comment syntax. + (elint-warning "Skipping quoted form `'%.20s...'" + (read (current-buffer))) + (condition-case nil + (setq tops (cons + (elint-make-top-form (read (current-buffer)) + elint-current-pos) + tops)) + (end-of-file + (goto-char elint-current-pos) + (error "Missing ')' in top form: %s" + (buffer-substring elint-current-pos + (line-end-position)))))))) (nreverse tops)))) (defun elint-find-next-top-form () @@ -240,6 +388,81 @@ Return nil if there are no more forms, t otherwise." (parse-partial-sexp (point) (point-max) nil t) (not (eobp))) +(defvar env) ; from elint-init-env + +(defun elint-init-form (form) + "Process FORM, adding to ENV if recognized." + (cond + ;; Eg nnmaildir seems to use [] as a form of comment syntax. + ((not (listp form)) + (elint-warning "Skipping non-list form `%s'" form)) + ;; Add defined variable + ((memq (car form) '(defvar defconst defcustom)) + (setq env (elint-env-add-var env (cadr form)))) + ;; Add function + ((memq (car form) '(defun defsubst)) + (setq env (elint-env-add-func env (cadr form) (nth 2 form)))) + ;; FIXME needs a handler to say second arg is not a variable when we come + ;; to scan the form. + ((eq (car form) 'define-derived-mode) + (setq env (elint-env-add-func env (cadr form) ()) + env (elint-env-add-var env (cadr form)) + env (elint-env-add-var env (intern (format "%s-map" (cadr form)))))) + ((eq (car form) 'define-minor-mode) + (setq env (elint-env-add-func env (cadr form) '(&optional arg)) + ;; FIXME mode map? + env (elint-env-add-var env (cadr form)))) + ((and (eq (car form) 'easy-menu-define) + (cadr form)) + (setq env (elint-env-add-func env (cadr form) '(event)) + env (elint-env-add-var env (cadr form)))) + ;; FIXME it would be nice to check the autoloads are correct. + ((eq (car form) 'autoload) + (setq env (elint-env-add-func env (cadr (cadr form)) 'unknown))) + ((eq (car form) 'declare-function) + (setq env (elint-env-add-func env (cadr form) + (if (or (< (length form) 4) + (eq (nth 3 form) t)) + 'unknown + (nth 3 form))))) + ((and (eq (car form) 'defalias) (listp (nth 2 form))) + ;; If the alias points to something already in the environment, + ;; add the alias to the environment with the same arguments. + ;; FIXME symbol-function, eg backquote.el? + (let ((def (elint-env-find-func env (cadr (nth 2 form))))) + (setq env (elint-env-add-func env (cadr (cadr form)) + (if def (cadr def) 'unknown))))) + ;; Add macro, both as a macro and as a function + ((eq (car form) 'defmacro) + (setq env (elint-env-add-macro env (cadr form) + (cons 'lambda (cddr form))) + env (elint-env-add-func env (cadr form) (nth 2 form)))) + ((and (eq (car form) 'put) + (= 4 (length form)) + (eq (car-safe (cadr form)) 'quote) + (equal (nth 2 form) '(quote error-conditions))) + (set (make-local-variable 'elint-extra-errors) + (cons (cadr (cadr form)) elint-extra-errors))) + ((eq (car form) 'provide) + (add-to-list 'elint-features (eval (cadr form)))) + ;; Import variable definitions + ((memq (car form) '(require cc-require cc-require-when-compile)) + (let ((name (eval (cadr form))) + (file (eval (nth 2 form))) + (elint-doing-cl (bound-and-true-p elint-doing-cl))) + (unless (memq name elint-features) + (add-to-list 'elint-features name) + ;; cl loads cl-macs in an opaque manner. + ;; Since cl-macs requires cl, we can just process cl-macs. + (and (eq name 'cl) (not elint-doing-cl) + ;; We need cl if elint-form is to be able to expand cl macros. + (require 'cl) + (setq name 'cl-macs + file nil + elint-doing-cl t)) ; blech + (setq env (elint-add-required-env env name file)))))) + env) + (defun elint-init-env (forms) "Initialize the environment from FORMS." (let ((env (elint-make-env)) @@ -247,38 +470,14 @@ Return nil if there are no more forms, t otherwise." (while forms (setq form (elint-top-form-form (car forms)) forms (cdr forms)) - (cond - ;; Add defined variable - ((memq (car form) '(defvar defconst defcustom)) - (setq env (elint-env-add-var env (cadr form)))) - ;; Add function - ((memq (car form) '(defun defsubst)) - (setq env (elint-env-add-func env (cadr form) (nth 2 form)))) - ;; FIXME it would be nice to check the autoloads are correct. - ((eq (car form) 'autoload) - (setq env (elint-env-add-func env (cadr (cadr form)) 'unknown))) - ((eq (car form) 'declare-function) - (setq env (elint-env-add-func env (cadr form) - (if (> (length form) 3) - (nth 3 form) - 'unknown)))) - ((eq (car form) 'defalias) - ;; If the alias points to something already in the environment, - ;; add the alias to the environment with the same arguments. - (let ((def (elint-env-find-func env (cadr (nth 2 form))))) - ;; FIXME warn if the alias target is unknown. - (setq env (elint-env-add-func env (cadr (cadr form)) - (if def (cadr def) 'unknown))))) - ;; Add macro, both as a macro and as a function - ((eq (car form) 'defmacro) - (setq env (elint-env-add-macro env (cadr form) - (cons 'lambda (cddr form))) - env (elint-env-add-func env (cadr form) (nth 2 form)))) - ;; Import variable definitions - ((eq (car form) 'require) - (let ((name (eval (cadr form))) - (file (eval (nth 2 form)))) - (setq env (elint-add-required-env env name file)))))) + ;; FIXME eval-when-compile should be treated differently (macros). + ;; Could bind something that makes elint-init-form only check + ;; defmacros. + (if (memq (car-safe form) + '(eval-and-compile eval-when-compile progn prog1 prog2 + with-no-warnings)) + (mapc 'elint-init-form (cdr form)) + (elint-init-form form))) env)) (defun elint-add-required-env (env name file) @@ -292,15 +491,24 @@ Return nil if there are no more forms, t otherwise." (lib1 (locate-library (concat libname ".el") t)) (lib (or lib1 (locate-library libname t)))) ;; Clear the messages :-/ - (message nil) + ;; (Messes up the "Initializing elint..." message.) +;;; (message nil) (if lib (save-excursion + ;; FIXME this doesn't use a temp buffer, because it + ;; stores the result in buffer-local variables so that + ;; it can be reused. (set-buffer (find-file-noselect lib)) (elint-update-env) (setq env (elint-env-add-env env elint-buffer-env))) - (error "Dummy error"))) + ;;; (with-temp-buffer + ;;; (insert-file-contents lib) + ;;; (with-syntax-table emacs-lisp-mode-syntax-table + ;;; (elint-update-env)) + ;;; (setq env (elint-env-add-env env elint-buffer-env)))) + ;;(message "Elint processed (require '%s)" name)) + (error "Unable to find require'd library %s" name))) (error - (ding) (message "Can't get variables from require'd library %s" name))) env) @@ -326,10 +534,12 @@ Return nil if there are no more forms, t otherwise." (let* . elint-check-let-form) (setq . elint-check-setq-form) (quote . elint-check-quote-form) + (function . elint-check-quote-form) (cond . elint-check-cond-form) (lambda . elint-check-defun-form) (function . elint-check-function-form) (setq-default . elint-check-setq-form) + (defalias . elint-check-defalias-form) (defun . elint-check-defun-form) (defsubst . elint-check-defun-form) (defmacro . elint-check-defun-form) @@ -337,16 +547,22 @@ Return nil if there are no more forms, t otherwise." (defconst . elint-check-defvar-form) (defcustom . elint-check-defcustom-form) (macro . elint-check-macro-form) - (condition-case . elint-check-condition-case-form)) + (condition-case . elint-check-condition-case-form) + (if . elint-check-conditional-form) + (when . elint-check-conditional-form) + (unless . elint-check-conditional-form) + (and . elint-check-conditional-form) + (or . elint-check-conditional-form)) "Functions to call when some special form should be linted.") -(defun elint-form (form env) +(defun elint-form (form env &optional nohandler) "Lint FORM in the environment ENV. -The environment created by the form is returned." +Optional argument NOHANDLER non-nil means ignore `elint-special-forms'. +Returns the environment created by the form." (cond ((consp form) (let ((func (cdr (assq (car form) elint-special-forms)))) - (if func + (if (and func (not nohandler)) ;; Special form (funcall func form env) @@ -356,7 +572,8 @@ The environment created by the form is returned." (cond ((eq args 'undefined) (setq argsok nil) - (elint-error "Call to undefined function: %s" form)) + (or (memq 'undefined-functions elint-ignored-warnings) + (elint-error "Call to undefined function: %s" func))) ((eq args 'unknown) nil) @@ -371,7 +588,9 @@ The environment created by the form is returned." (elint-form (macroexpand form (elint-env-macro-env env)) env) (error - (elint-error "Elint failed to expand macro: %s" form))) + (or (memq 'macro-expansion elint-ignored-warnings) + (elint-error "Elint failed to expand macro: %s" func)) + env)) env) (let ((fcode (if (symbolp func) @@ -387,9 +606,10 @@ The environment created by the form is returned." (elint-forms (cdr form) env)))))))) ((symbolp form) ;; :foo variables are quoted - (if (and (/= (aref (symbol-name form) 0) ?:) - (elint-unbound-variable form env)) - (elint-warning "Reference to unbound symbol: %s" form)) + (and (/= (aref (symbol-name form) 0) ?:) + (not (memq 'unbound-reference elint-ignored-warnings)) + (elint-unbound-variable form env) + (elint-warning "Reference to unbound symbol: %s" form)) env) (t env))) @@ -397,12 +617,20 @@ The environment created by the form is returned." (defun elint-forms (forms env) "Lint the FORMS, accumulating an environment, starting with ENV." ;; grumblegrumbletailrecursiongrumblegrumble - (dolist (f forms env) - (setq env (elint-form f env)))) + (if (listp forms) + (dolist (f forms env) + (setq env (elint-form f env))) + ;; Loop macro? + (elint-error "Elint failed to parse form: %s" forms) + env)) + +(defvar elint-bound-variable nil + "Name of a temporarily bound symbol.") (defun elint-unbound-variable (var env) "T if VAR is unbound in ENV." (not (or (memq var '(nil t)) + (eq var elint-bound-variable) (elint-env-find-var env var) (memq var elint-builtin-variables) (memq var elint-autoloaded-variables) @@ -439,6 +667,9 @@ The environment created by the form is returned." t))) ok)) +(defvar elint-bound-function nil + "Name of a temporarily bound function symbol.") + (defun elint-get-args (func env) "Find the args of FUNC in ENV. Returns `unknown' if we couldn't find arguments." @@ -446,13 +677,15 @@ Returns `unknown' if we couldn't find arguments." (if f (cadr f) (if (symbolp func) - (if (fboundp func) - (let ((fcode (indirect-function func))) - (if (subrp fcode) - ;; FIXME builtins with no args have args = nil. - (or (get func 'elint-args) 'unknown) - (elint-find-args-in-code fcode))) - 'undefined) + (if (eq func elint-bound-function) + 'unknown + (if (fboundp func) + (let ((fcode (indirect-function func))) + (if (subrp fcode) + ;; FIXME builtins with no args have args = nil. + (or (get func 'elint-args) 'unknown) + (elint-find-args-in-code fcode))) + 'undefined)) (elint-find-args-in-code func))))) (defun elint-find-args-in-code (code) @@ -473,10 +706,25 @@ CODE can be a lambda expression, a macro, or byte-compiled code." (defun elint-check-cond-form (form env) "Lint a cond FORM in ENV." - (dolist (f (cdr form) env) + (dolist (f (cdr form)) (if (consp f) - (elint-forms f env) - (elint-error "cond clause should be a list: %s" f)))) + (let ((test (car f))) + (cond ((equal test '(featurep (quote xemacs)))) + ((equal test '(not (featurep (quote emacs))))) + ;; FIXME (and (boundp 'foo) + ((and (eq (car-safe test) 'fboundp) + (= 2 (length test)) + (eq (car-safe (cadr test)) 'quote)) + (let ((elint-bound-function (cadr (cadr test)))) + (elint-forms f env))) + ((and (eq (car-safe test) 'boundp) + (= 2 (length test)) + (eq (car-safe (cadr test)) 'quote)) + (let ((elint-bound-variable (cadr (cadr test)))) + (elint-forms f env))) + (t (elint-forms f env)))) + (elint-error "cond clause should be a list: %s" f))) + env) (defun elint-check-defun-form (form env) "Lint a defun/defmacro/lambda FORM in ENV." @@ -487,12 +735,30 @@ CODE can be a lambda expression, a macro, or byte-compiled code." (car form)) (elint-forms (cdr form) env)) +(defun elint-check-defalias-form (form env) + "Lint a defalias FORM in ENV." + (let ((alias (cadr form)) + (target (nth 2 form))) + (and (eq (car-safe alias) 'quote) + (eq (car-safe target) 'quote) + (eq (elint-get-args (cadr target) env) 'undefined) + (elint-warning "Alias `%s' has unknown target `%s'" + (cadr alias) (cadr target)))) + (elint-form form env t)) + (defun elint-check-let-form (form env) "Lint the let/let* FORM in ENV." (let ((varlist (cadr form))) (if (not varlist) - (progn - (elint-error "Missing varlist in let: %s" form) + (if (> (length form) 2) + ;; An empty varlist is not really an error. Eg some cl macros + ;; can expand to such a form. + (progn + (or (memq 'empty-let elint-ignored-warnings) + (elint-warning "Empty varlist in let: %s" form)) + ;; Lint the body forms + (elint-forms (cddr form) env)) + (elint-error "Malformed let: %s" form) env) ;; Check for (let (a (car b)) ...) type of error (if (and (= (length varlist) 2) @@ -523,7 +789,8 @@ CODE can be a lambda expression, a macro, or byte-compiled code." (defun elint-check-setq-form (form env) "Lint the setq FORM in ENV." (or (= (mod (length form) 2) 1) - (elint-error "Missing value in setq: %s" form)) + ;; (setq foo) is valid and equivalent to (setq foo nil). + (elint-warning "Missing value in setq: %s" form)) (let ((newenv env) sym val) (setq form (cdr form)) @@ -532,8 +799,9 @@ CODE can be a lambda expression, a macro, or byte-compiled code." val (car (cdr form)) form (cdr (cdr form))) (if (symbolp sym) - (if (elint-unbound-variable sym newenv) - (elint-warning "Setting previously unbound symbol: %s" sym)) + (and (not (memq 'unbound-assignment elint-ignored-warnings)) + (elint-unbound-variable sym newenv) + (elint-warning "Setting previously unbound symbol: %s" sym)) (elint-error "Setting non-symbol in setq: %s" sym)) (elint-form val newenv) (if (symbolp sym) @@ -544,7 +812,8 @@ CODE can be a lambda expression, a macro, or byte-compiled code." "Lint the defvar/defconst FORM in ENV." (if (or (= (length form) 2) (= (length form) 3) - (and (= (length form) 4) (stringp (nth 3 form)))) + ;; Eg the defcalcmodevar macro can expand with a nil doc-string. + (and (= (length form) 4) (string-or-null-p (nth 3 form)))) (elint-env-add-global-var (elint-form (nth 2 form) env) (car (cdr form))) (elint-error "Malformed variable declaration: %s" form) @@ -566,6 +835,8 @@ CODE can be a lambda expression, a macro, or byte-compiled code." (cond ((symbolp func) (or (elint-env-find-func env func) + ;; FIXME potentially bogus, since it uses the current + ;; environment rather than a clean one. (fboundp func) (elint-warning "Reference to undefined function: %s" form)) env) @@ -610,6 +881,72 @@ CODE can be a lambda expression, a macro, or byte-compiled code." (elint-forms (cdr err) newenv)))) resenv)) +;; For the featurep parts, an alternative is to have +;; elint-get-top-forms skip the irrelevant branches. +(defun elint-check-conditional-form (form env) + "Check the when/unless/and/or FORM in ENV. +Does basic handling of `featurep' tests." + (let ((func (car form)) + (test (cadr form)) + sym) + ;; Misses things like (and t (featurep 'xemacs)) + ;; Check byte-compile-maybe-guarded. + (cond ((and (memq func '(when and)) + (eq (car-safe test) 'boundp) + (= 2 (length test)) + (eq (car-safe (cadr test)) 'quote)) + ;; Cf elint-check-let-form, which modifies the whole ENV. + (let ((elint-bound-variable (cadr (cadr test)))) + (elint-form form env t))) + ((and (memq func '(when and)) + (eq (car-safe test) 'fboundp) + (= 2 (length test)) + (eq (car-safe (cadr test)) 'quote)) + (let ((elint-bound-function (cadr (cadr test)))) + (elint-form form env t))) + ;; Let's not worry about (if (not (boundp... + ((and (eq func 'if) + (eq (car-safe test) 'boundp) + (= 2 (length test)) + (eq (car-safe (cadr test)) 'quote)) + (let ((elint-bound-variable (cadr (cadr test)))) + (elint-form (nth 2 form) env)) + (dolist (f (nthcdr 3 form)) + (elint-form f env))) + ((and (eq func 'if) + (eq (car-safe test) 'fboundp) + (= 2 (length test)) + (eq (car-safe (cadr test)) 'quote)) + (let ((elint-bound-function (cadr (cadr test)))) + (elint-form (nth 2 form) env)) + (dolist (f (nthcdr 3 form)) + (elint-form f env))) + ((and (memq func '(when and)) ; skip all + (or (null test) + (member test '((featurep (quote xemacs)) + (not (featurep (quote emacs))))) + (and (eq (car-safe test) 'and) + (equal (car-safe (cdr test)) + '(featurep (quote xemacs))))))) + ((and (memq func '(unless or)) + (equal test '(featurep (quote emacs))))) + ((and (eq func 'if) + (or (null test) ; eg custom-browse-insert-prefix + (member test '((featurep (quote xemacs)) + (not (featurep (quote emacs))))) + (and (eq (car-safe test) 'and) + (equal (car-safe (cdr test)) + '(featurep (quote xemacs)))))) + (dolist (f (nthcdr 3 form)) + (elint-form f env))) ; lint the else branch + ((and (eq func 'if) + (equal test '(featurep (quote emacs)))) + (elint-form (nth 2 form) env)) ; lint the if branch + ;; Process conditional as normal, without handler. + (t + (elint-form form env t)))) + env) + ;;; ;;; Message functions ;;; @@ -622,10 +959,12 @@ CODE can be a lambda expression, a macro, or byte-compiled code." (if f (file-name-nondirectory f) (buffer-name))) - (save-excursion - (goto-char elint-current-pos) - (1+ (count-lines (point-min) - (line-beginning-position)))) + (if (boundp 'elint-current-pos) + (save-excursion + (goto-char elint-current-pos) + (1+ (count-lines (point-min) + (line-beginning-position)))) + 0) ; unknown position type (apply 'format string args)))) @@ -639,27 +978,33 @@ STRING and ARGS are thrown on `format' to get the message." See `elint-error'." (elint-log "Warning" string args)) -(defun elint-log-message (errstr) - "Insert ERRSTR last in the lint log buffer." +(defun elint-output (string) + "Print or insert STRING, depending on value of `noninteractive'." + (if noninteractive + (message "%s" string) + (insert string "\n"))) + +(defun elint-log-message (errstr &optional top) + "Insert ERRSTR last in the lint log buffer. +Optional argument TOP non-nil means pretend `elint-top-form-logged' is non-nil." (with-current-buffer (elint-get-log-buffer) (goto-char (point-max)) (let ((inhibit-read-only t)) (or (bolp) (newline)) ;; Do we have to say where we are? - (unless elint-top-form-logged - (insert - (let* ((form (elint-top-form-form elint-top-form)) - (top (car form))) - (cond - ((memq top '(defun defsubst)) - (format "\nIn function %s:\n" (cadr form))) - ((eq top 'defmacro) - (format "\nIn macro %s:\n" (cadr form))) - ((memq top '(defvar defconst)) - (format "\nIn variable %s:\n" (cadr form))) - (t "\nIn top level expression:\n")))) + (unless (or elint-top-form-logged top) + (let* ((form (elint-top-form-form elint-top-form)) + (top (car form))) + (elint-output (cond + ((memq top '(defun defsubst)) + (format "\nIn function %s:" (cadr form))) + ((eq top 'defmacro) + (format "\nIn macro %s:" (cadr form))) + ((memq top '(defvar defconst)) + (format "\nIn variable %s:" (cadr form))) + (t "\nIn top level expression:")))) (setq elint-top-form-logged t)) - (insert errstr "\n")))) + (elint-output errstr)))) (defun elint-clear-log (&optional header) "Clear the lint log buffer. @@ -677,6 +1022,17 @@ Insert HEADER followed by a blank line if non-nil." (display-buffer (elint-get-log-buffer)) (sit-for 0))) +(defvar elint-running) + +(defun elint-set-mode-line (&optional on) + "Set the mode-line-process of the Elint log buffer." + (with-current-buffer (elint-get-log-buffer) + (and (eq major-mode 'compilation-mode) + (setq mode-line-process + (list (if (or on (bound-and-true-p elint-running)) + (propertize ":run" 'face 'compilation-warning) + (propertize ":finished" 'face 'compilation-info))))))) + (defun elint-get-log-buffer () "Return a log buffer for elint." (or (get-buffer elint-log-buffer) @@ -690,6 +1046,13 @@ Insert HEADER followed by a blank line if non-nil." ;;; Initializing code ;;; +(defun elint-put-function-args (func args) + "Mark function FUNC as having argument list ARGS." + (and (symbolp func) + args + (not (eq args 'unknown)) + (put func 'elint-args args))) + ;;;###autoload (defun elint-initialize (&optional reinit) "Initialize elint. @@ -699,23 +1062,29 @@ optional prefix argument REINIT is non-nil." (if (and elint-builtin-variables (not reinit)) (message "Elint is already initialized") (message "Initializing elint...") - (setq elint-builtin-variables (elint-find-builtin-variables) + (setq elint-builtin-variables (elint-scan-doc-file) elint-autoloaded-variables (elint-find-autoloaded-variables)) - (mapc (lambda (x) (or (not (symbolp (car x))) - (eq (cdr x) 'unknown) - (put (car x) 'elint-args (cdr x)))) + (mapc (lambda (x) (elint-put-function-args (car x) (cdr x))) (elint-find-builtin-args)) (if elint-unknown-builtin-args - (mapc (lambda (x) (put (car x) 'elint-args (cdr x))) + (mapc (lambda (x) (elint-put-function-args (car x) (cdr x))) elint-unknown-builtin-args)) + (when elint-scan-preloaded + (dolist (lib preloaded-file-list) + ;; Skip files that contain nothing of use to us. + (unless (string-match elint-preloaded-skip-re lib) + (setq elint-preloaded-env + (elint-add-required-env elint-preloaded-env nil lib))))) (message "Initializing elint...done"))) -(defun elint-find-builtin-variables () - "Return a list of all built-in variables." +;; This includes all the built-in and dumped things with documentation. +(defun elint-scan-doc-file () + "Scan the DOC file for function and variables. +Marks the function wih their arguments, and returns a list of variables." ;; Cribbed from help-fns.el. (let ((docbuf " *DOC*") - vars var) + vars sym args) (save-excursion (if (get-buffer docbuf) (progn @@ -724,12 +1093,25 @@ optional prefix argument REINIT is non-nil." (set-buffer (get-buffer-create docbuf)) (insert-file-contents-literally (expand-file-name internal-doc-file-name doc-directory))) - (while (search-forward " V" nil t) - (and (setq var (intern-soft - (buffer-substring (point) (line-end-position)))) - (boundp var) - (setq vars (cons var vars)))) - vars))) + (while (re-search-forward " \\([VF]\\)" nil t) + (when (setq sym (intern-soft (buffer-substring (point) + (line-end-position)))) + (if (string-equal (match-string 1) "V") + ;; Excludes platform-specific stuff not relevant to the + ;; running platform. + (if (boundp sym) (setq vars (cons sym vars))) + ;; Function. + (when (fboundp sym) + (when (re-search-forward "\\(^(fn.*)\\)? " nil t) + (backward-char 1) + ;; FIXME distinguish no args from not found. + (and (setq args (match-string 1)) + (setq args + (ignore-errors + (read + (replace-regexp-in-string "^(fn ?" "(" args)))) + (elint-put-function-args sym args)))))))) + vars)) (defun elint-find-autoloaded-variables () "Return a list of all autoloaded variables." diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 756aa3c778b..5fede8243c0 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -210,7 +210,10 @@ This variable is set by the master function.") ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) ;; (aref (symbol-function 'elp-wrapper) 2))) ;; to help me find this list. - error call-interactively apply current-time) + error call-interactively apply current-time + ;; Andreas Politz reports problems profiling these (Bug#4233): + + byte-code-function-p functionp byte-code subrp + indirect-function fboundp) "List of functions that cannot be profiled. Those functions are used internally by the profiling code and profiling them would thus lead to infinite recursion.") diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el index 5d90919ccf3..475e2ad753a 100644 --- a/lisp/emacs-lisp/gulp.el +++ b/lisp/emacs-lisp/gulp.el @@ -5,7 +5,7 @@ ;; Author: Sam Shteingold <shteingd@math.ucla.edu> ;; Maintainer: FSF -;; Keywords: maintenance +;; Keywords: maint ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1ea0881f3d9..b9b7c6ad8f9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -78,7 +78,8 @@ (modify-syntax-entry ?\) ")( " table) (modify-syntax-entry ?\[ "(] " table) (modify-syntax-entry ?\] ")[ " table)) - table)) + table) + "Syntax table used in `emacs-lisp-mode'.") (defvar lisp-mode-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) @@ -86,7 +87,8 @@ (modify-syntax-entry ?\] "_ " table) (modify-syntax-entry ?# "' 14b" table) (modify-syntax-entry ?| "\" 23bn" table) - table)) + table) + "Syntax table used in `lisp-mode'.") (defvar lisp-imenu-generic-expression (list @@ -330,16 +332,19 @@ font-lock keywords will not be case sensitive." (define-key prof-map [prof-func] '(menu-item "Instrument Function..." elp-instrument-function :help "Instrument a function for profiling")) - (define-key menu-map [lint] (cons "Lint" lint-map)) + (define-key menu-map [lint] (cons "Linting" lint-map)) + (define-key lint-map [lint-di] + '(menu-item "Lint Directory..." elint-directory + :help "Lint a directory")) + (define-key lint-map [lint-f] + '(menu-item "Lint File..." elint-file + :help "Lint a file")) (define-key lint-map [lint-b] '(menu-item "Lint Buffer" elint-current-buffer :help "Lint the current buffer")) (define-key lint-map [lint-d] '(menu-item "Lint Defun" elint-defun :help "Lint the function at point")) - (define-key lint-map [lint-in] - '(menu-item "Lint Initialize" elint-initialize - :help "Lint Initialize")) (define-key menu-map [edebug-defun] '(menu-item "Instrument Function for Debugging" edebug-defun :help "Evaluate the top level form point is in, stepping through with Edebug" diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index f586382afd3..9b48c497eba 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -597,43 +597,16 @@ character." (error "Unmatched bracket or quote")))) (defun field-complete (table &optional predicate) - (let* ((pattern (field-string-no-properties)) - (completion (try-completion pattern table predicate))) - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region (field-beginning) (field-end)) - (insert completion) - ;; Don't leave around a completions buffer that's out of date. - (let ((win (get-buffer-window "*Completions*" 0))) - (if win (with-selected-window win (bury-buffer))))) - (t - (let ((minibuf-is-in-use - (eq (minibuffer-window) (selected-window)))) - (unless minibuf-is-in-use - (message "Making completion list...")) - (let ((list (all-completions pattern table predicate))) - (setq list (sort list 'string<)) - (or (eq predicate 'fboundp) - (let (new) - (while list - (setq new (cons (if (fboundp (intern (car list))) - (list (car list) " <f>") - (car list)) - new)) - (setq list (cdr list))) - (setq list (nreverse new)))) - (if (> (length list) 1) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list list pattern)) - ;; Don't leave around a completions buffer that's - ;; out of date. - (let ((win (get-buffer-window "*Completions*" 0))) - (if win (with-selected-window win (bury-buffer)))))) - (unless minibuf-is-in-use - (message "Making completion list...%s" "done"))))))) + (let ((minibuffer-completion-table table) + (minibuffer-completion-predicate predicate) + ;; This made sense for lisp-complete-symbol, but for + ;; field-complete, this is out of place. --Stef + ;; (completion-annotate-function + ;; (unless (eq predicate 'fboundp) + ;; (lambda (str) + ;; (if (fboundp (intern-soft str)) " <f>")))) + ) + (call-interactively 'minibuffer-complete))) (defun lisp-complete-symbol (&optional predicate) "Perform completion on Lisp symbol preceding point. @@ -649,85 +622,42 @@ symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered." (interactive) - (let ((window (get-buffer-window "*Completions*" 0))) - (if (and (eq last-command this-command) - window (window-live-p window) (window-buffer window) - (buffer-name (window-buffer window))) - ;; If this command was repeated, and - ;; there's a fresh completion window with a live buffer, - ;; and this command is repeated, scroll that window. - (with-current-buffer (window-buffer window) - (if (pos-visible-in-window-p (point-max) window) - (set-window-start window (point-min)) - (save-selected-window - (select-window window) - (scroll-up)))) - - ;; Do completion. - (let* ((end (point)) - (beg (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) - (point)))) - (pattern (buffer-substring-no-properties beg end)) - (predicate - (or predicate - (save-excursion - (goto-char beg) - (if (not (eq (char-before) ?\()) - (lambda (sym) ;why not just nil ? -sm - (or (boundp sym) (fboundp sym) - (symbol-plist sym))) - ;; Looks like a funcall position. Let's double check. - (if (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil)) - ;; If the first element of the parent list is an open - ;; parenthesis we are probably not in a funcall position. - ;; Maybe a `let' varlist or something. - nil - ;; Else, we assume that a function name is expected. - 'fboundp))))) - (completion (try-completion pattern obarray predicate))) - (cond ((eq completion t)) - ((null completion) - (if (window-minibuffer-p (selected-window)) - (minibuffer-message (format " [No completions of \"%s\"]" pattern)) - (message "Can't find completion for \"%s\"" pattern)) - (ding)) - ((not (string= pattern completion)) - (delete-region beg end) - (insert completion) - ;; Don't leave around a completions buffer that's out of date. - (let ((win (get-buffer-window "*Completions*" 0))) - (if win (with-selected-window win (bury-buffer))))) - (t - (let ((minibuf-is-in-use - (eq (minibuffer-window) (selected-window)))) - (unless minibuf-is-in-use - (message "Making completion list...")) - (let ((list (all-completions pattern obarray predicate))) - (setq list (sort list 'string<)) - (unless (eq predicate 'fboundp) - (let (new) - (dolist (compl list) - (push (if (fboundp (intern compl)) - (list compl " <f>") - compl) - new)) - (setq list (nreverse new)))) - (if (> (length list) 1) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list list pattern)) - ;; Don't leave around a completions buffer that's - ;; out of date. - (let ((win (get-buffer-window "*Completions*" 0))) - (if win (with-selected-window win (bury-buffer)))))) - (unless minibuf-is-in-use - (message "Making completion list...%s" "done"))))))))) + (let* ((end (point)) + (beg (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + (backward-sexp 1) + (while (= (char-syntax (following-char)) ?\') + (forward-char 1)) + (point)))) + (predicate + (or predicate + (save-excursion + (goto-char beg) + (if (not (eq (char-before) ?\()) + (lambda (sym) ;why not just nil ? -sm + (or (boundp sym) (fboundp sym) + (symbol-plist sym))) + ;; Looks like a funcall position. Let's double check. + (if (condition-case nil + (progn (up-list -2) (forward-char 1) + (eq (char-after) ?\()) + (error nil)) + ;; If the first element of the parent list is an open + ;; parenthesis we are probably not in a funcall position. + ;; Maybe a `let' varlist or something. + nil + ;; Else, we assume that a function name is expected. + 'fboundp))))) + (ol (make-overlay beg end nil nil t))) + (overlay-put ol 'field 'completion) + (let ((completion-annotate-function + (unless (eq predicate 'fboundp) + (lambda (str) (if (fboundp (intern-soft str)) " <f>")))) + (minibuffer-completion-table obarray) + (minibuffer-completion-predicate predicate)) + (unwind-protect + (call-interactively 'minibuffer-complete) + (delete-overlay ol))))) ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e ;;; lisp.el ends here diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 97aba431c0f..31f7d8da49e 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -720,7 +720,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (remove-hook 'kill-buffer-hook 'reb-kill-buffer t) (when (reb-mode-buffer-p) (reb-delete-overlays) - (funcall default-major-mode)))) + (funcall (or (default-value 'major-mode) 'fundamental-mode))))) ;; continue standard unloading nil) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 0380d8553ba..bbb10797934 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -1,7 +1,7 @@ ;;; timer.el --- run a function with args at some time in future -;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Maintainer: FSF @@ -284,7 +284,7 @@ how many will really happen.") "Calculate number of seconds from when TIMER will run, until TIME. TIMER is a timer, and stands for the time when its next repeat is scheduled. TIME is a time-list." - ;; FIXME: (time-to-seconds (time-subtract (timer--time timer) time)) + ;; FIXME: (float-time (time-subtract (timer--time timer) time)) (let ((high (- (car time) (timer--high-seconds timer))) (low (- (nth 1 time) (timer--low-seconds timer)))) (+ low (* high 65536)))) diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el index 64ca561fbe2..870e8799b3f 100644 --- a/lisp/emulation/crisp.el +++ b/lisp/emulation/crisp.el @@ -55,6 +55,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + ;; local variables (defgroup crisp nil @@ -62,8 +64,112 @@ :prefix "crisp-" :group 'emulations) -(defvar crisp-mode-map (let ((map (make-sparse-keymap))) - map) +(defvar crisp-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [(f1)] 'other-window) + + (define-key map [(f2) (down)] 'enlarge-window) + (define-key map [(f2) (left)] 'shrink-window-horizontally) + (define-key map [(f2) (right)] 'enlarge-window-horizontally) + (define-key map [(f2) (up)] 'shrink-window) + (define-key map [(f3) (down)] 'split-window-vertically) + (define-key map [(f3) (right)] 'split-window-horizontally) + + (define-key map [(f4)] 'delete-window) + (define-key map [(control f4)] 'delete-other-windows) + + (define-key map [(f5)] 'search-forward-regexp) + (define-key map [(f19)] 'search-forward-regexp) + (define-key map [(meta f5)] 'search-backward-regexp) + + (define-key map [(f6)] 'query-replace) + + (define-key map [(f7)] 'start-kbd-macro) + (define-key map [(meta f7)] 'end-kbd-macro) + + (define-key map [(f8)] 'call-last-kbd-macro) + (define-key map [(meta f8)] 'save-kbd-macro) + + (define-key map [(f9)] 'find-file) + (define-key map [(meta f9)] 'load-library) + + (define-key map [(f10)] 'execute-extended-command) + (define-key map [(meta f10)] 'compile) + + (define-key map [(SunF37)] 'kill-buffer) + (define-key map [(kp-add)] 'crisp-copy-line) + (define-key map [(kp-subtract)] 'crisp-kill-line) + ;; just to cover all the bases (GNU Emacs, for instance) + (define-key map [(f24)] 'crisp-kill-line) + (define-key map [(insert)] 'crisp-yank-clipboard) + (define-key map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd + (define-key map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd + (define-key map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd + + (define-key map [(control f)] 'fill-paragraph-or-region) + (define-key map [(meta d)] (lambda () + (interactive) + (beginning-of-line) (kill-line))) + (define-key map [(meta e)] 'find-file) + (define-key map [(meta g)] 'goto-line) + (define-key map [(meta h)] 'help) + (define-key map [(meta i)] 'overwrite-mode) + (define-key map [(meta j)] 'bookmark-jump) + (define-key map [(meta l)] 'crisp-mark-line) + (define-key map [(meta m)] 'set-mark-command) + (define-key map [(meta n)] 'bury-buffer) + (define-key map [(meta p)] 'crisp-unbury-buffer) + (define-key map [(meta u)] 'undo) + (define-key map [(f14)] 'undo) + (define-key map [(meta w)] 'save-buffer) + (define-key map [(meta x)] 'crisp-meta-x-wrapper) + (define-key map [(meta ?0)] (lambda () + (interactive) + (bookmark-set "0"))) + (define-key map [(meta ?1)] (lambda () + (interactive) + (bookmark-set "1"))) + (define-key map [(meta ?2)] (lambda () + (interactive) + (bookmark-set "2"))) + (define-key map [(meta ?3)] (lambda () + (interactive) + (bookmark-set "3"))) + (define-key map [(meta ?4)] (lambda () + (interactive) + (bookmark-set "4"))) + (define-key map [(meta ?5)] (lambda () + (interactive) + (bookmark-set "5"))) + (define-key map [(meta ?6)] (lambda () + (interactive) + (bookmark-set "6"))) + (define-key map [(meta ?7)] (lambda () + (interactive) + (bookmark-set "7"))) + (define-key map [(meta ?8)] (lambda () + (interactive) + (bookmark-set "8"))) + (define-key map [(meta ?9)] (lambda () + (interactive) + (bookmark-set "9"))) + + (define-key map [(shift delete)] 'kill-word) + (define-key map [(shift backspace)] 'backward-kill-word) + (define-key map [(control left)] 'backward-word) + (define-key map [(control right)] 'forward-word) + + (define-key map [(home)] 'crisp-home) + (define-key map [(control home)] (lambda () + (interactive) + (move-to-window-line 0))) + (define-key map [(meta home)] 'beginning-of-line) + (define-key map [(end)] 'crisp-end) + (define-key map [(control end)] (lambda () + (interactive) + (move-to-window-line -1))) + (define-key map [(meta end)] 'end-of-line) + map) "Local keymap for CRiSP emulation mode. All the bindings are done here instead of globally to try and be nice to the world.") @@ -150,112 +256,6 @@ does not load the scroll-all package." zmacs-region-active-p mark-active)) -;; and now the keymap defines - -(define-key crisp-mode-map [(f1)] 'other-window) - -(define-key crisp-mode-map [(f2) (down)] 'enlarge-window) -(define-key crisp-mode-map [(f2) (left)] 'shrink-window-horizontally) -(define-key crisp-mode-map [(f2) (right)] 'enlarge-window-horizontally) -(define-key crisp-mode-map [(f2) (up)] 'shrink-window) -(define-key crisp-mode-map [(f3) (down)] 'split-window-vertically) -(define-key crisp-mode-map [(f3) (right)] 'split-window-horizontally) - -(define-key crisp-mode-map [(f4)] 'delete-window) -(define-key crisp-mode-map [(control f4)] 'delete-other-windows) - -(define-key crisp-mode-map [(f5)] 'search-forward-regexp) -(define-key crisp-mode-map [(f19)] 'search-forward-regexp) -(define-key crisp-mode-map [(meta f5)] 'search-backward-regexp) - -(define-key crisp-mode-map [(f6)] 'query-replace) - -(define-key crisp-mode-map [(f7)] 'start-kbd-macro) -(define-key crisp-mode-map [(meta f7)] 'end-kbd-macro) - -(define-key crisp-mode-map [(f8)] 'call-last-kbd-macro) -(define-key crisp-mode-map [(meta f8)] 'save-kbd-macro) - -(define-key crisp-mode-map [(f9)] 'find-file) -(define-key crisp-mode-map [(meta f9)] 'load-library) - -(define-key crisp-mode-map [(f10)] 'execute-extended-command) -(define-key crisp-mode-map [(meta f10)] 'compile) - -(define-key crisp-mode-map [(SunF37)] 'kill-buffer) -(define-key crisp-mode-map [(kp-add)] 'crisp-copy-line) -(define-key crisp-mode-map [(kp-subtract)] 'crisp-kill-line) -;; just to cover all the bases (GNU Emacs, for instance) -(define-key crisp-mode-map [(f24)] 'crisp-kill-line) -(define-key crisp-mode-map [(insert)] 'crisp-yank-clipboard) -(define-key crisp-mode-map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd -(define-key crisp-mode-map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd -(define-key crisp-mode-map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd - -(define-key crisp-mode-map [(control f)] 'fill-paragraph-or-region) -(define-key crisp-mode-map [(meta d)] (lambda () - (interactive) - (beginning-of-line) (kill-line))) -(define-key crisp-mode-map [(meta e)] 'find-file) -(define-key crisp-mode-map [(meta g)] 'goto-line) -(define-key crisp-mode-map [(meta h)] 'help) -(define-key crisp-mode-map [(meta i)] 'overwrite-mode) -(define-key crisp-mode-map [(meta j)] 'bookmark-jump) -(define-key crisp-mode-map [(meta l)] 'crisp-mark-line) -(define-key crisp-mode-map [(meta m)] 'set-mark-command) -(define-key crisp-mode-map [(meta n)] 'bury-buffer) -(define-key crisp-mode-map [(meta p)] 'crisp-unbury-buffer) -(define-key crisp-mode-map [(meta u)] 'advertised-undo) -(define-key crisp-mode-map [(f14)] 'advertised-undo) -(define-key crisp-mode-map [(meta w)] 'save-buffer) -(define-key crisp-mode-map [(meta x)] 'crisp-meta-x-wrapper) -(define-key crisp-mode-map [(meta ?0)] (lambda () - (interactive) - (bookmark-set "0"))) -(define-key crisp-mode-map [(meta ?1)] (lambda () - (interactive) - (bookmark-set "1"))) -(define-key crisp-mode-map [(meta ?2)] (lambda () - (interactive) - (bookmark-set "2"))) -(define-key crisp-mode-map [(meta ?3)] (lambda () - (interactive) - (bookmark-set "3"))) -(define-key crisp-mode-map [(meta ?4)] (lambda () - (interactive) - (bookmark-set "4"))) -(define-key crisp-mode-map [(meta ?5)] (lambda () - (interactive) - (bookmark-set "5"))) -(define-key crisp-mode-map [(meta ?6)] (lambda () - (interactive) - (bookmark-set "6"))) -(define-key crisp-mode-map [(meta ?7)] (lambda () - (interactive) - (bookmark-set "7"))) -(define-key crisp-mode-map [(meta ?8)] (lambda () - (interactive) - (bookmark-set "8"))) -(define-key crisp-mode-map [(meta ?9)] (lambda () - (interactive) - (bookmark-set "9"))) - -(define-key crisp-mode-map [(shift delete)] 'kill-word) -(define-key crisp-mode-map [(shift backspace)] 'backward-kill-word) -(define-key crisp-mode-map [(control left)] 'backward-word) -(define-key crisp-mode-map [(control right)] 'forward-word) - -(define-key crisp-mode-map [(home)] 'crisp-home) -(define-key crisp-mode-map [(control home)] (lambda () - (interactive) - (move-to-window-line 0))) -(define-key crisp-mode-map [(meta home)] 'beginning-of-line) -(define-key crisp-mode-map [(end)] 'crisp-end) -(define-key crisp-mode-map [(control end)] (lambda () - (interactive) - (move-to-window-line -1))) -(define-key crisp-mode-map [(meta end)] 'end-of-line) - (defun crisp-version (&optional arg) "Version number of the CRiSP emulator package. If ARG, insert results at point." @@ -349,14 +349,15 @@ normal CRiSP binding) and when it is nil M-x will run (call-interactively 'execute-extended-command))) ;;;###autoload -(defun crisp-mode (&optional arg) +(define-minor-mode crisp-mode "Toggle CRiSP/Brief emulation minor mode. With ARG, turn CRiSP mode on if ARG is positive, off otherwise." - (interactive "P") - (setq crisp-mode (if (null arg) - (not crisp-mode) - (> (prefix-numeric-value arg) 0))) + :keymap crisp-mode-map + :lighter crisp-mode-modeline-string (when crisp-mode + ;; Make menu entries show M-u or f14 in preference to C-x u. + (put 'undo :advertised-binding + (list* [?\M-u] [f14] (get 'undo :advertised-binding))) ;; Force transient-mark-mode, so that the marking routines work as ;; expected. If the user turns off transient mark mode, most ;; things will still work fine except the crisp-(copy|kill) @@ -367,23 +368,12 @@ With ARG, turn CRiSP mode on if ARG is positive, off otherwise." (if crisp-load-scroll-all (require 'scroll-all)) (if (featurep 'scroll-all) - (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode)) - (run-hooks 'crisp-mode-hook))) + (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode)))) ;; People might use Apropos on `brief'. ;;;###autoload (defalias 'brief-mode 'crisp-mode) -(if (fboundp 'add-minor-mode) - (add-minor-mode 'crisp-mode 'crisp-mode-modeline-string - crisp-mode-map nil 'crisp-mode) - (or (assq 'crisp-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(crisp-mode crisp-mode-modeline-string) minor-mode-alist))) - (or (assq 'crisp-mode minor-mode-map-alist) - (setq minor-mode-map-alist (cons (cons 'crisp-mode crisp-mode-map) - minor-mode-map-alist)))) - ;; Interaction with other packages. (put 'crisp-home 'CUA 'move) (put 'crisp-end 'CUA 'move) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index d74738900e4..a99a3f76250 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1196,8 +1196,8 @@ If ARG is the atom `-', scroll upward by nearly full screen." (set-cursor-color color)) (if (and type (symbolp type) - (not (eq type default-cursor-type))) - (setq default-cursor-type type)))) + (not (eq type (default-value 'cursor-type)))) + (setq-default cursor-type type)))) ;;; Pre-command hook diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el index 5e6063efa34..536eaa1840c 100644 --- a/lisp/emulation/pc-select.el +++ b/lisp/emulation/pc-select.el @@ -382,7 +382,9 @@ If scan reaches end of buffer, stop there without error." "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil." +When calling from a program, supply a number as argument or nil. +Attempting to scroll past the edge of buffer does not raise an +error, unless `pc-select-override-scroll-error' is nil." (interactive "P") (pc-select-ensure-mark) (cond (pc-select-override-scroll-error @@ -515,7 +517,9 @@ If scan reaches end of buffer, stop there without error." "Deactivate mark; scroll down ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil." +When calling from a program, supply a number as argument or nil. +Attempting to scroll past the edge of buffer does not raise an +error, unless `pc-select-override-scroll-error' is nil." (interactive "P") (pc-select-maybe-deactivate-mark) (cond (pc-select-override-scroll-error @@ -630,7 +634,9 @@ If scan reaches end of buffer, stop there without error." "Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil." +When calling from a program, supply a number as argument or nil. +Attempting to scroll past the edge of buffer does not raise an +error, unless `pc-select-override-scroll-error' is nil." (interactive "P") (pc-select-ensure-mark) (cond (pc-select-override-scroll-error @@ -727,7 +733,9 @@ If scan reaches end of buffer, stop there without error." "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil." +When calling from a program, supply a number as argument or nil. +Attempting to scroll past the edge of buffer does not raise an +error, unless `pc-select-override-scroll-error' is nil." (interactive "P") (pc-select-maybe-deactivate-mark) (cond (pc-select-override-scroll-error diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 864b2db46a4..c0fca58a5a8 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -1,7 +1,7 @@ ;;; tpu-edt.el --- Emacs emulating TPU emulating EDT -;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Rob Riepel <riepel@networking.stanford.edu> ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> @@ -2374,7 +2374,7 @@ If FILE is nil, try to load a default file. The default file names are (and (tpu-y-or-n-p "Copy key definitions to the new file now? ") (condition-case conditions (copy-file oldname newname) - (tpu-error (message "Sorry, couldn't copy - %s." (cdr conditions))))) + (error (message "Sorry, couldn't copy - %s." (cdr conditions))))) (kill-buffer "*TPU-Notice*"))) (defvar tpu-edt-old-global-values nil) diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el index e9c7f6e8bbd..64f610f4a13 100644 --- a/lisp/emulation/vi.el +++ b/lisp/emulation/vi.el @@ -639,7 +639,7 @@ insert state." (if (null (vi-raw-numeric-prefix arg)) (with-no-warnings (end-of-buffer)) - (goto-line (vi-prefix-numeric-value arg)))) + (with-no-warnings (goto-line (vi-prefix-numeric-value arg))))) (defun vi-beginning-of-buffer () "Move point to the beginning of current buffer." diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 3f8c48474d5..fcc98db3204 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -329,7 +329,6 @@ Don't put `-c' here, as it is added automatically." (defcustom viper-glob-function (cond (ex-unix-type-shell 'viper-glob-unix-files) - ((eq system-type 'emx) 'viper-glob-mswindows-files) ; OS/2 (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS (t 'viper-glob-unix-files) ; presumably UNIX ) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 901a73fcecf..0227842b450 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -35,7 +35,6 @@ (defvar default-input-method) (defvar describe-current-input-method-function) (defvar bar-cursor) -(defvar default-cursor-type) (defvar cursor-type) ;; end pacifier @@ -971,7 +970,7 @@ Should be set in `~/.viper' file." (condition-case nil (if (featurep 'xemacs) (set (make-local-variable 'bar-cursor) nil) - (setq cursor-type default-cursor-type)) + (setq cursor-type (default-value 'cursor-type))) (error nil))) (defun viper-set-insert-cursor-type () diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 1631b1aa6ba..2d65f5c4a06 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -678,8 +678,9 @@ It also can't undo some Viper settings." global-mode-string (delq 'viper-mode-string global-mode-string)) - (setq default-major-mode - (viper-standard-value 'default-major-mode viper-saved-non-viper-variables)) + (setq-default major-mode + (viper-standard-value 'default-major-mode + viper-saved-non-viper-variables)) (if (featurep 'emacs) (setq-default @@ -834,8 +835,8 @@ It also can't undo some Viper settings." ;; in Fundamental Mode and Vi state. ;; When viper-mode is executed in such a case, it will set the major mode ;; back to fundamental-mode. - (if (eq default-major-mode 'fundamental-mode) - (setq default-major-mode 'viper-mode)) + (if (eq (default-value 'major-mode) 'fundamental-mode) + (setq-default major-mode 'viper-mode)) (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) @@ -1214,7 +1215,7 @@ These two lines must come in the order given. (if (null viper-saved-non-viper-variables) (setq viper-saved-non-viper-variables (list - (cons 'default-major-mode (list default-major-mode)) + (cons 'default-major-mode (list (default-value 'major-mode))) (cons 'next-line-add-newlines (list next-line-add-newlines)) (cons 'require-final-newline (list require-final-newline)) (cons 'scroll-step (list scroll-step)) diff --git a/lisp/emulation/ws-mode.el b/lisp/emulation/ws-mode.el index ada28e38ba3..ffbe7043d88 100644 --- a/lisp/emulation/ws-mode.el +++ b/lisp/emulation/ws-mode.el @@ -1,7 +1,7 @@ ;;; ws-mode.el --- WordStar emulation mode for GNU Emacs -;; Copyright (C) 1991, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1991, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de> ;; Version: 0.7 @@ -457,14 +457,14 @@ in ws-last-errormessage for recovery with C-q w." (if (or ws-block-begin-marker ws-block-end-marker) (save-excursion (if ws-block-begin-marker - (let () + (progn (goto-char ws-block-begin-marker) (message "Block begin marker") (sit-for 2)) (message "Block begin marker not set") (sit-for 2)) (if ws-block-end-marker - (let () + (progn (goto-char ws-block-end-marker) (message "Block end marker") (sit-for 2)) @@ -509,7 +509,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Move block to current cursor position." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) - (let () + (progn (kill-region ws-block-begin-marker ws-block-end-marker) (yank) (save-excursion @@ -536,7 +536,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Delete block." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) - (let () + (progn (kill-region ws-block-begin-marker ws-block-end-marker) (setq ws-block-end-marker nil) (setq ws-block-begin-marker nil)) @@ -548,7 +548,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 0." (interactive) (if ws-marker-0 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-0)) (ws-error "Marker 0 not set"))) @@ -557,7 +557,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 1." (interactive) (if ws-marker-1 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-1)) (ws-error "Marker 1 not set"))) @@ -566,7 +566,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 2." (interactive) (if ws-marker-2 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-2)) (ws-error "Marker 2 not set"))) @@ -575,7 +575,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 3." (interactive) (if ws-marker-3 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-3)) (ws-error "Marker 3 not set"))) @@ -584,7 +584,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 4." (interactive) (if ws-marker-4 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-4)) (ws-error "Marker 4 not set"))) @@ -593,7 +593,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 5." (interactive) (if ws-marker-5 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-5)) (ws-error "Marker 5 not set"))) @@ -602,7 +602,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 6." (interactive) (if ws-marker-6 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-6)) (ws-error "Marker 6 not set"))) @@ -611,7 +611,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 7." (interactive) (if ws-marker-7 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-7)) (ws-error "Marker 7 not set"))) @@ -620,7 +620,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 8." (interactive) (if ws-marker-8 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-8)) (ws-error "Marker 8 not set"))) @@ -629,7 +629,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to marker 9." (interactive) (if ws-marker-9 - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-marker-9)) (ws-error "Marker 9 not set"))) @@ -638,7 +638,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to block begin marker." (interactive) (if ws-block-begin-marker - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-block-begin-marker)) (ws-error "Block begin marker not set"))) @@ -665,7 +665,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: Go to block end marker." (interactive) (if ws-block-end-marker - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-block-end-marker)) (ws-error "Block end marker not set"))) @@ -680,7 +680,7 @@ in ws-last-errormessage for recovery with C-q w." "In WordStar mode: " (interactive) (if ws-last-cursorposition - (let () + (progn (setq ws-last-cursorposition (point-marker)) (goto-char ws-last-cursorposition)) (ws-error "No last cursor position available."))) @@ -740,7 +740,7 @@ sWith: " ) "In WordStar mode: Copy block to current cursor position." (interactive) (if (and ws-block-begin-marker ws-block-end-marker) - (let () + (progn (copy-region-as-kill ws-block-begin-marker ws-block-end-marker) (yank) (save-excursion diff --git a/lisp/epa-file.el b/lisp/epa-file.el index fc753df312c..0605ad41fc4 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -25,7 +25,12 @@ (require 'epa-hook) (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil - "If non-nil, cache passphrase for symmetric encryption." + "If non-nil, cache passphrase for symmetric encryption. + +For security reasons, this option is turned off by default and +not recommended to use. Instead, consider using public-key +encryption with gpg-agent which does the same job in a safer +way." :type 'boolean :group 'epa-file) @@ -151,7 +156,7 @@ (defun epa-file-write-region (start end file &optional append visit lockname mustbenew) (if append - (error "Can't append to the file.")) + (error "Can't append to the file")) (setq file (expand-file-name file)) (let* ((coding-system (or coding-system-for-write (if (fboundp 'select-safe-coding-system) diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 593b5dcf150..0987b2a221d 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -86,6 +86,11 @@ May either be a string or a list of strings.") With prefix argument ARG, turn auto encryption on if positive, else off. Return the new status of auto encryption (non-nil means on)." :global t :init-value t :group 'epa-file :version "23.1" + ;; We'd like to use custom-initialize-set here so the setup is done + ;; before dumping, but at the point where the defcustom is evaluated, + ;; the corresponding function isn't defined yet, so + ;; custom-initialize-set signals an error. + :initialize 'custom-initialize-delay (setq file-name-handler-alist (delq epa-file-handler file-name-handler-alist)) (remove-hook 'find-file-hooks 'epa-file-find-file-hook) diff --git a/lisp/epg.el b/lisp/epg.el index 8481f65b833..b8eb2b48ea7 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -49,6 +49,8 @@ (8 . "AES192") (9 . "AES256") (10 . "TWOFISH") + (11 . "CAMELLIA128") + (12 . "CAMELLIA256") (110 . "DUMMY"))) ;; from gnupg/include/cipher.h @@ -67,7 +69,8 @@ (3 . "RMD160") (8 . "SHA256") (9 . "SHA384") - (10 . "SHA512"))) + (10 . "SHA512") + (11 . "SHA224"))) ;; from gnupg/include/cipher.h (defconst epg-compress-algorithm-alist @@ -178,6 +181,7 @@ (signal 'wrong-type-argument (list 'epg-data-p data))) (aref (cdr data) 1)) +;;;###autoload (defun epg-make-context (&optional protocol armor textmode include-certs cipher-algorithm digest-algorithm compress-algorithm) @@ -325,7 +329,13 @@ This function is for internal use only." (defun epg-context-set-passphrase-callback (context passphrase-callback) - "Set the function used to query passphrase." + "Set the function used to query passphrase. + +PASSPHRASE-CALLBACK is either a function, or a cons-cell whose +car is a function and cdr is a callback data. + +The function gets three arguments: the context, the key-id in +question, and the callback data (if any)." (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 7 (if (consp passphrase-callback) @@ -335,7 +345,14 @@ This function is for internal use only." (defun epg-context-set-progress-callback (context progress-callback) "Set the function which handles progress update. -If optional argument HANDBACK is specified, it is passed to PROGRESS-CALLBACK." + +PROGRESS-CALLBACK is either a function, or a cons-cell whose +car is a function and cdr is a callback data. + +The function gets five arguments: the context, the operation +description, the character to display a progress unit, the +current amount done, the total amount to be done, and the +callback data (if any)." (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 8 (if (consp progress-callback) @@ -1170,7 +1187,10 @@ This function is for internal use only." epg-pending-status-list) (accept-process-output (epg-context-process context) 1)) (if epg-pending-status-list - (epg-context-set-result-for context 'error 'exit)))) + (epg-context-set-result-for + context 'error + (cons (list 'exit) + (epg-context-result-for context 'error)))))) (defun epg-wait-for-completion (context) "Wait until the `epg-gpg-program' process completes." @@ -1739,7 +1759,6 @@ This function is for internal use only." (if (aref line 6) (epg--time-from-seconds (aref line 6))))) -;;;###autoload (defun epg-list-keys (context &optional name mode) "Return a list of epg-key objects matched with NAME. If MODE is nil or 'public, only public keyring should be searched. @@ -1906,7 +1925,6 @@ You can then use `write-region' to write new data into the file." (epg-sig-notation-value notation))))) notations))) -;;;###autoload (defun epg-cancel (context) (if (buffer-live-p (process-buffer (epg-context-process context))) (save-excursion @@ -1918,7 +1936,6 @@ You can then use `write-region' to write new data into the file." (if (eq (process-status (epg-context-process context)) 'run) (delete-process (epg-context-process context)))) -;;;###autoload (defun epg-start-decrypt (context cipher) "Initiate a decrypt operation on CIPHER. CIPHER must be a file data object. @@ -1950,7 +1967,6 @@ If you are unsure, use synchronous version of this function (signal 'epg-error (list "No data"))) (signal 'epg-error (list "Can't decrypt" error))))) -;;;###autoload (defun epg-decrypt-file (context cipher plain) "Decrypt a file CIPHER and store the result to a file PLAIN. If PLAIN is nil, it returns the result as a string." @@ -1969,7 +1985,6 @@ If PLAIN is nil, it returns the result as a string." (epg-delete-output-file context)) (epg-reset context))) -;;;###autoload (defun epg-decrypt-string (context cipher) "Decrypt a string CIPHER and return the plain text." (let ((input-file (epg--make-temp-file "epg-input")) @@ -1988,7 +2003,6 @@ If PLAIN is nil, it returns the result as a string." (delete-file input-file)) (epg-reset context)))) -;;;###autoload (defun epg-start-verify (context signature &optional signed-text) "Initiate a verify operation on SIGNATURE. SIGNATURE and SIGNED-TEXT are a data object if they are specified. @@ -2029,7 +2043,6 @@ If you are unsure, use synchronous version of this function (if (eq (process-status (epg-context-process context)) 'run) (process-send-eof (epg-context-process context)))))) -;;;###autoload (defun epg-verify-file (context signature &optional signed-text plain) "Verify a file SIGNATURE. SIGNED-TEXT and PLAIN are also a file if they are specified. @@ -2057,7 +2070,6 @@ stored into the file after successful verification." (epg-delete-output-file context)) (epg-reset context))) -;;;###autoload (defun epg-verify-string (context signature &optional signed-text) "Verify a string SIGNATURE. SIGNED-TEXT is a string if it is specified. @@ -2088,7 +2100,6 @@ successful verification." (delete-file input-file)) (epg-reset context)))) -;;;###autoload (defun epg-start-sign (context plain &optional mode) "Initiate a sign operation on PLAIN. PLAIN is a data object. @@ -2134,7 +2145,6 @@ If you are unsure, use synchronous version of this function (if (eq (process-status (epg-context-process context)) 'run) (process-send-eof (epg-context-process context))))) -;;;###autoload (defun epg-sign-file (context plain signature &optional mode) "Sign a file PLAIN and store the result to a file SIGNATURE. If SIGNATURE is nil, it returns the result as a string. @@ -2160,7 +2170,6 @@ Otherwise, it makes a cleartext signature." (epg-delete-output-file context)) (epg-reset context))) -;;;###autoload (defun epg-sign-string (context plain &optional mode) "Sign a string PLAIN and return the output as string. If optional 3rd argument MODE is t or 'detached, it makes a detached signature. @@ -2198,7 +2207,6 @@ Otherwise, it makes a cleartext signature." (delete-file input-file)) (epg-reset context)))) -;;;###autoload (defun epg-start-encrypt (context plain recipients &optional sign always-trust) "Initiate an encrypt operation on PLAIN. @@ -2249,7 +2257,6 @@ If you are unsure, use synchronous version of this function (if (eq (process-status (epg-context-process context)) 'run) (process-send-eof (epg-context-process context))))) -;;;###autoload (defun epg-encrypt-file (context plain recipients cipher &optional sign always-trust) "Encrypt a file PLAIN and store the result to a file CIPHER. @@ -2279,7 +2286,6 @@ If RECIPIENTS is nil, it performs symmetric encryption." (epg-delete-output-file context)) (epg-reset context))) -;;;###autoload (defun epg-encrypt-string (context plain recipients &optional sign always-trust) "Encrypt a string PLAIN. @@ -2321,7 +2327,6 @@ If RECIPIENTS is nil, it performs symmetric encryption." (delete-file input-file)) (epg-reset context)))) -;;;###autoload (defun epg-start-export-keys (context keys) "Initiate an export keys operation. @@ -2339,7 +2344,6 @@ If you are unsure, use synchronous version of this function (car (epg-key-sub-key-list key)))) keys)))) -;;;###autoload (defun epg-export-keys-to-file (context keys file) "Extract public KEYS." (unwind-protect @@ -2359,12 +2363,10 @@ If you are unsure, use synchronous version of this function (epg-delete-output-file context)) (epg-reset context))) -;;;###autoload (defun epg-export-keys-to-string (context keys) "Extract public KEYS and return them as a string." (epg-export-keys-to-file context keys nil)) -;;;###autoload (defun epg-start-import-keys (context keys) "Initiate an import keys operation. KEYS is a data object. @@ -2396,17 +2398,14 @@ If you are unsure, use synchronous version of this function (epg-context-result-for context 'error)))) (epg-reset context))) -;;;###autoload (defun epg-import-keys-from-file (context keys) "Add keys from a file KEYS." (epg--import-keys-1 context (epg-make-data-from-file keys))) -;;;###autoload (defun epg-import-keys-from-string (context keys) "Add keys from a string KEYS." (epg--import-keys-1 context (epg-make-data-from-string keys))) -;;;###autoload (defun epg-start-receive-keys (context key-id-list) "Initiate a receive key operation. KEY-ID-LIST is a list of key IDs. @@ -2420,7 +2419,6 @@ If you are unsure, use synchronous version of this function (epg-context-set-result context nil) (epg--start context (cons "--recv-keys" key-id-list))) -;;;###autoload (defun epg-receive-keys (context keys) "Add keys from server. KEYS is a list of key IDs" @@ -2433,10 +2431,8 @@ KEYS is a list of key IDs" (epg-context-result-for context 'error)))) (epg-reset context))) -;;;###autoload (defalias 'epg-import-keys-from-server 'epg-receive-keys) -;;;###autoload (defun epg-start-delete-keys (context keys &optional allow-secret) "Initiate a delete keys operation. @@ -2456,7 +2452,6 @@ If you are unsure, use synchronous version of this function (car (epg-key-sub-key-list key)))) keys)))) -;;;###autoload (defun epg-delete-keys (context keys &optional allow-secret) "Delete KEYS from the key ring." (unwind-protect @@ -2472,7 +2467,6 @@ If you are unsure, use synchronous version of this function (error "Delete keys failed"))))) (epg-reset context))) -;;;###autoload (defun epg-start-sign-keys (context keys &optional local) "Initiate a sign keys operation. @@ -2493,7 +2487,6 @@ If you are unsure, use synchronous version of this function keys)))) (make-obsolete 'epg-start-sign-keys "do not use." "23.1") -;;;###autoload (defun epg-sign-keys (context keys &optional local) "Sign KEYS from the key ring." (unwind-protect @@ -2506,7 +2499,6 @@ If you are unsure, use synchronous version of this function (epg-reset context))) (make-obsolete 'epg-sign-keys "do not use." "23.1") -;;;###autoload (defun epg-start-generate-key (context parameters) "Initiate a key generation. PARAMETERS specifies parameters for the key. @@ -2528,7 +2520,6 @@ If you are unsure, use synchronous version of this function (if (eq (process-status (epg-context-process context)) 'run) (process-send-eof (epg-context-process context))))) -;;;###autoload (defun epg-generate-key-from-file (context parameters) "Generate a new key pair. PARAMETERS is a file which tells how to create the key." @@ -2541,7 +2532,6 @@ PARAMETERS is a file which tells how to create the key." (epg-context-result-for context 'error)))) (epg-reset context))) -;;;###autoload (defun epg-generate-key-from-string (context parameters) "Generate a new key pair. PARAMETERS is a string which tells how to create the key." diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index aef7d0c3c60..73b14f6f912 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,18 @@ +2009-09-27 Johan BockgÃ¥rd <bojohan@gnu.org> + + * erc-button.el (erc-button-keymap): Bind `follow-link'. + +2009-09-26 Johan BockgÃ¥rd <bojohan@gnu.org> + + * erc-button.el (erc-button-add-button): Only call + `widget-convert-button' in XEmacs. For Emacs (at least), it + doesn't seem to have any purpose except creating lots of overlays, + slowing everything down. + +2009-09-19 Glenn Morris <rgm@gnu.org> + + * erc-lang.el (line): Define for compiler. + 2009-07-22 Kevin Ryde <user42@zip.com.au> * erc/erc.el (erc-cmd-MODE): Hyperlink urls in docstring with URL `...'. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index f0fa72f45b5..a862e02f43b 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -216,6 +216,7 @@ PAR is a number of a regexp grouping whose text will be passed to (define-key map (kbd "<mouse-2>") 'erc-button-click-button)) (define-key map (kbd "TAB") 'erc-button-next) (define-key map (kbd "<backtab>") 'erc-button-previous) + (define-key map [follow-link] 'mouse-face) (set-keymap-parent map erc-mode-map) map) "Local keymap for ERC buttons.") @@ -367,16 +368,17 @@ REGEXP is the regular expression which matched for this button." (list 'keymap erc-button-keymap) (list 'rear-nonsticky t) (and data (list 'erc-data data)))) - (widget-convert-button 'link from to :action 'erc-button-press-button - :suppress-face t - ;; Make XEmacs use our faces. - :button-face (if nick-p - erc-button-nickname-face - erc-button-face) - ;; Make XEmacs behave with mouse-clicks, for - ;; some reason, widget stuff overrides the - ;; 'keymap text-property. - :mouse-down-action 'erc-button-click-button)) + (when (featurep 'xemacs) + (widget-convert-button 'link from to :action 'erc-button-press-button + :suppress-face t + ;; Make XEmacs use our faces. + :button-face (if nick-p + erc-button-nickname-face + erc-button-face) + ;; Make XEmacs behave with mouse-clicks, for + ;; some reason, widget stuff overrides the + ;; 'keymap text-property. + :mouse-down-action 'erc-button-click-button))) (defun erc-button-add-face (from to face) "Add FACE to the region between FROM and TO." diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index 1395a561ff5..73d836348c7 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -197,6 +197,8 @@ Normungsinstitut (ON), Postfach 130, A-1021 Vienna, Austria.") iso-638-languages))) (message "%s" (cdr (assoc code iso-638-languages)))) +(defvar line) ; dynamically bound in erc-process-input-line + (defun erc-cmd-LANG (language) "Display the language name for the language code given by LANGUAGE." (let ((lang (cdr (assoc language iso-638-languages)))) diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index f0b026175f1..7e1a0a82258 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -102,7 +102,7 @@ ;; :link '(info-link "(eshell)Command aliases") :group 'eshell-module) -(defcustom eshell-aliases-file (concat eshell-directory-name "alias") +(defcustom eshell-aliases-file (expand-file-name "alias" eshell-directory-name) "*The file in which aliases are kept. Whenever an alias is defined by the user, using the `alias' command, it will be written to this file. Thus, alias definitions (and diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index fa1af37f808..cc95d810213 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -138,7 +138,7 @@ This is effective only if directory tracking is enabled." :group 'eshell-dirs) (defcustom eshell-last-dir-ring-file-name - (concat eshell-directory-name "lastdir") + (expand-file-name "lastdir" eshell-directory-name) "*If non-nil, name of the file to read/write the last-dir-ring. See also `eshell-read-last-dir-ring' and `eshell-write-last-dir-ring'. If it is nil, the last-dir-ring will not be written to disk." @@ -276,6 +276,11 @@ Thus, this does not include the current directory.") (path (eshell-find-previous-directory regexp))) (concat (or path letter) "/")))) +(defvar pcomplete-stub) +(defvar pcomplete-last-completion-raw) +(declare-function pcomplete-actual-arg "pcomplete") +(declare-function pcomplete-uniqify-list "pcomplete") + (defun eshell-complete-user-reference () "If there is a user reference, complete it." (let ((arg (pcomplete-actual-arg))) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 844a736c65c..3ca3dc77c0e 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -86,7 +86,7 @@ :group 'eshell-hist) (defcustom eshell-history-file-name - (concat eshell-directory-name "history") + (expand-file-name "history" eshell-directory-name) "*If non-nil, name of the file to read/write input history. See also `eshell-read-history' and `eshell-write-history'. If it is nil, Eshell will use the value of HISTFILE." @@ -583,6 +583,10 @@ See also `eshell-read-history'." posb (cdr posb) pose (cdr pose)))))))) +(defvar pcomplete-stub) +(defvar pcomplete-last-completion-raw) +(declare-function pcomplete-actual-arg "pcomplete") + (defun eshell-complete-history-reference () "Complete a history reference, by completing the event designator." (let ((arg (pcomplete-actual-arg))) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index e346806679e..3bf0bbdc614 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -113,56 +113,52 @@ faster and conserves more memory." (t (:weight bold))) "*The face used for highlight directories." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-directory-face 'face-alias 'eshell-ls-directory) +(define-obsolete-face-alias 'eshell-ls-directory-face + 'eshell-ls-directory "22.1") (defface eshell-ls-symlink '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold)) (((class color) (background dark)) (:foreground "Cyan" :weight bold))) "*The face used for highlight symbolic links." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-symlink-face 'face-alias 'eshell-ls-symlink) +(define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1") (defface eshell-ls-executable '((((class color) (background light)) (:foreground "ForestGreen" :weight bold)) (((class color) (background dark)) (:foreground "Green" :weight bold))) "*The face used for highlighting executables (not directories, though)." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-executable-face 'face-alias 'eshell-ls-executable) +(define-obsolete-face-alias 'eshell-ls-executable-face + 'eshell-ls-executable "22.1") (defface eshell-ls-readonly '((((class color) (background light)) (:foreground "Brown")) (((class color) (background dark)) (:foreground "Pink"))) "*The face used for highlighting read-only files." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-readonly-face 'face-alias 'eshell-ls-readonly) +(define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1") (defface eshell-ls-unreadable '((((class color) (background light)) (:foreground "Grey30")) (((class color) (background dark)) (:foreground "DarkGrey"))) "*The face used for highlighting unreadable files." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-unreadable-face 'face-alias 'eshell-ls-unreadable) +(define-obsolete-face-alias 'eshell-ls-unreadable-face + 'eshell-ls-unreadable "22.1") (defface eshell-ls-special '((((class color) (background light)) (:foreground "Magenta" :weight bold)) (((class color) (background dark)) (:foreground "Magenta" :weight bold))) "*The face used for highlighting non-regular files." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-special-face 'face-alias 'eshell-ls-special) +(define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1") (defface eshell-ls-missing '((((class color) (background light)) (:foreground "Red" :weight bold)) (((class color) (background dark)) (:foreground "Red" :weight bold))) "*The face used for highlighting non-existent file names." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-missing-face 'face-alias 'eshell-ls-missing) +(define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1") (defcustom eshell-ls-archive-regexp (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|" @@ -178,8 +174,7 @@ files." (((class color) (background dark)) (:foreground "Orchid" :weight bold))) "*The face used for highlighting archived and compressed file names." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-archive-face 'face-alias 'eshell-ls-archive) +(define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1") (defcustom eshell-ls-backup-regexp "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)" @@ -192,8 +187,7 @@ files." (((class color) (background dark)) (:foreground "LightSalmon"))) "*The face used for highlighting backup file names." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-backup-face 'face-alias 'eshell-ls-backup) +(define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1") (defcustom eshell-ls-product-regexp "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'" @@ -208,8 +202,7 @@ ought to be recreatable if they are deleted." (((class color) (background dark)) (:foreground "LightSalmon"))) "*The face used for highlighting files that are build products." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-product-face 'face-alias 'eshell-ls-product) +(define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1") (defcustom eshell-ls-clutter-regexp "\\(^texput\\.log\\|^core\\)\\'" @@ -224,8 +217,7 @@ really need to stick around for very long." (((class color) (background dark)) (:foreground "OrangeRed" :weight bold))) "*The face used for highlighting junk file names." :group 'eshell-ls) -;; backward-compatibility alias -(put 'eshell-ls-clutter-face 'face-alias 'eshell-ls-clutter) +(define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1") (defsubst eshell-ls-filetype-p (attrs type) "Test whether ATTRS specifies a directory." diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 215a14793e3..6780c98374a 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -76,8 +76,7 @@ re-entered for it to take effect." For highlighting other kinds of strings -- similar to shell mode's behavior -- simply use an output filer which changes text properties." :group 'eshell-prompt) -;; backward-compatibility alias -(put 'eshell-prompt-face 'face-alias 'eshell-prompt) +(define-obsolete-face-alias 'eshell-prompt-face 'eshell-prompt "22.1") (defcustom eshell-before-prompt-hook nil "*A list of functions to call before outputting the prompt." diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index fbe10278c37..2d063ea4c2c 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -40,14 +40,14 @@ commands, as a script file." :type 'hook :group 'eshell-script) -(defcustom eshell-login-script (concat eshell-directory-name "login") +(defcustom eshell-login-script (expand-file-name "login" eshell-directory-name) "*If non-nil, a file to invoke when starting up Eshell interactively. This file should be a file containing Eshell commands, where comment lines begin with '#'." :type 'file :group 'eshell-script) -(defcustom eshell-rc-script (concat eshell-directory-name "profile") +(defcustom eshell-rc-script (expand-file-name "profile" eshell-directory-name) "*If non-nil, a file to invoke whenever Eshell is started. This includes when running `eshell-command'." :type 'file diff --git a/lisp/eshell/esh-test.el b/lisp/eshell/esh-test.el index 2d9f4d4244d..1550553ece0 100644 --- a/lisp/eshell/esh-test.el +++ b/lisp/eshell/esh-test.el @@ -45,8 +45,7 @@ (((class color) (background dark)) (:foreground "Green" :bold t))) "*The face used to highlight OK result strings." :group 'eshell-test) -;; backward-compatibility alias -(put 'eshell-test-ok-face 'face-alias 'eshell-test-ok) +(define-obsolete-face-alias 'eshell-test-ok-face 'eshell-test-ok "22.1") (defface eshell-test-failed '((((class color) (background light)) (:foreground "OrangeRed" :bold t)) @@ -54,8 +53,7 @@ (t (:bold t))) "*The face used to highlight FAILED result strings." :group 'eshell-test) -;; backward-compatibility alias -(put 'eshell-test-failed-face 'face-alias 'eshell-test-failed) +(define-obsolete-face-alias 'eshell-test-failed-face 'eshell-test-failed "22.1") (defcustom eshell-show-usage-metrics nil "*If non-nil, display different usage metrics for each Eshell command." diff --git a/lisp/faces.el b/lisp/faces.el index b8d21404e87..4d0e1211ada 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,7 +1,8 @@ ;;; faces.el --- Lisp faces ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -552,7 +553,7 @@ If FACE is a face-alias, get the documentation for the target face." (if alias (progn (setq doc (get alias 'face-documentation)) - (format "%s is an alias for the face `%s'.%s" face alias + (format "%s is an alias for the face `%s'.%s" face alias (if doc (format "\n%s" doc) ""))) (get face 'face-documentation)))) @@ -1368,10 +1369,29 @@ If FRAME is omitted or nil, use the selected frame." file-name) (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) (princ (concat " (" customize-label ")\n")) - (insert "Documentation: " - (or (face-documentation f) - "Not documented as a face.") - "\n") + ;; FIXME not sure how much of this belongs here, and + ;; how much in `face-documentation'. The latter is + ;; not used much, but needs to return nil for + ;; undocumented faces. + (let ((alias (get f 'face-alias)) + (face f) + obsolete) + (when alias + (setq face alias) + (insert + (format "\n %s is an alias for the face `%s'.\n%s" + f alias + (if (setq obsolete (get f 'obsolete-face)) + (format " This face is obsolete%s; use `%s' instead.\n" + (if (stringp obsolete) + (format " since %s" obsolete) + "") + alias) + "")))) + (insert "\nDocumentation:\n" + (or (face-documentation face) + "Not documented as a face.") + "\n\n")) (with-current-buffer standard-output (save-excursion (re-search-backward @@ -2258,9 +2278,14 @@ terminal type to a different value." "Basic face for highlighting." :group 'basic-faces) +;; Region face: under NS, default to the system-defined selection +;; color (optimized for the fixed white background of other apps), +;; if background is light. (defface region '((((class color) (min-colors 88) (background dark)) :background "blue3") + (((class color) (min-colors 88) (background light) (type ns)) + :background "ns_selection_color") (((class color) (min-colors 88) (background light)) :background "lightgoldenrod2") (((class color) (min-colors 16) (background dark)) @@ -2338,6 +2363,8 @@ terminal type to a different value." :version "21.1" :group 'mode-line-faces :group 'basic-faces) +;; No need to define aliases of this form for new faces. +(define-obsolete-face-alias 'modeline 'mode-line "21.1") (defface mode-line-inactive '((default @@ -2354,6 +2381,7 @@ terminal type to a different value." :version "22.1" :group 'mode-line-faces :group 'basic-faces) +(define-obsolete-face-alias 'modeline-inactive 'mode-line-inactive "22.1") (defface mode-line-highlight '((((class color) (min-colors 88)) @@ -2364,6 +2392,7 @@ terminal type to a different value." :version "22.1" :group 'mode-line-faces :group 'basic-faces) +(define-obsolete-face-alias 'modeline-highlight 'mode-line-highlight "22.1") (defface mode-line-emphasis '((t (:weight bold))) @@ -2379,12 +2408,7 @@ Use the face `mode-line-highlight' for features that can be selected." :version "22.1" :group 'mode-line-faces :group 'basic-faces) - -;; Make `modeline' an alias for `mode-line', for compatibility. -(put 'modeline 'face-alias 'mode-line) -(put 'modeline-inactive 'face-alias 'mode-line-inactive) -(put 'modeline-highlight 'face-alias 'mode-line-highlight) -(put 'modeline-buffer-id 'face-alias 'mode-line-buffer-id) +(define-obsolete-face-alias 'modeline-buffer-id 'mode-line-buffer-id "22.1") (defface header-line '((default diff --git a/lisp/ffap.el b/lisp/ffap.el index 6aa6913dbed..3eb21a53666 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,7 +1,7 @@ ;;; ffap.el --- find file (or url) at point -;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> ;; Maintainer: FSF @@ -1177,6 +1177,9 @@ which may actually result in an url rather than a filename." ((and abs (ffap-file-remote-p name))) ;; Ok, not remote, try the existence test even if it is absolute: ((and abs (ffap-file-exists-string name))) + ;; Try stripping off line numbers. + ((and abs (string-match ":[0-9]" name) + (ffap-file-exists-string (substring name 0 (match-beginning 0))))) ;; If it contains a colon, get rid of it (and return if exists) ((and (string-match path-separator name) (setq name (ffap-string-at-point 'nocolon)) diff --git a/lisp/files.el b/lisp/files.el index 0e70d673e8e..177046ace0f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defvar font-lock-keywords) (defgroup backup nil @@ -193,6 +195,7 @@ If the buffer is visiting a new file, the value is nil.") (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files." :group 'files + :initialize 'custom-initialize-delay :type 'directory) (defcustom small-temporary-file-directory @@ -202,6 +205,7 @@ If non-nil, this directory is used instead of `temporary-file-directory' by programs that create small temporary files. This is for systems that have fast storage with limited space, such as a RAM disk." :group 'files + :initialize 'custom-initialize-delay :type '(choice (const nil) directory)) ;; The system null device. (Should reference NULL_DEVICE from C.) @@ -383,6 +387,7 @@ ignored." :group 'auto-save :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement") (boolean :tag "Uniquify"))) + :initialize 'custom-initialize-delay :version "21.1") (defcustom save-abbrevs t @@ -493,6 +498,7 @@ a -*- line. The command \\[normal-mode], when used interactively, always obeys file local variable specifications and the -*- line, and ignores this variable." + :risky t :type '(choice (const :tag "Query Unsafe" t) (const :tag "Safe Only" :safe) (const :tag "Do all" :all) @@ -514,6 +520,7 @@ specified in a -*- line.") The value can be t, nil or something else. A value of t means obey `eval' variables. A value of nil means ignore them; anything else means query." + :risky t :type '(choice (const :tag "Obey" t) (const :tag "Ignore" nil) (other :tag "Query" other)) @@ -649,7 +656,7 @@ Directories are separated by occurrences of `path-separator' (unless (file-executable-p dir) (error "Cannot cd to %s: Permission denied" dir)) (setq default-directory dir) - (set (make-local-variable 'list-buffers-directory) dir))) + (setq list-buffers-directory dir))) (defun cd (dir) "Make DIR become the current buffer's default directory. @@ -714,24 +721,34 @@ one or more of those symbols." (defun locate-file-completion-table (dirs suffixes string pred action) "Do completion for file names passed to `locate-file'." - (if (file-name-absolute-p string) - (let ((read-file-name-predicate pred)) - (read-file-name-internal string nil action)) + (cond + ((file-name-absolute-p string) + (let ((read-file-name-predicate pred)) + (read-file-name-internal string nil action))) + ((eq (car-safe action) 'boundaries) + (let ((suffix (cdr action))) + (list* 'boundaries + (length (file-name-directory string)) + (let ((x (file-name-directory suffix))) + (if x (1- (length x)) (length suffix)))))) + (t (let ((names nil) (suffix (concat (regexp-opt suffixes t) "\\'")) - (string-dir (file-name-directory string))) + (string-dir (file-name-directory string)) + (string-file (file-name-nondirectory string))) (dolist (dir dirs) (unless dir (setq dir default-directory)) (if string-dir (setq dir (expand-file-name string-dir dir))) (when (file-directory-p dir) (dolist (file (file-name-all-completions - (file-name-nondirectory string) dir)) - (add-to-list 'names (if string-dir (concat string-dir file) file)) + string-file dir)) + (push file names) (when (string-match suffix file) (setq file (substring file 0 (match-beginning 0))) - (push (if string-dir (concat string-dir file) file) names))))) - (complete-with-action action names string pred)))) + (push file names))))) + (completion-table-with-context + string-dir names string-file pred action))))) (defun locate-file-completion (string path-and-suffixes action) "Do completion for file names passed to `locate-file'. @@ -1469,18 +1486,29 @@ killed." t))) (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions) (error "Aborted")) - (when (and (buffer-modified-p) (buffer-file-name)) - (if (yes-or-no-p (format "Buffer %s is modified; kill anyway? " - (buffer-name))) - (unless (yes-or-no-p "Kill and replace the buffer without saving it? ") - (error "Aborted")) - (save-buffer))) + (when (and (buffer-modified-p) buffer-file-name) + (if (yes-or-no-p (format "Buffer %s is modified; save it first? " + (buffer-name))) + (save-buffer) + (unless (yes-or-no-p "Kill and replace the buffer without saving it? ") + (error "Aborted")))) (let ((obuf (current-buffer)) (ofile buffer-file-name) (onum buffer-file-number) (odir dired-directory) (otrue buffer-file-truename) (oname (buffer-name))) + ;; Run `kill-buffer-hook' here. It needs to happen before + ;; variables like `buffer-file-name' etc are set to nil below, + ;; because some of the hooks that could be invoked + ;; (e.g., `save-place-to-alist') depend on those variables. + ;; + ;; Note that `kill-buffer-hook' is not what queries whether to + ;; save a modified buffer visiting a file. Rather, `kill-buffer' + ;; asks that itself. Thus, there's no need to temporarily do + ;; `(set-buffer-modified-p nil)' before running this hook. + (run-hooks 'kill-buffer-hook) + ;; Okay, now we can end-of-life the old buffer. (if (get-buffer " **lose**") (kill-buffer " **lose**")) (rename-buffer " **lose**") @@ -1508,8 +1536,8 @@ killed." (rename-buffer oname))) (unless (eq (current-buffer) obuf) (with-current-buffer obuf - ;; We already asked; don't ask again. - (let ((kill-buffer-query-functions)) + ;; We already ran these; don't run them again. + (let (kill-buffer-query-functions kill-buffer-hook) (kill-buffer obuf)))))) (defun create-file-buffer (filename) @@ -2098,7 +2126,7 @@ not set local variables (though we do notice a mode specified with -*-.) or from Lisp without specifying the optional argument FIND-FILE; in that case, this function acts as if `enable-local-variables' were t." (interactive) - (funcall (or default-major-mode 'fundamental-mode)) + (funcall (or (default-value 'major-mode) 'fundamental-mode)) (let ((enable-local-variables (or (not find-file) enable-local-variables))) (report-errors "File mode specification error: %s" (set-auto-mode)) @@ -2144,7 +2172,6 @@ since only a single case-insensitive search through the alist is made." ("\\.dtx\\'" . doctex-mode) ("\\.org\\'" . org-mode) ("\\.el\\'" . emacs-lisp-mode) - ("Project\\.ede\\'" . emacs-lisp-mode) ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) ("\\.li?sp\\'" . lisp-mode) @@ -2152,13 +2179,14 @@ since only a single case-insensitive search through the alist is made." ("\\.for\\'" . fortran-mode) ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) + ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) ("\\.ad[abs]\\'" . ada-mode) ("\\.ad[bs].dg\\'" . ada-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) ("Imakefile\\'" . makefile-imake-mode) ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk ("\\.makepp\\'" . makefile-makepp-mode) - ,@(if (memq system-type '(berkeley-unix next-mach darwin)) + ,@(if (memq system-type '(berkeley-unix darwin)) '(("\\.mk\\'" . makefile-bsdmake-mode) ("GNUmakefile\\'" . makefile-gmake-mode) ("[Mm]akefile\\'" . makefile-bsdmake-mode)) @@ -2203,7 +2231,6 @@ since only a single case-insensitive search through the alist is made." ("\\.f9[05]\\'" . f90-mode) ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode ("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode) - ("\\.srt\\'" . srecode-template-mode) ; in the CEDET library ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ;; The list of archive file extensions should be in sync with @@ -2308,6 +2335,7 @@ appear in `auto-coding-alist' with `no-conversion' coding system. See also `interpreter-mode-alist', which detects executable script modes based on the interpreters they specify to run, and `magic-mode-alist', which determines modes based on file contents.") +(put 'auto-mode-alist 'risky-local-variable t) (defun conf-mode-maybe () "Select Conf mode or XML mode according to start of file." @@ -2401,6 +2429,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying (defvar magic-fallback-mode-alist `((image-type-auto-detected-p . image-mode) + ("\\(PK00\\)?[P]K\003\004" . archive-mode) ; zip ;; The < comes before the groups (but the first) to reduce backtracking. ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff. ;; We use [ \t\r\n] instead of `\\s ' to make regex overflow less likely. @@ -2643,6 +2672,7 @@ Otherwise, return nil; point may be changed." '(ignored-local-variables safe-local-variable-values file-local-variables-alist dir-local-variables-alist) "Variables to be ignored in a file's local variable spec.") +(put 'ignored-local-variables 'risky-local-variable t) (defvar hack-local-variables-hook nil "Normal hook run after processing a file's local variables specs. @@ -2653,14 +2683,18 @@ in order to initialize other data structure based on them.") "List variable-value pairs that are considered safe. Each element is a cons cell (VAR . VAL), where VAR is a variable symbol and VAL is a value that is considered safe." + :risky t :group 'find-file :type 'alist) -(defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp)) +(defcustom safe-local-eval-forms + '((add-hook 'write-file-functions 'time-stamp) + (add-hook 'before-save-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." + :risky t :group 'find-file :version "22.2" :type '(repeat sexp)) @@ -2668,63 +2702,34 @@ asking you for confirmation." ;; Risky local variables: (mapc (lambda (var) (put var 'risky-local-variable t)) '(after-load-alist - auto-mode-alist buffer-auto-save-file-name buffer-file-name buffer-file-truename buffer-undo-list - dabbrev-case-fold-search - dabbrev-case-replace debugger default-text-properties - display-time-string - enable-local-eval - enable-local-variables eval exec-directory exec-path file-name-handler-alist - font-lock-defaults - format-alist frame-title-format global-mode-string header-line-format icon-title-format - ignored-local-variables - imenu--index-alist - imenu-generic-expression inhibit-quit - input-method-alist load-path max-lisp-eval-depth max-specpdl-size - minor-mode-alist minor-mode-map-alist minor-mode-overriding-map-alist - mode-line-buffer-identification mode-line-format - mode-line-client - mode-line-modes - mode-line-modified - mode-line-mule-info - mode-line-position - mode-line-process - mode-line-remote mode-name - outline-level overriding-local-map overriding-terminal-local-map - parse-time-rules process-environment - rmail-output-file-alist - safe-local-variable-values - safe-local-eval-forms - save-some-buffers-action-alist - special-display-buffer-names standard-input standard-output - unread-command-events - vc-mode)) + unread-command-events)) ;; Safe local variables: ;; @@ -4401,6 +4406,7 @@ This requires the external program `diff' to be in your `exec-path'." nil) "view changes in this buffer")) "ACTION-ALIST argument used in call to `map-y-or-n-p'.") +(put 'save-some-buffers-action-alist 'risky-local-variable t) (defvar buffer-save-without-query nil "Non-nil means `save-some-buffers' should save this buffer without asking.") @@ -5400,17 +5406,13 @@ program specified by `directory-free-space-program' if that is non-nil." (let ((fsinfo (file-system-info dir))) (if fsinfo (format "%.0f" (/ (nth 2 fsinfo) 1024)))) + (setq dir (expand-file-name dir)) (save-match-data (with-temp-buffer (when (and directory-free-space-program ;; Avoid failure if the default directory does ;; not exist (Bug#2631, Bug#3911). - (let ((default-directory default-directory)) - (setq dir (expand-file-name dir)) - (unless (and (not (file-remote-p default-directory)) - (file-directory-p default-directory) - (file-readable-p default-directory)) - (setq default-directory "/")) + (let ((default-directory "/")) (eq (call-process directory-free-space-program nil t nil directory-free-space-args diff --git a/lisp/filesets.el b/lisp/filesets.el index c15e0231f00..e287c149202 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1641,7 +1641,7 @@ Replace <file-name> or <<file-name>> with filename." (let ((buffer (filesets-find-file this))) (when buffer (goto-char (point-min)) - (let () + (progn (cond ((stringp fn) (let* ((args diff --git a/lisp/font-core.el b/lisp/font-core.el index 88c67d8dece..7112b6b227c 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -75,6 +75,8 @@ Other variables include that for syntactic keyword fontification, functions, `font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function', `font-lock-fontify-region-function', `font-lock-unfontify-region-function', and `font-lock-inhibit-thing-lock'.") +;; Autoload if this file no longer dumped. +(put 'font-lock-defaults 'risky-local-variable t) (make-variable-buffer-local 'font-lock-defaults) (defvar font-lock-defaults-alist nil @@ -297,8 +299,9 @@ means that Font Lock mode is turned on for buffers in C and C++ modes only." (define-globalized-minor-mode global-font-lock-mode font-lock-mode turn-on-font-lock-if-desired - :extra-args (dummy) - :initialize 'custom-initialize-safe-default + ;; What was this :extra-args thingy for? --Stef + ;; :extra-args (dummy) + :initialize 'custom-initialize-delay :init-value (not (or noninteractive emacs-basic-display)) :group 'font-lock :version "22.1") diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 45e8a70ee6d..4d8198292f8 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2265,7 +2265,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "save-match-data" "save-current-buffer" "unwind-protect" "condition-case" "track-mouse" "eval-after-load" "eval-and-compile" "eval-when-compile" - "eval-when" "eval-at-startup" "eval-next-after-load" + "eval-when" "eval-next-after-load" "with-case-table" "with-category-table" "with-current-buffer" "with-electric-help" "with-local-quit" "with-no-warnings" @@ -2283,7 +2283,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "restart-bind" "restart-case" "in-package" "break" "ignore-errors" "loop" "do" "do*" "dotimes" "dolist" "the" "locally" - "proclaim" "declaim" "declare" "symbol-macrolet" + "proclaim" "declaim" "declare" "symbol-macrolet" "letf" "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" "destructuring-bind" "macrolet" "tagbody" "block" "go" "multiple-value-bind" "multiple-value-prog1" diff --git a/lisp/format.el b/lisp/format.el index 27253a2c47d..f15026147c7 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -1,7 +1,7 @@ ;;; format.el --- read and save files in multiple formats -;; Copyright (C) 1994, 1995, 1997, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> @@ -106,9 +106,9 @@ DOC-STR should be a single line providing more information about the the user if they ask for more information. REGEXP is a regular expression to match against the beginning of the file; - it should match only files in that format. Use nil to avoid - matching at all for formats for which it isn't appropriate to - require explicit encoding/decoding. + it should match only files in that format. REGEXP may be nil, in + which case the format will never be applied automatically to a file. + Use this for formats that you only ever want to apply manually. FROM-FN is called to decode files in that format; it takes two args, BEGIN and END, and can make any modifications it likes, returning the new @@ -136,6 +136,8 @@ MODE-FN, if specified, is called when visiting a file with that format. PRESERVE, if non-nil, means that `format-write-file' should not remove this format from `buffer-file-format'.") +;; Autoload if this file no longer dumped. +(put 'format-alist 'risky-local-variable t) ;;; Basic Functions (called from Lisp) diff --git a/lisp/frame.el b/lisp/frame.el index 35cbbfbe1a2..e5d92fa1df3 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1605,7 +1605,7 @@ cursor display. On a text-only terminal, this is not implemented." no-blinking-cursor (eq system-type 'ms-dos) (not (memq window-system '(x w32))))) - :initialize 'custom-initialize-safe-default + :initialize 'custom-initialize-delay :group 'cursor :global t (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer)) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 3677c9732a9..06e663441bd 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1,7 +1,7 @@ ;;; generic-x.el --- A collection of generic modes -;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Created: Tue Oct 08 1996 @@ -1775,8 +1775,7 @@ like an INI file. You can add this hook to `find-file-hook'." (t (:weight bold))) "Font Lock mode face used to highlight TABs." :group 'generic-x) -;; backward-compatibility alias -(put 'show-tabs-tab-face 'face-alias 'show-tabs-tab) +(define-obsolete-face-alias 'show-tabs-tab-face 'show-tabs-tab "22.1") (defface show-tabs-space '((((class grayscale) (background light)) (:background "DimGray" :weight bold)) @@ -1786,8 +1785,7 @@ like an INI file. You can add this hook to `find-file-hook'." (t (:weight bold))) "Font Lock mode face used to highlight spaces." :group 'generic-x) -;; backward-compatibility alias -(put 'show-tabs-space-face 'face-alias 'show-tabs-space) +(define-obsolete-face-alias 'show-tabs-space-face 'show-tabs-space "22.1") (define-generic-mode show-tabs-generic-mode nil ;; no comment char diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index cd5bcc4f4d3..39ec4899fc2 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,212 @@ +2009-09-23 Juanma Barranquero <lekktu@gmail.com> + + * gnus-art.el (gnus-article-encrypt-body): + * message.el (message-check-recipients): + * mm-util.el (mm-codepage-setup): + * nnir.el (gnus-summary-nnir-goto-thread, nnir-run-waissearch) + (nnir-run-swish++, nnir-run-swish-e): Fix typos in error messages. + +2009-09-22 Daiki Ueno <ueno@unixuser.org> + + * mm-encode.el (mm-sign-option, mm-encrypt-option): New user option. + * mml2015.el (mml2015-epg-sign, mml2015-epg-encrypt): Let users select + keys from the menu if mm-{sign,encrypt}-option is 'guided. + * mml-smime.el (mml-smime-epg-sign, mml-smime-epg-encrypt): Ditto. + * mml1991.el (mml1991-epg-sign, mml1991-epg-encrypt): Ditto. + +2009-09-18 Glenn Morris <rgm@gnu.org> + + * gnus-diary.el (gnus-diary-check-message): + * message.el (message-insert-formatted-citation-line): + * nnbabyl.el (top-level): + * nndiary.el (nndiary-schedule): + Fix typos in condition-case handlers. + +2009-09-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-edit-part): Work for the buffer + configuration that provides the sole article window in a frame; + position point correctly after deleting a part. + +2009-09-14 Adam Sjøgren <asjo@koldfront.dk> + + * spam.el (spam-unregister-on-reregister): Add boolean variable. + (spam-resolve-registrations-routine): Use it to unregister articles + that change status. + +2009-09-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnrss.el (nnrss-request-article): Remove binding of + default-enable-multibyte-characters that has gotten needless by + the 2007-07-13 change in rfc2047-encode-message-header. + + * mml.el (mml-insert-multipart): Error on the message header. + (mml-insert-part): Error on the message header; position point at + the end of a MIME tag. + +2009-09-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (with-no-warnings): Define it for old Emacsen. + (gnus-float-time): Alias to float-time if it exists. + + * ecomplete.el (with-no-warnings): Define it for old Emacsen. + (ecomplete-add-item): Don't use (featurep 'xemacs) to check if + float-time is available; suppress compile warning for time-to-seconds. + +2009-09-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-encode.el (mm-encode-buffer): Don't force 7bit encoding since MTA + may break data. Suggested by Dmitri Paduchikh <dpaduch@k66.ru>. + Add the optional argument `encoding' that overrides the default. + + * mml.el (mml-generate-mime-1): Pass encoding defined by a user to + mm-encode-buffer. + +2009-09-04 Glenn Morris <rgm@gnu.org> + + * qp.el (quoted-printable-encode-string): Use mm-enable-multibyte, or + mm-disable-multibyte, rather than default-enable-multibyte-characters. + * utf7.el (utf7-encode, utf7-decode): Use mm-with-multibyte-buffer, or + mm-with-unibyte-buffer, rather than default-enable-multibyte-characters. + * mm-util.el (mm-with-unibyte-current-buffer) + (mm-find-buffer-file-coding-system): + * yenc.el (yenc-decode-region): Use default-value rather than + default-enable-multibyte-characters. + +2009-09-03 Glenn Morris <rgm@gnu.org> + + * mm-util.el (mm-emacs-mule, mm-default-multibyte-p): + * rfc2047.el (rfc2047-encode-message-header): Use default-value rather + than default-enable-multibyte-characters. + +2009-09-02 Karl Kleinpaste <karl@kleinpaste.org> + + * gnus-art.el (gnus-article-read-summary-keys): + Fix gnus-buffer-configuration's value temporarily used. + +2009-09-02 Glenn Morris <rgm@gnu.org> + + * gnus-util.el (gnus-float-time): New function. + * gnus-delay.el (gnus-delay-article): + * gnus-sum.el (gnus-thread-latest-date): + * gnus-util.el (gnus-user-date): Use gnus-float-time. + * nnspool.el (nnspool-request-newgroups): + Use gnus-float-time rather than time-to-seconds. + * ecomplete.el (ecomplete-add-item): In Emacs, use float-time. + + * gnus-art.el (gnus-signature-face, gnus-header-from-face) + (gnus-header-subject-face, gnus-header-newsgroups-face) + (gnus-header-name-face, gnus-header-content-face): + * gnus-cite.el (gnus-cite-attribution-face, gnus-cite-face-1) + (gnus-cite-face-2, gnus-cite-face-3, gnus-cite-face-4) + (gnus-cite-face-5, gnus-cite-face-6, gnus-cite-face-7) + (gnus-cite-face-8, gnus-cite-face-9, gnus-cite-face-10) + (gnus-cite-face-11): + * gnus-picon.el (gnus-picon-xbm-face, gnus-picon-face): + * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) + (gnus-server-closed-face, gnus-server-denied-face) + (gnus-server-offline-face): + * gnus.el (gnus-group-news-1-face, gnus-group-news-1-empty-face) + (gnus-group-news-2-face, gnus-group-news-2-empty-face) + (gnus-group-news-3-face, gnus-group-news-3-empty-face) + (gnus-group-news-4-face, gnus-group-news-4-empty-face) + (gnus-group-news-5-face, gnus-group-news-5-empty-face) + (gnus-group-news-6-face, gnus-group-news-6-empty-face) + (gnus-group-news-low-face, gnus-group-news-low-empty-face) + (gnus-group-mail-1-face, gnus-group-mail-1-empty-face) + (gnus-group-mail-2-face, gnus-group-mail-2-empty-face) + (gnus-group-mail-3-face, gnus-group-mail-3-empty-face) + (gnus-group-mail-low-face, gnus-group-mail-low-empty-face) + (gnus-summary-selected-face, gnus-summary-cancelled-face) + (gnus-summary-high-ticked-face, gnus-summary-low-ticked-face) + (gnus-summary-normal-ticked-face, gnus-summary-high-ancient-face) + (gnus-summary-low-ancient-face, gnus-summary-normal-ancient-face) + (gnus-summary-high-undownloaded-face) + (gnus-summary-low-undownloaded-face) + (gnus-summary-normal-undownloaded-face) + (gnus-summary-high-unread-face, gnus-summary-low-unread-face) + (gnus-summary-normal-unread-face, gnus-summary-high-read-face) + (gnus-summary-low-read-face, gnus-summary-normal-read-face) + (gnus-splash-face): + * message.el (message-header-to-face, message-header-cc-face) + (message-header-subject-face, message-header-newsgroups-face) + (message-header-other-face, message-header-name-face) + (message-header-xheader-face, message-separator-face) + (message-cited-text-face, message-mml-face): + * sieve-mode.el (sieve-control-commands-face) + (sieve-action-commands-face, sieve-test-commands-face) + (sieve-tagged-arguments-face): + * spam.el (spam-face): + Mark face aliases with "-face" in the name as obsolete. + +2009-09-01 Glenn Morris <rgm@gnu.org> + + * gnus-salt.el (gnus-pick-mouse-pick-region): Use forward-line rather + than goto-line. + +2009-08-31 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-attach-file, mml-attach-buffer, mml-attach-external): + Don't move point if the command is invoked inside the message header. + +2009-08-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * spam.el (spam-ifile-path, spam-bogofilter-path, spam-sa-learn-path) + (spam-ifile-database-path, spam-bsfilter-path, spam-spamassassin-path): + * nnmail.el (nnmail-spool-file, nnmail-fix-eudora-headers): + * nnir.el (nnir-swish-e-index-file): + * gnus-sum.el (gnus-summary-delete-marked-as-read) + (gnus-summary-delete-marked-with, gnus-summary-mark-as-unread-forward) + (gnus-summary-mark-as-unread-backward, gnus-summary-mark-as-unread): + * gnus-msg.el (gnus-inews-mark-gcc-as-read): + * gnus-art.el (gnus-article-hide-pgp-hook, gnus-treat-strip-pgp) + (gnus-treat-display-xface): Add Emacs version of obsolescence. + +2009-08-28 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-attach-file, mml-attach-buffer, mml-attach-external): + Don't save excursion. + +2009-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * nnheader.el (nnheader-find-file-noselect): + * mm-util.el (mm-insert-file-contents): + Use (default-value 'major-mode) instead of default-major-mode. + +2009-08-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * nnrss.el (nnrss-request-article): Avoid default-fill-column. + +2009-08-25 Glenn Morris <rgm@gnu.org> + + * nnir.el (top-level): Don't require cl at run-time. + (nnir-run-waissearch, nnir-run-swish-e, nnir-run-hyrex): + Replace cl-function substitute with gnus-replace-in-string. + (nnir-run-waissearch, nnir-run-swish++, nnir-run-swish-e) + (nnir-run-hyrex, nnir-run-namazu): Replace cl-function sort* with sort. + (nnir-run-find-grep): Replace cl-functions find-if and subseq with + simplified expansions. + +2009-08-22 Glenn Morris <rgm@gnu.org> + + * gnus-art.el (gnus-button-patch): Use forward-line rather than + goto-line. + +2009-08-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-group.el (gnus-safe-html-newsgroups): New user option. + + * gnus-art.el (gnus-bind-safe-url-regexp): New macro. + (gnus-mime-view-all-parts, gnus-mime-view-part-internally) + (gnus-mm-display-part, gnus-mime-display-single) + (gnus-mime-display-alternative): Use gnus-bind-safe-url-regexp to + override mm-w3m-safe-url-regexp according to gnus-safe-html-newsgroups. + + * gnus-sum.el + (gnus-mark-copied-or-moved-articles-as-expirable): New user option. + (gnus-summary-move-article): Add expirable mark to articles copied or + moved to group that has auto-expire turned on if the option is non-nil. + 2009-07-24 Glenn Morris <rgm@gnu.org> * gnus-demon.el (gnus-demon-add-nntp-close-connection): @@ -10597,7 +10806,6 @@ * message.el (message-mode): Set comment-start-skip. - 2004-08-22 Sam Steingold <sds@gnu.org> * pop3.el (pop3-leave-mail-on-server): New user variable. @@ -12926,7 +13134,6 @@ macros (gnus-group-entry, gnus-group-unread, gnus-info-marks etc.) to get group information for improved readability. - 2004-01-09 Jesper Harder <harder@ifa.au.dk> * gnus-art.el (article-decode-mime-words, article-babel) diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el index fd9dfa63b6d..ece8f2deff4 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/gnus/ecomplete.el @@ -27,6 +27,11 @@ (eval-when-compile (require 'cl)) +(eval-when-compile + (unless (fboundp 'with-no-warnings) + (defmacro with-no-warnings (&rest body) + `(progn ,@body)))) + (defgroup ecomplete nil "Electric completion of email addresses and the like." :group 'mail) @@ -56,7 +61,11 @@ (defun ecomplete-add-item (type key text) (let ((elems (assq type ecomplete-database)) (now (string-to-number - (format "%.0f" (time-to-seconds (current-time))))) + (format "%.0f" (if (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (float-time) + (with-no-warnings + (time-to-seconds (current-time))))))) entry) (unless elems (push (setq elems (list type)) ecomplete-database)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 09f481763df..fa13947d7c8 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -727,8 +727,8 @@ Each element is a regular expression." :type '(repeat regexp) :group 'gnus-article-various) -(make-obsolete-variable 'gnus-article-hide-pgp-hook - "This variable is obsolete in Gnus 5.10.") +(make-obsolete-variable 'gnus-article-hide-pgp-hook nil + "Gnus 5.10 (Emacs-22.1)") (defface gnus-button '((t (:weight bold))) @@ -766,6 +766,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." :group 'gnus-article-signature) ;; backward-compatibility alias (put 'gnus-signature-face 'face-alias 'gnus-signature) +(put 'gnus-signature-face 'obsolete-face "22.1") (defface gnus-header-from '((((class color) @@ -781,6 +782,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." :group 'gnus-article-highlight) ;; backward-compatibility alias (put 'gnus-header-from-face 'face-alias 'gnus-header-from) +(put 'gnus-header-from-face 'obsolete-face "22.1") (defface gnus-header-subject '((((class color) @@ -796,6 +798,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." :group 'gnus-article-highlight) ;; backward-compatibility alias (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject) +(put 'gnus-header-subject-face 'obsolete-face "22.1") (defface gnus-header-newsgroups '((((class color) @@ -813,6 +816,7 @@ articles." :group 'gnus-article-highlight) ;; backward-compatibility alias (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups) +(put 'gnus-header-newsgroups-face 'obsolete-face "22.1") (defface gnus-header-name '((((class color) @@ -828,6 +832,7 @@ articles." :group 'gnus-article-highlight) ;; backward-compatibility alias (put 'gnus-header-name-face 'face-alias 'gnus-header-name) +(put 'gnus-header-name-face 'obsolete-face "22.1") (defface gnus-header-content '((((class color) @@ -842,6 +847,7 @@ articles." :group 'gnus-article-highlight) ;; backward-compatibility alias (put 'gnus-header-content-face 'face-alias 'gnus-header-content) +(put 'gnus-header-content-face 'obsolete-face "22.1") (defcustom gnus-header-face-alist '(("From" nil gnus-header-from) @@ -1217,8 +1223,8 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(make-obsolete-variable 'gnus-treat-strip-pgp - "This option is obsolete in Gnus 5.10.") +(make-obsolete-variable 'gnus-treat-strip-pgp nil + "Gnus 5.10 (Emacs 22.1)") (defcustom gnus-treat-strip-pem nil "Strip PEM signatures. @@ -1409,7 +1415,7 @@ predicate. See Info node `(gnus)Customizing Articles'." :type gnus-article-treat-custom) (make-obsolete-variable 'gnus-treat-display-xface - 'gnus-treat-display-x-face) + 'gnus-treat-display-x-face "22.1") (defcustom gnus-treat-display-x-face (and (not noninteractive) @@ -4740,6 +4746,23 @@ General format specifiers can also be used. See Info node (vector (caddr c) (car c) :active t)) gnus-mime-button-commands))) +(defmacro gnus-bind-safe-url-regexp (&rest body) + "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'." + `(let ((mm-w3m-safe-url-regexp + (let ((group (if (and (eq major-mode 'gnus-article-mode) + (gnus-buffer-live-p + gnus-article-current-summary)) + (with-current-buffer gnus-article-current-summary + gnus-newsgroup-name) + gnus-newsgroup-name))) + (if (cond ((stringp gnus-safe-html-newsgroups) + (string-match gnus-safe-html-newsgroups group)) + ((consp gnus-safe-html-newsgroups) + (member group gnus-safe-html-newsgroups))) + nil + mm-w3m-safe-url-regexp)))) + ,@body)) + (defun gnus-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." (interactive "e\nP") @@ -4765,7 +4788,7 @@ General format specifiers can also be used. See Info node (or (search-forward "\n\n") (goto-char (point-max))) (let ((inhibit-read-only t)) (delete-region (point) (point-max)) - (mm-display-parts handles)))))) + (gnus-bind-safe-url-regexp (mm-display-parts handles))))))) (defun gnus-article-jump-to-part (n) "Jump to MIME part N." @@ -4839,15 +4862,9 @@ and `gnus-mime-delete-part', and not provided at run-time normally." ,gnus-summary-buffer no-highlight)) t) (gnus-article-edit-done) - (gnus-summary-expand-window) - (gnus-summary-show-article) + (gnus-configure-windows 'article) (when (and current-id (integerp gnus-auto-select-part)) - (gnus-article-jump-to-part - (if (text-property-any (point-min) (point-max) - 'gnus-part (+ current-id gnus-auto-select-part)) - (+ current-id gnus-auto-select-part) - (with-current-buffer gnus-article-buffer - (length gnus-article-mime-handle-alist))))))) + (gnus-article-jump-to-part (+ current-id gnus-auto-select-part))))) (defun gnus-mime-replace-part (file) "Replace MIME part under point with an external body." @@ -5267,7 +5284,7 @@ If no internal viewer is available, use an external viewer." (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle) - (mm-display-part handle)))))) + (gnus-bind-safe-url-regexp (mm-display-part handle))))))) (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." @@ -5488,7 +5505,7 @@ N is the numerical prefix." (save-restriction (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) - (mm-display-part handle) + (gnus-bind-safe-url-regexp (mm-display-part handle)) ;; We narrow to the part itself and ;; then call the treatment functions. (goto-char (point-min)) @@ -5767,7 +5784,7 @@ If displaying \"text/html\" is discouraged \(see (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets))) - (mm-display-part handle t)) + (gnus-bind-safe-url-regexp (mm-display-part handle t))) (goto-char (point-max))) ((and text not-attachment) (when move @@ -5903,7 +5920,7 @@ If displaying \"text/html\" is discouraged \(see (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) - (mm-display-part preferred) + (gnus-bind-safe-url-regexp (mm-display-part preferred)) ;; Do highlighting. (save-excursion (save-restriction @@ -6344,9 +6361,9 @@ not have a face in `gnus-article-boring-faces'." (gnus-configure-windows 'article) (unless (setq win (get-buffer-window summary-buffer 'visible)) (let ((gnus-buffer-configuration - '(article ((vertical 1.0 - (summary 0.25 point) - (article 1.0)))))) + '((article ((vertical 1.0 + (summary 0.25 point) + (article 1.0))))))) (gnus-configure-windows 'article)) (setq win (get-buffer-window summary-buffer 'visible))) (gnus-select-frame-set-input-focus (window-frame win)) @@ -7908,7 +7925,8 @@ url is put as the `gnus-button-url' overlay property on the button." (unless file (error "Couldn't find library %s" library)) (find-file file) - (goto-line (string-to-number line)))) + (goto-char (point-min)) + (forward-line (1- (string-to-number line))))) (defun gnus-button-handle-man (url) "Fetch a man page." @@ -8298,7 +8316,7 @@ For example: (when (and gnus-article-encrypt-protocol gnus-novice-user) (unless (gnus-y-or-n-p "Really encrypt article(s)? ") - (error "Encrypt aborted."))) + (error "Encrypt aborted"))) (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) (unless func (error "Can't find the encrypt protocol %s" protocol)) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 4e78437404e..039875d549d 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -142,6 +142,7 @@ the envelope From line." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution) +(put 'gnus-cite-attribution-face 'obsolete-face "22.1") (defcustom gnus-cite-attribution-face 'gnus-cite-attribution "Face used for attribution lines. @@ -162,6 +163,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-1 'face-alias 'gnus-cite-1) +(put 'gnus-cite-face-1 'obsolete-face "22.1") (defface gnus-cite-2 '((((class color) (background dark)) @@ -175,6 +177,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-2 'face-alias 'gnus-cite-2) +(put 'gnus-cite-face-2 'obsolete-face "22.1") (defface gnus-cite-3 '((((class color) (background dark)) @@ -188,6 +191,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-3 'face-alias 'gnus-cite-3) +(put 'gnus-cite-face-3 'obsolete-face "22.1") (defface gnus-cite-4 '((((class color) (background dark)) @@ -201,6 +205,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-4 'face-alias 'gnus-cite-4) +(put 'gnus-cite-face-4 'obsolete-face "22.1") (defface gnus-cite-5 '((((class color) (background dark)) @@ -214,6 +219,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-5 'face-alias 'gnus-cite-5) +(put 'gnus-cite-face-5 'obsolete-face "22.1") (defface gnus-cite-6 '((((class color) (background dark)) @@ -227,6 +233,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-6 'face-alias 'gnus-cite-6) +(put 'gnus-cite-face-6 'obsolete-face "22.1") (defface gnus-cite-7 '((((class color) (background dark)) @@ -240,6 +247,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-7 'face-alias 'gnus-cite-7) +(put 'gnus-cite-face-7 'obsolete-face "22.1") (defface gnus-cite-8 '((((class color) (background dark)) @@ -253,6 +261,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-8 'face-alias 'gnus-cite-8) +(put 'gnus-cite-face-8 'obsolete-face "22.1") (defface gnus-cite-9 '((((class color) (background dark)) @@ -266,6 +275,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-9 'face-alias 'gnus-cite-9) +(put 'gnus-cite-face-9 'obsolete-face "22.1") (defface gnus-cite-10 '((((class color) (background dark)) @@ -279,6 +289,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-10 'face-alias 'gnus-cite-10) +(put 'gnus-cite-face-10 'obsolete-face "22.1") (defface gnus-cite-11 '((((class color) (background dark)) @@ -292,6 +303,7 @@ It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite) ;; backward-compatibility alias (put 'gnus-cite-face-11 'face-alias 'gnus-cite-11) +(put 'gnus-cite-face-11 'obsolete-face "22.1") (defcustom gnus-cite-face-list '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6 diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 14480315f31..eb227d934cd 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -1,6 +1,7 @@ ;;; gnus-delay.el --- Delayed posting of articles -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> ;; Keywords: mail, news, extensions @@ -101,10 +102,10 @@ DELAY is a string, giving the length of the time. Possible values are: (aset deadline 1 minute) (aset deadline 2 hour) ;; Convert to seconds. - (setq deadline (time-to-seconds (apply 'encode-time + (setq deadline (gnus-float-time (apply 'encode-time (append deadline nil)))) ;; If this time has passed already, add a day. - (when (< deadline (time-to-seconds (current-time))) + (when (< deadline (gnus-float-time)) (setq deadline (+ 3600 deadline))) ;3600 secs/day ;; Convert seconds to date header. (setq deadline (message-make-date @@ -127,8 +128,7 @@ DELAY is a string, giving the length of the time. Possible values are: (t (setq delay (* num 60)))) (setq deadline (message-make-date - (seconds-to-time (+ (time-to-seconds (current-time)) - delay))))) + (seconds-to-time (+ (gnus-float-time) delay))))) (t (error "Malformed delay `%s'" delay))) (message-add-header (format "%s: %s" gnus-delay-header deadline))) (set-buffer-modified-p t) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 630066afafa..7ec4c6735b4 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -1,7 +1,7 @@ ;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Didier Verna <didier@xemacs.org> ;; Maintainer: Didier Verna <didier@xemacs.org> @@ -351,7 +351,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (condition-case () (nndiary-parse-schedule-value value (nth 1 head) (nth 2 head)) - (t + (error (setq invalid t))) ;; #### NOTE: this (along with the `gnus-diary-add-header' ;; function) could be rewritten in a better way, in particular @@ -378,7 +378,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (condition-case () (nndiary-parse-schedule-value value (nth 1 head) (nth 2 head)) - (t + (error (setq invalid t)))) (gnus-diary-add-header (concat header ": " value)) )) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 602ee31944a..4a7f06833a3 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -110,6 +110,18 @@ If nil, no groups are permanently visible." :group 'gnus-group-listing :type '(choice regexp (const nil))) +(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]" + "Groups in which links in html articles are considered all safe. +The value may be a regexp matching those groups, a list of group names, +or nil. This overrides `mm-w3m-safe-url-regexp' (which see). This is +effective only when emacs-w3m renders html articles, i.e., in the case +`mm-text-html-renderer' is set to `w3m'." + :version "23.2" + :group 'gnus-group-various + :type '(choice regexp + (repeat :tag "List of group names" (string :tag "Group")) + (const nil))) + (defcustom gnus-list-groups-with-ticked-articles t "*If non-nil, list groups that have only ticked articles. If nil, only list groups that have unread articles." diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 62f23cb169d..7257099dbbe 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -149,7 +149,7 @@ See Info node `(gnus)Posting Styles'." :type 'boolean) (make-obsolete-variable 'gnus-inews-mark-gcc-as-read - 'gnus-gcc-mark-as-read) + 'gnus-gcc-mark-as-read "Emacs 22.1") (defcustom gnus-gcc-externalize-attachments nil "Should local-file attachments be included as external parts in Gcc copies? diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 442e2bbdc5a..e9d2bd93c0a 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -90,12 +90,14 @@ added right to the textual representation." :group 'gnus-picon) ;; backward-compatibility alias (put 'gnus-picon-xbm-face 'face-alias 'gnus-picon-xbm) +(put 'gnus-picon-xbm-face 'obsolete-face "22.1") (defface gnus-picon '((t (:foreground "black" :background "white"))) "Face to show picon in." :group 'gnus-picon) ;; backward-compatibility alias (put 'gnus-picon-face 'face-alias 'gnus-picon) +(put 'gnus-picon-face 'obsolete-face "22.1") ;;; Internal variables: diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 1e1aed52b82..9b595a8e3ca 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -1,7 +1,7 @@ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -273,9 +273,9 @@ This must be bound to a button-down mouse event." (let* ((this-line (1+ (count-lines (point-min) end-point))) (min-line (min this-line start-line)) (max-line (max this-line start-line))) - ;; Why not use `forward-line'? --Stef (while (< min-line max-line) - (goto-line min-line) + (goto-char (point-min)) + (forward-line (1- min-line)) (gnus-pick-article) (setq min-line (1+ min-line))) (setq start-line this-line)) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 36c73eb42e6..8e3c6aaca3c 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -177,6 +177,7 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual) ;; backward-compatibility alias (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) +(put 'gnus-server-agent-face 'obsolete-face "22.1") (defface gnus-server-opened '((((class color) (background light)) (:foreground "Green3" :bold t)) @@ -186,6 +187,7 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual) ;; backward-compatibility alias (put 'gnus-server-opened-face 'face-alias 'gnus-server-opened) +(put 'gnus-server-opened-face 'obsolete-face "22.1") (defface gnus-server-closed '((((class color) (background light)) (:foreground "Steel Blue" :italic t)) @@ -196,6 +198,7 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual) ;; backward-compatibility alias (put 'gnus-server-closed-face 'face-alias 'gnus-server-closed) +(put 'gnus-server-closed-face 'obsolete-face "22.1") (defface gnus-server-denied '((((class color) (background light)) (:foreground "Red" :bold t)) @@ -205,6 +208,7 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual) ;; backward-compatibility alias (put 'gnus-server-denied-face 'face-alias 'gnus-server-denied) +(put 'gnus-server-denied-face 'obsolete-face "22.1") (defface gnus-server-offline '((((class color) (background light)) (:foreground "Orange" :bold t)) @@ -214,6 +218,7 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual) ;; backward-compatibility alias (put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) +(put 'gnus-server-offline-face 'obsolete-face "22.1") (defvar gnus-server-font-lock-keywords '(("(\\(agent\\))" 1 'gnus-server-agent) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 0624418f5ee..b1fa5254bdc 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -668,6 +668,17 @@ string with the suggested prefix." :group 'gnus-summary :type 'boolean) +(defcustom gnus-mark-copied-or-moved-articles-as-expirable nil + "If non-nil, mark articles copied or moved to auto-expire group as expirable. +If nil, the expirable marks will be unchanged except that the marks +will be removed when copying or moving articles to a group that has +not turned auto-expire on. If non-nil, articles that have been read +will be marked as expirable when being copied or moved to a group in +which auto-expire is turned on." + :version "23.2" + :type 'boolean + :group 'gnus-summary-marks) + (defcustom gnus-view-pseudos nil "*If `automatic', pseudo-articles will be viewed automatically. If `not-confirm', pseudos will be viewed automatically, and the user @@ -4991,7 +5002,7 @@ Unscored articles will be counted as having a score of zero." (lambda (header) (setq previous-time (condition-case () - (time-to-seconds (mail-header-parse-date + (gnus-float-time (mail-header-parse-date (mail-header-date header))) (error previous-time)))) (sort @@ -8273,7 +8284,7 @@ articles that are younger than AGE days." (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) + 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4") (defun gnus-summary-limit-to-unread (&optional all) "Limit the summary buffer to articles that are not marked as read. @@ -8368,7 +8379,7 @@ If UNREPLIED (the prefix), limit to unreplied articles." (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) (make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exclude-marks) + 'gnus-summary-limit-exclude-marks "Emacs 20.4") (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). @@ -9753,11 +9764,12 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (list (cdr art-group))))) ;; See whether the article is to be put in the cache. - (let ((marks (if (gnus-group-auto-expirable-p to-group) - gnus-article-mark-lists - (delete '(expirable . expire) - (copy-sequence gnus-article-mark-lists)))) - (to-article (cdr art-group))) + (let* ((expirable (gnus-group-auto-expirable-p to-group)) + (marks (if expirable + gnus-article-mark-lists + (delete '(expirable . expire) + (copy-sequence gnus-article-mark-lists)))) + (to-article (cdr art-group))) ;; Enter the article into the cache in the new group, ;; if that is required. @@ -9796,6 +9808,17 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-group (cdar marks) (list to-article) info))) (setq marks (cdr marks))) + (when (and expirable + gnus-mark-copied-or-moved-articles-as-expirable + (not (memq 'expire to-marks))) + ;; Mark this article as expirable. + (push 'expire to-marks) + (when (equal to-group gnus-newsgroup-name) + (push to-article gnus-newsgroup-expirable)) + ;; Copy the expirable mark to other group. + (gnus-add-marked-articles + to-group 'expire (list to-article) info)) + (gnus-request-set-mark to-group (list (list (list to-article) 'add to-marks)))) @@ -10798,7 +10821,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (defalias 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (make-obsolete 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) + 'gnus-summary-tick-article-forward "Emacs 20.4") (defun gnus-summary-tick-article-forward (n) "Tick N articles forwards. If N is negative, tick backwards instead. @@ -10809,7 +10832,7 @@ The difference between N and the number of articles ticked is returned." (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (make-obsolete 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) + 'gnus-summary-tick-article-backward "Emacs 20.4") (defun gnus-summary-tick-article-backward (n) "Tick N articles backwards. The difference between N and the number of articles ticked is returned." @@ -10817,7 +10840,7 @@ The difference between N and the number of articles ticked is returned." (gnus-summary-mark-forward (- n) gnus-ticked-mark)) (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) +(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article "Emacs 20.4") (defun gnus-summary-tick-article (&optional article clear-mark) "Mark current article as unread. Optional 1st argument ARTICLE specifies article number to be marked as unread. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 3827bc17c5d..28a8c5dbed4 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -38,6 +38,12 @@ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) + +(eval-when-compile + (unless (fboundp 'with-no-warnings) + (defmacro with-no-warnings (&rest body) + `(progn ,@body)))) + ;; Fixme: this should be a gnus variable, not nnmail-. (defvar nnmail-pathname-coding-system) (defvar nnmail-active-file-coding-system) @@ -285,6 +291,15 @@ Symbols are also allowed; their print names are used instead." (and (= (car fdate) (car date)) (> (nth 1 fdate) (nth 1 date)))))) +(eval-and-compile + (if (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defalias 'gnus-float-time 'float-time) + (defun gnus-float-time (&optional time) + "Convert time value TIME to a floating point number. +TIME defaults to the current time." + (with-no-warnings (time-to-seconds (or time (current-time))))))) + ;;; Keymap macros. (defmacro gnus-local-set-keys (&rest plist) @@ -443,8 +458,8 @@ respectively.") Returns \" ? \" if there's bad input or if an other error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () - (let* ((messy-date (time-to-seconds (safe-date-to-time messy-date))) - (now (time-to-seconds (current-time))) + (let* ((messy-date (gnus-float-time (safe-date-to-time messy-date))) + (now (gnus-float-time)) ;;If we don't find something suitable we'll use this one (my-format "%b %d '%y")) (let* ((difference (- now messy-date)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 0fae8db4f76..85baa71f2a3 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -378,6 +378,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1) +(put 'gnus-group-news-1-face 'obsolete-face "22.1") (defface gnus-group-news-1-empty '((((class color) @@ -392,6 +393,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty) +(put 'gnus-group-news-1-empty-face 'obsolete-face "22.1") (defface gnus-group-news-2 '((((class color) @@ -406,6 +408,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2) +(put 'gnus-group-news-2-face 'obsolete-face "22.1") (defface gnus-group-news-2-empty '((((class color) @@ -420,6 +423,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty) +(put 'gnus-group-news-2-empty-face 'obsolete-face "22.1") (defface gnus-group-news-3 '((((class color) @@ -434,6 +438,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3) +(put 'gnus-group-news-3-face 'obsolete-face "22.1") (defface gnus-group-news-3-empty '((((class color) @@ -448,6 +453,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty) +(put 'gnus-group-news-3-empty-face 'obsolete-face "22.1") (defface gnus-group-news-4 '((((class color) @@ -462,6 +468,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4) +(put 'gnus-group-news-4-face 'obsolete-face "22.1") (defface gnus-group-news-4-empty '((((class color) @@ -476,6 +483,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty) +(put 'gnus-group-news-4-empty-face 'obsolete-face "22.1") (defface gnus-group-news-5 '((((class color) @@ -490,6 +498,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5) +(put 'gnus-group-news-5-face 'obsolete-face "22.1") (defface gnus-group-news-5-empty '((((class color) @@ -504,6 +513,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty) +(put 'gnus-group-news-5-empty-face 'obsolete-face "22.1") (defface gnus-group-news-6 '((((class color) @@ -518,6 +528,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6) +(put 'gnus-group-news-6-face 'obsolete-face "22.1") (defface gnus-group-news-6-empty '((((class color) @@ -532,6 +543,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty) +(put 'gnus-group-news-6-empty-face 'obsolete-face "22.1") (defface gnus-group-news-low '((((class color) @@ -546,6 +558,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low) +(put 'gnus-group-news-low-face 'obsolete-face "22.1") (defface gnus-group-news-low-empty '((((class color) @@ -560,6 +573,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty) +(put 'gnus-group-news-low-empty-face 'obsolete-face "22.1") (defface gnus-group-mail-1 '((((class color) @@ -574,6 +588,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1) +(put 'gnus-group-mail-1-face 'obsolete-face "22.1") (defface gnus-group-mail-1-empty '((((class color) @@ -588,6 +603,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty) +(put 'gnus-group-mail-1-empty-face 'obsolete-face "22.1") (defface gnus-group-mail-2 '((((class color) @@ -602,6 +618,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2) +(put 'gnus-group-mail-2-face 'obsolete-face "22.1") (defface gnus-group-mail-2-empty '((((class color) @@ -616,6 +633,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty) +(put 'gnus-group-mail-2-empty-face 'obsolete-face "22.1") (defface gnus-group-mail-3 '((((class color) @@ -630,6 +648,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3) +(put 'gnus-group-mail-3-face 'obsolete-face "22.1") (defface gnus-group-mail-3-empty '((((class color) @@ -644,6 +663,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty) +(put 'gnus-group-mail-3-empty-face 'obsolete-face "22.1") (defface gnus-group-mail-low '((((class color) @@ -658,6 +678,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low) +(put 'gnus-group-mail-low-face 'obsolete-face "22.1") (defface gnus-group-mail-low-empty '((((class color) @@ -672,6 +693,7 @@ be set in `.emacs' instead." :group 'gnus-group) ;; backward-compatibility alias (put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty) +(put 'gnus-group-mail-low-empty-face 'obsolete-face "22.1") ;; Summary mode faces. @@ -680,6 +702,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected) +(put 'gnus-summary-selected-face 'obsolete-face "22.1") (defface gnus-summary-cancelled '((((class color)) @@ -688,6 +711,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled) +(put 'gnus-summary-cancelled-face 'obsolete-face "22.1") (defface gnus-summary-high-ticked '((((class color) @@ -702,6 +726,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked) +(put 'gnus-summary-high-ticked-face 'obsolete-face "22.1") (defface gnus-summary-low-ticked '((((class color) @@ -716,6 +741,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked) +(put 'gnus-summary-low-ticked-face 'obsolete-face "22.1") (defface gnus-summary-normal-ticked '((((class color) @@ -730,6 +756,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked) +(put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1") (defface gnus-summary-high-ancient '((((class color) @@ -744,6 +771,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient) +(put 'gnus-summary-high-ancient-face 'obsolete-face "22.1") (defface gnus-summary-low-ancient '((((class color) @@ -758,6 +786,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient) +(put 'gnus-summary-low-ancient-face 'obsolete-face "22.1") (defface gnus-summary-normal-ancient '((((class color) @@ -772,6 +801,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient) +(put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1") (defface gnus-summary-high-undownloaded '((((class color) @@ -784,6 +814,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded) +(put 'gnus-summary-high-undownloaded-face 'obsolete-face "22.1") (defface gnus-summary-low-undownloaded '((((class color) @@ -796,6 +827,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded) +(put 'gnus-summary-low-undownloaded-face 'obsolete-face "22.1") (defface gnus-summary-normal-undownloaded '((((class color) @@ -808,6 +840,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded) +(put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1") (defface gnus-summary-high-unread '((t @@ -816,6 +849,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread) +(put 'gnus-summary-high-unread-face 'obsolete-face "22.1") (defface gnus-summary-low-unread '((t @@ -824,6 +858,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread) +(put 'gnus-summary-low-unread-face 'obsolete-face "22.1") (defface gnus-summary-normal-unread '((t @@ -832,6 +867,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread) +(put 'gnus-summary-normal-unread-face 'obsolete-face "22.1") (defface gnus-summary-high-read '((((class color) @@ -848,6 +884,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read) +(put 'gnus-summary-high-read-face 'obsolete-face "22.1") (defface gnus-summary-low-read '((((class color) @@ -864,6 +901,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read) +(put 'gnus-summary-low-read-face 'obsolete-face "22.1") (defface gnus-summary-normal-read '((((class color) @@ -878,6 +916,7 @@ be set in `.emacs' instead." :group 'gnus-summary) ;; backward-compatibility alias (put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read) +(put 'gnus-summary-normal-read-face 'obsolete-face "22.1") ;;; @@ -933,6 +972,7 @@ be set in `.emacs' instead." :group 'gnus-start) ;; backward-compatibility alias (put 'gnus-splash-face 'face-alias 'gnus-splash) +(put 'gnus-splash-face 'obsolete-face "22.1") (defun gnus-splash () (save-excursion diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 89dceb391d4..d6feaa0b346 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1317,6 +1317,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-to-face 'face-alias 'message-header-to) +(put 'message-header-to-face 'obsolete-face "22.1") (defface message-header-cc '((((class color) @@ -1331,6 +1332,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-cc-face 'face-alias 'message-header-cc) +(put 'message-header-cc-face 'obsolete-face "22.1") (defface message-header-subject '((((class color) @@ -1345,6 +1347,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-subject-face 'face-alias 'message-header-subject) +(put 'message-header-subject-face 'obsolete-face "22.1") (defface message-header-newsgroups '((((class color) @@ -1359,6 +1362,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups) +(put 'message-header-newsgroups-face 'obsolete-face "22.1") (defface message-header-other '((((class color) @@ -1373,6 +1377,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-other-face 'face-alias 'message-header-other) +(put 'message-header-other-face 'obsolete-face "22.1") (defface message-header-name '((((class color) @@ -1387,6 +1392,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-name-face 'face-alias 'message-header-name) +(put 'message-header-name-face 'obsolete-face "22.1") (defface message-header-xheader '((((class color) @@ -1401,6 +1407,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-header-xheader-face 'face-alias 'message-header-xheader) +(put 'message-header-xheader-face 'obsolete-face "22.1") (defface message-separator '((((class color) @@ -1415,6 +1422,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-separator-face 'face-alias 'message-separator) +(put 'message-separator-face 'obsolete-face "22.1") (defface message-cited-text '((((class color) @@ -1429,6 +1437,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-cited-text-face 'face-alias 'message-cited-text) +(put 'message-cited-text-face 'obsolete-face "22.1") (defface message-mml '((((class color) @@ -1443,6 +1452,7 @@ starting with `not' and followed by regexps." :group 'message-faces) ;; backward-compatibility alias (put 'message-mml-face 'face-alias 'message-mml) +(put 'message-mml-face 'obsolete-face "22.1") (defun message-font-lock-make-header-matcher (regexp) (let ((form @@ -3812,9 +3822,8 @@ See `message-citation-line-format'." (>= i ?a))) (push i lst) (push (condition-case nil - (progn (format-time-string (format "%%%c" i) - replydate)) - (format ">%c<" i)) + (format-time-string (format "%%%c" i) replydate) + (error (format ">%c<" i))) lst)) (setq i (1+ i))) (reverse lst))) @@ -4238,7 +4247,7 @@ This function could be useful in `message-setup-hook'." (not (y-or-n-p (format "Address `%s' might be bogus. Continue? " bog))) - (error "Bogus address.")))))))) + (error "Bogus address")))))))) (custom-add-option 'message-setup-hook 'message-check-recipients) diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 39b83ff1c3c..d4f9ea76006 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -60,6 +60,24 @@ to specify encoding of non-ASCII MIME parts." (const base64)))) :group 'mime) +(defcustom mm-sign-option nil + "Option how to create signed parts. +nil, use the default keys without asking; +`guided', let you select signing keys from the menu." + :version "23.1" + :type '(choice (item guided) + (item :tag "default" nil)) + :group 'mime-security) + +(defcustom mm-encrypt-option nil + "Option how to create encrypted parts. +nil, use the default keys without asking; +`guided', let you select recipients' keys from the menu." + :version "23.1" + :type '(choice (item guided) + (item :tag "default" nil)) + :group 'mime-security) + (defvar mm-use-ultra-safe-encoding nil "If non-nil, use encodings aimed at Procrustean bed survival. @@ -137,22 +155,19 @@ ENCODING can be: nil (do nothing); one of `quoted-printable', `base64'; (t (error "Unknown encoding %s" encoding)))) -(defun mm-encode-buffer (type) - "Encode the buffer which contains data of MIME type TYPE. +(defun mm-encode-buffer (type &optional encoding) + "Encode the buffer which contains data of MIME type TYPE by ENCODING. TYPE is a string or a list of the components. +The optional ENCODING overrides the encoding determined according to +TYPE and `mm-content-transfer-encoding-defaults'. The encoding used is returned." - (let* ((mime-type (if (stringp type) type (car type))) - (encoding - (or (and (listp type) - (cadr (assq 'encoding type))) - (mm-content-transfer-encoding mime-type))) - (bits (mm-body-7-or-8))) - ;; We force buffers that are 7bit to be unencoded, no matter - ;; what the preferred encoding is. - ;; Only if the buffers don't contain lone lines. - (when (and (eq bits '7bit) (not (mm-long-lines-p 76))) - (setq encoding bits)) - (mm-encode-content-transfer-encoding encoding mime-type) + (let ((mime-type (if (stringp type) type (car type)))) + (mm-encode-content-transfer-encoding + (or encoding + (setq encoding (or (and (listp type) + (cadr (assq 'encoding type))) + (mm-content-transfer-encoding mime-type)))) + mime-type) encoding)) (defun mm-insert-headers (type encoding &optional file) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 403d967f8e4..c6104462d7b 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1,7 +1,7 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -315,7 +315,7 @@ the alias. Else windows-NUMBER is used." (candidates (if (fboundp 'cp-supported-codepages) (cp-supported-codepages) ;; Removed in Emacs 23 (unicode), so signal an error: - (error "`codepage-setup' not present in this Emacs version.")))) + (error "`codepage-setup' not present in this Emacs version")))) (list (completing-read "Setup DOS Codepage: (default 437) " candidates nil t nil nil "437")))) (when alias @@ -326,7 +326,7 @@ the alias. Else windows-NUMBER is used." (unless (mm-coding-system-p cp) (if (fboundp 'codepage-setup) ; silence compiler (codepage-setup number) - (error "`codepage-setup' not present in this Emacs version."))) + (error "`codepage-setup' not present in this Emacs version"))) (when (and alias ;; Don't add alias if setup of cp failed. (mm-coding-system-p cp)) @@ -900,8 +900,8 @@ mail with multiple parts is preferred to sending a Unicode one.") (eval-and-compile (defvar mm-emacs-mule (and (not (featurep 'xemacs)) - (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters + (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters) (fboundp 'set-buffer-multibyte)) "True in Emacs with Mule.") @@ -1013,8 +1013,8 @@ This is a compatibility function for Emacsen without `delete-dups'." "Return non-nil if the session is multibyte. This affects whether coding conversion should be attempted generally." (if (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters) t))) (defun mm-iso-8859-x-to-15-region (&optional b e) @@ -1227,7 +1227,7 @@ Use multibyte mode for this." (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS with current buffer temporarily made unibyte. -Also bind `default-enable-multibyte-characters' to nil. +Also bind the default-value of `enable-multibyte-characters' to nil. Equivalent to `progn' in XEmacs NOTE: Use this macro with caution in multibyte buffers (it is not @@ -1242,12 +1242,12 @@ Emacs 23 (unicode)." (let ((,multibyte enable-multibyte-characters) (,buffer (current-buffer))) (unwind-protect - (let (default-enable-multibyte-characters) + (letf (((default-value 'enable-multibyte-characters) nil)) (set-buffer-multibyte nil) ,@forms) (set-buffer ,buffer) (set-buffer-multibyte ,multibyte))) - (let (default-enable-multibyte-characters) + (letf (((default-value 'enable-multibyte-characters) nil)) ,@forms)))) (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) @@ -1308,24 +1308,24 @@ to advanced Emacs features, such as file-name-handlers, format decoding, `find-file-hooks', etc. If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. This function ensures that none of these modifications will take place." - (let* ((format-alist nil) - (auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (enable-local-eval nil) - (inhibit-file-name-operation (if inhibit - 'insert-file-contents - inhibit-file-name-operation)) - (inhibit-file-name-handlers - (if inhibit - (append mm-inhibit-file-name-handlers - inhibit-file-name-handlers) - inhibit-file-name-handlers)) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) + (letf* ((format-alist nil) + (auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil) + (enable-local-eval nil) + (inhibit-file-name-operation (if inhibit + 'insert-file-contents + inhibit-file-name-operation)) + (inhibit-file-name-handlers + (if inhibit + (append mm-inhibit-file-name-handlers + inhibit-file-name-handlers) + inhibit-file-name-handlers)) + (ffh (if (boundp 'find-file-hook) + 'find-file-hook + 'find-file-hooks)) + (val (symbol-value ffh))) (set ffh nil) (unwind-protect (insert-file-contents filename visit beg end replace) @@ -1590,8 +1590,8 @@ gzip, bzip2, etc. are allowed." filename)) (mm-decompress-buffer filename nil t)))) (when decomp - (set-buffer (let (default-enable-multibyte-characters) - (generate-new-buffer " *temp*"))) + (set-buffer (letf (((default-value 'enable-multibyte-characters) nil)) + (generate-new-buffer " *temp*"))) (insert decomp) (setq filename (file-name-sans-extension filename))) (goto-char (point-min)) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index af4d1bf9363..8aeb56413f9 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -381,7 +381,7 @@ Whether the passphrase is cached at all is controlled by (or (message-options-get 'mml-smime-epg-signers) (message-options-set 'mml-smime-epg-signers - (if mml-smime-verbose + (if (eq mm-sign-option 'guided) (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " @@ -462,7 +462,7 @@ Content-Disposition: attachment; filename=smime.p7s (message-options-set 'message-recipients (read-string "Recipients: "))) "[ \f\t\n\r\v,]+")))) - (if mml-smime-verbose + (if (eq mm-encrypt-option 'guided) (setq recipients (epa-select-keys context "\ Select recipients for encryption. diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 6028ce8b205..24a88806759 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -585,7 +585,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (unless raw (setq charset (mm-encode-body charset)))) (insert contents))))) - (setq encoding (mm-encode-buffer type) + (if (setq encoding (cdr (assq 'encoding cont))) + (setq encoding (intern (downcase encoding)))) + (setq encoding (mm-encode-buffer type encoding) coded (mm-string-as-multibyte (buffer-string)))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) @@ -1292,15 +1294,24 @@ body) or \"attachment\" (separate from the body)." (description (mml-minibuffer-read-description)) (disposition (mml-minibuffer-read-disposition type nil file))) (list file type description disposition))) - (save-excursion - (unless (message-in-body-p) (goto-char (point-max))) + ;; Don't move point if this command is invoked inside the message header. + (let ((head (unless (message-in-body-p) + (prog1 + (point) + (goto-char (point-max)))))) (mml-insert-empty-tag 'part 'type type ;; icicles redefines read-file-name and returns a ;; string w/ text properties :-/ 'filename (mm-substring-no-properties file) 'disposition (or disposition "attachment") - 'description description))) + 'description description) + (when head + (unless (prog1 + (pos-visible-in-window-p) + (goto-char head)) + (message "The file \"%s\" has been attached at the end of the message" + (file-name-nondirectory file)))))) (defun mml-dnd-attach-file (uri action) "Attach a drag and drop file. @@ -1336,11 +1347,21 @@ BUFFER is the name of the buffer to attach. See (description (mml-minibuffer-read-description)) (disposition (mml-minibuffer-read-disposition type nil))) (list buffer type description disposition))) - (save-excursion - (unless (message-in-body-p) (goto-char (point-max))) + ;; Don't move point if this command is invoked inside the message header. + (let ((head (unless (message-in-body-p) + (prog1 + (point) + (goto-char (point-max)))))) (mml-insert-empty-tag 'part 'type type 'buffer buffer 'disposition disposition - 'description description))) + 'description description) + (when head + (unless (prog1 + (pos-visible-in-window-p) + (goto-char head)) + (message + "The buffer \"%s\" has been attached at the end of the message" + buffer))))) (defun mml-attach-external (file &optional type description) "Attach an external file into the buffer. @@ -1351,26 +1372,38 @@ TYPE is the MIME type to use." (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description))) (list file type description))) - (save-excursion - (unless (message-in-body-p) (goto-char (point-max))) + ;; Don't move point if this command is invoked inside the message header. + (let ((head (unless (message-in-body-p) + (prog1 + (point) + (goto-char (point-max)))))) (mml-insert-empty-tag 'external 'type type 'name file - 'disposition "attachment" 'description description))) + 'disposition "attachment" 'description description) + (when head + (unless (prog1 + (pos-visible-in-window-p) + (goto-char head)) + (message "The file \"%s\" has been attached at the end of the message" + (file-name-nondirectory file)))))) (defun mml-insert-multipart (&optional type) - (interactive (list (completing-read "Multipart type (default mixed): " - '(("mixed") ("alternative") ("digest") ("parallel") - ("signed") ("encrypted")) - nil nil "mixed"))) + (interactive (if (message-in-body-p) + (list (completing-read "Multipart type (default mixed): " + '(("mixed") ("alternative") + ("digest") ("parallel") + ("signed") ("encrypted")) + nil nil "mixed")) + (error "Use this command in the message body"))) (or type (setq type "mixed")) (mml-insert-empty-tag "multipart" 'type type) (forward-line -1)) (defun mml-insert-part (&optional type) - (interactive - (list (mml-minibuffer-read-type ""))) - (mml-insert-tag 'part 'type type 'disposition "inline") - (forward-line -1)) + (interactive (if (message-in-body-p) + (list (mml-minibuffer-read-type "")) + (error "Use this command in the message body"))) + (mml-insert-tag 'part 'type type 'disposition "inline")) (declare-function message-subscribed-p "message" ()) (declare-function message-make-mail-followup-to "message" diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 4536f4183d9..7d4f828f6bf 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -34,6 +34,7 @@ (require 'cl) (require 'mm-util)) +(require 'mm-encode) (require 'mml-sec) (defvar mc-pgp-always-sign) @@ -368,7 +369,7 @@ Whether the passphrase is cached at all is controlled by (defun mml1991-epg-sign (cont) (let ((context (epg-make-context)) headers cte signers signature) - (if mml1991-verbose + (if (eq mm-sign-option 'guided) (setq signers (epa-select-keys context "Select keys for signing. If no one is selected, default secret key is used. " mml1991-signers t)) @@ -448,7 +449,7 @@ If no one is selected, default secret key is used. " (or (epg-expand-group config recipient) (list recipient))) recipients)))) - (if mml1991-verbose + (if (eq mm-encrypt-option 'guided) (setq recipients (epa-select-keys context "Select recipients for encryption. If no one is selected, symmetric encryption will be performed. " @@ -466,7 +467,7 @@ If no one is selected, symmetric encryption will be performed. " mml1991-signers))) (error "mml1991-signers not set"))) (when sign - (if mml1991-verbose + (if (eq mm-sign-option 'guided) (setq signers (epa-select-keys context "Select keys for signing. If no one is selected, default secret key is used. " mml1991-signers t)) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 508c51f76c9..d6d06c379e8 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -1187,7 +1187,7 @@ Whether the passphrase is cached at all is controlled by (or (message-options-get 'mml2015-epg-signers) (message-options-set 'mml2015-epg-signers - (if mml2015-verbose + (if (eq mm-sign-option 'guided) (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " @@ -1269,7 +1269,7 @@ If no one is selected, default secret key is used. " (unless mml2015-signers (error "mml2015-signers not set")) (setq recipients (nconc recipients mml2015-signers))) - (if mml2015-verbose + (if (eq mm-encrypt-option 'guided) (setq recipients (epa-select-keys context "\ Select recipients for encryption. @@ -1297,7 +1297,7 @@ If no one is selected, symmetric encryption will be performed. " (or (message-options-get 'mml2015-epg-signers) (message-options-set 'mml2015-epg-signers - (if mml2015-verbose + (if (eq mm-sign-option 'guided) (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 2b9b1e5f30c..40863454518 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -32,7 +32,7 @@ (require 'nnheader) (condition-case nil (require 'rmail) - (t (nnheader-message + (error (nnheader-message 5 "Ignore rmail errors from this file, you don't have rmail"))) (require 'nnmail) (require 'nnoo) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 9ba8e37942e..c6821b0f8db 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -1,7 +1,7 @@ ;;; nndiary.el --- A diary back end for Gnus -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Didier Verna <didier@xemacs.org> ;; Maintainer: Didier Verna <didier@xemacs.org> @@ -368,7 +368,7 @@ all. This may very well take some time.") (setq head (nth 0 elt)) (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt))) nndiary-headers) - (t + (error (nnheader-report 'nndiary "X-Diary-%s header parse error: %s." head (cdr arg)) nil)) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 572f80bea9d..ce52ac96564 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -992,18 +992,18 @@ find-file-hooks, etc. (defun nnheader-find-file-noselect (&rest args) "Open a file with some variables bound. See `find-file-noselect' for the arguments." - (let* ((format-alist nil) - (auto-mode-alist (mm-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (enable-local-eval nil) - (coding-system-for-read nnheader-file-coding-system) - (version-control 'never) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) + (letf* ((format-alist nil) + (auto-mode-alist (mm-auto-mode-alist)) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil) + (enable-local-eval nil) + (coding-system-for-read nnheader-file-coding-system) + (version-control 'never) + (ffh (if (boundp 'find-file-hook) + 'find-file-hook + 'find-file-hooks)) + (val (symbol-value ffh))) (set ffh nil) (unwind-protect (apply 'find-file-noselect args) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 0658b1e2050..d72bb69d52c 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -336,7 +336,7 @@ (require 'gnus-sum) (require 'message) (require 'gnus-util) -(eval-and-compile +(eval-when-compile (require 'cl)) (nnoo-declare nnir) @@ -505,7 +505,7 @@ that it is for swish++, not Wais." ;; `nnir-swish-e-additional-switches' (make-obsolete-variable 'nnir-swish-e-index-file - 'nnir-swish-e-index-files) + 'nnir-swish-e-index-files "Emacs 23.1") (defcustom nnir-swish-e-index-file (expand-file-name "~/Mail/index.swish-e") "*Index file for swish-e. @@ -690,7 +690,7 @@ The returned format is as `gnus-server-to-method' needs it. See and show thread that contains this article." (interactive) (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name))) - (error "Can't execute this command unless in nnir group.")) + (error "Can't execute this command unless in nnir group")) (let* ((cur (gnus-summary-article-number)) (group (nnir-artlist-artitem-group nnir-artlist cur)) (backend-number (nnir-artlist-artitem-number nnir-artlist cur)) @@ -889,7 +889,7 @@ ready to be added to the list of search results." "Run given query agains waissearch. Returns vector of (group name, file name) pairs (also vectors, actually)." (when group - (error "The freeWAIS-sf backend cannot search specific groups.")) + (error "The freeWAIS-sf backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) @@ -916,17 +916,18 @@ pairs (also vectors, actually)." (unless (string-match prefix dirnam) (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" dirnam prefix)) - (setq group (substitute ?. ?/ (replace-match "" t t dirnam))) + (setq group (gnus-replace-in-string + (replace-match "" t t dirnam) "/" ".")) (push (vector (nnir-group-full-name group server) (string-to-number artno) (string-to-number score)) artlist)) (message "Massaging waissearch output...done") (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) ;; IMAP interface. ;; todo: @@ -1161,7 +1162,7 @@ Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on Windows NT 4.0." (when group - (error "The swish++ backend cannot search specific groups.")) + (error "The swish++ backend cannot search specific groups")) (save-excursion (let ( (qstring (cdr (assq 'query query))) @@ -1178,7 +1179,7 @@ Windows NT 4.0." score artno dirnam filenam) (when (equal "" qstring) - (error "swish++: You didn't enter anything.")) + (error "swish++: You didn't enter anything")) (set-buffer (get-buffer-create nnir-tmp-buffer)) (erase-buffer) @@ -1235,10 +1236,10 @@ Windows NT 4.0." ;; Sort by score (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) ;; Swish-E interface. (defun nnir-run-swish-e (query server &optional group) @@ -1250,7 +1251,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; swish-e crashes with empty parameter to "-w" on commandline... (when group - (error "The swish-e backend cannot search specific groups.")) + (error "The swish-e backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) @@ -1260,7 +1261,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." artlist score artno dirnam group ) (when (equal "" qstring) - (error "swish-e: You didn't enter anything.")) + (error "swish-e: You didn't enter anything")) (set-buffer (get-buffer-create nnir-tmp-buffer)) (erase-buffer) @@ -1316,9 +1317,9 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; eliminate all ".", "/", "\" from beginning. Always matches. (string-match "^[./\\]*\\(.*\\)$" dirnam) ;; "/" -> "." - (setq group (substitute ?. ?/ (match-string 1 dirnam))) + (setq group (gnus-replace-in-string (match-string 1 dirnam) "/" ".")) ;; Windows "\\" -> "." - (setq group (substitute ?. ?\\ group)) + (setq group (gnus-replace-in-string group "\\\\" ".")) (push (vector (nnir-group-full-name group server) (string-to-number artno) @@ -1329,10 +1330,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; Sort by score (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) ;; HyREX interface (defun nnir-run-hyrex (query server &optional group) @@ -1397,19 +1398,20 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." score (match-string 3)) (when (string-match prefix dirnam) (setq dirnam (replace-match "" t t dirnam))) - (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server) + (push (vector (nnir-group-full-name + (gnus-replace-in-string dirnam "/" ".") server) (string-to-number artno) (string-to-number score)) artlist)) (message "Massaging hyrex-search output...done.") (apply 'vector - (sort* artlist - (function (lambda (x y) - (if (string-lessp (nnir-artitem-group x) - (nnir-artitem-group y)) - t - (< (nnir-artitem-number x) - (nnir-artitem-number y))))))) + (sort artlist + (function (lambda (x y) + (if (string-lessp (nnir-artitem-group x) + (nnir-artitem-group y)) + t + (< (nnir-artitem-number x) + (nnir-artitem-number y))))))) ))) ;; Namazu interface @@ -1476,10 +1478,10 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." ;; sort artlist by score (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) (defun nnir-run-find-grep (query server &optional group) "Run find and grep to obtain matching articles." @@ -1505,11 +1507,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." "." ;; Try accessing the group literally as well as ;; interpreting dots as directory separators so the - ;; engine works with plain nnml as well as the Gnus - ;; Cache. - (find-if 'file-directory-p - (let ((group (gnus-group-real-name group))) - (list group (gnus-replace-in-string group "\\." "/" t))))))) + ;; engine works with plain nnml as well as the Gnus Cache. + (let ((group (gnus-group-real-name group))) + ;; Replace cl-func find-if. + (if (file-directory-p group) + group + (if (file-directory-p + (setq group (gnus-replace-in-string group "\\." "/" t))) + group)))))) (unless group (error "Cannot locate directory for group")) (save-excursion @@ -1532,7 +1537,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (art (string-to-number (car (last path))))) (while (string= "." (car path)) (setq path (cdr path))) - (let ((group (mapconcat 'identity (subseq path 0 -1) "."))) + (let ((group (mapconcat 'identity + ;; Replace cl-func: (subseq path 0 -1) + (let ((end (1- (length path))) + res) + (while (>= (setq end (1- end)) 0) + (push (pop path) res)) + (nreverse res)) + "."))) (push (vector (nnir-group-full-name group server) art 0) artlist)) (forward-line 1))) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 47c509f68cf..df2e21efd78 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -242,9 +242,8 @@ If non-nil, also update the cache when copy or move articles." :group 'nnmail :type 'boolean) -(make-obsolete-variable 'nnmail-spool-file - "This option is obsolete in Gnus 5.9. \ -Use `mail-sources' instead.") +(make-obsolete-variable 'nnmail-spool-file 'mail-sources + "Gnus 5.9 (Emacs 22.1)") ;; revision 5.29 / p0-85 / Gnus 5.9 ;; Variable removed in No Gnus v0.7 @@ -1318,7 +1317,7 @@ Eudora has a broken References line, but an OK In-Reply-To." (replace-match "\\1" t)))) (defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) -(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) +(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references "Emacs 23.1") (custom-add-option 'nnmail-prepare-incoming-header-hook 'nnmail-ignore-broken-references) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index cf59c81a796..b51894d9a94 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -226,8 +226,6 @@ used to render text. If it is nil, text will simply be folded.") (link (nth 2 e)) (enclosure (nth 7 e)) (comments (nth 8 e)) - ;; Enable encoding of Newsgroups header in XEmacs. - (default-enable-multibyte-characters t) (rfc2047-header-encoding-alist (if (mm-coding-system-p 'utf-8) (cons '("Newsgroups" . utf-8) @@ -272,7 +270,7 @@ used to render text. If it is nil, text will simply be folded.") (replace-match "\n") (replace-match "\n\n"))) (unless (eobp) - (let ((fill-column default-fill-column) + (let ((fill-column (default-value 'fill-column)) (window (get-buffer-window nntp-server-buffer))) (when window (setq fill-column diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 38dfd60c942..6f8330f2080 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -1,7 +1,8 @@ ;;; nnspool.el --- spool access for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -288,7 +289,8 @@ there.") (while (and (not (looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) - (let ((seconds (time-to-seconds (date-to-time date))) + ;; We require nnheader which requires gnus-util. + (let ((seconds (gnus-float-time (date-to-time date))) groups) ;; Go through lines and add the latest groups to a list. (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el index d8d6d5d552e..aeec743ce55 100644 --- a/lisp/gnus/qp.el +++ b/lisp/gnus/qp.el @@ -1,7 +1,7 @@ ;;; qp.el --- Quoted-Printable functions -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: mail, extensions @@ -154,11 +154,13 @@ encode lines starting with \"From\"." (defun quoted-printable-encode-string (string) "Encode the STRING as quoted-printable and return the result." - (let ((default-enable-multibyte-characters (mm-multibyte-string-p string))) - (with-temp-buffer - (insert string) - (quoted-printable-encode-region (point-min) (point-max)) - (buffer-string)))) + (with-temp-buffer + (if (mm-multibyte-string-p string) + (mm-enable-multibyte) + (mm-disable-multibyte)) + (insert string) + (quoted-printable-encode-region (point-min) (point-max)) + (buffer-string))) (provide 'qp) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index c0bdec3c025..4ba4bcb5119 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -1,7 +1,7 @@ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -282,8 +282,8 @@ Should be called narrowed to the head of the message." (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) (if (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters) + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters)) mail-parse-charset) (mm-encode-coding-region (point) (point-max) mail-parse-charset))) @@ -309,8 +309,8 @@ Should be called narrowed to the head of the message." ;;; (error "Cannot send unencoded text"))) ((mm-coding-system-p method) (if (or (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters)) + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters))) (featurep 'file-coding)) (mm-encode-coding-region (point) (point-max) method))) ;; Hm. diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el index 15d981b58a1..468099a00d6 100644 --- a/lisp/gnus/sieve-mode.el +++ b/lisp/gnus/sieve-mode.el @@ -1,7 +1,7 @@ ;;; sieve-mode.el --- Sieve code editing commands for Emacs -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> @@ -78,6 +78,7 @@ :group 'sieve) ;; backward-compatibility alias (put 'sieve-control-commands-face 'face-alias 'sieve-control-commands) +(put 'sieve-control-commands-face 'obsolete-face "22.1") (defvar sieve-action-commands-face 'sieve-action-commands "Face name used for Sieve Action Commands.") @@ -91,6 +92,7 @@ :group 'sieve) ;; backward-compatibility alias (put 'sieve-action-commands-face 'face-alias 'sieve-action-commands) +(put 'sieve-action-commands-face 'obsolete-face "22.1") (defvar sieve-test-commands-face 'sieve-test-commands "Face name used for Sieve Test Commands.") @@ -108,6 +110,7 @@ :group 'sieve) ;; backward-compatibility alias (put 'sieve-test-commands-face 'face-alias 'sieve-test-commands) +(put 'sieve-test-commands-face 'obsolete-face "22.1") (defvar sieve-tagged-arguments-face 'sieve-tagged-arguments "Face name used for Sieve Tagged Arguments.") @@ -123,6 +126,7 @@ :group 'sieve) ;; backward-compatibility alias (put 'sieve-tagged-arguments-face 'face-alias 'sieve-tagged-arguments) +(put 'sieve-tagged-arguments-face 'obsolete-face "22.1") (defconst sieve-font-lock-keywords diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index c315f2f0347..c98fcf6ad17 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -371,6 +371,7 @@ Only meaningful if you enable `spam-use-blackholes'." :group 'spam) ;; backward-compatibility alias (put 'spam-face 'face-alias 'spam) +(put 'spam-face 'obsolete-face "22.1") (defcustom spam-face 'spam "Face for spam-marked articles." @@ -413,16 +414,16 @@ Only meaningful if you enable `spam-use-regex-body'." "Spam ifile configuration." :group 'spam) -(make-obsolete-variable 'spam-ifile-path 'spam-ifile-program) -;; "22.1" ;; Gnus 5.10.9 +(make-obsolete-variable 'spam-ifile-path 'spam-ifile-program + "Gnus 5.10.9 (Emacs 22.1)") (defcustom spam-ifile-program (executable-find "ifile") "Name of the ifile program." :type '(choice (file :tag "Location of ifile") (const :tag "ifile is not installed")) :group 'spam-ifile) -(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database) -;; "22.1" ;; Gnus 5.10.9 +(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database + "Gnus 5.10.9 (Emacs 22.1)") (defcustom spam-ifile-database nil "File name of the ifile database." :type '(choice (file :tag "Location of the ifile database") @@ -452,8 +453,8 @@ your main source of newsgroup names." "Spam bogofilter configuration." :group 'spam) -(make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program) -;; "22.1" ;; Gnus 5.10.9 +(make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program + "Gnus 5.10.9 (Emacs 22.1)") (defcustom spam-bogofilter-program (executable-find "bogofilter") "Name of the Bogofilter program." :type '(choice (file :tag "Location of bogofilter") @@ -504,8 +505,8 @@ When nil, use the default location." "Spam bsfilter configuration." :group 'spam) -(make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program) -;; "22.1" ;; Gnus 5.10.9 +(make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program + "Gnus 5.10.9 (Emacs 22.1)") (defcustom spam-bsfilter-program (executable-find "bsfilter") "Name of the Bsfilter program." :type '(choice (file :tag "Location of bsfilter") @@ -571,7 +572,7 @@ When nil, use the default spamoracle database." :group 'spam) (make-obsolete-variable 'spam-spamassassin-path - 'spam-spamassassin-program) ;; "22.1" ;; Gnus 5.10.9 + 'spam-spamassassin-program "Gnus 5.10.9 (Emacs 22.1)") (defcustom spam-assassin-program (executable-find "spamassassin") "Name of the spamassassin program. Hint: set this to \"spamc\" if you have spamd running. See the spamc and @@ -602,8 +603,8 @@ identification" :type 'string :group 'spam-spamassassin) -(make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program) -;; "22.1" ;; Gnus 5.10.9 +(make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program + "Gnus 5.10.9 (Emacs 22.1)") (defcustom spam-sa-learn-program (executable-find "sa-learn") "Name of the sa-learn program." :type '(choice (file :tag "Location of spamassassin") @@ -659,12 +660,12 @@ order for SpamAssassin to recognize the new registered spam." :type 'string :group 'spam-crm114) -(defcustom spam-crm114-spam-strong-switch "--UNKNOWN" +(defcustom spam-crm114-spam-strong-switch "--unlearn" "The switch that CRM114 Mailfilter uses to unregister ham messages." :type 'string :group 'spam-crm114) -(defcustom spam-crm114-ham-strong-switch "--UNKNOWN" +(defcustom spam-crm114-ham-strong-switch "--unlearn" "The switch that CRM114 Mailfilter uses to unregister spam messages." :type 'string :group 'spam-crm114) @@ -1151,10 +1152,8 @@ backends)." 'spam-check-crm114 'spam-crm114-register-ham-routine 'spam-crm114-register-spam-routine - ;; does CRM114 Mailfilter support unregistration? - nil - nil) - + 'spam-crm114-unregister-ham-routine + 'spam-crm114-unregister-spam-routine) ;;}}} ;;{{{ scoring and summary formatting diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el index d2666ebac2b..5f15d5465de 100644 --- a/lisp/gnus/utf7.el +++ b/lisp/gnus/utf7.el @@ -1,7 +1,7 @@ ;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*- -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Jon K Hellan <hellan@acm.org> ;; Maintainer: bugs@gnus.org @@ -210,23 +210,21 @@ Characters are in raw byte pairs in narrowed buffer." (if (and (coding-system-p 'utf-7) (coding-system-p 'utf-7-imap)) ;; Emacs 23 with proper support for IMAP (encode-coding-string string (if for-imap 'utf-7-imap 'utf-7)) - (let ((default-enable-multibyte-characters t)) - (with-temp-buffer - (insert string) - (utf7-encode-internal for-imap) - (buffer-string))))) + (mm-with-multibyte-buffer + (insert string) + (utf7-encode-internal for-imap) + (buffer-string)))) (defun utf7-decode (string &optional for-imap) "Decode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil." (if (and (coding-system-p 'utf-7) (coding-system-p 'utf-7-imap)) ;; Emacs 23 with proper support for IMAP (decode-coding-string string (if for-imap 'utf-7-imap 'utf-7)) - (let ((default-enable-multibyte-characters nil)) - (with-temp-buffer - (insert string) - (utf7-decode-internal for-imap) - (mm-enable-multibyte) - (buffer-string))))) + (mm-with-unibyte-buffer + (insert string) + (utf7-decode-internal for-imap) + (mm-enable-multibyte) + (buffer-string)))) (provide 'utf7) diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el index 51d80f8667d..e352b8099d7 100644 --- a/lisp/gnus/yenc.el +++ b/lisp/gnus/yenc.el @@ -89,8 +89,8 @@ (when (re-search-forward "^=yend.*$" end t) (setq last (match-beginning 0)) (setq footer-alist (yenc-parse-line (match-string 0))) - (let (default-enable-multibyte-characters) - (setq work-buffer (generate-new-buffer " *yenc-work*"))) + (letf (((default-value 'enable-multibyte-characters) nil)) + (setq work-buffer (generate-new-buffer " *yenc-work*"))) (while (< first last) (setq char (char-after first)) (cond ((or (eq char ?\r) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index ba5c32d5373..7608e9f24e9 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,7 +1,7 @@ ;;; help-fns.el --- Complex help functions -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -158,15 +158,18 @@ KIND should be `var' for a variable or `subr' for a subroutine." (concat "src/" file) file))))) -(defun help-default-arg-highlight (arg) - "Default function to highlight arguments in *Help* buffers. -It returns ARG in face `help-argument-name'; ARG is also -downcased if it displays differently than the default -face (according to `face-differs-from-default-p')." - (propertize (if (face-differs-from-default-p 'help-argument-name) - (downcase arg) - arg) - 'face 'help-argument-name)) +(defcustom help-downcase-arguments nil + "If non-nil, argument names in *Help* buffers are downcased." + :type 'boolean + :group 'help + :version "23.2") + +(defun help-highlight-arg (arg) + "Highlight ARG as an argument name for a *Help* buffer. +Return ARG in face `help-argument-name'; ARG is also downcased +if the variable `help-downcase-arguments' is non-nil." + (propertize (if help-downcase-arguments (downcase arg) arg) + 'face 'help-argument-name)) (defun help-do-arg-highlight (doc args) (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table) @@ -184,7 +187,7 @@ face (according to `face-differs-from-default-p')." "\\(?:-[a-z0-9-]+\\)?" ; for ARG-xxx, ARG-n "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x' "\\>") ; end of word - (help-default-arg-highlight arg) + (help-highlight-arg arg) doc t t 1))))) (defun help-highlight-arguments (usage doc &rest args) @@ -267,8 +270,9 @@ suitable file is found, return nil." "^;;; Generated autoloads from \\(.*\\)" nil t) (setq file-name (locate-file - (match-string-no-properties 1) - load-path nil 'readable)))))))) + (file-name-sans-extension + (match-string-no-properties 1)) + load-path '(".el" ".elc") 'readable)))))))) (cond ((and (not file-name) (subrp type)) @@ -323,8 +327,6 @@ suitable file is found, return nil." (and src-file (file-readable-p src-file) src-file)))))) (declare-function ad-get-advice-info "advice" (function)) -(declare-function function-overload-p "mode-local") -(declare-function overload-docstring-extension function "mode-local") ;;;###autoload (defun describe-function-1 (function) @@ -452,6 +454,18 @@ suitable file is found, return nil." (fill-region-as-paragraph pt2 (point)) (unless (looking-back "\n\n") (terpri))))) + ;; Note that list* etc do not get this property until + ;; cl-hack-byte-compiler runs, after bytecomp is loaded. + (when (eq (get function 'byte-compile) 'cl-byte-compile-compiler-macro) + (princ "This function has a compiler macro") + (let ((lib (get function 'compiler-macro-file))) + (when (stringp lib) + (princ (format " in `%s'" lib)) + (with-current-buffer standard-output + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-function-cmacro function lib))))) + (princ ".\n\n")) (let* ((arglist (help-function-arglist def)) (doc (documentation function)) (usage (help-split-fundoc doc function))) @@ -482,8 +496,6 @@ suitable file is found, return nil." (insert (car high) "\n") (fill-region fill-begin (point))) (setq doc (cdr high)))) - - ;; Note if function is obsolete. (let* ((obsolete (and ;; function might be a lambda construct. (symbolp function) @@ -496,16 +508,9 @@ suitable file is found, return nil." (insert (cond ((stringp use) (concat ";\n" use)) (use (format ";\nuse `%s' instead." use)) (t ".")) - "\n"))) - - ;; Note if function is overloadable (see the `mode-local' - ;; package in CEDET). - (when (and (featurep 'mode-local) - (symbolp function) - (function-overload-p function)) - (insert (overload-docstring-extension function) "\n")) - - (insert "\n" (or doc "Not documented."))))))) + "\n")) + (insert "\n" + (or doc "Not documented.")))))))) ;; Variables diff --git a/lisp/help-macro.el b/lisp/help-macro.el index c920ecbf43b..802eb54916d 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -90,7 +90,7 @@ When FNAME finally does get a command, it executes that command and then returns." (let ((doc-fn (intern (concat (symbol-name fname) "-doc")))) `(progn - (defun ,doc-fn () ,help-text) + (defun ,doc-fn () ,help-text nil) (defun ,fname () "Help command." (interactive) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 91fb4f99257..7c032b81cf2 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -202,6 +202,22 @@ The format is (FUNCTION ARGS...).") (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find function's definition")) +(define-button-type 'help-function-cmacro + :supertype 'help-xref + 'help-function (lambda (fun file) + (setq file (locate-library file t)) + (if (and file (file-readable-p file)) + (progn + (pop-to-buffer (find-file-noselect file)) + (goto-char (point-min)) + (if (re-search-forward + (format "^[ \t]*(define-compiler-macro[ \t]+%s" + (regexp-quote (symbol-name fun))) nil t) + (forward-line 0) + (message "Unable to find location in file"))) + (message "Unable to find file"))) + 'help-echo (purecopy "mouse-2, RET: find function's compiler macro")) + (define-button-type 'help-variable-def :supertype 'help-xref 'help-function (lambda (var &optional file) diff --git a/lisp/help.el b/lisp/help.el index e5c07e82439..8b5efc88d8d 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -202,7 +202,10 @@ specifies what to do when the user exits the help buffer." (defalias 'help-for-help 'help-for-help-internal) ;; It can't find this, but nobody will look. (make-help-screen help-for-help-internal - "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?" + (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?") + ;; Don't purecopy this one, because it's not evaluated (it's + ;; directly used as a docstring in a function definition, so it'll + ;; be moved to the DOC file anyway: no need for purecopying it). "You have typed %THIS-KEY%, the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.) diff --git a/lisp/hexl.el b/lisp/hexl.el index 2cdd449af38..19c1b996b16 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -42,6 +42,7 @@ ;;; Code: (require 'eldoc) +(eval-when-compile (require 'cl)) ;; ;; vars here @@ -365,8 +366,8 @@ and edit the file in `hexl-mode'." (list (let ((completion-ignored-extensions nil)) (read-file-name "Filename: " nil nil 'ret-must-match)))) - ;; Ignore the user's setting of default-major-mode. - (let ((default-major-mode 'fundamental-mode)) + ;; Ignore the user's setting of default major-mode. + (letf (((default-value 'major-mode) 'fundamental-mode)) (find-file-literally filename)) (if (not (eq major-mode 'hexl-mode)) (hexl-mode))) @@ -795,7 +796,7 @@ and their encoded form is inserted byte by byte." (coding (if (or (null buffer-file-coding-system) ;; coding-system-type equals t means undecided. (eq (coding-system-type buffer-file-coding-system) t)) - default-buffer-file-coding-system + (default-value 'buffer-file-coding-system) buffer-file-coding-system))) (cond ((and (> ch 0) (< ch 256)) (hexl-insert-char ch num)) diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index d24274aa13c..8b6a884424b 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -1,7 +1,7 @@ ;;; hilit-chg.el --- minor mode displaying buffer changes with special face -;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Richard Sharman <rsharman@pobox.com> ;; Keywords: faces @@ -195,8 +195,8 @@ (t (:inverse-video t))) "Face used for highlighting changes." :group 'highlight-changes) -;; backward-compatibility alias -(put 'highlight-changes-face 'face-alias 'highlight-changes) +(define-obsolete-face-alias 'highlight-changes-face + 'highlight-changes "22.1") ;; This looks pretty ugly, actually. Maybe the underline should be removed. (defface highlight-changes-delete @@ -205,13 +205,11 @@ (t (:inverse-video t))) "Face used for highlighting deletions." :group 'highlight-changes) -;; backward-compatibility alias -(put 'highlight-changes-delete-face 'face-alias 'highlight-changes-delete) - +(define-obsolete-face-alias 'highlight-changes-delete-face + 'highlight-changes-delete "22.1") ;; A (not very good) default list of colors to rotate through. -;; (define-obsolete-variable-alias 'highlight-changes-colours 'highlight-changes-colors "22.1") diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 8cf18b17c06..752a61613bb 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -1,7 +1,7 @@ ;;; hippie-exp.el --- expand text trying various ways to find its expansion -;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Anders Holst <aho@sans.kth.se> ;; Last change: 3 March 1998 @@ -519,7 +519,7 @@ otherwise." (defun he-concat-directory-file-name (dir-part name-part) "Try to slam together two parts of a file specification, system dependently." (cond ((null dir-part) name-part) - ((memq system-type '(ms-dos w32)) + ((eq system-type 'ms-dos) (if (and (string-match "\\\\" dir-part) (not (string-match "/" dir-part)) (= (aref name-part (1- (length name-part))) ?/)) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 73c5840aefa..a585c75f620 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1,7 +1,7 @@ ;;; ibuf-ext.el --- extensions for ibuffer -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Colin Walters <walters@verbum.org> ;; Maintainer: John Paul Wallington <jpw@gnu.org> @@ -544,7 +544,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (dolist (filtergroup filter-group-alist) (let ((filterset (cdr filtergroup))) (multiple-value-bind (hip-crowd lamers) - (values-list + (values-list (ibuffer-split-list (lambda (bufmark) (ibuffer-included-in-filters-p (car bufmark) filterset)) @@ -1161,10 +1161,10 @@ Ordering is lexicographic." (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)) + (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)) + (or (buffer-file-name (car b)) (let ((pr-b (get-buffer-process (car b)))) (and (processp pr-b) (process-name pr-b)))))) @@ -1598,5 +1598,9 @@ defaults to one." (provide 'ibuf-ext) +;; Local Variables: +;; generated-autoload-file: "ibuffer.el" +;; End: + ;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d ;;; ibuf-ext.el ends here diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 335f410475c..e3693c443cc 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1,7 +1,7 @@ ;;; ibuffer.el --- operate on buffers like dired -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Colin Walters <walters@verbum.org> ;; Maintainer: John Paul Wallington <jpw@gnu.org> @@ -1093,7 +1093,8 @@ one window." (line (+ 1 (count-lines 1 (point))))) (bury-buffer buf) (ibuffer-update nil t) - (goto-line line))) + (goto-char (point-min)) + (forward-line (1- line)))) (defun ibuffer-visit-tags-table () "Visit the tags table in the buffer on this line. See `visit-tags-table'." @@ -2616,6 +2617,399 @@ will be inserted before the group at point." (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (run-mode-hooks 'ibuffer-mode-hook)) + +;;; Start of automatically extracted autoloads. + +;;;### (autoloads (ibuffer-do-occur ibuffer-mark-dired-buffers ibuffer-mark-read-only-buffers +;;;;;; ibuffer-mark-special-buffers ibuffer-mark-old-buffers ibuffer-mark-compressed-file-buffers +;;;;;; ibuffer-mark-help-buffers ibuffer-mark-dissociated-buffers +;;;;;; ibuffer-mark-unsaved-buffers ibuffer-mark-modified-buffers +;;;;;; ibuffer-mark-by-mode ibuffer-mark-by-file-name-regexp ibuffer-mark-by-mode-regexp +;;;;;; ibuffer-mark-by-name-regexp ibuffer-copy-filename-as-kill +;;;;;; ibuffer-diff-with-file ibuffer-jump-to-buffer ibuffer-do-kill-lines +;;;;;; ibuffer-backwards-next-marked ibuffer-forward-next-marked +;;;;;; ibuffer-add-to-tmp-show ibuffer-add-to-tmp-hide ibuffer-bs-show +;;;;;; ibuffer-invert-sorting ibuffer-toggle-sorting-mode ibuffer-switch-to-saved-filters +;;;;;; ibuffer-add-saved-filters ibuffer-delete-saved-filters ibuffer-save-filters +;;;;;; ibuffer-or-filter ibuffer-negate-filter ibuffer-exchange-filters +;;;;;; ibuffer-decompose-filter ibuffer-pop-filter ibuffer-filter-disable +;;;;;; ibuffer-switch-to-saved-filter-groups ibuffer-delete-saved-filter-groups +;;;;;; ibuffer-save-filter-groups ibuffer-yank-filter-group ibuffer-yank +;;;;;; ibuffer-kill-line ibuffer-kill-filter-group ibuffer-jump-to-filter-group +;;;;;; ibuffer-clear-filter-groups ibuffer-decompose-filter-group +;;;;;; ibuffer-pop-filter-group ibuffer-set-filter-groups-by-mode +;;;;;; ibuffer-filters-to-filter-group ibuffer-included-in-filters-p +;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group +;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group +;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "811ee3bd414f35c6a1966e64e9e597f1") +;;; Generated autoloads from ibuf-ext.el + +(autoload 'ibuffer-auto-mode "ibuf-ext" "\ +Toggle use of Ibuffer's auto-update facility. +With numeric ARG, enable auto-update if and only if ARG is positive. + +\(fn &optional ARG)" t nil) + +(autoload 'ibuffer-mouse-filter-by-mode "ibuf-ext" "\ +Enable or disable filtering by the major mode chosen via mouse. + +\(fn EVENT)" t nil) + +(autoload 'ibuffer-interactive-filter-by-mode "ibuf-ext" "\ +Enable or disable filtering by the major mode at point. + +\(fn EVENT-OR-POINT)" t nil) + +(autoload 'ibuffer-mouse-toggle-filter-group "ibuf-ext" "\ +Toggle the display status of the filter group chosen with the mouse. + +\(fn EVENT)" t nil) + +(autoload 'ibuffer-toggle-filter-group "ibuf-ext" "\ +Toggle the display status of the filter group on this line. + +\(fn)" t nil) + +(autoload 'ibuffer-forward-filter-group "ibuf-ext" "\ +Move point forwards by COUNT filtering groups. + +\(fn &optional COUNT)" t nil) + +(autoload 'ibuffer-backward-filter-group "ibuf-ext" "\ +Move point backwards by COUNT filtering groups. + +\(fn &optional COUNT)" t nil) + (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext") + (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext") + (autoload 'ibuffer-do-shell-command-file "ibuf-ext") + (autoload 'ibuffer-do-eval "ibuf-ext") + (autoload 'ibuffer-do-view-and-eval "ibuf-ext") + (autoload 'ibuffer-do-rename-uniquely "ibuf-ext") + (autoload 'ibuffer-do-revert "ibuf-ext") + (autoload 'ibuffer-do-isearch "ibuf-ext") + (autoload 'ibuffer-do-isearch-regexp "ibuf-ext") + (autoload 'ibuffer-do-replace-regexp "ibuf-ext") + (autoload 'ibuffer-do-query-replace "ibuf-ext") + (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext") + (autoload 'ibuffer-do-print "ibuf-ext") + +(autoload 'ibuffer-included-in-filters-p "ibuf-ext" "\ +Not documented + +\(fn BUF FILTERS)" nil nil) + +(autoload 'ibuffer-filters-to-filter-group "ibuf-ext" "\ +Make the current filters into a filtering group. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-set-filter-groups-by-mode "ibuf-ext" "\ +Set the current filter groups to filter by mode. + +\(fn)" t nil) + +(autoload 'ibuffer-pop-filter-group "ibuf-ext" "\ +Remove the first filter group. + +\(fn)" t nil) + +(autoload 'ibuffer-decompose-filter-group "ibuf-ext" "\ +Decompose the filter group GROUP into active filters. + +\(fn GROUP)" t nil) + +(autoload 'ibuffer-clear-filter-groups "ibuf-ext" "\ +Remove all filter groups. + +\(fn)" t nil) + +(autoload 'ibuffer-jump-to-filter-group "ibuf-ext" "\ +Move point to the filter group whose name is NAME. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-kill-filter-group "ibuf-ext" "\ +Kill the filter group named NAME. +The group will be added to `ibuffer-filter-group-kill-ring'. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-kill-line "ibuf-ext" "\ +Kill the filter group at point. +See also `ibuffer-kill-filter-group'. + +\(fn &optional ARG INTERACTIVE-P)" t nil) + +(autoload 'ibuffer-yank "ibuf-ext" "\ +Yank the last killed filter group before group at point. + +\(fn)" t nil) + +(autoload 'ibuffer-yank-filter-group "ibuf-ext" "\ +Yank the last killed filter group before group named NAME. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-save-filter-groups "ibuf-ext" "\ +Save all active filter groups GROUPS as NAME. +They are added to `ibuffer-saved-filter-groups'. Interactively, +prompt for NAME, and use the current filters. + +\(fn NAME GROUPS)" t nil) + +(autoload 'ibuffer-delete-saved-filter-groups "ibuf-ext" "\ +Delete saved filter groups with NAME. +They are removed from `ibuffer-saved-filter-groups'. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-switch-to-saved-filter-groups "ibuf-ext" "\ +Set this buffer's filter groups to saved version with NAME. +The value from `ibuffer-saved-filter-groups' is used. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-filter-disable "ibuf-ext" "\ +Disable all filters currently in effect in this buffer. + +\(fn)" t nil) + +(autoload 'ibuffer-pop-filter "ibuf-ext" "\ +Remove the top filter in this buffer. + +\(fn)" t nil) + +(autoload 'ibuffer-decompose-filter "ibuf-ext" "\ +Separate the top compound filter (OR, NOT, or SAVED) in this buffer. + +This means that the topmost filter on the filtering stack, which must +be a complex filter like (OR [name: foo] [mode: bar-mode]), will be +turned into two separate filters [name: foo] and [mode: bar-mode]. + +\(fn)" t nil) + +(autoload 'ibuffer-exchange-filters "ibuf-ext" "\ +Exchange the top two filters on the stack in this buffer. + +\(fn)" t nil) + +(autoload 'ibuffer-negate-filter "ibuf-ext" "\ +Negate the sense of the top filter in the current buffer. + +\(fn)" t nil) + +(autoload 'ibuffer-or-filter "ibuf-ext" "\ +Replace the top two filters in this buffer with their logical OR. +If optional argument REVERSE is non-nil, instead break the top OR +filter into parts. + +\(fn &optional REVERSE)" t nil) + +(autoload 'ibuffer-save-filters "ibuf-ext" "\ +Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'. +Interactively, prompt for NAME, and use the current filters. + +\(fn NAME FILTERS)" t nil) + +(autoload 'ibuffer-delete-saved-filters "ibuf-ext" "\ +Delete saved filters with NAME from `ibuffer-saved-filters'. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-add-saved-filters "ibuf-ext" "\ +Add saved filters from `ibuffer-saved-filters' to this buffer's filters. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-switch-to-saved-filters "ibuf-ext" "\ +Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'. + +\(fn NAME)" t nil) + (autoload 'ibuffer-filter-by-mode "ibuf-ext") + (autoload 'ibuffer-filter-by-used-mode "ibuf-ext") + (autoload 'ibuffer-filter-by-name "ibuf-ext") + (autoload 'ibuffer-filter-by-filename "ibuf-ext") + (autoload 'ibuffer-filter-by-size-gt "ibuf-ext") + (autoload 'ibuffer-filter-by-size-lt "ibuf-ext") + (autoload 'ibuffer-filter-by-content "ibuf-ext") + (autoload 'ibuffer-filter-by-predicate "ibuf-ext") + +(autoload 'ibuffer-toggle-sorting-mode "ibuf-ext" "\ +Toggle the current sorting mode. +Default sorting modes are: + Recency - the last time the buffer was viewed + Name - the name of the buffer + Major Mode - the name of the major mode of the buffer + Size - the size of the buffer + +\(fn)" t nil) + +(autoload 'ibuffer-invert-sorting "ibuf-ext" "\ +Toggle whether or not sorting is in reverse order. + +\(fn)" t nil) + (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext") + (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext") + (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext") + (autoload 'ibuffer-do-sort-by-size "ibuf-ext") + (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext") + +(autoload 'ibuffer-bs-show "ibuf-ext" "\ +Emulate `bs-show' from the bs.el package. + +\(fn)" t nil) + +(autoload 'ibuffer-add-to-tmp-hide "ibuf-ext" "\ +Add REGEXP to `ibuffer-tmp-hide-regexps'. +This means that buffers whose name matches REGEXP will not be shown +for this Ibuffer session. + +\(fn REGEXP)" t nil) + +(autoload 'ibuffer-add-to-tmp-show "ibuf-ext" "\ +Add REGEXP to `ibuffer-tmp-show-regexps'. +This means that buffers whose name matches REGEXP will always be shown +for this Ibuffer session. + +\(fn REGEXP)" t nil) + +(autoload 'ibuffer-forward-next-marked "ibuf-ext" "\ +Move forward by COUNT marked buffers (default 1). + +If MARK is non-nil, it should be a character denoting the type of mark +to move by. The default is `ibuffer-marked-char'. + +If DIRECTION is non-nil, it should be an integer; negative integers +mean move backwards, non-negative integers mean move forwards. + +\(fn &optional COUNT MARK DIRECTION)" t nil) + +(autoload 'ibuffer-backwards-next-marked "ibuf-ext" "\ +Move backwards by COUNT marked buffers (default 1). + +If MARK is non-nil, it should be a character denoting the type of mark +to move by. The default is `ibuffer-marked-char'. + +\(fn &optional COUNT MARK)" t nil) + +(autoload 'ibuffer-do-kill-lines "ibuf-ext" "\ +Hide all of the currently marked lines. + +\(fn)" t nil) + +(autoload 'ibuffer-jump-to-buffer "ibuf-ext" "\ +Move point to the buffer whose name is NAME. + +If called interactively, prompt for a buffer name and go to the +corresponding line in the Ibuffer buffer. If said buffer is in a +hidden group filter, open it. + +If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer +visible buffers in the completion list. Calling the command with +a prefix argument reverses the meaning of that variable. + +\(fn NAME)" t nil) + +(autoload 'ibuffer-diff-with-file "ibuf-ext" "\ +View the differences between marked buffers and their associated files. +If no buffers are marked, use buffer at point. +This requires the external program \"diff\" to be in your `exec-path'. + +\(fn)" t nil) + +(autoload 'ibuffer-copy-filename-as-kill "ibuf-ext" "\ +Copy filenames of marked buffers into the kill ring. + +The names are separated by a space. +If a buffer has no filename, it is ignored. + +With no prefix arg, use the filename sans its directory of each marked file. +With a zero prefix arg, use the complete filename of each marked file. +With \\[universal-argument], use the filename of each marked file relative +to `ibuffer-default-directory' if non-nil, otherwise `default-directory'. + +You can then feed the file name(s) to other commands with \\[yank]. + +\(fn &optional ARG)" t nil) + +(autoload 'ibuffer-mark-by-name-regexp "ibuf-ext" "\ +Mark all buffers whose name matches REGEXP. + +\(fn REGEXP)" t nil) + +(autoload 'ibuffer-mark-by-mode-regexp "ibuf-ext" "\ +Mark all buffers whose major mode matches REGEXP. + +\(fn REGEXP)" t nil) + +(autoload 'ibuffer-mark-by-file-name-regexp "ibuf-ext" "\ +Mark all buffers whose file name matches REGEXP. + +\(fn REGEXP)" t nil) + +(autoload 'ibuffer-mark-by-mode "ibuf-ext" "\ +Mark all buffers whose major mode equals MODE. + +\(fn MODE)" t nil) + +(autoload 'ibuffer-mark-modified-buffers "ibuf-ext" "\ +Mark all modified buffers. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-unsaved-buffers "ibuf-ext" "\ +Mark all modified buffers that have an associated file. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-dissociated-buffers "ibuf-ext" "\ +Mark all buffers whose associated file does not exist. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-help-buffers "ibuf-ext" "\ +Mark buffers like *Help*, *Apropos*, *Info*. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-compressed-file-buffers "ibuf-ext" "\ +Mark buffers whose associated file is compressed. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-old-buffers "ibuf-ext" "\ +Mark buffers which have not been viewed in `ibuffer-old-time' hours. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-special-buffers "ibuf-ext" "\ +Mark all buffers whose name begins and ends with '*'. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-read-only-buffers "ibuf-ext" "\ +Mark all read-only buffers. + +\(fn)" t nil) + +(autoload 'ibuffer-mark-dired-buffers "ibuf-ext" "\ +Mark all `dired' buffers. + +\(fn)" t nil) + +(autoload 'ibuffer-do-occur "ibuf-ext" "\ +View lines which match REGEXP in all marked buffers. +Optional argument NLINES says how many lines of context to display: it +defaults to one. + +\(fn REGEXP &optional NLINES)" t nil) + +;;;*** + +;;; End of automatically extracted autoloads. + + (provide 'ibuffer) (run-hooks 'ibuffer-load-hook) diff --git a/lisp/ido.el b/lisp/ido.el index fa85cf1c6ed..2336feacf9e 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3660,6 +3660,7 @@ for first matching file." matches (cdr error)))) (when prefix-matches (ido-trace "prefix match" prefix-matches) + ;; Bug#2042. (setq matches (nconc prefix-matches matches))) (when suffix-matches (ido-trace "suffix match" (list text suffix-re suffix-matches)) diff --git a/lisp/image.el b/lisp/image.el index 076a969a363..e2f4977ed10 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -43,7 +43,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm) ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff) ("\\`[\t\n\r ]*%!PS" . postscript) - ("\\`\xff\xd8" . (image-jpeg-p . jpeg)) + ("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<" @@ -98,18 +98,17 @@ AUTODETECT can be - maybe auto-detect only if the image type is available (see `image-type-available-p').") -(defvar image-load-path nil +(defcustom image-load-path + (list (file-name-as-directory (expand-file-name "images" data-directory)) + 'data-directory 'load-path) "List of locations in which to search for image files. If an element is a string, it defines a directory to search. If an element is a variable symbol whose value is a string, that value defines a directory to search. If an element is a variable symbol whose value is a list, the -value is used as a list of directories to search.") - -(eval-at-startup - (setq image-load-path - (list (file-name-as-directory (expand-file-name "images" data-directory)) - 'data-directory 'load-path))) +value is used as a list of directories to search." + :type '(repeat (choice directory variable)) + :initialize 'custom-initialize-delay) (defun image-load-path-for-library (library image &optional path no-error) diff --git a/lisp/imenu.el b/lisp/imenu.el index a1707f3ca61..77035c602d8 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -198,6 +198,7 @@ For example, see the value of `fortran-imenu-generic-expression' used by `fortran-mode' with `imenu-syntax-alist' set locally to give the characters which normally have \"symbol\" syntax \"word\" syntax during matching.") +;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t) ;;;###autoload (make-variable-buffer-local 'imenu-generic-expression) @@ -297,9 +298,9 @@ The function in this variable is called when selecting a normal index-item.") ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; FIXME: This is the only imenu-example-* definition that's actually used, -;; and it seems to only be used by cperl-mode.el. We should just move it to -;; cperl-mode.el and remove the rest. +;; FIXME: This was the only imenu-example-* definition actually used, +;; by cperl-mode.el. Now cperl-mode has its own copy, so these can +;; all be removed. (defun imenu-example--name-and-position () "Return the current/previous sexp and its (beginning) location. Don't move point." @@ -444,6 +445,7 @@ if it is a sub-alist. There is one simple element with negative POSITION; selecting that element recalculates the buffer's index alist.") +;;;###autoload(put 'imenu--index-alist 'risky-local-variable t) (make-variable-buffer-local 'imenu--index-alist) diff --git a/lisp/info.el b/lisp/info.el index be61127176c..cfaf749ef8a 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,4 +1,4 @@ -;;; info.el --- info package for Emacs +;; info.el --- info package for Emacs ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 @@ -83,32 +83,28 @@ The Lisp code is executed when the node is selected.") (t :height 1.2 :inherit info-title-2)) "Face for info titles at level 1." :group 'info) -;; backward-compatibility alias -(put 'Info-title-1-face 'face-alias 'info-title-1) +(define-obsolete-face-alias 'Info-title-1-face 'info-title-1 "22.1") (defface info-title-2 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) (t :height 1.2 :inherit info-title-3)) "Face for info titles at level 2." :group 'info) -;; backward-compatibility alias -(put 'Info-title-2-face 'face-alias 'info-title-2) +(define-obsolete-face-alias 'Info-title-2-face 'info-title-2 "22.1") (defface info-title-3 '((((type tty pc) (class color)) :weight bold) (t :height 1.2 :inherit info-title-4)) "Face for info titles at level 3." :group 'info) -;; backward-compatibility alias -(put 'Info-title-3-face 'face-alias 'info-title-3) +(define-obsolete-face-alias 'Info-title-3-face 'info-title-3 "22.1") (defface info-title-4 '((((type tty pc) (class color)) :weight bold) (t :weight bold :inherit variable-pitch)) "Face for info titles at level 4." :group 'info) -;; backward-compatibility alias -(put 'Info-title-4-face 'face-alias 'info-title-4) +(define-obsolete-face-alias 'Info-title-4-face 'info-title-4 "22.1") (defface info-menu-header '((((type tty pc)) @@ -125,7 +121,7 @@ The Lisp code is executed when the node is selected.") (t :underline t)) "Face for every third `*' in an Info menu." :group 'info) -(put 'info-menu-5 'face-alias 'info-menu-star) +(define-obsolete-face-alias 'info-menu-5 'info-menu-star "22.1") (defface info-xref '((t :inherit link)) @@ -3522,9 +3518,10 @@ If FORK is a string, it is the name to use for the new buffer." If FORK is non-nil, it is passed to `Info-goto-node'." (let (node) (cond - ((Info-get-token (point) "[hf]t?tps?://" "[hf]t?tps?://\\([^ \t\n\"`({<>})']+\\)") - (setq node t) - (browse-url (browse-url-url-at-point))) + ((setq node (Info-get-token (point) "[hf]t?tps?://" + "\\([hf]t?tps?://[^ \t\n\"`({<>})']+\\)")) + (browse-url node) + (setq node t)) ((setq node (Info-get-token (point) "\\*note[ \n\t]+" "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")) (Info-follow-reference node fork)) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index c428ab2bdbe..5bc80b5873a 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -184,7 +184,8 @@ Combining diacritic or mark (Unicode General Category M)") (map-charset-chars #'modify-category-entry 'latin-jisx0201 ?r) (dolist (l '(katakana-jisx0201 japanese-jisx0208 japanese-jisx0212 - japanese-jisx0213-1 japanese-jisx0213-2)) + japanese-jisx0213-1 japanese-jisx0213-2 + cp932-2-byte)) (map-charset-chars #'modify-category-entry l ?j)) ;; Unicode equivalents of JISX0201-kana diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index e2c6491d4af..f9d3c85125a 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -308,6 +308,74 @@ (declare-function set-fontset-font "fontset.c" (name target font-spec &optional frame add)) +(eval-when-compile + +;; Build a data to initialize the default fontset at compile time to +;; avoid loading charsets that won't be necessary at runtime. + +;; The value is (CJK-REGISTRY-VECTOR TARGET-SPEC ...), where +;; CJK-REGISTRY-VECTOR is ["JISX0208.1983-0" "GB2312.1980-0" ...], +;; TARGET-SPEC is (TARGET . BITMASK) or (TARGET SPEC ...), +;; TARGET is CHAR or (FROM-CHAR . TO-CHAR), +;; BITMASK is a bitmask of indices to CJK-REGISTRY-VECTOR, +;; SPEC is a list of arguments to font-spec. + +(defmacro build-default-fontset-data () + (let* (;; CHARSET-REGISTRY CHARSET FROM-CODE TO-CODE + (cjk '(("JISX0208.1983-0" japanese-jisx0208 #x2121 #x287E) + ("GB2312.1980-0" chinese-gb2312 #x2121 #x297E) + ("BIG5-0" big5 #xA140 #xA3FE) + ("CNS11643.1992-1" chinese-cns11643-1 #x2121 #x427E) + ("KSC5601.1987-0" korean-ksc5601 #x2121 #x2C7E))) + (scripts '((tibetan + (:registry "iso10646-1" :otf (tibt nil (ccmp blws abvs))) + (:family "mtib" :registry "iso10646-1") + (:registry "muletibetan-2")) + (ethiopic + (:registry "iso10646-1" :script ethiopic) + (:registry "ethiopic-unicode")) + (phonetic + (:registry "iso10646-1" :script phonetic) + (:registry "MuleIPA-1") + (:registry "iso10646-1")))) + (cjk-table (make-char-table nil)) + (script-coverage + #'(lambda (script) + (let ((coverage)) + (map-char-table + #'(lambda (range val) + (when (eq val script) + (if (consp range) + (setq range (cons (car range) (cdr range)))) + (push range coverage))) + char-script-table) + coverage))) + (data (list (vconcat (mapcar 'car cjk)))) + (i 0)) + (dolist (elt cjk) + (let ((mask (lsh 1 i))) + (map-charset-chars + #'(lambda (range arg) + (let ((from (car range)) (to (cdr range))) + (if (< to #x110000) + (while (<= from to) + (aset cjk-table from + (logior (or (aref cjk-table from) 0) mask)) + (setq from (1+ from)))))) + (nth 1 elt) nil (nth 2 elt) (nth 3 elt))) + (setq i (1+ i))) + (map-char-table + #'(lambda (range val) + (if (consp range) + (setq range (cons (car range) (cdr range)))) + (push (cons range val) data)) + cjk-table) + (dolist (script scripts) + (dolist (range (funcall script-coverage (car script))) + (push (cons range (cdr script)) data))) + `(quote ,(nreverse data)))) +) + (defun setup-default-fontset () "Setup the default fontset." (new-fontset @@ -349,16 +417,6 @@ (tai-viet ("TaiViet" . "iso10646-1")) - ;; both for script and charset. - (tibetan ,(font-spec :registry "iso10646-1" - :otf '(tibt nil (ccmp blws abvs))) - ,(font-spec :family "mtib" :registry "iso10646-1") - (nil . "muletibetan-2")) - - ;; both for script and charset. - (ethiopic ,(font-spec :registry "iso10646-1" :script 'ethiopic) - (nil . "ethiopic-unicode")) - (greek ,(font-spec :registry "iso10646-1" :script 'greek) (nil . "ISO8859-7")) @@ -461,11 +519,6 @@ (telugu-akruti (nil . "Telugu-Akruti")) (kannada-akruti (nil . "Kannada-Akruti")) (malayalam-akruti (nil . "Malayalam-Akruti")) - ;;(devanagari-glyph ("altsys-dv_ttsurekh" . "devanagari-cdac")) - ;;(malayalam-glyph ("altsys-ml_ttkarthika" . "malayalam-cdac")) - (ipa ,(font-spec :registry "iso10646-1" :script 'phonetic) - (nil . "MuleIPA-1") - (nil . "iso10646-1")) ;; Fallback fonts (nil (nil . "gb2312.1980") @@ -567,18 +620,21 @@ (font-spec :registry "iso10646-1" :script (nth 2 math-subgroup)))) ;; Append CJK fonts for characters other than han, kana, cjk-misc. - ;; CHARSET-REGISTRY CHARSET FROM-CODE TO-CODE - (let ((list '(("JISX0208.1983-0" japanese-jisx0208 #x2121 #x287E) - ("GB2312.1980-0" chinese-gb2312 #x2121 #x297E) - ("BIG5-0" big5 #xA140 #xA3FE) - ("CNS11643.1992-1" chinese-cns11643-1 #x2121 #x427E) - ("KSC5601.1987-0" korean-ksc5601 #x2121 #x2C7E)))) - (dolist (elt list) - (map-charset-chars - #'(lambda (range arg) - (set-fontset-font "fontset-default" range - (cons nil (car elt)) nil 'append)) - (nth 1 elt) nil (nth 2 elt) (nth 3 elt)))) + ;; Append fonts for scripts whose name is also a charset name. + (let* ((data (build-default-fontset-data)) + (registries (car data))) + (dolist (target-spec (cdr data)) + (let ((target (car target-spec)) + (spec (cdr target-spec))) + (if (integerp spec) + (dotimes (i (length registries)) + (if (> (logand spec (lsh 1 i)) 0) + (set-fontset-font "fontset-default" target + (cons nil (aref registries i)) + nil 'append))) + (dolist (args spec) + (set-fontset-font "fontset-default" target + (apply 'font-spec args) nil 'append)))))) ;; Append Unicode fonts. ;; This may find fonts with more variants (bold, italic) but which diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 5ec3f286b9d..eba35856f0e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -31,6 +31,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) ; letf + (defvar dos-codepage) (autoload 'widget-value "wid-edit") @@ -127,8 +129,8 @@ (define-key-after map [separator-input-method] '("--")) (define-key-after map [set-various-coding-system] - (list 'menu-item "Set Coding Systems" set-coding-system-map - :enable 'default-enable-multibyte-characters)) + `(menu-item "Set Coding Systems" ,set-coding-system-map + :enable (default-value 'enable-multibyte-characters))) (define-key-after map [view-hello-file] '(menu-item "Show Multi-lingual Text" view-hello-file :enable (file-readable-p @@ -281,9 +283,9 @@ wrong, use this command again to toggle back to the right mode." "Display the HELLO file, which lists many languages and characters." (interactive) ;; We have to decode the file in any environment. - (let ((default-enable-multibyte-characters t) - (coding-system-for-read 'iso-2022-7bit)) - (view-file (expand-file-name "HELLO" data-directory)))) + (letf (((default-value 'enable-multibyte-characters) t) + (coding-system-for-read 'iso-2022-7bit)) + (view-file (expand-file-name "HELLO" data-directory)))) (defun universal-coding-system-argument (coding-system) "Execute an I/O command using the specified coding system." @@ -358,7 +360,7 @@ This also sets the following values: (if (eq system-type 'darwin) ;; The file-name coding system on Darwin systems is always utf-8. (setq default-file-name-coding-system 'utf-8) - (if (and default-enable-multibyte-characters + (if (and (default-value 'enable-multibyte-characters) (or (not coding-system) (coding-system-get coding-system 'ascii-compatible-p))) (setq default-file-name-coding-system coding-system))) @@ -813,7 +815,7 @@ between FROM and TO are shown in a popup window. Among them, the most proper one is suggested as the default. The list of `buffer-file-coding-system' of the current buffer, the -`default-buffer-file-coding-system', and the most preferred coding +default `buffer-file-coding-system', and the most preferred coding system (if it corresponds to a MIME charset) is treated as the default coding system list. Among them, the first one that safely encodes the text is normally selected silently and returned without @@ -829,7 +831,7 @@ Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a list of coding systems to be prepended to the default coding system list. However, if DEFAULT-CODING-SYSTEM is a list and the first element is t, the cdr part is used as the default coding system list, -i.e. `buffer-file-coding-system', `default-buffer-file-coding-system', +i.e. current `buffer-file-coding-system', default `buffer-file-coding-system', and the most preferred coding system are not used. Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to @@ -908,16 +910,18 @@ It is highly recommended to fix it before writing to a file." (unless (and buffer-file-coding-system-explicit (cdr buffer-file-coding-system-explicit)) - ;; If default-buffer-file-coding-system is not nil nor undecided, + ;; If default buffer-file-coding-system is not nil nor undecided, ;; append it to the defaults. - (if default-buffer-file-coding-system - (let ((base (coding-system-base default-buffer-file-coding-system))) - (or (eq base 'undecided) - (rassq base default-coding-system) - (setq default-coding-system - (append default-coding-system - (list (cons default-buffer-file-coding-system - base))))))) + (when (default-value 'buffer-file-coding-system) + (let ((base (coding-system-base + (default-value 'buffer-file-coding-system)))) + (or (eq base 'undecided) + (rassq base default-coding-system) + (setq default-coding-system + (append default-coding-system + (list (cons (default-value + 'buffer-file-coding-system) + base))))))) ;; If the most preferred coding system has the property mime-charset, ;; append it to the defaults. @@ -935,17 +939,18 @@ It is highly recommended to fix it before writing to a file." (setq accept-default-p select-safe-coding-system-accept-default-p)) ;; Decide the eol-type from the top of the default codings, - ;; buffer-file-coding-system, or - ;; default-buffer-file-coding-system. + ;; current buffer-file-coding-system, or default buffer-file-coding-system. (if default-coding-system (let ((default-eol-type (coding-system-eol-type (caar default-coding-system)))) (if (and (vectorp default-eol-type) buffer-file-coding-system) (setq default-eol-type (coding-system-eol-type buffer-file-coding-system))) - (if (and (vectorp default-eol-type) default-buffer-file-coding-system) - (setq default-eol-type (coding-system-eol-type - default-buffer-file-coding-system))) + (if (and (vectorp default-eol-type) + (default-value 'buffer-file-coding-system)) + (setq default-eol-type + (coding-system-eol-type + (default-value 'buffer-file-coding-system)))) (if (and default-eol-type (not (vectorp default-eol-type))) (dolist (elt default-coding-system) (setcar elt (coding-system-change-eol-conversion @@ -1032,7 +1037,7 @@ in this order: (1) local value of `buffer-file-coding-system' (2) value of `sendmail-coding-system' (3) value of `default-sendmail-coding-system' - (4) value of `default-buffer-file-coding-system' + (4) default value of `buffer-file-coding-system' If the found coding system can't encode the current buffer, or none of them are bound to a coding system, it asks the user to select a proper coding system." @@ -1040,7 +1045,7 @@ it asks the user to select a proper coding system." buffer-file-coding-system) sendmail-coding-system default-sendmail-coding-system - default-buffer-file-coding-system))) + (default-value 'buffer-file-coding-system)))) (if (eq coding 'no-conversion) ;; We should never use no-conversion for outgoing mail. (setq coding nil)) @@ -1093,9 +1098,9 @@ Meaningful values for KEY include in extended segments of CTEXT. See the variable `ctext-non-standard-encodings' for more detail. -The following keys take effect only when multibyte characters are -globally disabled, i.e. the value of `default-enable-multibyte-characters' -is nil. +The following key takes effect only when multibyte characters are +globally disabled, i.e. the default value of `enable-multibyte-characters' +is nil (which is an obsolete and deprecated use): unibyte-display value is a coding system to encode characters for the terminal. Characters in the range of 160 to @@ -1135,7 +1140,7 @@ see `language-info-alist'." (set-language-environment-nonascii-translation lang-env)) ((eq key 'charset) (set-language-environment-charset lang-env)) - ((and (not default-enable-multibyte-characters) + ((and (not (default-value 'enable-multibyte-characters)) (or (eq key 'unibyte-syntax) (eq key 'unibyte-display))) (set-language-environment-unibyte lang-env))))) @@ -1337,6 +1342,8 @@ This function is called with no argument.") Each element has the form: (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...) See the function `register-input-method' for the meanings of the elements.") +;; Autoload if this file no longer dumped. +(put 'input-method-alist 'risky-local-variable t) (defun register-input-method (input-method lang-env &rest args) "Register INPUT-METHOD as an input method for language environment LANG-ENV. @@ -1844,7 +1851,7 @@ specifies the character set for the major languages of Western Europe." (set-language-environment-nonascii-translation language-name) (set-language-environment-charset language-name) ;; Unibyte setups if necessary. - (unless default-enable-multibyte-characters + (unless (default-value 'enable-multibyte-characters) (set-language-environment-unibyte language-name)) (let ((func (get-language-info language-name 'setup-function))) @@ -1929,7 +1936,8 @@ See `set-language-info-alist' for use in programs." ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with ;; the native font, and codes 160 and 146 stand for something very ;; different there. - (or (and (eq window-system 'pc) (not default-enable-multibyte-characters)) + (or (and (eq window-system 'pc) (not (default-value + 'enable-multibyte-characters))) (progn ;; Most X fonts used to do the wrong thing for latin-1 code 160. (unless (and (eq window-system 'x) @@ -1952,9 +1960,9 @@ See `set-language-info-alist' for use in programs." "Do various coding system setups for language environment LANGUAGE-NAME." (let* ((priority (get-language-info language-name 'coding-priority)) (default-coding (car priority)) - ;; If default-buffer-file-coding-system is nil, don't use + ;; If the default buffer-file-coding-system is nil, don't use ;; coding-system-eol-type, because it treats nil as - ;; `no-conversion'. default-buffer-file-coding-system is set + ;; `no-conversion'. The default buffer-file-coding-system is set ;; to nil by reset-language-environment, and in that case we ;; want to have here the native EOL type for each platform. ;; FIXME: there should be a common code that runs both on @@ -1963,14 +1971,12 @@ See `set-language-info-alist' for use in programs." ;; which works only as long as the order of loading files at ;; dump time and calling functions at startup is not modified ;; significantly, i.e. as long as this function is called - ;; _after_ default-buffer-file-coding-system was set by + ;; _after_ the default buffer-file-coding-system was set by ;; dos-w32.el. (eol-type - (if (null default-buffer-file-coding-system) - (cond ((memq system-type '(windows-nt ms-dos)) 1) - ((eq system-type 'macos) 2) - (t 0)) - (coding-system-eol-type default-buffer-file-coding-system)))) + (coding-system-eol-type + (or (default-value 'buffer-file-coding-system) + (if (memq system-type '(windows-nt ms-dos)) 'dos 'unix))))) (when priority (set-default-coding-systems (if (memq eol-type '(0 1 2 unix dos mac)) @@ -2563,7 +2569,7 @@ See also `locale-charset-language-names', `locale-language-names', (charset-language-name (locale-name-match locale locale-charset-language-names)) (default-eol-type (coding-system-eol-type - default-buffer-file-coding-system)) + (default-value 'buffer-file-coding-system))) (coding-system (or (locale-name-match locale locale-preferred-coding-systems) (when locale @@ -2599,10 +2605,10 @@ See also `locale-charset-language-names', `locale-language-names', (unless frame (set-language-environment language-name)) - ;; If default-enable-multibyte-characters is nil, + ;; If the default enable-multibyte-characters is nil, ;; we are using single-byte characters, ;; so the display table and terminal coding system are irrelevant. - (when default-enable-multibyte-characters + (when (default-value 'enable-multibyte-characters) (set-display-table-and-terminal-coding-system language-name coding-system frame)) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 89daaae7063..8417a7c1142 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -516,8 +516,8 @@ in place of `..': eol-type of `process-coding-system' for read (of the current buffer, if any) `process-coding-system' for write (of the current buffer, if any) eol-type of `process-coding-system' for write (of the current buffer, if any) - `default-buffer-file-coding-system' - eol-type of `default-buffer-file-coding-system' + default `buffer-file-coding-system' + eol-type of default `buffer-file-coding-system' `default-process-coding-system' for read eol-type of `default-process-coding-system' for read `default-process-coding-system' for write @@ -537,8 +537,9 @@ in place of `..': (coding-system-eol-type-mnemonic (car process-coding-systems)) (coding-system-mnemonic (cdr process-coding-systems)) (coding-system-eol-type-mnemonic (cdr process-coding-systems)) - (coding-system-mnemonic default-buffer-file-coding-system) - (coding-system-eol-type-mnemonic default-buffer-file-coding-system) + (coding-system-mnemonic (default-value 'buffer-file-coding-system)) + (coding-system-eol-type-mnemonic + (default-value 'buffer-file-coding-system)) (coding-system-mnemonic (car default-process-coding-system)) (coding-system-eol-type-mnemonic (car default-process-coding-system)) (coding-system-mnemonic (cdr default-process-coding-system)) @@ -592,7 +593,7 @@ docstring, and print only the first line of the docstring." (print-coding-system-briefly buffer-file-coding-system) (princ "Not set locally, use the default.\n")) (princ "Default coding system (for new files):\n ") - (print-coding-system-briefly default-buffer-file-coding-system) + (print-coding-system-briefly (default-value 'buffer-file-coding-system)) (princ "Coding system for keyboard input:\n ") (print-coding-system-briefly (keyboard-coding-system)) (princ "Coding system for terminal output:\n ") @@ -1087,7 +1088,8 @@ system which uses fontsets)." (insert "Version of this emacs:\n " (emacs-version) "\n\n") (insert "Configuration options:\n " system-configuration-options "\n\n") (insert "Multibyte characters awareness:\n" - (format " default: %S\n" default-enable-multibyte-characters) + (format " default: %S\n" (default-value + 'enable-multibyte-characters)) (format " current-buffer: %S\n\n" enable-multibyte-characters)) (insert "Current language environment: " current-language-environment "\n\n") diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 9cbec2f024d..712291b4abf 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -307,12 +307,9 @@ Return t if file exists." (signal 'file-error (list "Cannot open load file" file))) ;; Read file with code conversion, and then eval. (let* ((buffer - ;; To avoid any autoloading, set default-major-mode to - ;; fundamental-mode. - (let ((default-major-mode 'fundamental-mode)) - ;; We can't use `generate-new-buffer' because files.el - ;; is not yet loaded. - (get-buffer-create (generate-new-buffer-name " *load*")))) + ;; We can't use `generate-new-buffer' because files.el + ;; is not yet loaded. + (get-buffer-create (generate-new-buffer-name " *load*"))) (load-in-progress t) (source (save-match-data (string-match "\\.el\\'" fullname)))) (unless nomessage @@ -351,7 +348,7 @@ Return t if file exists." ;; If this Emacs is running with --unibyte, ;; convert multibyte strings to unibyte ;; after reading them. -;; (not default-enable-multibyte-characters) +;; (not (default-value 'enable-multibyte-characters)) nil t )) (let (kill-buffer-hook kill-buffer-query-functions) diff --git a/lisp/international/robin.el b/lisp/international/robin.el index ab8c0e2230a..e4a9dab5589 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -5,7 +5,7 @@ ;; Registration Number: H15PRO110 ;; Author: TAKAHASHI Naoto <ntakahas@m17n.org> -;; Keywords: mule, multilingual, input method +;; Keywords: mule, multilingual, input method, i18n ;; This file is part of GNU Emacs. diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index a0e46adef54..876237300cf 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -88,8 +88,8 @@ ;; with previous character, then the beginning of the block is ;; the searched character. If searched character is combining ;; character, then previous character will be the target -;; character -;; (2) end of the block +;; character +;; (2) end of the block ;; Block ends at non-composable starter character. ;; ;; C. Decomposition (`ucs-normalize-block') @@ -112,6 +112,8 @@ (eval-when-compile (require 'cl)) +(declare-function nfd "ucs-normalize" (char)) + (eval-when-compile (defconst ucs-normalize-composition-exclusions @@ -166,7 +168,7 @@ (eval-when-compile - (defvar combining-chars nil) + (defvar combining-chars nil) (setq combining-chars nil) (defvar decomposition-pair-to-composition nil) (setq decomposition-pair-to-composition nil) @@ -199,9 +201,9 @@ check-range)) (setq combining-chars - (append combining-chars + (append combining-chars '(?á…¡ ?á…¢ ?á…£ ?á…¤ ?á…¥ ?á…¦ ?á…§ ?á…¨ ?á…© ?á…ª - ?á…« ?á…¬ ?á… ?á…® ?á…¯ ?á…° ?á…± ?á…² ?á…³ ?á…´ ?á…µ + ?á…« ?á…¬ ?á… ?á…® ?á…¯ ?á…° ?á…± ?á…² ?á…³ ?á…´ ?á…µ ?ᆨ ?ᆩ ?ᆪ ?ᆫ ?ᆬ ?ᆠ?ᆮ ?ᆯ ?ᆰ ?ᆱ ?ᆲ ?ᆳ ?ᆴ ?ᆵ ?ᆶ ?ᆷ ?ᆸ ?ᆹ ?ᆺ ?ᆻ ?ᆼ ?ᆽ ?ᆾ ?ᆿ ?ᇀ ?ᇠ?ᇂ))) ) @@ -251,6 +253,12 @@ Note that Hangul are excluded.") (setq ucs-normalize-combining-chars-regexp (eval-when-compile (concat (regexp-opt (mapcar 'char-to-string combining-chars)) "+"))) +(declare-function decomposition-translation-alist "ucs-normalize" + (decomposition-function)) +(declare-function decomposition-char-recursively "ucs-normalize" + (char decomposition-function)) +(declare-function alist-list-to-vector "ucs-normalize" (alist)) + (eval-when-compile (defun decomposition-translation-alist (decomposition-function) @@ -262,7 +270,7 @@ Note that Hangul are excluded.") (if decomposition (setq alist (cons (cons char (apply 'append - (mapcar (lambda (x) + (mapcar (lambda (x) (decomposition-char-recursively x decomposition-function)) decomposition))) @@ -274,7 +282,7 @@ Note that Hangul are excluded.") (let ((decomposition (funcall decomposition-function char))) (if decomposition (apply 'append - (mapcar (lambda (x) + (mapcar (lambda (x) (decomposition-char-recursively x decomposition-function)) decomposition)) (list char)))) @@ -295,8 +303,8 @@ Note that Hangul are excluded.") (setq ucs-normalize-hangul-translation-alist (let ((i 0) entries) (while (< i 11172) - (setq entries - (cons (cons (+ #xac00 i) + (setq entries + (cons (cons (+ #xac00 i) (if (= 0 (% i 28)) (vector (+ #x1100 (/ i 588)) (+ #x1161 (/ (% i 588) 28))) @@ -307,7 +315,7 @@ Note that Hangul are excluded.") i (1+ i))) entries)) (defun ucs-normalize-make-translation-table-from-alist (alist) - (make-translation-table-from-alist + (make-translation-table-from-alist (append alist ucs-normalize-hangul-translation-alist))) (define-translation-table 'ucs-normalize-nfd-table @@ -318,7 +326,7 @@ Note that Hangul are excluded.") (ucs-normalize-make-translation-table-from-alist (eval-when-compile hfs-nfd-alist))) (defun ucs-normalize-sort (chars) - "Sort by canonical combining class of chars." + "Sort by canonical combining class of CHARS." (sort chars (lambda (ch1 ch2) (< (ucs-normalize-ccc ch1) (ucs-normalize-ccc ch2))))) @@ -364,20 +372,24 @@ If COMPOSITION-PREDICATE is not given, then do nothing." chars))) ) +(declare-function quick-check-list "ucs-normalize" + (decomposition-translation &optional composition-predicate)) +(declare-function quick-check-list-to-regexp "ucs-normalize" (quick-check-list)) + (eval-when-compile (defun quick-check-list (decomposition-translation &optional composition-predicate) "Quick-Check List for DECOMPOSITION-TRANSLATION and COMPOSITION-PREDICATE. It includes Singletons, CompositionExclusions, and Non-Starter -decomposition. " +decomposition." (let (entries decomposition composition) (mapc (lambda (start-end) (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) (setq decomposition (string-to-list - (with-temp-buffer + (with-temp-buffer (insert i) (translate-region 1 2 decomposition-translation) (buffer-string)))) @@ -592,7 +604,7 @@ COMPOSITION-PREDICATE will be used to compose region." (defun ucs-normalize-hfs-nfd-pre-write-conversion (from to) (let ((old-buf (current-buffer))) (set-buffer (generate-new-buffer " *temp*")) - (if (stringp from) + (if (stringp from) (insert from) (insert-buffer-substring old-buf from to)) (ucs-normalize-HFS-NFD-region (point-min) (point-max)) diff --git a/lisp/isearch.el b/lisp/isearch.el index 663142ec687..bf2f0738d97 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1,7 +1,7 @@ ;;; isearch.el --- incremental search minor mode -;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ;; Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu> @@ -322,7 +322,7 @@ A value of nil means highlight all matches." "Face for lazy highlighting of matches other than the current one." :group 'lazy-highlight :group 'basic-faces) -(put 'isearch-lazy-highlight-face 'face-alias 'lazy-highlight) +(define-obsolete-face-alias 'isearch-lazy-highlight-face 'lazy-highlight "22.1") (defvar lazy-highlight-face 'lazy-highlight) (define-obsolete-variable-alias 'isearch-lazy-highlight-face 'lazy-highlight-face @@ -347,7 +347,7 @@ A value of nil means highlight all matches." (eval-when-compile (require 'help-macro)) (make-help-screen isearch-help-for-help-internal - "Type a help option: [bkm] or ?" + (purecopy "Type a help option: [bkm] or ?") "You have typed %THIS-KEY%, the help character. Type a Help option: \(Type \\<help-map>\\[help-quit] to exit the Help command.) @@ -2496,8 +2496,8 @@ since they have special meaning in a regexp." (defun isearch-text-char-description (c) (cond - ((< c ?\s) (format "^%c" (+ c 64))) - ((= c ?\^?) "^?") + ((< c ?\s) (propertize (format "^%c" (+ c 64)) 'face 'escape-glyph)) + ((= c ?\^?) (propertize "^?" 'face 'escape-glyph)) (t (char-to-string c)))) ;; General function to unread characters or events. diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 802b45d23b1..8a800143bd2 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -657,9 +657,12 @@ the selection process begins. Used by isearchb.el." ;; that file now and act as though that buffer had been selected. (if (and iswitchb-virtual-buffers (not (iswitchb-existing-buffer-p))) - (let ((virt (car iswitchb-virtual-buffers))) - (find-file-noselect (cdr virt)) - (setq iswitchb-matches (list (car virt)) + (let ((virt (car iswitchb-virtual-buffers)) + (new-buf)) + ;; Keep the name of the buffer returned by find-file-noselect, as + ;; the buffer 'virt' could be a symlink to a file of a different name. + (setq new-buf (buffer-name (find-file-noselect (cdr virt)))) + (setq iswitchb-matches (list new-buf) iswitchb-virtual-buffers nil))) ;; Handling the require-match must be done in a better way. diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index 59e3c834087..e47884baa94 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -382,21 +382,12 @@ (;; misc nil ".m" ".h" "'" nil "." nil))) -(defun mapthread (function seq1 &rest seqrest) - "Apply FUNCTION to each element of SEQ1 and return result list. -If there are several SEQRESTs, FUNCTION is called with that many -arguments, with all possible combinations of these multiple SEQUENCES. -Thus, if SEQ1 contains 3 elements and SEQ2 contains 5 elements, then -FUNCTION will be called 15 times." - (if seqrest - (mapcar - (lambda (x) - (apply - 'mapthread - `(lambda (&rest y) (apply ',function x y)) - seqrest)) - seq1) - (mapcar function seq1))) +(defun combinatorial (head &rest tail) + (if tail + (apply 'append + (mapcar (lambda (y) (mapcar (lambda (x) (cons x y)) head)) + (apply 'combinatorial tail))) + (mapcar 'list head))) (defun indian--puthash-char (char trans-char hashtbls) (let ((encode-hash (car hashtbls)) ;; char -> trans @@ -446,8 +437,8 @@ FUNCTION will be called 15 times." (if (stringp trans-v) (setq trans-v (list trans-v))) (indian--puthash-char (concat c v) - (apply 'append - (mapthread 'concat trans-c trans-v)) + (mapcar (lambda (x) (apply 'concat x)) + (combinatorial trans-c trans-v)) hashtbls))) v trans-v)) c trans-c)) diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index f3a5668541b..a97656e25d7 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -106,7 +106,9 @@ HANKAKU-KATAKANA belongs to `japanese-jisx0201-kana'.") (?$B!R(B ?<) (?$B!S(B ?>) (?\$B!V(B nil ?\(I"(B) (?\$B!W(B nil ?\(I#(B) (?$B!\(B ?+) (?$B!](B ?-) (?$B!a(B ?=) (?$B!c(B ?<) (?$B!d(B ?>) (?$B!l(B ?') (?$B!m(B ?\") (?$B!o(B ?\\) (?$B!p(B ?$) (?$B!s(B ?%) (?$B!t(B ?#) (?$B!u(B ?&) (?$B!v(B ?*) - (?$B!w(B ?@)) + (?$B!w(B ?@) + ;; cp932-2-byte + (#x2015 ?-) (#xFF5E ?~) (#xFF0D ?-)) "Japanese JISX0208 symbol character table. Each element is of the form (SYMBOL ASCII HANKAKU), where SYMBOL belongs to `japanese-jisx0208', ASCII belongs to `ascii', and HANKAKU diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 6d5126ee150..f2dea83b624 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -23230,24 +23230,6 @@ This means the number of non-shy regexp grouping constructs ;;;*** -;;;### (autoloads nil "register" "register.el" (18961 38375)) -;;; Generated autoloads from register.el - (define-key ctl-x-r-map "\C-@" 'point-to-register) - (define-key ctl-x-r-map [?\C-\ ] 'point-to-register) - (define-key ctl-x-r-map " " 'point-to-register) - (define-key ctl-x-r-map "j" 'jump-to-register) - (define-key ctl-x-r-map "s" 'copy-to-register) - (define-key ctl-x-r-map "x" 'copy-to-register) - (define-key ctl-x-r-map "i" 'insert-register) - (define-key ctl-x-r-map "g" 'insert-register) - (define-key ctl-x-r-map "r" 'copy-rectangle-to-register) - (define-key ctl-x-r-map "n" 'number-to-register) - (define-key ctl-x-r-map "+" 'increment-register) - (define-key ctl-x-r-map "w" 'window-configuration-to-register) - (define-key ctl-x-r-map "f" 'frame-configuration-to-register) - -;;;*** - ;;;### (autoloads (remember-diary-extract-entries remember-clipboard ;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el" ;;;;;; (18787 48936)) diff --git a/lisp/linum.el b/lisp/linum.el index 9e0e54a49e1..81b48e99067 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -113,7 +113,7 @@ and you have to scroll or press \\[recenter-top-bottom] to update the numbers." (mapc #'delete-overlay linum-overlays) (setq linum-overlays nil) (dolist (w (get-buffer-window-list (current-buffer) nil t)) - (set-window-margins w 0))) + (set-window-margins w 0 (cdr (window-margins w))))) (defun linum-update-current () "Update line numbers for the current buffer." @@ -168,7 +168,7 @@ and you have to scroll or press \\[recenter-top-bottom] to update the numbers." (overlay-put ov 'linum-str str)))) (forward-line) (setq line (1+ line))) - (set-window-margins win width))) + (set-window-margins win width (cdr (window-margins win))))) (defun linum-after-change (beg end len) ;; update overlays on deletions, and after newlines are inserted diff --git a/lisp/loadup.el b/lisp/loadup.el index 8f1fe845e39..b531fd02b43 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,7 +1,7 @@ ;;; loadup.el --- load up standardly loaded Lisp files for Emacs -;; Copyright (C) 1985, 1986, 1992, 1994, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -25,15 +25,35 @@ ;; This is loaded into a bare Emacs to make a dumpable one. +;; If you add/remove Lisp files to be loaded here, consider the +;; following issues: + +;; i) Any file loaded on all platforms should appear in $lisp +;; and $shortlisp in src/Makefile.in. Use the .el or .elc version as +;; appropriate. + +;; ii) Any file that is only loaded on some platforms should appear +;; in the version of $lisp in the generated Makefile on that platform. +;; At the present time, this is achieved by use of #ifdefs. +;; It should also appear in $SOME_MACHINE_LISP on all platforms. + +;; The above steps ensure both that the Lisp files are compiled (if +;; necessary) before the emacs executable is dumped, and that they are +;; passed to make-docfile. (Any that are not processed for DOC will +;; not have doc strings in the dumped Emacs.) Because of this: + +;; iii) If the file is loaded uncompiled, it should (where possible) +;; obey the doc-string conventions expected by make-docfile. + ;;; Code: -;; add subdirectories to the load-path for files that might -;; get autoloaded when bootstrapping +;; Add subdirectories to the load-path for files that might get +;; autoloaded when bootstrapping. (if (or (equal (nth 3 command-line-args) "bootstrap") (equal (nth 4 command-line-args) "bootstrap") (equal (nth 3 command-line-args) "unidata-gen.el") (equal (nth 4 command-line-args) "unidata-gen-files") - ;; in case CANNOT_DUMP + ;; In case CANNOT_DUMP. (equal (nth 0 command-line-args) "../src/bootstrap-emacs")) (let ((dir (car load-path))) ;; We'll probably overflow the pure space. @@ -60,6 +80,10 @@ (load "emacs-lisp/backquote") (load "subr") +;; Do it after subr, since both after-load-functions and add-hook are +;; implemented in subr.el. +(add-hook 'after-load-functions '(lambda (f) (garbage-collect))) + ;; We specify .el in case someone compiled version.el by mistake. (load "version.el") @@ -82,17 +106,12 @@ (load "button") (load "startup") -(message "Lists of integers (garbage collection statistics) are normal output") -(message "while building Emacs; they do not indicate a problem.") -(message "%s" (garbage-collect)) - (condition-case nil ;; Don't get confused if someone compiled this by mistake. (load "loaddefs.el") ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) -(message "%s" (garbage-collect)) (load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table. (load "simple") @@ -159,7 +178,6 @@ (load "isearch") (load "rfn-eshadow") -(message "%s" (garbage-collect)) (load "menu-bar") (load "paths.el") ;Don't get confused if someone compiled paths by mistake. (load "emacs-lisp/lisp") @@ -169,7 +187,6 @@ (load "emacs-lisp/lisp-mode") (load "textmodes/text-mode") (load "textmodes/fill") -(message "%s" (garbage-collect)) (load "replace") (load "buff-menu") @@ -180,7 +197,6 @@ (load "image") (load "international/fontset") (load "dnd") - (load "mwheel") (load "tool-bar"))) (if (featurep 'x) (progn @@ -188,8 +204,6 @@ (load "term/common-win") (load "term/x-win"))) -(message "%s" (garbage-collect)) - (if (eq system-type 'windows-nt) (progn (load "w32-vars") @@ -213,31 +227,25 @@ (progn (load "emacs-lisp/easymenu") ;; for platform-related menu adjustments (load "term/ns-win"))) +(if (fboundp 'x-create-frame) + ;; Do it after loading term/foo-win.el since the value of the + ;; mouse-wheel-*-event vars depends on those files being loaded or not. + (load "mwheel")) (if (fboundp 'atan) ; preload some constants and (progn ; floating pt. functions if we have float support. (load "emacs-lisp/float-sup"))) -(message "%s" (garbage-collect)) (load "vc-hooks") (load "ediff-hook") (if (fboundp 'x-show-tip) (load "tooltip")) -(message "%s" (garbage-collect)) - ;If you want additional libraries to be preloaded and their ;doc strings kept in the DOC file rather than in core, ;you may load them with a "site-load.el" file. ;But you must also cause them to be scanned when the DOC file ;is generated. ;For other systems, you must edit ../src/Makefile.in. -(if (load "site-load" t) - (garbage-collect)) - -(if (fboundp 'x-popup-menu) - (precompute-menubar-bindings)) -;; Turn on recording of which commands get rebound, -;; for the sake of the next call to precompute-menubar-bindings. -(setq define-key-rebound-commands nil) +(load "site-load" t) ;; Determine which last version number to use ;; based on the executables that now exist. @@ -254,10 +262,6 @@ (format "%s.%d" emacs-version (if versions (1+ (apply 'max versions)) 1))))) -;; Note: all compiled Lisp files loaded above this point -;; must be among the ones parsed by make-docfile -;; to construct DOC. Any that are not processed -;; for DOC will not have doc strings in the dumped Emacs. (message "Finding pointers to doc strings...") (if (or (equal (nth 3 command-line-args) "dump") @@ -328,11 +332,13 @@ (equal (nth 4 command-line-args) "bootstrap")) (setcdr load-path nil)) +(remove-hook 'after-load-functions '(lambda (f) (garbage-collect))) + (setq inhibit-load-charset-map nil) (clear-charset-maps) (garbage-collect) -;;; At this point, we're ready to resume undo recording for scratch. +;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") (if (null (garbage-collect)) diff --git a/lisp/locate.el b/lisp/locate.el index d685097447c..f08847d4c4c 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -1,7 +1,7 @@ ;;; locate.el --- interface to the locate command -;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Keywords: unix files @@ -107,8 +107,7 @@ ;;; Code: -(eval-when-compile - (require 'dired)) +(require 'dired) ;; Variables @@ -363,31 +362,22 @@ except that FILTER is not optional." (goto-char (point-min)) (keep-lines filter)) -(defvar locate-mode-map nil +(defvar locate-mode-map + (let ((map (copy-keymap dired-mode-map))) + ;; Undefine Useless Dired Menu bars + (define-key map [menu-bar Dired] 'undefined) + (define-key map [menu-bar subdir] 'undefined) + (define-key map [menu-bar mark executables] 'undefined) + (define-key map [menu-bar mark directory] 'undefined) + (define-key map [menu-bar mark directories] 'undefined) + (define-key map [menu-bar mark symlinks] 'undefined) + (define-key map [M-mouse-2] 'locate-mouse-view-file) + (define-key map "\C-c\C-t" 'locate-tags) + (define-key map "l" 'locate-do-redisplay) + (define-key map "U" 'dired-unmark-all-files) + (define-key map "V" 'locate-find-directory) + map) "Local keymap for Locate mode buffers.") -(if locate-mode-map - nil - - (require 'dired) - - (setq locate-mode-map (copy-keymap dired-mode-map)) - - ;; Undefine Useless Dired Menu bars - (define-key locate-mode-map [menu-bar Dired] 'undefined) - (define-key locate-mode-map [menu-bar subdir] 'undefined) - - (define-key locate-mode-map [menu-bar mark executables] 'undefined) - (define-key locate-mode-map [menu-bar mark directory] 'undefined) - (define-key locate-mode-map [menu-bar mark directories] 'undefined) - (define-key locate-mode-map [menu-bar mark symlinks] 'undefined) - - (define-key locate-mode-map [M-mouse-2] 'locate-mouse-view-file) - (define-key locate-mode-map "\C-c\C-t" 'locate-tags) - - (define-key locate-mode-map "l" 'locate-do-redisplay) - (define-key locate-mode-map "U" 'dired-unmark-all-files) - (define-key locate-mode-map "V" 'locate-find-directory) -) ;; This variable is used to indent the lines and then to search for ;; the file name diff --git a/lisp/log-edit.el b/lisp/log-edit.el index a9816ea6649..f648d1f1fb4 100644 --- a/lisp/log-edit.el +++ b/lisp/log-edit.el @@ -560,23 +560,21 @@ A \"page\" in a ChangeLog file is the area between two dates." (defun log-edit-changelog-paragraph () "Return the bounds of the ChangeLog paragraph containing point. If we are between paragraphs, return the previous paragraph." - (save-excursion - (beginning-of-line) - (if (looking-at "^[ \t]*$") - (skip-chars-backward " \t\n" (point-min))) - (list (progn - (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit) - (goto-char (match-end 0))) - (point)) - (if (re-search-forward "^[ \t\n]*$" nil t) - (match-beginning 0) - (point-max))))) + (beginning-of-line) + (if (looking-at "^[ \t]*$") + (skip-chars-backward " \t\n" (point-min))) + (list (progn + (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit) + (goto-char (match-end 0))) + (point)) + (if (re-search-forward "^[ \t\n]*$" nil t) + (match-beginning 0) + (point-max)))) (defun log-edit-changelog-subparagraph () "Return the bounds of the ChangeLog subparagraph containing point. A subparagraph is a block of non-blank lines beginning with an asterisk. If we are between sub-paragraphs, return the previous subparagraph." - (save-excursion (end-of-line) (if (search-backward "*" nil t) (list (progn (beginning-of-line) (point)) @@ -585,16 +583,17 @@ If we are between sub-paragraphs, return the previous subparagraph." (if (re-search-forward "^[ \t]*[\n*]" nil t) (match-beginning 0) (point-max)))) - (list (point) (point))))) + (list (point) (point)))) (defun log-edit-changelog-entry () "Return the bounds of the ChangeLog entry containing point. The variable `log-edit-changelog-full-paragraphs' decides whether an \"entry\" is a paragraph or a subparagraph; see its documentation string for more details." - (if log-edit-changelog-full-paragraphs - (log-edit-changelog-paragraph) - (log-edit-changelog-subparagraph))) + (save-excursion + (if log-edit-changelog-full-paragraphs + (log-edit-changelog-paragraph) + (log-edit-changelog-subparagraph)))) (defvar user-full-name) (defvar user-mail-address) @@ -663,11 +662,17 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each pattern "\\($\\|[^[:alnum:]]\\)")) - (let (texts) - (while (re-search-forward pattern nil t) + (let (texts + (pos (point))) + (while (and (not (eobp)) (re-search-forward pattern nil t)) (let ((entry (log-edit-changelog-entry))) - (push entry texts) - (goto-char (elt entry 1)))) + (if (< (elt entry 1) (max (1+ pos) (point))) + ;; This is not relevant, actually. + nil + (push entry texts)) + ;; Make sure we make progress. + (setq pos (max (1+ pos) (elt entry 1))) + (goto-char pos))) (cons (current-buffer) texts)))))))) diff --git a/lisp/log-view.el b/lisp/log-view.el index 8b9c74660c5..1b79f0a595a 100644 --- a/lisp/log-view.el +++ b/lisp/log-view.el @@ -1,7 +1,7 @@ ;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: rcs sccs cvs log version-control @@ -178,8 +178,7 @@ (t (:weight bold))) "Face for the file header line in `log-view-mode'." :group 'log-view) -;; backward-compatibility alias -(put 'log-view-file-face 'face-alias 'log-view-file) +(define-obsolete-face-alias 'log-view-file-face 'log-view-file "22.1") (defvar log-view-file-face 'log-view-file) (defface log-view-message @@ -189,7 +188,7 @@ "Face for the message header line in `log-view-mode'." :group 'log-view) ;; backward-compatibility alias -(put 'log-view-message-face 'face-alias 'log-view-message) +(define-obsolete-face-alias 'log-view-message-face 'log-view-message "22.1") (defvar log-view-message-face 'log-view-message) (defvar log-view-file-re @@ -484,7 +483,9 @@ log entries." If the mark is not active or the mark is on the revision at point, get the diff between the revision at point and its previous revision. Otherwise, get the diff between the revisions where the region starts -and ends." +and ends. +Contrary to `log-view-diff-changeset', it will only show the part of the +changeset that affected the currently considered file(s)." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) @@ -509,7 +510,9 @@ and ends." If the mark is not active or the mark is on the revision at point, get the diff between the revision at point and its previous revision. Otherwise, get the diff between the revisions where the region starts -and ends." +and ends. +Contrary to `log-view-diff', it will show the whole changeset including +the changes that affected other files than the currently considered file(s)." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) diff --git a/lisp/lpr.el b/lisp/lpr.el index b8614af18ff..c12e01c1667 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -31,7 +31,7 @@ ;;;###autoload (defvar lpr-windows-system - (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) ;;;###autoload (defvar lpr-lp-system @@ -45,7 +45,7 @@ ;;;###autoload (defcustom printer-name - (and (memq system-type '(emx ms-dos)) "PRN") + (and (eq system-type '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 060e4011a4a..ee5db5bf1f5 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -70,10 +70,9 @@ :group 'dired) (defcustom ls-lisp-emulation - (cond ((eq system-type 'macos) 'MacOS) - ;; ((eq system-type 'windows-nt) 'MS-Windows) + (cond ;; ((eq system-type 'windows-nt) 'MS-Windows) ((memq system-type - '(hpux usg-unix-v unisoft-unix irix berkeley-unix)) + '(hpux usg-unix-v irix berkeley-unix)) 'UNIX)) ; very similar to GNU ;; Anything else defaults to nil, meaning GNU. "Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX. @@ -129,7 +128,7 @@ if emulation is GNU then default is `(links uid gid)'." :group 'ls-lisp) (defcustom ls-lisp-use-insert-directory-program - (not (memq system-type '(macos ms-dos windows-nt))) + (not (memq system-type '(ms-dos windows-nt))) "Non-nil causes ls-lisp to revert back to using `insert-directory-program'. This is useful on platforms where ls-lisp is dumped into Emacs, such as Microsoft Windows, but you would still like to use a program to list diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index e09b68de2b3..c05dbe1f80d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -1,7 +1,7 @@ ;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list -;; Copyright (C) 1985, 1994, 1997, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1994, 1997, 1998, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF @@ -166,8 +166,8 @@ usually do not have translators to read other languages for them.\n\n") '("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES" "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS")) (insert (format " locale-coding-system: %s\n" locale-coding-system)) - (insert (format " default-enable-multibyte-characters: %s\n" - default-enable-multibyte-characters)) + (insert (format " default enable-multibyte-characters: %s\n" + (default-value 'enable-multibyte-characters))) (insert "\n") (insert (format "Major mode: %s\n" (format-mode-line diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index d0cbbb6a89a..2449adb5ee7 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -286,7 +286,7 @@ (defconst feedmail-patch-level "8") -(eval-when-compile (require 'smtpmail)) +(eval-when-compile (require 'smtpmail) (require 'cl)) (autoload 'mail-do-fcc "sendmail") (defgroup feedmail nil @@ -481,11 +481,10 @@ header is fiddled after the From: header is fiddled." (defcustom feedmail-force-binary-write t "*If non-nil, force writing file as binary (this applies to queues and Fcc:). On systems where there is a difference between binary and text files, -feedmail will temporarily manipulate the values of `buffer-file-type' -and/or `default-buffer-file-type' to make the writing as binary. If -nil, writing will be in text mode. On systems where there is no -distinction or where it is controlled by other variables or other -means, this option has no effect." +feedmail will temporarily manipulate the value of `buffer-file-type' +to make the writing as binary. If nil, writing will be in text mode. +On systems where there is no distinction or where it is controlled by other +variables or other means, this option has no effect." :group 'feedmail-misc :type 'boolean ) @@ -1522,6 +1521,9 @@ bail out with an appropriate answer to the global confirmation prompt." (interactive "p") (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg))) +;; letf fools the byte-compiler. +(defvar file-name-buffer-file-type-alist) + ;;;###autoload (defun feedmail-run-the-queue (&optional arg) "Visit each message in the feedmail queue directory and send it out. @@ -1601,9 +1603,9 @@ backup file names and the like)." (not (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator)) (feedmail-find-eoh t))))) - (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil)) - (erase-buffer) (insert-file-contents maybe-file)) - ) + (letf ((file-name-buffer-file-type-alist nil) + ((default-value 'buffer-file-type) nil)) + (erase-buffer) (insert-file-contents maybe-file))) ;; if M-H-S not found and (a-M-H-S is non-nil and is found) ;; temporarily set M-H-S to the value of a-M-H-S (if (and (not (feedmail-find-eoh t)) @@ -1913,7 +1915,8 @@ mapped to mostly alphanumerics for safety." (setq filename buffer-file-name) (setq filename (feedmail-create-queue-filename queue-directory))) ;; make binary file on DOS/Win95/WinNT, etc - (let ((buffer-file-type feedmail-force-binary-write)) (write-file filename)) + (let ((buffer-file-type feedmail-force-binary-write)) + (write-file filename)) ;; convenient for moving from draft to q, for example (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir)) (y-or-n-p (format "FQM: Was previously %s; delete that? " previous-buffer-file-name))) @@ -2086,7 +2089,8 @@ mapped to mostly alphanumerics for safety." ))) (goto-char (point-min)) ;; re-insert and handle any Fcc fields (and, optionally, any Bcc). - (if fcc (let ((default-buffer-file-type feedmail-force-binary-write)) + (if fcc (letf (((default-value 'buffer-file-type) + feedmail-force-binary-write)) (insert fcc) (if (not feedmail-nuke-bcc-in-fcc) (progn (if bcc-holder (insert bcc-holder)) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 8a38f82d02f..81f215dd726 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -84,8 +84,14 @@ displaying footnotes." :type 'integer :group 'footnote) -(defvar footnote-prefix [(control ?c) ?!] - "*When not using `message-mode', the prefix to bind in `mode-specific-map'") +(defcustom footnote-prefix [(control ?c) ?!] + "Prefix key to use for Footnote command in Footnote minor mode. +The value of this variable is checked as part of loading Footnote mode. +After that, changing the prefix key requires manipulating keymaps." + ;; FIXME: the type should be a key-sequence, but it seems Custom + ;; doesn't support that yet. + ;; :type 'string + ) ;;; Interface variables that probably shouldn't be changed @@ -143,10 +149,6 @@ has no effect on buffers already displaying footnotes." (defvar footnote-mouse-highlight 'highlight "Text property name to enable mouse over highlight.") -(defvar footnote-mode nil - "Variable indicating whether footnote minor mode is active.") -(make-variable-buffer-local 'footnote-mode) - ;;; Default styles ;;; NUMERIC (defconst footnote-numeric-regexp "[0-9]+" @@ -564,7 +566,8 @@ a footnote." (Footnote-narrow-to-footnotes) (and (>= old-point (point-min)) (<= old-point (point-max)))))) - (>= (point) (cdar footnote-text-marker-alist))) + footnote-text-marker-alist + (>= (point) (cdar footnote-text-marker-alist))) (let ((i 1) alist-txt rc) (while (and (setq alist-txt (nth i footnote-text-marker-alist)) @@ -743,47 +746,32 @@ being set it is automatically widened." (widen)) (goto-char (cadr (assq note footnote-pointer-marker-alist)))))) -(defvar footnote-mode-map nil - "Keymap used for footnote minor mode.") - -;; Set up our keys -(unless footnote-mode-map - (setq footnote-mode-map (make-sparse-keymap)) - (define-key footnote-mode-map "a" 'Footnote-add-footnote) - (define-key footnote-mode-map "b" 'Footnote-back-to-message) - (define-key footnote-mode-map "c" 'Footnote-cycle-style) - (define-key footnote-mode-map "d" 'Footnote-delete-footnote) - (define-key footnote-mode-map "g" 'Footnote-goto-footnote) - (define-key footnote-mode-map "r" 'Footnote-renumber-footnotes) - (define-key footnote-mode-map "s" 'Footnote-set-style)) - -(defvar footnote-minor-mode-map nil +(defvar footnote-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'Footnote-add-footnote) + (define-key map "b" 'Footnote-back-to-message) + (define-key map "c" 'Footnote-cycle-style) + (define-key map "d" 'Footnote-delete-footnote) + (define-key map "g" 'Footnote-goto-footnote) + (define-key map "r" 'Footnote-renumber-footnotes) + (define-key map "s" 'Footnote-set-style) + map)) + +(defvar footnote-minor-mode-map + (let ((map (make-sparse-keymap))) + (define-key map footnote-prefix footnote-mode-map) + map) "Keymap used for binding footnote minor mode.") -(unless footnote-minor-mode-map - (define-key global-map footnote-prefix footnote-mode-map)) - ;;;###autoload -(defun footnote-mode (&optional arg) +(define-minor-mode footnote-mode "Toggle footnote minor mode. -\\<message-mode-map> This minor mode provides footnote support for `message-mode'. To get started, play around with the following keys: -key binding ---- ------- -\\[Footnote-add-footnote] Footnote-add-footnote -\\[Footnote-back-to-message] Footnote-back-to-message -\\[Footnote-delete-footnote] Footnote-delete-footnote -\\[Footnote-goto-footnote] Footnote-goto-footnote -\\[Footnote-renumber-footnotes] Footnote-renumber-footnotes -\\[Footnote-cycle-style] Footnote-cycle-style -\\[Footnote-set-style] Footnote-set-style -" - (interactive "*P") +\\{footnote-minor-mode-map}" + :lighter footnote-mode-line-string + :keymap footnote-minor-mode-map ;; (filladapt-mode t) - (setq footnote-mode - (if (null arg) (not footnote-mode) - (> (prefix-numeric-value arg) 0))) (when footnote-mode ;; (Footnote-setup-keybindings) (make-local-variable 'footnote-style) @@ -793,9 +781,6 @@ key binding (make-local-variable 'footnote-section-tag-regexp) (make-local-variable 'footnote-start-tag) (make-local-variable 'footnote-end-tag) - (if (fboundp 'force-mode-line-update) - (force-mode-line-update) - (set-buffer-modified-p (buffer-modified-p))) (when (boundp 'filladapt-token-table) ;; add tokens to filladapt to match footnotes @@ -808,14 +793,7 @@ key binding (unless (assoc bullet-regexp filladapt-token-table) (setq filladapt-token-table (append filladapt-token-table - (list (list bullet-regexp 'bullet))))))) - - (run-hooks 'footnote-mode-hook))) - -(unless (assq 'footnote-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(footnote-mode footnote-mode-line-string) - minor-mode-alist))) + (list (list bullet-regexp 'bullet))))))))) (provide 'footnote) diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 4d8c684e8f7..ded1323e226 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -244,61 +244,53 @@ By default, this is the file specified by `mail-personal-alias-file'." ;; In case mail-aliases is t, make sure define-mail-alias ;; does not recursively call build-mail-aliases. (setq mail-aliases nil) - (let ((buffer nil) - (obuf (current-buffer))) - (unwind-protect - (progn - (setq buffer (generate-new-buffer " mailrc")) - (set-buffer buffer) - (while file - (cond ((get-file-buffer file) - (insert (save-excursion - (set-buffer (get-file-buffer file)) - (buffer-substring-no-properties - (point-min) (point-max))))) - ((file-exists-p file) (insert-file-contents file)) - ((file-exists-p (setq file (concat "~/" file))) - (insert-file-contents file)) - (t (setq file nil))) - (goto-char (point-min)) - ;; Delete comments from the contents. - (while (search-forward "# " nil t) - (let ((p (- (point) 2))) - (end-of-line) - (delete-region p (point)))) - ;; Don't lose if no final newline. - (goto-char (point-max)) - (or (eq (preceding-char) ?\n) (newline)) - (goto-char (point-min)) - ;; handle "\\\n" continuation lines - (while (not (eobp)) - (end-of-line) - (if (= (preceding-char) ?\\) - (progn (delete-char -1) (delete-char 1) (insert ?\ )) - (forward-char 1))) - (goto-char (point-min)) - ;; handle `source' directives -- Eddy/1994/May/25 - (cond ((re-search-forward "^source[ \t]+" nil t) - (re-search-forward "\\S-+") - (setq file (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (beginning-of-line) - (insert "# ") ; to ensure we don't re-process this file - (beginning-of-line)) - (t (setq file nil)))) - (goto-char (point-min)) - (while (re-search-forward - "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t\n]+\\)" nil t) - (let* ((name (match-string 2)) - (start (progn (skip-chars-forward " \t") (point))) - value) - (end-of-line) - (setq value (buffer-substring-no-properties start (point))) - (unless (equal value "") - (define-mail-alias name value t)))) - mail-aliases) - (if buffer (kill-buffer buffer)) - (set-buffer obuf)))) + (with-temp-buffer + (while file + (cond ((get-file-buffer file) + (insert (with-current-buffer (get-file-buffer file) + (buffer-substring-no-properties + (point-min) (point-max))))) + ((file-exists-p file) (insert-file-contents file)) + ((file-exists-p (setq file (expand-file-name file "~/"))) + (insert-file-contents file)) + (t (setq file nil))) + (goto-char (point-min)) + ;; Delete comments from the contents. + (while (search-forward "# " nil t) + (let ((p (- (point) 2))) + (end-of-line) + (delete-region p (point)))) + ;; Don't lose if no final newline. + (goto-char (point-max)) + (or (eq (preceding-char) ?\n) (newline)) + (goto-char (point-min)) + ;; handle "\\\n" continuation lines + (while (not (eobp)) + (end-of-line) + (if (= (preceding-char) ?\\) + (progn (delete-char -1) (delete-char 1) (insert ?\ )) + (forward-char 1))) + (goto-char (point-min)) + ;; handle `source' directives -- Eddy/1994/May/25 + (cond ((re-search-forward "^source[ \t]+" nil t) + (re-search-forward "\\S-+") + (setq file (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (beginning-of-line) + (insert "# ") ; to ensure we don't re-process this file + (beginning-of-line)) + (t (setq file nil)))) + (goto-char (point-min)) + (while (re-search-forward + "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t\n]+\\)" nil t) + (let* ((name (match-string 2)) + (start (progn (skip-chars-forward " \t") (point))) + value) + (end-of-line) + (setq value (buffer-substring-no-properties start (point))) + (unless (equal value "") + (define-mail-alias name value t)))) + mail-aliases)) ;; Always autoloadable in case the user wants to define aliases ;; interactively or in .emacs. @@ -452,8 +444,7 @@ Consults `/etc/passwd' and a directory service if one is set up via `mail-directory-function'. PATTERN is the string we want to complete." (if (eq mail-local-names t) - (save-excursion - (set-buffer (generate-new-buffer " passwd")) + (with-current-buffer (generate-new-buffer " passwd") (let ((files mail-passwd-files)) (while files (insert-file-contents (car files) nil nil nil t) @@ -511,11 +502,10 @@ PATTERN is the string we want to complete." If PATTERN is nil, get all the defined user names. This function calls `mail-directory-function' to query the directory, then uses `mail-directory-parser' to parse the output it returns." - (save-excursion - (message "Querying directory...") - (set-buffer (generate-new-buffer " *mail-directory*")) + (message "Querying directory...") + (with-current-buffer (generate-new-buffer " *mail-directory*") (funcall mail-directory-function pattern) - (goto-char 1) + (goto-char (point-min)) (let (directory) (if (stringp mail-directory-parser) (while (re-search-forward mail-directory-parser nil t) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 5aa592b79f4..b690a00dac5 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -267,6 +267,24 @@ Currently known variants are 'emacs and 'mailutils." (rmail-movemail-variant-p) ;;;###autoload +(defcustom rmail-user-mail-address-regexp nil + "Regexp matching user mail addresses. +If non-nil, this variable is used to identify the correspondent +when receiving new mail. If it matches the address of the sender, +the recipient is taken as correspondent of a mail. +If nil \(default value\), your `user-login-name' and `user-mail-address' +are used to exclude yourself as correspondent. + +Usually you don't have to set this variable, except if you collect mails +sent by you under different user names. +Then it should be a regexp matching your mail addresses. + +Setting this variable has an effect only before reading a mail." + :type '(choice (const :tag "None" nil) regexp) + :group 'rmail-retrieve + :version "21.1") + +;;;###autoload (defcustom rmail-dont-reply-to-names nil "A regexp specifying addresses to prune from a reply message. If this is nil, it is set the first time you compose a reply, to @@ -1234,7 +1252,7 @@ Instead, these commands are available: (rmail-mode-2) (when (and finding-rmail-file (null coding-system-for-read) - default-enable-multibyte-characters) + (default-value 'enable-multibyte-characters)) (let ((rmail-enable-multibyte t)) (rmail-require-mime-maybe) (rmail-convert-file-maybe) @@ -3519,10 +3537,12 @@ use \\[mail-yank-original] to yank the original message into it." (aref rmail-msgref-vector msgnum)) rmail-answered-attr-index)) nil - (list (cons "References" (if references - (concat (mapconcat 'identity references " ") - " " message-id) - message-id)))))) + (if (or references message-id) + (list (cons "References" (if references + (concat + (mapconcat 'identity references " ") + " " message-id) + message-id))))))) (defun rmail-mark-message (buffer msgnum-list attribute) "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. @@ -4152,6 +4172,225 @@ encoded string (and the same mask) will decode the string." (widen) nil)) + +;;; Start of automatically extracted autoloads. + +;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el" +;;;;;; "c70c6c35b8c5bbdb73787a48b83e5adc") +;;; Generated autoloads from rmailedit.el + +(autoload 'rmail-edit-current-message "rmailedit" "\ +Edit the contents of this message. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message +;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd" +;;;;;; "rmailkwd.el" "2e986921026eea971b49e91f53967f77") +;;; Generated autoloads from rmailkwd.el + +(autoload 'rmail-add-label "rmailkwd" "\ +Add LABEL to labels associated with current RMAIL message. +Completes (see `rmail-read-label') over known labels when reading. +LABEL may be a symbol or string. Only one label is allowed. + +\(fn LABEL)" t nil) + +(autoload 'rmail-kill-label "rmailkwd" "\ +Remove LABEL from labels associated with current RMAIL message. +Completes (see `rmail-read-label') over known labels when reading. +LABEL may be a symbol or string. Only one label is allowed. + +\(fn LABEL)" t nil) + +(autoload 'rmail-read-label "rmailkwd" "\ +Read a label with completion, prompting with PROMPT. +Completions are chosen from `rmail-label-obarray'. The default +is `rmail-last-label', if that is non-nil. Updates `rmail-last-label' +according to the choice made, and returns a symbol. + +\(fn PROMPT)" nil nil) + +(autoload 'rmail-previous-labeled-message "rmailkwd" "\ +Show previous message with one of the labels LABELS. +LABELS should be a comma-separated list of label names. +If LABELS is empty, the last set of labels specified is used. +With prefix argument N moves backward N messages with these labels. + +\(fn N LABELS)" t nil) + +(autoload 'rmail-next-labeled-message "rmailkwd" "\ +Show next message with one of the labels LABELS. +LABELS should be a comma-separated list of label names. +If LABELS is empty, the last set of labels specified is used. +With prefix argument N moves forward N messages with these labels. + +\(fn N LABELS)" t nil) + +;;;*** + +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "ab34439779d8036dbd5cdc80fb4cea64") +;;; Generated autoloads from rmailmm.el + +(autoload 'rmail-mime "rmailmm" "\ +Process the current Rmail message as a MIME message. +This creates a temporary \"*RMAIL*\" buffer holding a decoded +copy of the message. Inline content-types are handled according to +`rmail-mime-media-type-handlers-alist'. By default, this +displays text and multipart messages, and offers to download +attachments as specfied by `rmail-mime-attachment-dirs-alist'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el" +;;;;;; "de01c37c81339201034a01732b97f44e") +;;; Generated autoloads from rmailmsc.el + +(autoload 'set-rmail-inbox-list "rmailmsc" "\ +Set the inbox list of the current RMAIL file to FILE-NAME. +You can specify one file name, or several names separated by commas. +If FILE-NAME is empty, remove any existing inbox list. + +This applies only to the current session. + +\(fn FILE-NAME)" t nil) + +;;;*** + +;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent +;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject +;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "3f2b10b0272ea56cb604f29330d95fc4") +;;; Generated autoloads from rmailsort.el + +(autoload 'rmail-sort-by-date "rmailsort" "\ +Sort messages of current Rmail buffer by \"Date\" header. +If prefix argument REVERSE is non-nil, sorts in reverse order. + +\(fn REVERSE)" t nil) + +(autoload 'rmail-sort-by-subject "rmailsort" "\ +Sort messages of current Rmail buffer by \"Subject\" header. +Ignores any \"Re: \" prefix. If prefix argument REVERSE is +non-nil, sorts in reverse order. + +\(fn REVERSE)" t nil) + +(autoload 'rmail-sort-by-author "rmailsort" "\ +Sort messages of current Rmail buffer by author. +This uses either the \"From\" or \"Sender\" header, downcased. +If prefix argument REVERSE is non-nil, sorts in reverse order. + +\(fn REVERSE)" t nil) + +(autoload 'rmail-sort-by-recipient "rmailsort" "\ +Sort messages of current Rmail buffer by recipient. +This uses either the \"To\" or \"Apparently-To\" header, downcased. +If prefix argument REVERSE is non-nil, sorts in reverse order. + +\(fn REVERSE)" t nil) + +(autoload 'rmail-sort-by-correspondent "rmailsort" "\ +Sort messages of current Rmail buffer by other correspondent. +This uses either the \"From\", \"Sender\", \"To\", or +\"Apparently-To\" header, downcased. Uses the first header not +excluded by `rmail-dont-reply-to-names'. If prefix argument +REVERSE is non-nil, sorts in reverse order. + +\(fn REVERSE)" t nil) + +(autoload 'rmail-sort-by-lines "rmailsort" "\ +Sort messages of current Rmail buffer by the number of lines. +If prefix argument REVERSE is non-nil, sorts in reverse order. + +\(fn REVERSE)" t nil) + +(autoload 'rmail-sort-by-labels "rmailsort" "\ +Sort messages of current Rmail buffer by labels. +LABELS is a comma-separated list of labels. The order of these +labels specifies the order of messages: messages with the first +label come first, messages with the second label come second, and +so on. Messages that have none of these labels come last. +If prefix argument REVERSE is non-nil, sorts in reverse order. + +\(fn REVERSE LABELS)" t nil) + +;;;*** + +;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic +;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "60bec0ae88b7ed18dd6845ddb9ccd904") +;;; Generated autoloads from rmailsum.el + +(autoload 'rmail-summary "rmailsum" "\ +Display a summary of all messages, one line per message. + +\(fn)" t nil) + +(autoload 'rmail-summary-by-labels "rmailsum" "\ +Display a summary of all messages with one or more LABELS. +LABELS should be a string containing the desired labels, separated by commas. + +\(fn LABELS)" t nil) + +(autoload 'rmail-summary-by-recipients "rmailsum" "\ +Display a summary of all messages with the given RECIPIENTS. +Normally checks the To, From and Cc fields of headers; +but if PRIMARY-ONLY is non-nil (prefix arg given), + only look in the To and From fields. +RECIPIENTS is a string of regexps separated by commas. + +\(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil) + +(autoload 'rmail-summary-by-regexp "rmailsum" "\ +Display a summary of all messages according to regexp REGEXP. +If the regular expression is found in the header of the message +\(including in the date and other lines, as well as the subject line), +Emacs will list the message in the summary. + +\(fn REGEXP)" t nil) + +(autoload 'rmail-summary-by-topic "rmailsum" "\ +Display a summary of all messages with the given SUBJECT. +Normally checks just the Subject field of headers; but with prefix +argument WHOLE-MESSAGE is non-nil, looks in the whole message. +SUBJECT is a string of regexps separated by commas. + +\(fn SUBJECT &optional WHOLE-MESSAGE)" t nil) + +(autoload 'rmail-summary-by-senders "rmailsum" "\ +Display a summary of all messages whose \"From\" field matches SENDERS. +SENDERS is a string of regexps separated by commas. + +\(fn SENDERS)" t nil) + +;;;*** + +;;;### (autoloads (unforward-rmail-message undigestify-rmail-message) +;;;;;; "undigest" "undigest.el" "b691540ddff5c394e9ebc3517051445f") +;;; Generated autoloads from undigest.el + +(autoload 'undigestify-rmail-message "undigest" "\ +Break up a digest message into its constituent messages. +Leaves original message, deleted, before the undigestified messages. + +\(fn)" t nil) + +(autoload 'unforward-rmail-message "undigest" "\ +Extract a forwarded message from the containing message. +This puts the forwarded message into a separate rmail message +following the containing message. + +\(fn)" t nil) + +;;;*** + +;;; End of automatically extracted autoloads. + + (provide 'rmail) ;; arch-tag: 65d257d3-c281-4a65-9c38-e61af95af2f0 diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index d350c29006b..e119ed2f133 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -387,5 +387,9 @@ HEADER-DIFF should be a return value from `rmail-edit-diff-headers'." (provide 'rmailedit) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b ;;; rmailedit.el ends here diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index b52ad4897f8..76135c6178d 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -159,6 +159,7 @@ With prefix argument N moves backward N messages with these labels." LABELS should be a comma-separated list of label names. If LABELS is empty, the last set of labels specified is used. With prefix argument N moves forward N messages with these labels." + ;; FIXME show the default in the prompt. (interactive "p\nsMove to next msg with labels: ") (if (string= labels "") (setq labels rmail-last-multi-labels)) @@ -188,5 +189,9 @@ With prefix argument N moves forward N messages with these labels." (provide 'rmailkwd) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7 ;;; rmailkwd.el ends here diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 93e9c3424bd..29aa869523e 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -28,6 +28,11 @@ ;; extensions (mime-display.el and mime.el). ;; Call `M-x rmail-mime' when viewing an Rmail message. +;; Todo: + +;; Handle multipart/alternative. +;; Offer the option to call external/internal viewers (doc-view, xpdf, etc). + ;;; Code: (require 'rmail) @@ -35,23 +40,26 @@ ;;; User options. -;; FIXME should these be in an rmail group? -;; FIXME we ought to be able to display images in Emacs. +(defgroup rmail-mime nil + "Rmail MIME handling options." + :prefix "rmail-mime-" + :group 'rmail) + (defcustom rmail-mime-media-type-handlers-alist '(("multipart/.*" rmail-mime-multipart-handler) ("text/.*" rmail-mime-text-handler) ("text/\\(x-\\)?patch" rmail-mime-bulk-handler) - ;; FIXME this handler not defined anywhere? -;;; ("application/pgp-signature" rmail-mime-application/pgp-signature-handler) ("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler)) "Functions to handle various content types. This is an alist with elements of the form (REGEXP FUNCTION ...). The first item is a regular expression matching a content-type. The remaining elements are handler functions to run, in order of -decreasing preference. These are called until one returns non-nil." +decreasing preference. These are called until one returns non-nil. +Note that this only applies to items with an inline Content-Disposition, +all others are handled by `rmail-mime-bulk-handler'." :type '(alist :key-type regexp :value-type (repeat function)) :version "23.1" - :group 'mime) + :group 'rmail-mime) (defcustom rmail-mime-attachment-dirs-alist `(("text/.*" "~/Documents") @@ -64,44 +72,50 @@ The remaining elements are directories, in order of decreasing preference. The first directory that exists is used." :type '(alist :key-type regexp :value-type (repeat directory)) :version "23.1" - :group 'mime) + :group 'rmail-mime) + +(defcustom rmail-mime-show-images 'button + "What to do with image attachments that Emacs is capable of displaying. +If nil, do nothing special. If `button', add an extra button +that when pushed displays the image in the buffer. If a number, +automatically show images if they are smaller than that size (in +bytes), otherwise add a display button. Anything else means to +automatically display the image in the buffer." + :type '(choice (const :tag "Add button to view image" button) + (const :tag "No special treatment" nil) + (number :tag "Show if smaller than certain size") + (other :tag "Always show" show)) + :version "23.2" + :group 'rmail-mime) ;;; End of user options. -(defvar rmail-mime-total-number-of-bulk-attachments 0 - "The total number of bulk attachments in the message. -If more than 3, offer a way to save all attachments at once.") -(put 'rmail-mime-total-number-of-bulk-attachments 'permanent-local t) - ;;; Buttons (defun rmail-mime-save (button) "Save the attachment using info in the BUTTON." (let* ((filename (button-get button 'filename)) (directory (button-get button 'directory)) - (data (button-get button 'data))) - (while (file-exists-p (expand-file-name filename directory)) - (let* ((f (file-name-sans-extension filename)) - (i 1)) - (when (string-match "-\\([0-9]+\\)$" f) - (setq i (1+ (string-to-number (match-string 1 f))) - f (substring f 0 (match-beginning 0)))) - (setq filename (concat f "-" (number-to-string i) "." - (file-name-extension filename))))) + (data (button-get button 'data)) + (ofilename filename)) (setq filename (expand-file-name (read-file-name (format "Save as (default: %s): " filename) directory (expand-file-name filename directory)) directory)) - (when (file-regular-p filename) - (error (message "File `%s' already exists" filename))) - (with-temp-file filename + ;; If arg is just a directory, use the default file name, but in + ;; that directory (copied from write-file). + (if (file-directory-p filename) + (setq filename (expand-file-name + (file-name-nondirectory ofilename) + (file-name-as-directory filename)))) + (with-temp-buffer (set-buffer-file-coding-system 'no-conversion) - (insert data)))) + (insert data) + (write-region nil nil filename nil nil nil t)))) -(define-button-type 'rmail-mime-save - 'action 'rmail-mime-save) +(define-button-type 'rmail-mime-save 'action 'rmail-mime-save) ;;; Handlers @@ -131,13 +145,29 @@ MIME-Version: 1.0 (rmail-mime-show t) (set-buffer-multibyte t))) + +(defun rmail-mime-insert-image (type data) + "Insert an image of type TYPE, where DATA is the image data." + (end-of-line) + (insert ?\n) + (insert-image (create-image data type t))) + +(defun rmail-mime-image (button) + "Display the image associated with BUTTON." + (let ((inhibit-read-only t)) + (rmail-mime-insert-image (button-get button 'image-type) + (button-get button 'image-data)))) + +(define-button-type 'rmail-mime-image 'action 'rmail-mime-image) + + (defun rmail-mime-bulk-handler (content-type content-disposition content-transfer-encoding) - "Handle the current buffer as an attachment to download." - (setq rmail-mime-total-number-of-bulk-attachments - (1+ rmail-mime-total-number-of-bulk-attachments)) - ;; Find the default directory for this media type + "Handle the current buffer as an attachment to download. +For images that Emacs is capable of displaying, the behavior +depends upon the value of `rmail-mime-show-images'." + ;; Find the default directory for this media type. (let* ((directory (catch 'directory (dolist (entry rmail-mime-attachment-dirs-alist) (when (string-match (car entry) (car content-type)) @@ -148,14 +178,42 @@ MIME-Version: 1.0 (cdr (assq 'filename (cdr content-disposition))) "noname")) (label (format "\nAttached %s file: " (car content-type))) - (data (buffer-string))) + (data (buffer-string)) + (udata (string-as-unibyte data)) + (size (length udata)) + (osize size) + (units '(B kB MB GB)) + type) + (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message + (cdr units)) + (setq size (/ size 1024.0) + units (cdr units))) (delete-region (point-min) (point-max)) (insert label) (insert-button filename :type 'rmail-mime-save + 'help-echo "mouse-2, RET: Save attachment" 'filename filename - 'directory directory - 'data data))) + 'directory (file-name-as-directory directory) + 'data data) + (insert (format " (%.0f%s)" size (car units))) + (when (and rmail-mime-show-images + (string-match "image/\\(.*\\)" (setq type (car content-type))) + (setq type (concat "." (match-string 1 type)) + type (image-type-from-file-name type)) + (memq type image-types) + (image-type-available-p type)) + (insert " ") + (cond ((or (eq rmail-mime-show-images 'button) + (and (numberp rmail-mime-show-images) + (>= osize rmail-mime-show-images))) + (insert-button "Display" + :type 'rmail-mime-image + 'help-echo "mouse-2, RET: Show image" + 'image-type type + 'image-data udata)) + (t + (rmail-mime-insert-image type udata)))))) (defun test-rmail-mime-bulk-handler () "Test of a mail used as an example in RFC 2183." @@ -205,8 +263,6 @@ format." (when (and (search-forward boundary nil t) (looking-at "[ \t]*\n")) (delete-region (point-min) (match-end 0))) - ;; Reset the counter - (setq rmail-mime-total-number-of-bulk-attachments 0) ;; Loop over all body parts, where beg points at the beginning of ;; the part and end points at the end of the part. next points at ;; the beginning of the next part. @@ -216,23 +272,21 @@ format." ;; If this is the last boundary according to RFC 2046, hide the ;; epilogue, else hide the boundary only. Use a marker for ;; `next' because `rmail-mime-show' may change the buffer. - (cond ((looking-at "--[ \t]*\n") + (cond ((looking-at "--[ \t]*$") (setq next (point-max-marker))) ((looking-at "[ \t]*\n") - (setq next (copy-marker (match-end 0)))) + (setq next (copy-marker (match-end 0) t))) (t (rmail-mm-get-boundary-error-message "Malformed boundary" content-type content-disposition content-transfer-encoding))) (delete-region end next) ;; Handle the part. - (save-match-data - (save-excursion - (save-restriction - (narrow-to-region beg end) - (rmail-mime-show)))) - (setq beg next) - (goto-char beg)))) + (save-restriction + (narrow-to-region beg end) + (rmail-mime-show)) + (goto-char (setq beg next))))) + (defun test-rmail-mime-multipart-handler () "Test of a mail used as an example in RFC 2046." @@ -379,11 +433,15 @@ modified." (rmail-mime-handle content-type content-disposition content-transfer-encoding)))) +(define-derived-mode rmail-mime-mode fundamental-mode "RMIME" + "Major mode used in `rmail-mime' buffers." + (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) + ;;;###autoload (defun rmail-mime () "Process the current Rmail message as a MIME message. This creates a temporary \"*RMAIL*\" buffer holding a decoded -copy of the message. Content-types are handled according to +copy of the message. Inline content-types are handled according to `rmail-mime-media-type-handlers-alist'. By default, this displays text and multipart messages, and offers to download attachments as specfied by `rmail-mime-attachment-dirs-alist'." @@ -395,6 +453,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." (let ((inhibit-read-only t)) (erase-buffer) (insert data) + (rmail-mime-mode) (rmail-mime-show t) (set-buffer-modified-p nil)) (view-buffer buf))) @@ -406,5 +465,9 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." (provide 'rmailmm) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 3f2c5e5d-1aef-4512-bc20-fd737c9d5dd9 ;;; rmailmm.el ends here diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index 0345e720f5f..861a0ea7292 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -41,6 +41,7 @@ This applies only to the current session." (with-temp-buffer (insert file-name) (goto-char (point-min)) + ;; split-string does not remove leading/trailing whitespace. (nreverse (mail-parse-comma-list))))) (when (or (not rmail-inbox-list) (y-or-n-p (concat "Replace " @@ -53,5 +54,9 @@ This applies only to the current session." (setq rmail-inbox-list inbox-list))) (rmail-show-message-1 rmail-current-message)) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 94614a62-2a0a-4e25-bac9-06f461ed4c60 ;;; rmailmsc.el ends here diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index dad696f5355..8ca36ed1f70 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -46,6 +46,7 @@ a file name as a string." (string :tag "File Name") sexp))) :group 'rmail-output) +;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t) (defcustom rmail-fields-not-to-output nil "Regexp describing fields to exclude when outputting a message to a file. diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index 39244669928..00d0bad4af2 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -250,5 +250,9 @@ Numeric keys are sorted numerically, all others as strings." (provide 'rmailsort) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 665da245-f6a7-4115-ad8c-ba19216988d5 ;;; rmailsort.el ends here diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index b8175c36f23..03185a279f9 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -488,25 +488,6 @@ LINES is the number of lines in the message (if we should display that) (concat prefix basic-start linecount-string " " labels basic-end)))) -;; FIXME move to rmail.el? -;;;###autoload -(defcustom rmail-user-mail-address-regexp nil - "Regexp matching user mail addresses. -If non-nil, this variable is used to identify the correspondent -when receiving new mail. If it matches the address of the sender, -the recipient is taken as correspondent of a mail. -If nil \(default value\), your `user-login-name' and `user-mail-address' -are used to exclude yourself as correspondent. - -Usually you don't have to set this variable, except if you collect mails -sent by you under different user names. -Then it should be a regexp matching your mail addresses. - -Setting this variable has an effect only before reading a mail." - :type '(choice (const :tag "None" nil) regexp) - :group 'rmail-retrieve - :version "21.1") - (defun rmail-header-summary () "Return a message summary based on the message headers. The value is a list of two strings, the first and second parts of the summary. @@ -1862,5 +1843,9 @@ the summary is only showing a subset of messages." (provide 'rmailsum) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 80b0a27a-a50d-4f37-9466-83d32d1e0ca8 ;;; rmailsum.el ends here diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 09028a37628..955e424cf23 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -168,6 +168,7 @@ This is used by the default mail-sending commands. See also (function-item feedmail-send-it :tag "Use Feedmail package") (function-item mailclient-send-it :tag "Use Mailclient package") function) + :initialize 'custom-initialize-delay :group 'sendmail) ;;;###autoload @@ -552,7 +553,7 @@ actually occur.") (kill-local-variable 'buffer-file-coding-system) ;; This doesn't work for enable-multibyte-characters. ;; (kill-local-variable 'enable-multibyte-characters) - (set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte (default-value 'enable-multibyte-characters)) (if current-input-method (inactivate-input-method)) (setq mail-send-actions actions) @@ -931,7 +932,7 @@ This function uses `mail-envelope-from'." ;;;###autoload (defvar sendmail-coding-system nil "*Coding system for encoding the outgoing mail. -This has higher priority than `default-buffer-file-coding-system' +This has higher priority than the default `buffer-file-coding-system' and `default-sendmail-coding-system', but lower priority than the local value of `buffer-file-coding-system'. See also the function `select-message-coding-system'.") @@ -1509,7 +1510,7 @@ and don't delete any header fields." (insert-buffer original) ;; If they yank the original text, the encoding of the ;; original message is a better default than - ;; default-buffer-file-coding-system. + ;; the default buffer-file-coding-system. (and (coding-system-equal (default-value 'buffer-file-coding-system) buffer-file-coding-system) @@ -1855,7 +1856,7 @@ The seventh argument ACTIONS is a list of actions to take ;; TRT, or the user will get prompted for the right ;; encoding when they send the message. (setq buffer-file-coding-system - default-buffer-file-coding-system)))))))) + (default-value 'buffer-file-coding-system))))))))) (declare-function dired-move-to-filename "dired" (&optional raise-error eol)) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el index 2a0ea5ad549..54293b0d4f9 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -213,6 +213,7 @@ Leaves original message, deleted, before the undigestified messages." (set-buffer buff) (rmail-swap-buffers-maybe) (goto-char (point-max)) + ;; FIXME use rmail-count-new-messages. (rmail-set-message-counters) (set-buffer-modified-p t) (rmail-show-message current) @@ -312,6 +313,7 @@ following the containing message." (set-buffer buff) (rmail-swap-buffers-maybe) (goto-char (point-max)) + ;; FIXME use rmail-count-new-messages. (rmail-set-message-counters) (set-buffer-modified-p t) (rmail-show-message current) @@ -323,5 +325,9 @@ following the containing message." (provide 'undigest) +;; Local Variables: +;; generated-autoload-file: "rmail.el" +;; End: + ;; arch-tag: 3a28b9fb-c1f5-43ef-9278-285f3e4b874d ;;; undigest.el ends here diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 4b92a26aeb7..fa22f1d5209 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -86,6 +86,11 @@ emacs = "$(EMACS)" $(EMACSOPT) WINS_ALMOST=\ calc \ calendar \ + cedet \ + cedet/ede \ + cedet/semantic \ + cedet/srecode \ + eieio \ emacs-lisp \ emulation \ erc \ diff --git a/lisp/man.el b/lisp/man.el index 3aadfa2d5e1..d305d54dd43 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,7 +1,7 @@ ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw <bwarsaw@cen.com> ;; Maintainer: FSF @@ -811,7 +811,7 @@ all sections related to a subject, put something appropriate into the ;; We must decode the output by a coding system that the ;; system's locale suggests in multibyte mode. (coding-system-for-read - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) locale-coding-system 'raw-text-unix)) ;; Avoid possible error by using a directory that always exists. (default-directory diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index e3aa7bc04b8..b94faa390ef 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -64,72 +64,72 @@ ;; The "File" menu items (define-key menu-bar-file-menu [exit-emacs] - '(menu-item "Quit" save-buffers-kill-terminal - :help "Save unsaved buffers, then exit")) + `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal + :help ,(purecopy "Save unsaved buffers, then exit"))) (define-key menu-bar-file-menu [separator-exit] - '("--")) + (purecopy "--")) ;; Don't use delete-frame as event name because that is a special ;; event. (define-key menu-bar-file-menu [delete-this-frame] - '(menu-item "Delete Frame" delete-frame + `(menu-item ,(purecopy "Delete Frame") delete-frame :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) - :help "Delete currently selected frame")) + :help ,(purecopy "Delete currently selected frame"))) (define-key menu-bar-file-menu [make-frame-on-display] - '(menu-item "New Frame on Display..." make-frame-on-display + `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display :visible (fboundp 'make-frame-on-display) - :help "Open a new frame on another display")) + :help ,(purecopy "Open a new frame on another display"))) (define-key menu-bar-file-menu [make-frame] - '(menu-item "New Frame" make-frame-command + `(menu-item ,(purecopy "New Frame") make-frame-command :visible (fboundp 'make-frame-command) - :help "Open a new frame")) + :help ,(purecopy "Open a new frame"))) (define-key menu-bar-file-menu [one-window] - '(menu-item "Remove Splits" delete-other-windows + `(menu-item ,(purecopy "Remove Splits") delete-other-windows :enable (not (one-window-p t nil)) - :help "Selected window grows to fill the whole frame")) + :help ,(purecopy "Selected window grows to fill the whole frame"))) (define-key menu-bar-file-menu [split-window] - '(menu-item "Split Window" split-window-vertically + `(menu-item ,(purecopy "Split Window") split-window-vertically :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help "Split selected window in two windows")) + :help ,(purecopy "Split selected window in two windows"))) (define-key menu-bar-file-menu [separator-window] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-file-menu [ps-print-region] - '(menu-item "Postscript Print Region (B+W)" ps-print-region + `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region :enable mark-active - :help "Pretty-print marked region in black and white to PostScript printer")) + :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer"))) (define-key menu-bar-file-menu [ps-print-buffer] - '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer + `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) - :help "Pretty-print current buffer in black and white to PostScript printer")) + :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer"))) (define-key menu-bar-file-menu [ps-print-region-faces] - '(menu-item "Postscript Print Region" ps-print-region-with-faces + `(menu-item ,(purecopy "Postscript Print Region") ps-print-region-with-faces :enable mark-active - :help "Pretty-print marked region to PostScript printer")) + :help ,(purecopy "Pretty-print marked region to PostScript printer"))) (define-key menu-bar-file-menu [ps-print-buffer-faces] - '(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces + `(menu-item ,(purecopy "Postscript Print Buffer") ps-print-buffer-with-faces :enable (menu-bar-menu-frame-live-and-visible-p) - :help "Pretty-print current buffer to PostScript printer")) + :help ,(purecopy "Pretty-print current buffer to PostScript printer"))) (define-key menu-bar-file-menu [print-region] - '(menu-item "Print Region" print-region + `(menu-item ,(purecopy "Print Region") print-region :enable mark-active - :help "Print region between mark and current position")) + :help ,(purecopy "Print region between mark and current position"))) (define-key menu-bar-file-menu [print-buffer] - '(menu-item "Print Buffer" print-buffer + `(menu-item ,(purecopy "Print Buffer") print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) - :help "Print current buffer with page headings")) + :help ,(purecopy "Print current buffer with page headings"))) (define-key menu-bar-file-menu [separator-print] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-file-menu [recover-session] - '(menu-item "Recover Crashed Session" recover-session + `(menu-item ,(purecopy "Recover Crashed Session") recover-session :enable (and auto-save-list-file-prefix (file-directory-p (file-name-directory auto-save-list-file-prefix)) @@ -141,30 +141,30 @@ (file-name-nondirectory auto-save-list-file-prefix))) t)) - :help "Recover edits from a crashed session")) + :help ,(purecopy "Recover edits from a crashed session"))) (define-key menu-bar-file-menu [revert-buffer] - '(menu-item "Revert Buffer" revert-buffer + `(menu-item ,(purecopy "Revert Buffer") revert-buffer :enable (or revert-buffer-function revert-buffer-insert-file-contents-function (and buffer-file-number (or (buffer-modified-p) (not (verify-visited-file-modtime (current-buffer)))))) - :help "Re-read current buffer from its file")) + :help ,(purecopy "Re-read current buffer from its file"))) (define-key menu-bar-file-menu [write-file] - '(menu-item "Save As..." write-file + `(menu-item ,(purecopy "Save As...") write-file :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help "Write current buffer to another file")) + :help ,(purecopy "Write current buffer to another file"))) (define-key menu-bar-file-menu [save-buffer] - '(menu-item "Save" save-buffer + `(menu-item ,(purecopy "Save") save-buffer :enable (and (buffer-modified-p) (buffer-file-name) (menu-bar-non-minibuffer-window-p)) - :help "Save current buffer to its file")) + :help ,(purecopy "Save current buffer to its file"))) (define-key menu-bar-file-menu [separator-save] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (defun menu-find-file-existing () "Edit the existing file FILENAME." @@ -178,25 +178,25 @@ (define-key menu-bar-file-menu [kill-buffer] - '(menu-item "Close" kill-this-buffer + `(menu-item ,(purecopy "Close") kill-this-buffer :enable (kill-this-buffer-enabled-p) - :help "Discard (kill) current buffer")) + :help ,(purecopy "Discard (kill) current buffer"))) (define-key menu-bar-file-menu [insert-file] - '(menu-item "Insert File..." insert-file + `(menu-item ,(purecopy "Insert File...") insert-file :enable (menu-bar-non-minibuffer-window-p) - :help "Insert another file into current buffer")) + :help ,(purecopy "Insert another file into current buffer"))) (define-key menu-bar-file-menu [dired] - '(menu-item "Open Directory..." dired + `(menu-item ,(purecopy "Open Directory...") dired :enable (menu-bar-non-minibuffer-window-p) - :help "Read a directory, to operate on its files")) + :help ,(purecopy "Read a directory, to operate on its files"))) (define-key menu-bar-file-menu [open-file] - '(menu-item "Open File..." menu-find-file-existing + `(menu-item ,(purecopy "Open File...") menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) - :help "Read an existing file into an Emacs buffer")) + :help ,(purecopy "Read an existing file into an Emacs buffer"))) (define-key menu-bar-file-menu [new-file] - '(menu-item "Visit New File..." find-file + `(menu-item ,(purecopy "Visit New File...") find-file :enable (menu-bar-non-minibuffer-window-p) - :help "Specify a new file's name, to edit the file")) + :help ,(purecopy "Specify a new file's name, to edit the file"))) ;; The "Edit" menu items @@ -274,120 +274,119 @@ (make-sparse-keymap "Incremental Search")) (define-key menu-bar-i-search-menu [isearch-backward-regexp] - '(menu-item "Backward Regexp..." isearch-backward-regexp - :help "Search backwards for a regular expression as you type it")) + `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp + :help ,(purecopy "Search backwards for a regular expression as you type it"))) (define-key menu-bar-i-search-menu [isearch-forward-regexp] - '(menu-item "Forward Regexp..." isearch-forward-regexp - :help "Search forward for a regular expression as you type it")) + `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp + :help ,(purecopy "Search forward for a regular expression as you type it"))) (define-key menu-bar-i-search-menu [isearch-backward] - '(menu-item "Backward String..." isearch-backward - :help "Search backwards for a string as you type it")) + `(menu-item ,(purecopy "Backward String...") isearch-backward + :help ,(purecopy "Search backwards for a string as you type it"))) (define-key menu-bar-i-search-menu [isearch-forward] - '(menu-item "Forward String..." isearch-forward - :help "Search forward for a string as you type it")) - + `(menu-item ,(purecopy "Forward String...") isearch-forward + :help ,(purecopy "Search forward for a string as you type it"))) (define-key menu-bar-search-menu [i-search] - (list 'menu-item "Incremental Search" menu-bar-i-search-menu)) + `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu)) (define-key menu-bar-search-menu [separator-tag-isearch] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-search-menu [tags-continue] - '(menu-item "Continue Tags Search" tags-loop-continue - :help "Continue last tags search operation")) + `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue + :help ,(purecopy "Continue last tags search operation"))) (define-key menu-bar-search-menu [tags-srch] - '(menu-item "Search Tagged Files..." tags-search - :help "Search for a regexp in all tagged files")) + `(menu-item ,(purecopy "Search Tagged Files...") tags-search + :help ,(purecopy "Search for a regexp in all tagged files"))) (define-key menu-bar-search-menu [separator-tag-search] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-search-menu [repeat-search-back] - '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward + `(menu-item ,(purecopy "Repeat Backwards") nonincremental-repeat-search-backward :enable (or (and (eq menu-bar-last-search-type 'string) search-ring) (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) - :help "Repeat last search backwards")) + :help ,(purecopy "Repeat last search backwards"))) (define-key menu-bar-search-menu [repeat-search-fwd] - '(menu-item "Repeat Forward" nonincremental-repeat-search-forward + `(menu-item ,(purecopy "Repeat Forward") nonincremental-repeat-search-forward :enable (or (and (eq menu-bar-last-search-type 'string) search-ring) (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) - :help "Repeat last search forward")) + :help ,(purecopy "Repeat last search forward"))) (define-key menu-bar-search-menu [separator-repeat-search] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-search-menu [re-search-backward] - '(menu-item "Regexp Backwards..." nonincremental-re-search-backward - :help "Search backwards for a regular expression")) + `(menu-item ,(purecopy "Regexp Backwards...") nonincremental-re-search-backward + :help ,(purecopy "Search backwards for a regular expression"))) (define-key menu-bar-search-menu [re-search-forward] - '(menu-item "Regexp Forward..." nonincremental-re-search-forward - :help "Search forward for a regular expression")) + `(menu-item ,(purecopy "Regexp Forward...") nonincremental-re-search-forward + :help ,(purecopy "Search forward for a regular expression"))) (define-key menu-bar-search-menu [search-backward] - '(menu-item "String Backwards..." nonincremental-search-backward - :help "Search backwards for a string")) + `(menu-item ,(purecopy "String Backwards...") nonincremental-search-backward + :help ,(purecopy "Search backwards for a string"))) (define-key menu-bar-search-menu [search-forward] - '(menu-item "String Forward..." nonincremental-search-forward - :help "Search forward for a string")) + `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward + :help ,(purecopy "Search forward for a string"))) ;; The Edit->Replace submenu (defvar menu-bar-replace-menu (make-sparse-keymap "Replace")) (define-key menu-bar-replace-menu [tags-repl-continue] - '(menu-item "Continue Replace" tags-loop-continue - :help "Continue last tags replace operation")) + `(menu-item ,(purecopy "Continue Replace") tags-loop-continue + :help ,(purecopy "Continue last tags replace operation"))) (define-key menu-bar-replace-menu [tags-repl] - '(menu-item "Replace in Tagged Files..." tags-query-replace - :help "Interactively replace a regexp in all tagged files")) + `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace + :help ,(purecopy "Interactively replace a regexp in all tagged files"))) (define-key menu-bar-replace-menu [separator-replace-tags] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-replace-menu [query-replace-regexp] - '(menu-item "Replace Regexp..." query-replace-regexp + `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp :enable (not buffer-read-only) - :help "Replace regular expression interactively, ask about each occurrence")) + :help ,(purecopy "Replace regular expression interactively, ask about each occurrence"))) (define-key menu-bar-replace-menu [query-replace] - '(menu-item "Replace String..." query-replace + `(menu-item ,(purecopy "Replace String...") query-replace :enable (not buffer-read-only) - :help "Replace string interactively, ask about each occurrence")) + :help ,(purecopy "Replace string interactively, ask about each occurrence"))) ;;; Assemble the top-level Edit menu items. (define-key menu-bar-edit-menu [props] - '(menu-item "Text Properties" facemenu-menu)) + `(menu-item ,(purecopy "Text Properties") facemenu-menu)) (define-key menu-bar-edit-menu [fill] - '(menu-item "Fill" fill-region + `(menu-item ,(purecopy "Fill") fill-region :enable (and mark-active (not buffer-read-only)) :help - "Fill text in region to fit between left and right margin")) + ,(purecopy "Fill text in region to fit between left and right margin"))) (define-key menu-bar-edit-menu [separator-bookmark] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-edit-menu [bookmark] - '(menu-item "Bookmarks" menu-bar-bookmark-map)) + `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map)) (defvar menu-bar-goto-menu (make-sparse-keymap "Go To")) (define-key menu-bar-goto-menu [set-tags-name] - '(menu-item "Set Tags File Name..." visit-tags-table - :help "Tell Tags commands which tag table file to use")) + `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table + :help ,(purecopy "Tell Tags commands which tag table file to use"))) (define-key menu-bar-goto-menu [separator-tag-file] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-goto-menu [apropos-tags] - '(menu-item "Tags Apropos..." tags-apropos - :help "Find function/variables whose names match regexp")) + `(menu-item ,(purecopy "Tags Apropos...") tags-apropos + :help ,(purecopy "Find function/variables whose names match regexp"))) (define-key menu-bar-goto-menu [next-tag-otherw] - '(menu-item "Next Tag in Other Window" + `(menu-item ,(purecopy "Next Tag in Other Window") menu-bar-next-tag-other-window :enable (and (boundp 'tags-location-ring) (not (ring-empty-p tags-location-ring))) - :help "Find next function/variable matching last tag name in another window")) + :help ,(purecopy "Find next function/variable matching last tag name in another window"))) (defun menu-bar-next-tag-other-window () "Find the next definition of the tag already specified." @@ -400,62 +399,62 @@ (find-tag nil t)) (define-key menu-bar-goto-menu [next-tag] - '(menu-item "Find Next Tag" + `(menu-item ,(purecopy "Find Next Tag") menu-bar-next-tag :enable (and (boundp 'tags-location-ring) (not (ring-empty-p tags-location-ring))) - :help "Find next function/variable matching last tag name")) + :help ,(purecopy "Find next function/variable matching last tag name"))) (define-key menu-bar-goto-menu [find-tag-otherw] - '(menu-item "Find Tag in Other Window..." find-tag-other-window - :help "Find function/variable definition in another window")) + `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window + :help ,(purecopy "Find function/variable definition in another window"))) (define-key menu-bar-goto-menu [find-tag] - '(menu-item "Find Tag..." find-tag - :help "Find definition of function or variable")) + `(menu-item ,(purecopy "Find Tag...") find-tag + :help ,(purecopy "Find definition of function or variable"))) (define-key menu-bar-goto-menu [separator-tags] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-goto-menu [end-of-buf] - '(menu-item "Goto End of Buffer" end-of-buffer)) + `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer)) (define-key menu-bar-goto-menu [beg-of-buf] - '(menu-item "Goto Beginning of Buffer" beginning-of-buffer)) + `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer)) (define-key menu-bar-goto-menu [go-to-pos] - '(menu-item "Goto Buffer Position..." goto-char - :help "Read a number N and go to buffer position N")) + `(menu-item ,(purecopy "Goto Buffer Position...") goto-char + :help ,(purecopy "Read a number N and go to buffer position N"))) (define-key menu-bar-goto-menu [go-to-line] - '(menu-item "Goto Line..." goto-line - :help "Read a line number and go to that line")) + `(menu-item ,(purecopy "Goto Line...") goto-line + :help ,(purecopy "Read a line number and go to that line"))) (define-key menu-bar-edit-menu [goto] - (list 'menu-item "Go To" menu-bar-goto-menu)) + `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu)) (define-key menu-bar-edit-menu [replace] - (list 'menu-item "Replace" menu-bar-replace-menu)) + `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu)) (define-key menu-bar-edit-menu [search] - (list 'menu-item "Search" menu-bar-search-menu)) + `(menu-item ,(purecopy "Search") ,menu-bar-search-menu)) (define-key menu-bar-edit-menu [separator-search] - '(menu-item "--")) + `(menu-item ,(purecopy "--"))) (define-key menu-bar-edit-menu [mark-whole-buffer] - '(menu-item "Select All" mark-whole-buffer - :help "Mark the whole buffer for a subsequent cut/copy")) + `(menu-item ,(purecopy "Select All") mark-whole-buffer + :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy"))) (define-key menu-bar-edit-menu [clear] - '(menu-item "Clear" delete-region + `(menu-item ,(purecopy "Clear") delete-region :enable (and mark-active (not buffer-read-only) (not (mouse-region-match))) :help - "Delete the text in region between mark and current position")) + ,(purecopy "Delete the text in region between mark and current position"))) (defvar yank-menu (cons "Select Yank" nil)) (fset 'yank-menu (cons 'keymap yank-menu)) (define-key menu-bar-edit-menu [paste-from-menu] - '(menu-item "Paste from Kill Menu" yank-menu + `(menu-item ,(purecopy "Paste from Kill Menu") yank-menu :enable (and (cdr yank-menu) (not buffer-read-only)) - :help "Choose a string from the kill ring and paste it")) + :help ,(purecopy "Choose a string from the kill ring and paste it"))) (define-key menu-bar-edit-menu [paste] - '(menu-item "Paste" yank + `(menu-item ,(purecopy "Paste") yank :enable (and (or ;; Emacs compiled --without-x doesn't have ;; x-selection-exists-p. @@ -463,25 +462,25 @@ (x-selection-exists-p)) kill-ring) (not buffer-read-only)) - :help "Paste (yank) text most recently cut/copied")) + :help ,(purecopy "Paste (yank) text most recently cut/copied"))) (define-key menu-bar-edit-menu [copy] - '(menu-item "Copy" menu-bar-kill-ring-save + `(menu-item ,(purecopy "Copy") menu-bar-kill-ring-save :enable mark-active - :help "Copy text in region between mark and current position" + :help ,(purecopy "Copy text in region between mark and current position") :keys "\\[kill-ring-save]")) (define-key menu-bar-edit-menu [cut] - '(menu-item "Cut" kill-region + `(menu-item ,(purecopy "Cut") kill-region :enable (and mark-active (not buffer-read-only)) :help - "Cut (kill) text in region between mark and current position")) + ,(purecopy "Cut (kill) text in region between mark and current position"))) (define-key menu-bar-edit-menu [undo] - '(menu-item "Undo" undo + `(menu-item ,(purecopy "Undo") undo :enable (and (not buffer-read-only) (not (eq t buffer-undo-list)) (if (eq last-command 'undo) (listp pending-undo-list) (consp buffer-undo-list))) - :help "Undo last operation")) + :help ,(purecopy "Undo last operation"))) (defun menu-bar-kill-ring-save (beg end) @@ -550,44 +549,44 @@ Do the same for the keys of the same name." (defvar menu-bar-custom-menu (make-sparse-keymap "Customize")) (define-key menu-bar-custom-menu [customize-apropos-groups] - '(menu-item "Groups Matching Regexp..." customize-apropos-groups - :help "Browse groups whose names match regexp")) + `(menu-item ,(purecopy "Groups Matching Regexp...") customize-apropos-groups + :help ,(purecopy "Browse groups whose names match regexp"))) (define-key menu-bar-custom-menu [customize-apropos-faces] - '(menu-item "Faces Matching Regexp..." customize-apropos-faces - :help "Browse faces whose names match regexp")) + `(menu-item ,(purecopy "Faces Matching Regexp...") customize-apropos-faces + :help ,(purecopy "Browse faces whose names match regexp"))) (define-key menu-bar-custom-menu [customize-apropos-options] - '(menu-item "Options Matching Regexp..." customize-apropos-options - :help "Browse options whose names match regexp")) + `(menu-item ,(purecopy "Options Matching Regexp...") customize-apropos-options + :help ,(purecopy "Browse options whose names match regexp"))) (define-key menu-bar-custom-menu [customize-apropos] - '(menu-item "Settings Matching Regexp..." customize-apropos - :help "Browse customizable settings whose names match regexp")) + `(menu-item ,(purecopy "Settings Matching Regexp...") customize-apropos + :help ,(purecopy "Browse customizable settings whose names match regexp"))) (define-key menu-bar-custom-menu [separator-1] '("--")) (define-key menu-bar-custom-menu [customize-group] - '(menu-item "Specific Group..." customize-group - :help "Customize settings of specific group")) + `(menu-item ,(purecopy "Specific Group...") customize-group + :help ,(purecopy "Customize settings of specific group"))) (define-key menu-bar-custom-menu [customize-face] - '(menu-item "Specific Face..." customize-face - :help "Customize attributes of specific face")) + `(menu-item ,(purecopy "Specific Face...") customize-face + :help ,(purecopy "Customize attributes of specific face"))) (define-key menu-bar-custom-menu [customize-option] - '(menu-item "Specific Option..." customize-option - :help "Customize value of specific option")) + `(menu-item ,(purecopy "Specific Option...") customize-option + :help ,(purecopy "Customize value of specific option"))) (define-key menu-bar-custom-menu [separator-2] '("--")) (define-key menu-bar-custom-menu [customize-changed-options] - '(menu-item "New Options..." customize-changed-options - :help "Options added or changed in recent Emacs versions")) + `(menu-item ,(purecopy "New Options...") customize-changed-options + :help ,(purecopy "Options added or changed in recent Emacs versions"))) (define-key menu-bar-custom-menu [customize-saved] - '(menu-item "Saved Options" customize-saved - :help "Customize previously saved options")) + `(menu-item ,(purecopy "Saved Options") customize-saved + :help ,(purecopy "Customize previously saved options"))) (define-key menu-bar-custom-menu [separator-3] '("--")) (define-key menu-bar-custom-menu [customize-browse] - '(menu-item "Browse Customization Groups" customize-browse - :help "Browse all customization groups")) + `(menu-item ,(purecopy "Browse Customization Groups") customize-browse + :help ,(purecopy "Browse all customization groups"))) (define-key menu-bar-custom-menu [customize] - '(menu-item "Top-level Customization Group" customize - :help "The master group called `Emacs'")) + `(menu-item ,(purecopy "Top-level Customization Group") customize + :help ,(purecopy "The master group called `Emacs'"))) ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences")) @@ -597,9 +596,9 @@ FNAME is the minor mode's name (variable and function). DOC is the text to use for the menu entry. HELP is the text to use for the tooltip. PROPS are additional properties." - `'(menu-item ,doc ,fname + `'(menu-item ,(purecopy doc) ,fname ,@props - :help ,help + :help ,(purecopy help) :button (:toggle . (and (default-boundp ',fname) (default-value ',fname))))) @@ -624,8 +623,8 @@ by \"Save Options\" in Custom buffers.") ;; a candidate for "Save Options", and we do not want to save options ;; the user have already set explicitly in his init file. (if interactively (customize-mark-as-set ',variable))) - '(menu-item ,doc ,name - :help ,help + '(menu-item ,(purecopy doc) ,name + :help ,(purecopy help) :button (:toggle . (and (default-boundp ',variable) (default-value ',variable)))))) @@ -660,7 +659,7 @@ by \"Save Options\" in Custom buffers.") ;;; Assemble all the top-level items of the "Options" menu (define-key menu-bar-options-menu [customize] - (list 'menu-item "Customize Emacs" menu-bar-custom-menu)) + `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu)) (defun menu-bar-options-save () "Save current values of Options menu items using Custom." @@ -700,16 +699,16 @@ by \"Save Options\" in Custom buffers.") (custom-save-all)))) (define-key menu-bar-options-menu [save] - '(menu-item "Save Options" menu-bar-options-save - :help "Save options set from the menu above")) + `(menu-item ,(purecopy "Save Options") menu-bar-options-save + :help ,(purecopy "Save options set from the menu above"))) (define-key menu-bar-options-menu [custom-separator] '("--")) (define-key menu-bar-options-menu [menu-set-font] - '(menu-item "Set Default Font..." menu-set-font + `(menu-item ,(purecopy "Set Default Font...") menu-set-font :visible (display-multi-font-p) - :help "Select a default font")) + :help ,(purecopy "Select a default font"))) ;; The "Show/Hide" submenu of menu "Options" @@ -748,8 +747,8 @@ mail status in mode line")) '("--")) (define-key menu-bar-showhide-menu [showhide-speedbar] - '(menu-item "Speedbar" speedbar-frame-mode - :help "Display a Speedbar quick-navigation frame" + `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode + :help ,(purecopy "Display a Speedbar quick-navigation frame") :button (:toggle . (and (boundp 'speedbar-frame) (frame-live-p (symbol-value 'speedbar-frame)) @@ -767,9 +766,9 @@ mail status in mode line")) (customize-variable 'indicate-buffer-boundaries)) (define-key menu-bar-showhide-fringe-ind-menu [customize] - '(menu-item "Other (Customize)" + `(menu-item ,(purecopy "Other (Customize)") menu-bar-showhide-fringe-ind-customize - :help "Additional choices available through Custom buffer" + :help ,(purecopy "Additional choices available through Custom buffer") :visible (display-graphic-p) :button (:radio . (not (member indicate-buffer-boundaries '(nil left right @@ -783,9 +782,9 @@ mail status in mode line")) '((t . right) (top . left)))) (define-key menu-bar-showhide-fringe-ind-menu [mixed] - '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed + `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed :help - "Show top/bottom indicators in opposite fringes, arrows in right" + ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right") :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((t . right) (top . left)))))) @@ -797,8 +796,8 @@ mail status in mode line")) '((top . left) (bottom . right)))) (define-key menu-bar-showhide-fringe-ind-menu [box] - '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box - :help "Show top/bottom indicators in opposite fringes, no arrows" + `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box + :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows") :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((top . left) (bottom . right)))))) @@ -809,8 +808,8 @@ mail status in mode line")) (customize-set-variable 'indicate-buffer-boundaries 'right)) (define-key menu-bar-showhide-fringe-ind-menu [right] - '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right - :help "Show buffer boundaries and arrows in right fringe" + `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right + :help ,(purecopy "Show buffer boundaries and arrows in right fringe") :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'right)))) @@ -820,8 +819,8 @@ mail status in mode line")) (customize-set-variable 'indicate-buffer-boundaries 'left)) (define-key menu-bar-showhide-fringe-ind-menu [left] - '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left - :help "Show buffer boundaries and arrows in left fringe" + `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left + :help ,(purecopy "Show buffer boundaries and arrows in left fringe") :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'left)))) @@ -831,15 +830,15 @@ mail status in mode line")) (customize-set-variable 'indicate-buffer-boundaries nil)) (define-key menu-bar-showhide-fringe-ind-menu [none] - '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none - :help "Hide all buffer boundary indicators and arrows" + `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none + :help ,(purecopy "Hide all buffer boundary indicators and arrows") :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries nil)))) (define-key menu-bar-showhide-fringe-menu [showhide-fringe-ind] - (list 'menu-item "Buffer Boundaries" menu-bar-showhide-fringe-ind-menu - :visible `(display-graphic-p) - :help "Indicate buffer boundaries in fringe")) + `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu + :visible (display-graphic-p) + :help ,(purecopy "Indicate buffer boundaries in fringe"))) (define-key menu-bar-showhide-fringe-menu [indicate-empty-lines] (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines @@ -853,8 +852,8 @@ mail status in mode line")) (customize-variable 'fringe-mode)) (define-key menu-bar-showhide-fringe-menu [customize] - '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize - :help "Detailed customization of fringe" + `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize + :help ,(purecopy "Detailed customization of fringe") :visible (display-graphic-p))) (defun menu-bar-showhide-fringe-menu-customize-reset () @@ -863,8 +862,8 @@ mail status in mode line")) (customize-set-variable 'fringe-mode nil)) (define-key menu-bar-showhide-fringe-menu [default] - '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset - :help "Default width fringe on both left and right side" + `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset + :help ,(purecopy "Default width fringe on both left and right side") :visible (display-graphic-p) :button (:radio . (eq fringe-mode nil)))) @@ -875,8 +874,8 @@ mail status in mode line")) (customize-set-variable 'fringe-mode '(0 . nil))) (define-key menu-bar-showhide-fringe-menu [right] - '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right - :help "Fringe only on the right side" + `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right + :help ,(purecopy "Fringe only on the right side") :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(0 . nil))))) @@ -887,8 +886,8 @@ mail status in mode line")) (customize-set-variable 'fringe-mode '(nil . 0))) (define-key menu-bar-showhide-fringe-menu [left] - '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left - :help "Fringe only on the left side" + `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left + :help ,(purecopy "Fringe only on the left side") :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(nil . 0))))) @@ -899,21 +898,21 @@ mail status in mode line")) (customize-set-variable 'fringe-mode 0)) (define-key menu-bar-showhide-fringe-menu [none] - '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable - :help "Turn off fringe" + `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable + :help ,(purecopy "Turn off fringe") :visible (display-graphic-p) :button (:radio . (eq fringe-mode 0)))) (define-key menu-bar-showhide-menu [showhide-fringe] - (list 'menu-item "Fringe" menu-bar-showhide-fringe-menu - :visible `(display-graphic-p))) + `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu + :visible (display-graphic-p))) (defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar")) (define-key menu-bar-showhide-scroll-bar-menu [right] - '(menu-item "On the Right" + `(menu-item ,(purecopy "On the Right") menu-bar-right-scroll-bar - :help "Scroll-bar on the right side" + :help ,(purecopy "Scroll-bar on the right side") :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'right)))) @@ -923,9 +922,9 @@ mail status in mode line")) (customize-set-variable 'scroll-bar-mode 'right)) (define-key menu-bar-showhide-scroll-bar-menu [left] - '(menu-item "On the Left" + `(menu-item ,(purecopy "On the Left") menu-bar-left-scroll-bar - :help "Scroll-bar on the left side" + :help ,(purecopy "Scroll-bar on the left side") :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'left)))) @@ -936,9 +935,9 @@ mail status in mode line")) (customize-set-variable 'scroll-bar-mode 'left)) (define-key menu-bar-showhide-scroll-bar-menu [none] - '(menu-item "None" + `(menu-item ,(purecopy "None") menu-bar-no-scroll-bar - :help "Turn off scroll-bar" + :help ,(purecopy "Turn off scroll-bar") :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) nil)))) @@ -949,28 +948,28 @@ mail status in mode line")) (customize-set-variable 'scroll-bar-mode nil)) (define-key menu-bar-showhide-menu [showhide-scroll-bar] - (list 'menu-item "Scroll-bar" menu-bar-showhide-scroll-bar-menu - :visible `(display-graphic-p))) + `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu + :visible (display-graphic-p))) (define-key menu-bar-showhide-menu [showhide-tooltip-mode] - (list 'menu-item "Tooltips" 'tooltip-mode - :help "Turn tooltips on/off" - :visible `(and (display-graphic-p) (fboundp 'x-show-tip)) - :button `(:toggle . tooltip-mode))) + `(menu-item ,(purecopy "Tooltips") tooltip-mode + :help ,(purecopy "Turn tooltips on/off") + :visible (and (display-graphic-p) (fboundp 'x-show-tip)) + :button (:toggle . tooltip-mode))) (define-key menu-bar-showhide-menu [menu-bar-mode] - '(menu-item "Menu-bar" toggle-menu-bar-mode-from-frame - :help "Turn menu-bar on/off" + `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame + :help ,(purecopy "Turn menu-bar on/off") :button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0)))) (define-key menu-bar-showhide-menu [showhide-tool-bar] - (list 'menu-item "Tool-bar" 'toggle-tool-bar-mode-from-frame - :help "Turn tool-bar on/off" - :visible `(display-graphic-p) - :button `(:toggle . (> (frame-parameter nil 'tool-bar-lines) 0)))) + `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame + :help ,(purecopy "Turn tool-bar on/off") + :visible (display-graphic-p) + :button (:toggle . (> (frame-parameter nil 'tool-bar-lines) 0)))) (define-key menu-bar-options-menu [showhide] - (list 'menu-item "Show/Hide" menu-bar-showhide-menu)) + `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) (define-key menu-bar-options-menu [showhide-separator] '("--")) @@ -979,15 +978,15 @@ mail status in mode line")) ;; It is better not to use backquote here, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. - (list 'menu-item "Mule (Multilingual Environment)" mule-menu-keymap + `(menu-item ,(purecopy "Mule (Multilingual Environment)") ,mule-menu-keymap ;; Most of the MULE menu actually does make sense in unibyte mode, ;; e.g. language selection. -;;; ':visible 'default-enable-multibyte-characters +;;; :visible '(default-value 'enable-multibyte-characters) )) ;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) ;(define-key menu-bar-options-menu [preferences] -; (list 'menu-item "Preferences" menu-bar-preferences-menu -; :help "Toggle important global options")) +; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu +; :help ,(purecopy "Toggle important global options"))) (define-key menu-bar-options-menu [mule-separator] '("--")) @@ -1062,9 +1061,9 @@ mail status in mode line")) (customize-mark-as-set 'text-mode-hook)) (define-key menu-bar-options-menu [auto-fill-mode] - '(menu-item "Auto Fill in Text Modes" + `(menu-item ,(purecopy "Auto Fill in Text Modes") menu-bar-text-mode-auto-fill - :help "Automatically fill text while typing (Auto Fill mode)" + :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") :button (:toggle . (if (listp text-mode-hook) (member 'turn-on-auto-fill text-mode-hook) (eq 'turn-on-auto-fill text-mode-hook))))) @@ -1073,38 +1072,38 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (make-sparse-keymap "Line Wrapping")) (define-key menu-bar-line-wrapping-menu [word-wrap] - '(menu-item "Word Wrap (Visual Line mode)" + `(menu-item ,(purecopy "Word Wrap (Visual Line mode)") (lambda () (interactive) (unless visual-line-mode (visual-line-mode 1)) (message "Visual-Line mode enabled")) - :help "Wrap long lines at word boundaries" + :help ,(purecopy "Wrap long lines at word boundaries") :button (:radio . (and (null truncate-lines) (not (truncated-partial-width-window-p)) word-wrap)) :visible (menu-bar-menu-frame-live-and-visible-p))) (define-key menu-bar-line-wrapping-menu [truncate] - '(menu-item "Truncate Long Lines" + `(menu-item ,(purecopy "Truncate Long Lines") (lambda () (interactive) (if visual-line-mode (visual-line-mode 0)) (setq word-wrap nil) (toggle-truncate-lines 1)) - :help "Truncate long lines at window edge" + :help ,(purecopy "Truncate long lines at window edge") :button (:radio . (or truncate-lines (truncated-partial-width-window-p))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) (define-key menu-bar-line-wrapping-menu [window-wrap] - '(menu-item "Wrap at Window Edge" + `(menu-item ,(purecopy "Wrap at Window Edge") (lambda () (interactive) (if visual-line-mode (visual-line-mode 0)) (setq word-wrap nil) (if truncate-lines (toggle-truncate-lines -1))) - :help "Wrap long lines at window edge" + :help ,(purecopy "Wrap long lines at window edge") :button (:radio . (and (null truncate-lines) (not (truncated-partial-width-window-p)) (not word-wrap))) @@ -1112,7 +1111,7 @@ mail status in mode line")) :enable (not (truncated-partial-width-window-p)))) (define-key menu-bar-options-menu [line-wrapping] - (list 'menu-item "Line Wrapping in this Buffer" menu-bar-line-wrapping-menu)) + `(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu)) (define-key menu-bar-options-menu [highlight-separator] @@ -1153,145 +1152,141 @@ mail status in mode line")) (defvar menu-bar-games-menu (make-sparse-keymap "Games")) (define-key menu-bar-tools-menu [games] - (list 'menu-item "Games" menu-bar-games-menu)) + `(menu-item ,(purecopy "Games") ,menu-bar-games-menu)) (define-key menu-bar-tools-menu [separator-games] '("--")) (define-key menu-bar-games-menu [zone] - '(menu-item "Zone Out" zone - :help "Play tricks with Emacs display when Emacs is idle")) + `(menu-item ,(purecopy "Zone Out") zone + :help ,(purecopy "Play tricks with Emacs display when Emacs is idle"))) (define-key menu-bar-games-menu [tetris] - '(menu-item "Tetris" tetris - :help "Falling blocks game")) + `(menu-item ,(purecopy "Tetris") tetris + :help ,(purecopy "Falling blocks game"))) (define-key menu-bar-games-menu [solitaire] - '(menu-item "Solitaire" solitaire - :help "Get rid of all the stones")) + `(menu-item ,(purecopy "Solitaire") solitaire + :help ,(purecopy "Get rid of all the stones"))) (define-key menu-bar-games-menu [snake] - '(menu-item "Snake" snake - :help "Move snake around avoiding collisions")) + `(menu-item ,(purecopy "Snake") snake + :help ,(purecopy "Move snake around avoiding collisions"))) (define-key menu-bar-games-menu [pong] - '(menu-item "Pong" pong - :help "Bounce the ball to your opponent")) + `(menu-item ,(purecopy "Pong") pong + :help ,(purecopy "Bounce the ball to your opponent"))) (define-key menu-bar-games-menu [mult] - '(menu-item "Multiplication Puzzle" mpuz - :help "Exercise brain with multiplication")) + `(menu-item ,(purecopy "Multiplication Puzzle") mpuz + :help ,(purecopy "Exercise brain with multiplication"))) (define-key menu-bar-games-menu [life] - '(menu-item "Life" life - :help "Watch how John Conway's cellular automaton evolves")) + `(menu-item ,(purecopy "Life") life + :help ,(purecopy "Watch how John Conway's cellular automaton evolves"))) (define-key menu-bar-games-menu [hanoi] - '(menu-item "Towers of Hanoi" hanoi - :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) + `(menu-item ,(purecopy "Towers of Hanoi") hanoi + :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs"))) (define-key menu-bar-games-menu [gomoku] - '(menu-item "Gomoku" gomoku - :help "Mark 5 contiguous squares (like tic-tac-toe)")) + `(menu-item ,(purecopy "Gomoku") gomoku + :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)"))) (define-key menu-bar-games-menu [bubbles] - '(menu-item "Bubbles" bubbles - :help "Remove all bubbles using the fewest moves")) + `(menu-item ,(purecopy "Bubbles") bubbles + :help ,(purecopy "Remove all bubbles using the fewest moves"))) (define-key menu-bar-games-menu [black-box] - '(menu-item "Blackbox" blackbox - :help "Find balls in a black box by shooting rays")) + `(menu-item ,(purecopy "Blackbox") blackbox + :help ,(purecopy "Find balls in a black box by shooting rays"))) (define-key menu-bar-games-menu [adventure] - '(menu-item "Adventure" dunnet - :help "Dunnet, a text Adventure game for Emacs")) + `(menu-item ,(purecopy "Adventure") dunnet + :help ,(purecopy "Dunnet, a text Adventure game for Emacs"))) (define-key menu-bar-games-menu [5x5] - '(menu-item "5x5" 5x5 - :help "Fill in all the squares on a 5x5 board")) + `(menu-item ,(purecopy "5x5") 5x5 + :help ,(purecopy "Fill in all the squares on a 5x5 board"))) (defvar menu-bar-encryption-decryption-menu (make-sparse-keymap "Encryption/Decryption")) (define-key menu-bar-tools-menu [encryption-decryption] - (list 'menu-item "Encryption/Decryption" menu-bar-encryption-decryption-menu)) + `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu)) (define-key menu-bar-tools-menu [separator-encryption-decryption] '("--")) (define-key menu-bar-encryption-decryption-menu [insert-keys] - '(menu-item "Insert Keys" epa-insert-keys - :help "Insert public keys after the current point")) + `(menu-item ,(purecopy "Insert Keys") epa-insert-keys + :help ,(purecopy "Insert public keys after the current point"))) (define-key menu-bar-encryption-decryption-menu [export-keys] - '(menu-item "Export Keys" epa-export-keys - :help "Export public keys to a file")) + `(menu-item ,(purecopy "Export Keys") epa-export-keys + :help ,(purecopy "Export public keys to a file"))) (define-key menu-bar-encryption-decryption-menu [import-keys-region] - '(menu-item "Import Keys from Region" epa-import-keys-region - :help "Import public keys from the current region")) + `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region + :help ,(purecopy "Import public keys from the current region"))) (define-key menu-bar-encryption-decryption-menu [import-keys] - '(menu-item "Import Keys from File..." epa-import-keys - :help "Import public keys from a file")) + `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys + :help ,(purecopy "Import public keys from a file"))) (define-key menu-bar-encryption-decryption-menu [list-keys] - '(menu-item "List Keys" epa-list-keys - :help "Browse your public keyring")) + `(menu-item ,(purecopy "List Keys") epa-list-keys + :help ,(purecopy "Browse your public keyring"))) (define-key menu-bar-encryption-decryption-menu [separator-keys] '("--")) (define-key menu-bar-encryption-decryption-menu [sign-region] - '(menu-item "Sign Region" epa-sign-region - :help "Create digital signature of the current region")) + `(menu-item ,(purecopy "Sign Region") epa-sign-region + :help ,(purecopy "Create digital signature of the current region"))) (define-key menu-bar-encryption-decryption-menu [verify-region] - '(menu-item "Verify Region" epa-verify-region - :help "Verify digital signature of the current region")) + `(menu-item ,(purecopy "Verify Region") epa-verify-region + :help ,(purecopy "Verify digital signature of the current region"))) (define-key menu-bar-encryption-decryption-menu [encrypt-region] - '(menu-item "Encrypt Region" epa-encrypt-region - :help "Encrypt the current region")) + `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region + :help ,(purecopy "Encrypt the current region"))) (define-key menu-bar-encryption-decryption-menu [decrypt-region] - '(menu-item "Decrypt Region" epa-decrypt-region - :help "Decrypt the current region")) + `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region + :help ,(purecopy "Decrypt the current region"))) (define-key menu-bar-encryption-decryption-menu [separator-file] '("--")) (define-key menu-bar-encryption-decryption-menu [sign-file] - '(menu-item "Sign File..." epa-sign-file - :help "Create digital signature of a file")) + `(menu-item ,(purecopy "Sign File...") epa-sign-file + :help ,(purecopy "Create digital signature of a file"))) (define-key menu-bar-encryption-decryption-menu [verify-file] - '(menu-item "Verify File..." epa-verify-file - :help "Verify digital signature of a file")) + `(menu-item ,(purecopy "Verify File...") epa-verify-file + :help ,(purecopy "Verify digital signature of a file"))) (define-key menu-bar-encryption-decryption-menu [encrypt-file] - '(menu-item "Encrypt File..." epa-encrypt-file - :help "Encrypt a file")) + `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file + :help ,(purecopy "Encrypt a file"))) (define-key menu-bar-encryption-decryption-menu [decrypt-file] - '(menu-item "Decrypt File..." epa-decrypt-file - :help "Decrypt a file")) + `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file + :help ,(purecopy "Decrypt a file"))) (define-key menu-bar-tools-menu [simple-calculator] - '(menu-item "Simple Calculator" calculator - :help "Invoke the Emacs built-in quick calculator")) + `(menu-item ,(purecopy "Simple Calculator") calculator + :help ,(purecopy "Invoke the Emacs built-in quick calculator"))) (define-key menu-bar-tools-menu [calc] - '(menu-item "Programmable Calculator" calc - :help "Invoke the Emacs built-in full scientific calculator")) + `(menu-item ,(purecopy "Programmable Calculator") calc + :help ,(purecopy "Invoke the Emacs built-in full scientific calculator"))) (define-key menu-bar-tools-menu [calendar] - '(menu-item "Calendar" calendar - :help "Invoke the Emacs built-in calendar")) + `(menu-item ,(purecopy "Calendar") calendar + :help ,(purecopy "Invoke the Emacs built-in calendar"))) (define-key menu-bar-tools-menu [separator-net] '("--")) (define-key menu-bar-tools-menu [directory-search] - '(menu-item "Directory Search" eudc-tools-menu)) + `(menu-item ,(purecopy "Directory Search") eudc-tools-menu)) (define-key menu-bar-tools-menu [compose-mail] - (list - 'menu-item `(format "Send Mail (with %s)" (send-mail-item-name)) - 'compose-mail - :visible `(and mail-user-agent (not (eq mail-user-agent 'ignore))) - :help "Send a mail message")) + `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail + :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) + :help ,(purecopy "Send a mail message"))) (define-key menu-bar-tools-menu [rmail] - (list - 'menu-item `(format "Read Mail (with %s)" (read-mail-item-name)) - 'menu-bar-read-mail - :visible `(and read-mail-command (not (eq read-mail-command 'ignore))) - :help "Read your mail and reply to it")) + `(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) menu-bar-read-mail + :visible (and read-mail-command (not (eq read-mail-command 'ignore))) + :help ,(purecopy "Read your mail and reply to it"))) (defun menu-bar-read-mail () "Read mail using `read-mail-command'." @@ -1299,51 +1294,51 @@ mail status in mode line")) (call-interactively read-mail-command)) (define-key menu-bar-tools-menu [gnus] - '(menu-item "Read Net News (Gnus)" gnus - :help "Read network news groups")) + `(menu-item ,(purecopy "Read Net News (Gnus)") gnus + :help ,(purecopy "Read network news groups"))) (define-key menu-bar-tools-menu [separator-vc] '("--")) (define-key menu-bar-tools-menu [pcl-cvs] - '(menu-item "PCL-CVS" cvs-global-menu)) + `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu)) (define-key menu-bar-tools-menu [vc] nil) ;Create the place for the VC menu. (define-key menu-bar-tools-menu [separator-compare] '("--")) (define-key menu-bar-tools-menu [epatch] - '(menu-item "Apply Patch" menu-bar-epatch-menu)) + `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu)) (define-key menu-bar-tools-menu [ediff-merge] - '(menu-item "Merge" menu-bar-ediff-merge-menu)) + `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu)) (define-key menu-bar-tools-menu [compare] - '(menu-item "Compare (Ediff)" menu-bar-ediff-menu)) + `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu)) (define-key menu-bar-tools-menu [separator-spell] '("--")) (define-key menu-bar-tools-menu [spell] - '(menu-item "Spell Checking" ispell-menu-map)) + `(menu-item ,(purecopy "Spell Checking") ispell-menu-map)) (define-key menu-bar-tools-menu [separator-prog] '("--")) (define-key menu-bar-tools-menu [gdb] - '(menu-item "Debugger (GDB)..." gdb - :help "Debug a program from within Emacs with GDB")) + `(menu-item ,(purecopy "Debugger (GDB)...") gdb + :help ,(purecopy "Debug a program from within Emacs with GDB"))) (define-key menu-bar-tools-menu [shell-on-region] - '(menu-item "Shell Command on Region..." shell-command-on-region + `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region :enable mark-active - :help "Pass marked region to a shell command")) + :help ,(purecopy "Pass marked region to a shell command"))) (define-key menu-bar-tools-menu [shell] - '(menu-item "Shell Command..." shell-command - :help "Invoke a shell command and catch its output")) + `(menu-item ,(purecopy "Shell Command...") shell-command + :help ,(purecopy "Invoke a shell command and catch its output"))) (define-key menu-bar-tools-menu [compile] - '(menu-item "Compile..." compile - :help "Invoke compiler or Make, view compilation errors")) + `(menu-item ,(purecopy "Compile...") compile + :help ,(purecopy "Invoke compiler or Make, view compilation errors"))) (define-key menu-bar-tools-menu [grep] - '(menu-item "Search Files (Grep)..." grep - :help "Search files for strings or regexps (with Grep)")) + `(menu-item ,(purecopy "Search Files (Grep)...") grep + :help ,(purecopy "Search files for strings or regexps (with Grep)"))) ;; The "Help" menu items @@ -1351,50 +1346,50 @@ mail status in mode line")) (defvar menu-bar-describe-menu (make-sparse-keymap "Describe")) (define-key menu-bar-describe-menu [mule-diag] - '(menu-item "Show All of Mule Status" mule-diag - :visible default-enable-multibyte-characters - :help "Display multilingual environment settings")) + `(menu-item ,(purecopy "Show All of Mule Status") mule-diag + :visible (default-value 'enable-multibyte-characters) + :help ,(purecopy "Display multilingual environment settings"))) (define-key menu-bar-describe-menu [describe-coding-system-briefly] - '(menu-item "Describe Coding System (Briefly)" + `(menu-item ,(purecopy "Describe Coding System (Briefly)") describe-current-coding-system-briefly - :visible default-enable-multibyte-characters)) + :visible (default-value 'enable-multibyte-characters))) (define-key menu-bar-describe-menu [describe-coding-system] - '(menu-item "Describe Coding System..." describe-coding-system - :visible default-enable-multibyte-characters)) + `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system + :visible (default-value 'enable-multibyte-characters))) (define-key menu-bar-describe-menu [describe-input-method] - '(menu-item "Describe Input Method..." describe-input-method - :visible default-enable-multibyte-characters - :help "Keyboard layout for specific input method")) + `(menu-item ,(purecopy "Describe Input Method...") describe-input-method + :visible (default-value 'enable-multibyte-characters) + :help ,(purecopy "Keyboard layout for specific input method"))) (define-key menu-bar-describe-menu [describe-language-environment] - (list 'menu-item "Describe Language Environment" - describe-language-environment-map)) + `(menu-item ,(purecopy "Describe Language Environment") + ,describe-language-environment-map)) (define-key menu-bar-describe-menu [separator-desc-mule] '("--")) (define-key menu-bar-describe-menu [list-keybindings] - '(menu-item "List Key Bindings" describe-bindings - :help "Display all current key bindings (keyboard shortcuts)")) + `(menu-item ,(purecopy "List Key Bindings") describe-bindings + :help ,(purecopy "Display all current key bindings (keyboard shortcuts)"))) (define-key menu-bar-describe-menu [describe-current-display-table] - '(menu-item "Describe Display Table" describe-current-display-table - :help "Describe the current display table")) + `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table + :help ,(purecopy "Describe the current display table"))) (define-key menu-bar-describe-menu [describe-face] - '(menu-item "Describe Face..." describe-face - :help "Display the properties of a face")) + `(menu-item ,(purecopy "Describe Face...") describe-face + :help ,(purecopy "Display the properties of a face"))) (define-key menu-bar-describe-menu [describe-variable] - '(menu-item "Describe Variable..." describe-variable - :help "Display documentation of variable/option")) + `(menu-item ,(purecopy "Describe Variable...") describe-variable + :help ,(purecopy "Display documentation of variable/option"))) (define-key menu-bar-describe-menu [describe-function] - '(menu-item "Describe Function..." describe-function - :help "Display documentation of function/command")) + `(menu-item ,(purecopy "Describe Function...") describe-function + :help ,(purecopy "Display documentation of function/command"))) (define-key menu-bar-describe-menu [describe-key-1] - '(menu-item "Describe Key or Mouse Operation..." describe-key + `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key ;; Users typically don't identify keys and menu items... - :help "Display documentation of command bound to a \ -key, a click, or a menu-item")) + :help ,(purecopy "Display documentation of command bound to a \ +key, a click, or a menu-item"))) (define-key menu-bar-describe-menu [describe-mode] - '(menu-item "Describe Buffer Modes" describe-mode - :help "Describe this buffer's major and minor mode")) + `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode + :help ,(purecopy "Describe this buffer's major and minor mode"))) (defvar menu-bar-search-documentation-menu (make-sparse-keymap "Search Documentation")) @@ -1426,79 +1421,79 @@ key, a click, or a menu-item")) (Info-index topic)) (define-key menu-bar-search-documentation-menu [search-documentation-strings] - '(menu-item "Search Documentation Strings..." apropos-documentation + `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation :help - "Find functions and variables whose doc strings match a regexp")) + ,(purecopy "Find functions and variables whose doc strings match a regexp"))) (define-key menu-bar-search-documentation-menu [find-any-object-by-name] - '(menu-item "Find Any Object by Name..." apropos - :help "Find symbols of any kind whose names match a regexp")) + `(menu-item ,(purecopy "Find Any Object by Name...") apropos + :help ,(purecopy "Find symbols of any kind whose names match a regexp"))) (define-key menu-bar-search-documentation-menu [find-option-by-value] - '(menu-item "Find Options by Value..." apropos-value - :help "Find variables whose values match a regexp")) + `(menu-item ,(purecopy "Find Options by Value...") apropos-value + :help ,(purecopy "Find variables whose values match a regexp"))) (define-key menu-bar-search-documentation-menu [find-options-by-name] - '(menu-item "Find Options by Name..." apropos-variable - :help "Find variables whose names match a regexp")) + `(menu-item ,(purecopy "Find Options by Name...") apropos-variable + :help ,(purecopy "Find variables whose names match a regexp"))) (define-key menu-bar-search-documentation-menu [find-commands-by-name] - '(menu-item "Find Commands by Name..." apropos-command - :help "Find commands whose names match a regexp")) + `(menu-item ,(purecopy "Find Commands by Name...") apropos-command + :help ,(purecopy "Find commands whose names match a regexp"))) (define-key menu-bar-search-documentation-menu [sep1] '("--")) (define-key menu-bar-search-documentation-menu [lookup-command-in-manual] - '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node - :help "Display manual section that describes a command")) + `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node + :help ,(purecopy "Display manual section that describes a command"))) (define-key menu-bar-search-documentation-menu [lookup-key-in-manual] - '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node - :help "Display manual section that describes a key")) + `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node + :help ,(purecopy "Display manual section that describes a key"))) (define-key menu-bar-search-documentation-menu [lookup-subject-in-elisp-manual] - '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search - :help "Find description of a subject in Emacs Lisp manual")) + `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search + :help ,(purecopy "Find description of a subject in Emacs Lisp manual"))) (define-key menu-bar-search-documentation-menu [lookup-subject-in-emacs-manual] - '(menu-item "Look Up Subject in User Manual..." emacs-index-search - :help "Find description of a subject in Emacs User manual")) + `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search + :help ,(purecopy "Find description of a subject in Emacs User manual"))) (define-key menu-bar-search-documentation-menu [emacs-terminology] - '(menu-item "Emacs Terminology" search-emacs-glossary - :help "Display the Glossary section of the Emacs manual")) + `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary + :help ,(purecopy "Display the Glossary section of the Emacs manual"))) (defvar menu-bar-manuals-menu (make-sparse-keymap "More Manuals")) (define-key menu-bar-manuals-menu [man] - '(menu-item "Read Man Page..." manual-entry - :help "Man-page docs for external commands and libraries")) + `(menu-item ,(purecopy "Read Man Page...") manual-entry + :help ,(purecopy "Man-page docs for external commands and libraries"))) (define-key menu-bar-manuals-menu [sep2] '("--")) (define-key menu-bar-manuals-menu [order-emacs-manuals] - '(menu-item "Ordering Manuals" view-order-manuals - :help "How to order manuals from the Free Software Foundation")) + `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals + :help ,(purecopy "How to order manuals from the Free Software Foundation"))) (define-key menu-bar-manuals-menu [lookup-subject-in-all-manuals] - '(menu-item "Lookup Subject in all Manuals..." info-apropos - :help "Find description of a subject in all installed manuals")) + `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos + :help ,(purecopy "Find description of a subject in all installed manuals"))) (define-key menu-bar-manuals-menu [other-manuals] - '(menu-item "All Other Manuals (Info)" Info-directory - :help "Read any of the installed manuals")) + `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory + :help ,(purecopy "Read any of the installed manuals"))) (define-key menu-bar-manuals-menu [emacs-lisp-reference] - '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref - :help "Read the Emacs Lisp Reference manual")) + `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref + :help ,(purecopy "Read the Emacs Lisp Reference manual"))) (define-key menu-bar-manuals-menu [emac-lisp-intro] - '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro - :help "Read the Introduction to Emacs Lisp Programming")) + `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro + :help ,(purecopy "Read the Introduction to Emacs Lisp Programming"))) (define-key menu-bar-help-menu [about-gnu-project] - '(menu-item "About GNU" describe-gnu-project - :help "About the GNU System, GNU Project, and GNU/Linux")) + `(menu-item ,(purecopy "About GNU") describe-gnu-project + :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux"))) (define-key menu-bar-help-menu [about-emacs] - '(menu-item "About Emacs" about-emacs - :help "Display version number, copyright info, and basic help")) + `(menu-item ,(purecopy "About Emacs") about-emacs + :help ,(purecopy "Display version number, copyright info, and basic help"))) (define-key menu-bar-help-menu [sep4] '("--")) (define-key menu-bar-help-menu [describe-no-warranty] - '(menu-item "(Non)Warranty" describe-no-warranty - :help "Explain that Emacs has NO WARRANTY")) + `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty + :help ,(purecopy "Explain that Emacs has NO WARRANTY"))) (define-key menu-bar-help-menu [describe-copying] - '(menu-item "Copying Conditions" describe-copying - :help "Show the Emacs license (GPL)")) + `(menu-item ,(purecopy "Copying Conditions") describe-copying + :help ,(purecopy "Show the Emacs license (GPL)"))) (define-key menu-bar-help-menu [getting-new-versions] - '(menu-item "Getting New Versions" describe-distribution - :help "How to get the latest version of Emacs")) + `(menu-item ,(purecopy "Getting New Versions") describe-distribution + :help ,(purecopy "How to get the latest version of Emacs"))) (defun menu-bar-help-extra-packages () "Display help about some additional packages available for Emacs." (interactive) @@ -1509,37 +1504,37 @@ key, a click, or a menu-item")) (define-key menu-bar-help-menu [sep2] '("--")) (define-key menu-bar-help-menu [external-packages] - '(menu-item "External Packages" menu-bar-help-extra-packages - :help "Lisp packages distributed separately for use in Emacs")) + `(menu-item ,(purecopy "External Packages") menu-bar-help-extra-packages + :help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) (define-key menu-bar-help-menu [find-emacs-packages] - '(menu-item "Find Emacs Packages" finder-by-keyword - :help "Find packages and features by keyword")) + `(menu-item ,(purecopy "Find Emacs Packages") finder-by-keyword + :help ,(purecopy "Find packages and features by keyword"))) (define-key menu-bar-help-menu [more-manuals] - (list 'menu-item "More Manuals" menu-bar-manuals-menu)) + `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) (define-key menu-bar-help-menu [emacs-manual] - '(menu-item "Read the Emacs Manual" info-emacs-manual - :help "Full documentation of Emacs features")) + `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual + :help ,(purecopy "Full documentation of Emacs features"))) (define-key menu-bar-help-menu [describe] - (list 'menu-item "Describe" menu-bar-describe-menu)) + `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu)) (define-key menu-bar-help-menu [search-documentation] - (list 'menu-item "Search Documentation" menu-bar-search-documentation-menu)) + `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu)) (define-key menu-bar-help-menu [sep1] '("--")) (define-key menu-bar-help-menu [emacs-psychotherapist] - '(menu-item "Emacs Psychotherapist" doctor - :help "Our doctor will help you feel better")) + `(menu-item ,(purecopy "Emacs Psychotherapist") doctor + :help ,(purecopy "Our doctor will help you feel better"))) (define-key menu-bar-help-menu [send-emacs-bug-report] - '(menu-item "Send Bug Report..." report-emacs-bug - :help "Send e-mail to Emacs maintainers")) + `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug + :help ,(purecopy "Send e-mail to Emacs maintainers"))) (define-key menu-bar-help-menu [emacs-known-problems] - '(menu-item "Emacs Known Problems" view-emacs-problems - :help "Read about known problems with Emacs")) + `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems + :help ,(purecopy "Read about known problems with Emacs"))) (define-key menu-bar-help-menu [emacs-news] - '(menu-item "Emacs News" view-emacs-news - :help "New features of this version")) + `(menu-item ,(purecopy "Emacs News") view-emacs-news + :help ,(purecopy "New features of this version"))) (define-key menu-bar-help-menu [emacs-faq] - '(menu-item "Emacs FAQ" view-emacs-FAQ - :help "Frequently asked (and answered) questions about Emacs")) + `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ + :help ,(purecopy "Frequently asked (and answered) questions about Emacs"))) (defun help-with-tutorial-spec-language () "Use the Emacs tutorial, specifying which language you want." @@ -1547,12 +1542,12 @@ key, a click, or a menu-item")) (help-with-tutorial t)) (define-key menu-bar-help-menu [emacs-tutorial-language-specific] - '(menu-item "Emacs Tutorial (choose language)..." + `(menu-item ,(purecopy "Emacs Tutorial (choose language)...") help-with-tutorial-spec-language - :help "Learn how to use Emacs (choose a language)")) + :help ,(purecopy "Learn how to use Emacs (choose a language)"))) (define-key menu-bar-help-menu [emacs-tutorial] - '(menu-item "Emacs Tutorial" help-with-tutorial - :help "Learn how to use Emacs")) + `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial + :help ,(purecopy "Learn how to use Emacs"))) (defun menu-bar-menu-frame-live-and-visible-p () "Return non-nil if the menu frame is alive and visible. @@ -1690,7 +1685,9 @@ Buffers menu is regenerated." :type 'boolean :group 'menu) -(defvar list-buffers-directory nil) +(defvar list-buffers-directory nil + "String to display in buffer listings for buffers not visiting a file.") +(make-variable-buffer-local 'list-buffers-directory) (defun menu-bar-select-buffer () (interactive) @@ -1867,35 +1864,35 @@ Buffers menu is regenerated." (let ((map minibuffer-local-completion-map)) (define-key map [menu-bar minibuf ?\?] - (list 'menu-item "List Completions" 'minibuffer-completion-help - :help "Display all possible completions")) + `(menu-item ,(purecopy "List Completions") minibuffer-completion-help + :help ,(purecopy "Display all possible completions"))) (define-key map [menu-bar minibuf space] - (list 'menu-item "Complete Word" 'minibuffer-complete-word - :help "Complete at most one word")) + `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word + :help ,(purecopy "Complete at most one word"))) (define-key map [menu-bar minibuf tab] - (list 'menu-item "Complete" 'minibuffer-complete - :help "Complete as far as possible"))) + `(menu-item ,(purecopy "Complete") minibuffer-complete + :help ,(purecopy "Complete as far as possible")))) (let ((map minibuffer-local-map)) (define-key map [menu-bar minibuf quit] - (list 'menu-item "Quit" 'abort-recursive-edit - :help "Abort input and exit minibuffer")) + `(menu-item ,(purecopy "Quit") abort-recursive-edit + :help ,(purecopy "Abort input and exit minibuffer"))) (define-key map [menu-bar minibuf return] - (list 'menu-item "Enter" 'exit-minibuffer - :key-sequence "\r" - :help "Terminate input and exit minibuffer")) + `(menu-item ,(purecopy "Enter") exit-minibuffer + :key-sequence "\r" + :help ,(purecopy "Terminate input and exit minibuffer"))) (define-key map [menu-bar minibuf isearch-forward] - (list 'menu-item "Isearch History Forward" 'isearch-forward - :help "Incrementally search minibuffer history forward")) + `(menu-item ,(purecopy "Isearch History Forward") isearch-forward + :help ,(purecopy "Incrementally search minibuffer history forward"))) (define-key map [menu-bar minibuf isearch-backward] - (list 'menu-item "Isearch History Backward" 'isearch-backward - :help "Incrementally search minibuffer history backward")) + `(menu-item ,(purecopy "Isearch History Backward") isearch-backward + :help ,(purecopy "Incrementally search minibuffer history backward"))) (define-key map [menu-bar minibuf next] - (list 'menu-item "Next History Item" 'next-history-element - :help "Put next minibuffer history element in the minibuffer")) + `(menu-item ,(purecopy "Next History Item") next-history-element + :help ,(purecopy "Put next minibuffer history element in the minibuffer"))) (define-key map [menu-bar minibuf previous] - (list 'menu-item "Previous History Item" 'previous-history-element - :help "Put previous minibuffer history element in the minibuffer"))) + `(menu-item ,(purecopy "Previous History Item") previous-history-element + :help ,(purecopy "Put previous minibuffer history element in the minibuffer")))) ;;;###autoload ;; This comment is taken from tool-bar.el near diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 9ca26b3e943..585cc0a86c6 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,8 @@ +2009-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * mh-comp.el (mh-send-letter): default-buffer-file-coding-system + => (default-value 'buffer-file-coding-system). + 2009-08-10 Bill Wohler <wohler@newt.com> * mh-junk.el (mh-spamassassin-blacklist, mh-bogofilter-blacklist) diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 43a1a482cca..5ae78ef1767 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -276,8 +276,8 @@ message and scan line." '(undecided undecided-unix undecided-dos)))) buffer-file-coding-system (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) - (and (boundp 'default-buffer-file-coding-system ) - default-buffer-file-coding-system) + (and (default-boundp 'buffer-file-coding-system) + (default-value 'buffer-file-coding-system)) 'iso-latin-1)))) ;; Older versions of spost do not support -msgid and -mime. (unless mh-send-uses-spost-flag diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index e43c56ba68f..52a6d787cae 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -529,7 +529,7 @@ font-lock is done highlighting.") (defvar font-lock-auto-fontify) (defvar font-lock-defaults) ; XEmacs -;; Ensure new buffers won't get this mode if default-major-mode is nil. +;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-folder-mode 'mode-class 'special) ;; Autoload cookie needed by desktop.el diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index dcb8d8588e2..051a98de89a 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -277,7 +277,7 @@ searching for `mh-mail-header-separator' in the buffer." ;; Shush compiler. (defvar font-lock-defaults) ; XEmacs -;; Ensure new buffers won't get this mode if default-major-mode is nil. +;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-letter-mode 'mode-class 'special) ;;;###mh-autoload diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 97a9883d558..70852f0bb05 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -825,7 +825,7 @@ operation." ;;; MH-Show Mode -;; Ensure new buffers won't get this mode if default-major-mode is nil. +;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-show-mode 'mode-class 'special) ;; Shush compiler. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e8862eba6d1..8f2de068444 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -30,7 +30,6 @@ ;; (boundaries START . END). See `completion-boundaries'. ;; Any other return value should be ignored (so we ignore values returned ;; from completion tables that don't know about this new `action' form). -;; See `completion-boundaries'. ;;; Bugs: @@ -40,10 +39,21 @@ ;; - choose-completion can't automatically figure out the boundaries ;; corresponding to the displayed completions. `base-size' gives the left ;; boundary, but not the righthand one. So we need to add -;; completion-extra-size (and also completion-no-auto-exit). +;; completion-extra-size. ;;; Todo: +;; - make partial-complete-mode obsolete: +;; - (?) <foo.h> style completion for file names. + +;; - case-sensitivity is currently confuses two issues: +;; - whether or not a particular completion table should be case-sensitive +;; (i.e. whether strings that different only by case are semantically +;; equivalent) +;; - whether the user wants completion to pay attention to case. +;; e.g. we may want to make it possible for the user to say "first try +;; completion case-sensitively, and if that fails, try to ignore case". + ;; - make lisp-complete-symbol and sym-comp use it. ;; - add support for ** to pcm. ;; - Make read-file-name-predicate obsolete. @@ -248,31 +258,38 @@ The text is displayed for `minibuffer-message-timeout' seconds, or until the next input event arrives, whichever comes first. Enclose MESSAGE in [...] if this is not yet the case. If ARGS are provided, then pass MESSAGE through `format'." - ;; Clear out any old echo-area message to make way for our new thing. - (message nil) - (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) - ;; Make sure we can put-text-property. - (copy-sequence message) - (concat " [" message "]"))) - (when args (setq message (apply 'format message args))) - (let ((ol (make-overlay (point-max) (point-max) nil t t)) - ;; A quit during sit-for normally only interrupts the sit-for, - ;; but since minibuffer-message is used at the end of a command, - ;; at a time when the command has virtually finished already, a C-g - ;; should really cause an abort-recursive-edit instead (i.e. as if - ;; the C-g had been typed at top-level). Binding inhibit-quit here - ;; is an attempt to get that behavior. - (inhibit-quit t)) - (unwind-protect - (progn - (unless (zerop (length message)) - ;; The current C cursor code doesn't know to use the overlay's - ;; marker's stickiness to figure out whether to place the cursor - ;; before or after the string, so let's spoon-feed it the pos. - (put-text-property 0 1 'cursor t message)) - (overlay-put ol 'after-string message) - (sit-for (or minibuffer-message-timeout 1000000))) - (delete-overlay ol)))) + (if (not (minibufferp (current-buffer))) + (progn + (if args + (apply 'message message args) + (message "%s" message)) + (prog1 (sit-for (or minibuffer-message-timeout 1000000)) + (message nil))) + ;; Clear out any old echo-area message to make way for our new thing. + (message nil) + (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) + ;; Make sure we can put-text-property. + (copy-sequence message) + (concat " [" message "]"))) + (when args (setq message (apply 'format message args))) + (let ((ol (make-overlay (point-max) (point-max) nil t t)) + ;; A quit during sit-for normally only interrupts the sit-for, + ;; but since minibuffer-message is used at the end of a command, + ;; at a time when the command has virtually finished already, a C-g + ;; should really cause an abort-recursive-edit instead (i.e. as if + ;; the C-g had been typed at top-level). Binding inhibit-quit here + ;; is an attempt to get that behavior. + (inhibit-quit t)) + (unwind-protect + (progn + (unless (zerop (length message)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor t message)) + (overlay-put ol 'after-string message) + (sit-for (or minibuffer-message-timeout 1000000))) + (delete-overlay ol))))) (defun minibuffer-completion-contents () "Return the user input in a minibuffer before point as a string. @@ -296,16 +313,33 @@ the second failed attempt to complete." :group 'minibuffer) (defvar completion-styles-alist - '((basic completion-basic-try-completion completion-basic-all-completions) - (emacs22 completion-emacs22-try-completion completion-emacs22-all-completions) - (emacs21 completion-emacs21-try-completion completion-emacs21-all-completions) + '((emacs21 + completion-emacs21-try-completion completion-emacs21-all-completions + "Simple prefix-based completion.") + (emacs22 + completion-emacs22-try-completion completion-emacs22-all-completions + "Prefix completion that only operates on the text before point.") + (basic + completion-basic-try-completion completion-basic-all-completions + "Completion of the prefix before point and the suffix after point.") (partial-completion - completion-pcm-try-completion completion-pcm-all-completions)) + completion-pcm-try-completion completion-pcm-all-completions + "Completion of multiple words, each one taken as a prefix. +E.g. M-x l-c-h can complete to list-command-history +and C-x C-f /u/m/s to /usr/monnier/src.") + (initials + completion-initials-try-completion completion-initials-all-completions + "Completion of acronyms and initialisms. +E.g. can complete M-x lch to list-command-history +and C-x C-f ~/sew to ~/src/emacs/work.")) "List of available completion styles. -Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS) +Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC): where NAME is the name that should be used in `completion-styles', -TRY-COMPLETION is the function that does the completion, and -ALL-COMPLETIONS is the function that lists the completions.") +TRY-COMPLETION is the function that does the completion (it should +follow the same calling convention as `completion-try-completion'), +ALL-COMPLETIONS is the function that lists the completions (it should +follow the calling convention of `completion-all-completions'), +and DOC describes the way this style of completion works.") (defcustom completion-styles '(basic partial-completion emacs22) "List of completion styles to use. @@ -323,19 +357,10 @@ The return value can be either nil to indicate that there is no completion, t to indicate that STRING is the only possible completion, or a pair (STRING . NEWPOINT) of the completed result string together with a new position for point." - ;; The property `completion-styles' indicates that this functional - ;; completion-table claims to take care of completion styles itself. - ;; [I.e. It will most likely call us back at some point. ] - (if (and (symbolp table) (get table 'completion-styles)) - ;; Extended semantics for functional completion-tables: - ;; They accept a 4th argument `point' and when called with action=nil - ;; and this 4th argument (a position inside `string'), they should - ;; return instead of a string a pair (STRING . NEWPOINT). - (funcall table string pred nil point) - (completion--some (lambda (style) - (funcall (nth 1 (assq style completion-styles-alist)) - string table pred point)) - completion-styles))) + (completion--some (lambda (style) + (funcall (nth 1 (assq style completion-styles-alist)) + string table pred point)) + completion-styles)) (defun completion-all-completions (string table pred point) "List the possible completions of STRING in completion table TABLE. @@ -343,19 +368,12 @@ Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. The return value is a list of completions and may contain the base-size in the last `cdr'." - ;; The property `completion-styles' indicates that this functional - ;; completion-table claims to take care of completion styles itself. - ;; [I.e. It will most likely call us back at some point. ] - (if (and (symbolp table) (get table 'completion-styles)) - ;; Extended semantics for functional completion-tables: - ;; They accept a 4th argument `point' and when called with action=t - ;; and this 4th argument (a position inside `string'), they may - ;; return BASE-SIZE in the last `cdr'. - (funcall table string pred t point) - (completion--some (lambda (style) - (funcall (nth 2 (assq style completion-styles-alist)) - string table pred point)) - completion-styles))) + ;; FIXME: We need to additionally return completion-extra-size (similar + ;; to completion-base-size but for the text after point). + (completion--some (lambda (style) + (funcall (nth 2 (assq style completion-styles-alist)) + string table pred point)) + completion-styles)) (defun minibuffer--bitset (modified completions exact) (logior (if modified 4 0) @@ -528,7 +546,9 @@ Repeated uses step through the possible completions." ;; completion-all-sorted-completions to nil, but we prefer not to, ;; so that repeated calls minibuffer-force-complete still cycle ;; through the previous possible completions. - (setq completion-all-sorted-completions (cdr all))))) + (let ((last (last all))) + (setcdr last (cons (car all) (cdr last))) + (setq completion-all-sorted-completions (cdr all)))))) (defvar minibuffer-confirm-exit-commands '(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word) @@ -872,6 +892,23 @@ the completions buffer." (run-hooks 'completion-setup-hook))) nil) +(defvar completion-annotate-function + nil + ;; Note: there's a lot of scope as for when to add annotations and + ;; what annotations to add. E.g. completing-help.el allowed adding + ;; the first line of docstrings to M-x completion. But there's + ;; a tension, since such annotations, while useful at times, can + ;; actually drown the useful information. + ;; So completion-annotate-function should be used parsimoniously, or + ;; else only used upon a user's request (e.g. we could add a command + ;; to completion-list-mode to add annotations to the current + ;; completions). + "Function to add annotations in the *Completions* buffer. +The function takes a completion and should either return nil, or a string that +will be displayed next to the completion. The function can access the +completion table and predicates via `minibuffer-completion-table' and related +variables.") + (defun minibuffer-completion-help () "Display a list of possible completions of the current minibuffer contents." (interactive) @@ -892,8 +929,15 @@ the completions buffer." ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. (when last (setcdr last nil)) - (display-completion-list (nconc (sort completions 'string-lessp) - base-size)))) + (setq completions (sort completions 'string-lessp)) + (when completion-annotate-function + (setq completions + (mapcar (lambda (s) + (let ((ann + (funcall completion-annotate-function s))) + (if ann (list s ann) s))) + completions))) + (display-completion-list (nconc completions base-size)))) ;; If there are no completions, or if the current input is already the ;; only possible completion, then hide (previous&stale) completions. @@ -998,8 +1042,11 @@ the completions buffer." (if (eq (aref string (1- beg)) ?{) (setq table (apply-partially 'completion-table-with-terminator "}" table))) - (completion-table-with-context - prefix table (substring string beg) pred action))))) + ;; Even if file-name completion is case-insensitive, we want + ;; envvar completion to be case-sensitive. + (let ((completion-ignore-case nil)) + (completion-table-with-context + prefix table (substring string beg) pred action)))))) (defun completion--file-name-table (string pred action) "Internal subroutine for `read-file-name'. Do not call this." @@ -1447,15 +1494,15 @@ or a symbol chosen among `any', `star', `point'." (defun completion-pcm--pattern->regex (pattern &optional group) (let ((re - (concat "\\`" - (mapconcat - (lambda (x) - (case x + (concat "\\`" + (mapconcat + (lambda (x) + (case x ((star any point) (if (if (consp group) (memq x group) group) - "\\(.*?\\)" ".*?")) - (t (regexp-quote x)))) - pattern + "\\(.*?\\)" ".*?")) + (t (regexp-quote x)))) + pattern "")))) ;; Avoid pathological backtracking. (while (string-match "\\.\\*\\?\\(?:\\\\[()]\\)*\\(\\.\\*\\?\\)" re) @@ -1721,6 +1768,44 @@ filter out additional entries (because TABLE migth not obey PRED)." 'completion-pcm--filename-try-filter)) (completion-pcm--merge-try pattern all prefix suffix))) +;;; Initials completion +;; Complete /ums to /usr/monnier/src or lch to list-command-history. + +(defun completion-initials-expand (str table pred) + (unless (or (zerop (length str)) + (string-match completion-pcm--delim-wild-regex str)) + (let ((bounds (completion-boundaries str table pred ""))) + (if (zerop (car bounds)) + (mapconcat 'string str "-") + ;; If there's a boundary, it's trickier. The main use-case + ;; we consider here is file-name completion. We'd like + ;; to expand ~/eee to ~/e/e/e and /eee to /e/e/e. + ;; But at the same time, we don't want /usr/share/ae to expand + ;; to /usr/share/a/e just because we mistyped "ae" for "ar", + ;; so we probably don't want initials to touch anything that + ;; looks like /usr/share/foo. As a heuristic, we just check that + ;; the text before the boundary char is at most 1 char. + ;; This allows both ~/eee and /eee and not much more. + ;; FIXME: It sadly also disallows the use of ~/eee when that's + ;; embedded within something else (e.g. "(~/eee" in Info node + ;; completion or "ancestor:/eee" in bzr-revision completion). + (when (< (car bounds) 3) + (let ((sep (substring str (1- (car bounds)) (car bounds)))) + ;; FIXME: the above string-match checks the whole string, whereas + ;; we end up only caring about the after-boundary part. + (concat (substring str 0 (car bounds)) + (mapconcat 'string (substring str (car bounds)) sep)))))))) + +(defun completion-initials-all-completions (string table pred point) + (let ((newstr (completion-initials-expand string table pred))) + (when newstr + (completion-pcm-all-completions newstr table pred (length newstr))))) + +(defun completion-initials-try-completion (string table pred point) + (let ((newstr (completion-initials-expand string table pred))) + (when newstr + (completion-pcm-try-completion newstr table pred (length newstr))))) + (provide 'minibuffer) diff --git a/lisp/mouse.el b/lisp/mouse.el index 168a82e1742..dd3edbb13ae 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -158,7 +158,8 @@ items `Turn Off' and `Help'." (list (completing-read "Minor mode indicator: " (describe-minor-mode-completion-table-for-indicator)))) - (let ((minor-mode (lookup-minor-mode-from-indicator indicator))) + (let* ((minor-mode (lookup-minor-mode-from-indicator indicator)) + (mm-fun (or (get minor-mode :minor-mode-function) minor-mode))) (unless minor-mode (error "Cannot find minor mode for `%s'" indicator)) (let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist))) (menu (and (keymapp map) (lookup-key map [menu-bar])))) @@ -167,10 +168,10 @@ items `Turn Off' and `Help'." (mouse-menu-non-singleton menu) `(keymap ,indicator - (turn-off menu-item "Turn Off minor mode" ,minor-mode) + (turn-off menu-item "Turn Off minor mode" ,mm-fun) (help menu-item "Help for minor mode" (lambda () (interactive) - (describe-function ',minor-mode)))))) + (describe-function ',mm-fun)))))) (popup-menu menu)))) (defun mouse-minor-mode-menu (event) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 37980279a28..ad500443b3e 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -41,16 +41,16 @@ (require 'custom) (require 'timer) +(defvar mouse-wheel-mode) + ;; Setter function for mouse-button user-options. Switch Mouse Wheel ;; mode off and on again so that the old button is unbound and ;; new button is bound to mwheel-scroll. (defun mouse-wheel-change-button (var button) - (let ((active mouse-wheel-mode)) - ;; Deactivate before changing the setting. - (when active (mouse-wheel-mode -1)) - (set-default var button) - (when active (mouse-wheel-mode 1)))) + (set-default var button) + ;; Sync the bindings. + (when (bound-and-true-p mouse-wheel-mode) (mouse-wheel-mode 1))) (defvar mouse-wheel-down-button 4) (make-obsolete-variable 'mouse-wheel-down-button @@ -131,7 +131,8 @@ less than a full screen." (choice :tag "scroll amount" (const :tag "Full screen" :value nil) (integer :tag "Specific # of lines") - (float :tag "Fraction of window")))))) + (float :tag "Fraction of window"))))) + :set 'mouse-wheel-change-button) (defcustom mouse-wheel-progressive-speed t "If non-nil, the faster the user moves the wheel, the faster the scrolling. @@ -239,35 +240,36 @@ This should only be bound to mouse buttons 4 and 5." (run-with-timer mouse-wheel-inhibit-click-time nil 'mwheel-inhibit-click-timeout)))) -;;;###autoload +(defvar mwheel-installed-bindings nil) + +;; preloaded ;;;###autoload (define-minor-mode mouse-wheel-mode "Toggle mouse wheel support. With prefix argument ARG, turn on if positive, otherwise off. Return non-nil if the new state is enabled." + :init-value t + ;; We'd like to use custom-initialize-set here so the setup is done + ;; before dumping, but at the point where the defcustom is evaluated, + ;; the corresponding function isn't defined yet, so + ;; custom-initialize-set signals an error. + :initialize 'custom-initialize-delay :global t :group 'mouse - (let* ((dn mouse-wheel-down-event) - (up mouse-wheel-up-event) - (keys - (nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)]) - mouse-wheel-scroll-amount) - (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,dn)]) - mouse-wheel-scroll-amount)))) - ;; This condition-case is here because Emacs 19 will throw an error - ;; if you try to define a key that it does not know about. I for one - ;; prefer to just unconditionally do a mwheel-install in my .emacs, so - ;; that if the wheeled-mouse is there, it just works, and this way it - ;; doesn't yell at me if I'm on my laptop or another machine, etc. - (condition-case () - (dolist (key keys) - (cond (mouse-wheel-mode - (global-set-key key 'mwheel-scroll)) - ((eq (lookup-key (current-global-map) key) 'mwheel-scroll) - (global-unset-key key)))) - (error nil)))) + ;; Remove previous bindings, if any. + (while mwheel-installed-bindings + (let ((key (pop mwheel-installed-bindings))) + (when (eq (lookup-key (current-global-map) key) 'mwheel-scroll) + (global-unset-key key)))) + ;; Setup bindings as needed. + (when mouse-wheel-mode + (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) + (dolist (key (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,event)]) + mouse-wheel-scroll-amount)) + (global-set-key key 'mwheel-scroll) + (push key mwheel-installed-bindings))))) ;;; Compatibility entry point -;;;###autoload +;; preloaded ;;;###autoload (defun mwheel-install (&optional uninstall) "Enable mouse wheel support." (mouse-wheel-mode (if uninstall -1 1))) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 2c20e8c94d8..fd7b83900d4 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1,7 +1,8 @@ ;;; ange-ftp.el --- transparent FTP support for GNU Emacs ;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Andy Norman (ange@hplb.hpl.hp.com) ;; Maintainer: FSF @@ -1967,16 +1968,10 @@ on the gateway machine to do the FTP instead." (accept-process-output proc) ;wait for ftp startup message proc)) -(put 'internal-ange-ftp-mode 'mode-class 'special) - -(defun internal-ange-ftp-mode () +(define-derived-mode internal-ange-ftp-mode comint-mode "Internal Ange-ftp" "Major mode for interacting with the FTP process. \\{comint-mode-map}" - (interactive) - (delay-mode-hooks (comint-mode)) - (setq major-mode 'internal-ange-ftp-mode) - (setq mode-name "Internal Ange-ftp") (make-local-variable 'ange-ftp-process-string) (setq ange-ftp-process-string "") (make-local-variable 'ange-ftp-process-busy) @@ -2000,8 +1995,7 @@ on the gateway machine to do the FTP instead." ;; ange-ftp has its own ways of handling passwords. (setq comint-password-prompt-regexp "\\`a\\`") (make-local-variable 'paragraph-start) - (setq paragraph-start comint-prompt-regexp) - (run-mode-hooks 'internal-ange-ftp-mode-hook)) + (setq paragraph-start comint-prompt-regexp)) (defcustom ange-ftp-raw-login nil "Use raw FTP commands for login, if account password is not nil. @@ -3220,7 +3214,7 @@ system TYPE.") ;; regardless. Maybe a system-type to host-type lookup? (binary (or (ange-ftp-binary-file filename) (and (not (memq system-type - '(ms-dos windows-nt macos vax-vms))) + '(ms-dos windows-nt))) (memq (ange-ftp-host-type host user) '(unix dumb-unix))))) (cmd (if append 'append 'put)) @@ -4171,7 +4165,10 @@ COMPRESSING should be t if the specified file should be compressed, and nil if it should be uncompressed (that is, if it is a compressed file). NEWNAME should be the name to give the new compressed or uncompressed file.") +(declare-function dired-compress-file "dired-aux" (file)) + (defun ange-ftp-dired-compress-file (name) + "Handler used by `dired-compress-file'." (let ((parsed (ange-ftp-ftp-name name)) conversion-func) (if (and parsed diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 992a081fefd..6f180341f36 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -699,7 +699,7 @@ interactively. Turn the filename into a URL with function (defun browse-url-file-url (file) "Return the URL corresponding to FILE. Use variable `browse-url-filename-alist' to map filenames to URLs." - (let ((coding (and default-enable-multibyte-characters + (let ((coding (and (default-value 'enable-multibyte-characters) (or file-name-coding-system default-file-name-coding-system)))) (if coding (setq file (encode-coding-string file coding)))) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index ccda21a2d22..6f829c6f709 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -493,13 +493,26 @@ The result is either a string, or `nil' if there is no name owner." bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "GetNameOwner" service))) -(defun dbus-ping (bus service) - "Check whether SERVICE is registered for D-Bus BUS." +(defun dbus-ping (bus service &optional timeout) + "Check whether SERVICE is registered for D-Bus BUS. +TIMEOUT, a nonnegative integer, specifies the maximum number of +milliseconds `dbus-ping' must return. The default value is 25,000. + +Note, that this autoloads SERVICE if it is not running yet. If +it shall be checked whether SERVICE is already running, one shall +apply + + \(member service \(dbus-list-known-names bus))" ;; "Ping" raises a D-Bus error if SERVICE does not exist. ;; Otherwise, it returns silently with `nil'. (condition-case nil (not - (dbus-call-method bus service dbus-path-dbus dbus-interface-peer "Ping")) + (if (natnump timeout) + (dbus-call-method + bus service dbus-path-dbus dbus-interface-peer + "Ping" :timeout timeout) + (dbus-call-method + bus service dbus-path-dbus dbus-interface-peer "Ping"))) (dbus-error nil))) diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 96f03661463..c3b5db19a4c 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -4,7 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> -;; Keywords: DNS BIND dig +;; Keywords: DNS BIND dig comm ;; This file is part of GNU Emacs. @@ -68,10 +68,10 @@ If nil, use system defaults." query-type query-class query-option dig-option server) "Call dig with given arguments and return buffer containing output. -DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string -with a DNS type. QUERY-CLASS is an optional string with a DNS class. -QUERY-OPTION is an optional string with dig \"query options\". -DIG-OPTIONS is an optional string with parameters for the dig program. +DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional +string with a DNS type. QUERY-CLASS is an optional string with a DNS +class. QUERY-OPTION is an optional string with dig \"query options\". +DIG-OPTION is an optional string with parameters for the dig program. SERVER is an optional string with a domain name server to query. Dig is an external program found in the BIND name server distribution, @@ -136,29 +136,23 @@ Buffer should contain output generated by `dig-invoke'." (define-key dig-mode-map "q" 'dig-exit)) -(defun dig-mode () +(define-derived-mode dig-mode nil "Dig" "Major mode for displaying dig output." - (interactive) - (kill-all-local-variables) - (setq mode-name "dig") - (setq major-mode 'dig-mode) - (use-local-map dig-mode-map) (buffer-disable-undo) (unless (featurep 'xemacs) (set (make-local-variable 'font-lock-defaults) '(dig-font-lock-keywords t))) (when (featurep 'font-lock) + ;; FIXME: what is this for?? --Stef (font-lock-set-defaults)) - (save-current-buffer - (if (fboundp 'run-mode-hooks) - (run-mode-hooks 'dig-mode-hook) - (run-hooks 'dig-mode-hook)))) + ) (defun dig-exit () "Quit dig output buffer." (interactive) (kill-buffer (current-buffer))) +;;;###autoload (defun dig (domain &optional query-type query-class query-option dig-option server) "Query addresses of a DOMAIN using dig, by calling `dig-invoke'. @@ -177,9 +171,9 @@ Optional arguments are passed to `dig-invoke'." (defun query-dig (domain &optional query-type query-class query-option dig-option server) "Query addresses of a DOMAIN using dig. -It works by calling `dig-invoke' and `dig-extract-rr'. Optional -arguments are passed to `dig-invoke' and `dig-extract-rr'. Returns -nil for domain/class/type queries that results in no data." +It works by calling `dig-invoke' and `dig-extract-rr'. +Optional arguments are passed to `dig-invoke' and `dig-extract-rr'. +Returns nil for domain/class/type queries that result in no data." (let ((buffer (dig-invoke domain query-type query-class query-option dig-option server))) (when buffer diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 86a7db15077..d65f0f12423 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -1,7 +1,7 @@ ;;; eudc-bob.el --- Binary Objects Support for EUDC -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> @@ -46,20 +46,20 @@ (defvar eudc-bob-mail-keymap nil "Keymap for inline e-mail addresses.") -(defconst eudc-bob-generic-menu +(defvar eudc-bob-generic-menu '("EUDC Binary Object Menu" ["---" nil nil] ["Pipe to external program" eudc-bob-pipe-object-to-external-program t] ["Save object" eudc-bob-save-object t])) -(defconst eudc-bob-image-menu +(defvar eudc-bob-image-menu `("EUDC Image Menu" ["---" nil nil] ["Toggle inline display" eudc-bob-toggle-inline-display (eudc-bob-can-display-inline-images)] ,@(cdr (cdr eudc-bob-generic-menu)))) -(defconst eudc-bob-sound-menu +(defvar eudc-bob-sound-menu `("EUDC Sound Menu" ["---" nil nil] ["Play sound" eudc-bob-play-sound-at-point @@ -252,7 +252,7 @@ display a button." (car (cdr viewer)) (cdr (cdr viewer))) (call-process-region (point-min) (point-max) program))) - (t + (error (kill-buffer buffer))))) (defun eudc-bob-menu () @@ -317,6 +317,8 @@ display a button." (set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap) (set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap) +;; If the first arguments can be nil here, then these 3 can be +;; defconsts once more. (when (not (featurep 'xemacs)) (easy-menu-define eudc-bob-generic-menu eudc-bob-generic-keymap diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 6494e01f739..be3654728d8 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1,7 +1,7 @@ ;;; eudc.el --- Emacs Unified Directory Client -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> @@ -931,7 +931,7 @@ see `eudc-inline-expansion-servers'" (or (and (equal eudc-server eudc-former-server) (equal eudc-protocol eudc-former-protocol)) (eudc-set-server eudc-former-server eudc-former-protocol t))) - (t + (error (or (and (equal eudc-server eudc-former-server) (equal eudc-protocol eudc-former-protocol)) (eudc-set-server eudc-former-server eudc-former-protocol t)) diff --git a/lisp/net/imap-hash.el b/lisp/net/imap-hash.el new file mode 100644 index 00000000000..5e53ddbb08b --- /dev/null +++ b/lisp/net/imap-hash.el @@ -0,0 +1,372 @@ +;;; imap-hash.el --- Hashtable-like interface to an IMAP mailbox + +;; Copyright (C) 2009 Free Software Foundation, Inc. + +;; Author: Teodor Zlatanov <tzz@lifelogs.com> +;; Keywords: mail + +;; This program 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 of the License, or +;; (at your option) any later version. + +;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module provides hashtable-like functions on top of imap.el +;; functionality. All the authentication is handled by auth-source so +;; there are no authentication options here, only the server and +;; mailbox names are needed. + +;; Create a IHT (imap-hash table) object with `imap-hash-make'. Then +;; use it with `imap-hash-map' to map a function across all the +;; messages. Use `imap-hash-get' and `imap-hash-rem' to operate on +;; individual messages. See the tramp-imap.el library in Tramp if you +;; need to see practical examples. + +;; This only works with IMAP4r1. Sorry to everyone without it, but +;; the compatibility code is too annoying and it's 2009. + +;; TODO: Use SEARCH instead of FETCH when a test is specified. List +;; available mailboxes. Don't select an invalid mailbox. + +;;; Code: + +(require 'assoc) +(require 'imap) +(require 'sendmail) ; for mail-header-separator +(require 'message) +(autoload 'auth-source-user-or-password "auth-source") + +;; retrieve these headers +(defvar imap-hash-headers + (append '(Subject From Date Message-Id References In-Reply-To Xref))) + +;; from nnheader.el +(defsubst imap-hash-remove-cr-followed-by-lf () + (goto-char (point-max)) + (while (search-backward "\r\n" nil t) + (delete-char 1))) + +;; from nnheader.el +(defun imap-hash-ms-strip-cr (&optional string) + "Strip ^M from the end of all lines in current buffer or STRING." + (if string + (with-temp-buffer + (insert string) + (imap-hash-remove-cr-followed-by-lf) + (buffer-string)) + (save-excursion + (imap-hash-remove-cr-followed-by-lf)))) + +(defun imap-hash-make (server port mailbox &optional user password ssl) + "Makes a new imap-hash object using SERVER, PORT, and MAILBOX. +SSL, USER, PASSWORD are optional. +The test is set to t, meaning all messages are considered." + (when (and server port mailbox) + (list :server server :port port :mailbox mailbox + :ssl ssl :user user :password password + :test t))) + +(defun imap-hash-p (iht) + "Checks whether IHT is a valid imap-hash." + (and + (imap-hash-server iht) + (imap-hash-port iht) + (imap-hash-mailbox iht) + (imap-hash-test iht))) + +(defmacro imap-hash-gather (uid) + `(imap-message-get ,uid 'BODYDETAIL)) + +(defmacro imap-hash-data-body (details) + `(nth 2 (nth 1 ,details))) + +(defmacro imap-hash-data-headers (details) + `(nth 2 (nth 0 ,details))) + +(defun imap-hash-get (key iht &optional refetch) + "Get the value for KEY in the imap-hash IHT. +Requires either `imap-hash-fetch' to be called beforehand +(e.g. by `imap-hash-map'), or REFETCH to be t. +Returns a list of the headers (an alist, see `imap-hash-map') and +the body of the message as a string. +Also see `imap-hash-test'." + (with-current-buffer (imap-hash-get-buffer iht) + (when refetch + (imap-hash-fetch iht nil key)) + (let ((details (imap-hash-gather key))) + (list + (imap-hash-get-headers + (imap-hash-data-headers details)) + (imap-hash-get-body + (imap-hash-data-body details)))))) + +(defun imap-hash-put (value iht &optional key) + "Put VALUE in the imap-hash IHT. Returns the new key. +If KEY is given, removes it. +VALUE can be a list of the headers (an alist, see `imap-hash-map') +and the body of the message as a string. It can also be a uid, +in which case `imap-hash-get' will be called to get the value. +Also see `imap-hash-test'." + (let ((server-buffer (imap-hash-get-buffer iht)) + (value (if (listp value) value (imap-hash-get value iht))) + newuid) + (when value + (with-temp-buffer + (funcall 'imap-hash-make-message + (nth 0 value) + (nth 1 value) + nil) + (setq newuid (nth 1 (imap-message-append + (imap-hash-mailbox iht) + (current-buffer) nil nil server-buffer))) + (when key (imap-hash-rem key iht)))) + newuid)) + +(defun imap-hash-make-message (headers body &optional overrides) + "Make a message with HEADERS and BODY suitable for `imap-append', +using `message-setup'.. +Look in the alist OVERRIDES for header overrides as per `imap-hash-headers'." + ;; don't insert a signature no matter what + (let (message-signature) + (message-setup + (append overrides headers)) + (message-generate-headers message-required-mail-headers) + (message-remove-header "X-Draft-From") + (message-goto-body) + (insert (or (aget overrides 'body) + body + "")) + (goto-char (point-min)) + ;; TODO: make this search better + (if (search-forward mail-header-separator nil t) + (delete-region (line-beginning-position) (line-end-position)) + (error "Could not find the body separator in the encoded message!")))) + +(defun imap-hash-rem (key iht) + "Remove KEY in the imap-hash IHT. +Also see `imap-hash-test'. Requires `imap-hash-fetch' to have +been called and the imap-hash server buffer to be current, +so it's best to use it inside `imap-hash-map'. +The key will not be found on the next `imap-hash-map' call." + (with-current-buffer (imap-hash-get-buffer iht) + (imap-message-flags-add + (imap-range-to-message-set (list key)) + "\\Deleted" 'silent) + (imap-mailbox-expunge t))) + +(defun imap-hash-clear (iht) + "Remove all keys in the imap-hash IHT. +Also see `imap-hash-test'." + (imap-hash-map (lambda (uid b c) (imap-hash-rem uid iht)) iht)) + +(defun imap-hash-get-headers (text-headers) + (with-temp-buffer + (insert (or text-headers "")) + (imap-hash-remove-cr-followed-by-lf) + (mapcar (lambda (header) + (cons header + (message-fetch-field (format "%s" header)))) + imap-hash-headers))) + +(defun imap-hash-get-body (text) + (with-temp-buffer + (insert (or text "")) + (imap-hash-remove-cr-followed-by-lf) + (buffer-string))) + +(defun imap-hash-map (function iht &optional headers-only &rest messages) + "Call FUNCTION for all entries in IHT and pass it the message uid, +the headers (an alist, see `imap-hash-headers'), and the body +contents as a string. If HEADERS-ONLY is not nil, the body will be nil. +Returns results of evaluating, as would `mapcar'. +If MESSAGES are given, iterate only over those UIDs. +Also see `imap-hash-test'." + (imap-hash-fetch iht headers-only) + (let ((test (imap-hash-test iht))) + (with-current-buffer (imap-hash-get-buffer iht) + (delq nil + (imap-message-map (lambda (message ignored-parameter) + (let* ((details (imap-hash-gather message)) + (headers (imap-hash-data-headers details)) + (hlist (imap-hash-get-headers headers)) + (runit (cond + ((stringp test) + (string-match + test + (format "%s" (aget hlist 'Subject)))) + ((functionp test) + (funcall test hlist)) + ;; otherwise, return test itself + (t test)))) + ;;(debug message headers) + (when runit + (funcall function + message + (imap-hash-get-headers + headers) + (imap-hash-get-body + (imap-hash-data-body details)))))) + "UID"))))) + +(defun imap-hash-count (iht) + "Counts the number of messages in the imap-hash IHT. +Also see `imap-hash-test'. It uses `imap-hash-map' so just use that +function if you want to do more than count the elements." + (length (imap-hash-map (lambda (a b c)) iht t))) + +(defalias 'imap-hash-size 'imap-hash-count) + +(defun imap-hash-test (iht) + "Returns the test used by `imap-hash-map' for IHT. +When the test is t, any key will be a candidate. +When the test is a string, messages will be filtered on that string as a regexp +against the subject. +When the test is a function, messages will be filtered with it. +The function is passed the message headers (see `imap-hash-get-headers')." + (plist-get iht :test)) + +(defun imap-hash-server (iht) + "Returns the server used by the imap-hash IHT." + (plist-get iht :server)) + +(defun imap-hash-port (iht) + "Returns the port used by the imap-hash IHT." + (plist-get iht :port)) + +(defun imap-hash-ssl (iht) + "Returns the SSL need for the imap-hash IHT." + (plist-get iht :ssl)) + +(defun imap-hash-mailbox (iht) + "Returns the mailbox used by the imap-hash IHT." + (plist-get iht :mailbox)) + +(defun imap-hash-user (iht) + "Returns the username used by the imap-hash IHT." + (plist-get iht :user)) + +(defun imap-hash-password (iht) + "Returns the password used by the imap-hash IHT." + (plist-get iht :password)) + +(defun imap-hash-open-connection (iht) + "Open the connection used for IMAP interactions with the imap-hash IHT." + (let* ((server (imap-hash-server iht)) + (port (imap-hash-port iht)) + (ssl-need (imap-hash-ssl iht)) + (auth-need (not (and (imap-hash-user iht) + (imap-hash-password iht)))) + ;; this will not be needed if auth-need is t + (auth-info (when auth-need + (auth-source-user-or-password + '("login" "password") + server port))) + (auth-user (or (imap-hash-user iht) + (nth 0 auth-info))) + (auth-passwd (or (imap-hash-password iht) + (nth 1 auth-info))) + (imap-logout-timeout nil)) + + ;; (debug "opening server: opened+state" (imap-opened) imap-state) + ;; this is the only place where IMAP vs IMAPS matters + (if (imap-open server port (if ssl-need 'ssl nil) nil (current-buffer)) + (progn + ;; (debug "after opening server: opened+state" (imap-opened (current-buffer)) imap-state) + ;; (debug "authenticating" auth-user auth-passwd) + (if (not (imap-capability 'IMAP4rev1)) + (error "IMAP server does not support IMAP4r1, it won't work, sorry.") + (imap-authenticate auth-user auth-passwd) + (imap-id) + ;; (debug "after authenticating: opened+state" (imap-opened (current-buffer)) imap-state) + (imap-opened (current-buffer)))) + (error "Could not open the IMAP buffer")))) + +(defun imap-hash-get-buffer (iht) + "Get or create the connection buffer to be used for the imap-hash IHT." + (let* ((name (imap-hash-buffer-name iht)) + (buffer (get-buffer name))) + (if (and buffer (imap-opened buffer)) + buffer + (when buffer (kill-buffer buffer)) + (with-current-buffer (get-buffer-create name) + (setq buffer-undo-list t) + (when (imap-hash-open-connection iht) + (current-buffer)))))) + +(defun imap-hash-buffer-name (iht) + "Get the connection buffer to be used for the imap-hash IHT." + (when (imap-hash-p iht) + (let ((server (imap-hash-server iht)) + (port (imap-hash-port iht)) + (ssl-text (if (imap-hash-ssl iht) "SSL" "NoSSL"))) + (format "*imap-hash/%s:%s:%s*" server port ssl-text)))) + +(defun imap-hash-fetch (iht &optional headers-only &rest messages) + "Fetch all the messages for imap-hash IHT. +Get only the headers if HEADERS-ONLY is not nil." + (with-current-buffer (imap-hash-get-buffer iht) + (let ((range (if messages + (list + (imap-range-to-message-set messages) + (imap-range-to-message-set messages)) + '("1:*" . "1,*:*")))) + + ;; (with-current-buffer "*imap-debug*" + ;; (erase-buffer)) + (imap-mailbox-unselect) + (imap-mailbox-select (imap-hash-mailbox iht)) + ;; (debug "after selecting mailbox: opened+state" (imap-opened) imap-state) + ;; (setq imap-message-data (make-vector imap-message-prime 0) + (imap-fetch-safe range + (concat (format "(UID RFC822.SIZE BODY %s " + (if headers-only "" "BODY.PEEK[TEXT]")) + (format "BODY.PEEK[HEADER.FIELDS %s])" + imap-hash-headers)))))) + +(provide 'imap-hash) +;;; imap-hash.el ends here + +;; ignore, for testing only + +;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "INBOX.test")) +;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "test")) +;;; (imap-hash-make "server1" "INBOX.mailbox2") +;;; (imap-hash-p iht) +;;; (imap-hash-get 35 iht) +;;; (imap-hash-get 38 iht) +;;; (imap-hash-get 37 iht t) +;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("*imap-debug*" "*imap-log*")) +;;; (imap-hash-put (imap-hash-get 5 iht) iht) +;;; (with-current-buffer (imap-hash-get-buffer iht) (let ((uid (imap-hash-put (imap-hash-get 5 iht) iht))) (imap-hash-put uid iht uid))) +;;; (imap-hash-put (imap-hash-get 35 iht) iht) +;;; (imap-hash-make-message '((Subject . "normal")) "normal body") +;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "new"))) +;;; (imap-hash-make-message '((Subject . "old")) "old body" '((body . "new body")) (lambda (subject) (concat "overwrite-" subject))) +;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "change this")) (lambda (subject) (concat "overwrite-" subject))) +;;; (imap-hash-make-message '((Subject . "Twelcome")) "body here" nil) +;; (with-current-buffer (imap-hash-get-buffer iht) (imap-hash-rem (imap-hash-put (imap-hash-get 5 iht) iht) iht)) +;;; (kill-buffer (imap-hash-buffer-name iht)) +;;; (imap-hash-map 'debug iht) +;;; (imap-hash-map 'debug iht t) +;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome") +;;;(imap-hash-count iht) +;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("*imap-debug*" "*imap-log*")) +;;; (kill-buffer (imap-hash-buffer-name iht)) +;;; this should always return t if the server is up, automatically reopening if needed +;;; (imap-opened (imap-hash-get-buffer iht)) +;;; (imap-hash-buffer-name iht) +;;; (with-current-buffer (imap-hash-get-buffer iht) (debug "mailbox data, auth and state" imap-mailbox-data imap-auth imap-state)) +;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome") +;;; (imap-hash-fetch iht nil) +;;; (imap-hash-fetch iht t) +;;; (imap-hash-fetch iht nil 1 2 3) +;;; (imap-hash-fetch iht t 1 2 3) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 88e897fa32e..ea1c8870bac 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -380,6 +380,7 @@ basis.") (defvar imap-port nil) (defvar imap-username nil) (defvar imap-password nil) +(defvar imap-last-authenticator nil) (defvar imap-calculate-literal-size-first nil) (defvar imap-state 'closed "IMAP state. @@ -872,25 +873,26 @@ Returns t if login was successful, nil otherwise." (while (or (not user) (not passwd)) (setq user (or imap-username (read-from-minibuffer - (concat "IMAP username for " imap-server + (concat "imap: username for " imap-server " (using stream `" (symbol-name imap-stream) "'): ") (or user imap-default-user)))) (setq passwd (or imap-password (read-passwd - (concat "IMAP password for " user "@" + (concat "imap: password for " user "@" imap-server " (using authenticator `" (symbol-name imap-auth) "'): ")))) (when (and user passwd) (if (funcall loginfunc user passwd) (progn + (message "imap: Login successful...") (setq ret t imap-username user) (when (and (not imap-password) (or imap-store-password - (y-or-n-p "Store password for this session? "))) + (y-or-n-p "imap: Store password for this IMAP session? "))) (setq imap-password passwd))) - (message "Login failed...") + (message "imap: Login failed...") (setq passwd nil) (setq imap-password nil) (sit-for 1)))) @@ -1160,7 +1162,10 @@ necessary. If nil, the buffer name is generated." buffer (buffer-name buffer)))) (kill-buffer buffer) - (rename-buffer name)) + (rename-buffer name) + ;; set the passed buffer to the current one, + ;; so that (imap-opened buffer) later will work + (setq buffer (current-buffer))) (message "imap: Reconnecting with stream `%s'...done" stream) (setq imap-stream stream) @@ -1173,6 +1178,7 @@ necessary. If nil, the buffer name is generated." (setq streams nil)))))) (when (imap-opened buffer) (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) + ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer) (when imap-stream buffer)))) @@ -1217,25 +1223,32 @@ password is remembered in the buffer." (eq imap-state 'examine)) (make-local-variable 'imap-username) (make-local-variable 'imap-password) - (if user (setq imap-username user)) - (if passwd (setq imap-password passwd)) + (make-local-variable 'imap-last-authenticator) + (when user (setq imap-username user)) + (when passwd (setq imap-password passwd)) (if imap-auth - (and (funcall (nth 2 (assq imap-auth - imap-authenticator-alist)) (current-buffer)) + (and (setq imap-last-authenticator + (assq imap-auth imap-authenticator-alist)) + (funcall (nth 2 imap-last-authenticator) (current-buffer)) (setq imap-state 'auth)) ;; Choose authenticator. (let ((auths imap-authenticators) auth) (while (setq auth (pop auths)) ;; OK to use authenticator? - (when (funcall (nth 1 (assq auth imap-authenticator-alist)) (current-buffer)) + (setq imap-last-authenticator + (assq auth imap-authenticator-alist)) + (when (funcall (nth 1 imap-last-authenticator) (current-buffer)) (message "imap: Authenticating to `%s' using `%s'..." imap-server auth) (setq imap-auth auth) - (if (funcall (nth 2 (assq auth imap-authenticator-alist)) (current-buffer)) + (if (funcall (nth 2 imap-last-authenticator) (current-buffer)) (progn (message "imap: Authenticating to `%s' using `%s'...done" imap-server auth) + ;; set imap-state correctly on successful auth attempt + (setq imap-state 'auth) + ;; stop iterating through the authenticator list (setq auths nil)) (message "imap: Authenticating to `%s' using `%s'...failed" imap-server auth))))) @@ -1689,7 +1702,7 @@ is non-nil return these properties." propname))) (defun imap-message-map (func propname &optional buffer) - "Map a function across each mailbox in `imap-message-data', returning a list." + "Map a function across each message in `imap-message-data', returning a list." (with-current-buffer (or buffer (current-buffer)) (let (result) (mapatoms @@ -2004,10 +2017,11 @@ on failure." (imap-send-command-1 cmdstr) (setq cmdstr nil) (unwind-protect - (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) - (setq command nil) ;; abort command if no cont-req - (setq command (cons (funcall cmd imap-continuation) - command))) + (setq command + (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) + nil ;; abort command if no cont-req + (cons (funcall cmd imap-continuation) + command))) (setq imap-continuation nil))) (t (error "Unknown command type")))) @@ -2021,7 +2035,7 @@ on failure." (while (and (null imap-continuation) (memq (process-status imap-process) '(open run)) (< imap-reached-tag tag)) - (let ((len (/ (point-max) 1024)) + (let ((len (/ (buffer-size) 1024)) message-log-max) (unless (< len 10) (setq imap-have-messaged t) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 68afee6a1a2..20b41aeded4 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -524,8 +524,7 @@ an alist of attribute/value pairs." (equal "" filter)) (error "No search filter")) (setq filter (cons filter attributes)) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (erase-buffer) (if (and host (not (equal "" host))) @@ -597,8 +596,7 @@ an alist of attribute/value pairs." ;; Do not try to open non-existent files (if (equal value "") (setq value " ") - (save-excursion - (set-buffer bufval) + (with-current-buffer bufval (erase-buffer) (set-buffer-multibyte nil) (insert-file-contents-literally value) @@ -607,9 +605,9 @@ an alist of attribute/value pairs." (setq record (cons (list name value) record)) (forward-line 1)) - (setq result (cons (if withdn - (cons dn (nreverse record)) - (nreverse record)) result)) + (push (if withdn + (cons dn (nreverse record)) + (nreverse record)) result) (setq record nil) (skip-chars-forward " \t\n") (message "Parsing results... %d" numres) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index f295803ff50..9fe105d4641 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -1,7 +1,7 @@ ;;; net-utils.el --- network functions -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Created: Sun Mar 16 1997 @@ -372,28 +372,28 @@ This variable is only used if the variable (display-buffer buffer-name)) ;;;###autoload -(defun ifconfig () - "Run ifconfig and display diagnostic output." - (interactive) - (net-utils-run-simple - (format "*%s*" ifconfig-program) - ifconfig-program +(defun ifconfig () + "Run ifconfig and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" ifconfig-program) + ifconfig-program ifconfig-program-options)) (defalias 'ipconfig 'ifconfig) ;;;###autoload -(defun iwconfig () - "Run iwconfig and display diagnostic output." - (interactive) - (net-utils-run-simple - (format "*%s*" iwconfig-program) - iwconfig-program +(defun iwconfig () + "Run iwconfig and display diagnostic output." + (interactive) + (net-utils-run-simple + (format "*%s*" iwconfig-program) + iwconfig-program iwconfig-program-options)) ;;;###autoload (defun netstat () - "Run netstat and display diagnostic output." + "Run netstat and display diagnostic output." (interactive) (net-utils-run-simple (format "*%s*" netstat-program) @@ -402,7 +402,7 @@ This variable is only used if the variable ;;;###autoload (defun arp () - "Run arp and display diagnostic output." + "Run arp and display diagnostic output." (interactive) (net-utils-run-simple (format "*%s*" arp-program) @@ -484,7 +484,7 @@ If your system's ping continues until interrupted, you can try setting (defun nslookup () "Run nslookup program." (interactive) - (comint-run nslookup-program) + (switch-to-buffer (make-comint "nslookup" nslookup-program)) (nslookup-mode)) (defvar comint-prompt-regexp) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 56254ccd539..23c7e1450f9 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -442,10 +442,15 @@ buffers *newsticker-wget-<feed>* will not be closed." ;; ====================================================================== ;;; Compatibility section, XEmacs, Emacs ;; ====================================================================== + +;; FIXME It is bad practice to define compat functions with such generic names. + +;; This is not needed in Emacs >= 22.1. (unless (fboundp 'time-add) (require 'time-date);;FIXME (defun time-add (t1 t2) - (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2))))) + (with-no-warnings ; don't warn about obsolete time-to-seconds in 23.2 + (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))) (unless (fboundp 'match-string-no-properties) (defalias 'match-string-no-properties 'match-string)) @@ -2172,8 +2177,8 @@ FEED is a symbol!" (read (current-buffer)))) (error (message "Error while reading newsticker cache file %s!" - file-name)) - (setq newsticker--cache nil)))))) + file-name) + (setq newsticker--cache nil))))))) ;; ====================================================================== ;;; Statistics diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 095ebe7245f..ab9a0ba8b7d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -538,8 +538,10 @@ last ping." (rcirc-send-string process (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a" rcirc-nick - (time-to-seconds - (current-time))))))) + (if (featurep 'xemacs) + (time-to-seconds + (current-time)) + (float-time))))))) (rcirc-process-list)) ;; no processes, clean up timer (cancel-timer rcirc-keepalive-timer) @@ -547,7 +549,10 @@ last ping." (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) (with-rcirc-process-buffer process - (setq header-line-format (format "%f" (- (time-to-seconds (current-time)) + (setq header-line-format (format "%f" (- (if (featurep 'xemacs) + (time-to-seconds + (current-time)) + (float-time)) (string-to-number message)))))) (defvar rcirc-debug-buffer " *rcirc debug*") diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 3018bdf6742..0b13996e84f 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -387,7 +387,7 @@ version.") ((= authtype socks-authentication-null) (and socks-debug (message "No authentication necessary"))) ((= authtype socks-authentication-failure) - (error "No acceptable authentication methods found.")) + (error "No acceptable authentication methods found")) (t (let* ((auth-type (gethash 'authtype info)) (auth-handler (assoc auth-type socks-authentication-methods)) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 49bbd79cb45..3b1f4d46aad 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -62,6 +62,7 @@ (autoload 'tramp-file-name-host "tramp") (autoload 'tramp-file-name-localname "tramp") (autoload 'tramp-run-real-handler "tramp") + (autoload 'tramp-time-less-p "tramp") (autoload 'time-stamp-string "time-stamp")) ;;; -- Cache -- @@ -70,7 +71,11 @@ "Hash table for remote files properties.") (defvar tramp-cache-inhibit-cache nil - "Inhibit cache read access, when non-nil.") + "Inhibit cache read access, when `t'. +`nil' means to accept cache entries unconditionally. If the +value is a timestamp (as returned by `current-time'), cache +entries are not used when they have been written before this +time.") (defcustom tramp-persistency-file-name (cond @@ -106,9 +111,21 @@ Returns DEFAULT if not set." (let* ((hash (or (gethash vec tramp-cache-data) (puthash vec (make-hash-table :test 'equal) tramp-cache-data))) - (value (if (and (null tramp-cache-inhibit-cache) (hash-table-p hash)) - (gethash property hash default) - default))) + (value (when (hash-table-p hash) (gethash property hash)))) + (if + ;; We take the value only if there is any, and + ;; `tramp-cache-inhibit-cache' indicates that it is still + ;; valid. Otherwise, DEFAULT is set. + (and (consp value) + (or (null tramp-cache-inhibit-cache) + (and (consp tramp-cache-inhibit-cache) + (tramp-time-less-p + tramp-cache-inhibit-cache (car value))))) + (setq value (cdr value)) + (setq value default)) + + (if (consp tramp-cache-inhibit-cache) + (tramp-message vec 1 "%s %s %s" file property value)) (tramp-message vec 8 "%s %s %s" file property value) value)) @@ -121,7 +138,8 @@ Returns VALUE." (let ((hash (or (gethash vec tramp-cache-data) (puthash vec (make-hash-table :test 'equal) tramp-cache-data)))) - (puthash property value hash) + ;; We put the timestamp there. + (puthash property (cons (current-time) value) hash) (tramp-message vec 8 "%s %s %s" file property value) value)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index a4b3dc7728f..258bc2f4de0 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -42,6 +42,9 @@ (require 'timer-funcs) (require 'timer)) + (autoload 'tramp-tramp-file-p "tramp") + (autoload 'tramp-file-name-handler "tramp") + ;; tramp-util offers integration into other (X)Emacs packages like ;; compile.el, gud.el etc. Not necessary in Emacs 23. (eval-after-load "tramp" @@ -85,6 +88,8 @@ (unless (boundp 'byte-compile-not-obsolete-var) (defvar byte-compile-not-obsolete-var nil)) (setq byte-compile-not-obsolete-var 'directory-sep-char) + (if (boundp 'byte-compile-not-obsolete-vars) ; Emacs 23.2 + (setq byte-compile-not-obsolete-vars '(directory-sep-char))) ;; `with-temp-message' does not exists in XEmacs. (condition-case nil @@ -99,24 +104,56 @@ (unless (fboundp 'font-lock-add-keywords) (defalias 'font-lock-add-keywords 'ignore)) + ;; The following functions cannot be aliases of the corresponding + ;; `tramp-handle-*' functions, because this would bypass the locking + ;; mechanism. + ;; `file-remote-p' has been introduced with Emacs 22. The version ;; of XEmacs is not a magic file name function (yet); this is ;; corrected in tramp-util.el. Here it is sufficient if the ;; function exists. (unless (fboundp 'file-remote-p) - (defalias 'file-remote-p 'tramp-handle-file-remote-p)) + (defalias 'file-remote-p + (lambda (file &optional identification connected) + (when (tramp-tramp-file-p file) + (tramp-file-name-handler + 'file-remote-p file identification connected))))) ;; `process-file' exists since Emacs 22. (unless (fboundp 'process-file) - (defalias 'process-file 'tramp-handle-process-file)) + (defalias 'process-file + (lambda (program &optional infile buffer display &rest args) + (when (tramp-tramp-file-p default-directory) + (apply + 'tramp-file-name-handler + 'process-file program infile buffer display args))))) ;; `start-file-process' is new in Emacs 23. (unless (fboundp 'start-file-process) - (defalias 'start-file-process 'tramp-handle-start-file-process)) + (defalias 'start-file-process + (lambda (name buffer program &rest program-args) + (when (tramp-tramp-file-p default-directory) + (apply + 'tramp-file-name-handler + 'start-file-process name buffer program program-args))))) ;; `set-file-times' is also new in Emacs 23. (unless (fboundp 'set-file-times) - (defalias 'set-file-times 'tramp-handle-set-file-times))) + (defalias 'set-file-times + (lambda (filename &optional time) + (when (tramp-tramp-file-p filename) + (tramp-file-name-handler + 'set-file-times filename time)))))) + +(defsubst tramp-compat-line-beginning-position () + "Return point at beginning of line (compat function). +Calls `line-beginning-position' or `point-at-bol' if defined, else +own implementation." + (cond + ((fboundp 'line-beginning-position) + (funcall (symbol-function 'line-beginning-position))) + ((fboundp 'point-at-bol) (funcall (symbol-function 'point-at-bol))) + (t (save-excursion (beginning-of-line) (point))))) (defsubst tramp-compat-line-end-position () "Return point at end of line (compat function). @@ -197,10 +234,8 @@ Add the extension of FILENAME, if existing." (cond ((or (null id-format) (eq id-format 'integer)) (file-attributes filename)) - ;; FIXME: shouldn't that be tramp-file-p or somesuch? - ((file-remote-p filename) - (funcall (symbol-function 'tramp-handle-file-attributes) - filename id-format)) + ((tramp-tramp-file-p filename) + (tramp-file-name-handler 'file-attributes filename id-format)) (t (condition-case nil (funcall (symbol-function 'file-attributes) filename id-format) (error (file-attributes filename)))))) @@ -219,7 +254,7 @@ Add the extension of FILENAME, if existing." ;; `copy-tree' is a built-in function in XEmacs. In Emacs 21, it is ;; an autoloaded function in cl-extra.el. Since Emacs 22, it is part ;; of subr.el. There are problems when autoloading, therefore we test -;; for `subrp' and `symbol-file'. Implementation is taken from Emacs23. +;; for `subrp' and `symbol-file'. Implementation is taken from Emacs 23. (defun tramp-compat-copy-tree (tree) "Make a copy of TREE (compat function)." (if (or (subrp 'copy-tree) (symbol-file 'copy-tree)) @@ -233,6 +268,28 @@ Add the extension of FILENAME, if existing." (setq tree (cdr tree))) (nconc (nreverse result) tree)))) +;; `number-sequence' has been introduced in Emacs 22. Implementation +;; is taken from Emacs 23. +(defun tramp-compat-number-sequence (from &optional to inc) + "Return a sequence of numbers from FROM to TO as a list (compat function)." + (if (or (subrp 'number-sequence) (symbol-file 'number-sequence)) + (funcall (symbol-function 'number-sequence) from to inc) + (if (or (not to) (= from to)) + (list from) + (or inc (setq inc 1)) + (when (zerop inc) (error "The increment can not be zero")) + (let (seq (n 0) (next from)) + (if (> inc 0) + (while (<= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc)))) + (while (>= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc))))) + (nreverse seq))))) + (defun tramp-compat-split-string (string pattern) "Like `split-string' but omit empty strings. In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\"). diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 3091197cad8..8ef65459cb7 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -144,7 +144,7 @@ "The well known name of the GVFS daemon.") ;; Check that GVFS is available. -(unless (dbus-ping :session tramp-gvfs-service-daemon) +(unless (dbus-ping :session tramp-gvfs-service-daemon 100) (throw 'tramp-loading nil)) (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" @@ -1177,7 +1177,7 @@ be used." (tramp-bluez-list-devices))) ;; Add completion function for OBEX method. -(when (dbus-ping :system tramp-bluez-service) +(when (member tramp-bluez-service (dbus-list-known-names :system)) (tramp-set-completion-function "obex" '((tramp-bluez-parse-device-names "")))) @@ -1210,7 +1210,7 @@ be used." (zeroconf-list-services "_webdav._tcp"))) ;; Add completion function for DAV and DAVS methods. -(when (dbus-ping :system zeroconf-service-avahi) +(when (member zeroconf-service-avahi (dbus-list-known-names :system)) (zeroconf-init tramp-gvfs-zeroconf-domain) (tramp-set-completion-function "sftp" '((tramp-zeroconf-parse-workstation-device-names ""))) diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el new file mode 100644 index 00000000000..cf0933db226 --- /dev/null +++ b/lisp/net/tramp-imap.el @@ -0,0 +1,801 @@ +;;; tramp-imap.el --- Tramp interface to IMAP through imap.el + +;; Copyright (C) 2009 Free Software Foundation, Inc. + +;; Author: Teodor Zlatanov <tzz@lifelogs.com> +;; Keywords: mail, comm + +;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Package to provide Tramp over IMAP + +;;; Setup: + +;; just load and open files, e.g. +;; /imaps:user@yourhosthere.com:/INBOX.test/1 +;; or +;; /imap:user@yourhosthere.com:/INBOX.test/1 + +;; where `imap' goes over IMAP, while `imaps' goes over IMAP+SSL + +;; This module will use imap-hash.el to access the IMAP mailbox. + +;; This module will use auth-source.el to authenticate against the +;; IMAP server, PLUS it will use auth-source.el to get your passphrase +;; for the symmetrically encrypted messages. For the former, use the +;; usual IMAP ports. For the latter, use the port "tramp-imap". + +;; example .authinfo / .netrc file: + +;; machine yourhosthere.com port tramp-imap login USER password SYMMETRIC-PASSPHRASE + +;; note above is the symmetric encryption passphrase for GPG +;; below is the regular password for IMAP itself and other things on that host + +;; machine yourhosthere.com login USER password NORMAL-PASSWORD + + +;;; Code: + +(require 'assoc) +(require 'tramp) +(require 'tramp-compat) +(require 'message) +(require 'imap-hash) +(require 'epa) +(autoload 'auth-source-user-or-password "auth-source") + +;; Define Tramp IMAP method ... +(defconst tramp-imap-method "imap" + "*Method to connect via IMAP protocol.") + +(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143))) + +;; Add a default for `tramp-default-user-alist'. Default is the local user. +(add-to-list 'tramp-default-user-alist + `(,tramp-imap-method nil ,(user-login-name))) + +;; Define Tramp IMAPS method ... +(defconst tramp-imaps-method "imaps" + "*Method to connect via secure IMAP protocol.") + +;; ... and add it to the method list. +(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993))) + +;; Add a default for `tramp-default-user-alist'. Default is the local user. +(add-to-list 'tramp-default-user-alist + `(,tramp-imaps-method nil ,(user-login-name))) + +;; Add completion function for IMAP method. +;; (tramp-set-completion-function +;; tramp-imap-method tramp-completion-function-alist-ssh) ; TODO: test this +;; tramp-imaps-method tramp-completion-function-alist-ssh) ; TODO: test this + +;; New handlers should be added here. +(defconst tramp-imap-file-name-handler-alist + '( + ;; `access-file' performed by default handler + (add-name-to-file . ignore) + ;; `byte-compiler-base-file-name' performed by default handler + (copy-file . tramp-imap-handle-copy-file) + (delete-directory . ignore) ;; tramp-imap-handle-delete-directory) + (delete-file . tramp-imap-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes + . tramp-imap-handle-directory-files-and-attributes) + ;; `dired-call-process' performed by default handler + ;; `dired-compress-file' performed by default handler + ;; `dired-uncache' performed by default handler + (expand-file-name . tramp-imap-handle-expand-file-name) + ;; `file-accessible-directory-p' performed by default handler + (file-attributes . tramp-imap-handle-file-attributes) + (file-directory-p . tramp-imap-handle-file-directory-p) + (file-executable-p . tramp-imap-handle-file-executable-p) + (file-exists-p . tramp-imap-handle-file-exists-p) + (file-local-copy . tramp-imap-handle-file-local-copy) + (file-remote-p . tramp-handle-file-remote-p) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . tramp-imap-handle-file-name-all-completions) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-completion . tramp-handle-file-name-completion) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) + ;; `file-name-sans-versions' performed by default handler + (file-newer-than-file-p . tramp-imap-handle-file-newer-than-file-p) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-imap-handle-file-readable-p) + (file-regular-p . tramp-handle-file-regular-p) + (file-symlink-p . tramp-handle-file-symlink-p) + ;; `file-truename' performed by default handler + (file-writable-p . tramp-imap-handle-file-writable-p) + (find-backup-file-name . tramp-handle-find-backup-file-name) + ;; `find-file-noselect' performed by default handler + ;; `get-file-buffer' performed by default handler + (insert-directory . tramp-imap-handle-insert-directory) + (insert-file-contents . tramp-imap-handle-insert-file-contents) + (load . tramp-handle-load) + (make-directory . ignore) ;; tramp-imap-handle-make-directory) + (make-directory-internal . ignore) ;; tramp-imap-handle-make-directory-internal) + (make-symbolic-link . ignore) + (rename-file . tramp-imap-handle-rename-file) + (set-file-modes . ignore) + (set-file-times . ignore) ;; tramp-imap-handle-set-file-times) + (set-visited-file-modtime . ignore) + (shell-command . ignore) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (vc-registered . ignore) + (verify-visited-file-modtime . ignore) + (write-region . tramp-imap-handle-write-region) + (executable-find . ignore) + (start-file-process . ignore) + (process-file . ignore) +) + "Alist of handler functions for Tramp IMAP method. +Operations not mentioned here will be handled by the default Emacs primitives.") + +(defgroup tramp-imap nil + "Tramp over IMAP configuration." + :version "23.2" + :group 'applications) + +(defcustom tramp-imap-subject-marker "tramp-imap-subject-marker" + "The subject marker that Tramp-IMAP will use." + :type 'string + :version "23.2" + :group 'tramp-imap) + +;; TODO: these will be defcustoms later. +(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never +(defvar tramp-imap-passphrase nil) + +(defun tramp-imap-file-name-p (filename) + "Check if it's a filename for IMAP protocol." + (let ((v (tramp-dissect-file-name filename))) + (or + (string= (tramp-file-name-method v) tramp-imap-method) + (string= (tramp-file-name-method v) tramp-imaps-method)))) + +(defun tramp-imap-file-name-handler (operation &rest args) + "Invoke the IMAP related OPERATION. +First arg specifies the OPERATION, second arg is a list of arguments to +pass to the OPERATION." + (let ((fn (assoc operation tramp-imap-file-name-handler-alist))) + (if fn + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args)))) + +(add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)) + +(defun tramp-imap-handle-copy-file + (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) + "Like `copy-file' for Tramp files." + (tramp-imap-do-copy-or-rename-file + 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid)) + +(defun tramp-imap-handle-rename-file + (filename newname &optional ok-if-already-exists) + "Like `rename-file' for Tramp files." + (tramp-imap-do-copy-or-rename-file + 'rename filename newname ok-if-already-exists t t)) + +(defun tramp-imap-do-copy-or-rename-file + (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) + "Copy or rename a remote file. +OP must be `copy' or `rename' and indicates the operation to perform. +FILENAME specifies the file to copy or rename, NEWNAME is the name of +the new file (for copy) or the new name of the file (for rename). +OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. +KEEP-DATE means to make sure that NEWNAME has the same timestamp +as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep +the uid and gid if both files are on the same host. + +This function is invoked by `tramp-imap-handle-copy-file' and +`tramp-imap-handle-rename-file'. It is an error if OP is neither +of `copy' and `rename'." + (unless (memq op '(copy rename)) + (error "Unknown operation `%s', must be `copy' or `rename'" op)) + (setq filename (expand-file-name filename)) + (setq newname (expand-file-name newname)) + (when (file-directory-p newname) + (setq newname (expand-file-name (file-name-nondirectory filename) newname))) + + (let ((t1 (and (tramp-tramp-file-p filename) + (tramp-imap-file-name-p filename))) + (t2 (and (tramp-tramp-file-p newname) + (tramp-imap-file-name-p newname)))) + + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (with-parsed-tramp-file-name (if t1 filename newname) nil + (tramp-error + v 'file-already-exists "File %s already exists" newname))) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (tramp-message v 0 "Transferring %s to %s..." filename newname)) + + ;; We just make a local copy of FILENAME, and write it then to + ;; NEWNAME. This must be optimized, when both files are located + ;; on the same IMAP server. + (with-temp-buffer + (if (and t1 t2) + ;; We don't encrypt. + (with-parsed-tramp-file-name newname nil + (insert (tramp-imap-get-file filename nil)) + (tramp-imap-put-file + v (current-buffer) + (tramp-imap-file-name-name v) + (tramp-imap-get-file-inode newname) + nil)) + ;; One of them is not located on a IMAP mailbox. + (insert-file-contents filename) + (write-region (point-min) (point-max) newname))) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (tramp-message v 0 "Transferring %s to %s...done" filename newname)) + + (when (eq op 'rename) + (delete-file filename)))) + +;; TODO: revise this much +(defun tramp-imap-handle-expand-file-name (name &optional dir) + "Like `expand-file-name' for Tramp files." + ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". + (setq dir (or dir default-directory "/")) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; If NAME is not a Tramp file, run the real handler. + (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name))) + (tramp-drop-volume-letter + (tramp-run-real-handler 'expand-file-name (list name nil))) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) + (setq localname (concat "/" localname))) + ;; There might be a double slash, for example when "~/" + ;; expands to "/". Remove this. + (while (string-match "//" localname) + (setq localname (replace-match "/" t t localname))) + ;; Do normal `expand-file-name' (this does "/./" and "/../"). + ;; We bind `directory-sep-char' here for XEmacs on Windows, + ;; which would otherwise use backslash. `default-directory' is + ;; bound, because on Windows there would be problems with UNC + ;; shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) + (tramp-make-tramp-file-name + method user host + (tramp-drop-volume-letter + (tramp-run-real-handler + 'expand-file-name (list localname)))))))) + +;; This function should return "foo/" for directories and "bar" for +;; files. +(defun tramp-imap-handle-file-name-all-completions (filename directory) + "Like `file-name-all-completions' for Tramp files." + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (save-match-data + (let ((entries + (tramp-imap-get-file-entries v localname))) + (mapcar + (lambda (x) + (list + (if (string-match "d" (nth 9 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + entries)))))) + +(defun tramp-imap-get-file-entries (vec localname &optional exact) + "Read entries returned by IMAP server. EXACT limits to exact matches. +Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME +SIZE MODE WEIRD INODE DEVICE)." + (tramp-message vec 5 "working on %s" localname) + (let* ((name (tramp-imap-file-name-name vec)) + (search-name (or name "")) + (search-name (if exact (concat search-name "$") search-name)) + (iht (tramp-imap-make-iht vec search-name))) +;; TODO: catch errors + ;; (tramp-error vec 'none "bad name %s or mailbox %s" name mbox)) + (imap-hash-map (lambda (uid headers body) + (let ((subject (substring + (aget headers 'Subject "") + (length tramp-imap-subject-marker)))) + (list + subject + nil + -1 + 1 + 1 + '(0 0) + '(0 0) + '(0 0) + 1 + "-rw-rw-rw-" + nil + uid + (tramp-get-device vec)))) + iht t))) + +(defun tramp-imap-handle-write-region (start end filename &optional append visit lockname confirm) + "Like `write-region' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + ;; XEmacs takes a coding system as the seventh argument, not `confirm'. + (when (and (not (featurep 'xemacs)) + confirm (file-exists-p filename)) + (unless (y-or-n-p (format "File %s exists; overwrite anyway? " + filename)) + (tramp-error v 'file-error "File not overwritten"))) + (tramp-flush-file-property v localname) + (let* ((old-buffer (current-buffer)) + (inode (tramp-imap-get-file-inode filename)) + (min 1) + (max (point-max)) + ;; Make sure we have good start and end values. + (start (or start min)) + (end (or end max)) + temp-buffer) + (with-temp-buffer + (setq temp-buffer (if (and (eq start min) (eq end max)) + old-buffer + ;; If this is a region write, insert the substring. + (insert + (with-current-buffer old-buffer + (buffer-substring-no-properties start end))) + (current-buffer))) + (tramp-imap-put-file v + temp-buffer + (tramp-imap-file-name-name v) + inode + t))) + (when (eq visit t) + (set-visited-file-modtime)))) + +(defun tramp-imap-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (setq filename (expand-file-name filename)) + (when full-directory-p + ;; Called from `dired-add-entry'. + (setq filename (file-name-as-directory filename))) + (with-parsed-tramp-file-name filename nil + (save-match-data + (let ((base (file-name-nondirectory localname)) + (entries (copy-sequence + (tramp-imap-get-file-entries + v (file-name-directory localname))))) + + (when wildcard + (when (string-match "\\." base) + (setq base (replace-match "\\\\." nil nil base))) + (when (string-match "\\*" base) + (setq base (replace-match ".*" nil nil base))) + (when (string-match "\\?" base) + (setq base (replace-match ".?" nil nil base)))) + + ;; Filter entries. + (setq entries + (delq + nil + (if (or wildcard (zerop (length base))) + ;; Check for matching entries. + (mapcar + (lambda (x) + (when (string-match + (format "^%s" base) (nth 0 x)) + x)) + entries) + ;; We just need the only and only entry FILENAME. + (list (assoc base entries))))) + + ;; Sort entries. + (setq entries + (sort + entries + (lambda (x y) + (if (string-match "t" switches) + ;; Sort by date. + (tramp-time-less-p (nth 6 y) (nth 6 x)) + ;; Sort by name. + (string-lessp (nth 0 x) (nth 0 y)))))) + + ;; Handle "-F" switch. + (when (string-match "F" switches) + (mapc + (lambda (x) + (when (not (zerop (length (car x)))) + (cond + ((char-equal ?d (string-to-char (nth 9 x))) + (setcar x (concat (car x) "/"))) + ((char-equal ?x (string-to-char (nth 9 x))) + (setcar x (concat (car x) "*")))))) + entries)) + + ;; Print entries. + (mapcar + (lambda (x) + (when (not (zerop (length (nth 0 x)))) + (insert + (format + "%10s %3d %-8s %-8s %8s %s " + (nth 9 x) ; mode + (nth 11 x) ; inode + "nobody" "nogroup" + (nth 8 x) ; size + (format-time-string + (if (tramp-time-less-p + (tramp-time-subtract (current-time) (nth 6 x)) + tramp-half-a-year) + "%b %e %R" + "%b %e %Y") + (nth 6 x)))) ; date + ;; For the file name, we set the `dired-filename' + ;; property. This allows to handle file names with + ;; leading or trailing spaces as well. + (let ((pos (point))) + (insert (format "%s" (nth 0 x))) ; file name + (put-text-property pos (point) 'dired-filename t)) + (insert "\n") + (forward-line) + (beginning-of-line))) + entries))))) + +(defun tramp-imap-handle-insert-file-contents + (filename &optional visit beg end replace) + "Like `insert-file-contents' for Tramp files." + (barf-if-buffer-read-only) + (when visit + (setq buffer-file-name (expand-file-name filename)) + (set-visited-file-modtime) + (set-buffer-modified-p nil)) + (with-parsed-tramp-file-name filename nil + (if (not (file-exists-p filename)) + (tramp-error + v 'file-error "File `%s' not found on remote host" filename) + (let ((point (point)) + size data) + (tramp-message v 4 "Fetching file %s..." filename) + (insert (tramp-imap-get-file filename t)) + (setq size (- (point) point)) +;;; TODO: handle ranges. +;;; (let ((beg (or beg (point-min))) +;;; (end (min (or end (point-max)) (point-max)))) +;;; (setq size (- end beg)) +;;; (buffer-substring beg end)) + (goto-char point) + (tramp-message v 4 "Fetching file %s...done" filename) + (list (expand-file-name filename) size))))) + +(defun tramp-imap-handle-file-exists-p (filename) + "Like `file-exists-p' for Tramp files." + (and (file-attributes filename) t)) + +(defun tramp-imap-handle-file-directory-p (filename) + "Like `file-directory-p' for Tramp-IMAP files." + ;; We allow only mailboxes to be a directory. + (with-parsed-tramp-file-name (expand-file-name filename default-directory) nil + (and (string-match "^/[^/]*$" (directory-file-name localname)) t))) + +(defun tramp-imap-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp-IMAP FILENAME." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (cdr-safe (nth 0 (tramp-imap-get-file-entries v localname))))) + +(defun tramp-imap-get-file-inode (filename &optional id-format) + "Get inode equivalent \(actually the UID) for Tramp-IMAP FILENAME." + (nth 10 (tramp-compat-file-attributes filename id-format))) + +(defun tramp-imap-handle-file-executable-p (filename) + "Like `file-executable-p' for Tramp files. False for IMAP." + nil) + +(defun tramp-imap-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files. True for IMAP." + (file-exists-p filename)) + +(defun tramp-imap-handle-file-writable-p (filename) + "Like `file-writable-p' for Tramp files. True for IMAP." + ;; `file-exists-p' does not work yet for directories. + ;; (file-exists-p (file-name-directory filename))) + (file-directory-p (file-name-directory filename))) + +(defun tramp-imap-handle-delete-file (filename) + "Like `delete-file' for Tramp files." + (cond + ((not (file-exists-p filename)) nil) + (t (with-parsed-tramp-file-name (expand-file-name filename) nil + (let ((iht (tramp-imap-make-iht v))) + (imap-hash-rem (tramp-imap-get-file-inode filename) iht)))))) + +(defun tramp-imap-handle-directory-files-and-attributes + (directory &optional full match nosort id-format) + "Like `directory-files-and-attributes' for Tramp files." + (mapcar + (lambda (x) + (cons x (tramp-compat-file-attributes + (if full x (expand-file-name x directory)) id-format))) + (directory-files directory full match nosort))) + +;; TODO: fix this in tramp-imap-get-file-entries. +(defun tramp-imap-handle-file-newer-than-file-p (file1 file2) + "Like `file-newer-than-file-p' for Tramp files." + (cond + ((not (file-exists-p file1)) nil) + ((not (file-exists-p file2)) t) + (t (tramp-time-less-p (nth 5 (file-attributes file2)) + (nth 5 (file-attributes file1)))))) + +(defun tramp-imap-handle-file-local-copy (filename) + "Like `file-local-copy' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (unless (file-exists-p filename) + (tramp-error + v 'file-error + "Cannot make local copy of non-existing file `%s'" filename)) + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) + (with-temp-buffer + (insert-file-contents filename) + (write-region (point-min) (point-max) tmpfile) + (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile) + tmpfile)))) + +(defun tramp-imap-put-file (vec filename-or-buffer &optional subject inode encode) + "Write contents of FILENAME-OR-BUFFER to Tramp-IMAP file VEC with name SUBJECT. +When INODE is given, delete that old remote file after writing the new one +\(normally this is the old file with the same name)." + ;; `tramp-current-host' is used in `tramp-imap-passphrase-callback-function'. + (let ((tramp-current-host (tramp-file-name-real-host vec)) + (iht (tramp-imap-make-iht vec))) + (imap-hash-put (list + (list (cons + 'Subject + (format + "%s%s" + tramp-imap-subject-marker + (or subject "no subject")))) + (cond ((bufferp filename-or-buffer) + (with-current-buffer filename-or-buffer + (if encode + (tramp-imap-encode-buffer) + (buffer-string)))) + ;; TODO: allow file names. + (t "No body available"))) + iht + inode))) + +(defun tramp-imap-get-file (filename &optional decode) + ;; (debug (tramp-imap-get-file-inode filename)) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (condition-case () + ;; `tramp-current-host' is used in + ;; `tramp-imap-passphrase-callback-function'. + (let* ((tramp-current-host (tramp-file-name-real-host v)) + (iht (tramp-imap-make-iht v)) + (inode (tramp-imap-get-file-inode filename)) + (data (imap-hash-get inode iht t))) + (if decode + (with-temp-buffer + (insert (nth 1 data)) + ;;(debug inode (buffer-string)) + (tramp-imap-decode-buffer)) + (nth 1 data))) + (error (tramp-error + v 'file-error "File `%s' could not be read" filename))))) + +(defun tramp-imap-passphrase-callback-function (context key-id handback) + "Called by EPG to get a passphrase for Tramp-IMAP. +CONTEXT is the encryption/decryption EPG context. +HANDBACK is just carried through. +KEY-ID can be 'SYM or 'PIN among others." + (let* ((server tramp-current-host) + (port "tramp-imap") ; this is NOT the server password! + (auth-passwd + (auth-source-user-or-password "password" server port))) + (or + (copy-sequence auth-passwd) + ;; If we cache the passphrase and we have one. + (if (and (eq tramp-imap-passphrase-cache t) + tramp-imap-passphrase) + ;; Do we reuse it? + (if (y-or-n-p "Reuse the passphrase? ") + (copy-sequence tramp-imap-passphrase) + ;; Don't reuse: revert caching behavior to nil, erase passphrase, + ;; call ourselves again. + (setq tramp-imap-passphrase-cache nil) + (setq tramp-imap-passphrase nil) + (tramp-imap-passphrase-callback-function context key-id handback)) + (let ((p (if (eq key-id 'SYM) + (read-passwd + "Tramp-IMAP passphrase for symmetric encryption: " + (eq (epg-context-operation context) 'encrypt) + tramp-imap-passphrase) + (read-passwd + (if (eq key-id 'PIN) + "Tramp-IMAP passphrase for PIN: " + (let ((entry (assoc key-id epg-user-id-alist))) + (if entry + (format "Tramp-IMAP passphrase for %s %s: " + key-id (cdr entry)) + (format "Tramp-IMAP passphrase for %s: " key-id)))) + nil + tramp-imap-passphrase)))) + + ;; If we have an answer, the passphrase has changed, + ;; the user hasn't declined keeping the passphrase, + ;; and they answer yes to keep it now... + (when (and + p + (not (equal tramp-imap-passphrase p)) + (not (eq tramp-imap-passphrase-cache 'never)) + (y-or-n-p "Keep the passphrase? ")) + (setq tramp-imap-passphrase (copy-sequence p)) + (setq tramp-imap-passphrase-cache t)) + + ;; If we still don't have a passphrase, the user didn't want + ;; to keep it. + (when (and + p + (not tramp-imap-passphrase)) + (setq tramp-imap-passphrase-cache 'never)) + + p))))) + +(defun tramp-imap-encode-buffer () + (let ((context (epg-make-context 'OpenPGP)) + cipher) + (epg-context-set-armor context t) + (epg-context-set-passphrase-callback context + #'tramp-imap-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons #'epa-progress-callback-function + "Encrypting...")) + (message "Encrypting...") + (setq cipher (epg-encrypt-string + context + (encode-coding-string (buffer-string) 'utf-8) + nil)) + (message "Encrypting...done") + cipher)) + +(defun tramp-imap-decode-buffer () + (let ((context (epg-make-context 'OpenPGP)) + plain) + (epg-context-set-passphrase-callback context + #'tramp-imap-passphrase-callback-function) + (epg-context-set-progress-callback context + (cons #'epa-progress-callback-function + "Decrypting...")) + (message "Decrypting...") + (setq plain (decode-coding-string + (epg-decrypt-string context (buffer-string)) + 'utf-8)) + (message "Decrypting...done") + plain)) + +(defun tramp-imap-file-name-mailbox (vec) + (nth 0 (tramp-imap-file-name-parse vec))) + +(defun tramp-imap-file-name-name (vec) + (nth 1 (tramp-imap-file-name-parse vec))) + +(defun tramp-imap-file-name-localname (vec) + (nth 1 (tramp-imap-file-name-parse vec))) + +(defun tramp-imap-file-name-parse (vec) + (let ((name (substring-no-properties (tramp-file-name-localname vec)))) + (if (string-match "^/\\([^/]+\\)/?\\(.*\\)$" name) + (list (match-string 1 name) + (match-string 2 name)) + nil))) + +(defun tramp-imap-make-iht (vec &optional needed-subject) + "Translate the Tramp vector VEC to the imap-hash structure. +With NEEDED-SUBJECT, alters the imap-hash test accordingly." + (let* ((mbox (tramp-imap-file-name-mailbox vec)) + (server (tramp-file-name-real-host vec)) + (method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (ssl (string-equal method tramp-imaps-method)) + (port (or (tramp-file-name-port vec) + (tramp-get-method-parameter method 'tramp-default-port))) + (result (imap-hash-make server port mbox))) + ;; Return the IHT with a test override to look for the subject + ;; marker. Set also user and ssl tags. + (setq result (plist-put result :user user) + result (plist-put result :ssl ssl) + result (plist-put + result + :test (format "^%s%s" + tramp-imap-subject-marker + (if needed-subject needed-subject "")))))) + +;;; TODO: + +;; * Implement `tramp-imap-handle-delete-directory', +;; `tramp-imap-handle-make-directory', +;; `tramp-imap-handle-make-directory-internal', +;; `tramp-imap-handle-set-file-times'. + +;; * Encode the subject. If the filename has trailing spaces (like +;; "test "), those characters get lost, for example in dired listings. + +;; * When opening a dired buffer, like "/imap::INBOX.test", there are +;; several error messages: +;; "Buffer has a running process; kill it? (yes or no) " +;; "error in process filter: Internal error, tag 6 status BAD code nil text No mailbox selected." +;; Afterwards, everything seems to be fine. + +;; * imaps works for local IMAP servers. Accessing +;; "/imaps:imap.gmail.com:/INBOX.test/" results in error +;; "error in process filter: Internal error, tag 5 status BAD code nil text UNSELECT not allowed now. + +(provide 'tramp-imap) +;;; tramp-imap.el ends here + +;; Ignore, for testing only. + +;;; (setq tramp-imap-subject-marker "T") +;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") t) +;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/") t) +;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4") t) +;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/") t) +;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t) +;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t t) +;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome") +;;; (dired-copy-file "/etc/fstab" "/imap:yourhosthere.com:/test/welcome" t) +;;; (write-region 1 100 "/imap:yourhosthere.com:/test/welcome") +;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t) +;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome")) +;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome2")) +;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2") +;;(file-name-directory "/imap:yourhosthere.com:/test/welcome2") +;;(with-temp-buffer (insert "hello") (delete-file "/tmp/hellotest") (write-file "/tmp/hellotest") (write-file "/imap:yourhosthere.com:/test/welcome2")) +;;;(file-exists-p "/imap:yourhosthere.com:/INBOX.test/4") +;;;(file-attributes "/imap:yourhosthere.com:/INBOX.test/4") +;;;(setq vec (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4")) +;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/INBOX.test/4") +;;; (tramp-imap-handle-insert-file-contents "/imap:user@yourhosthere.com:/INBOX.test/4" nil nil nil nil) +;;;(insert-file-contents "/imap:yourhosthere.com:/INBOX.test/4") +;;;(file-attributes "/imap:yourhosthere.com:/test/welcommen") +;;;(insert-file-contents "/imap:yourhosthere.com:/test/welcome") +;;;(file-exists-p "/imap:yourhosthere.com:/test/welcome2") +;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/test/welcome") +;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcommen") +;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome") +;;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2") +;;; (delete-file "/imap:yourhosthere.com:/test/welcome") +;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcommen" t) +;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t) +;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test")) +;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/old")) +;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new")) +;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/two")) +;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/one")) +;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test")) +;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4")) +;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/")) +;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) +;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) +;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) +;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4")) +;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") "extra") diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 26edcf8b1c8..86cbe641d99 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -323,10 +323,8 @@ PRESERVE-UID-GID is completely ignored." "Like `directory-files-and-attributes' for Tramp files." (mapcar (lambda (x) - ;; We cannot call `file-attributes' for backward compatibility reasons. - ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. - (cons x (tramp-smb-handle-file-attributes - (if full x (expand-file-name x directory)) id-format))) + (cons x (tramp-compat-handle-file-attributes + (if full x (expand-file-name x directory)) id-format))) (directory-files directory full match nosort))) (defun tramp-smb-handle-file-attributes (filename &optional id-format) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 16f9c5b182c..a558ccd41fd 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -69,15 +69,15 @@ ;; The Tramp version number and bug report address, as prepared by configure. (require 'trampver) (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'trampver) - (unload-feature 'trampver 'force)))) + (lambda () + (when (featurep 'trampver) + (unload-feature 'trampver 'force)))) (require 'tramp-compat) (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-compat) - (unload-feature 'tramp-compat 'force)))) + (lambda () + (when (featurep 'tramp-compat) + (unload-feature 'tramp-compat 'force)))) (require 'format-spec) ; from Gnus 5.8, also in tar ball ;; As long as password.el is not part of (X)Emacs, it shouldn't @@ -105,16 +105,16 @@ (autoload 'tramp-flush-connection-property "tramp-cache") (autoload 'tramp-parse-connection-properties "tramp-cache") (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-cache) - (unload-feature 'tramp-cache 'force)))) + (lambda () + (when (featurep 'tramp-cache) + (unload-feature 'tramp-cache 'force)))) (autoload 'tramp-uuencode-region "tramp-uu" "Implementation of `uuencode' in Lisp.") (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-uu) - (unload-feature 'tramp-uu 'force)))) + (lambda () + (when (featurep 'tramp-uu) + (unload-feature 'tramp-uu 'force)))) (autoload 'uudecode-decode-region "uudecode") @@ -151,7 +151,12 @@ 'tramp-gvfs) ;; Load gateways. It needs `make-network-process' from Emacs 22. - (when (functionp 'make-network-process) 'tramp-gw))) + (when (functionp 'make-network-process) 'tramp-gw) + + ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash + ;; (from Emacs 23.2). + (when (and (locate-library "epa") (locate-library "imap-hash")) + 'tramp-imap))) (when feature ;; We have used just some basic tests, whether a package shall @@ -375,6 +380,21 @@ files conditionalize this setup based on the TERM environment variable." (tramp-copy-args (("-e" "ssh") ("-t" "%k"))) (tramp-copy-keep-date t) (tramp-password-end-of-line nil)) + ("rsyncc" (tramp-login-program "ssh") + (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") + ("-o" "ControlPath=%t.%%r@%%h:%%p") + ("-o" "ControlMaster=yes") + ("-e" "none"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "rsync") + (tramp-copy-args (("-t" "%k"))) + (tramp-copy-env (("RSYNC_RSH") + (,(concat + "ssh" + " -o ControlPath=%t.%%r@%%h:%%p" + " -o ControlMaster=auto")))) + (tramp-copy-keep-date t) + (tramp-password-end-of-line nil)) ("remcp" (tramp-login-program "remsh") (tramp-login-args (("%h") ("-l" "%u"))) (tramp-remote-sh "/bin/sh") @@ -850,6 +870,8 @@ the info pages.") (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) (tramp-set-completion-function + "rsyncc" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) @@ -987,7 +1009,9 @@ Sometimes the prompt is reported to look like \"login as:\"." :type 'regexp) (defcustom tramp-shell-prompt-pattern - "^[^#$%>\n]*[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*" + ;; Allow a prompt to start right after a ^M since it indeed would be + ;; displayed at the beginning of the line (and Zsh uses it). + "\\(?:^\\|
\\)[^#$%>\n]*[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*" "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -1369,29 +1393,29 @@ Also see `tramp-file-name-structure'.") ;;;###autoload (defconst tramp-root-regexp (if (memq system-type '(cygwin windows-nt)) - "^\\([a-zA-Z]:\\)?/" - "^/") + "\\`\\([a-zA-Z]:\\)?/" + "\\`/") "Beginning of an incomplete Tramp file name. -Usually, it is just \"^/\". On W32 systems, there might be a +Usually, it is just \"\\\\`/\". On W32 systems, there might be a volume letter, which will be removed by `tramp-drop-volume-letter'.") ;;;###autoload (defconst tramp-completion-file-name-regexp-unified - (concat tramp-root-regexp "[^/]*$") + (concat tramp-root-regexp "[^/]*\\'") "Value for `tramp-completion-file-name-regexp' for unified remoting. GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP. See `tramp-file-name-structure' for more explanations.") ;;;###autoload (defconst tramp-completion-file-name-regexp-separate - (concat tramp-root-regexp "\\([[][^]]*\\)?$") + (concat tramp-root-regexp "\\([[][^]]*\\)?\\'") "Value for `tramp-completion-file-name-regexp' for separate remoting. XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload (defconst tramp-completion-file-name-regexp-url - (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$") + (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'") "Value for `tramp-completion-file-name-regexp' for URL-like remoting. See `tramp-file-name-structure' for more explanations.") @@ -1574,6 +1598,10 @@ we have this shell function.") (defconst tramp-perl-file-attributes "%s -e ' @stat = lstat($ARGV[0]); +if (!@stat) { + print \"nil\\n\"; + exit 0; +} if (($stat[2] & 0170000) == 0120000) { $type = readlink($ARGV[0]); @@ -1788,6 +1816,25 @@ while (my $data = <STDIN>) { Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") +(defconst tramp-vc-registered-read-file-names + "echo \"(\" +for file in \"$@\"; do + if %s $file; then + echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\" + else + echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\" + fi + if %s $file; then + echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\" + else + echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\" + fi +done +echo \")\"" + "Script to check existence of VC related files. +It must be send formatted with two strings; the tests for file +existence, and file readability.") + (defconst tramp-file-mode-type-map '((0 . "-") ; Normal file (SVID-v2 and XPG2) (1 . "p") ; fifo @@ -1938,6 +1985,11 @@ ARGS to actually emit the message (if applicable)." ;; The message. (insert (apply 'format fmt-string args))))) +(defvar tramp-message-show-message t + "Show Tramp message in the minibuffer. +This variable is used to disable messages from `tramp-error'. +The messages are visible anyway, because an error is raised.") + (defsubst tramp-message (vec-or-proc level fmt-string &rest args) "Emit a message depending on verbosity level. VEC-OR-PROC identifies the Tramp buffer to use. It can be either a @@ -1956,7 +2008,7 @@ applicable)." ;; Match data must be preserved! (save-match-data ;; Display only when there is a minimum level. - (when (<= level 3) + (when (and tramp-message-show-message (<= level 3)) (apply 'message (concat (cond @@ -1987,11 +2039,14 @@ applicable)." VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining args passed to `tramp-message'. Finally, signal SIGNAL is raised." - (tramp-message - vec-or-proc 1 "%s" - (error-message-string - (list signal (get signal 'error-message) (apply 'format fmt-string args)))) - (signal signal (list (apply 'format fmt-string args)))) + (let (tramp-message-show-message) + (tramp-message + vec-or-proc 1 "%s" + (error-message-string + (list signal + (get signal 'error-message) + (apply 'format fmt-string args)))) + (signal signal (list (apply 'format fmt-string args))))) (defsubst tramp-error-with-buffer (buffer vec-or-proc signal fmt-string &rest args) @@ -2196,9 +2251,9 @@ special handling of `substitute-in-file-name'." (add-hook 'rfn-eshadow-setup-minibuffer-hook 'tramp-rfn-eshadow-setup-minibuffer) (add-hook 'tramp-unload-hook - '(lambda () - (remove-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer)))) + (lambda () + (remove-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer)))) (defconst tramp-rfn-eshadow-update-overlay-regexp (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) @@ -2454,21 +2509,22 @@ target of the symlink differ." (defun tramp-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." (unless id-format (setq id-format 'integer)) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname (format "file-attributes-%s" id-format) - (when (file-exists-p filename) - ;; file exists, find out stuff + ;; Don't modify `last-coding-system-used' by accident. + (let ((last-coding-system-used last-coding-system-used)) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-file-property v localname (format "file-attributes-%s" id-format) (save-excursion (tramp-convert-file-attributes v - (if (tramp-get-remote-stat v) - (tramp-handle-file-attributes-with-stat v localname id-format) - (if (tramp-get-remote-perl v) - (tramp-handle-file-attributes-with-perl v localname id-format) - (tramp-handle-file-attributes-with-ls - v localname id-format))))))))) - -(defun tramp-handle-file-attributes-with-ls (vec localname &optional id-format) + (cond + ((tramp-get-remote-stat v) + (tramp-do-file-attributes-with-stat v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-file-attributes-with-perl v localname id-format)) + (t + (tramp-do-file-attributes-with-ls v localname id-format))))))))) + +(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format) "Implement `file-attributes' for Tramp files using the ls(1) command." (let (symlinkp dirp res-inode res-filemodes res-numlinks @@ -2476,84 +2532,89 @@ target of the symlink differ." (tramp-message vec 5 "file attributes with ls: %s" localname) (tramp-send-command vec - (format "%s %s %s" + (format "(%s %s || %s -h %s) && %s %s %s" + (tramp-get-file-exists-command vec) + (tramp-shell-quote-argument localname) + (tramp-get-test-command vec) + (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) (if (eq id-format 'integer) "-ildn" "-ild") (tramp-shell-quote-argument localname))) ;; parse `ls -l' output ... (with-current-buffer (tramp-get-buffer vec) - (goto-char (point-min)) - ;; ... inode - (setq res-inode - (condition-case err - (read (current-buffer)) - (invalid-read-syntax - (when (and (equal (cadr err) - "Integer constant overflow in reader") - (string-match - "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" - (car (cddr err)))) - (let* ((big (read (substring (car (cddr err)) 0 - (match-beginning 1)))) - (small (read (match-string 1 (car (cddr err))))) - (twiddle (/ small 65536))) - (cons (+ big twiddle) - (- small (* twiddle 65536)))))))) - ;; ... file mode flags - (setq res-filemodes (symbol-name (read (current-buffer)))) - ;; ... number links - (setq res-numlinks (read (current-buffer))) - ;; ... uid and gid - (setq res-uid (read (current-buffer))) - (setq res-gid (read (current-buffer))) - (if (eq id-format 'integer) - (progn - (unless (numberp res-uid) (setq res-uid -1)) - (unless (numberp res-gid) (setq res-gid -1))) - (progn - (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) - (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) - ;; ... size - (setq res-size (read (current-buffer))) - ;; From the file modes, figure out other stuff. - (setq symlinkp (eq ?l (aref res-filemodes 0))) - (setq dirp (eq ?d (aref res-filemodes 0))) - ;; if symlink, find out file name pointed to - (when symlinkp - (search-forward "-> ") - (setq res-symlink-target - (buffer-substring (point) (tramp-compat-line-end-position)))) - ;; return data gathered - (list - ;; 0. t for directory, string (name linked to) for symbolic - ;; link, or nil. - (or dirp res-symlink-target) - ;; 1. Number of links to file. - res-numlinks - ;; 2. File uid. - res-uid - ;; 3. File gid. - res-gid - ;; 4. Last access time, as a list of two integers. First - ;; integer has high-order 16 bits of time, second has low 16 - ;; bits. - ;; 5. Last modification time, likewise. - ;; 6. Last status change time, likewise. - '(0 0) '(0 0) '(0 0) ;CCC how to find out? - ;; 7. Size in bytes (-1, if number is out of range). - res-size - ;; 8. File modes, as a string of ten letters or dashes as in ls -l. - res-filemodes - ;; 9. t if file's gid would change if file were deleted and - ;; recreated. Will be set in `tramp-convert-file-attributes' - t - ;; 10. inode number. - res-inode - ;; 11. Device number. Will be replaced by a virtual device number. - -1 - )))) - -(defun tramp-handle-file-attributes-with-perl + (when (> (buffer-size) 0) + (goto-char (point-min)) + ;; ... inode + (setq res-inode + (condition-case err + (read (current-buffer)) + (invalid-read-syntax + (when (and (equal (cadr err) + "Integer constant overflow in reader") + (string-match + "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" + (car (cddr err)))) + (let* ((big (read (substring (car (cddr err)) 0 + (match-beginning 1)))) + (small (read (match-string 1 (car (cddr err))))) + (twiddle (/ small 65536))) + (cons (+ big twiddle) + (- small (* twiddle 65536)))))))) + ;; ... file mode flags + (setq res-filemodes (symbol-name (read (current-buffer)))) + ;; ... number links + (setq res-numlinks (read (current-buffer))) + ;; ... uid and gid + (setq res-uid (read (current-buffer))) + (setq res-gid (read (current-buffer))) + (if (eq id-format 'integer) + (progn + (unless (numberp res-uid) (setq res-uid -1)) + (unless (numberp res-gid) (setq res-gid -1))) + (progn + (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) + (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) + ;; ... size + (setq res-size (read (current-buffer))) + ;; From the file modes, figure out other stuff. + (setq symlinkp (eq ?l (aref res-filemodes 0))) + (setq dirp (eq ?d (aref res-filemodes 0))) + ;; if symlink, find out file name pointed to + (when symlinkp + (search-forward "-> ") + (setq res-symlink-target + (buffer-substring (point) (tramp-compat-line-end-position)))) + ;; return data gathered + (list + ;; 0. t for directory, string (name linked to) for symbolic + ;; link, or nil. + (or dirp res-symlink-target) + ;; 1. Number of links to file. + res-numlinks + ;; 2. File uid. + res-uid + ;; 3. File gid. + res-gid + ;; 4. Last access time, as a list of two integers. First + ;; integer has high-order 16 bits of time, second has low 16 + ;; bits. + ;; 5. Last modification time, likewise. + ;; 6. Last status change time, likewise. + '(0 0) '(0 0) '(0 0) ;CCC how to find out? + ;; 7. Size in bytes (-1, if number is out of range). + res-size + ;; 8. File modes, as a string of ten letters or dashes as in ls -l. + res-filemodes + ;; 9. t if file's gid would change if file were deleted and + ;; recreated. Will be set in `tramp-convert-file-attributes' + t + ;; 10. inode number. + res-inode + ;; 11. Device number. Will be replaced by a virtual device number. + -1 + ))))) + +(defun tramp-do-file-attributes-with-perl (vec localname &optional id-format) "Implement `file-attributes' for Tramp files using a Perl script." (tramp-message vec 5 "file attributes with perl: %s" localname) @@ -2564,14 +2625,18 @@ target of the symlink differ." (format "tramp_perl_file_attributes %s %s" (tramp-shell-quote-argument localname) id-format))) -(defun tramp-handle-file-attributes-with-stat +(defun tramp-do-file-attributes-with-stat (vec localname &optional id-format) "Implement `file-attributes' for Tramp files using stat(1) command." (tramp-message vec 5 "file attributes with stat: %s" localname) (tramp-send-command-and-read vec (format - "%s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s" + "((%s %s || %s -h %s) && %s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)" + (tramp-get-file-exists-command vec) + (tramp-shell-quote-argument localname) + (tramp-get-test-command vec) + (tramp-shell-quote-argument localname) (tramp-get-remote-stat vec) (if (eq id-format 'integer) "%u" "\"%U\"") (if (eq id-format 'integer) "%g" "\"%G\"") @@ -2593,7 +2658,7 @@ target of the symlink differ." (when (boundp 'last-coding-system-used) (setq coding-system-used (symbol-value 'last-coding-system-used))) ;; We use '(0 0) as a don't-know value. See also - ;; `tramp-handle-file-attributes-with-ls'. + ;; `tramp-do-file-attributes-with-ls'. (if (not (equal modtime '(0 0))) (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) (progn @@ -2719,27 +2784,29 @@ and gid of the corresponding user is taken. Both parameters must be integers." ;; another implementation, see `dired-do-chown'. OTOH, it is mostly ;; working with su(do)? when it is needed, so it shall succeed in ;; the majority of cases. - (if (file-remote-p filename) - (with-parsed-tramp-file-name filename nil - (if (and (zerop (user-uid)) (tramp-local-host-p v)) - ;; If we are root on the local host, we can do it directly. - (tramp-set-file-uid-gid localname uid gid) - (let ((uid (or (and (integerp uid) uid) - (tramp-get-remote-uid v 'integer))) - (gid (or (and (integerp gid) gid) - (tramp-get-remote-gid v 'integer)))) - (tramp-send-command - v (format - "chown %d:%d %s" uid gid - (tramp-shell-quote-argument localname)))))) - - ;; We handle also the local part, because there doesn't exist - ;; `set-file-uid-gid'. On W32 "chown" might not work. - (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer))) - (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))) - (tramp-local-call-process - "chown" nil nil nil - (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))) + ;; Don't modify `last-coding-system-used' by accident. + (let ((last-coding-system-used last-coding-system-used)) + (if (file-remote-p filename) + (with-parsed-tramp-file-name filename nil + (if (and (zerop (user-uid)) (tramp-local-host-p v)) + ;; If we are root on the local host, we can do it directly. + (tramp-set-file-uid-gid localname uid gid) + (let ((uid (or (and (integerp uid) uid) + (tramp-get-remote-uid v 'integer))) + (gid (or (and (integerp gid) gid) + (tramp-get-remote-gid v 'integer)))) + (tramp-send-command + v (format + "chown %d:%d %s" uid gid + (tramp-shell-quote-argument localname)))))) + + ;; We handle also the local part, because there doesn't exist + ;; `set-file-uid-gid'. On W32 "chown" might not work. + (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer))) + (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))) + (tramp-local-call-process + "chown" nil nil nil + (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))) ;; Simple functions using the `test' command. @@ -2913,15 +2980,16 @@ value of `default-file-modes', without execute permissions." (format "directory-files-and-attributes-%s" id-format) (save-excursion (mapcar - '(lambda (x) - (cons (car x) - (tramp-convert-file-attributes v (cdr x)))) - (if (tramp-get-remote-stat v) - (tramp-handle-directory-files-and-attributes-with-stat - v localname id-format) - (if (tramp-get-remote-perl v) - (tramp-handle-directory-files-and-attributes-with-perl - v localname id-format))))))))) + (lambda (x) + (cons (car x) + (tramp-convert-file-attributes v (cdr x)))) + (cond + ((tramp-get-remote-stat v) + (tramp-do-directory-files-and-attributes-with-stat + v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-directory-files-and-attributes-with-perl + v localname id-format))))))))) result item) (while temp @@ -2935,7 +3003,7 @@ value of `default-file-modes', without execute permissions." result (sort result (lambda (x y) (string< (car x) (car y)))))))) -(defun tramp-handle-directory-files-and-attributes-with-perl +(defun tramp-do-directory-files-and-attributes-with-perl (vec localname &optional id-format) "Implement `directory-files-and-attributes' for Tramp files using a Perl script." (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname) @@ -2950,7 +3018,7 @@ value of `default-file-modes', without execute permissions." (when (stringp object) (tramp-error vec 'file-error object)) object)) -(defun tramp-handle-directory-files-and-attributes-with-stat +(defun tramp-do-directory-files-and-attributes-with-stat (vec localname &optional id-format) "Implement `directory-files-and-attributes' for Tramp files using stat(1) command." (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname) @@ -3149,9 +3217,8 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." ok-if-already-exists keep-date preserve-uid-gid)) ;; Try out-of-band operation. - ((and (tramp-method-out-of-band-p v1) - (> (nth 7 (file-attributes filename)) - tramp-copy-size-limit)) + ((tramp-method-out-of-band-p + v1 (nth 7 (file-attributes filename))) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date)) @@ -3180,9 +3247,7 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." ;; If the Tramp file has an out-of-band method, the corresponding ;; copy-program can be invoked. - ((and (tramp-method-out-of-band-p v) - (> (nth 7 (file-attributes filename)) - tramp-copy-size-limit)) + ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename))) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date)) @@ -3298,10 +3363,11 @@ the uid and gid from FILENAME." 'rename-file (list localname1 localname2 ok-if-already-exists)))) ;; We can do it directly with `tramp-send-command' - ((let (file-name-handler-alist) - (and (file-readable-p (concat prefix localname1)) - (file-writable-p - (file-name-directory (concat prefix localname2))))) + ((and (file-readable-p (concat prefix localname1)) + (file-writable-p + (file-name-directory (concat prefix localname2))) + (or (file-directory-p (concat prefix localname2)) + (file-writable-p (concat prefix localname2)))) (tramp-do-copy-or-rename-file-directly op (concat prefix localname1) (concat prefix localname2) ok-if-already-exists keep-date t) @@ -3392,7 +3458,7 @@ the uid and gid from FILENAME." The method used must be an out-of-band method." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - copy-program copy-args copy-keep-date port spec + copy-program copy-args copy-env copy-keep-date port spec source target) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -3439,13 +3505,21 @@ The method used must be an out-of-band method." (delq nil (mapcar - '(lambda (x) - (setq - x - ;; " " is indication for keep-date argument. - (delete " " (mapcar '(lambda (y) (format-spec y spec)) x))) - (unless (member "" x) (mapconcat 'identity x " "))) - (tramp-get-method-parameter method 'tramp-copy-args)))) + (lambda (x) + (setq + x + ;; " " is indication for keep-date argument. + (delete " " (mapcar (lambda (y) (format-spec y spec)) x))) + (unless (member "" x) (mapconcat 'identity x " "))) + (tramp-get-method-parameter method 'tramp-copy-args))) + copy-env + (delq + nil + (mapcar + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) (mapconcat 'identity x " "))) + (tramp-get-method-parameter method 'tramp-copy-env)))) ;; Check for program. (when (and (fboundp 'executable-find) @@ -3459,12 +3533,16 @@ The method used must be an out-of-band method." (with-temp-buffer ;; The default directory must be remote. (let ((default-directory - (file-name-directory (if t1 filename newname)))) + (file-name-directory (if t1 filename newname))) + (process-environment (copy-sequence process-environment))) ;; Set the transfer process properties. (tramp-set-connection-property v "process-name" (buffer-name (current-buffer))) (tramp-set-connection-property v "process-buffer" (current-buffer)) + (while copy-env + (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env)) + (setenv (pop copy-env) (pop copy-env))) ;; Use an asynchronous process. By this, password can ;; be handled. The default directory must be local, in @@ -3575,10 +3653,10 @@ This is like `dired-recursive-delete-directory' for Tramp files." ;; XEmacs has `dired-compression-method-alist', which is ;; transformed into `dired-compress-file-suffixes' structure. (mapcar - '(lambda (x) - (list (concat (regexp-quote (nth 1 x)) "\\'") - nil - (mapconcat 'identity (nth 3 x) " "))) + (lambda (x) + (list (concat (regexp-quote (nth 1 x)) "\\'") + nil + (mapconcat 'identity (nth 3 x) " "))) (symbol-value 'dired-compression-method-alist)))) suffix) ;; See if any suffix rule matches this file name. @@ -3701,10 +3779,9 @@ This is like `dired-recursive-delete-directory' for Tramp files." (buffer-string))) ;; Check for "--dired" output. - (goto-char (point-max)) (forward-line -2) (when (looking-at "//DIRED//") - (let ((end (line-end-position)) + (let ((end (tramp-compat-line-end-position)) (linebeg (point))) ;; Now read the numeric positions of file names. (goto-char linebeg) @@ -3713,16 +3790,14 @@ This is like `dired-recursive-delete-directory' for Tramp files." (while (< (point) end) (let ((start (+ beg (read (current-buffer)))) (end (+ beg (read (current-buffer))))) - (if (memq (char-after end) '(?\n ?\s)) + (if (memq (char-after end) '(?\n ?\ )) ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t))))) - ;; Reove training lines. - (goto-char (point-max)) - (forward-line -1) + ;; Remove trailing lines. + (goto-char (tramp-compat-line-beginning-position)) (while (looking-at "//") (forward-line 1) - (delete-region (match-beginning 0) (point)) - (forward-line -1)))) + (delete-region (match-beginning 0) (point))))) (goto-char (point-max))))) (defun tramp-handle-unhandled-file-name-directory (filename) @@ -3839,21 +3914,21 @@ beginning of local filename are not substituted." ;; which calls corresponding functions (see minibuf.el). (when (fboundp 'minibuffer-electric-separator) (mapc - '(lambda (x) - (eval - `(defadvice ,x - (around ,(intern (format "tramp-advice-%s" x)) activate) - "Invoke `substitute-in-file-name' for Tramp files." - (if (and (symbol-value 'minibuffer-electric-file-name-behavior) - (tramp-tramp-file-p (buffer-substring))) - ;; We don't need to handle `last-input-event', because - ;; due to the key map we know it must be ?/ or ?~. - (let ((s (concat (buffer-substring (point-min) (point)) - (string last-command-char)))) - (delete-region (point-min) (point)) - (insert (substitute-in-file-name s)) - (setq ad-return-value last-command-char)) - ad-do-it)))) + (lambda (x) + (eval + `(defadvice ,x + (around ,(intern (format "tramp-advice-%s" x)) activate) + "Invoke `substitute-in-file-name' for Tramp files." + (if (and (symbol-value 'minibuffer-electric-file-name-behavior) + (tramp-tramp-file-p (buffer-substring))) + ;; We don't need to handle `last-input-event', because + ;; due to the key map we know it must be ?/ or ?~. + (let ((s (concat (buffer-substring (point-min) (point)) + (string last-command-char)))) + (delete-region (point-min) (point)) + (insert (substitute-in-file-name s)) + (setq ad-return-value last-command-char)) + ad-do-it)))) '(minibuffer-electric-separator minibuffer-electric-tilde))) @@ -4015,7 +4090,15 @@ beginning of local filename are not substituted." ;; Cleanup. We remove all file cache values for the connection, ;; because the remote process could have changed them. (when tmpinput (delete-file tmpinput)) - (tramp-flush-directory-property v "") + + ;; `process-file-side-effects' has been introduced with GNU + ;; Emacs 23.2. If set to `nil', no remote file will be changed + ;; by `program'. If it doesn't exist, we assume its default + ;; value 't'. + (unless (and (boundp 'process-file-side-effects) + (not (symbol-value 'process-file-side-effects))) + (tramp-flush-directory-property v "")) + ;; Return exit status. (if (equal ret -1) (keyboard-quit) @@ -4146,9 +4229,8 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." (cond ;; `copy-file' handles direct copy and out-of-band methods. ((or (tramp-local-host-p v) - (and (tramp-method-out-of-band-p v) - (> (nth 7 (file-attributes filename)) - tramp-copy-size-limit))) + (tramp-method-out-of-band-p + v (nth 7 (file-attributes filename)))) (copy-file filename tmpfile t t)) ;; Use inline encoding for file transfer. @@ -4173,13 +4255,19 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." v 5 "Decoding remote file %s with function %s..." filename loc-dec) (funcall loc-dec (point-min) (point-max)) - (let ((coding-system-for-write 'binary)) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) (write-region (point-min) (point-max) tmpfile))) ;; If tramp-decoding-function is not defined for this ;; method, we invoke tramp-decoding-command instead. (let ((tmpfile2 (tramp-compat-make-temp-file filename))) - (let ((coding-system-for-write 'binary)) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) (write-region (point-min) (point-max) tmpfile2)) (tramp-message v 5 "Decoding remote file %s with command %s..." @@ -4365,14 +4453,14 @@ coding system might not be determined. This function repairs it." (when (boundp 'backup-directory-alist) (if (symbol-value 'tramp-backup-directory-alist) (mapcar - '(lambda (x) - (cons - (car x) - (if (and (stringp (cdr x)) - (file-name-absolute-p (cdr x)) - (not (tramp-file-name-p (cdr x)))) - (tramp-make-tramp-file-name method user host (cdr x)) - (cdr x)))) + (lambda (x) + (cons + (car x) + (if (and (stringp (cdr x)) + (file-name-absolute-p (cdr x)) + (not (tramp-file-name-p (cdr x)))) + (tramp-make-tramp-file-name method user host (cdr x)) + (cdr x)))) (symbol-value 'tramp-backup-directory-alist)) (symbol-value 'backup-directory-alist)))) @@ -4381,17 +4469,17 @@ coding system might not be determined. This function repairs it." (when (boundp 'bkup-backup-directory-info) (if (symbol-value 'tramp-bkup-backup-directory-info) (mapcar - '(lambda (x) - (nconc - (list (car x)) - (list - (if (and (stringp (car (cdr x))) - (file-name-absolute-p (car (cdr x))) - (not (tramp-file-name-p (car (cdr x))))) - (tramp-make-tramp-file-name - method user host (car (cdr x))) - (car (cdr x)))) - (cdr (cdr x)))) + (lambda (x) + (nconc + (list (car x)) + (list + (if (and (stringp (car (cdr x))) + (file-name-absolute-p (car (cdr x))) + (not (tramp-file-name-p (car (cdr x))))) + (tramp-make-tramp-file-name + method user host (car (cdr x))) + (car (cdr x)))) + (cdr (cdr x)))) (symbol-value 'tramp-bkup-backup-directory-info)) (symbol-value 'bkup-backup-directory-info))))) @@ -4415,12 +4503,12 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; all other cases we must do it ourselves. (when (boundp 'auto-save-file-name-transforms) (mapc - '(lambda (x) - (when (and (string-match (car x) buffer-file-name) - (not (car (cddr x)))) - (setq tramp-auto-save-directory - (or tramp-auto-save-directory - (tramp-compat-temporary-file-directory))))) + (lambda (x) + (when (and (string-match (car x) buffer-file-name) + (not (car (cddr x)))) + (setq tramp-auto-save-directory + (or tramp-auto-save-directory + (tramp-compat-temporary-file-directory))))) (symbol-value 'auto-save-file-name-transforms))) ;; Create directory. (when tramp-auto-save-directory @@ -4540,9 +4628,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (cond ;; `rename-file' handles direct copy and out-of-band methods. ((or (tramp-local-host-p v) - (and (tramp-method-out-of-band-p v) - (> (- (or end (point-max)) (or start (point-min))) - tramp-copy-size-limit))) + (tramp-method-out-of-band-p + v (- (or end (point-max)) (or start (point-min))))) (condition-case err (rename-file tmpfile filename t) ((error quit) @@ -4664,12 +4751,64 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook))))) +(defvar tramp-vc-registered-file-names nil + "List used to collect file names, which are checked during `vc-registered'.") + +;; VC backends check for the existence of various different special +;; files. This is very time consuming, because every single check +;; requires a remote command (the file cache must be invalidated). +;; Therefore, we apply a kind of optimization. We install the file +;; name handler `tramp-vc-file-name-handler', which does nothing but +;; remembers all file names for which `file-exists-p' or +;; `file-readable-p' has been applied. A first run of `vc-registered' +;; is performed. Afterwards, a script is applied for all collected +;; file names, using just one remote command. The result of this +;; script is used to fill the file cache with actual values. Now we +;; can reset the file name handlers, and we make a second run of +;; `vc-registered', which returns the expected result without sending +;; any other remote command. (defun tramp-handle-vc-registered (file) "Like `vc-registered' for Tramp files." - ;; There could be new files, created by the vc backend. We disable - ;; the file cache therefore. - (let ((tramp-cache-inhibit-cache t)) - (tramp-run-real-handler 'vc-registered (list file)))) + (with-parsed-tramp-file-name file nil + + ;; There could be new files, created by the vc backend. We cannot + ;; reuse the old cache entries, therefore. + (let (tramp-vc-registered-file-names + (tramp-cache-inhibit-cache (current-time)) + (file-name-handler-alist + `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) + + ;; Here we collect only file names, which need an operation. + (tramp-run-real-handler 'vc-registered (list file)) + (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) + + ;; Send just one command, in order to fill the cache. + (when tramp-vc-registered-file-names + (tramp-maybe-send-script + v + (format tramp-vc-registered-read-file-names + (tramp-get-file-exists-command v) + (format "%s -r" (tramp-get-test-command v))) + "tramp_vc_registered_read_file_names") + + (dolist + (elt + (tramp-send-command-and-read + v + (format + "tramp_vc_registered_read_file_names %s" + (mapconcat 'tramp-shell-quote-argument + tramp-vc-registered-file-names + " ")))) + + (tramp-set-file-property v (car elt) (cadr elt) (cadr (cdr elt)))))) + + ;; Second run. Now all `file-exists-p' or `file-readable-p' calls + ;; shall be answered from the file cache. + ;; We unset `process-file-side-effects' in order to keep the cache + ;; when `process-file' calls appear. + (let (process-file-side-effects) + (tramp-run-real-handler 'vc-registered (list file))))) ;;;###autoload (progn (defun tramp-run-real-handler (operation args) @@ -4678,6 +4817,7 @@ First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (let* ((inhibit-file-name-handlers `(tramp-file-name-handler + tramp-vc-file-name-handler tramp-completion-file-name-handler cygwin-mount-name-hook-function cygwin-mount-map-drive-hook-function @@ -4881,6 +5021,30 @@ Fall back to normal file name handler if no Tramp handler exists." (tramp-run-real-handler operation args)))))) (setq tramp-locked tl)))) +(defun tramp-vc-file-name-handler (operation &rest args) + "Invoke special file name handler, which collects files to be handled." + (save-match-data + (let ((filename + (tramp-replace-environment-variables + (apply 'tramp-file-name-for-operation operation args))) + (fn (assoc operation tramp-file-name-handler-alist))) + (with-parsed-tramp-file-name filename nil + (cond + ;; That's what we want: file names, for which checks are + ;; applied. We assume, that VC uses only `file-exists-p' and + ;; `file-readable-p' checks; otherwise we must extend the + ;; list. We do not perform any action, but return nil, in + ;; order to keep `vc-registered' running. + ((and fn (memq operation '(file-exists-p file-readable-p))) + (add-to-list 'tramp-vc-registered-file-names localname 'append) + nil) + ;; Tramp file name handlers like `expand-file-name'. They + ;; must still work. + (fn + (save-match-data (apply (cdr fn) args))) + ;; Default file name handlers, we don't care. + (t (tramp-run-real-handler operation args))))))) + ;;;###autoload (progn (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler. @@ -4889,73 +5053,54 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; would otherwise use backslash. (let ((directory-sep-char ?/) (fn (assoc operation tramp-completion-file-name-handler-alist))) - ;; When `tramp-mode' is not enabled, we don't do anything. - (if (and fn tramp-mode) + (if (and + ;; When `tramp-mode' is not enabled, we don't do anything. + fn tramp-mode + ;; For other syntaxes than `sep', the regexp matches many common + ;; situations where the user doesn't actually want to use Tramp. + ;; So to avoid autoloading Tramp after typing just "/s", we + ;; disable this part of the completion, unless the user implicitly + ;; indicated his interest in using a fancier completion system. + (or (eq tramp-syntax 'sep) + (featurep 'tramp) ; If it's loaded, we may as well use it. + (and (boundp 'partial-completion-mode) partial-completion-mode) + ;; FIXME: These may have been loaded even if the user never + ;; intended to use them. + (featurep 'ido) + (featurep 'icicles))) (save-match-data (apply (cdr fn) args)) (tramp-completion-run-real-handler operation args))))) ;;;###autoload -(defsubst tramp-register-file-name-handler () - "Add Tramp file name handler to `file-name-handler-alist'." - ;; Remove autoloaded handler from file name handler alist. Useful, +(progn (defun tramp-register-file-name-handlers () + "Add Tramp file name handlers to `file-name-handler-alist'." + ;; Remove autoloaded handlers from file name handler alist. Useful, ;; if `tramp-syntax' has been changed. (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist))) - (setq file-name-handler-alist (delete a1 file-name-handler-alist))) - ;; Add the handler. + (setq file-name-handler-alist (delq a1 file-name-handler-alist))) + (let ((a1 (rassq + 'tramp-completion-file-name-handler file-name-handler-alist))) + (setq file-name-handler-alist (delq a1 file-name-handler-alist))) + ;; Add the handlers. (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp 'tramp-file-name-handler)) - ;; If jka-compr is already loaded, move it to the front of - ;; `file-name-handler-alist'. - (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist))) - (when jka - (setq file-name-handler-alist - (cons jka (delete jka file-name-handler-alist)))))) + (add-to-list 'file-name-handler-alist + (cons tramp-completion-file-name-regexp + 'tramp-completion-file-name-handler)) + (put 'tramp-completion-file-name-handler 'safe-magic t) + ;; If jka-compr or epa-file are already loaded, move them to the + ;; front of `file-name-handler-alist'. + (dolist (fnh '(epa-file-handler jka-compr-handler)) + (let ((entry (rassoc fnh file-name-handler-alist))) + (when entry + (setq file-name-handler-alist + (cons entry (delete entry file-name-handler-alist)))))))) ;; `tramp-file-name-handler' must be registered before evaluation of ;; site-start and init files, because there might exist remote files ;; already, f.e. files kept via recentf-mode. -;;;###autoload(tramp-register-file-name-handler) -(tramp-register-file-name-handler) - -;;;###autoload -(defsubst tramp-register-completion-file-name-handler () - "Add Tramp completion file name handler to `file-name-handler-alist'." - ;; Remove autoloaded handler from file name handler alist. Useful, - ;; if `tramp-syntax' has been changed. - (let ((a1 (rassq - 'tramp-completion-file-name-handler file-name-handler-alist))) - (setq file-name-handler-alist (delete a1 file-name-handler-alist))) - ;; In XEmacs, there is another Tramp syntax, so we can enable this - ;; unconditionally. In GNU Emacs <= 22, method/user/host name - ;; completion shall be bound to `partial-completion-mode'. Starting - ;; with GNU Emacs 23, this is replaced by `completion-styles', - ;; containing symbol `partial-completion'. `ido-mode' and - ;; `icy-mode' are other packages which extend file name completion. - (when (or (and (boundp 'partial-completion-mode) - (symbol-value 'partial-completion-mode)) - (and (boundp 'completion-styles) - (member 'partial-completion (symbol-value 'completion-styles))) - (featurep 'xemacs) - (featurep 'ido) - (featurep 'icicles)) - (add-to-list 'file-name-handler-alist - (cons tramp-completion-file-name-regexp - 'tramp-completion-file-name-handler)) - (put 'tramp-completion-file-name-handler 'safe-magic t)) - ;; If jka-compr is already loaded, move it to the front of - ;; `file-name-handler-alist'. - (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist))) - (when jka - (setq file-name-handler-alist - (cons jka (delete jka file-name-handler-alist)))))) - -;; During autoload, it shall be checked whether -;; `partial-completion-mode' is active. Therefore, registering of -;; `tramp-completion-file-name-handler' will be delayed. -;;;###autoload(add-hook -;;;###autoload 'after-init-hook -;;;###autoload 'tramp-register-completion-file-name-handler) -(tramp-register-completion-file-name-handler) +;;;###autoload(tramp-register-file-name-handlers) +(tramp-register-file-name-handlers) ;;;###autoload (defun tramp-unload-file-name-handlers () @@ -5569,8 +5714,8 @@ Only send the definition if it has not already been done." (auto-save-mode 1))) (add-hook 'find-file-hooks 'tramp-set-auto-save t) (add-hook 'tramp-unload-hook - '(lambda () - (remove-hook 'find-file-hooks 'tramp-set-auto-save))) + (lambda () + (remove-hook 'find-file-hooks 'tramp-set-auto-save))) (defun tramp-run-test (switch filename) "Run `test' on the remote system, given a SWITCH and a FILENAME. @@ -6699,9 +6844,9 @@ connection if a previous connection has died for some reason." (concat command " " (mapconcat - '(lambda (x) - (setq x (mapcar '(lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (mapconcat 'identity x " "))) + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) (mapconcat 'identity x " "))) login-args " ") ;; Local shell could be a Windows COMSPEC. It doesn't ;; know the ";" syntax, but we must exit always for @@ -6927,61 +7072,62 @@ the remote host use line-endings as defined in the variable "Convert file-attributes ATTR generated by perl script, stat or ls. Convert file mode bits to string and set virtual device number. Return ATTR." - ;; Convert last access time. - (unless (listp (nth 4 attr)) - (setcar (nthcdr 4 attr) - (list (floor (nth 4 attr) 65536) - (floor (mod (nth 4 attr) 65536))))) - ;; Convert last modification time. - (unless (listp (nth 5 attr)) - (setcar (nthcdr 5 attr) - (list (floor (nth 5 attr) 65536) - (floor (mod (nth 5 attr) 65536))))) - ;; Convert last status change time. - (unless (listp (nth 6 attr)) - (setcar (nthcdr 6 attr) - (list (floor (nth 6 attr) 65536) - (floor (mod (nth 6 attr) 65536))))) - ;; Convert file size. - (when (< (nth 7 attr) 0) - (setcar (nthcdr 7 attr) -1)) - (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) - (setcar (nthcdr 7 attr) (round (nth 7 attr)))) - ;; Convert file mode bits to string. - (unless (stringp (nth 8 attr)) - (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))) - (when (stringp (car attr)) - (aset (nth 8 attr) 0 ?l))) - ;; Convert directory indication bit. - (when (string-match "^d" (nth 8 attr)) - (setcar attr t)) - ;; Convert symlink from `tramp-handle-file-attributes-with-stat'. - (when (consp (car attr)) - (if (and (stringp (caar attr)) - (string-match ".+ -> .\\(.+\\)." (caar attr))) - (setcar attr (match-string 1 (caar attr))) - (setcar attr nil))) - ;; Set file's gid change bit. - (setcar (nthcdr 9 attr) - (if (numberp (nth 3 attr)) - (not (= (nth 3 attr) - (tramp-get-remote-gid vec 'integer))) - (not (string-equal - (nth 3 attr) - (tramp-get-remote-gid vec 'string))))) - ;; Convert inode. - (unless (listp (nth 10 attr)) - (setcar (nthcdr 10 attr) - (condition-case nil - (cons (floor (nth 10 attr) 65536) - (floor (mod (nth 10 attr) 65536))) - ;; Inodes can be incredible huge. We must hide this. - (error (tramp-get-inode vec))))) - ;; Set virtual device number. - (setcar (nthcdr 11 attr) - (tramp-get-device vec)) - attr) + (when attr + ;; Convert last access time. + (unless (listp (nth 4 attr)) + (setcar (nthcdr 4 attr) + (list (floor (nth 4 attr) 65536) + (floor (mod (nth 4 attr) 65536))))) + ;; Convert last modification time. + (unless (listp (nth 5 attr)) + (setcar (nthcdr 5 attr) + (list (floor (nth 5 attr) 65536) + (floor (mod (nth 5 attr) 65536))))) + ;; Convert last status change time. + (unless (listp (nth 6 attr)) + (setcar (nthcdr 6 attr) + (list (floor (nth 6 attr) 65536) + (floor (mod (nth 6 attr) 65536))))) + ;; Convert file size. + (when (< (nth 7 attr) 0) + (setcar (nthcdr 7 attr) -1)) + (when (and (floatp (nth 7 attr)) + (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) + (setcar (nthcdr 7 attr) (round (nth 7 attr)))) + ;; Convert file mode bits to string. + (unless (stringp (nth 8 attr)) + (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))) + (when (stringp (car attr)) + (aset (nth 8 attr) 0 ?l))) + ;; Convert directory indication bit. + (when (string-match "^d" (nth 8 attr)) + (setcar attr t)) + ;; Convert symlink from `tramp-do-file-attributes-with-stat'. + (when (consp (car attr)) + (if (and (stringp (caar attr)) + (string-match ".+ -> .\\(.+\\)." (caar attr))) + (setcar attr (match-string 1 (caar attr))) + (setcar attr nil))) + ;; Set file's gid change bit. + (setcar (nthcdr 9 attr) + (if (numberp (nth 3 attr)) + (not (= (nth 3 attr) + (tramp-get-remote-gid vec 'integer))) + (not (string-equal + (nth 3 attr) + (tramp-get-remote-gid vec 'string))))) + ;; Convert inode. + (unless (listp (nth 10 attr)) + (setcar (nthcdr 10 attr) + (condition-case nil + (cons (floor (nth 10 attr) 65536) + (floor (mod (nth 10 attr) 65536))) + ;; Inodes can be incredible huge. We must hide this. + (error (tramp-get-inode vec))))) + ;; Set virtual device number. + (setcar (nthcdr 11 attr) + (tramp-get-device vec)) + attr)) (defun tramp-get-inode (vec) "Returns the virtual inode number. @@ -7257,9 +7403,15 @@ necessary only. This function will be used in file name completion." (format "%s@%s:%s" user host localname) (format "%s:%s" host localname)))) -(defun tramp-method-out-of-band-p (vec) +(defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." - (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)) + (and + ;; It shall be an out-of-band method. + (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program) + ;; Either the file size is large enough, or (in rare cases) there + ;; does not exist a remote encoding. + (or (> size tramp-copy-size-limit) + (null (tramp-get-remote-coding vec "remote-encoding"))))) (defun tramp-local-host-p (vec) "Return t if this points to the local host, nil otherwise." @@ -7369,39 +7521,33 @@ necessary only. This function will be used in file name completion." (defun tramp-get-ls-command (vec) (with-connection-property vec "ls" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding a suitable `ls' command") - (or - (catch 'ls-found - (dolist (cmd '("ls" "gnuls" "gls")) - (let ((dl (tramp-get-remote-path vec)) - result) - (while - (and - dl - (setq result - (tramp-find-executable vec cmd dl t t))) - ;; Check parameter. - (when (zerop (tramp-send-command-and-check - vec (format "%s -lnd /" result))) - (throw 'ls-found result)) - (setq dl (cdr dl)))))) - (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))) + (tramp-message vec 5 "Finding a suitable `ls' command") + (or + (catch 'ls-found + (dolist (cmd '("ls" "gnuls" "gls")) + (let ((dl (tramp-get-remote-path vec)) + result) + (while (and dl (setq result (tramp-find-executable vec cmd dl t t))) + ;; Check parameter. + (when (zerop (tramp-send-command-and-check + vec (format "%s -lnd /" result))) + (throw 'ls-found result)) + (setq dl (cdr dl)))))) + (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))) (defun tramp-get-ls-command-with-dired (vec) (save-match-data (with-connection-property vec "ls-dired" (tramp-message vec 5 "Checking, whether `ls --dired' works") (zerop (tramp-send-command-and-check - vec (format "%s --diredd /" (tramp-get-ls-command vec))))))) + vec (format "%s --dired /" (tramp-get-ls-command vec))))))) (defun tramp-get-test-command (vec) (with-connection-property vec "test" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding a suitable `test' command") - (if (zerop (tramp-send-command-and-check vec "test 0")) - "test" - (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))) + (tramp-message vec 5 "Finding a suitable `test' command") + (if (zerop (tramp-send-command-and-check vec "test 0")) + "test" + (tramp-find-executable vec "test" (tramp-get-remote-path vec))))) (defun tramp-get-test-nt-command (vec) ;; Does `test A -nt B' work? Use abominable `find' construct if it @@ -7426,65 +7572,56 @@ necessary only. This function will be used in file name completion." (defun tramp-get-file-exists-command (vec) (with-connection-property vec "file-exists" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding command to check if file exists") - (tramp-find-file-exists-command vec)))) + (tramp-message vec 5 "Finding command to check if file exists") + (tramp-find-file-exists-command vec))) (defun tramp-get-remote-ln (vec) (with-connection-property vec "ln" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding a suitable `ln' command") - (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))) + (tramp-message vec 5 "Finding a suitable `ln' command") + (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) (defun tramp-get-remote-perl (vec) (with-connection-property vec "perl" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding a suitable `perl' command") - (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) - (tramp-find-executable vec "perl" (tramp-get-remote-path vec)))))) + (tramp-message vec 5 "Finding a suitable `perl' command") + (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) + (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))) (defun tramp-get-remote-stat (vec) (with-connection-property vec "stat" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding a suitable `stat' command") - (let ((result (tramp-find-executable - vec "stat" (tramp-get-remote-path vec))) - tmp) - ;; Check whether stat(1) returns usable syntax. %s does not - ;; work on older AIX systems. - (when result - (setq tmp - ;; We don't want to display an error message. - (with-temp-message (or (current-message) "") - (condition-case nil - (tramp-send-command-and-read - vec (format "%s -c '(\"%%N\" %%s)' /" result)) - (error nil)))) - (unless (and (listp tmp) (stringp (car tmp)) - (string-match "^./.$" (car tmp)) - (integerp (cadr tmp))) - (setq result nil))) - result)))) + (tramp-message vec 5 "Finding a suitable `stat' command") + (let ((result (tramp-find-executable + vec "stat" (tramp-get-remote-path vec))) + tmp) + ;; Check whether stat(1) returns usable syntax. %s does not + ;; work on older AIX systems. + (when result + (setq tmp + ;; We don't want to display an error message. + (with-temp-message (or (current-message) "") + (condition-case nil + (tramp-send-command-and-read + vec (format "%s -c '(\"%%N\" %%s)' /" result)) + (error nil)))) + (unless (and (listp tmp) (stringp (car tmp)) + (string-match "^./.$" (car tmp)) + (integerp (cadr tmp))) + (setq result nil))) + result))) (defun tramp-get-remote-id (vec) (with-connection-property vec "id" - (with-current-buffer (tramp-get-buffer vec) - (tramp-message vec 5 "Finding POSIX `id' command") - (or - (catch 'id-found - (let ((dl (tramp-get-remote-path vec)) - result) - (while - (and - dl - (setq result - (tramp-find-executable vec "id" dl t t))) - ;; Check POSIX parameter. - (when (zerop (tramp-send-command-and-check - vec (format "%s -u" result))) - (throw 'id-found result)) - (setq dl (cdr dl))))) - (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))) + (tramp-message vec 5 "Finding POSIX `id' command") + (or + (catch 'id-found + (let ((dl (tramp-get-remote-path vec)) + result) + (while (and dl (setq result (tramp-find-executable vec "id" dl t t))) + ;; Check POSIX parameter. + (when (zerop (tramp-send-command-and-check + vec (format "%s -u" result))) + (throw 'id-found result)) + (setq dl (cdr dl))))) + (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))) (defun tramp-get-remote-uid (vec id-format) (with-connection-property vec (format "uid-%s" id-format) @@ -7559,12 +7696,12 @@ If the `tramp-methods' entry does not exist, return NIL." (file-name-handler-alist (list (cons "/" - '(lambda (operation &rest args) - "Returns OPERATION if it is the one to be checked." - (if (equal check-file-name-operation operation) - operation - (let ((file-name-handler-alist fnha)) - (apply operation args)))))))) + (lambda (operation &rest args) + "Returns OPERATION if it is the one to be checked." + (if (equal check-file-name-operation operation) + operation + (let ((file-name-handler-alist fnha)) + (apply operation args)))))))) (equal (apply operation args) operation)) (error nil))) @@ -7573,10 +7710,13 @@ If the `tramp-methods' entry does not exist, return NIL." (around tramp-advice-make-auto-save-file-name () activate) "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files." (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))) - (setq ad-return-value (tramp-handle-make-auto-save-file-name)) + ;; We cannot call `tramp-handle-make-auto-save-file-name' + ;; directly, because this would bypass the locking mechanism. + (setq ad-return-value + (tramp-file-name-handler 'make-auto-save-file-name)) ad-do-it)) (add-hook 'tramp-unload-hook - '(lambda () (ad-unadvise 'make-auto-save-file-name)))) + (lambda () (ad-unadvise 'make-auto-save-file-name)))) ;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have ;; permission 0666 minus umask. This is a security threat. @@ -7603,8 +7743,8 @@ If the `tramp-methods' entry does not exist, return NIL." (> emacs-minor-version 4))) (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes) (add-hook 'tramp-unload-hook - '(lambda () - (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)))) + (lambda () + (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)))) (defun tramp-subst-strs-in-string (alist string) "Replace all occurrences of the string FROM with TO in STRING. @@ -7813,7 +7953,7 @@ Only works for Bourne-like shells." ;; If it is not a Tramp file, just run the original function. (setq ad-return-value (or ad-do-it (list name)))))) (add-hook 'tramp-unload-hook - '(lambda () (ad-unadvise 'file-expand-wildcards)))) + (lambda () (ad-unadvise 'file-expand-wildcards)))) ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages @@ -7910,8 +8050,6 @@ Only works for Bourne-like shells." ;; reasonably unproblematic. And maybe trampclient should have some ;; way of passing credentials, like by using an SSL socket or ;; something. (David Kastrup) -;; * Could Tramp reasonably look for a prompt after ^M rather than -;; only after ^J ? (Stefan Monnier) ;; * Reconnect directly to a compliant shell without first going ;; through the user's default shell. (Pete Forman) ;; * Make `tramp-default-user' obsolete. @@ -7924,14 +8062,8 @@ Only works for Bourne-like shells." ;; SSH instance, would correctly be propagated to the remote process ;; automatically; possibly SSH would have to be started with ;; "-t". (Markus Triska) -;; * Set `tramp-copy-size-limit' to 0, when there is no remote -;; encoding routine. ;; * It makes me wonder if tramp couldn't fall back to ssh when scp ;; isn't on the remote host. (Mark A. Hershberger) -;; * To improve the behavior in case of things like "git status", it -;; might be worthwhile to add some way to indicate that a particular -;; use of process-file is (supposed to be) free of side-effects. -;; (Stefan Monnier) ;; * Use lsh instead of ssh. (Alfred M. Szmidt) ;; * Implement a general server-local-variable mechanism, as there are ;; probably other variables that need different values for different @@ -7939,7 +8071,10 @@ Only works for Bourne-like shells." ;; tramp-server-local-variable-alist) to define any such variables ;; that they need to, which would then be let bound as appropriate ;; in tramp functions. (Jason Rumney) -;; * Optimize out-of-band copying, when both methods are scp-like. +;; * Optimize out-of-band copying, when both methods are scp-like (not +;; rsync). +;; * Keep a second connection open for out-of-band methods like scp or +;; rsync. ;; Functions for file-name-handler-alist: ;; diff-latest-backup-file -- in diff.el diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index e6339776a65..52d08c66c72 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -334,7 +334,7 @@ The attributes of SERVICE can be retrieved via the functions (let ((l-hook (gethash type zeroconf-service-removed-hooks-hash nil))) (add-hook 'l-hook function) (puthash type l-hook zeroconf-service-removed-hooks-hash))) - (t (error "EVENT must be either `:new' or `:removed'.")))) + (t (error "EVENT must be either `:new' or `:removed'")))) (defun zeroconf-get-host () "Returns the local host name as string." diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index b2ad12b3243..054ec3c9c2c 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -2652,6 +2652,9 @@ With a prefix argument, inserts the character directly." (put 'entity-ref 'nxml-friendly-name "entity reference") (put 'char-ref 'nxml-friendly-name "character reference") +;;;###autoload +(defalias 'xml-mode 'nxml-mode) + (provide 'nxml-mode) ;; arch-tag: 8603bc5f-1ef9-4021-b223-322fb2ca708e diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index 4066376ae14..e517f4d9120 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -795,7 +795,7 @@ Do not move past the end of the line." (let ((pos (condition-case err (and (nxml-scan-element-forward (point) t) xmltok-start) - nil))) + (nxml-scan-error nil)))) (end-of-line) (skip-chars-backward " \t") (cond ((not pos) diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index 66ccbed50b8..7027ab02d82 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -549,7 +549,7 @@ See `fast-lock-cache-directory'." (concat buffer-file-name ".flc") (let* ((bufile (expand-file-name buffer-file-truename)) (chars-alist - (if (memq system-type '(emx windows-nt cygwin)) + (if (memq system-type '(windows-nt cygwin)) '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;))) '((?/ . (?#)) (?# . (?# ?#))))) (mapchars diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index 017aeb69f09..94592f61d43 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -1,7 +1,7 @@ ;;; whitespace.el --- warn about and clean bogus whitespaces in the file -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Rajesh Vaidheeswarran <rv@gnu.org> ;; Keywords: convenience @@ -308,8 +308,8 @@ To disable timer scans, set this to zero." (:background "white"))) "Face used for highlighting the bogus whitespaces that exist in the buffer." :group 'whitespace-faces) -;; backward-compatibility alias -(put 'whitespace-highlight-face 'face-alias 'whitespace-highlight) +(define-obsolete-face-alias 'whitespace-highlight-face + 'whitespace-highlight "22.1") (if (not (assoc 'whitespace-mode minor-mode-alist)) (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) diff --git a/lisp/obsolete/vc-mcvs.el b/lisp/obsolete/vc-mcvs.el index 3b6a024631f..cef0e11618c 100644 --- a/lisp/obsolete/vc-mcvs.el +++ b/lisp/obsolete/vc-mcvs.el @@ -200,7 +200,7 @@ COMMENT can be used to provide an initial description of FILE. Passes either `vc-mcvs-register-switches' or `vc-register-switches' to the Meta-CVS command." ;; FIXME: multiple-file case should be made to work. - (if (> (length files) 1) (error "Registering filesets is not yet supported.")) + (if (> (length files) 1) (error "Registering filesets is not yet supported")) (let* ((file (car files)) (filename (file-name-nondirectory file)) (extpos (string-match "\\." filename)) diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 82010dc1493..95826a602dd 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,16 +1,456 @@ +2009-09-23 Juanma Barranquero <lekktu@gmail.com> + + * org.el (org-tree-to-indirect-buffer, org-convert-to-oddeven-levels) + (org-shiftselect-error, org-ctrl-c-ctrl-c): + * org-agenda.el (org-agenda-undo, org-check-for-org-mode): + * org-attach.el (org-attach-check-absolute-path): + * org-docbook.el (org-export-as-docbook): + * org-html.el (org-export-as-html): + * org-id.el (org-id-update-id-locations): + * org-table.el (org-table-fedit-lisp-indent, orgtbl-send-table): + Fix typos in error messages. + +2009-09-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-ascii.el: Require CL for the `loop' macro. + +2009-09-05 Carsten Dominik <dominik@u016822.science.uva.nl> + + * org-gnus.el (require): Wrap (require gnus-sum) into + eval-when-compile. + +2009-09-03 Carsten Dominik <dominik@u016822.science.uva.nl> + + * org-protocol.el (org-protocol-store-link) + (org-protocol-remember, org-protocol-open-source): Remove autoload + cookies again. + + * org-agenda.el (org-agenda-dim-blocked-tasks): Make sure we are + referencing the start of the line. + + * org-gnus.el: Remove unnecessary declare-function forms. + (gnus-sum): Always require gnus-sum. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-protocol.el (org-protocol-store-link) + (org-protocol-remember, org-protocol-open-source): Add autoloads. + + * org-compat.el (org-float-time): New function. + + * org.el (org-clock-update-time-maybe) + (org-sort-entries-or-items, org-do-sort) + (org-evaluate-time-range, org-time-string-to-seconds) + (org-closed-in-range): Use `org-float-time'. + + * org-timer.el (org-timer-start, org-timer-pause-or-continue) + (org-timer-seconds): Use `org-float-time'. + + * org-clock.el (org-clock-get-clocked-time, org-clock-out) + (org-clock-sum, org-dblock-write:clocktable) + (org-clocktable-steps): Use `org-float-time'. + + * org-agenda.el (org-agenda-last-marker-time) + (org-agenda-new-marker, org-diary): Use `org-float-time'. + + * org-compat.el (w32-focus-frame): Declare the w32-focus-frame + function. + + * org-exp.el (org-get-file-contents): Only protect lines that + really need it. + + * org-html.el (require): Require cl for compilation. + + * org.el: Avoid using `default-major-mode'. + + * org-plot.el (require): Require CL only at compile time. + + * org-exp.el (require): Require CL only at compile time. + + * org-agenda.el (org-agenda-quit): When the agenda window is + dedicated, remove other windows before exiting, so that the frame + really will be killed. + + * org-exp.el (org-export-handle-include-files): Reset START and + END for each loop cycle. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-eval-in-calendar): Use + `org-select-frame-set-input-focus'. + + * org-compat.el (org-select-frame-set-input-focus): New function. + + * org.el (org-update-statistics-cookies): New function. + (org-mode-map): Bind `C-c #' to `org-update-statistics-cookies'. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el (org-edit-fixed-width-region): Set org-src-mode only + after the local variables are set. + + * org-latex.el (org-export-latex-protect-amp): New function. + (org-export-latex-links): Protect link ampersands in tables. + + * org-exp.el (org-export-select-backend-specific-text): Match in + two steps, to avoid regexp problems. + + * org.el (org-offer-links-in-entry): Improve working with many and + duplicate links. + + * org-agenda.el (org-agenda-show-1): Make more consistent with + normal cycling. + (org-agenda-cycle-show): Make more consistent with normal cycling. + + * org-gnus.el (org-gnus-store-link): Restore the linking to a + website. + +2009-09-02 Bastien Guerry <bzg@altern.org> + + * org-latex.el (org-export-latex-first-lines): Bugfix. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-modify-effort-estimate): Emit message + about new effort. + + * org.el (org-set-effort): New function. + (org-mode-map): New key for effort setting command. + + * org-agenda.el (org-agenda): Keep window setup when calling + agenda from within agenda window. + (org-agenda-mode-map): New keys for effort setting commands. + (org-agenda-menu): Add effort setting commands to menu. + (org-agenda-set-property, org-agenda-set-effort): New functions. + + * org-latex.el (org-export-latex-tables): Fix + `org-table-last-alignment' and `org-table-last-column-widths' if + the first column has been removed. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-remove-timestamp-with-keyword): Only remove in + entry, not in subtree. + + * org-src.el (org-src-lang-modes): Add abbreviation elisp for + emacs lisp. + + * org.el (org-open-at-point): When on headline, offer all strings + in entry. + + * org-remember.el (org-remember-templates): Documentation fix. + + * org.el (org-move-subtree-down): Use `org-get-next-sibling' and + `org-get-last-sibling' instead of the outline versions of these + functions. + (org-get-last-sibling): New function. + (org-refile): Use `org-get-next-sibling' instead of the outline + version of this function. + (org-clean-visibility-after-subtree-move): Use + `org-get-next-sibling' and `org-get-last-sibling' instead of the + outline versions of these functions. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-prepare-agenda): When creating a new frame + for the agenda, make the window dedicated. + + * org-agenda.el (org-agenda-mode-map): New keys for time motion. + + * org-table.el (org-table-align): Change the order of reinsertion + and deletion, to avoid problems with overlays following the table. + + * org.el (org-parse-time-string): Better error message. + (org-show-subtree): Use org-end-of-subtree. + + * org-macs.el (org-goto-line): New defsubst. + + * org.el (org-open-file, org-change-tag-in-region) + (org-fast-tag-show-exit): Don't use `goto-line'. + + * org-table.el (org-table-align, org-table-insert-column) + (org-table-delete-column, org-table-move-column) + (org-table-sort-lines, org-table-copy-region) + (org-table-paste-rectangle, org-table-wrap-region) + (org-table-get-specials, org-table-rotate-recalc-marks) + (org-table-get-range, org-table-recalculate) + (org-table-edit-formulas, org-table-fedit-convert-buffer) + (org-table-show-reference, org-table-highlight-rectangle): Don't + use `goto-line'. + + * org-src.el (org-edit-src-code, org-edit-fixed-width-region) + (org-edit-src-exit): Don't use `goto-line'. + + * org-macs.el (org-preserve-lc): Don't use `goto-line'. + + * org-list.el (org-renumber-ordered-list, org-fix-bullet-type): + Don't use `goto-line'. + + * org-exp.el (org-export-number-lines): Don't use `goto-line'. + + * org-colview.el (org-columns, org-columns-redo) + (org-agenda-columns): Don't use `goto-line'. + + * org-colview-xemacs.el (org-columns, org-agenda-columns): Don't + use `goto-line'. + + * org-agenda.el (org-agenda-mode): Force visual line motion off. + (org-agenda-add-entry-text-maxlines): Improve docstring. + (org-agenda-start-with-entry-text-mode): New option. + (org-agenda-entry-text-maxlines): New option. + (org-agenda-entry-text-mode): New variable. + (org-agenda-mode): Set initial value of + `org-agenda-entry-text-mode'. + (org-agenda-mode-map): Add the `E' key. + (org-agenda-menu): Add entry text mode to the menu. + (org-agenda-get-some-entry-text): Fix line count bug. + (org-finalize-agenda): Apply entry text mode if appropriate. + (org-agenda-entry-text-show-here): New function. + (org-agenda-entry-text-show): New function. + (org-agenda-entry-text-hide): New function. + (org-agenda-view-mode-dispatch): Add entry text mode to the view + key menu. + (org-agenda-entry-text-mode): New command. + (org-agenda-set-mode-name): Add entry text mode to the mode line + string. + (org-agenda-undo, org-agenda-get-restriction-and-command) + (org-agenda-get-some-entry-text, org-agenda-redo): Don't use + `goto-line'. + +2009-09-02 Bernt Hansen <bernt@norang.ca> + + * org-clock.el (org-notify): Bugfix. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-open-link): Handle multiple links and + check for after-string. + + * org-gnus.el (org-gnus-store-link): Simplify. + + * org.el (org-latex-regexps): Don't add extra empty lines for + display formulas. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-some-entry-text): New function. + (org-agenda-add-entry-text): Use + `org-agenda-get-some-entry-text'. + + * org.el (org-cycle-separator-lines): Update docstring. + (org-cycle-show-empty-lines): Handle negative values for + `org-cycle-show-empty-lines'. + + * org-exp.el (org-export-protect-sub-super): New function. + (org-export-normalize-links): Protect the url of plain links from + supscript and superscript processing. + + * org-remember.el (org-remember-escaped-%): New function. + (org-remember-apply-template): Use `org-remember-escaped-%' to + detect escaped % signs. + +2009-09-02 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Use `org-notify' and play a + sound when showing the notification. + + * org-clock.el (org-notify): New function. + (org-clock-notify-once-if-expired): Use `org-notify'. + + * org-gnus.el (org-gnus-store-link): Handle `gnus-summary-mode' + and `gnus-article-mode' separately. + (gnus-summary-article-header): Fix the declare-function. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Translate + language. + + * org-src.el (org-src-lang-modes): New variable + (org-edit-src-code): Translate language. + + * org-exp.el (org-export-format-source-code-or-example): Deal wit + the new structure of the `org-export-latex-listings-langs' + variable. + + * org-latex.el (org-export-latex-listings-langs): Change structure + of the variable from plist to alist. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-in-commented-line): New function. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-hide-block-toggle): Make folded blocks searchable. + +2009-09-02 Friedrich Delgado Friedrichs <friedel@nomaden.org> (tiny change) + + * org.el (org-flag-drawer): More useful error. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-remember.el (org-remember-apply-template): Use + org-icompleting-read. + + * org-publish.el (org-publish): Use org-icompleting-read. + + * org-colview.el (org-columns-edit-value, org-columns-new) + (org-insert-columns-dblock): Use org-icompleting-read. + + * org-colview-xemacs.el (org-columns-edit-value) + (org-columns-new, org-insert-columns-dblock): Use + org-icompleting-read. + + * org-attach.el (org-attach-delete-one, org-attach-open): Use + org-icompleting-read. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-hierarchical-todo-statistics): Improve docstring. + (org-version): Return the version text. + (org-org-menu): Add a menu entry for the new bug reporter. + (org-submit-bug-report): New command. + + * org-list.el (org-hierarchical-checkbox-statistics): Improve + docstring. + + * org.el (org-emphasis-regexp-components): Add "`" to set of + pre-emphasis characters. + + * org-latex.el (org-export-latex-classes): Always include the soul + package. + (org-export-latex-emphasis-alist): Use \st for strikethough. + + * org-exp-blocks.el (org-export-blocks-preprocess): Use + `indent-code-rigidly' to indent. + + * org-agenda.el (org-agenda-get-restriction-and-command): Remove + properties only if MATCH really is a string. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-packages-alist): Fix + customization type. + + * org.el (org-create-formula-image): Also use + `org-export-latex-packages-alist'. + + * org-html.el (org-export-as-html): Fix bug in footnote regexp. + (org-export-as-html): Format footnotes correctly. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-fast-tag-selection): Avoid text properties on tags + in the alist. + + * org-agenda.el (org-agenda-get-restriction-and-command): Avoid + text properties on the match element. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-regexps-and-options): Make sure the list of done + keywords is not invalid. + + * org-exp.el (org-export-interpolate-newlines): New function. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-format-latex): Avoid nested overlays. + + * org-latex.el (org-export-latex-listings-langs): Add a few more + languages. + + * org-exp.el (org-export-preprocess-apply-macros): Make sure to + ignore newlines and space before the first macro argument. + + * org-latex.el (org-export-latex-tables): Remove save-excursion + around `org-table-align'. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-html-special-string-regexps): Definition + moved into org.el. + + * org-exp.el (org-export-preprocess-apply-macros): Allow newlines + in macro calls. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-listings) + (org-export-latex-listings-langs): New options. + + * org-exp.el (org-export-format-source-code-or-example): Use + listing package if requested by the user. + +2009-09-02 Bastien Guerry <bzg@altern.org> + + * org.el (org-iswitchb): Fix bug when aborting the `org-iswitchb' + command before actually switching to a buffer. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-get-file-contents): Only quote org lines when + the markup is src or example. + + * org-agenda.el (org-agenda-skip-scheduled-if-deadline-is-shown): + New option + (org-agenda-get-day-entries): Remember deadline results and pass + them on into the function getting the scheduling information. + (org-agenda-get-scheduled): Accept deadline results as parameters + and maybe skip some entries. + (org-agenda-skip-scheduled-if-deadline-is-shown): New option. + + * org.el (org-insert-heading): When respecting content, do not + convert current line to headline. + + * org-clock.el (org-clock-save-markers-for-cut-and-paste): Also + cheeeeeck the hd marker + (org-clock-in): Also set the hd marker. + (org-clock-out): Also set the hd marker. + (org-clock-cancel): Reset markers. + + * org.el (org-clock-hd-marker): New marker. + + * org-faces.el (org-agenda-clocking): New face. + + * org-agenda.el (org-agenda-mark-clocking-task): New function. + (org-finalize-agenda): call `org-agenda-mark-clocking-task'. + + * org.el (org-modules): Add org-track.el. + + * org-agenda.el (org-agenda-bulk-marked-p): New function. + (org-agenda-bulk-mark, org-agenda-bulk-unmark): Use + `org-agenda-bulk-marked-p'. + (org-agenda-bulk-toggle): New command. + +2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-move-subtree-down): Hide subtree if it was folded, + not just the body. + + * org-remember.el (org-remember-finalize): Avoid buffer-modified + messages. + +2009-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-html.el (org-export-as-html): + * org-docbook.el (org-export-as-docbook): + Use (default-value 'major-mode) instead of default-major-mode. + 2009-08-08 Carsten Dominik <carsten.dominik@gmail.com> * org-docbook.el: Add arch-tag. - * org-exp-blocks.el: Add arch-tag. + * org-exp-blocks.el: Add arch-tag. - * org-id.el: Add arch-tag. + * org-id.el: Add arch-tag. - * org-indent.el: Add arch-tag. + * org-indent.el: Add arch-tag. - * org-inlinetask.el: Add arch-tag. + * org-inlinetask.el: Add arch-tag. - * org-protocol.el: Add arch-tag. + * org-protocol.el: Add arch-tag. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -39,7 +479,7 @@ * org.el (org-ido-completing-read): Accept straight lists for completion as well as alists. - * org-timer.el (org-timer-cancel-timers): Renamed from + * org-timer.el (org-timer-cancel-timers): Rename from `org-timer-cancel-timers'. * org.el (org-cycle-internal-local): Fix problem with finding next @@ -193,7 +633,7 @@ (org-cycle): Update the docstring to document the new behavior of `org-cycle-internal-local'. -2009-08-06 Nicolas Goaziou <n.goaziou@neuf.fr> (tiny change) +2009-08-06 Nicolas Goaziou <n.goaziou@neuf.fr> (tiny change) * org-clock.el (org-clock-in): Bugfix: recognize timestamps with an abbreviated format for days. @@ -340,12 +780,12 @@ * org.el (org-time-since): Add a function to get the time since an org timestamp. (org-entry-properties): Add two new special properties: SINCE and - SINCE_IA. These give the time since any active or inactive + SINCE_IA. These give the time since any active or inactive timestamp in an entry. (org-special-properties): Add SINCE, SINCE_IA. (org-tags-sort-function): Add custom declaration for tags sorting function. - (org-set-tags): Sort tags if org-tags-sort-function is set + (org-set-tags): Sort tags if org-tags-sort-function is set. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -766,7 +1206,7 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> - * org-exp.el (org-export-replace-src-segments-and-examples): FInd + * org-exp.el (org-export-replace-src-segments-and-examples): Find indented blocks. (org-export-format-source-code-or-example): Fix indentation of blocks. @@ -781,7 +1221,7 @@ function. * org-faces.el (org-meta-line): New face - (org-block): New face. + (org-block): New face. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -862,7 +1302,7 @@ dependent. * org.el (org-hierarchical-todo-statistics): New option. - (org-update-parent-todo-statistics): Modified to handle recursive + (org-update-parent-todo-statistics): Modify to handle recursive statistics. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -1014,7 +1454,7 @@ (org-export-normalize-links): Do not protect the description if it is explicitly given. - * org-list.el (org-reset-checkbox-state-subtree): Moved here from + * org-list.el (org-reset-checkbox-state-subtree): Move here from org-checklist.el. (org-reset-checkbox-state-subtree): Call `org-reset-checkbox-state-subtree'. @@ -1191,7 +1631,7 @@ * org-remember.el (org-remember-handler): Allow filing to non-org files. -2009-08-06 Magnus Henoch <magnus.henoch@gmail.com> +2009-08-06 Magnus Henoch <magnus.henoch@gmail.com> * org-table.el (org-table-fix-formulas): Do not change references to remote tables. @@ -1248,7 +1688,7 @@ * org-agenda.el (org-agenda-dim-blocked-tasks): Honor the NOBLOCKING property. - * org.el (org-scan-tags): Fix bug in tag scanner + * org.el (org-scan-tags): Fix bug in tag scanner. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -1300,7 +1740,7 @@ * org-agenda.el (org-agenda-get-progress): Fix regexp bug. * org.el (org-block-todo-from-children-or-siblings-or-parent): - Renamed from org-block-todo-from-children-or-siblings, and + Rename from org-block-todo-from-children-or-siblings, and enhanced to look for the parent's status as well. * org-agenda.el (org-agenda-log-mode-add-notes): New option. @@ -1541,7 +1981,7 @@ * org-latex.el (org-export-latex-preprocess): Implement the centering markup. - * org-exp.el (org-export-mark-blockquote-verse-center): Renamed + * org-exp.el (org-export-mark-blockquote-verse-center): Rename from `org-export-mark-blockquote-and-verse'. (org-export-as-html): Implement the centering markup. @@ -1703,7 +2143,7 @@ * org-agenda.el (org-agenda-fontify-priorities): New default value `cookies'. - (org-agenda-fontify-priorities): Renamed from + (org-agenda-fontify-priorities): Rename from org-fontify-priorities. * org.el (org-set-font-lock-defaults): Call @@ -1719,7 +2159,7 @@ (org-export-html-validation-link): New variable. (org-export-as-html): Add validation link to exported page. - * org.el (org-match-sparse-tree): Renamed from + * org.el (org-match-sparse-tree): Rename from `org-tags-sparse-tree'. (org-tags-sparse-tree): New alias. @@ -1809,9 +2249,9 @@ (org-export-latex-fontify): Catch error when org-emph-alist has entries that are not defined for LaTeX export. - * org-export-latex.el: renamed to org-latex.el + * org-export-latex.el: renamed to org-latex.el. - * org-latex.el: renamed from org-export-latex.el + * org-latex.el: renamed from org-export-latex.el. * org.el (orgstruct++-mode): New function. (turn-on-orgstruct++): Call `orgstruct++-mode'. @@ -1937,7 +2377,8 @@ * org-agenda.el (org-agenda-dim-blocked-tasks): No tagging when only checking for blocks. - * org-exp.el (org-export-html-footnotes-section): Make the div id consistent + * org-exp.el (org-export-html-footnotes-section): Make the div id + consistent. * org-export-latex.el (org-export-latex-classes): Remove paper size option from LaTeX classes. @@ -2015,7 +2456,7 @@ * org.el (org-todo): Return correct state type even if the blocker throws an error. - (org-modifier-cursor-error): Renamed from + (org-modifier-cursor-error): Rename from `org-shiftcursor-error'. (org-shiftmetaleft, org-shiftmetaright, org-shiftmetaup) (org-shiftmetadown): Call `org-modifier-cursor-error'. @@ -2128,14 +2569,14 @@ * org-exp.el (org-get-current-options): Include the option for publishing time stamps. - * org.el (org-toggle-heading): Renamed from + * org.el (org-toggle-heading): Rename from `org-toggel-region-headings'. No longer needs a region defined, but will use it if there is one. - (org-ctrl-c-star): Simplified, relying more on the internal + (org-ctrl-c-star): Simplify, relying more on the internal workings of `org-toggle-heading'. - (org-toggle-item): Renamed from `org-toggle-region-items'. + (org-toggle-item): Rename from `org-toggle-region-items'. No longer needs a region defined, but will use it if there is one. - (org-ctrl-c-minus): Simplified, relying more on the inernal + (org-ctrl-c-minus): Simplify, relying more on the inernal workings of `org-toggle-item'. * org-export-latex.el (org-export-latex-preprocess): Fix bug in @@ -2186,7 +2627,7 @@ `window-full-width-p'. * org-exp.el (org-export-as-html): Only check for images files - that really can be inlined + that really can be inlined. * org.el (org-image-file-name-regexp, org-file-image-p): Allow the list of extensions to be a parameter. @@ -2286,12 +2727,12 @@ * org-timer.el (org-timer-mode-line-string): New variable. - * org-clock.el (org-clock-mode-line-map): Renamed from + * org-clock.el (org-clock-mode-line-map): Rename from `org-clock-mode-map'. - (org-clock-mode-line-timer): Renamed from `org-mode-line-timer'. - (org-clock-update-mode-line): Renamed from `org-update-mode-line'. - (org-clock-put-overlay): Renamed from `org-put-clock-overlay'. - (org-clock-remove-overlays): Renamed from + (org-clock-mode-line-timer): Rename from `org-mode-line-timer'. + (org-clock-update-mode-line): Rename from `org-update-mode-line'. + (org-clock-put-overlay): Rename from `org-put-clock-overlay'. + (org-clock-remove-overlays): Rename from `org-remove-clock-overlays'. * org-timer.el (org-timer-pause-or-continue): Implement stopping @@ -2302,7 +2743,7 @@ (org-timer-set-mode-line, org-timer-update-mode-line): New functions. - * org.el (org-insert-heading): Handle new value `auto' for + * org.el (org-insert-heading): Handle new value `auto' for `org-blank-before-new-entry'. (org-org-menu): Add new items for timer functions. @@ -2420,7 +2861,7 @@ * org-exp.el (org-export-preprocess-string): Call `org-export-protect-colon-examples'. - (org-export-protect-colon-examples): Renamed from + (org-export-protect-colon-examples): Rename from `org-export-protect-examples', and scope limited to lines starting with a colon. @@ -2476,9 +2917,9 @@ No longer call `org-export-protect-examples'. (org-export-target-internal-links): Take care of coderef targets. (org-export-last-code-line-counter-value): New variable. - (org-export-replace-src-segments-and-examples): Renamed from + (org-export-replace-src-segments-and-examples): Rename from `org-export-replace-src-segments', and modified. - (org-export-format-source-code-or-example): Renamed from + (org-export-format-source-code-or-example): Rename from `org-export-format-source-code'. (org-export-number-lines): New function. (org-export-as-ascii, org-export-as-html): Handle coderef links. @@ -2707,12 +3148,12 @@ * org-agenda.el (org-agenda-goto-calendar): Remove duplicate let bindings of calendar variables. - * org-table.el (org-table-find-row-type): Renamed from + * org-table.el (org-table-find-row-type): Rename from `org-find-row-type'. - (org-table-rewrite-old-row-references): Renamed from + (org-table-rewrite-old-row-references): Rename from `org-rewrite-old-row-references'. - (org-table-shift-refpart): Renamed from `org-shift-refpart'. - (org-table-cleanup-narrow-column-properties): Renamed from + (org-table-shift-refpart): Rename from `org-shift-refpart'. + (org-table-cleanup-narrow-column-properties): Rename from `org-cleanup-narrow-column-properties'. 2008-12-07 Carsten Dominik <carsten.dominik@gmail.com> @@ -3148,7 +3589,7 @@ * org-attach.el (org-attach-expand-link, org-attach-expand): New functions. - * org-agenda.el (org-agenda-get-progress): Renamed from + * org-agenda.el (org-agenda-get-progress): Rename from `org-get-closed'. Implement searching for state changes as well. (org-agenda-log-mode-items): New option. (org-agenda-log-mode): New option prefix argument, interpreted as @@ -3318,7 +3759,7 @@ tree. * org-publish.el (org-publish-get-base-files-1): Deal correctly - with broken symlinks + with broken symlinks. 2008-11-12 Carsten Dominik <dominik@science.uva.nl> @@ -3377,12 +3818,12 @@ 2008-10-26 Bastien Guerry <bzg@altern.org> - * org-export-latex.el (org-export-latex-classes): Added + * org-export-latex.el (org-export-latex-classes): Add \usepackage{graphicx} to the default list of packages. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> - * org-agenda.el (org-agenda-filter): Renamed from + * org-agenda.el (org-agenda-filter): Rename from `org-agenda-filter-tags'. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> @@ -3495,7 +3936,7 @@ modifications, to make sure links are prepared before the LaTeX conversions do happen. - * org-attach.el (org-attach-delete-all): Renamed from + * org-attach.el (org-attach-delete-all): Rename from `org-attch-delete'. Add a security query before deleting the entire directory. New optional argument FORCE can overrule the security query. @@ -3565,20 +4006,20 @@ preview. (org-time-stamp-inactive): Call `org-time-stamp'. (org-time-stamp): New argument `inactive'. Also edit inacive - stamps. Convert time stamp type. + stamps. Convert time stamp type. (org-open-file): Interpret the `default' value for the `command' in `org-file-apps'. * org-id.el (org-id-int-to-b36-one-digit) (org-id-b36-to-int-one-digit, org-id-int-to-b36) - (org-id-b36-to-int, org-id-time-to-b36): Modified from b62 to + (org-id-b36-to-int, org-id-time-to-b36): Modify from b62 to b36. * org-id.el (org-id-reverse-string): New function. (org-id-new): Use `org-id-reverse-string' to make sure the beginning chars of the ID are mutating fast. This allows to use a directory structure to spread things better. - (org-id-prefix): Changed default to nil. + (org-id-prefix): Change default to nil. * org-list.el (org-move-item-down, org-move-item-up): Remember and restore the column of the cursor position. @@ -3658,17 +4099,17 @@ * org-remember.el (org-get-x-clipboard): Use the compat function to get clipboard values when x-selection-value is - unavailable. Use substring-no-properties instead of + unavailable. Use substring-no-properties instead of set-text-properties to remove text properties from the clipboard value. * lisp/org-clock.el (org-update-mode-line): Support limiting the modeline clock string, and display the full todo value in the - tooltip. Set a local keymap so mouse-3 on the clock string goes to + tooltip. Set a local keymap so mouse-3 on the clock string goes to the currently clocked task. (org-clock-string-limit): Add a custom value for the maximum length of the clock string in the modeline. - (org-clock-mode-map): Add a keymap for the modeline string + (org-clock-mode-map): Add a keymap for the modeline string. 2008-10-12 Carsten Dominik <dominik@science.uva.nl> @@ -3686,7 +4127,7 @@ (org-export-latex-keywords-maybe): Use `replace-regexp-in-string'. (org-export-latex-list-beginning-re): Rename to `org-list-beginning-re' - (org-list-item-begin): Rename to `org-list-item-beginning' + (org-list-item-begin): Rename to `org-list-item-beginning'. 2008-10-12 Eric Schulte <schulte.eric@gmail.com> @@ -3782,7 +4223,7 @@ 2008-10-12 Bastien Guerry <bzg@altern.org> - * org.el (org-additional-option-like-keywords): Added keywords for + * org.el (org-additional-option-like-keywords): Add keywords for the _QUOTE, _VERSE and _SRC environments. * org-export-latex.el (org-export-latex-preprocess): Fix bug when @@ -3828,7 +4269,7 @@ * org-gnus.el (org-gnus-store-link): Support for :to information in gnus links. - * org-exp.el (org-export-as-html): Fixed typo in creator + * org-exp.el (org-export-as-html): Fix typo in creator information. (org-export-protect-examples): New parameter indent. Insert extra spaces only when this parameter is specified. @@ -3839,7 +4280,7 @@ (org-remember-apply-template): Allow the file component to be a function. - * org.el (org-goto-local-search-headings): Renamed from + * org.el (org-goto-local-search-headings): Rename from `org-goto-local-search-forward-headings'. Added the possibility to search backwards. @@ -3849,7 +4290,7 @@ * org-agenda.el (org-write-agenda): Erase buffer for txt export. * org-exp.el (org-html-do-expand): Allow {} to terminate - tex macro + tex macro. * org.el (org-buffer-list): Select buffers based on major mode, not on file name. @@ -3865,7 +4306,6 @@ * org.el (org-columns-modify-value-for-display-function): New option. - * org-publish.el (org-publish-file): Make sure the directory match for the publishing directory works correctly. @@ -3942,10 +4382,10 @@ * org.el (org-narrow-to-subtree): Do not include the final newline into the narrowed region. - * org-agenda.el (org-agenda-custom-commands-local-options): Fixed + * org-agenda.el (org-agenda-custom-commands-local-options): Fix bug with user-define skipping condition. - * org-agenda.el (org-agenda-get-restriction-and-command): Fixed typo. + * org-agenda.el (org-agenda-get-restriction-and-command): Fix typo. * org-exp.el (org-export-html-style-default): Automatic overflow handling for pre fields. @@ -4123,7 +4563,7 @@ text property, so that the agenda knows where this entry comes from. - * org-agenda.el (org-agenda-clock-in): Fixed bug in the + * org-agenda.el (org-agenda-clock-in): Fix bug in the interaction between clocking-in from the agenda, and automatic task state switching. @@ -4194,7 +4634,7 @@ (org-columns-cleanup-item): Call `org-columns-compact-links'. (org-columns-display-here): Call `org-agenda-columns-cleanup-item' when in agenda. - (org-columns-edit-value): Fixed bug with editing values from + (org-columns-edit-value): Fix bug with editing values from agenda column view. (org-columns-redo): Also redo the agenda itself. @@ -4205,7 +4645,7 @@ * org-colview.el (org-agenda-columns-cleanup-item): New function. - * org-exp.el (org-export-ascii-preprocess): Renamed from + * org-exp.el (org-export-ascii-preprocess): Rename from `org-export-ascii-clean-string'. (org-export-kill-licensed-text) (org-export-define-heading-targets) @@ -4233,7 +4673,7 @@ * org-archive.el (org-archive-save-context-info): Fix bugs in customization setup and docstring. - * org-exp.el (org-export-html-style): Changed the size of in the + * org-exp.el (org-export-html-style): Change the size of in the <pre> element to 90%. 2008-06-17 Carsten Dominik <dominik@science.uva.nl> @@ -4273,8 +4713,7 @@ * org-exp.el (org-export-get-title-from-subtree) (org-export-as-ascii, org-export-as-html): Make sure the original - region-beginning and region-end are used, even after moving - point. + region-beginning and region-end are used, even after moving point. (org-export-get-title-from-subtree): Also try the EXPORT_TITLE property. @@ -4287,12 +4726,11 @@ 2008-06-17 Carsten Dominik <dominik@science.uva.nl> - * org.el (org-file-properties): Renamed from `org-local-properties'. + * org.el (org-file-properties): Rename from `org-local-properties'. (org-scan-tags): Take file tags into account. (org-tags-match-list-sublevels): Default changed to t. - * org-exp.el (org-export-as-html): Close paragraph after a - footnote. + * org-exp.el (org-export-as-html): Close paragraph after a footnote. * org.el (org-update-parent-todo-statistics): New function. @@ -4339,8 +4777,7 @@ 2008-06-17 Carsten Dominik <dominik@science.uva.nl> * org-exp.el (org-print-icalendar-entries): Make sure DTEND is - shifted by one day if there is a date range without an end - time. + shifted by one day if there is a date range without an end time. * org.el (org-try-structure-completion): New function. @@ -4439,8 +4876,8 @@ 2008-06-17 Bastien Guerry <bzg@altern.org> - * org-export-latex.el (org-export-latex-preprocess): Added - support for blockquotes. + * org-export-latex.el (org-export-latex-preprocess): + Add support for blockquotes. 2008-06-17 Carsten Dominik <dominik@science.uva.nl> @@ -4523,8 +4960,7 @@ 2008-06-17 Carsten Dominik <dominik@science.uva.nl> * org-exp.el (org-export-preprocess-hook): New hook. - (org-export-preprocess-string): Call - `org-export-preprocess-hook'. + (org-export-preprocess-string): Call `org-export-preprocess-hook'. * org.el (org-font-lock-hook): New variable. (org-font-lock-hook): New function. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 29f708b8af2..9e711433c78 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -128,7 +128,11 @@ This is only relevant when `org-agenda-add-entry-text' is part of `org-agenda-before-write-hook', which it is by default. When this is 0, nothing will happen. When it is greater than 0, it specifies the maximum number of lines that will be added for each entry -that is listed in the agenda view." +that is listed in the agenda view. + +Note that this variable is not used during display, only when exporting +the agenda. For agenda display, see org-agenda-entry-text-mode and the +variable `org-agenda-entry-text-maxlines'." :group 'org-agenda :type 'integer) @@ -555,6 +559,23 @@ is DONE." :group 'org-agenda-daily/weekly :type 'boolean) +(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil + "Non-nil means skip scheduling line if same entry shows because of deadline. +In the agenda of today, an entry can show up multiple times because +it is both scheduled and has a nearby deadline, and maybe a plain time +stamp as well. +When this variable is t, then only the deadline is shown and the fact that +the entry is scheduled today or was scheduled previously is not shown. +When this variable is nil, the entry will be shown several times. When +the variable is the symbol `not-today', then skip scheduled previously, +but not scheduled today." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Not when scheduled today" not-today))) + (defcustom org-agenda-skip-deadline-if-done nil "Non-nil means don't show deadlines when the corresponding item is done. When nil, the deadline is still shown and should give you a happy feeling. @@ -634,6 +655,20 @@ Needs to be set before org.el is loaded." :group 'org-agenda-startup :type 'boolean) +(defcustom org-agenda-start-with-entry-text-mode nil + "The initial value of entry-text-mode in a newly created agenda window." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-entry-text-maxlines 5 + "Number of text lines to be added when `E' is presed in the agenda. + +Note that this variable only used during agenda display. Add add entry text +when exporting the agenda, configure the variable +`org-agenda-add-entry-ext-maxlines'." + :group 'org-agenda + :type 'integer) + (defvar org-agenda-include-inactive-timestamps nil "Non-nil means, include inactive time stamps in agenda and timeline.") @@ -1228,6 +1263,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-menu) ; defined later in this file. (defvar org-agenda-restrict) ; defined later in this file. (defvar org-agenda-follow-mode nil) +(defvar org-agenda-entry-text-mode nil) (defvar org-agenda-clockreport-mode nil) (defvar org-agenda-show-log nil) (defvar org-agenda-redo-command nil) @@ -1256,6 +1292,7 @@ The following commands are available: (use-local-map org-agenda-mode-map) (easy-menu-add org-agenda-menu) (if org-startup-truncated (setq truncate-lines t)) + (org-set-local 'line-move-visual nil) (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text @@ -1266,6 +1303,7 @@ The following commands are available: buffer-substring-filters))) (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode + org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode org-agenda-show-log org-agenda-start-with-log-mode)) @@ -1292,25 +1330,24 @@ The following commands are available: (org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) (org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) -(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) (org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks) (org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) +(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) (org-defkey org-agenda-mode-map "$" 'org-agenda-archive) (org-defkey org-agenda-mode-map "A" 'org-agenda-archive-to-archive-sibling) (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) (org-defkey org-agenda-mode-map " " 'org-agenda-show) -(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) (org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) -(org-defkey org-agenda-mode-map "b" 'org-agenda-tree-to-indirect-buffer) (org-defkey org-agenda-mode-map "o" 'delete-other-windows) (org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) +(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) (org-defkey org-agenda-mode-map "t" 'org-agenda-todo) (org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) (org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) @@ -1336,15 +1373,20 @@ The following commands are available: (while l (org-defkey org-agenda-mode-map (int-to-string (pop l)) 'digit-argument))) -(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) +(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode) (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) +(org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode) (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) (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 "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 "e" 'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-e" + 'org-clock-modify-effort-estimate) +(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) (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) @@ -1380,8 +1422,8 @@ The following commands are available: (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) -(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) +(org-defkey org-agenda-mode-map "f" 'org-agenda-later) +(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier) (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) @@ -1454,11 +1496,15 @@ The following commands are available: ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) - ("Clock" + ("Clock and Effort" ["Clock in" org-agenda-clock-in t] ["Clock out" org-agenda-clock-out t] ["Clock cancel" org-agenda-clock-cancel t] - ["Goto running clock" org-clock-goto t]) + ["Goto running clock" org-clock-goto t] + "--" + ["Set Effort" org-agenda-set-effort t] + ["Change clocked effort" org-clock-modify-effort-estimate + (org-clock-is-active)]) ("Priority" ["Set Priority" org-agenda-priority t] ["Increase Priority" org-agenda-priority-up t] @@ -1502,6 +1548,9 @@ The following commands are available: ["Show clock report" org-agenda-clockreport-mode :style toggle :selected org-agenda-clockreport-mode :active (org-agenda-check-type nil 'agenda)] + ["Show some entry text" org-agenda-entry-text-mode + :style toggle :selected org-agenda-entry-text-mode + :active t] "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log @@ -1543,7 +1592,7 @@ This undoes changes both in the agenda buffer and in the remote buffer that have been changed along." (interactive) (or org-agenda-allow-remote-undo - (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo.")) + (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) (if (not (eq this-command last-command)) (setq org-agenda-undo-has-started-in nil org-agenda-pending-undo-list org-agenda-undo-list)) @@ -1568,7 +1617,7 @@ that have been changed along." (not (car pending-undo-list))) (pop pending-undo-list)) (undo-more 1)))))) - (goto-line line) + (org-goto-line line) (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) (defun org-verify-change-for-undo (l1 l2) @@ -1622,6 +1671,10 @@ Pressing `<' twice means to restrict to the current subtree or region (interactive "P") (catch 'exit (let* ((prefix-descriptions nil) + (org-agenda-window-setup (if (equal (buffer-name) + org-agenda-buffer-name) + 'current-window + org-agenda-window-setup)) (org-agenda-custom-commands-orig org-agenda-custom-commands) (org-agenda-custom-commands ;; normalize different versions @@ -1778,7 +1831,7 @@ s Search for keywords C Configure custom agenda commands (while t (setq custom1 custom) (when (eq rmheader t) - (goto-line 1) + (org-goto-line 1) (re-search-forward ":" nil t) (delete-region (match-end 0) (point-at-eol)) (forward-char 1) @@ -1789,7 +1842,8 @@ s Search for keywords C Configure custom agenda commands (delete-region (point) (point-max)) (while (setq entry (pop custom1)) (setq key (car entry) desc (nth 1 entry) - type (nth 2 entry) match (nth 3 entry)) + type (nth 2 entry) + match (nth 3 entry)) (if (> (length key) 1) (add-to-list 'prefixes (string-to-char key)) (insert @@ -1815,6 +1869,7 @@ s Search for keywords C Configure custom agenda commands (t "???")) (cond ((stringp match) + (setq match (copy-sequence match)) (org-add-props match nil 'face 'org-warning)) (match (format "set of %d commands" (length match))) @@ -2212,78 +2267,86 @@ This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the entry text following headings shown in the agenda. Drawers will be excluded, also the line with scheduling/deadline info." (when (> org-agenda-add-entry-text-maxlines 0) - (let (m txt drawer-re kwd-time-re ind) + (let (m txt) (goto-char (point-min)) (while (not (eobp)) (if (not (setq m (get-text-property (point) 'org-hd-marker))) (beginning-of-line 2) - (save-excursion - (with-current-buffer (marker-buffer m) - (if (not (org-mode-p)) - (setq txt "") - (save-excursion - (save-restriction - (widen) - (goto-char m) - (beginning-of-line 2) - (setq txt (buffer-substring - (point) - (progn (outline-next-heading) (point))) - drawer-re org-drawer-regexp - kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp - ".*\n?")) - (with-temp-buffer - (insert txt) - (when org-agenda-add-entry-text-descriptive-links - (goto-char (point-min)) - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp (point-max) t) - (set-text-properties (match-beginning 0) (match-end 0) - nil)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (delete-region - (match-beginning 0) - (progn (re-search-forward - "^[ \t]*:END:.*\n?" nil 'move) - (point)))) - (goto-char (point-min)) - (while (re-search-forward kwd-time-re nil t) - (replace-match "")) - (if (re-search-forward "[ \t\n]+\\'" nil t) - (replace-match "")) - (goto-char (point-min)) - ;; find min indentation - (goto-char (point-min)) - (untabify (point-min) (point-max)) - (setq ind (org-get-indentation)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (setq ind (min ind (org-get-indentation)))) - (beginning-of-line 2)) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (move-to-column ind) - (delete-region (point-at-bol) (point))) - (beginning-of-line 2)) - (goto-char (point-min)) - (while (and (not (eobp)) (re-search-forward "^" nil t)) - (replace-match " > ")) - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (goto-char (point-max)) - (when (> (org-current-line) - (1+ org-agenda-add-entry-text-maxlines)) - (goto-line (1+ org-agenda-add-entry-text-maxlines)) - (backward-char 1)) - (setq txt (buffer-substring (point-min) (point))))))))) + (setq txt (org-agenda-get-some-entry-text + m org-agenda-add-entry-text-maxlines)) (end-of-line 1) (if (string-match "\\S-" txt) (insert "\n" txt))))))) +(defun org-agenda-get-some-entry-text (marker n-lines) + "Extract entry text from MARKER, at most N-LINES lines. +This will ignore drawers etc, just get the text." + (let (txt drawer-re kwd-time-re ind) + (save-excursion + (with-current-buffer (marker-buffer marker) + (if (not (org-mode-p)) + (setq txt "") + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (beginning-of-line 2) + (setq txt (buffer-substring + (point) + (progn (outline-next-heading) (point))) + drawer-re org-drawer-regexp + kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp + ".*\n?")) + (with-temp-buffer + (insert txt) + (when org-agenda-add-entry-text-descriptive-links + (goto-char (point-min)) + (while (org-activate-bracket-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp (point-max) t) + (set-text-properties (match-beginning 0) (match-end 0) + nil)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (delete-region + (match-beginning 0) + (progn (re-search-forward + "^[ \t]*:END:.*\n?" nil 'move) + (point)))) + (goto-char (point-min)) + (while (re-search-forward kwd-time-re nil t) + (replace-match "")) + (if (re-search-forward "[ \t\n]+\\'" nil t) + (replace-match "")) + (goto-char (point-min)) + ;; find min indentation + (goto-char (point-min)) + (untabify (point-min) (point-max)) + (setq ind (org-get-indentation)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (setq ind (min ind (org-get-indentation)))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (move-to-column ind) + (delete-region (point-at-bol) (point))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (and (not (eobp)) (re-search-forward "^" nil t)) + (replace-match " > ")) + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (goto-char (point-max)) + (when (> (org-current-line) + n-lines) + (org-goto-line (1+ n-lines)) + (backward-char 1)) + (setq txt (buffer-substring (point-min) (point))))))))) + txt)) + (defun org-agenda-collect-markers () "Collect the markers pointing to entries in the agenda buffer." (let (m markers) @@ -2324,7 +2387,7 @@ Drawers will be excluded, also the line with scheduling/deadline info." (defun org-check-for-org-mode () "Make sure current buffer is in org-mode. Error if not." (or (org-mode-p) - (error "Cannot execute org-mode agenda command on buffer in %s." + (error "Cannot execute org-mode agenda command on buffer in %s" major-mode))) (defun org-fit-agenda-window () @@ -2386,7 +2449,8 @@ bind it in the options section.") ((equal org-agenda-window-setup 'other-window) (org-switch-to-buffer-other-window abuf)) ((equal org-agenda-window-setup 'other-frame) - (switch-to-buffer-other-frame abuf)) + (switch-to-buffer-other-frame abuf) + (set-window-dedicated-p (selected-window) t)) ((equal org-agenda-window-setup 'reorganize-frame) (delete-other-windows) (org-switch-to-buffer-other-window abuf)))) @@ -2420,12 +2484,36 @@ bind it in the options section.") (org-agenda-fontify-priorities)) (when (and org-agenda-dim-blocked-tasks org-blocker-hook) (org-agenda-dim-blocked-tasks)) + (org-agenda-mark-clocking-task) + (when org-agenda-entry-text-mode + (org-agenda-entry-text-hide) + (org-agenda-entry-text-show)) (run-hooks 'org-finalize-agenda-hook) (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) (when (get 'org-agenda-filter :preset-filter) (org-agenda-filter-apply org-agenda-filter)) ))) +(defun org-agenda-mark-clocking-task () + "Mark the current clock entry in the agenda if it is present." + (mapc (lambda (o) + (if (eq (org-overlay-get o 'type) 'org-agenda-clocking) + (org-delete-overlay o))) + (org-overlays-in (point-min) (point-max))) + (when (marker-buffer org-clock-hd-marker) + (save-excursion + (goto-char (point-min)) + (let (s ov) + (while (setq s (next-single-property-change (point) 'org-hd-marker)) + (goto-char s) + (when (equal (get-text-property (point) 'org-hd-marker) + org-clock-hd-marker) + (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-eol)))) + (org-overlay-put ov 'type 'org-agenda-clocking) + (org-overlay-put ov 'face 'org-agenda-clocking) + (org-overlay-put ov 'help-echo + "The clock is running in this item"))))))) + (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." (interactive) @@ -2485,7 +2573,9 @@ bind it in the options section.") :from 'todo :to 'done))))))) (if org-blocked-by-checkboxes (setq invis1 nil)) - (setq b (if invis1 (max (point-min) (1- (point))) (point)) + (setq b (if invis1 + (max (point-min) (1- (point-at-bol))) + (point-at-bol)) e (point-at-eol) ov (org-make-overlay b e)) (if invis1 @@ -2530,7 +2620,7 @@ continue from there." (defvar org-agenda-markers nil "List of all currently active markers created by `org-agenda'.") -(defvar org-agenda-last-marker-time (time-to-seconds (current-time)) +(defvar org-agenda-last-marker-time (org-float-time) "Creation time of the last agenda marker.") (defun org-agenda-new-marker (&optional pos) @@ -2538,7 +2628,7 @@ continue from there." Org-mode keeps a list of these markers and resets them when they are no longer in use." (let ((m (copy-marker (or pos (point))))) - (setq org-agenda-last-marker-time (time-to-seconds (current-time))) + (setq org-agenda-last-marker-time (org-float-time)) (push m org-agenda-markers) m)) @@ -2552,6 +2642,43 @@ no longer in use." (mapc (lambda (m) (org-check-and-save-marker m beg end)) org-agenda-markers)) +;;; Entry text mode + +(defun org-agenda-entry-text-show-here () + "Add some text from te entry as context to the current line." + (let (m txt o) + (setq m (get-text-property (point) 'org-hd-marker)) + (unless (marker-buffer m) + (error "No marker points to an entry here")) + (setq txt (concat "\n" (org-no-properties + (org-agenda-get-some-entry-text + m org-agenda-entry-text-maxlines)))) + (when (string-match "\\S-" txt) + (setq o (org-make-overlay (point-at-bol) (point-at-eol))) + (org-overlay-put o 'evaporate t) + (org-overlay-put o 'org-overlay-type 'agenda-entry-content) + (org-overlay-put o 'after-string txt)))) + +(defun org-agenda-entry-text-show () + "Add entry context for all agenda lines." + (interactive) + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not (bobp)) + (when (get-text-property (point) 'org-hd-marker) + (org-agenda-entry-text-show-here)) + (beginning-of-line 0)))) + +(defun org-agenda-entry-text-hide () + "Remove any shown entry context." + (delq nil + (mapcar (lambda (o) + (if (eq (org-overlay-get o 'org-overlay-type) + 'agenda-entry-content) + (progn (org-delete-overlay o) t))) + (org-overlays-in (point-min) (point-max))))) + ;;; Agenda timeline (defvar org-agenda-only-exact-dates nil) ; dynamically scoped @@ -3115,7 +3242,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in rtn rtnall files file pos) (when (equal arg '(4)) (setq org-select-this-todo-keyword - (org-ido-completing-read "Keyword (or KWD1|K2D2|...): " + (org-icompleting-read "Keyword (or KWD1|K2D2|...): " (mapcar 'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) (org-set-local 'org-last-arg arg) @@ -3547,7 +3674,7 @@ So the example above may also be written as The function expects the lisp variables `entry' and `date' to be provided by the caller, because this is how the calendar works. Don't use this function from a program - use `org-agenda-get-day-entries' instead." - (when (> (- (time-to-seconds (current-time)) + (when (> (- (org-float-time) org-agenda-last-marker-time) 5) (org-agenda-reset-markers)) @@ -3582,7 +3709,7 @@ the documentation of `org-diary'." (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) (error "No such file %s" file))) - arg results rtn) + arg results rtn deadline-results) (if (not buffer) ;; If file does not exist, make sure an error message ends up in diary (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) @@ -3612,13 +3739,14 @@ the documentation of `org-diary'." (setq rtn (org-agenda-get-sexps)) (setq results (append results rtn))) ((eq arg :scheduled) - (setq rtn (org-agenda-get-scheduled)) + (setq rtn (org-agenda-get-scheduled deadline-results)) (setq results (append results rtn))) ((eq arg :closed) (setq rtn (org-agenda-get-progress)) (setq results (append results rtn))) ((eq arg :deadline) (setq rtn (org-agenda-get-deadlines)) + (setq deadline-results (copy-sequence rtn)) (setq results (append results rtn)))))))) results)))) @@ -4021,7 +4149,7 @@ FRACTION is what fraction of the head-warning time has passed." (while (setq f (pop faces)) (if (>= fraction (car f)) (throw 'exit (cdr f))))))) -(defun org-agenda-get-scheduled () +(defun org-agenda-get-scheduled (&optional deadline-results) "Return the scheduled information for agenda display." (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -4035,6 +4163,12 @@ FRACTION is what fraction of the head-warning time has passed." (regexp org-scheduled-time-regexp) (todayp (org-agenda-todayp date)) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar + mm + (deadline-position-alist + (mapcar (lambda (a) (and (setq mm (get-text-property + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) + deadline-results)) d2 diff pos pos1 category tags donep ee txt head pastschedp todo-state face timestr s) (goto-char (point-min)) @@ -4067,6 +4201,12 @@ FRACTION is what fraction of the head-warning time has passed." (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) (setq pos1 (match-beginning 0)) + (if (and + (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown) + (and org-agenda-skip-scheduled-if-deadline-is-shown + pastschedp)) + (setq mm (assoc pos1 deadline-position-alist))) + (throw :skip nil)) (setq tags (org-get-tags-at)) (setq head (buffer-substring-no-properties (point) @@ -4273,7 +4413,7 @@ Any match of REMOVE-RE will be removed from TXT." (error nil))) (when effort (setq neffort (org-hh:mm-string-to-minutes effort) - effort (setq effort (concat "[" effort"]" ))))) + effort (setq effort (concat "[" effort "]" ))))) (when remove-re (while (string-match remove-re txt) @@ -4662,6 +4802,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (interactive) (if org-agenda-columns-active (org-columns-quit) + (if (window-dedicated-p) (delete-other-windows)) (let ((buf (current-buffer))) (and (not (eq org-agenda-window-setup 'current-window)) (not (one-window-p)) @@ -4713,7 +4854,7 @@ When this is the global TODO list, a prefix argument will be interpreted." (put 'org-agenda-filter :preset-filter preset) (and (or filter preset) (org-agenda-filter-apply filter)) (and cols (interactive-p) (org-agenda-columns)) - (goto-line line) + (org-goto-line line) (recenter window-line))) @@ -4772,7 +4913,7 @@ to switch to narrowing." (org-set-local 'org-global-tags-completion-table (org-global-tags-completion-table))) (let ((completion-ignore-case t)) - (setq tag (org-ido-completing-read + (setq tag (org-icompleting-read "Tag: " org-global-tags-completion-table)))) (cond ((equal char ?/) @@ -4905,10 +5046,9 @@ Negative selection means, regexp must not match for selection of an entry." (defun org-agenda-manipulate-query (char) (cond ((memq org-agenda-type '(timeline agenda)) - (if (y-or-n-p "Re-display with inactive time stamps included? ") - (let ((org-agenda-include-inactive-timestamps t)) - (org-agenda-redo)) - (error "Abort"))) + (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) ((eq org-agenda-type 'search) (org-add-to-string 'org-agenda-query-string @@ -4999,7 +5139,7 @@ With prefix ARG, go backward that many times the current span." "Call one of the view mode commands." (interactive) (message "View: [d]ay [w]eek [m]onth [y]ear [l]og [L]og-all [a]rch-trees [A]rch-files - clock[R]eport time[G]rid include[D]iary") + clock[R]eport time[G]rid [[]inactive [E]ntryText include[D]iary") (let ((a (read-char-exclusive))) (case a (?d (call-interactively 'org-agenda-day-view)) @@ -5007,11 +5147,17 @@ With prefix ARG, go backward that many times the current span." (?m (call-interactively 'org-agenda-month-view)) (?y (call-interactively 'org-agenda-year-view)) (?l (call-interactively 'org-agenda-log-mode)) + ((?F ?f) (call-interactively 'org-agenda-follow-mode)) (?a (call-interactively 'org-agenda-archives-mode)) (?A (org-agenda-archives-mode 'files)) - (?R (call-interactively 'org-agenda-clockreport-mode)) + ((?R ?r) (call-interactively 'org-agenda-clockreport-mode)) + ((?E ?e) (call-interactively 'org-agenda-entry-text-mode)) (?G (call-interactively 'org-agenda-toggle-time-grid)) (?D (call-interactively 'org-agenda-toggle-diary)) + (?\[ (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) (?q (message "Abort")) (otherwise (error "Invalid key" ))))) @@ -5171,6 +5317,22 @@ so that the date SD will be in that range." (message "Follow mode is %s" (if org-agenda-follow-mode "on" "off"))) +(defun org-agenda-entry-text-mode (&optional arg) + "Toggle entry text mode in an agenda buffer." + (interactive "P") + (if (integerp arg) + (setq org-agenda-entry-text-mode t) + (setq org-agenda-entry-text-mode (not org-agenda-entry-text-mode))) + (org-agenda-entry-text-hide) + (and org-agenda-entry-text-mode + (let ((org-agenda-entry-text-maxlines + (if (integerp arg) arg org-agenda-entry-text-maxlines))) + (org-agenda-entry-text-show))) + (org-agenda-set-mode-name) + (message "Entry text mode is %s. Maximum number of lines is %d" + (if org-agenda-entry-text-mode "on" "off") + (if (integerp arg) arg org-agenda-entry-text-maxlines))) + (defun org-agenda-clockreport-mode () "Toggle clocktable mode in an agenda buffer." (interactive) @@ -5244,6 +5406,7 @@ When called with a prefix argument, include all archive files as well." (if (equal org-agenda-ndays 1) " Day" "") (if (equal org-agenda-ndays 7) " Week" "") (if org-agenda-follow-mode " Follow" "") + (if org-agenda-entry-text-mode " ETxt" "") (if org-agenda-include-diary " Diary" "") (if org-agenda-use-time-grid " Grid" "") (if (consp org-agenda-show-log) " LogAll" @@ -5411,33 +5574,39 @@ If this information is not given, the function uses the tree at point." (defun org-agenda-refile (&optional goto rfloc) "Refile the item at point." (interactive "P") + (if (equal goto '(16)) + (org-refile-goto-last-stored) + (let* ((marker (or (get-text-property (point) 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (rfloc (or rfloc + (org-refile-get-location + (if goto "Goto: " "Refile to: ") buffer + org-refile-allow-creating-parent-nodes)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (org-remove-subtree-entries-from-agenda) + (org-refile goto buffer rfloc))))))) + +(defun org-agenda-open-link (&optional arg) + "Follow the link in the current line, if any. +This looks for a link in the displayed lin in the agenda. It also looks +at the text of the entry itself." + (interactive "P") (let* ((marker (or (get-text-property (point) 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (rfloc (or rfloc - (org-refile-get-location - (if goto "Goto: " "Refile to: ") buffer - org-refile-allow-creating-parent-nodes)))) + (get-text-property (point) 'org-marker))) + (buffer (and marker (marker-buffer marker)))) + (unless buffer (error "Don't know where to look for links")) (with-current-buffer buffer (save-excursion (save-restriction (widen) (goto-char marker) - (org-remove-subtree-entries-from-agenda) - (org-refile goto buffer rfloc)))))) - - - - -(defun org-agenda-open-link () - "Follow the link in the current line, if any." - (interactive) - (org-agenda-copy-local-variable 'org-link-abbrev-alist-local) - (save-excursion - (save-restriction - (narrow-to-region (point-at-bol) (point-at-eol)) - (org-open-at-point)))) + (org-offer-links-in-entry arg)))))) (defun org-agenda-copy-local-variable (var) "Get a variable from a referenced buffer and install it here." @@ -5487,8 +5656,8 @@ The prefix arg causes further revieling: 0 hide the subtree 1 just show the entry according to defaults. -2 show the text below the heading -3 show the entire subtree +2 show the children view +3 show the subtree view 4 show the entire subtree and any LOGBOOK drawers 5 show the entire subtree and any drawers With prefix argument FULL-ENTRY, make the entire entry visible @@ -5500,21 +5669,25 @@ if it was hidden in the outline." (cond ((= more 0) (hide-subtree) - (message "Remote: hide subtree")) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'folded)) + (message "Remote: FOLDED")) ((and (interactive-p) (= more 1)) (message "Remote: show with default settings")) ((= more 2) (show-entry) + (show-children) (save-excursion (org-back-to-heading) - (org-cycle-hide-drawers 'children)) - (message "Remote: show entry")) + (run-hook-with-args 'org-cycle-hook 'children)) + (message "Remote: CHILDREN")) ((= more 3) (show-subtree) (save-excursion (org-back-to-heading) - (org-cycle-hide-drawers 'subtree)) - (message "Remote: show subtree")) + (run-hook-with-args 'org-cycle-hook 'subtree)) + (message "Remote: SUBTREE")) ((= more 4) (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) (org-drawer-regexp @@ -5525,10 +5698,10 @@ if it was hidden in the outline." (save-excursion (org-back-to-heading) (org-cycle-hide-drawers 'subtree))) - (message "Remote: show subtree and LOGBOOK")) + (message "Remote: SUBTREE AND LOGBOOK")) ((> more 4) (show-subtree) - (message "Remote: show subtree and LOGBOOK"))) + (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) (defun org-recenter-heading (n) @@ -5537,20 +5710,27 @@ if it was hidden in the outline." (recenter n))) (defvar org-agenda-cycle-counter nil) -(defun org-agenda-cycle-show (n) +(defun org-agenda-cycle-show (&optional n) "Show the current entry in another window, with default settings. Default settings are taken from `org-show-hierarchy-above' and siblings. -When use repeadedly in immediate succession, the remote entry will cycle +When use repeatedly in immediate succession, the remote entry will cycle through visibility -entry -> subtree -> subtree with logbook" - (interactive "p") - (when (and (= n 1) - (not (eq last-command this-command))) - (setq org-agenda-cycle-counter 0)) - (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) - (if (> org-agenda-cycle-counter 4) - (setq org-agenda-cycle-counter 0)) +children -> subtree -> folded + +When called with a numeric prefix arg, that arg will be passed through to +`org-agenda-show-1'. For the interpretation of that argument, see the +docstring of `org-agenda-show-1'." + (interactive "P") + (if (integerp n) + (setq org-agenda-cycle-counter n) + (if (not (eq last-command this-command)) + (setq org-agenda-cycle-counter 1) + (if (equal org-agenda-cycle-counter 0) + (setq org-agenda-cycle-counter 2) + (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) + (if (> org-agenda-cycle-counter 3) + (setq org-agenda-cycle-counter 0))))) (org-agenda-show-1 org-agenda-cycle-counter)) (defun org-agenda-recenter (arg) @@ -5821,6 +6001,53 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-change-all-lines newhead hdmarker) (beginning-of-line 1))))) +(defun org-agenda-set-property () + "Set a property for the current headline." + (interactive) + (org-agenda-check-no-diary) + (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed + (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (save-excursion + (org-show-context 'agenda)) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (goto-char pos) + (call-interactively 'org-set-property))))) + +(defun org-agenda-set-effort () + "Set the effort property for the current headline." + (interactive) + (org-agenda-check-no-diary) + (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed + (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (save-excursion + (org-show-context 'agenda)) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (goto-char pos) + (call-interactively 'org-set-effort) + (end-of-line 1))))) + (defun org-agenda-toggle-archive-tag () "Toggle the archive tag for the current entry." (interactive) @@ -6273,14 +6500,17 @@ This is a command that has to be installed in `calendar-mode-map'." (defvar org-agenda-bulk-marked-entries nil "List of markers that refer to marked entries in the agenda.") +(defun org-agenda-bulk-marked-p () + (eq (get-char-property (point-at-bol) 'type) + 'org-marked-entry-overlay)) + (defun org-agenda-bulk-mark () "Mark the entry at point for future bulk action." (interactive) (org-agenda-check-no-diary) (let* ((m (get-text-property (point) 'org-hd-marker)) ov) - (unless (eq (get-char-property (point-at-bol) 'type) - 'org-marked-entry-overlay) + (unless (org-agenda-bulk-marked-p) (unless m (error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol)))) @@ -6295,8 +6525,7 @@ This is a command that has to be installed in `calendar-mode-map'." (defun org-agenda-bulk-unmark () "Unmark the entry at point for future bulk action." (interactive) - (when (eq (get-char-property (point-at-bol) 'type) - 'org-marked-entry-overlay) + (when (org-agenda-bulk-marked-p) (org-agenda-bulk-remove-overlays (point-at-bol) (+ 2 (point-at-bol))) (setq org-agenda-bulk-marked-entries @@ -6306,6 +6535,12 @@ This is a command that has to be installed in `calendar-mode-map'." (message "%d entries marked for bulk action" (length org-agenda-bulk-marked-entries))) +(defun org-agenda-bulk-toggle () + "Toggle marking the entry at point for bulk action." + (interactive) + (if (org-agenda-bulk-marked-p) + (org-agenda-bulk-unmark) + (org-agenda-bulk-mark))) (defun org-agenda-bulk-remove-overlays (&optional beg end) "Remove the mark overlays between BEG and END in the agenda buffer. @@ -6357,7 +6592,7 @@ This will remove the markers, and the overlays." (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc)))) ((equal action ?t) - (setq state (org-ido-completing-read + (setq state (org-icompleting-read "Todo state: " (with-current-buffer (marker-buffer (car entries)) (mapcar 'list org-todo-keywords-1)))) @@ -6366,7 +6601,7 @@ This will remove the markers, and the overlays." (org-agenda-todo ,state)))) ((memq action '(?- ?+)) - (setq tag (org-ido-completing-read + (setq tag (org-icompleting-read (format "Tag to %s: " (if (eq action ?+) "add" "remove")) (with-current-buffer (marker-buffer (car entries)) (delq nil diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index 26d3278183c..7a5692480ef 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index 4ace1db5c7c..253066375dc 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -27,6 +27,7 @@ ;;; Commentary: (require 'org-exp) +(eval-when-compile (require 'cl)) (defgroup org-export-ascii nil "Options specific for ASCII export of Org-mode files." @@ -266,11 +267,13 @@ publishing directory." ;; File header (unless body-only - (if title (org-insert-centered title ?=)) - (insert "\n") + (when (and title (not (string= "" title))) + (org-insert-centered title ?=) + (insert "\n")) + (if (and (or author email) org-export-author-info) - (insert (concat (nth 1 lang-words) ": " (or author "") + (insert(concat (nth 1 lang-words) ": " (or author "") (if email (concat " <" email ">") "") "\n"))) @@ -283,7 +286,8 @@ publishing directory." (if (and date org-export-time-stamp-file) (insert (concat (nth 2 lang-words) ": " date"\n"))) - (insert "\n\n")) + (unless (= (point) (point-min)) + (insert "\n\n"))) (if (and org-export-with-toc (not body-only)) (progn diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 05228c22c0f..33a740b227a 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 6.29c +;; Version: 6.30c ;; This file is part of GNU Emacs. ;; @@ -217,7 +217,7 @@ Throw an error if we cannot root the directory." (or (and dir (file-name-absolute-p dir)) (file-name-absolute-p org-attach-directory) (buffer-file-name (buffer-base-buffer)) - (error "Need absolute `org-attach-directory' to attach in buffers without filename."))) + (error "Need absolute `org-attach-directory' to attach in buffers without filename"))) (defun org-attach-set-directory () "Set the ATTACH_DIR property of the current entry. @@ -314,7 +314,7 @@ The attachment is created as an Emacs buffer." (let* ((attach-dir (org-attach-dir t)) (files (org-attach-file-list attach-dir)) (file (or file - (org-ido-completing-read + (org-icompleting-read "Delete attachment: " (mapcar (lambda (f) (list (file-name-nondirectory f))) @@ -389,7 +389,7 @@ If IN-EMACS is non-nil, force opening in Emacs." (files (org-attach-file-list attach-dir)) (file (if (= (length files) 1) (car files) - (org-ido-completing-read "Open attachment: " + (org-icompleting-read "Open attachment: " (mapcar 'list files) nil t)))) (org-open-file (expand-file-name file attach-dir) in-emacs))) diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 8b2470d82bf..2c2e9ce81a9 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -7,7 +7,7 @@ ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 6bdc1ce1236..5e9fbe3cf76 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -5,7 +5,7 @@ ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 4b96dae101b..064d5269523 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -277,6 +277,7 @@ of a different task.") (defun org-clock-save-markers-for-cut-and-paste (beg end) "Save relative positions of markers in region." (org-check-and-save-marker org-clock-marker beg end) + (org-check-and-save-marker org-clock-hd-marker beg end) (org-check-and-save-marker org-clock-default-task beg end) (org-check-and-save-marker org-clock-interrupted-task beg end) (mapc (lambda (m) (org-check-and-save-marker m beg end)) @@ -389,8 +390,8 @@ If not, show simply the clocked time like 01:50." The time returned includes the the time spent on this task in previous clocking intervals." (let ((currently-clocked-time - (floor (- (time-to-seconds (current-time)) - (time-to-seconds org-clock-start-time)) 60))) + (floor (- (org-float-time) + (org-float-time org-clock-start-time)) 60))) (+ currently-clocked-time (or org-clock-total-time 0)))) (defun org-clock-modify-effort-estimate (&optional value) @@ -424,7 +425,8 @@ the mode line." (setq value (max 0 value) org-clock-effort (org-minutes-to-hh:mm-string value)) (org-entry-put org-clock-marker "Effort" org-clock-effort) - (org-clock-update-mode-line)))) + (org-clock-update-mode-line) + (message "Effort is now %s" org-clock-effort)))) (defvar org-clock-notification-was-shown nil "Shows if we have shown notification already.") @@ -438,12 +440,16 @@ Notification is shown only once." (if (>= clocked-time effort-in-minutes) (unless org-clock-notification-was-shown (setq org-clock-notification-was-shown t) - (org-clock-play-sound) - (org-show-notification + (org-notify (format "Task '%s' should be finished by now. (%s)" - org-clock-heading org-clock-effort))) + org-clock-heading org-clock-effort) t)) (setq org-clock-notification-was-shown nil))))) +(defun org-notify (notification &optional play-sound) + "Send a NOTIFICATION and maybe PLAY-SOUND." + (org-show-notification notification) + (if play-sound (org-clock-play-sound))) + (defun org-show-notification (notification) "Show notification. Use `org-show-notification-handler' if defined, @@ -592,6 +598,9 @@ the clocking selection, associated with the letter `d'." (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) (move-marker org-clock-marker (point) (buffer-base-buffer)) + (move-marker org-clock-hd-marker + (save-excursion (org-back-to-heading t) (point)) + (buffer-base-buffer)) (or global-mode-string (setq global-mode-string '(""))) (or (memq 'org-mode-line-string global-mode-string) (setq global-mode-string @@ -751,8 +760,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (delete-region (point) (point-at-eol)) (insert "--") (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive)) - (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te))) - (time-to-seconds (apply 'encode-time (org-parse-time-string ts)))) + (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) + (org-float-time (apply 'encode-time (org-parse-time-string ts)))) h (floor (/ s 3600)) s (- s (* 3600 h)) m (floor (/ s 60)) @@ -765,6 +774,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (and (looking-at "\n") (> (point-max) (1+ (point))) (delete-char 1))) (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) (when org-log-note-clock-out (org-add-log-setup 'clock-out nil nil nil nil (concat "# Task: " (org-get-heading t) "\n\n"))) @@ -802,6 +812,8 @@ 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))) + (move-marker 'org-clock-marker nil) + (move-marker 'org-clock-hd-marker nil) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) (force-mode-line-update) @@ -856,8 +868,8 @@ TSTART and TEND can mark a time range to be considered." time) (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) - (if (consp tstart) (setq tstart (time-to-seconds tstart))) - (if (consp tend) (setq tend (time-to-seconds tend))) + (if (consp tstart) (setq tstart (org-float-time tstart))) + (if (consp tend) (setq tend (org-float-time tend))) (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) (save-excursion (goto-char (point-max)) @@ -867,9 +879,9 @@ TSTART and TEND can mark a time range to be considered." ;; Two time stamps (setq ts (match-string 2) te (match-string 3) - ts (time-to-seconds + ts (org-float-time (apply 'encode-time (org-parse-time-string ts))) - te (time-to-seconds + te (org-float-time (apply 'encode-time (org-parse-time-string te))) ts (if tstart (max ts tstart) ts) te (if tend (min te tend) te) @@ -1210,9 +1222,9 @@ the currently selected interval size." (when (and te (listp te)) (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) ;; Now the times are strings we can parse. - (if ts (setq ts (time-to-seconds + (if ts (setq ts (org-float-time (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (time-to-seconds + (if te (setq te (org-float-time (apply 'encode-time (org-parse-time-string te))))) (move-marker ins (point)) (setq ipos (point)) @@ -1390,9 +1402,9 @@ the currently selected interval size." (when block (setq cc (org-clock-special-range block nil t) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (if ts (setq ts (time-to-seconds + (if ts (setq ts (org-float-time (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (time-to-seconds + (if te (setq te (org-float-time (apply 'encode-time (org-parse-time-string te))))) (setq p1 (plist-put p1 :header "")) (setq p1 (plist-put p1 :step nil)) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index c89de339fab..73e6bed121a 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -446,7 +446,7 @@ Where possible, use the standard interface for changing this line." (t (setq allowed (org-property-get-allowed-values pom key 'table)) (if allowed - (setq nval (org-ido-completing-read "Value: " allowed nil t)) + (setq nval (org-icompleting-read "Value: " allowed nil t)) (setq nval (read-string "Edit: " value))) (setq nval (org-trim nval)) (when (not (equal nval value)) @@ -694,7 +694,7 @@ around it." truncate-lines)) (setq truncate-lines t) (mapc (lambda (x) - (goto-line (car x)) + (org-goto-line (car x)) (org-columns-display-here (cdr x))) cache))))) @@ -721,7 +721,7 @@ interactive function org-columns-new.") (interactive) (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) cell) - (setq prop (org-ido-completing-read + (setq prop (org-icompleting-read "Property: " (mapcar 'list (org-buffer-property-keys t nil t)) nil nil prop)) (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) @@ -729,7 +729,7 @@ interactive function org-columns-new.") (if (string-match "\\S-" width) (setq width (string-to-number width)) (setq width nil)) - (setq fmt (org-ido-completing-read + (setq fmt (org-icompleting-read "Summary [none]: " (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map) @@ -959,7 +959,7 @@ Don't set this, this is meant for dynamic scoping.") (call-interactively 'org-columns) (org-agenda-redo) (call-interactively 'org-agenda-columns))) - (goto-line line) + (org-goto-line line) (move-to-column col)) (message "Recomputing columns...done")) @@ -1228,7 +1228,7 @@ and tailing newline characters." "Create a dynamic block capturing a column view table." (interactive) (let ((defaults '(:name "columnview" :hlines 1)) - (id (org-ido-completing-read + (id (org-icompleting-read "Capture columns (local, global, entry with :ID: property) [local]: " (append '(("global") ("local")) (mapcar 'list (org-property-values "ID")))))) @@ -1303,7 +1303,7 @@ and tailing newline characters." (org-bound-and-true-p flyspell-mode)) (flyspell-mode 0)) (mapc (lambda (x) - (goto-line (car x)) + (org-goto-line (car x)) (org-columns-display-here (cdr x))) cache) (when org-agenda-columns-show-summaries diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index c52c5af9b6e..2f4112ce354 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -36,7 +36,8 @@ (require 'org-macs) -(declare-function find-library-name "find-func" (library)) +(declare-function find-library-name "find-func" (library)) +(declare-function w32-focus-frame "w32-win" (frame)) (defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself (defconst org-format-transports-properties-p @@ -332,6 +333,35 @@ that can be added." string) (apply 'kill-new string args)) +(defun org-select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (cond ((featurep 'xemacs) + (if (fboundp 'select-frame-set-input-focus) + (select-frame-set-input-focus frame) + (raise-frame frame) + (select-frame frame) + (focus-frame frame))) + ;; `select-frame-set-input-focus' defined in Emacs 21 will not + ;; set the input focus. + ((>= emacs-major-version 22) + (select-frame-set-input-focus frame)) + (t + (raise-frame frame) + (select-frame frame) + (cond ((memq window-system '(x ns mac)) + (x-focus-frame frame)) + ((eq window-system 'w32) + (w32-focus-frame frame))) + (when focus-follows-mouse + (set-mouse-position frame (1- (frame-width frame)) 0))))) + +(defun org-float-time (&optional time) + "Convert time value TIME to a floating point number. +TIME defaults to the current time." + (if (featurep 'xemacs) + (time-to-seconds (or time (current-time))) + (float-time time))) + (provide 'org-compat) ;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index 8d47b552e5d..6d6e67528a0 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -4,12 +4,11 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-docbook.el -;; Version: 6.29c +;; Version: 6.30c ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook ;; Description: Converts an org-mode buffer into DocBook -;; $Id: org-docbook.el,v 1.2 2009/08/08 02:33:22 gm Exp $ ;; URL: ;; This file is part of GNU Emacs. @@ -388,7 +387,7 @@ publishing directory." (org-set-local 'buffer-file-name (with-current-buffer (buffer-base-buffer) buffer-file-name)) - (error "Need a file name to be able to export."))) + (error "Need a file name to be able to export"))) (message "Exporting...") (setq-default org-todo-line-regexp org-todo-line-regexp) @@ -1102,7 +1101,7 @@ publishing directory." (unless (plist-get opt-plist :buffer-will-be-killed) (normal-mode) - (if (eq major-mode default-major-mode) + (if (eq major-mode (default-value 'major-mode)) (nxml-mode))) ;; Remove empty paragraphs and lists. Replace them with a diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index e8cf4392de4..5a55b563790 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -203,9 +203,8 @@ specified in BLOCKS which default to the value of "" (apply func (save-match-data (org-remove-indentation (match-string 4))) (split-string (match-string 3) " ")))) t t) - ;; indent the replaced match - (indent-region (match-beginning 0) (match-end 0) indentation) - )) + ;; indent block + (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) (setf start (save-match-data (match-end 0)))) (mapcar (lambda (type) (interblock start (point-max) type)) @@ -370,7 +369,7 @@ with their values as determined by R." (defun org-export-interblocks-format-R (start end) "This is run over parts of the org-file which are between R -blocks. It's main use is to expand the \R{stuff} chunks for +blocks. Its main use is to expand the \R{stuff} chunks for export." (save-excursion (goto-char start) diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 53264d30d47..3e12e6af10e 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -29,7 +29,7 @@ (require 'org) (require 'org-agenda) (require 'org-exp-blocks) -(eval-and-compile +(eval-when-compile (require 'cl)) (declare-function org-export-latex-preprocess "org-latex" (parameters)) @@ -574,6 +574,7 @@ much faster." (:priority "pri" org-export-with-priority) (:TeX-macros "TeX" org-export-with-TeX-macros) (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments) + (:latex-listings nil org-export-latex-listings) (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading) (:fixed-width ":" org-export-with-fixed-width) (:timestamps "<" org-export-with-timestamps) @@ -741,9 +742,14 @@ modified) list.") (setq p (plist-put p (intern (concat ":macro-" (downcase (match-string 1 val)))) - (match-string 2 val))))) + (org-export-interpolate-newlines (match-string 2 val)))))) p)))) +(defun org-export-interpolate-newlines (s) + (while (string-match "\\\\n" s) + (setq s (replace-match "\n" t t s))) + s) + (defvar org-export-allow-BIND-local nil) (defun org-export-confirm-letbind () "Can we use #+BIND values during export? @@ -1695,7 +1701,7 @@ from the buffer." (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) (case-fold-search t) - fmt) + fmt beg beg-content end end-content) (while formatters (setq fmt (pop formatters)) @@ -1709,16 +1715,17 @@ from the buffer." (point-at-bol) (min (1+ (point-at-eol)) (point-max)) '(org-protected t)))) (goto-char (point-min)) - (while (re-search-forward - (concat "^[ \t]*#\\+" (caddr fmt) - "\\>.*\\(\\(\n.*\\)*?\n\\)[ \t]*#\\+" (cadddr fmt) - "\\>.*\n?") nil t) - (if (eq (car fmt) backend) - ;; yes, keep this - (add-text-properties (match-beginning 1) (1+ (match-end 1)) - '(org-protected t)) - ;; No, this is for a different backend, kill it - (delete-region (match-beginning 0) (match-end 0))))))) + (while (re-search-forward (concat "^[ \t]*#\\+" (caddr fmt) "\\>.*\n?") + nil t) + (setq beg (match-beginning 0) beg-content (match-end 0)) + (when (re-search-forward (concat "^[ \t]*#\\+" (cadddr fmt) "\\>.*\n?") + nil t) + (setq end (match-end 0) end-content (match-beginning 0)) + (if (eq (car fmt) backend) + ;; yes, keep this + (add-text-properties beg-content end-content '(org-protected t)) + ;; No, this is for a different backend, kill it + (delete-region beg end))))))) (defun org-export-mark-blockquote-verse-center () "Mark block quote and verse environments with special cookies. @@ -1834,12 +1841,18 @@ When it is nil, all comments will be removed." (while (re-search-forward "^[ \t]*|" nil t) (beginning-of-line 1) (if (or (looking-at "[ \t]*| *[!_^] *|") - (and (looking-at ".*?| *<[0-9]+> *|") - (not (looking-at ".*?| *[^ <|]")))) + (and (looking-at "[ \t]*|\\( *\\(<[0-9]+>\\|<[rl]>\\|<[rl][0-9]+>\\)? *|\\)+[ \t]*$") + (not (looking-at ".*?| *[^ <|\n]")))) (delete-region (max (point-min) (1- (point-at-bol))) (point-at-eol)) (end-of-line 1)))) +(defun org-export-protect-sub-super (s) + (save-match-data + (while (string-match "\\([^\\\\]\\)\\([_^]\\)" s) + (setq s (replace-match "\\1\\\\\\2" nil nil s))) + s)) + (defun org-export-normalize-links () "Convert all links to bracket links, and expand link abbreviations." (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) @@ -1849,8 +1862,11 @@ When it is nil, all comments will be removed." (while (re-search-forward re-plain-link nil t) (goto-char (1- (match-end 0))) (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((s (concat (match-string 1) "[[" (match-string 2) - ":" (match-string 3) "]]"))) + (let* ((s (concat (match-string 1) + "[[" (match-string 2) ":" (match-string 3) + "][" (match-string 2) ":" (org-export-protect-sub-super + (match-string 3)) + "]]"))) ;; added 'org-link face to links (put-text-property 0 (length s) 'face 'org-link s) (replace-match s t t)))) @@ -1858,8 +1874,11 @@ When it is nil, all comments will be removed." (while (re-search-forward re-angle-link nil t) (goto-char (1- (match-end 0))) (org-if-unprotected - (let* ((s (concat (match-string 1) "[[" (match-string 2) - ":" (match-string 3) "]]"))) + (let* ((s (concat (match-string 1) + "[[" (match-string 2) ":" (match-string 3) + "][" (match-string 2) ":" (org-export-protect-sub-super + (match-string 3)) + "]]"))) (put-text-property 0 (length s) 'face 'org-link s) (replace-match s t t)))) (goto-char (point-min)) @@ -2056,7 +2075,7 @@ TYPE must be a string, any of: (goto-char (point-min)) (let (sy val key args args2 s n) (while (re-search-forward - "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(.*?\\))\\)?}}}" + "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" nil t) (setq key (downcase (match-string 1)) args (match-string 3)) @@ -2066,7 +2085,8 @@ TYPE must be a string, any of: (intern (concat ":" key))))) (save-match-data (when args - (setq args (org-split-string args ",[ \t]*") args2 nil) + (setq args (org-split-string args ",[ \t\n]*") args2 nil) + (setq args (mapcar 'org-trim args)) (while args (while (string-match "\\\\\\'" (car args)) ;; repair bad splits @@ -2111,7 +2131,8 @@ TYPE must be a string, any of: markup (org-symname-or-string (pop params)) lang (and (member markup '("src" "SRC")) (org-symname-or-string (pop params))) - switches (mapconcat '(lambda (x) (format "%s" x)) params " ")) + switches (mapconcat '(lambda (x) (format "%s" x)) params " ") + start nil end nil) (delete-region (match-beginning 0) (match-end 0)) (if (or (not file) (not (file-exists-p file)) @@ -2126,7 +2147,8 @@ TYPE must be a string, any of: (setq start (format "#+begin_%s %s\n" markup switches) end (format "#+end_%s" markup)))) (insert (or start "")) - (insert (org-get-file-contents (expand-file-name file) prefix prefix1 markup)) + (insert (org-get-file-contents (expand-file-name file) + prefix prefix1 markup)) (or (bolp) (newline)) (insert (or end "")))))) @@ -2136,6 +2158,7 @@ If PREFIX is a string, prepend it to each line. If PREFIX1 is a string, prepend it to the first line instead of PREFIX. If MARKUP, don't protect org-like lines, the exporter will take care of the block they are in." + (if (stringp markup) (setq markup (downcase markup))) (with-temp-buffer (insert-file-contents file) (when (or prefix prefix1) @@ -2145,9 +2168,9 @@ take care of the block they are in." (setq prefix1 nil) (beginning-of-line 2))) (buffer-string) - (unless markup + (when (member markup '("src" "example")) (goto-char (point-min)) - (while (re-search-forward "^\\(\\*\\|[ \t]*#\\)" nil t) + (while (re-search-forward "^\\([*#]\\|[ \t]*#\\+\\)" nil t) (goto-char (match-beginning 0)) (insert ",") (end-of-line 1))) @@ -2203,6 +2226,8 @@ in the list) and remove property and value from the list in LISTVAR." (defvar htmlp) ;; dynamically scoped (defvar latexp) ;; dynamically scoped (defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el +(defvar org-export-latex-listings) ;; defined in org-latex.el +(defvar org-export-latex-listings-langs) ;; defined in org-latex.el (defun org-export-format-source-code-or-example (backend lang code &optional opts indent) @@ -2268,7 +2293,15 @@ INDENT was the original indentation of the block." "htmlize.el 1.34 or later is needed for source code formatting"))) (if lang - (let* ((mode (and lang (intern (concat lang "-mode")))) + (let* ((lang-m (when lang + (or (cdr (assoc lang org-src-lang-modes)) + lang))) + (mode (and lang-m (intern + (concat + (if (symbolp lang-m) + (symbol-name lang-m) + lang-m) + "-mode")))) (org-inhibit-startup t) (org-startup-folded nil)) (setq rtn @@ -2309,8 +2342,24 @@ INDENT was the original indentation of the block." ((eq backend 'latex) (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) (concat "\n#+BEGIN_LaTeX\n" - (org-add-props (concat (car org-export-latex-verbatim-wrap) - rtn (cdr org-export-latex-verbatim-wrap)) + (org-add-props + (if org-export-latex-listings + (concat + (if lang + (let* + ((lang-sym (intern lang)) + (lstlang + (or (cadr + (assq + lang-sym + org-export-latex-listings-langs)) + lang))) + (format "\\lstset{language=%s}\n" lstlang)) + "") + "\\begin{lstlisting}\n" + rtn "\\end{lstlisting}\n") + (concat (car org-export-latex-verbatim-wrap) + rtn (cdr org-export-latex-verbatim-wrap))) '(org-protected t)) "#+END_LaTeX\n\n")) ((eq backend 'ascii) @@ -2367,7 +2416,7 @@ INDENT was the original indentation of the block." "\\)\\)")) ref) - (goto-line (1+ skip1)) + (org-goto-line (1+ skip1)) (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax)) (if number (insert (format fm (incf n))) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 3674f0a4e74..d529348d4d4 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -498,6 +498,11 @@ changes." (when (fboundp 'set-face-attribute) (set-face-attribute 'org-agenda-date-today nil :weight 'bold :italic 't))) +(unless (facep 'org-agenda-clocking) + (copy-face 'secondary-selection 'org-agenda-clocking) + (set-face-doc-string 'org-agenda-clocking + "Face marking the current clock item in the agenda.")) + (unless (facep 'org-agenda-date-weekend) (copy-face 'org-agenda-date 'org-agenda-date-weekend) (set-face-doc-string 'org-agenda-date-weekend diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 4562d252faf..bef0a533358 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 7da75b1989b..416eaaf45ec 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -38,6 +38,7 @@ (require 'org-macs) (require 'org-compat) +(declare-function org-in-commented-line "org" ()) (declare-function org-in-regexp "org" (re &optional nlines visually)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function outline-next-heading "outline") @@ -363,42 +364,44 @@ referenced sequence." ;; Now find footnote references, and extract the definitions (goto-char (point-min)) (while (re-search-forward org-footnote-re nil t) - (org-if-unprotected - (setq def (match-string 4) - idef def - ref (or (match-string 1) (match-string 2)) - before (char-to-string (char-after (match-beginning 0)))) - (if (equal ref "fn:") (setq ref nil)) - (if (and ref (setq a (assoc ref ref-table))) - (progn - (setq marker (nth 1 a)) - (unless (nth 2 a) (setf (caddr a) def))) - (setq marker (number-to-string (incf count)))) - (save-match-data - (if def - (setq def (org-trim def)) - (save-excursion - (goto-char (point-min)) - (if (not (re-search-forward (concat "^\\[" (regexp-quote ref) - "\\]") nil t)) - (setq def nil) - (setq beg (match-beginning 0)) - (setq beg1 (match-end 0)) - (re-search-forward - (org-re "^[ \t]*$\\|^\\*+ \\|^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") - nil 'move) - (setq def (buffer-substring beg1 (or (match-beginning 0) - (point-max)))) - (goto-char beg) - (skip-chars-backward " \t\n\t") - (delete-region (1+ (point)) (match-beginning 0)))))) - (unless sort-only - (replace-match (concat before "[" marker "]")) - (and idef - org-footnote-fill-after-inline-note-extraction - (fill-paragraph))) - (if (not a) (push (list ref marker def (if idef t nil)) ref-table)))) - + (unless (org-in-commented-line) + (org-if-unprotected + (setq def (match-string 4) + idef def + ref (or (match-string 1) (match-string 2)) + before (char-to-string (char-after (match-beginning 0)))) + (if (equal ref "fn:") (setq ref nil)) + (if (and ref (setq a (assoc ref ref-table))) + (progn + (setq marker (nth 1 a)) + (unless (nth 2 a) (setf (caddr a) def))) + (setq marker (number-to-string (incf count)))) + (save-match-data + (if def + (setq def (org-trim def)) + (save-excursion + (goto-char (point-min)) + (if (not (re-search-forward (concat "^\\[" (regexp-quote ref) + "\\]") nil t)) + (setq def nil) + (setq beg (match-beginning 0)) + (setq beg1 (match-end 0)) + (re-search-forward + (org-re "^[ \t]*$\\|^\\*+ \\|^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") + nil 'move) + (setq def (buffer-substring beg1 (or (match-beginning 0) + (point-max)))) + (goto-char beg) + (skip-chars-backward " \t\n\t") + (delete-region (1+ (point)) (match-beginning 0)))))) + (unless sort-only + (replace-match (concat before "[" marker "]")) + (and idef + org-footnote-fill-after-inline-note-extraction + (fill-paragraph))) + (if (not a) (push (list ref marker def (if idef t nil)) + ref-table))))) + ;; First find and remove the footnote section (goto-char (point-min)) (cond diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index dbc4ee7db4c..02e7075da66 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -7,7 +7,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -34,8 +34,7 @@ ;;; Code: (require 'org) -(eval-when-compile - (require 'gnus-sum)) +(eval-when-compile (require 'gnus-sum)) ;; Customization variables @@ -51,10 +50,6 @@ negates this setting for the duration of the command." :type 'boolean) ;; Declare external functions and variables -(declare-function gnus-article-show-summary "gnus-art" ()) -(declare-function gnus-summary-last-subject "gnus-sum" ()) -(declare-function message-fetch-field "message" (header &optional not-all)) -(declare-function message-narrow-to-head-1 "message" nil) (defvar gnus-other-frame-object) (defvar gnus-group-name) @@ -123,37 +118,29 @@ If `org-store-link' was called with a prefix arg the meaning of link))) ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (and (eq major-mode 'gnus-summary-mode) (gnus-summary-show-article)) (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-article-buffer - (gnus-summary-toggle-header 1) - (goto-char (point-min)) - ;; mbox files may contain a first line starting with - ;; "From" followed by a space, which cannot be parsed as - ;; header line, so we skip it. - (when (looking-at "From ") - (beginning-of-line 2)) - (mail-header-extract-no-properties))) - (from (mail-header 'from header)) - (message-id (org-remove-angle-brackets - (mail-header 'message-id header))) - (date (mail-header 'date header)) - (to (mail-header 'to header)) - (newsgroups (mail-header 'newsgroups header)) - (x-no-archive (mail-header 'x-no-archive header)) - (subject (if (eq major-mode 'gnus-article-mode) - (save-restriction - (require 'message) - (message-narrow-to-head-1) - (message-fetch-field "subject")) - (gnus-summary-subject-string))) - desc link) + (header (with-current-buffer gnus-summary-buffer + (gnus-summary-article-header))) + (from (mail-header-from header)) + (message-id (org-remove-angle-brackets (mail-header-id header))) + (date (mail-header-date header)) + (subject (mail-header-subject header)) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive desc link) + ;; Fetching an article is an expensive operation; newsgroup and + ;; x-no-archive are only needed for web links. + (when (org-xor current-prefix-arg org-gnus-prefer-web-links) + ;; Make sure the original article buffer is up-to-date + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To")) + newsgroups (gnus-fetch-original-field "Newsgroups") + x-no-archive (gnus-fetch-original-field "x-no-archive"))) (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) (setq desc (org-email-link-description) - link (org-gnus-article-link group newsgroups message-id x-no-archive)) + link (org-gnus-article-link + group newsgroups message-id x-no-archive)) (org-add-link-props :link link :description desc) - (gnus-summary-toggle-header -1) link)))) (defun org-gnus-open (path) diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 35eb45ab179..5b0e7cb5bfb 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -27,6 +27,7 @@ ;;; Commentary: (require 'org-exp) +(eval-when-compile (require 'cl)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function htmlize-region "ext:htmlize" (beg end)) @@ -543,7 +544,7 @@ PUB-DIR is set, use this as the publishing directory." (org-set-local 'buffer-file-name (with-current-buffer (buffer-base-buffer) buffer-file-name)) - (error "Need a file name to be able to export."))) + (error "Need a file name to be able to export"))) (message "Exporting...") (setq-default org-todo-line-regexp org-todo-line-regexp) @@ -1161,7 +1162,7 @@ lang=\"%s\" xml:lang=\"%s\"> ;; Does this contain a reference to a footnote? (when org-export-with-footnotes (setq start 0) - (while (string-match "\\([^* \t].*\\)?\\[\\([0-9]+\\)\\]" line start) + (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)) extra a) @@ -1174,10 +1175,10 @@ lang=\"%s\" xml:lang=\"%s\"> (setq line (replace-match (format - (concat (if (match-string 1 line) "%s" "") + (concat "%s" (format org-export-html-footnote-format "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")) - (match-string 1 line) n extra n n) + (or (match-string 1 line) "") n extra n n) t t line)))))) (cond @@ -1331,10 +1332,11 @@ lang=\"%s\" xml:lang=\"%s\"> (let ((n (match-string 1 line))) (setq org-par-open t line (replace-match - (concat "<p class=\"footnote\">" - (format org-export-html-footnote-format - "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>" - n n n) t t line)))))) + (format + (concat "<p class=\"footnote\">" + (format org-export-html-footnote-format + "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>")) + n n n) t t line))))) ;; Check if the line break needs to be conserved (cond ((string-match "\\\\\\\\[ \t]*$" line) @@ -1419,7 +1421,8 @@ lang=\"%s\" xml:lang=\"%s\"> (unless (plist-get opt-plist :buffer-will-be-killed) (normal-mode) - (if (eq major-mode default-major-mode) (html-mode))) + (if (eq major-mode (default-value 'major-mode)) + (html-mode))) ;; insert the table of contents (goto-char (point-min)) @@ -1641,7 +1644,7 @@ lang=\"%s\" xml:lang=\"%s\"> (push (mapconcat (lambda (x) (setq gr (pop org-table-colgroup-info)) - (format "%s<col align=\"%s\"></col>%s" + (format "%s<col align=\"%s\" />%s" (if (memq gr '(:start :startend)) (prog1 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") @@ -1883,13 +1886,6 @@ If there are links in the string, don't modify these." (setq start (+ start (length wd)))))))) s) -(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) diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index 2ea7483078f..d3804e6cfb6 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 70f2243ce16..295125f9ec7 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -390,7 +390,7 @@ When FILES is given, scan these files instead. When CHECK is given, prepare detailed information about duplicate IDs." (interactive) (if (not org-id-track-globally) - (error "Please turn on `org-id-track-globally' if you want to track IDs.") + (error "Please turn on `org-id-track-globally' if you want to track IDs") (let ((files (or files (append @@ -563,7 +563,7 @@ optional argument MARKERP, return the position as a new marker." ;; so we do have to add it to `org-store-link-functions'. (defun org-id-store-link () - "Store a link to the current entry, using it's ID." + "Store a link to the current entry, using its ID." (interactive) (let* ((link (org-make-link "id:" (org-id-get-create))) (desc (save-excursion @@ -601,9 +601,8 @@ optional argument MARKERP, return the position as a new marker." (provide 'org-id) -;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712 ;;; org-id.el ends here - +;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712 diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 50b6f4856e6..7099ec2c30b 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -1,11 +1,10 @@ -;;; org-indent.el --- Dynamic indentation for Org-mode - -;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. +;;; org-indent.el --- Dynamic indentation for Org-mode +;; Copyright (C) 2009 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 8599404020a..3b5cfb148ea 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index ebee4268c92..070aa73f375 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -5,11 +5,12 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; 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 of the License, or ;; (at your option) any later version. diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index ac40ec606bd..f415bd1cc0f 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -4,7 +4,7 @@ ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index b5632fc85d0..55f2251f560 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 896a0073190..48a7ac2878b 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-latex.el -;; Version: 6.29c +;; Version: 6.30c ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -93,6 +93,7 @@ \\usepackage[T1]{fontenc} \\usepackage{graphicx} \\usepackage{longtable} +\\usepackage{soul} \\usepackage{hyperref}" ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") @@ -105,6 +106,7 @@ \\usepackage[T1]{fontenc} \\usepackage{graphicx} \\usepackage{longtable} +\\usepackage{soul} \\usepackage{hyperref}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") @@ -117,6 +119,7 @@ \\usepackage[T1]{fontenc} \\usepackage{graphicx} \\usepackage{longtable} +\\usepackage{soul} \\usepackage{hyperref}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") @@ -166,7 +169,7 @@ to represent the section title." '(("*" "\\textbf{%s}" nil) ("/" "\\emph{%s}" nil) ("_" "\\underline{%s}" nil) - ("+" "\\texttt{%s}" nil) + ("+" "\\st{%s}" nil) ("=" "\\verb" t) ("~" "\\verb" t)) "Alist of LaTeX expressions to convert emphasis fontifiers. @@ -245,9 +248,12 @@ When nil, grouping causes only separation lines between groups." (defcustom org-export-latex-packages-alist nil "Alist of packages to be inserted in the header. -Each cell is of the forma \( \"option\" . \"package\" \)." +Each cell is of the format \( \"option\" . \"package\" \)." :group 'org-export-latex - :type 'alist) + :type '(repeat + (list + (string :tag "option") + (string :tag "package")))) (defcustom org-export-latex-low-levels 'itemize "How to convert sections below the current level of sectioning. @@ -297,6 +303,43 @@ Defaults to \\begin{verbatim} and \\end{verbatim}." :type '(cons (string :tag "Open") (string :tag "Close"))) +(defcustom org-export-latex-listings nil + "Non-nil means, export source code using the listings package. +This package will fontify source code, possibly even with color. +If you want to use this, you also need to make LaTeX use the +listings package, and if you want to have color, the color +package. Just add these to `org-export-latex-packages-alist', +for example using customize, or with something like + + (require 'org-latex) + (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) + (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))" + :group 'org-export-latex + :type 'boolean) + +(defcustom org-export-latex-listings-langs + '((emacs-lisp "Lisp") (lisp "Lisp") + (c "C") (cc "C++") + (fortran "fortran") + (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") + (html "HTML") (xml "XML") + (tex "TeX") (latex "TeX") + (shell-script "bash") + (gnuplot "Gnuplot") + (ocaml "Caml") (caml "Caml") + (sql "SQL")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language parameter +for the listings package. If the mode name and the listings name are +the same, the language does not need an entry in this list - but it does not +hurt if it is present." + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) "A plist of keywords to remove from headlines. OBSOLETE. @@ -960,10 +1003,11 @@ If BEG is non-nil, it is the beginning of the region. If END is non-nil, it is the end of the region." (save-excursion (goto-char (or beg (point-min))) - (let* ((pt (point)) - (end (if (re-search-forward "^\\*+ " end t) - (goto-char (match-beginning 0)) - (goto-char end)))) + (let* ((pt (point))) + (or end + (and (re-search-forward "^\\*+ " end t) + (setq end (match-beginning 0))) + (setq end (point-max))) (prog1 (org-export-latex-content (org-export-preprocess-string @@ -1276,16 +1320,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defvar org-table-last-alignment) ; defined in org-table.el +(defvar org-table-last-column-widths) ; defined in org-table.el (declare-function orgtbl-to-latex "org-table" (table params) t) (defun org-export-latex-tables (insert) "Convert tables to LaTeX and INSERT it." (goto-char (point-min)) (while (re-search-forward "^\\([ \t]*\\)|" nil t) - ;; FIXME really need to save-excursion? - (save-excursion (org-table-align)) + (org-table-align) (let* ((beg (org-table-begin)) (end (org-table-end)) (raw-table (buffer-substring beg end)) + (org-table-last-alignment (copy-sequence org-table-last-alignment)) + (org-table-last-column-widths (copy-sequence + org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align caption label attr floatp longtblp) (if org-export-latex-tables-verbatim @@ -1310,6 +1357,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (apply 'delete-region (list beg end)) (when org-export-table-remove-special-lines (setq lines (org-table-clean-before-export lines 'maybe-quoted))) + (when org-table-clean-did-remove-column + (pop org-table-last-alignment) + (pop org-table-last-column-widths)) ;; make a formatting string to reflect aligment (setq olines lines) (while (and (not line-fmt) (setq line (pop olines))) @@ -1521,10 +1571,24 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ((not type) (insert (format "\\hyperref[%s]{%s}" (org-remove-initial-hash - (org-solidify-link-text raw-path)) desc))) - (path (insert (format "\\href{%s}{%s}" path desc))) + (org-solidify-link-text raw-path)) + desc))) + (path + (when (org-at-table-p) + ;; There is a strange problem when we have a link in a table, + ;; ampersands then cause a problem. I think this must be + ;; a LaTeX issue, but we here implement a work-around anyway. + (setq path (org-export-latex-protect-amp path) + desc (org-export-latex-protect-amp desc))) + (insert (format "\\href{%s}{%s}" path desc))) (t (insert "\\texttt{" desc "}"))))))) +(defun org-export-latex-protect-amp (s) + (while (string-match "\\([^\\\\]\\)\\(&\\)" s) + (setq s (replace-match (concat (match-string 1 s) "\\" (match-string 2 s)) + t t s))) + s) + (defun org-remove-initial-hash (s) (if (string-match "\\`#" s) (substring s 1) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 6c775f7d5d0..cef5fe458a4 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -7,7 +7,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -149,7 +149,9 @@ toggle a checkbox with \\[org-ctrl-c-ctrl-c]." (defcustom org-hierarchical-checkbox-statistics t "Non-nil means, checkbox statistics counts only the state of direct children. -When nil, all boxes below the cookie are counted." +When nil, all boxes below the cookie are counted. +This can be set to nil on a per-node basis using a COCKIE_DATA property +with the word \"recursive\" in the value." :group 'org-plain-lists :type 'boolean) @@ -834,7 +836,7 @@ with something like \"1.\" or \"2)\"." (goto-char (match-beginning 2)) (insert (setq new (format fmt (setq n (1+ n))))) (org-shift-item-indentation (- (length new) (length old)))))) - (goto-line line) + (org-goto-line line) (org-move-to-column col))) (defun org-fix-bullet-type (&optional force-bullet) @@ -872,7 +874,7 @@ Also, fix the indentation." (setq oldbullet (match-string 0)) (unless (equal bullet oldbullet) (replace-match bullet)) (org-shift-item-indentation (- (length bullet) (length oldbullet)))))) - (goto-line line) + (org-goto-line line) (org-move-to-column col) (if (string-match "[0-9]" bullet) (org-renumber-ordered-list 1)))) diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index ff33dc7de14..87fe77a7b70 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Christopher Suckling <suckling at gmail dot com> -;; Version: 6.29c +;; Version: 6.30c ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 4e15566f4f6..0bc3d059eb4 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -71,7 +71,7 @@ Also, do not record undo information." (_col (current-column))) (unwind-protect (progn ,@body) - (goto-line _line) + (org-goto-line _line) (org-move-to-column _col)))) (defmacro org-without-partial-completion (&rest body) @@ -173,7 +173,7 @@ We use a macro so that the test can happen at compilation time." (defsubst org-check-external-command (cmd &optional use no-error) "Check if external progam CMD for USE exists, error if not. -When the program does exist, return it's path. +When the program does exist, return its path. When it does not exist and NO-ERROR is set, return nil. Otherwise, throw an error. The optional argument USE can describe what this program is needed for, so that the error message can be more informative." @@ -219,6 +219,12 @@ we turn off invisibility temporarily. Use this in a `let' form." ;; works also in narrowed buffer, because we start at 1, not point-min (+ (if (bolp) 1 0) (count-lines 1 (point))))) +(defsubst org-goto-line (N) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- N)))) + (defsubst org-current-line-string (&optional to-here) (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol)))) diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 9fe84fece87..6840703fcde 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index ba408ef7c4f..8b90f3f93e8 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -6,7 +6,7 @@ ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index c911db9ad61..fd69589395d 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -4,7 +4,7 @@ ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 3f40eafb8cd..684a515e96d 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -33,7 +33,7 @@ (require 'org) (require 'org-exp) (require 'org-table) -(eval-and-compile +(eval-when-compile (require 'cl)) (declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg)) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 4de3ab89a44..b32c1095743 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -1,7 +1,7 @@ ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. ;; ;; Copyright (C) 2008, 2009 -;; Free Software Foundation, Inc. +;; Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Author: Daniel M German <dmg AT uvic DOT org> @@ -9,7 +9,7 @@ ;; Author: Ross Patterson <me AT rpatterson DOT net> ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> ;; Keywords: org, emacsclient, wp -;; Version: 6.29c +;; Version: 6.30c ;; This file is part of GNU Emacs. ;; @@ -422,7 +422,6 @@ The sub-protocol used to reach this function is set in uri)) nil) - (defun org-protocol-remember (info) "Process an org-protocol://remember:// style url. @@ -470,7 +469,6 @@ Now template ?b will be used." (message "Org-mode not loaded.")) nil) - (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -635,5 +633,4 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse (provide 'org-protocol) ;; arch-tag: b5c5c2ac-77cf-4a94-a649-2163dff95846 - ;;; org-protocol.el ends here diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index e6b0218b178..bac86366916 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -4,7 +4,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 6.29c +;; Version: 6.30c ;; This file is part of GNU Emacs. ;; @@ -632,7 +632,7 @@ Default for INDEX-FILENAME is 'sitemap.org'." "Publish PROJECT." (interactive (list - (assoc (org-ido-completing-read + (assoc (org-icompleting-read "Publish project: " org-publish-project-alist nil t) org-publish-project-alist) diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index 4bc1bf67d84..d3f83993daa 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -130,8 +130,8 @@ Furthermore, the following %-escapes will be replaced with content: You may define a prompt like %^{Please specify birthday %n user name (taken from `user-full-name') %a annotation, normally the link created with org-store-link - %i initial content, the region active. If %i is indented, - the entire inserted text will be indented as well. + %i initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. %c current kill ring head %x content of the X clipboard %^C Interactive selection of which kill or clip to use @@ -256,6 +256,18 @@ is set." :group 'org-remember :type 'boolean) +(defcustom org-remember-warn-about-backups t + "Non-nil means warn about backup files in `org-remember-backup-directory'. + +Set this to nil if you find that you don't need the warning. + +If you cancel remember calls frequently and know when they +contain useful information (because you know that you made an +error or emacs crashed, for example) nil is more useful. In the +opposite case, the default, t, is more useful." + :group 'org-remember + :type 'boolean) + (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' @@ -468,49 +480,53 @@ to be run from that hook to function properly." ;; Simple %-escapes (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t)) + (unless (org-remember-escaped-%) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string initial "\n") + (concat "\n" lead)))))) + (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)))))) + (unless (org-remember-escaped-%) + (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)))) + (unless (org-remember-escaped-%) + (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) + (unless (org-remember-escaped-%) (and (setq x (or (plist-get org-store-link-plist (intern (match-string 1))) "")) - (replace-match x t t)))) + (replace-match x t t))))) ;; Turn on org-mode in the remember buffer, set local variables (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) @@ -521,87 +537,89 @@ to be run from that hook to function properly." ;; Interactive template entries (goto-char (point-min)) (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (setq char (if (match-end 3) (match-string 3)) - 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 - (org-global-tags-completion-table - (if (equal char "G") (org-agenda-files) (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-ido-completing-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":"))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (let* - ((prop (org-substring-no-properties prompt)) - (pall (concat prop "_ALL")) - (allowed - (with-current-buffer - (get-buffer (file-name-nondirectory file)) - (or (cdr (assoc pall org-file-properties)) - (cdr (assoc pall org-global-properties)) - (cdr (assoc pall org-global-properties-fixed))))) - (existing (with-current-buffer - (get-buffer (file-name-nondirectory file)) - (mapcar 'list (org-property-values prop)))) - (propprompt (concat "Value for " prop ": ")) - (val (if allowed - (org-completing-read - propprompt - (mapcar 'list (org-split-string allowed "[ \t]+")) - nil 'req-match) - (org-completing-read-no-ido propprompt existing nil nil - "" nil "")))) - (org-set-property prop val))) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) "U") t nil - prompt)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (insert (org-completing-read-no-ido - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default)))))) + (unless (org-remember-escaped-%) + (setq char (if (match-end 3) (match-string 3)) + 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 + (org-global-tags-completion-table + (if (equal char "G") (org-agenda-files) (and file (list file))))) + (org-add-colon-after-tag-completion t) + (ins (org-icompleting-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history))) + (setq ins (mapconcat 'identity + (org-split-string ins (org-re "[^[:alnum:]_@]+")) + ":")) + (when (string-match "\\S-" ins) + (or (equal (char-before) ?:) (insert ":")) + (insert ins) + (or (equal (char-after) ?:) (insert ":"))))) + ((equal char "C") + (cond ((= (length clipboards) 1) (insert (car clipboards))) + ((> (length clipboards) 1) + (insert (read-string "Clipboard/kill value: " + (car clipboards) '(clipboards . 1) + (car clipboards)))))) + ((equal char "L") + (cond ((= (length clipboards) 1) + (org-insert-link 0 (car clipboards))) + ((> (length clipboards) 1) + (org-insert-link 0 (read-string "Clipboard/kill value: " + (car clipboards) + '(clipboards . 1) + (car clipboards)))))) + ((equal char "p") + (let* + ((prop (org-substring-no-properties prompt)) + (pall (concat prop "_ALL")) + (allowed + (with-current-buffer + (get-buffer (file-name-nondirectory file)) + (or (cdr (assoc pall org-file-properties)) + (cdr (assoc pall org-global-properties)) + (cdr (assoc pall org-global-properties-fixed))))) + (existing (with-current-buffer + (get-buffer (file-name-nondirectory file)) + (mapcar 'list (org-property-values prop)))) + (propprompt (concat "Value for " prop ": ")) + (val (if allowed + (org-completing-read + propprompt + (mapcar 'list (org-split-string allowed "[ \t]+")) + nil 'req-match) + (org-completing-read-no-i propprompt existing nil nil + "" nil "")))) + (org-set-property prop val))) + (char + ;; These are the date/time related ones + (setq org-time-was-given (equal (upcase char) char)) + (setq time (org-read-date (equal (upcase char) "U") t nil + prompt)) + (org-insert-time-stamp time org-time-was-given + (member char '("u" "U")) + nil nil (list org-end-time-was-given))) + (t + (let (org-completion-use-ido) + (insert (org-completing-read-no-i + (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 "") @@ -629,6 +647,14 @@ to be run from that hook to function properly." (replace-match "") (add-hook 'post-command-hook 'org-remember-finish-immediately 'append))) +(defun org-remember-escaped-% () + (if (equal (char-before (match-beginning 0)) ?\\) + (progn + (delete-region (1- (match-beginning 0)) (match-beginning 0)) + t) + nil)) + + (defun org-remember-finish-immediately () "File remember note immediately. This should be run in `post-command-hook' and will remove itself @@ -1050,7 +1076,8 @@ See also the variable `org-reverse-note-order'." (directory-files org-remember-backup-directory nil "^remember-.*[0-9]$")))) - (when (> n 0) + (when (and org-remember-warn-about-backups + (> n 0)) (message "%d backup files (unfinished remember calls) in %s" n org-remember-backup-directory)))))))))) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 4be14e859d0..b7536b21152 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -7,7 +7,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -109,11 +109,25 @@ You may want to use this hook for example to turn off `outline-minor-mode' or similar things which you want to have when editing a source code file, but which mess up the display of a snippet in Org exported files.") +(defcustom org-src-lang-modes + '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)) + "Alist mapping languages to their major mode. +The key is the language name, the value is the string that should +be inserted as the name of the major mode. For many languages this is +simple, but for language where this is not the case, this variable +provides a way to simplify things on the user side. +For example, there is no ocaml-mode in Emacs, but the mode to use is +`tuareg-mode'." + :group 'org-edit-structure + :type '(repeat + (cons + (string "Language name") + (symbol "Major mode")))) + ;;; Editing source examples (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) -(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) (defvar org-edit-src-picture nil) @@ -151,7 +165,9 @@ the edited version." (setq beg (move-marker beg (nth 0 info)) end (move-marker end (nth 1 info)) code (buffer-substring-no-properties beg end) - lang (nth 2 info) + lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) + (nth 2 info)) + lang (if (symbolp lang) (symbol-name lang) lang) single (nth 3 info) lfmt (nth 4 info) nindent (nth 5 info) @@ -159,7 +175,7 @@ the edited version." begline (save-excursion (goto-char beg) (org-current-line))) (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) - (goto-line line) + (org-goto-line line) (if (and (setq buffer (org-edit-src-find-buffer beg end)) (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) (switch-to-buffer buffer) @@ -168,7 +184,8 @@ the edited version." (if (boundp 'org-edit-src-overlay) (org-delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) - (setq buffer (generate-new-buffer "*Org Edit Src Example*")) + (setq buffer (generate-new-buffer + (concat "*Org Src " (file-name-nondirectory buffer-file-name) "[" lang "]*"))) (setq ovl (org-make-overlay beg end)) (org-overlay-put ovl 'face 'secondary-selection) (org-overlay-put ovl 'edit-buffer buffer) @@ -186,8 +203,7 @@ the edited version." '(display nil invisible nil intangible nil)) (org-do-remove-indentation) (let ((org-inhibit-startup t)) - (funcall lang-f) - (org-src-mode)) + (funcall lang-f)) (set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (when lfmt @@ -196,11 +212,13 @@ the edited version." (goto-char (point-min)) (while (re-search-forward "^," nil t) (replace-match ""))) - (goto-line (1+ (- line begline))) + (org-goto-line (1+ (- line begline))) (org-set-local 'org-edit-src-beg-marker beg) (org-set-local 'org-edit-src-end-marker end) (org-set-local 'org-edit-src-overlay ovl) (org-set-local 'org-edit-src-nindent nindent) + (org-src-mode) + (set-buffer-modified-p nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg))) (message "%s" msg) @@ -258,7 +276,7 @@ the fragment in the Org-mode buffer." (if (re-search-forward "^[ \t]*[^: \t]" nil 'move) (setq end1 (1- (match-beginning 0))) (setq end1 (point)))) - (goto-line line)) + (org-goto-line line)) (setq beg (move-marker beg beg1) end (move-marker end end1) code (buffer-substring-no-properties beg end) @@ -299,12 +317,13 @@ the fragment in the Org-mode buffer." (goto-char (point-min)) (while (re-search-forward "^[ \t]*: ?" nil t) (replace-match "")) - (goto-line (1+ (- line begline))) - (org-src-mode) + (org-goto-line (1+ (- line begline))) (org-set-local 'org-edit-src-beg-marker beg) (org-set-local 'org-edit-src-end-marker end) (org-set-local 'org-edit-src-overlay ovl) (org-set-local 'org-edit-src-nindent nindent) + (org-src-mode) + (set-buffer-modified-p nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg))) (message "%s" msg) @@ -400,8 +419,8 @@ the language, a switch telling of the content should be in a single line." (defun org-edit-src-exit () "Exit special edit and protect problematic lines." (interactive) - (unless (string-match "\\`*Org Edit " (buffer-name (current-buffer))) - (error "This is not an sub-editing buffer, something is wrong...")) + (unless org-edit-src-from-org-mode + (error "This is not a sub-editing buffer, something is wrong...")) (let ((beg org-edit-src-beg-marker) (end org-edit-src-end-marker) (ovl org-edit-src-overlay) @@ -441,14 +460,14 @@ the language, a switch telling of the content should be in a single line." (while (re-search-forward "^" nil t) (replace-match nindent))) (setq code (buffer-string)) + (set-buffer-modified-p nil) (switch-to-buffer (marker-buffer beg)) (kill-buffer buffer) (goto-char beg) - (org-delete-overlay ovl) (delete-region beg end) (insert code) (goto-char beg) - (goto-line (1- (+ (org-current-line) line))) + (org-goto-line (1- (+ (org-current-line) line))) (move-marker beg nil) (move-marker end nil))) @@ -464,6 +483,19 @@ the language, a switch telling of the content should be in a single line." (goto-char (min p (point-max))) (message (or msg "")))) +(defun org-src-mode-configure-edit-buffer () + (when org-edit-src-from-org-mode + (setq buffer-offer-save t) + (setq buffer-file-name + (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) + "[" (buffer-name) "]")) + (set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions) + '(org-edit-src-save)) + (org-add-hook 'kill-buffer-hook + '(lambda () (org-delete-overlay org-edit-src-overlay)) nil 'local))) + +(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) + (provide 'org-src) ;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8 diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index f09d51917c0..bf7d960a56a 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -719,9 +719,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (append (pop fields) emptystrings)) hfmt)) lines "")) - ;; Replace the old one - (delete-region beg end) - (move-marker end nil) (if (equal (char-before) ?\n) ;; This hack is for org-indent, to force redisplay of the ;; line prefix of the first line. Apparently the redisplay @@ -734,14 +731,17 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (insert "\n"))) (move-marker org-table-aligned-begin-marker (point)) (insert new) + ;; Replace the old one + (delete-region (point) end) + (move-marker end nil) (move-marker org-table-aligned-end-marker (point)) (when (and orgtbl-mode (not (org-mode-p))) (goto-char org-table-aligned-begin-marker) (while (org-hide-wide-columns org-table-aligned-end-marker))) ;; Try to move to the old location - (goto-line winstartline) + (org-goto-line winstartline) (setq winstart (point-at-bol)) - (goto-line linepos) + (org-goto-line linepos) (set-window-start (selected-window) winstart 'noforce) (org-table-goto-column colpos) (and org-table-overlay-coordinates (org-table-overlay-coordinates)) @@ -1127,7 +1127,7 @@ However, when FORCE is non-nil, create new columns if necessary." (insert "| ")) (beginning-of-line 2)) (move-marker end nil) - (goto-line linepos) + (org-goto-line linepos) (org-table-goto-column colpos) (org-table-align) (org-table-fix-formulas "$" nil (1- col) 1) @@ -1174,7 +1174,7 @@ However, when FORCE is non-nil, create new columns if necessary." (replace-match "|"))) (beginning-of-line 2)) (move-marker end nil) - (goto-line linepos) + (org-goto-line linepos) (org-table-goto-column colpos) (org-table-align) (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) @@ -1218,7 +1218,7 @@ However, when FORCE is non-nil, create new columns if necessary." (replace-match "|\\2|\\1|"))) (beginning-of-line 2)) (move-marker end nil) - (goto-line linepos) + (org-goto-line linepos) (org-table-goto-column colpos) (org-table-align) (org-table-fix-formulas @@ -1424,7 +1424,7 @@ should be done in reverse order." (move-marker beg nil) (move-marker end nil) (insert (mapconcat 'cdr lns "\n") "\n") - (goto-line thisline) + (org-goto-line thisline) (org-table-goto-column thiscol) (message "%d lines sorted, based on column %d" (length lns) column))) @@ -1462,7 +1462,7 @@ with `org-table-paste-rectangle'." (while t (catch 'nextline (if (> l1 l2) (throw 'exit t)) - (goto-line l1) + (org-goto-line l1) (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) (setq cols nil ic1 c1 ic2 c2) (while (< ic1 (1+ ic2)) @@ -1500,7 +1500,7 @@ lines." (org-table-get-field nil field) (setq c (1+ c))) (beginning-of-line 2)) - (goto-line line) + (org-goto-line line) (org-table-goto-column col) (org-table-align))) @@ -1590,7 +1590,7 @@ blank, and the content is appended to the field above." (setq org-table-clip (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") nil nlines))) - (goto-line cline) + (org-goto-line cline) (org-table-goto-column ccol) (org-table-paste-rectangle)) ;; No region, split the current field at point @@ -1994,7 +1994,7 @@ For all numbers larger than LIMIT, shift them by DELTA." last-dline (car dlines) org-table-dlines (apply 'vector (cons nil (nreverse dlines))) org-table-hlines (apply 'vector (cons nil (nreverse hlines)))) - (goto-line last-dline) + (org-goto-line last-dline) (let* ((l last-dline) (fields (org-split-string (buffer-substring (point-at-bol) (point-at-eol)) @@ -2070,7 +2070,7 @@ of the new mark." (if (and newchar (not forcenew)) (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" newchar)) - (if l1 (goto-line l1)) + (if l1 (org-goto-line l1)) (save-excursion (beginning-of-line 1) (unless (looking-at org-table-dataline-regexp) @@ -2091,13 +2091,13 @@ of the new mark." " # "))) (if (and l1 l2) (progn - (goto-line l1) + (org-goto-line l1) (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) (and (looking-at org-table-dataline-regexp) (org-table-get-field 1 (concat " " new " ")))) - (goto-line l1))) + (org-goto-line l1))) (if (not (= epos (point-at-eol))) (org-table-align)) - (goto-line l) + (org-goto-line l) (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) (defun org-table-maybe-recalculate-line () @@ -2360,7 +2360,7 @@ HIGHLIGHT means, just highlight the range." (if (or (not rangep) (and (= r1 r2) (= c1 c2))) ;; just one field (progn - (goto-line r1) + (org-goto-line r1) (while (not (looking-at org-table-dataline-regexp)) (beginning-of-line 2)) (prog1 (org-trim (org-table-get-field c1)) @@ -2369,12 +2369,12 @@ HIGHLIGHT means, just highlight the range." ;; First sort the numbers to get a regular ractangle (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line r1) + (org-goto-line r1) (while (not (looking-at org-table-dataline-regexp)) (beginning-of-line 2)) (org-table-goto-column c1) (setq beg (point)) - (goto-line r2) + (org-goto-line r2) (while (not (looking-at org-table-dataline-regexp)) (beginning-of-line 0)) (org-table-goto-column c2) @@ -2550,7 +2550,7 @@ known that the table will be realigned a little later anyway." (string-to-number (match-string 2 name))))) (when (and a (or all (equal (nth 1 a) thisline))) (message "Re-applying formula to field: %s" name) - (goto-line (nth 1 a)) + (org-goto-line (nth 1 a)) (org-table-goto-column (nth 2 a)) (push (append a (list (cdr eq))) eqlname1) (org-table-put-field-property :org-untouchable t))) @@ -2566,7 +2566,7 @@ known that the table will be realigned a little later anyway." (setq org-last-recalc-line (org-current-line)) (setq eql eqlnum) (while (setq entry (pop eql)) - (goto-line org-last-recalc-line) + (org-goto-line org-last-recalc-line) (org-table-goto-column (string-to-number (car entry)) nil 'force) (unless (get-text-property (point) :org-untouchable) (org-table-eval-formula nil (cdr entry) @@ -2575,12 +2575,12 @@ known that the table will be realigned a little later anyway." ;; Now evaluate the field formulas (while (setq eq (pop eqlname1)) (message "Re-applying formula to field: %s" (car eq)) - (goto-line (nth 1 eq)) + (org-goto-line (nth 1 eq)) (org-table-goto-column (nth 2 eq)) (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst 'nostore 'noanalysis)) - (goto-line thisline) + (org-goto-line thisline) (org-table-goto-column thiscol) (remove-text-properties (point-min) (point-max) '(org-untouchable t)) (or noalign (and org-table-may-need-update (org-table-align)) @@ -2588,7 +2588,7 @@ known that the table will be realigned a little later anyway." ;; back to initial position (message "Re-applying formulas...done") - (goto-line thisline) + (org-goto-line thisline) (org-table-goto-column thiscol) (or noalign (and org-table-may-need-update (org-table-align)) (and all (message "Re-applying formulas...done")))))) @@ -2744,7 +2744,7 @@ Parameters get priority." (insert s)) (if (eq org-table-use-standard-references t) (org-table-fedit-toggle-ref-type)) - (goto-line startline) + (org-goto-line startline) (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) (defun org-table-fedit-post-command () @@ -2839,7 +2839,7 @@ For example: 28 -> AB." (insert (funcall function (buffer-substring (point) (point-at-eol)))) (delete-region (point) (point-at-eol)) (or (eobp) (forward-char 1))) - (goto-line line))) + (org-goto-line line))) (defun org-table-fedit-toggle-ref-type () "Convert all references in the buffer from B3 to @3$2 and back." @@ -2993,7 +2993,7 @@ With prefix ARG, apply the new formulas to the table." (call-interactively 'lisp-indent-line)) ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available.")) + (error "Cannot pretty-print. Command `pp-buffer' is not available")) ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") (goto-char (- (match-end 0) 2)) (setq beg (point)) @@ -3080,12 +3080,12 @@ With prefix ARG, apply the new formulas to the table." (cond ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) (setq e (assoc name org-table-named-field-locations)) - (goto-line (nth 1 e)) + (org-goto-line (nth 1 e)) (org-table-goto-column (nth 2 e))) ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) (let ((l (string-to-number (match-string 1 dest))) (c (string-to-number (match-string 2 dest)))) - (goto-line (aref org-table-dlines l)) + (org-goto-line (aref org-table-dlines l)) (org-table-goto-column c))) (t (org-table-goto-column (string-to-number name)))) (move-marker pos (point)) @@ -3099,7 +3099,7 @@ With prefix ARG, apply the new formulas to the table." (org-table-get-range match nil nil 'highlight)) (error nil))) ((setq e (assoc var org-table-named-field-locations)) - (goto-line (nth 1 e)) + (org-goto-line (nth 1 e)) (org-table-goto-column (nth 2 e)) (org-table-highlight-rectangle (point) (point)) (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) @@ -3224,7 +3224,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (setq l2 (org-current-line) c2 (org-table-current-column)) (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line l1) + (org-goto-line l1) (beginning-of-line 1) (loop for line from l1 to l2 do (when (looking-at org-table-dataline-regexp) @@ -3783,7 +3783,7 @@ this table." (org-table-end))) (ntbl 0)) (unless dests (if maybe (throw 'exit nil) - (error "Don't know how to transform this table."))) + (error "Don't know how to transform this table"))) (dolist (dest dests) (let* ((name (plist-get dest :name)) (transform (plist-get dest :transform)) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 385f09b8954..847d5140973 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -78,9 +78,7 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - (- - (time-to-seconds (current-time)) - (org-timer-hms-to-secs s))))) + (- (org-float-time) (org-timer-hms-to-secs s))))) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" (format-time-string "%T" org-timer-start-time) @@ -97,9 +95,9 @@ the region 0:00:00." (setq org-timer-start-time (seconds-to-time (- - (time-to-seconds (current-time)) - (- (time-to-seconds org-timer-pause-time) - (time-to-seconds org-timer-start-time)))) + (org-float-time) + (- (org-float-time org-timer-pause-time) + (org-float-time org-timer-start-time)))) org-timer-pause-time nil) (org-timer-set-mode-line 'on) (message "Timer continues at %s" (org-timer-value-string))) @@ -133,8 +131,8 @@ that was not started at the correct moment." (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds))))) (defun org-timer-seconds () - (- (time-to-seconds (or org-timer-pause-time (current-time))) - (time-to-seconds org-timer-start-time))) + (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time org-timer-start-time))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) @@ -317,8 +315,8 @@ VALUE can be `on', `off', or `pause'." (if (not (or (eval timer) timer-set)) (setq timer-set t timer - (run-with-timer secs nil 'org-show-notification - (format "%s: time out" hl)) + (run-with-timer + secs nil 'org-notify (format "%s: time out" hl) t) org-timer-last-timer timer))) '(org-timer-timer1 org-timer-timer2 diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 283ac74639b..6feb64732a4 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index 773e8bc9630..5f0bf265849 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -5,7 +5,7 @@ ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 60be81e75c3..24a772a7aa2 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -6,7 +6,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index d55993f8065..61904c26542 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org.el b/lisp/org/org.el index 591d920253f..588faa21ac2 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -95,17 +95,36 @@ ;;; Version -(defconst org-version "6.29c" +(defconst org-version "6.30c" "The version number of the file org.el.") (defun org-version (&optional here) "Show the org-mode version in the echo area. With prefix arg HERE, insert it at point." (interactive "P") - (let ((version (format "Org-mode version %s" org-version))) + (let* ((version org-version) + (git-version) + (dir (concat (file-name-directory (locate-library "org")) "../" ))) + (if (and (file-exists-p (expand-file-name ".git" dir)) + (executable-find "git")) + (let ((pwd (substring (pwd) 10))) + (cd dir) + (if (eql 0 (shell-command "git describe --abbrev=4 HEAD")) + (save-excursion + (set-buffer "*Shell Command Output*") + (goto-char (point-min)) + (re-search-forward "[^\n]+") + (setq git-version (match-string 0)) + (subst-char-in-string ?- ?. git-version t) + (shell-command "git diff-index --name-only HEAD --") + (unless (eql 1 (point-max)) + (setq git-version (concat git-version ".dirty"))) + (setq version (concat version " (" git-version ")"))) + (cd pwd)))) + (setq version (format "Org-mode version %s" version)) + (if here (insert version)) (message version) - (if here - (insert version)))) + version)) ;;; Compatibility constants @@ -207,6 +226,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) + (const :tag "C track: Keep up with Org development" org-track) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil @@ -652,6 +672,9 @@ So the default 2 means, at least 2 empty lines after the end of a subtree are needed to produce free space between a collapsed subtree and the following headline. +If the number is negative, and the number of empty lines is at least -N, +all empty lines are shown. + Special case: when 0, never leave empty lines in collapsed view." :group 'org-cycle :type 'integer) @@ -1751,7 +1774,9 @@ current entry each time a todo state is changed." (defcustom org-hierarchical-todo-statistics t "Non-nil means, TODO statistics covers just direct children. When nil, all entries in the subtree are considered. -This has only an effect if `org-provide-todo-statistics' is set." +This has only an effect if `org-provide-todo-statistics' is set. +To set this to nil for only a single subtree, use a COOKIE_DATA +property and include the word \"recursive\" into the value." :group 'org-todo :type 'boolean) @@ -2848,7 +2873,17 @@ This is needed for font-lock setup.") "Non-nil means, use ido completion wherever possible. Note that `ido-mode' must be active for this variable to be relevant. If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'." +`org-outline-path-complete-in-steps'. +See also `org-completion-use-iswitchb'." + :group 'org-completion + :type 'boolean) + +(defcustom org-completion-use-iswitchb nil + "Non-nil means, use iswitchb completion wherever possible. +Note that `iswitchb-mode' must be active for this variable to be relevant. +If you decide to turn this variable on, you might well want to turn off +`org-outline-path-complete-in-steps'. +Note that thi variable has only an effect if `org-completion-use-ido' is nil." :group 'org-completion :type 'boolean) @@ -3085,6 +3120,8 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-clock-start-time) (defvar org-clock-marker (make-marker) "Marker recording the last clock-in.") +(defvar org-clock-hd-marker (make-marker) + "Marker recording the last clock-in, but the headline position.") (defun org-clock-is-active () "Return non-nil if clock is currently running. The return value is actually the clock marker." @@ -3128,9 +3165,9 @@ Otherwise, return nil." (end-of-line 1) (setq ts (match-string 1) te (match-string 3)) - (setq s (- (time-to-seconds + (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) - (time-to-seconds + (org-float-time (apply 'encode-time (org-parse-time-string ts)))) neg (< s 0) s (abs s) @@ -3694,7 +3731,8 @@ means to push this value onto the list in the variable.") ;; Compute the regular expressions and other local variables (if (not org-done-keywords) - (setq org-done-keywords (list (org-last org-todo-keywords-1)))) + (setq org-done-keywords (and org-todo-keywords-1 + (list (org-last org-todo-keywords-1))))) (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) (length org-scheduled-string) (length org-clock-string) @@ -4448,7 +4486,15 @@ will be prompted for." "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) + +;; This should be with the exporter code, but we also use if for font-locking +(defconst org-export-html-special-string-regexps + '(("\\\\-" . "­") + ("---\\([^-]\\)" . "—\\1") + ("--\\([^-]\\)" . "–\\1") + ("\\.\\.\\." . "…")) + "Regular expressions for special string conversion.") + (defun org-compute-latex-and-specials-regexp () "Compute regular expression for stuff treated specially by exporters." @@ -4764,7 +4810,7 @@ If KWD is a number, get the corresponding match group." (defun org-cycle (&optional arg) "TAB-action and visibility cycling for Org-mode. -This is the command invoked in Org-moe by the TAB key. It's main purpose +This is the command invoked in Org-mode by the TAB key. Its main purpose is outine visibility cycling, but it also invokes other actions in special contexts. @@ -4972,7 +5018,7 @@ in special contexts. (skip-chars-forward " \t\n") (beginning-of-line 1) ; in case this is an item ) - (setq eos (1- (point)))) + (setq eos (if (eobp) (point) (1- (point))))) ;; Find out what to do next and set `this-command' (cond ((= eos eoh) @@ -5157,13 +5203,13 @@ This function is the default value of the hook `org-cycle-hook'." ;; First, find a reasonable region to look at: ;; Start two siblings above, end three below (let* ((beg (save-excursion - (and (outline-get-last-sibling) - (outline-get-last-sibling)) + (and (org-get-last-sibling) + (org-get-last-sibling)) (point))) (end (save-excursion - (and (outline-get-next-sibling) - (outline-get-next-sibling) - (outline-get-next-sibling)) + (and (org-get-next-sibling) + (org-get-next-sibling) + (org-get-next-sibling)) (if (org-at-heading-p) (point-at-eol) (point)))) @@ -5187,16 +5233,16 @@ The region to be covered depends on STATE when called through `org-cycle-hook'. Lisp program can use t for STATE to get the entire buffer covered. Note that an empty line is only shown if there are at least `org-cycle-separator-lines' empty lines before the headline." - (when (> org-cycle-separator-lines 0) + (when (not (= org-cycle-separator-lines 0)) (save-excursion - (let* ((n org-cycle-separator-lines) + (let* ((n (abs org-cycle-separator-lines)) (re (cond ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") (t (let ((ns (number-to-string (- n 2)))) (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) - beg end) + beg end b e) (cond ((memq state '(overview contents t)) (setq beg (point-min) end (point-max))) @@ -5207,9 +5253,15 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (when beg (goto-char beg) (while (re-search-forward re end t) - (if (not (get-char-property (match-end 1) 'invisible)) - (outline-flag-region - (match-beginning 1) (match-end 1) nil))))))) + (unless (get-char-property (match-end 1) 'invisible) + (setq e (match-end 1)) + (if (< org-cycle-separator-lines 0) + (setq b (save-excursion + (goto-char (match-beginning 0)) + (org-back-over-empty-lines) + (point))) + (setq b (match-beginning 1))) + (outline-flag-region b e nil))))))) ;; Never hide empty lines at the end of the file. (save-excursion (goto-char (point-max)) @@ -5250,7 +5302,7 @@ are at least `org-cycle-separator-lines' empty lines before the headline." "^[ \t]*:END:" (save-excursion (outline-next-heading) (point)) t) (outline-flag-region b (point-at-eol) flag) - (error ":END: line missing")))))) + (error ":END: line missing at position %s" b)))))) (defun org-subtree-end-visible-p () "Is the end of the current subtree visible?" @@ -5323,24 +5375,34 @@ the range." (beginning-of-line) (if (re-search-forward org-block-regexp nil t) (let ((start (- (match-beginning 4) 1)) ;; beginning of body - (end (match-end 0)) - ov) ;; end of entire body + (end (match-end 0)) ;; end of entire body + ov) (if (memq t (mapcar (lambda (overlay) (eq (org-overlay-get overlay 'invisible) 'org-hide-block)) (org-overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-hide-block-overlays) - (setq org-hide-block-overlays - (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) - 'org-hide-block) - (org-delete-overlay ov))) - (org-overlays-at start))) - (setq ov (org-make-overlay start end)) + (if (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-hide-block-overlays) + (setq org-hide-block-overlays + (delq ov org-hide-block-overlays))) + (when (eq (org-overlay-get ov 'invisible) + 'org-hide-block) + (org-delete-overlay ov))) + (org-overlays-at start))) + (setq ov (org-make-overlay start end)) (org-overlay-put ov 'invisible 'org-hide-block) - (push ov org-hide-block-overlays))) + ;; make the block accessible to isearch + (org-overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (member ov org-hide-block-overlays) + (setq org-hide-block-overlays + (delq ov org-hide-block-overlays))) + (when (eq (org-overlay-get ov 'invisible) + 'org-hide-block) + (org-delete-overlay ov)))) + (push ov org-hide-block-overlays))) (error "Not looking at a source block")))) ;; org-tab-after-check-for-cycling-hook @@ -5599,7 +5661,7 @@ frame is not changed." (switch-to-buffer ibuf)) ((eq org-indirect-buffer-display 'other-window) (pop-to-buffer ibuf)) - (t (error "Invalid value."))) + (t (error "Invalid value"))) (if (featurep 'xemacs) (save-excursion (org-mode) (turn-on-font-lock))) (narrow-to-region beg end) @@ -5662,6 +5724,7 @@ but create the new headline after the current line." ;; insert before the current line (open-line (if blank 2 1))) ((and (bolp) + (not org-insert-heading-respect-content) (or (bobp) (save-excursion (backward-char 1) (not (org-invisible-p))))) @@ -6010,7 +6073,7 @@ is signaled in this case." ;; First check if there are no even levels (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) (org-show-context t) - (error "Not all levels are odd in this file. Conversion not possible.")) + (error "Not all levels are odd in this file. Conversion not possible")) (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") (let ((org-odd-levels-only nil) n) (save-excursion @@ -6036,8 +6099,8 @@ is signaled in this case." "Move the current subtree down past ARG headlines of the same level." (interactive "p") (setq arg (prefix-numeric-value arg)) - (let ((movfunc (if (> arg 0) 'outline-get-next-sibling - 'outline-get-last-sibling)) + (let ((movfunc (if (> arg 0) 'org-get-next-sibling + 'org-get-last-sibling)) (ins-point (make-marker)) (cnt (abs arg)) beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) @@ -6539,13 +6602,13 @@ WITH-CASE, the sorting considers case as well." (and (= (downcase sorting-type) ?f) (setq getkey-func - (org-ido-completing-read "Sort using function: " + (org-icompleting-read "Sort using function: " obarray 'fboundp t nil nil)) (setq getkey-func (intern getkey-func))) (and (= (downcase sorting-type) ?r) (setq property - (org-ido-completing-read "Property: " + (org-icompleting-read "Property: " (mapcar 'list (org-buffer-property-keys t)) nil t)))) @@ -6594,7 +6657,7 @@ WITH-CASE, the sorting considers case as well." (re-search-forward org-ts-regexp-both (point-at-eol) t)) (org-time-string-to-seconds (match-string 0)) - (time-to-seconds now))) + (org-float-time now))) ((= dcst ?f) (if getkey-func (progn @@ -6618,24 +6681,24 @@ WITH-CASE, the sorting considers case as well." (if (or (re-search-forward org-ts-regexp end t) (re-search-forward org-ts-regexp-both end t)) (org-time-string-to-seconds (match-string 0)) - (time-to-seconds now)))) + (org-float-time now)))) ((= dcst ?c) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") end t) (org-time-string-to-seconds (match-string 0)) - (time-to-seconds now)))) + (org-float-time now)))) ((= dcst ?s) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward org-scheduled-time-regexp end t) (org-time-string-to-seconds (match-string 1)) - (time-to-seconds now)))) + (org-float-time now)))) ((= dcst ?d) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward org-deadline-time-regexp end t) (org-time-string-to-seconds (match-string 1)) - (time-to-seconds now)))) + (org-float-time now)))) ((= dcst ?p) (if (re-search-forward org-priority-regexp (point-at-eol) t) (string-to-char (match-string 2)) @@ -6694,7 +6757,7 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." (lambda (x) (if (or (string-match org-ts-regexp x) (string-match org-ts-regexp-both x)) - (time-to-seconds + (org-float-time (org-time-string-to-time (match-string 0 x))) 0)) comparefun (if (= dcst sorting-type) '< '>))) @@ -7516,7 +7579,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unwind-protect (progn (setq link - (let ((org-completion-use-ido nil)) + (let ((org-completion-use-ido nil) + (org-completion-use-iswitchb nil)) (org-completing-read "Link: " (append @@ -7626,14 +7690,23 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (copy-keymap minibuffer-local-completion-map))) (org-defkey minibuffer-local-completion-map " " 'self-insert-command) (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) - (apply 'org-ido-completing-read args))) + (apply 'org-icompleting-read args))) -(defun org-completing-read-no-ido (&rest args) - (let (org-completion-use-ido) +(defun org-completing-read-no-i (&rest args) + (let (org-completion-use-ido org-completion-use-iswitchb) (apply 'org-completing-read args))) -(defun org-ido-completing-read (&rest args) - "Completing-read using `ido-mode' speedups if available" +(defun org-iswitchb-completing-read (prompt choices &rest args) + "Use iswitch as a completing-read replacement to choose from choices. +PROMPT is a string to prompt with. CHOICES is a list of strings to choose +from." + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist choices)))) + (iswitchb-read-buffer prompt))) + +(defun org-icompleting-read (&rest args) + "Completing-read using `ido-mode' or `iswitchb' speedups if available" (if (and org-completion-use-ido (fboundp 'ido-completing-read) (boundp 'ido-mode) ido-mode @@ -7644,7 +7717,13 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (mapcar (lambda (x) (car x)) (nth 1 args)) (nth 1 args)) (cddr args))) - (apply 'completing-read args))) + (if (and org-completion-use-iswitchb + (boundp 'iswitchb-mode) iswitchb-mode + (listp (second args))) + (apply 'org-iswitchb-completing-read (concat (car args)) + (mapcar (lambda (x) (car x)) (nth 1 args)) + (cddr args)) + (apply 'completing-read args)))) (defun org-extract-attributes (s) "Extract the attributes cookie from a string and set as text property." @@ -7783,10 +7862,10 @@ Org-mode syntax." (org-run-like-in-org-mode 'org-open-at-point)) ;;;###autoload -(defun org-open-link-from-string (s &optional arg) +(defun org-open-link-from-string (s &optional arg reference-buffer) "Open a link in the string S, as if it was in Org-mode." (interactive "sLink: \nP") - (let ((reference-buffer (current-buffer))) + (let ((reference-buffer (or reference-buffer (current-buffer)))) (with-temp-buffer (let ((org-inhibit-startup t)) (org-mode) @@ -7808,6 +7887,13 @@ application the system uses for this file type." (setq org-window-config-before-follow-link (current-window-configuration)) (org-remove-occur-highlights nil nil t) (cond + ((and (org-on-heading-p) + (not (org-in-regexp + (concat org-plain-link-re "\\|" + org-bracket-link-regexp "\\|" + org-angle-link-re "\\|" + "[ \t]:[^ \t\n]+:[ \t]*$")))) + (org-offer-links-in-entry in-emacs)) ((org-at-timestamp-p t) (org-follow-timestamp-link)) ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) (org-footnote-action)) @@ -7862,110 +7948,161 @@ application the system uses for this file type." ;; switch back to reference buffer ;; needed when if called in a temporary buffer through ;; org-open-link-from-string - (and reference-buffer (switch-to-buffer reference-buffer)) + (with-current-buffer (or reference-buffer (current-buffer)) - ;; Remove any trailing spaces in path - (if (string-match " +\\'" path) - (setq path (replace-match "" t t path))) - (if (and org-link-translation-function - (fboundp org-link-translation-function)) - ;; Check if we need to translate the link - (let ((tmp (funcall org-link-translation-function type path))) - (setq type (car tmp) path (cdr tmp)))) + ;; Remove any trailing spaces in path + (if (string-match " +\\'" path) + (setq path (replace-match "" t t path))) + (if (and org-link-translation-function + (fboundp org-link-translation-function)) + ;; Check if we need to translate the link + (let ((tmp (funcall org-link-translation-function type path))) + (setq type (car tmp) path (cdr tmp)))) - (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)))) - - ((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") - (require 'org-gnus) - (org-gnus-follow-link path)) - - ((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 - (if (equal (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (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") + (require 'org-gnus) + (org-gnus-follow-link path)) + + ((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 + (if (equal (string-to-char cmd) ?\() + (eval (read cmd)) + (call-interactively (read cmd)))) + (error "Abort")))) - (t - (browse-url-at-point)))))) - (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook)) + (t + (browse-url-at-point)))))) + (move-marker org-open-link-marker nil) + (run-hook-with-args 'org-follow-link-hook))) + +(defun org-offer-links-in-entry (&optional nth) + "Offer links in the curren entry and follow the selected link. +If there is only one link, follow it immediately as well. +If NTH is an integer immediately pick the NTH link found." + (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" + "\\(" org-angle-link-re "\\)\\|" + "\\(" org-plain-link-re "\\)")) + (cnt ?0) + (in-emacs (if (integerp nth) nil nth)) + end + links link c) + (save-excursion + (org-back-to-heading t) + (setq end (save-excursion (outline-next-heading) (point))) + (while (re-search-forward re end t) + (push (match-string 0) links)) + (setq links (org-uniquify (reverse links)))) + + (cond + ((null links) (error "No links")) + ((equal (length links) 1) + (setq link (car links))) + ((and (integerp nth) (>= (length links) nth)) + (setq link (nth (1- nth) links))) + (t ; we have to select a link + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Select Link*" + (princ "Select link\n\n") + (mapc (lambda (l) + (if (not (string-match org-bracket-link-regexp l)) + (princ (format "[%c] %s\n" (incf cnt) + (org-remove-angle-brackets l))) + (if (match-end 3) + (princ (format "[%c] %s (%s)\n" (incf cnt) + (match-string 3 l) (match-string 1 l))) + (princ (format "[%c] %s\n" (incf cnt) + (match-string 1 l)))))) + links)) + (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) + (message "Select link to open:") + (setq c (read-char-exclusive)) + (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) + (when (equal c ?q) (error "Abort")) + (setq nth (- c ?0)) + (unless (and (integerp nth) (>= (length links) nth)) + (error "Invalid link selection")) + (setq link (nth (1- nth) links)))) + (org-open-link-from-string link in-emacs (current-buffer)))) ;;;; Time estimates @@ -8349,7 +8486,7 @@ If the file does not exist, an error is thrown." (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) (widen) - (if line (goto-line line) + (if line (org-goto-line line) (if search (org-link-search search)))) ((consp cmd) (let ((file (convert-standard-filename file))) @@ -8640,7 +8777,7 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'" (goto-char (if reversed (or (outline-next-heading) (point-max)) - (or (save-excursion (outline-get-next-sibling)) + (or (save-excursion (org-get-next-sibling)) (org-end-of-subtree t t) (point-max))))) (setq level 1) @@ -8681,7 +8818,7 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'" (cfunc (if (and org-refile-use-outline-path org-outline-path-complete-in-steps) 'org-olpath-completing-read - 'org-ido-completing-read)) + 'org-icompleting-read)) (extra (if org-refile-use-outline-path "/" "")) (filename (and cfn (expand-file-name cfn))) (tbl (mapcar @@ -8700,7 +8837,7 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'" (setq answ (funcall cfunc prompt tbl nil (not new-nodes) nil 'org-refile-history)) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) - (if pa + (if pa (progn (when (or (not org-refile-history) (not (eq old-hist org-refile-history)) @@ -8751,9 +8888,10 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'" (defun org-olpath-completing-read (prompt collection &rest args) "Read an outline path like a file name." (let ((thetable collection) - (org-completion-use-ido nil)) ; does not work with ido. + (org-completion-use-ido nil) ; does not work with ido. + (org-completion-use-iswitchb nil)) ; or iswitchb (apply - 'org-ido-completing-read prompt + 'org-icompleting-read prompt (lambda (string predicate &optional flag) (let (rtn r f (l (length string))) (cond @@ -8912,7 +9050,8 @@ This function can be used in a hook." "BEGIN_SRC" "END_SRC" "CATEGORY" "COLUMNS" "CAPTION" "LABEL" - "BIND")) + "BIND" + "MACRO")) (defcustom org-structure-template-alist '( @@ -9044,11 +9183,14 @@ At all other locations, this simply calls the value of (setq type :opt) (require 'org-exp) (append - (mapcar - (lambda (x) - (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) - (cons (match-string 2 x) (match-string 1 x))) - (org-split-string (org-get-current-options) "\n")) + (delq nil + (mapcar + (lambda (x) + (if (string-match + "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) + (cons (match-string 2 x) + (match-string 1 x)))) + (org-split-string (org-get-current-options) "\n"))) (mapcar 'list org-additional-option-like-keywords))) (startup (setq type :startup) @@ -9247,7 +9389,7 @@ For calling through lisp, arg is also interpreted in the following way: (or (not org-use-fast-todo-selection) (not org-todo-key-trigger))) ;; Read a state with completion - (org-ido-completing-read + (org-icompleting-read "State: " (mapcar (lambda(x) (list x)) org-todo-keywords-1) nil t)) @@ -9513,6 +9655,39 @@ changes because there are uncheckd boxes in this entry." (throw 'dont-block nil))))) t)) ; do not block +(defun org-update-statistics-cookies (all) + "Update the statistics cookie, either from TODO or from checkboxes. +This should be called with the cursor in a line with a statistics cookie." + (interactive "P") + (if all + (progn + (org-update-checkbox-count 'all) + (org-map-entries 'org-update-parent-todo-statistics)) + (if (not (org-on-heading-p)) + (org-update-checkbox-count) + (let ((pos (move-marker (make-marker) (point))) + end l1 l2) + (ignore-errors (org-back-to-heading t)) + (if (not (org-on-heading-p)) + (org-update-checkbox-count) + (setq l1 (org-outline-level)) + (setq end (save-excursion + (outline-next-heading) + (if (org-on-heading-p) (setq l2 (org-outline-level))) + (point))) + (if (and (save-excursion (re-search-forward + "^[ \t]*[-+*] \\[[- X]\\]" end t)) + (not (save-excursion (re-search-forward + ":COOKIE_DATA:.*\\<todo\\>" end t)))) + (org-update-checkbox-count) + (if (and l2 (> l2 l1)) + (progn + (goto-char end) + (org-update-parent-todo-statistics)) + (error "No data for statistics cookie")))) + (goto-char pos) + (move-marker pos nil))))) + (defvar org-entry-property-inherited-from) ;; defined below (defun org-update-parent-todo-statistics () "Update any statistics cookie in the parent of the current headline. @@ -9848,7 +10023,7 @@ of `org-todo-keywords-1'." (kwd-re (cond ((null arg) org-not-done-regexp) ((equal arg '(4)) - (let ((kwd (org-ido-completing-read "Keyword (or KWD1|KWD2|...): " + (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " (mapcar 'list org-todo-keywords-1)))) (concat "\\(" (mapconcat 'identity (org-split-string kwd "|") "\\|") @@ -9913,7 +10088,7 @@ nil." (save-excursion (org-back-to-heading t) (setq beg (point)) - (org-end-of-subtree t t) + (outline-next-heading) (while (re-search-backward re beg t) (replace-match "") (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) @@ -10234,9 +10409,9 @@ a Show deadlines and scheduled items after a date." ((member ans '(?T ?m)) (call-interactively 'org-match-sparse-tree)) ((member ans '(?p ?P)) - (setq kwd (org-ido-completing-read "Property: " + (setq kwd (org-icompleting-read "Property: " (mapcar 'list (org-buffer-property-keys)))) - (setq value (org-ido-completing-read "Value: " + (setq value (org-icompleting-read "Value: " (mapcar 'list (org-property-values kwd)))) (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) @@ -10684,7 +10859,7 @@ also TODO lines." ;; Get a new match request, with completion (let ((org-last-tags-completion-table (org-global-tags-completion-table))) - (setq match (org-completing-read-no-ido + (setq match (org-completing-read-no-i "Match: " 'org-tags-completion-function nil nil nil 'org-tags-history)))) @@ -11021,7 +11196,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (let ((org-add-colon-after-tag-completion t)) (org-trim (org-without-partial-completion - (org-ido-completing-read "Tags: " 'org-tags-completion-function + (org-icompleting-read "Tags: " 'org-tags-completion-function nil nil current 'org-tags-history))))))) (while (string-match "[-+&]+" tags) ;; No boolean logic, just a list @@ -11069,7 +11244,7 @@ This works in the agenda, and also in an org-mode buffer." (if (org-mode-p) (org-get-buffer-tags) (org-global-tags-completion-table)))) - (org-ido-completing-read + (org-icompleting-read "Tag: " 'org-tags-completion-function nil nil nil 'org-tags-history)) (progn @@ -11083,7 +11258,7 @@ This works in the agenda, and also in an org-mode buffer." (goto-char beg) (setq l1 (org-current-line)) (loop for l from l1 to l2 do - (goto-line l) + (org-goto-line l) (setq m (get-text-property (point) 'org-hd-marker)) (when (or (and (org-mode-p) (org-on-heading-p)) (and agendap m)) @@ -11134,7 +11309,7 @@ This works in the agenda, and also in an org-mode buffer." (defun org-fast-tag-show-exit (flag) (save-excursion - (goto-line 3) + (org-goto-line 3) (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) (replace-match "")) (when flag @@ -11225,7 +11400,7 @@ Returns the new tags string, or nil to not change the current settings." (insert "\n") (setq tbl (cdr tbl))))) (t - (setq tg (car e) c2 nil) + (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) (setq c (cdr e)) ;; automatically assign a character. @@ -11288,7 +11463,7 @@ Returns the new tags string, or nil to not change the current settings." (if exit-after-next (setq exit-after-next 'now))) ((= c ?\t) (condition-case nil - (setq tg (org-ido-completing-read + (setq tg (org-icompleting-read "Tag: " (or buffer-tags (with-current-buffer buf @@ -11541,6 +11716,35 @@ Being in this list makes sure that they are offered for completion.") (call-interactively 'org-compute-property-at-point)) (t (error "No such property action %c" c))))) +(defun org-set-effort (&optional value) + "Set the effort property of the current entry. +With numerical prefix arg, use the nth allowed value, 0 stands for the 10th +allowed value." + (interactive "P") + (if (equal value 0) (setq value 10)) + (let* ((completion-ignore-case t) + (prop org-effort-property) + (cur (org-entry-get nil prop)) + (allowed (org-property-get-allowed-values nil prop 'table)) + (existing (mapcar 'list (org-property-values prop))) + (val (cond + ((stringp value) value) + ((and allowed (integerp value)) + (or (car (nth (1- value) allowed)) + (car (org-last allowed)))) + (allowed + (org-completing-read "Value: " allowed nil 'req-match)) + (t + (let (org-completion-use-ido org-completion-use-iswitchb) + (org-completing-read + (concat "Value " (if (and cur (string-match "\\S-" cur)) + (concat "[" cur "]") "") + ": ") + existing nil nil "" nil cur)))))) + (unless (equal (org-entry-get nil prop) val) + (org-entry-put nil prop val)) + (message "%s is now %s" prop val))) + (defun org-at-property-p () "Is the cursor in a property line?" ;; FIXME: Does not check if we are actually in the drawer. @@ -11958,7 +12162,7 @@ in the current file." (interactive (let* ((completion-ignore-case t) (keys (org-buffer-property-keys nil t t)) - (prop0 (org-ido-completing-read "Property: " (mapcar 'list keys))) + (prop0 (org-icompleting-read "Property: " (mapcar 'list keys))) (prop (if (member prop0 keys) prop0 (or (cdr (assoc (downcase prop0) @@ -11970,9 +12174,9 @@ in the current file." (existing (mapcar 'list (org-property-values prop))) (val (if allowed (org-completing-read "Value: " allowed nil 'req-match) - (let (org-completion-use-ido) + (let (org-completion-use-ido org-completion-use-iswitchb) (org-completing-read - (concat "Value" (if (and cur (string-match "\\S-" cur)) + (concat "Value " (if (and cur (string-match "\\S-" cur)) (concat "[" cur "]") "") ": ") existing nil nil "" nil cur))))) @@ -11984,7 +12188,7 @@ in the current file." "In the current entry, delete PROPERTY." (interactive (let* ((completion-ignore-case t) - (prop (org-ido-completing-read + (prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property @@ -11996,7 +12200,7 @@ in the current file." "Remove PROPERTY globally, from all entries." (interactive (let* ((completion-ignore-case t) - (prop (org-ido-completing-read + (prop (org-icompleting-read "Globally remove property: " (mapcar 'list (org-buffer-property-keys))))) (list prop))) @@ -12595,7 +12799,7 @@ Also, store the cursor date in variable org-ans2." (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) - (select-frame-set-input-focus sf))) + (org-select-frame-set-input-focus sf))) (defun org-calendar-select () "Return to `org-read-date' with the date currently selected. @@ -12826,8 +13030,8 @@ days in order to avoid rounding problems." (match-end (match-end 0)) (time1 (org-time-string-to-time ts1)) (time2 (org-time-string-to-time ts2)) - (t1 (time-to-seconds time1)) - (t2 (time-to-seconds time2)) + (t1 (org-float-time time1)) + (t2 (org-float-time time2)) (diff (abs (- t2 t1))) (negative (< (- t2 t1) 0)) ;; (ys (floor (* 365 24 60 60))) @@ -12883,7 +13087,7 @@ days in order to avoid rounding problems." (defun org-time-string-to-time (s) (apply 'encode-time (org-parse-time-string s))) (defun org-time-string-to-seconds (s) - (time-to-seconds (org-time-string-to-time s))) + (org-float-time (org-time-string-to-time s))) (defun org-time-string-to-absolute (s &optional daynr prefer show-all) "Convert a time stamp to an absolute day number. @@ -13071,7 +13275,7 @@ hour and minute fields will be nil if not given." (string-to-number (match-string 3 s)) (string-to-number (match-string 2 s)) nil nil nil) - (make-list 9 0))) + (error "Not a standard Org-mode time string: %s" s))) (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. @@ -13372,32 +13576,7 @@ changes from another. I believe the procedure must be like this: ;;;###autoload (defun org-iswitchb (&optional arg) - "Use `iswitchb-read-buffer' to prompt for an Org buffer to switch to. -With a prefix argument, restrict available to files. -With two prefix arguments, restrict available buffers to agenda files. - -Due to some yet unresolved reason, the global function -`iswitchb-mode' needs to be active for this function to work." - (interactive "P") - (require 'iswitchb) - (let ((enabled iswitchb-mode) blist) - (or enabled (iswitchb-mode 1)) - (setq blist (cond ((equal arg '(4)) (org-buffer-list 'files)) - ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list)))) - (unwind-protect - (let ((iswitchb-make-buflist-hook - (lambda () - (setq iswitchb-temp-buflist - (mapcar 'buffer-name blist))))) - (switch-to-buffer - (iswitchb-read-buffer - "Switch-to: " nil t)) - (or enabled (iswitchb-mode -1)))))) - -;;;###autoload -(defun org-ido-switchb (&optional arg) - "Use `org-ido-completing-read' to prompt for an Org buffer to switch to. + "Use `org-icompleting-read' to prompt for an Org buffer to switch to. With a prefix argument, restrict available to files. With two prefix arguments, restrict available buffers to agenda files." (interactive "P") @@ -13405,10 +13584,13 @@ With two prefix arguments, restrict available buffers to agenda files." ((equal arg '(16)) (org-buffer-list 'agenda)) (t (org-buffer-list))))) (switch-to-buffer - (org-ido-completing-read "Org buffer: " + (org-icompleting-read "Org buffer: " (mapcar 'list (mapcar 'buffer-name blist)) nil t)))) +;;;###autoload +(defalias 'org-ido-switchb 'org-iswitchb) + (defun org-buffer-list (&optional predicate exclude-tmp) "Return a list of Org buffers. PREDICATE can be `export', `files' or `agenda'. @@ -13508,7 +13690,8 @@ the buffer and restores the previous window configuration." (while (setq b (find-buffer-visiting f)) (kill-buffer b)) (with-temp-file f (insert (mapconcat 'identity list "\n") "\n"))) - (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) + (let ((org-mode-hook nil) (org-inhibit-startup t) + (org-insert-mode-line-in-empty-file nil)) (setq org-agenda-files list) (customize-save-variable 'org-agenda-files org-agenda-files)))) @@ -13856,8 +14039,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." ("$1" "\\([^$]\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 t) - ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t)) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) "Regular expressions for matching embedded LaTeX.") (defun org-format-latex (prefix &optional dir overlays msg at forbuffer) @@ -13887,7 +14070,11 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (while (re-search-forward re nil t) (when (and (or (not at) (equal (cdr at) (match-beginning n))) (not (get-text-property (match-beginning n) - 'org-protected))) + 'org-protected)) + (or (not overlays) + (not (eq (get-char-property (match-beginning n) + 'org-overlay-type) + 'org-latex-overlay)))) (setq txt (match-string n) beg (match-beginning n) end (match-end n) cnt (1+ cnt) @@ -13911,7 +14098,13 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." txt movefile opt forbuffer) (if overlays (progn + (mapc (lambda (o) + (if (eq (org-overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (org-delete-overlay o))) + (org-overlays-in beg end)) (setq ov (org-make-overlay beg end)) + (org-overlay-put ov 'org-overlay-type 'org-latex-overlay) (if (featurep 'xemacs) (progn (org-overlay-put ov 'invisible t) @@ -13926,8 +14119,10 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (delete-region beg end) (insert link)))))))) +(defvar org-export-latex-packages-alist) ;; defined in org-latex.el ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image (string tofile options buffer) + (require 'org-latex) (let* ((tmpdir (if (featurep 'xemacs) (temp-directory) temporary-file-directory)) @@ -13949,6 +14144,15 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (if (eq bg 'default) (setq bg (org-dvipng-color :background))) (with-temp-file texfile (insert org-format-latex-header + (if org-export-latex-packages-alist + (concat "\n" + (mapconcat (lambda(p) + (if (equal "" (car p)) + (format "\\usepackage{%s}" (cadr p)) + (format "\\usepackage[%s]{%s}" + (car p) (cadr p)))) + org-export-latex-packages-alist "\n")) + "") "\n\\begin{document}\n" string "\n\\end{document}\n")) (let ((dir default-directory)) (condition-case nil @@ -14117,7 +14321,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (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-c#" 'org-update-statistics-cookies) (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) @@ -14155,6 +14359,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) +(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) @@ -14384,8 +14589,8 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-shiftselect-error () "Throw an error because Shift-Cursor command was applied in wrong context." (if (and (boundp 'shift-select-mode) shift-select-mode) - (error "To use shift-selection with Org-mode, customize `org-support-shift-select'.") - (error "This command works only in special context like headlines or timestamps."))) + (error "To use shift-selection with Org-mode, customize `org-support-shift-select'") + (error "This command works only in special context like headlines or timestamps"))) (defun org-call-for-shift-select (cmd) (let ((this-command-keys-shift-translated t)) @@ -14726,6 +14931,8 @@ This command does many different things, depending on context: - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, this is what we do. +- If the cursor is on a statistics cookie, update it. + - If the cursor is in a headline, prompt for tags and insert them into the current line, aligned to `org-tags-column'. When called with prefix arg, realign all tags in the current buffer. @@ -14777,6 +14984,9 @@ This command does many different things, depending on context: ((org-at-property-p) (call-interactively 'org-property-action)) ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) + ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]") + (or (org-on-heading-p) (org-at-item-p))) + (call-interactively 'org-update-statistics-cookies)) ((org-on-heading-p) (call-interactively 'org-set-tags)) ((org-at-table.el-p) (require 'table) @@ -14819,7 +15029,7 @@ This command does many different things, depending on context: (let ((org-inhibit-startup t)) (org-mode-restart)) (message "Local setup has been refreshed")))) ((org-clock-update-time-maybe)) - (t (error "C-c C-c can do nothing useful at this location."))))) + (t (error "C-c C-c can do nothing useful at this location"))))) (defun org-mode-restart () "Restart Org-mode, to scan again for special lines. @@ -15259,6 +15469,7 @@ See the individual commands for more information." "--" ["Expand This Menu" org-create-customize-menu (fboundp 'customize-menu-create)]) + ["Send bug report" org-submit-bug-report t] "--" ("Refresh/Reload" ["Refresh setup current buffer" org-mode-restart t] @@ -15272,6 +15483,62 @@ With optional NODE, go directly to that node." (interactive) (info (format "(org)%s" (or node "")))) +;;;###autoload +(defun org-submit-bug-report () + "Submit a bug report on Org-mode via mail. + +Don't hesitate to report any problems or inaccurate documentation. + +If you don't have setup sending mail from (X)Emacs, please copy the +output buffer into your mail program, as it gives us important +information about your Org-mode version and configuration." + (interactive) + (require 'reporter) + (org-load-modules-maybe) + (org-require-autoloaded-modules) + (let ((reporter-prompt-for-summary-p "Bug report subject: ")) + (reporter-submit-bug-report + "emacs-orgmode@gnu.org" + (org-version) + (let (list) + (save-window-excursion + (switch-to-buffer (get-buffer-create "*Warn about privacy*")) + (delete-other-windows) + (erase-buffer) + (insert "You are about to submit a bug report to the Org-mode mailing list. + +We would like to add your full Org-mode and Outline configuration to the +bug report. This greatly simplifies the work of the maintainer and +other experts on the mailing list. + +HOWEVER, some variables you have customized may contain private +information. The names of customers, colleagues, or friends, might +appear in the form of file names, tags, todo states, or search strings. +If you answer yes to the prompt, you might want to check and remove +such private information before sending the email.") + (add-text-properties (point-min) (point-max) '(face org-warning)) + (when (yes-or-no-p "Include your Org-mode configuration ") + (mapatoms + (lambda (v) + (and (boundp v) + (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v)) + (or (and (symbol-value v) + (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v))) + (and + (get v 'custom-type) (get v 'standard-value) + (not (equal (symbol-value v) (eval (car (get v 'standard-value))))))) + (push v list))))) + (kill-buffer (get-buffer "*Warn about privacy*")) + list)) + nil nil + "Remember to cover the basics, that is, what you expected to happen and +what in fact did happen. You don't know how to make a good report? See + + http://orgmode.org/manual/Feedback.html#Feedback + +Your bug report will be posted to the Org-mode mailing list. +------------------------------------------------------------------------"))) + (defun org-install-agenda-files-menu () (let ((bl (buffer-list))) (save-excursion @@ -15390,6 +15657,10 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (display-buffer buf) (sit-for 0)))) +(defun org-in-commented-line () + "Is point in a line starting with `#'?" + (equal (char-after (point-at-bol)) ?#)) + (defun org-goto-marker-or-bmk (marker &optional bookmark) "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." (if (and marker (marker-buffer marker) @@ -16542,6 +16813,20 @@ This is like outline-next-sibling, but invisible headings are ok." nil (point)))) +(defun org-get-last-sibling () + "Move to previous heading of the same level, and return point. +If there is no such heading, return nil." + (let ((opoint (point)) + (level (funcall outline-level))) + (outline-previous-heading) + (when (and (/= (point) opoint) (outline-on-heading-p t)) + (while (and (> (funcall outline-level) level) + (not (bobp))) + (outline-previous-heading)) + (if (< (funcall outline-level) level) + nil + (point))))) + (defun org-end-of-subtree (&optional invisible-OK to-heading) ;; This contains an exact copy of the original function, but it uses ;; `org-back-to-heading', to make it work also in invisible @@ -16627,7 +16912,7 @@ Stop at the first and last subheadings of a superior heading." (outline-flag-region (point) (save-excursion - (outline-end-of-subtree) (outline-next-heading) (point)) + (org-end-of-subtree t t)) nil)) (defun org-show-entry () @@ -16852,14 +17137,14 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." Still experimental, may disappear in the future." (interactive) ;; Get the time interval from the user. - (let* ((time1 (time-to-seconds + (let* ((time1 (org-float-time (org-read-date nil 'to-time nil "Starting date: "))) - (time2 (time-to-seconds + (time2 (org-float-time (org-read-date nil 'to-time nil "End date:"))) ;; callback function (callback (lambda () (let ((time - (time-to-seconds + (org-float-time (apply 'encode-time (org-parse-time-string (match-string 1)))))) diff --git a/lisp/outline.el b/lisp/outline.el index 250f2e16335..703e818f3a5 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -380,6 +380,7 @@ See the command `outline-mode' for more information on this mode." "*Function of no args to compute a header's nesting level in an outline. It can assume point is at the beginning of a header line and that the match data reflects the `outline-regexp'.") +;;;###autoload(put 'outline-level 'risky-local-variable t) (defvar outline-heading-alist () "Alist associating a heading for every possible level. diff --git a/lisp/paren.el b/lisp/paren.el index 9648471d373..d5607c23f65 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -1,7 +1,7 @@ ;;; paren.el --- highlight matching paren -;; Copyright (C) 1993, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: rms@gnu.org ;; Maintainer: FSF @@ -87,16 +87,15 @@ otherwise)." :background "gray")) "Show Paren mode face used for a matching paren." :group 'paren-showing-faces) -;; backward-compatibility alias -(put 'show-paren-match-face 'face-alias 'show-paren-match) +(define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1") (defface show-paren-mismatch '((((class color)) (:foreground "white" :background "purple")) (t (:inverse-video t))) "Show Paren mode face used for a mismatching paren." :group 'paren-showing-faces) -;; backward-compatibility alias -(put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch) +(define-obsolete-face-alias 'show-paren-mismatch-face + 'show-paren-mismatch "22.1") (defvar show-paren-highlight-openparen t "*Non-nil turns on openparen highlighting when matching forward.") diff --git a/lisp/paths.el b/lisp/paths.el index 10881e5dbc9..401a981cd87 100644 --- a/lisp/paths.el +++ b/lisp/paths.el @@ -32,11 +32,12 @@ ;;; Code: ;; Docstrings in this file should, where reasonable, follow the -;; conventions described in bindings.el, so that they get put in the +;; conventions described in make-docfile, so that they get put in the ;; DOC file rather than in memory. (defun prune-directory-list (dirs &optional keep reject) - "Return a copy of DIRS with all non-existent directories removed. + "\ +Return a copy of DIRS with all non-existent directories removed. The optional argument KEEP is a list of directories to retain even if they don't exist, and REJECT is a list of directories to remove from DIRS, even if they exist; REJECT takes precedence over KEEP. @@ -121,8 +122,8 @@ the environment variable INFOPATH is set.") The name of the host running an NNTP server. The null string means use the local host as the server site.") -(defvar gnus-nntp-service "nntp" - "NNTP service name, usually \"nntp\" or 119. +(defvar gnus-nntp-service "nntp" "\ +NNTP service name, usually \"nntp\" or 119. Go to a local news spool if its value is nil, in which case `gnus-nntp-server' should be set to `(system-name)'.") @@ -130,8 +131,8 @@ should be set to `(system-name)'.") *The name of your organization, as a string. The `ORGANIZATION' environment variable is used instead if defined.") -(defcustom rmail-file-name "~/RMAIL" - "Name of user's primary mail file." +(defcustom rmail-file-name "~/RMAIL" "\ +Name of user's primary mail file." :type 'string :group 'rmail :version "21.1") @@ -181,9 +182,5 @@ If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\")) You may set this variable to nil in your `.emacs' file if you do not wish the terminal-initialization file to be loaded.") -(defvar abbrev-file-name - (convert-standard-filename "~/.abbrev_defs") - "*Default name of file to read abbrevs from.") - ;; arch-tag: bae27ffb-9944-4c87-b569-30d4635a99e1 ;;; paths.el ends here diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el index fa7f3f6cdc3..d1c60a6a96a 100644 --- a/lisp/pcvs-info.el +++ b/lisp/pcvs-info.el @@ -70,8 +70,7 @@ to confuse some users sometimes." (t (:weight bold))) "PCL-CVS face used to highlight directory changes." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-header-face 'face-alias 'cvs-header) +(define-obsolete-face-alias 'cvs-header-face 'cvs-header "22.1") (defface cvs-filename '((((class color) (background dark)) @@ -81,8 +80,7 @@ to confuse some users sometimes." (t ())) "PCL-CVS face used to highlight file names." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-filename-face 'face-alias 'cvs-filename) +(define-obsolete-face-alias 'cvs-filename-face 'cvs-filename "22.1") (defface cvs-unknown '((((class color) (background dark)) @@ -92,8 +90,7 @@ to confuse some users sometimes." (t (:slant italic))) "PCL-CVS face used to highlight unknown file status." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-unknown-face 'face-alias 'cvs-unknown) +(define-obsolete-face-alias 'cvs-unknown-face 'cvs-unknown "22.1") (defface cvs-handled '((((class color) (background dark)) @@ -103,8 +100,7 @@ to confuse some users sometimes." (t ())) "PCL-CVS face used to highlight handled file status." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-handled-face 'face-alias 'cvs-handled) +(define-obsolete-face-alias 'cvs-handled-face 'cvs-handled "22.1") (defface cvs-need-action '((((class color) (background dark)) @@ -114,8 +110,7 @@ to confuse some users sometimes." (t (:slant italic))) "PCL-CVS face used to highlight status of files needing action." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-need-action-face 'face-alias 'cvs-need-action) +(define-obsolete-face-alias 'cvs-need-action-face 'cvs-need-action "22.1") (defface cvs-marked '((((min-colors 88) (class color) (background dark)) @@ -127,15 +122,13 @@ to confuse some users sometimes." (t (:weight bold))) "PCL-CVS face used to highlight marked file indicator." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-marked-face 'face-alias 'cvs-marked) +(define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1") (defface cvs-msg '((t (:slant italic))) "PCL-CVS face used to highlight CVS messages." :group 'pcl-cvs) -;; backward-compatibility alias -(put 'cvs-msg-face 'face-alias 'cvs-msg) +(define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1") (defvar cvs-fi-up-to-date-face 'cvs-handled) (defvar cvs-fi-unknown-face 'cvs-unknown) diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 5d786a6538a..e40caae6b14 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el @@ -135,7 +135,7 @@ If NOREUSE is non-nil, always return a new buffer." (when (equal name list-buffers-directory) (return buf))))) (with-current-buffer (create-file-buffer name) - (set (make-local-variable 'list-buffers-directory) name) + (setq list-buffers-directory name) (current-buffer)))) ;;;; diff --git a/lisp/pcvs.el b/lisp/pcvs.el index dc01c45ad3f..448360665b5 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -399,7 +399,7 @@ from the current buffer." ;;(cvs-minor-mode 1) (let ((lbd list-buffers-directory)) (if (fboundp mode) (funcall mode) (fundamental-mode)) - (when lbd (set (make-local-variable 'list-buffers-directory) lbd))) + (when lbd (setq list-buffers-directory lbd))) (cvs-minor-mode 1) ;;(set (make-local-variable 'cvs-buffer) cvs-buf) (if normal @@ -1456,7 +1456,7 @@ The POSTPROC specified there (typically `log-edit') is then called, (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup)) (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist))) 'log-edit))) - (funcall setupfun 'cvs-do-commit setup + (funcall setupfun 'cvs-do-commit setup '((log-edit-listfun . cvs-commit-filelist) (log-edit-diff-function . cvs-mode-diff)) buf) (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap) @@ -1521,7 +1521,7 @@ This is best called from a `log-view-mode' buffer." ;; Set the filename before, so log-edit can correctly setup its ;; log-edit-initial-files variable. (set (make-local-variable 'cvs-edit-log-files) (list file))) - (funcall setupfun 'cvs-do-edit-log nil + (funcall setupfun 'cvs-do-edit-log nil '((log-edit-listfun . cvs-edit-log-filelist) (log-edit-diff-function . cvs-mode-diff)) buf) @@ -2054,7 +2054,10 @@ With a prefix, opens the buffer in an OTHER window." (t (if view 'view-buffer 'switch-to-buffer))) buf) (when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base)) - (goto-line (cvs-find-modif fi))) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- (cvs-find-modif fi))))) buf)))))) diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el index 26c7fccd78d..19d9a0ba240 100644 --- a/lisp/pgg-pgp.el +++ b/lisp/pgg-pgp.el @@ -1,7 +1,7 @@ ;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. -;; Copyright (C) 1999, 2000, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Created: 1999/11/02 @@ -145,7 +145,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (mapconcat 'shell-quote-argument (append recipients (if pgg-encrypt-for-me - (list pgg-pgp-user-id))))) + (list pgg-pgp-user-id))) " ")) (if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id)))))) (pgg-pgp-process-region start end nil pgg-pgp-program args) (pgg-process-when-success nil))) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index f04bc94b113..73edc965460 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -1,7 +1,7 @@ ;;; 5x5.el --- simple little puzzle game -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Dave Pearson <davep@davep.org> ;; Maintainer: Dave Pearson <davep@davep.org> @@ -59,32 +59,32 @@ :prefix "5x5-") (defcustom 5x5-grid-size 5 - "*Size of the playing area." + "Size of the playing area." :type 'integer :group '5x5) (defcustom 5x5-x-scale 4 - "*X scaling factor for drawing the grid." + "X scaling factor for drawing the grid." :type 'integer :group '5x5) (defcustom 5x5-y-scale 3 - "*Y scaling factor for drawing the grid." + "Y scaling factor for drawing the grid." :type 'integer :group '5x5) (defcustom 5x5-animate-delay .01 - "*Delay in seconds when animating a solution crack." + "Delay in seconds when animating a solution crack." :type 'number :group '5x5) (defcustom 5x5-hassle-me t - "*Should 5x5 ask you when you want to do a destructive operation?" + "Should 5x5 ask you when you want to do a destructive operation?" :type 'boolean :group '5x5) (defcustom 5x5-mode-hook nil - "*Hook run on starting 5x5." + "Hook run on starting 5x5." :type 'hook :group '5x5) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index e8a666a577d..1a538eb8db2 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -82,7 +82,7 @@ (defconst bubbles-version "0.5" "Version number of bubbles.el.") (require 'gamegrid) -(require 'cl) +(eval-when-compile (require 'cl)) ; for 'case ;; User options diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index e3dcef93a91..d32e1aad413 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -1,7 +1,7 @@ ;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers ;; -;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; ;; Author: Christopher J. Madsen <chris_madsen@geocities.com> ;; Keywords: games @@ -98,7 +98,7 @@ :group 'games) (defcustom decipher-force-uppercase t - "*Non-nil means to convert ciphertext to uppercase. + "Non-nil means to convert ciphertext to uppercase. nil means the case of the ciphertext is preserved. This variable must be set before typing `\\[decipher]'." :type 'boolean @@ -106,7 +106,7 @@ This variable must be set before typing `\\[decipher]'." (defcustom decipher-ignore-spaces nil - "*Non-nil means to ignore spaces and punctuation when counting digrams. + "Non-nil means to ignore spaces and punctuation when counting digrams. You should set this to nil if the cipher message is divided into words, or t if it is not. This variable is buffer-local." diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 18ab694b683..5dd63f0bb56 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -586,7 +586,8 @@ FILE is created there." (t "")))) (sort-fields 1 (point-min) (point-max)) (reverse-region (point-min) (point-max)) - (goto-line (1+ gamegrid-score-file-length)) + (goto-char (point-min)) + (forward-line gamegrid-score-file-length) (delete-region (point) (point-max)) (setq buffer-read-only t) (save-buffer))) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 4c4836747bc..fedaaf5b929 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -1,7 +1,7 @@ ;;; gametree.el --- manage game analysis trees in Emacs -;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Ian T Zimmerman <itz@rahul.net> ;; Created: Wed Dec 10 07:41:46 PST 1997 @@ -92,7 +92,7 @@ :version "20.3") (defcustom gametree-half-ply-regexp (regexp-quote ":") - "*Matches ends of numbers of moves by the \"second\" player. + "Matches ends of numbers of moves by the \"second\" player. For instance, it is an almost universal convention in chess to postfix numbers of moves by Black (if considered in isolation) by the ellipsis \"...\". This is NOT a good choice for this program, though, because it @@ -103,20 +103,20 @@ LaTeX macros he uses for typesetting annotated games." :group 'gametree) (defcustom gametree-full-ply-regexp (regexp-quote ".") - "*Matches ends of numbers of moves by the \"first\" player. + "Matches ends of numbers of moves by the \"first\" player. For instance, it is an almost universal convention in chess to postfix numbers of moves by White (if considered in isolation) by the dot \".\"." :type 'regexp :group 'gametree) (defcustom gametree-half-ply-format "%d:" - "*Output format for move numbers of moves by the \"second\" player. + "Output format for move numbers of moves by the \"second\" player. Has to contain \"%d\" to output the actual number." :type 'string :group 'gametree) (defcustom gametree-full-ply-format "%d." - "*Output format for move numbers of moves by the \"first\" player. + "Output format for move numbers of moves by the \"first\" player. Has to contain \"%d\" to output the actual number." :type 'string :group 'gametree) @@ -138,17 +138,17 @@ the file is visited (subject to the usual restriction via `enable-local-variables'), and the layout will be set accordingly.") (defcustom gametree-score-opener "{score=" - "*The string which opens a score tag, and precedes the actual score." + "The string which opens a score tag, and precedes the actual score." :type 'string :group 'gametree) (defcustom gametree-score-manual-flag "!" - "*String marking the line as manually (as opposed to automatically) scored." + "String marking the line as manually (as opposed to automatically) scored." :type 'string :group 'gametree) (defcustom gametree-score-closer "}" - "*The string which closes a score tag, and follows the actual score." + "The string which closes a score tag, and follows the actual score." :type 'string :group 'gametree) @@ -160,7 +160,7 @@ the file is visited (subject to the usual restriction via "[ ]*\\)?\\([-+]?[0-9]+\\)" (regexp-quote gametree-score-closer) "[ ]*\\)[\n\^M]") - "*Regular expression matching lines that guide the program in scoring. + "Regular expression matching lines that guide the program in scoring. Its third parenthetical group should match the actual score. Its first parenthetical group should match the entire score tag. Its second parenthetical group should be an optional flag that marks the @@ -172,7 +172,7 @@ score instead." :group 'gametree) (defcustom gametree-default-score 0 - "*Score to assume for branches lacking score tags." + "Score to assume for branches lacking score tags." :type 'integer :group 'gametree) diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 5021cf94211..b9461851136 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -1,7 +1,7 @@ ;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- coding: iso-latin-1; -*- -;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>) ;; Created: October 21 1996 @@ -88,43 +88,43 @@ ;; User definable variables (defcustom handwrite-numlines 60 - "*The number of lines on a page of the PostScript output from `handwrite'." + "The number of lines on a page of the PostScript output from `handwrite'." :type 'integer :group 'handwrite) (defcustom handwrite-fontsize 11 - "*The size of the font for the PostScript output from `handwrite'." + "The size of the font for the PostScript output from `handwrite'." :type 'integer :group 'handwrite) (defcustom handwrite-linespace 12 - "*The spacing for the PostScript output from `handwrite'." + "The spacing for the PostScript output from `handwrite'." :type 'integer :group 'handwrite) (defcustom handwrite-xstart 30 - "*X-axis translation in the PostScript output from `handwrite'." + "X-axis translation in the PostScript output from `handwrite'." :type 'integer :group 'handwrite) (defcustom handwrite-ystart 810 - "*Y-axis translation in the PostScript output from `handwrite'." + "Y-axis translation in the PostScript output from `handwrite'." :type 'integer :group 'handwrite) (defcustom handwrite-pagenumbering nil - "*If non-nil, number each page of the PostScript output from `handwrite'." + "If non-nil, number each page of the PostScript output from `handwrite'." :type 'boolean :group 'handwrite) (defcustom handwrite-10pt-numlines 65 - "*The number of lines on a page for the function `handwrite-10pt'." + "The number of lines on a page for the function `handwrite-10pt'." :type 'integer :group 'handwrite) (defcustom handwrite-11pt-numlines 60 - "*The number of lines on a page for the function `handwrite-11pt'." + "The number of lines on a page for the function `handwrite-11pt'." :type 'integer :group 'handwrite) (defcustom handwrite-12pt-numlines 55 - "*The number of lines on a page for the function `handwrite-12pt'." + "The number of lines on a page for the function `handwrite-12pt'." :type 'integer :group 'handwrite) (defcustom handwrite-13pt-numlines 50 - "*The number of lines on a page for the function `handwrite-13pt'." + "The number of lines on a page for the function `handwrite-13pt'." :type 'integer :group 'handwrite) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 51afa4602ae..5185b810918 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -6,7 +6,7 @@ ; Author (a) 1985, Damon Anton Permezel ; This is in the public domain -; since he distributed it without copyright notice in 1985. +; since he distributed it in 1985 without copyright notice. ;; This file is part of GNU Emacs. ; ; Support for horizontal poles, large numbers of rings, real-time, @@ -71,33 +71,33 @@ :group 'games) (defcustom hanoi-horizontal-flag nil - "*If non-nil, hanoi poles are oriented horizontally." + "If non-nil, hanoi poles are oriented horizontally." :group 'hanoi :type 'boolean) (defcustom hanoi-move-period 1.0 - "*Time, in seconds, for each pole-to-pole move of a ring. + "Time, in seconds, for each pole-to-pole move of a ring. If nil, move rings as fast as possible while displaying all intermediate positions." :group 'hanoi :type '(restricted-sexp :match-alternatives (numberp 'nil))) (defcustom hanoi-use-faces nil - "*If nil, all hanoi-*-face variables are ignored." + "If nil, all hanoi-*-face variables are ignored." :group 'hanoi :type 'boolean) (defcustom hanoi-pole-face 'highlight - "*Face for poles. Ignored if hanoi-use-faces is nil." + "Face for poles. Ignored if hanoi-use-faces is nil." :group 'hanoi :type 'face) (defcustom hanoi-base-face 'highlight - "*Face for base. Ignored if hanoi-use-faces is nil." + "Face for base. Ignored if hanoi-use-faces is nil." :group 'hanoi :type 'face) (defcustom hanoi-even-ring-face 'region - "*Face for even-numbered rings. Ignored if hanoi-use-faces is nil." + "Face for even-numbered rings. Ignored if hanoi-use-faces is nil." :group 'hanoi :type 'face) (defcustom hanoi-odd-ring-face 'secondary-selection - "*Face for odd-numbered rings. Ignored if hanoi-use-faces is nil." + "Face for odd-numbered rings. Ignored if hanoi-use-faces is nil." :group 'hanoi :type 'face) diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index 95840d81900..5e8df5d4a6b 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -1,11 +1,11 @@ ;;; landmark.el --- neural-network robot that learns landmarks -;; Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>) ;; Created: December 16, 1996 - first release to usenet -;; Keywords: gomoku, neural network, adaptive search, chemotaxis +;; Keywords: games, gomoku, neural network, adaptive search, chemotaxis ;;;_* Usage ;;; Just type @@ -211,13 +211,13 @@ (defface lm-font-lock-face-O '((((class color)) :foreground "red") (t :weight bold)) - "*Face to use for Emacs' O." + "Face to use for Emacs' O." :version "22.1" :group 'lm) (defface lm-font-lock-face-X '((((class color)) :foreground "green") (t :weight bold)) - "*Face to use for your X." + "Face to use for your X." :version "22.1" :group 'lm) diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index 7e8222d7e1d..2b1d1e4d8b5 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -39,7 +39,7 @@ (random t) ; randomize (defcustom mpuz-silent 'error - "*Set this to nil if you want dings on inputs. + "Set this to nil if you want dings on inputs. t means never ding, and `error' means only ding on wrong input." :type '(choice (const :tag "No" nil) (const :tag "Yes" t) @@ -47,36 +47,36 @@ t means never ding, and `error' means only ding on wrong input." :group 'mpuz) (defcustom mpuz-solve-when-trivial t - "*Solve any row that can be trivially calculated from what you've found." + "Solve any row that can be trivially calculated from what you've found." :type 'boolean :group 'mpuz) (defcustom mpuz-allow-double-multiplicator nil - "*Allow 2nd factors like 33 or 77." + "Allow 2nd factors like 33 or 77." :type 'boolean :group 'mpuz) (defface mpuz-unsolved '((((class color)) (:foreground "red1" :bold t)) (t (:bold t))) - "*Face to use for letters to be solved." + "Face to use for letters to be solved." :group 'mpuz) (defface mpuz-solved '((((class color)) (:foreground "green1" :bold t)) (t (:bold t))) - "*Face to use for solved digits." + "Face to use for solved digits." :group 'mpuz) (defface mpuz-trivial '((((class color)) (:foreground "blue" :bold t)) (t (:bold t))) - "*Face to use for trivial digits solved for you." + "Face to use for trivial digits solved for you." :group 'mpuz) (defface mpuz-text '((t (:inherit variable-pitch))) - "*Face to use for text on right." + "Face to use for text on right." :group 'mpuz) diff --git a/lisp/play/pong.el b/lisp/play/pong.el index 8835ff9c959..2ada2a08518 100644 --- a/lisp/play/pong.el +++ b/lisp/play/pong.el @@ -1,7 +1,7 @@ ;;; pong.el --- classical implementation of pong -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Benjamin Drieu <bdrieu@april.org> ;; Keywords: games @@ -39,67 +39,67 @@ :group 'games) (defcustom pong-buffer-name "*Pong*" - "*Name of the buffer used to play." + "Name of the buffer used to play." :group 'pong :type '(string)) (defcustom pong-width 50 - "*Width of the playfield." + "Width of the playfield." :group 'pong :type '(integer)) (defcustom pong-height (min 30 (- (frame-height) 6)) - "*Height of the playfield." + "Height of the playfield." :group 'pong :type '(integer)) (defcustom pong-bat-width 3 - "*Width of the bats for pong." + "Width of the bats for pong." :group 'pong :type '(integer)) (defcustom pong-blank-color "black" - "*Color used for background." + "Color used for background." :group 'pong :type 'color) (defcustom pong-bat-color "yellow" - "*Color used for bats." + "Color used for bats." :group 'pong :type 'color) (defcustom pong-ball-color "red" - "*Color used for the ball." + "Color used for the ball." :group 'pong :type 'color) (defcustom pong-border-color "white" - "*Color used for pong borders." + "Color used for pong borders." :group 'pong :type 'color) (defcustom pong-left-key "4" - "*Alternate key to press for bat 1 to go up (primary one is [left])." + "Alternate key to press for bat 1 to go up (primary one is [left])." :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-right-key "6" - "*Alternate key to press for bat 1 to go down (primary one is [right])." + "Alternate key to press for bat 1 to go down (primary one is [right])." :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-up-key "8" - "*Alternate key to press for bat 2 to go up (primary one is [up])." + "Alternate key to press for bat 2 to go up (primary one is [up])." :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-down-key "2" - "*Alternate key to press for bat 2 to go down (primary one is [down])." + "Alternate key to press for bat 2 to go down (primary one is [down])." :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-quit-key "q" - "*Key to press to quit pong." + "Key to press to quit pong." :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) @@ -109,12 +109,12 @@ :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-resume-key "p" - "*Key to press to resume pong." + "Key to press to resume pong." :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-timer-delay 0.1 - "*Time to wait between every cycle." + "Time to wait between every cycle." :group 'pong :type 'number) diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index 72c5bdaef18..6ea63e4f231 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -1,7 +1,7 @@ ;;; solitaire.el --- game of solitaire in Emacs Lisp -;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Jan Schormann <Jan.Schormann@rechen-gilde.de> ;; Created: Fri afternoon, Jun 3, 1994 @@ -118,7 +118,7 @@ The usual mnemonic keys move the cursor around the board; in addition, (defvar solitaire-end-y nil) (defcustom solitaire-auto-eval t - "*Non-nil means check for possible moves after each major change. + "Non-nil means check for possible moves after each major change. This takes a while, so switch this on if you like to be informed when the game is over, or off, if you are working on a slow machine." :type 'boolean diff --git a/lisp/play/studly.el b/lisp/play/studly.el index e8854fecf73..b9bd173d5f1 100644 --- a/lisp/play/studly.el +++ b/lisp/play/studly.el @@ -1,7 +1,7 @@ ;;; studly.el --- StudlyCaps (tm)(r)(c)(xxx) ;;; This is in the public domain, since it was distributed -;;; by its author without a copyright notice in 1986. +;;; by its author in 1986 without a copyright notice. ;; This file is part of GNU Emacs. diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index eeaff089cf8..7e16de28672 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -1,7 +1,7 @@ ;;; tetris.el --- implementation of Tetris for Emacs -;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Glynn Clements <glynn@sensei.co.uk> ;; Version: 2.01 @@ -40,22 +40,22 @@ :group 'games) (defcustom tetris-use-glyphs t - "*Non-nil means use glyphs when available." + "Non-nil means use glyphs when available." :group 'tetris :type 'boolean) (defcustom tetris-use-color t - "*Non-nil means use color when available." + "Non-nil means use color when available." :group 'tetris :type 'boolean) (defcustom tetris-draw-border-with-glyphs t - "*Non-nil means draw a border even when using glyphs." + "Non-nil means draw a border even when using glyphs." :group 'tetris :type 'boolean) (defcustom tetris-default-tick-period 0.3 - "*The default time taken for a shape to drop one row." + "The default time taken for a shape to drop one row." :group 'tetris :type 'number) diff --git a/lisp/proced.el b/lisp/proced.el index f529ac72c2c..cd9255cfdee 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -64,22 +64,23 @@ the external command (usually \"kill\")." (defcustom proced-signal-list '( ;; signals supported on all POSIX compliant systems - ("HUP (1. Hangup)") - ("INT (2. Terminal interrupt)") - ("QUIT (3. Terminal quit)") - ("ABRT (6. Process abort)") - ("KILL (9. Kill - cannot be caught or ignored)") - ("ALRM (14. Alarm Clock)") - ("TERM (15. Termination)") + ("HUP" . " (1. Hangup)") + ("INT" . " (2. Terminal interrupt)") + ("QUIT" . " (3. Terminal quit)") + ("ABRT" . " (6. Process abort)") + ("KILL" . " (9. Kill - cannot be caught or ignored)") + ("ALRM" . " (14. Alarm Clock)") + ("TERM" . " (15. Termination)") ;; POSIX 1003.1-2001 ;; Which systems do not support these signals so that we can ;; exclude them from `proced-signal-list'? - ("CONT (Continue executing)") - ("STOP (Stop executing / pause - cannot be caught or ignored)") - ("TSTP (Terminal stop / pause)")) + ("CONT" . " (Continue executing)") + ("STOP" . " (Stop executing / pause - cannot be caught or ignored)") + ("TSTP" . " (Terminal stop / pause)")) "List of signals, used for minibuffer completion." :group 'proced - :type '(repeat (string :tag "signal"))) + :type '(repeat (cons (string :tag "signal name") + (string :tag "description")))) ;; For which attributes can we use a fixed width of the output field? ;; A fixed width speeds up formatting, yet it can make @@ -96,45 +97,45 @@ the external command (usually \"kill\")." (defcustom proced-grammar-alist '( ;; attributes defined in `process-attributes' (euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil)) - (user "USER" nil left proced-string-lessp nil (user pid) (nil t nil)) + (user "User" nil left proced-string-lessp nil (user pid) (nil t nil)) (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) - (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil)) - (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil)) - (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil)) + (group "Group" nil left proced-string-lessp nil (group user pid) (nil t nil)) + (comm "Command" nil left proced-string-lessp nil (comm pid) (nil t nil)) + (state "Stat" nil left proced-string-lessp nil (state pid) (nil t nil)) (ppid "PPID" "%d" right proced-< nil (ppid pid) ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) "refine to process parents")) - (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) - (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil)) + (pgrp "PGrp" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) + (sess "Sess" "%d" right proced-< nil (sess pid) (nil t nil)) (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) (tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil)) - (minflt "MINFLT" "%d" right proced-< nil (minflt pid) (nil t t)) - (majflt "MAJFLT" "%d" right proced-< nil (majflt pid) (nil t t)) - (cminflt "CMINFLT" "%d" right proced-< nil (cminflt pid) (nil t t)) - (cmajflt "CMAJFLT" "%d" right proced-< nil (cmajflt pid) (nil t t)) - (utime "UTIME" proced-format-time right proced-time-lessp t (utime pid) (nil t t)) - (stime "STIME" proced-format-time right proced-time-lessp t (stime pid) (nil t t)) - (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) - (cutime "CUTIME" proced-format-time right proced-time-lessp t (cutime pid) (nil t t)) - (cstime "CSTIME" proced-format-time right proced-time-lessp t (cstime pid) (nil t t)) - (ctime "CTIME" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) - (pri "PR" "%d" right proced-< t (pri pid) (nil t t)) - (nice "NI" "%3d" 3 proced-< t (nice pid) (t t nil)) - (thcount "THCOUNT" "%d" right proced-< t (thcount pid) (nil t t)) - (start "START" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) - (vsize "VSIZE" "%d" right proced-< t (vsize pid) (nil t t)) + (minflt "MinFlt" "%d" right proced-< nil (minflt pid) (nil t t)) + (majflt "MajFlt" "%d" right proced-< nil (majflt pid) (nil t t)) + (cminflt "CMinFlt" "%d" right proced-< nil (cminflt pid) (nil t t)) + (cmajflt "CMajFlt" "%d" right proced-< nil (cmajflt pid) (nil t t)) + (utime "UTime" proced-format-time right proced-time-lessp t (utime pid) (nil t t)) + (stime "STime" proced-format-time right proced-time-lessp t (stime pid) (nil t t)) + (time "Time" proced-format-time right proced-time-lessp t (time pid) (nil t t)) + (cutime "CUTime" proced-format-time right proced-time-lessp t (cutime pid) (nil t t)) + (cstime "CSTime" proced-format-time right proced-time-lessp t (cstime pid) (nil t t)) + (ctime "CTime" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) + (pri "Pr" "%d" right proced-< t (pri pid) (nil t t)) + (nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil)) + (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t)) + (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) + (vsize "VSize" "%d" right proced-< t (vsize pid) (nil t t)) (rss "RSS" "%d" right proced-< t (rss pid) (nil t t)) - (etime "ETIME" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) + (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) (pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t)) - (pmem "%MEM" "%.1f" right proced-< t (pmem pid) (nil t t)) - (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) + (pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t)) + (args "Args" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) ;; ;; attributes defined by proced (see `proced-process-attributes') (pid "PID" "%d" right proced-< nil (pid) ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) "refine to process children")) ;; process tree - (tree "TREE" proced-format-tree left nil nil nil nil)) + (tree "Tree" proced-format-tree left nil nil nil nil)) "Alist of rules for handling Proced attributes. Each element has the form @@ -460,6 +461,7 @@ Important: the match ends just after the marker.") ;; marking (define-key km "d" 'proced-mark) ; Dired compatibility ("delete") (define-key km "m" 'proced-mark) + (put 'proced-mark :advertised-binding "m") (define-key km "u" 'proced-unmark) (define-key km "\177" 'proced-unmark-backward) (define-key km "M" 'proced-mark-all) @@ -608,7 +610,7 @@ Return nil if point is not on a process line." ;; proced mode (define-derived-mode proced-mode special-mode "Proced" - "Mode for displaying UNIX system processes and sending signals to them. + "Mode for displaying system processes and sending signals to them. Type \\[proced] to start a Proced session. In a Proced buffer type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands. Type \\[proced-send-signal] to send signals to marked processes. @@ -1709,16 +1711,19 @@ After sending the signal, this command runs the normal hook (line-end-position)))))) (unless signal ;; Display marked processes (code taken from `dired-mark-pop-up'). - (let ((bufname " *Marked Processes*") + (let ((bufname "*Marked Processes*") (header-line (substring-no-properties proced-header-line))) (with-current-buffer (get-buffer-create bufname) (setq truncate-lines t proced-header-line header-line ; inherit header line header-line-format '(:eval (proced-header-line))) (add-hook 'post-command-hook 'force-mode-line-update nil t) - (erase-buffer) - (dolist (process process-alist) - (insert " " (cdr process) "\n")) + (let ((inhibit-read-only t)) + (erase-buffer) + (buffer-disable-undo) + (setq buffer-read-only t) + (dolist (process process-alist) + (insert " " (cdr process) "\n"))) (save-window-excursion ;; Analogous to `dired-pop-to-buffer' ;; Don't split window horizontally. (Bug#1806) @@ -1729,15 +1734,13 @@ After sending the signal, this command runs the normal hook (pnum (if (= 1 (length process-alist)) "1 process" (format "%d processes" (length process-alist)))) - ;; The following is an ugly hack. Is there a better way - ;; to help people like me to remember the signals and - ;; their meanings? - (tmp (completing-read (concat "Send signal [" pnum - "] (default TERM): ") - proced-signal-list - nil nil nil nil "TERM"))) - (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp) - (match-string 1 tmp) tmp))))))) + (completion-annotate-function + (lambda (s) (cdr (assoc s proced-signal-list))))) + (setq signal + (completing-read (concat "Send signal [" pnum + "] (default TERM): ") + proced-signal-list + nil nil nil nil "TERM"))))))) ;; send signal (let ((count 0) failures) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index c28926dbb3d..89cbdd18454 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1,7 +1,7 @@ ;;; ada-mode.el --- major-mode for editing Ada sources ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Rolf Ebert <ebert@inf.enst.fr> ;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> @@ -229,6 +229,8 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or (const ada-no-auto-case)) :group 'ada) +;; FIXME If this is not something required by the ada language, this +;; should be removed. (defcustom ada-clean-buffer-before-saving t "*Non-nil means remove trailing spaces and untabify the buffer before saving." :type 'boolean :group 'ada) @@ -793,8 +795,9 @@ the 4 file locations can be clicked on and jumped to." (compilation-find-file (point-marker) (match-string 1) "./") (set-buffer file) - (if (stringp line) - (goto-line (string-to-number line))) + (when (stringp line) + (goto-char (point-min)) + (forward-line (1- (string-to-number line)))) (setq source (point-marker))) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 82df4be3dfd..4bb53a85f47 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1,7 +1,7 @@ ;; ada-xref.el --- for lookup and completion in Ada mode ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> ;; Rolf Ebert <ebert@inf.enst.fr> @@ -1901,7 +1901,8 @@ This function is disabled for operators, and only works for identifiers." (ada-name-of identlist))) ;; one => should be the right one ((= len 1) - (goto-line (caar declist))) + (goto-char (point-min)) + (forward-line (1- (caar declist)))) ;; more than one => display choice list (t @@ -1937,7 +1938,8 @@ This function is disabled for operators, and only works for identifiers." (read-from-minibuffer "Enter No. of your choice: ")))) ) (set-buffer ali-buffer) - (goto-line (car (nth (1- choice) declist))) + (goto-char (point-min)) + (forward-line (1- (car (nth (1- choice) declist)))) )))))) @@ -2166,7 +2168,8 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." ;; move the cursor to the correct position (push-mark) - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) (move-to-column column) ;; If we are not on the identifier, the ali file was not up-to-date. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 375afe8ca2b..521e8a17aeb 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -835,6 +835,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-default-face 'face-alias 'antlr-default) +(put 'antlr-font-lock-default-face 'obsolete-face "22.1") (defvar antlr-keyword-face 'antlr-keyword) (defface antlr-keyword @@ -846,6 +847,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword) +(put 'antlr-font-lock-keyword-face 'obsolete-face "22.1") (defvar antlr-syntax-face 'antlr-keyword) (defface antlr-syntax @@ -857,6 +859,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax) +(put 'antlr-font-lock-syntax-face 'obsolete-face "22.1") (defvar antlr-ruledef-face 'antlr-ruledef) (defface antlr-ruledef @@ -868,6 +871,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef) +(put 'antlr-font-lock-ruledef-face 'obsolete-face "22.1") (defvar antlr-tokendef-face 'antlr-tokendef) (defface antlr-tokendef @@ -879,6 +883,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef) +(put 'antlr-font-lock-tokendef-face 'obsolete-face "22.1") (defvar antlr-ruleref-face 'antlr-ruleref) (defface antlr-ruleref @@ -888,6 +893,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref) +(put 'antlr-font-lock-ruleref-face 'obsolete-face "22.1") (defvar antlr-tokenref-face 'antlr-tokenref) (defface antlr-tokenref @@ -897,6 +903,7 @@ Do not change." :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref) +(put 'antlr-font-lock-tokenref-face 'obsolete-face "22.1") (defvar antlr-literal-face 'antlr-literal) (defface antlr-literal @@ -910,6 +917,7 @@ It is used to highlight strings matched by the first regexp group of :group 'antlr) ;; backward-compatibility alias (put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal) +(put 'antlr-font-lock-literal-face 'obsolete-face "22.1") (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" "Regexp matching literals with special syntax highlighting, or nil. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index cb88f344cc0..bd41e1c7c87 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -322,7 +322,7 @@ after special characters such as brace, comma, semi-colon, and colon." (c-keep-region-active)) (defalias 'c-toggle-auto-state 'c-toggle-auto-newline) -(make-obsolete 'c-toggle-auto-state 'c-toggle-auto-newline) +(make-obsolete 'c-toggle-auto-state 'c-toggle-auto-newline "22.1") (defun c-toggle-hungry-state (&optional arg) "Toggle hungry-delete-key feature. @@ -1330,14 +1330,14 @@ keyword on the line, the keyword is not inserted inside a literal, and (interactive "p") (require 'cc-subword) (c-forward-subword arg)) -(make-obsolete 'c-forward-into-nomenclature 'c-forward-subword) +(make-obsolete 'c-forward-into-nomenclature 'c-forward-subword "22.1") (defun c-backward-into-nomenclature (&optional arg) "Compatibility alias for `c-backward-subword'." (interactive "p") (require 'cc-subword) (c-backward-subword arg)) -(make-obsolete 'c-backward-into-nomenclature 'c-backward-subword) +(make-obsolete 'c-backward-into-nomenclature 'c-backward-subword "22.1") (defun c-scope-operator () "Insert a double colon scope operator at point. @@ -2808,7 +2808,9 @@ move forward to the end of the containing preprocessor conditional. function stops at them when going backward, but not when going forward." (interactive "p") - (c-forward-conditional (- count) -1) + (let ((new-point (c-scan-conditionals (- count) -1))) + (push-mark) + (goto-char new-point)) (c-keep-region-active)) (defun c-up-conditional-with-else (count) @@ -2816,7 +2818,9 @@ forward." Just like `c-up-conditional', except it also stops at \"#else\" directives." (interactive "p") - (c-forward-conditional (- count) -1 t) + (let ((new-point (c-scan-conditionals (- count) -1 t))) + (push-mark) + (goto-char new-point)) (c-keep-region-active)) (defun c-down-conditional (count) @@ -2828,7 +2832,9 @@ move backward into the previous preprocessor conditional. function stops at them when going forward, but not when going backward." (interactive "p") - (c-forward-conditional count 1) + (let ((new-point (c-scan-conditionals count 1))) + (push-mark) + (goto-char new-point)) (c-keep-region-active)) (defun c-down-conditional-with-else (count) @@ -2836,15 +2842,24 @@ backward." Just like `c-down-conditional', except it also stops at \"#else\" directives." (interactive "p") - (c-forward-conditional count 1 t) + (let ((new-point (c-scan-conditionals count 1 t))) + (push-mark) + (goto-char new-point)) (c-keep-region-active)) (defun c-backward-conditional (count &optional target-depth with-else) "Move back across a preprocessor conditional, leaving mark behind. A prefix argument acts as a repeat count. With a negative argument, -move forward across a preprocessor conditional." +move forward across a preprocessor conditional. + +The optional arguments TARGET-DEPTH and WITH-ELSE are historical, +and have the same meanings as in `c-scan-conditionals'. If you +are calling c-forward-conditional from a program, you might want +to call `c-scan-conditionals' directly instead." (interactive "p") - (c-forward-conditional (- count) target-depth with-else) + (let ((new-point (c-scan-conditionals (- count) target-depth with-else))) + (push-mark) + (goto-char new-point)) (c-keep-region-active)) (defun c-forward-conditional (count &optional target-depth with-else) @@ -2852,21 +2867,42 @@ move forward across a preprocessor conditional." A prefix argument acts as a repeat count. With a negative argument, move backward across a preprocessor conditional. +If there aren't enough conditionals after \(or before) point, an +error is signalled. + +\"#elif\" is treated like \"#else\" followed by \"#if\", except that +the nesting level isn't changed when tracking subconditionals. + +The optional arguments TARGET-DEPTH and WITH-ELSE are historical, +and have the same meanings as in `c-scan-conditionals'. If you +are calling c-forward-conditional from a program, you might want +to call `c-scan-conditionals' directly instead." + (interactive "p") + (let ((new-point (c-scan-conditionals count target-depth with-else))) + (push-mark) + (goto-char new-point))) + +(defun c-scan-conditionals (count &optional target-depth with-else) + "Scan forward across COUNT preprocessor conditionals. +With a negative argument, scan backward across preprocessor +conditionals. Return the end position. Point is not moved. + +If there aren't enough preprocessor conditionals, throw an error. + \"#elif\" is treated like \"#else\" followed by \"#if\", except that the nesting level isn't changed when tracking subconditionals. The optional argument TARGET-DEPTH specifies the wanted nesting depth -after each scan. I.e. if TARGET-DEPTH is -1, the function will move -out of the enclosing conditional. A non-integer non-nil TARGET-DEPTH +after each scan. E.g. if TARGET-DEPTH is -1, the end position will be +outside the enclosing conditional. A non-integer non-nil TARGET-DEPTH counts as -1. If the optional argument WITH-ELSE is non-nil, \"#else\" directives are treated as conditional clause limits. Normally they are ignored." - (interactive "p") (let* ((forward (> count 0)) (increment (if forward -1 1)) (search-function (if forward 're-search-forward 're-search-backward)) - (new)) + new) (unless (integerp target-depth) (setq target-depth (if target-depth -1 0))) (save-excursion @@ -2935,9 +2971,8 @@ are treated as conditional clause limits. Normally they are ignored." (error "No containing preprocessor conditional")) (goto-char (setq new found))) (setq count (+ count increment)))) - (push-mark) - (goto-char new)) - (c-keep-region-active)) + (c-keep-region-active) + new)) ;; commands to indent lines, regions, defuns, and expressions @@ -4431,7 +4466,7 @@ If a fill prefix is specified, it overrides all the above." (indent-to col)))))) (defalias 'c-comment-line-break-function 'c-indent-new-comment-line) -(make-obsolete 'c-comment-line-break-function 'c-indent-new-comment-line) +(make-obsolete 'c-comment-line-break-function 'c-indent-new-comment-line "21.1") ;; advice for indent-new-comment-line for older Emacsen (unless (boundp 'comment-line-break-function) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b2a36220a7f..0b631d47d77 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1067,8 +1067,9 @@ comment at the start of cc-engine.el for more info." (not (eq ret 'beginning)) (looking-at c-case-kwds-regexp)) (if (< after-case:-pos start) - (setq pos after-case:-pos) - (setq ret 'label))) + (setq pos after-case:-pos)) + (if (eq ret 'same) + (setq ret 'label))) ;; Skip over the unary operators that can start the statement. (while (progn @@ -7103,7 +7104,7 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. (c-at-statement-start-p)) -(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p) +(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") (defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) ;; Return non-nil if we're looking at the beginning of a block diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 9c19e791c3e..0e0eca228bc 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2885,7 +2885,7 @@ tested at the beginning of every sexp in a suspected label, i.e. before \":\". Only used if `c-recognize-colon-labels' is set." t (concat ;; Don't allow string literals. - "[\"']\\|" + "\"\\|" ;; All keywords except `c-label-kwds' and `c-protection-kwds'. (c-make-keywords-re t (set-difference (c-lang-const c-keywords) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index a1f7d3ad3f2..153b7356686 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -451,7 +451,7 @@ comment-only lines." :group 'c) (make-obsolete-variable 'c-comment-continuation-stars - 'c-block-comment-prefix) + 'c-block-comment-prefix "21.1") ;; Although c-comment-continuation-stars is obsolete, we look at it in ;; some places in CC Mode anyway, so make the compiler ignore it diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 722a31eae80..42f7a0e95da 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5693,7 +5693,7 @@ indentation and initial hashes. Behaves usually outside of comment." (setq t-font-lock-keywords (list - (list "[ \t]+$" 0 cperl-invalid-face t) + `("[ \t]+$" 0 ',cperl-invalid-face t) (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" @@ -6874,6 +6874,19 @@ by CPerl." ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t)))) +;; Copied from imenu-example--name-and-position. +(defvar imenu-use-markers) + +(defun cperl-imenu-name-and-position () + "Return the current/previous sexp and its (beginning) location. +Does not move point." + (save-excursion + (forward-sexp -1) + (let ((beg (if imenu-use-markers (point-marker) (point))) + (end (progn (forward-sexp) (point)))) + (cons (buffer-substring beg end) + beg)))) + (defun cperl-xsub-scan () (require 'imenu) (let ((index-alist '()) @@ -6896,7 +6909,7 @@ by CPerl." ((not package) nil) ; C language section ((match-beginning 3) ; XSUB (goto-char (1+ (match-beginning 3))) - (setq index (imenu-example--name-and-position)) + (setq index (cperl-imenu-name-and-position)) (setq name (buffer-substring (match-beginning 3) (match-end 3))) (if (and prefix (string-match (concat "^" prefix) name)) (setq name (substring name (length prefix)))) @@ -6908,7 +6921,7 @@ by CPerl." (push index index-alist)) (t ; BOOT: section ;; (beginning-of-line) - (setq index (imenu-example--name-and-position)) + (setq index (cperl-imenu-name-and-position)) (setcar index (concat package "::BOOT:")) (push index index-alist))))) index-alist)) @@ -8758,7 +8771,8 @@ start with default arguments, then refine the slowdown regions." (let ((tt (current-time))) (+ (* 1000 (nth 1 tt)) (/ (nth 2 tt) 1000)))))) (tt (funcall timems)) (c 0) delta tot) - (goto-line l) + (goto-char (point-min)) + (forward-line (1- l)) (cperl-mode) (setq tot (- (- tt (setq tt (funcall timems))))) (message "cperl-mode at %s: %s" l tot) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 4c721fc622e..c5a38607b38 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -1652,14 +1652,23 @@ before the indent, the point is moved to the indent." (defun delphi-tab () - "Indent the current line or insert a TAB, depending on the value of -`delphi-tab-always-indents' and the current line position." + "Indent the region, when Transient Mark mode is enabled and the region is +active. Otherwise, indent the current line or insert a TAB, depending on the +value of `delphi-tab-always-indents' and the current line position." (interactive) - (if (or delphi-tab-always-indents ; We are always indenting - ;; Or we are before the first non-space character on the line. - (save-excursion (skip-chars-backward delphi-space-chars) (bolp))) - (delphi-indent-line) - (insert "\t"))) + (cond ((use-region-p) + ;; If Transient Mark mode is enabled and the region is active, indent + ;; the entire region. + (indent-region (region-beginning) (region-end))) + ((or delphi-tab-always-indents + (save-excursion (skip-chars-backward delphi-space-chars) (bolp))) + ;; Otherwise, if we are configured always to indent (regardless of the + ;; point's position in the line) or we are before the first non-space + ;; character on the line, indent the line. + (delphi-indent-line)) + (t + ;; Otherwise, insert a tab character. + (insert "\t")))) (defun delphi-is-directory (path) @@ -1935,7 +1944,8 @@ This is ok since we do our own keyword/comment/string face coloring.") ;;;###autoload (defun delphi-mode (&optional skip-initial-parsing) "Major mode for editing Delphi code. \\<delphi-mode-map> -\\[delphi-tab]\t- Indents the current line for Delphi code. +\\[delphi-tab]\t- Indents the current line (or region, if Transient Mark mode +\t is enabled and the region is active) of Delphi code. \\[delphi-find-unit]\t- Search for a Delphi source file. \\[delphi-fill-comment]\t- Fill the current comment. \\[delphi-new-comment-line]\t- If in a // comment, do a new comment line. diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 7e53ec8a5f6..41a77151c1a 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1,7 +1,7 @@ ;;; ebrowse.el --- Emacs C++ class browser & tags facility ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ;; Free Software Foundation Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> @@ -162,8 +162,7 @@ This space is used to display markers." (t (:foreground "red"))) "*The face used for the mark character in the tree." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-tree-mark-face 'face-alias 'ebrowse-tree-mark) +(define-obsolete-face-alias 'ebrowse-tree-mark-face 'ebrowse-tree-mark "22.1") (defface ebrowse-root-class @@ -171,24 +170,21 @@ This space is used to display markers." (t (:weight bold :foreground "blue"))) "*The face used for root classes in the tree." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-root-class-face 'face-alias 'ebrowse-root-class) +(define-obsolete-face-alias 'ebrowse-root-class-face 'ebrowse-root-class "22.1") (defface ebrowse-file-name '((t (:italic t))) "*The face for filenames displayed in the tree." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-file-name-face 'face-alias 'ebrowse-file-name) +(define-obsolete-face-alias 'ebrowse-file-name-face 'ebrowse-file-name "22.1") (defface ebrowse-default '((t nil)) "*Face for everything else in the tree not having other faces." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-default-face 'face-alias 'ebrowse-default) +(define-obsolete-face-alias 'ebrowse-default-face 'ebrowse-default "22.1") (defface ebrowse-member-attribute @@ -196,16 +192,16 @@ This space is used to display markers." (t (:foreground "red"))) "*Face used to display member attributes." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-member-attribute-face 'face-alias 'ebrowse-member-attribute) +(define-obsolete-face-alias 'ebrowse-member-attribute-face + 'ebrowse-member-attribute "22.1") (defface ebrowse-member-class '((t (:foreground "purple"))) "*Face used to display the class title in member buffers." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-member-class-face 'face-alias 'ebrowse-member-class) +(define-obsolete-face-alias 'ebrowse-member-class-face + 'ebrowse-member-class "22.1") (defface ebrowse-progress @@ -213,8 +209,7 @@ This space is used to display markers." (t (:background "blue"))) "*Face for progress indicator." :group 'ebrowse-faces) -;; backward-compatibility alias -(put 'ebrowse-progress-face 'face-alias 'ebrowse-progress) +(define-obsolete-face-alias 'ebrowse-progress-face 'ebrowse-progress "22.1") @@ -1337,7 +1332,8 @@ With PREFIX, insert that many filenames." (setf ebrowse--show-file-names-flag (not ebrowse--show-file-names-flag)) (let ((old-line (count-lines (point-min) (point)))) (ebrowse-redraw-tree) - (goto-line old-line))) + (goto-char (point-min)) + (forward-line (1- old-line)))) @@ -4316,7 +4312,8 @@ NUMBER-OF-STATIC-VARIABLES:" (interactive) (let* ((maxlin (count-lines (point-min) (point-max))) (n (min maxlin (+ 2 (string-to-number (this-command-keys)))))) - (goto-line n) + (goto-char (point-min)) + (forward-line (1- n)) (throw 'electric-buffer-menu-select (point)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index f3ffa1c2d91..7a557e95974 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1,8 +1,8 @@ ;;; etags.el --- etags facility for Emacs ;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -;; Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Maintainer: FSF @@ -1331,7 +1331,8 @@ hits the start of file." offset found pat) (if (eq (car tag-info) t) ;; Direct file tag. - (cond (line (goto-line line)) + (cond (line (progn (goto-char (point-min)) + (forward-line (1- line)))) (startpos (goto-char startpos)) (t (error "etags.el BUG: bogus direct file tag"))) ;; This constant is 1/2 the initial search window. @@ -1349,7 +1350,8 @@ hits the start of file." ;; If no char pos was given, try the given line number. (or startpos (if line - (setq startpos (progn (goto-line line) + (setq startpos (progn (goto-char (point-min)) + (forward-line (1- line)) (point))))) (or startpos (setq startpos (point-min))) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 0b011af9eb5..58a82a8918b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -182,63 +182,63 @@ (defcustom f90-do-indent 3 "Extra indentation applied to DO blocks." :type 'integer + :safe 'integerp :group 'f90-indent) -(put 'f90-do-indent 'safe-local-variable 'integerp) (defcustom f90-if-indent 3 "Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks." :type 'integer + :safe 'integerp :group 'f90-indent) -(put 'f90-if-indent 'safe-local-variable 'integerp) (defcustom f90-type-indent 3 "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks." :type 'integer + :safe 'integerp :group 'f90-indent) -(put 'f90-type-indent 'safe-local-variable 'integerp) (defcustom f90-program-indent 2 "Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks." :type 'integer + :safe 'integerp :group 'f90-indent) -(put 'f90-program-indent 'safe-local-variable 'integerp) (defcustom f90-associate-indent 2 "Extra indentation applied to ASSOCIATE blocks." :type 'integer + :safe 'integerp :group 'f90-indent :version "23.1") -(put 'f90-associate-indent 'safe-local-variable 'integerp) (defcustom f90-continuation-indent 5 "Extra indentation applied to continuation lines." :type 'integer + :safe 'integerp :group 'f90-indent) -(put 'f90-continuation-indent 'safe-local-variable 'integerp) (defcustom f90-comment-region "!!$" "String inserted by \\[f90-comment-region] at start of each line in region." :type 'string + :safe 'stringp :group 'f90-indent) -(put 'f90-comment-region 'safe-local-variable 'stringp) (defcustom f90-indented-comment-re "!" "Regexp matching comments to indent as code." :type 'regexp + :safe 'stringp :group 'f90-indent) -(put 'f90-indented-comment-re 'safe-local-variable 'stringp) (defcustom f90-directive-comment-re "!hpf\\$" "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." :type 'regexp + :safe 'stringp :group 'f90-indent) -(put 'f90-directive-comment-re 'safe-local-variable 'stringp) (defcustom f90-beginning-ampersand t "Non-nil gives automatic insertion of \& at start of continuation line." :type 'boolean + :safe 'booleanp :group 'f90) -(put 'f90-beginning-ampersand 'safe-local-variable 'booleanp) (defcustom f90-smart-end 'blink "Qualification of END statements according to the matching block start. @@ -248,9 +248,8 @@ values are 'blink, 'no-blink, and nil. If nil, nothing is done. The other two settings have the same effect, but 'blink additionally blinks the cursor to the start of the block." :type '(choice (const blink) (const no-blink) (const nil)) + :safe (lambda (value) (memq value '(blink no-blink nil))) :group 'f90) -(put 'f90-smart-end 'safe-local-variable - (lambda (value) (memq value '(blink no-blink nil)))) (defcustom f90-break-delimiters "[-+\\*/><=,% \t]" "Regexp matching delimiter characters at which lines may be broken. @@ -258,39 +257,38 @@ There are some common two-character tokens where one or more of the members matches this regexp. Although Fortran allows breaks within lexical tokens (provided the next line has a beginning ampersand), the constant `f90-no-break-re' ensures that such tokens are not split." - :type 'regexp + :type 'regexp + :safe 'stringp :group 'f90) -(put 'f90-break-delimiters 'safe-local-variable 'stringp) (defcustom f90-break-before-delimiters t "Non-nil causes `f90-do-auto-fill' to break lines before delimiters." - :type 'boolean + :type 'boolean + :safe 'booleanp :group 'f90) -(put 'f90-break-before-delimiters 'safe-local-variable 'booleanp) (defcustom f90-auto-keyword-case nil "Automatic case conversion of keywords. The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." :type '(choice (const downcase-word) (const upcase-word) (const capitalize-word) (const nil)) + :safe (lambda (value) (memq value '(downcase-word + capitalize-word upcase-word nil))) :group 'f90) -(put 'f90-auto-keyword-case 'safe-local-variable - (lambda (value) (memq value '(downcase-word - capitalize-word upcase-word nil)))) (defcustom f90-leave-line-no nil "If non-nil, line numbers are not left justified." :type 'boolean + :safe 'booleanp :group 'f90) -(put 'f90-leave-line-no 'safe-local-variable 'booleanp) (defcustom f90-mode-hook nil "Hook run when entering F90 mode." :type 'hook + ;; Not the only safe options, but some common ones. + :safe (lambda (value) (member value '((f90-add-imenu-menu) nil))) :options '(f90-add-imenu-menu) :group 'f90) -(put 'f90-mode-hook 'safe-local-variable - (lambda (value) (member value '((f90-add-imenu-menu) nil)))) ;; User options end here. @@ -1358,9 +1356,8 @@ Does not check type and subprogram indentation." (let ((epnt (line-end-position)) icol cont) (save-excursion (while (and (f90-previous-statement) - (or (progn - (setq cont (f90-present-statement-cont)) - (or (eq cont 'end) (eq cont 'middle))) + (or (memq (setq cont (f90-present-statement-cont)) + '(middle end)) (looking-at "[ \t]*[0-9]")))) (setq icol (current-indentation)) (beginning-of-line) @@ -1779,7 +1776,7 @@ If run in the middle of a line, the line is not broken." (zerop (forward-line 1))) (< (point) end-region-mark))) (setq cont (f90-present-statement-cont)) - (while (and (or (eq cont 'middle) (eq cont 'end)) + (while (and (memq cont '(middle end)) (f90-previous-statement)) (setq cont (f90-present-statement-cont))) ;; Process present line for beginning of block. @@ -1907,6 +1904,8 @@ is non-nil, call `f90-update-line' after inserting the continuation marker." (t (insert "&") (or no-update (f90-update-line)) (newline 1) + ;; FIXME also need leading ampersand if split lexical token (eg ==). + ;; Or respect f90-no-break-re. (if f90-beginning-ampersand (insert "&")))) (indent-according-to-mode)) @@ -2104,7 +2103,7 @@ Any other key combination is executed normally." (setq event (read-event) char event)) ;; Insert char if not equal to `?', or if abbrev-mode is off. - (if (and abbrev-mode (or (eq char ??) (eq char help-char))) + (if (and abbrev-mode (memq char (list ?? help-char))) (f90-abbrev-help) (setq unread-command-events (list event))))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 549bf4abe63..69eac565892 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -805,7 +805,8 @@ Return t if it has at least one flymake overlay, nil if no overlay." (defun flymake-highlight-line (line-no line-err-info-list) "Highlight line LINE-NO in current buffer. Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." - (goto-line line-no) + (goto-char (point-min)) + (forward-line (1- line-no)) (let* ((line-beg (flymake-line-beginning-position)) (line-end (flymake-line-end-position)) (beg line-beg) @@ -1269,7 +1270,8 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (if (not (file-exists-p file)) (flymake-log 1 "File %s does not exist" file) (find-file file) - (goto-line line))) + (goto-char (point-min)) + (forward-line (1- line)))) ;; flymake minor mode declarations (defvar flymake-mode-line nil) @@ -1443,7 +1445,8 @@ With arg, turn Flymake mode on if and only if arg is positive." (defun flymake-goto-line (line-no) "Go to line LINE-NO, then skip whitespace." - (goto-line line-no) + (goto-char (point-min)) + (forward-line (1- line-no)) (flymake-skip-whitespace)) (defun flymake-goto-next-error () diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index d729462731c..71913d0eca0 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,8 +1,8 @@ ;;; fortran.el --- Fortran mode for GNU Emacs ;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -;; Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Michael D. Prange <prange@erl.mit.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> @@ -83,8 +83,8 @@ A non-nil value specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked with a character in column 6." :type 'boolean + :safe 'booleanp :group 'fortran-indent) -(put 'fortran-tab-mode-default 'safe-local-variable 'booleanp) ;; TODO add more detail of what tab mode is to doc string. (defcustom fortran-tab-mode-string @@ -99,32 +99,32 @@ with a character in column 6." "String to appear in mode line in TAB format buffers. See Info node `(emacs)ForIndent Cont'." :type 'string + :risky t :group 'fortran-indent) -(put 'fortran-tab-mode-string 'risky-local-variable t) (defcustom fortran-do-indent 3 "Extra indentation applied to DO blocks." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-do-indent 'safe-local-variable 'integerp) (defcustom fortran-if-indent 3 "Extra indentation applied to IF, SELECT CASE and WHERE blocks." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-if-indent 'safe-local-variable 'integerp) (defcustom fortran-structure-indent 3 "Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-structure-indent 'safe-local-variable 'integerp) (defcustom fortran-continuation-indent 5 "Extra indentation applied to continuation lines." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-continuation-indent 'safe-local-variable 'integerp) (defcustom fortran-comment-indent-style 'fixed "How to indent comments. @@ -135,16 +135,15 @@ nil forces comment lines not to be touched; `relative' indents to current Fortran indentation plus `fortran-comment-line-extra-indent'." :type '(radio (const :tag "Untouched" nil) (const fixed) (const relative)) + :safe (lambda (value) (memq value '(nil fixed relative))) :group 'fortran-indent) -(put 'fortran-comment-indent 'safe-local-variable - (lambda (value) (memq value '(nil fixed relative)))) (defcustom fortran-comment-line-extra-indent 0 "Amount of extra indentation for text within full-line comments." :type 'integer + :safe 'integerp :group 'fortran-indent :group 'fortran-comment) -(put 'fortran-comment-line-extra-indent 'safe-local-variable 'integerp) (defcustom fortran-comment-line-start "C" "Delimiter inserted to start new full-line comment. @@ -152,8 +151,8 @@ You might want to change this to \"*\", for instance; or \"!\" to allow trailing comments on a line." :version "21.1" :type 'string + :safe 'stringp :group 'fortran-comment) -(put 'fortran-comment-line-start 'safe-local-variable 'stringp) ;; This used to match preprocessor lines too, but that messes up ;; filling and doesn't seem to be necessary. @@ -162,8 +161,8 @@ allow trailing comments on a line." "Regexp to match the start of a full-line comment." :version "21.1" :type 'regexp + :safe 'stringp :group 'fortran-comment) -(put 'fortran-comment-line-start-skip 'safe-local-variable 'stringp) (defcustom fortran-directive-re "^[ \t]*#.*" @@ -172,20 +171,20 @@ The matching text will be fontified with `font-lock-keyword-face'. The matching line will be given zero indentation." :version "22.1" :type 'regexp + :safe 'stringp :group 'fortran-indent) -(put 'fortran-directive-re 'safe-local-variable 'stringp) (defcustom fortran-minimum-statement-indent-fixed 6 "Minimum statement indentation for fixed format continuation style." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-minimum-statement-indent-fixed 'safe-local-variable 'integerp) (defcustom fortran-minimum-statement-indent-tab (max tab-width 6) "Minimum statement indentation for TAB format continuation style." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-minimum-statement-indent-tab 'safe-local-variable 'integerp) ;; Note that this is documented in the v18 manuals as being a string ;; of length one rather than a single character. @@ -194,31 +193,29 @@ The matching line will be given zero indentation." "Single-character string inserted for Fortran comment indentation. Normally a space." :type 'string + :safe (lambda (value) (or (characterp value) + (and (stringp value) (= (length value) 1)))) :group 'fortran-comment) -(put 'fortran-comment-indent-char 'safe-local-variable - (lambda (value) (or (characterp value) - (and (stringp value) - (= (length value) 1))))) (defcustom fortran-line-number-indent 1 "Maximum indentation for Fortran line numbers. 5 means right-justify them within their five-column field." :type 'integer + :safe 'integerp :group 'fortran-indent) -(put 'fortran-line-number-indent 'safe-local-variable 'integerp) (defcustom fortran-check-all-num-for-matching-do nil "Non-nil causes all numbered lines to be treated as possible DO loop ends." :type 'boolean + :safe 'booleanp :group 'fortran) -(put 'fortran-check-all-num-for-matching-do 'safe-local-variable 'booleanp) (defcustom fortran-blink-matching-if nil "Non-nil causes \\[fortran-indent-line] on ENDIF to blink on matching IF. Also, from an ENDDO statement blink on matching DO [WHILE] statement." :type 'boolean + :safe 'booleanp :group 'fortran) -(put 'fortran-blink-matching-if 'safe-local-variable 'booleanp) (defcustom fortran-continuation-string "$" "Single-character string used for Fortran continuation lines. @@ -228,23 +225,21 @@ Also, if \\[fortran-indent-line] finds this at the beginning of a line, it will convert the line into a continuation line of the appropriate style. Normally \"$\"." :type 'string + :safe (lambda (value) (and (stringp value) (= (length value) 1))) :group 'fortran) -(put 'fortran-continuation-string 'safe-local-variable - (lambda (value) (and (stringp value) - (= (length value) 1)))) (defcustom fortran-comment-region "c$$$" "String inserted by \\[fortran-comment-region] at start of each \ line in region." :type 'string + :safe 'stringp :group 'fortran-comment) -(put 'fortran-comment-region 'safe-local-variable 'stringp) (defcustom fortran-electric-line-number t "Non-nil causes line numbers to be moved to the correct column as typed." :type 'boolean + :safe 'booleanp :group 'fortran) -(put 'fortran-electric-line-number 'safe-local-variable 'booleanp) ;; TODO use fortran-line-length, somehow. (defcustom fortran-column-ruler-fixed @@ -256,8 +251,8 @@ line in region." This variable is used in fixed format mode. See the variable `fortran-column-ruler-tab' for TAB format mode." :type 'string + :safe 'stringp :group 'fortran) -(put 'fortran-column-ruler-fixed 'safe-local-variable 'stringp) ;; TODO use fortran-line-length, somehow. (defcustom fortran-column-ruler-tab @@ -269,21 +264,21 @@ See the variable `fortran-column-ruler-tab' for TAB format mode." This variable is used in TAB format mode. See the variable `fortran-column-ruler-fixed' for fixed format mode." :type 'string + :safe 'stringp :group 'fortran) -(put 'fortran-column-ruler-tab 'safe-local-variable 'stringp) (defcustom fortran-analyze-depth 100 "Number of lines to scan to identify fixed or TAB format style." :type 'integer + :safe 'integerp :group 'fortran) -(put 'fortran-analyze-depth 'safe-local-variable 'integerp) (defcustom fortran-break-before-delimiters t "Non-nil causes filling to break lines before delimiters. Delimiters are characters matching the regexp `fortran-break-delimiters-re'." :type 'boolean + :safe 'booleanp :group 'fortran) -(put 'fortran-break-before-delimiters 'safe-local-variable 'booleanp) ;; TODO 0 as no-limit, as per g77. (defcustom fortran-line-length 72 @@ -296,6 +291,7 @@ buffers and the default) or the function buffer). This corresponds to the g77 compiler option `-ffixed-line-length-N'." :type 'integer + :safe 'integerp :initialize 'custom-initialize-default :set (lambda (symbol value) ;; Do all fortran buffers, and the default. @@ -303,7 +299,6 @@ buffer). This corresponds to the g77 compiler option :version "23.1" :group 'fortran) -(put 'fortran-line-length 'safe-local-variable 'integerp) (make-variable-buffer-local 'fortran-line-length) (defcustom fortran-mode-hook nil @@ -330,6 +325,13 @@ characters long.") (defconst fortran-if-start-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(" "Regexp matching the start of an IF statement.") +;; Note fortran-current-defun uses the subgroups. +(defconst fortran-start-prog-re + "^[ \t]*\\(program\\|subroutine\\|function\ +\\|[ \ta-z0-9*()]*[ \t]+function\\|\ +\\(block[ \t]*data\\)\\)" + "Regexp matching the start of a subprogram, from the line start.") + (defconst fortran-end-prog-re1 "end\ \\([ \t]*\\(program\\|subroutine\\|function\\|block[ \t]*data\\)\\>\ @@ -1182,37 +1184,47 @@ Auto-indent does not happen if a numeric ARG is used." (+ fortran-line-length (line-beginning-position))))))) -;; Note that you can't just check backwards for `subroutine' &c in -;; case of un-marked main programs not at the start of the file. +;; This is more complex than first expected because the beginning of a +;; main program may be implicit (ie not marked by a PROGRAM statement). +;; This would be fine (we could just go to bob in the absence of a match), +;; except it need not even be the first subprogram in the file (eg it +;; could follow a subroutine). Hence we have to search for END +;; statements instead. +;; cf fortran-beginning-of-block, f90-beginning-of-subprogram +;; Note that unlike the latter, we don't have to worry about nested +;; subprograms (?). +;; FIXME push-mark? (defun fortran-beginning-of-subprogram () "Move point to the beginning of the current Fortran subprogram." (interactive) - (save-match-data - (let ((case-fold-search t)) - (beginning-of-line -1) - (if (catch 'ok - (while (re-search-backward fortran-end-prog-re nil 'move) - (if (fortran-check-end-prog-re) - (throw 'ok t)))) - (forward-line))))) - + (let ((case-fold-search t)) + ;; If called already at the start of subprogram, go to the previous. + (beginning-of-line (if (bolp) 0 1)) + (save-match-data + (or (looking-at fortran-start-prog-re) + ;; This leaves us at bob if before the first subprogram. + (eq (fortran-previous-statement) 'first-statement) + (if (or (catch 'ok + (while (re-search-backward fortran-end-prog-re nil 'move) + (if (fortran-check-end-prog-re) (throw 'ok t)))) + ;; If the search failed, must be at bob. + ;; First code line is the start of the subprogram. + ;; FIXME use a more rigorous test, cf fortran-next-statement? + ;; Though that needs to handle continuations too. + (not (looking-at "^\\([ \t]*[0-9]\\|[ \t]+[^!#]\\)"))) + (fortran-next-statement)))))) + +;; This is simpler than f-beginning-of-s because the end of a +;; subprogram is never implicit. (defun fortran-end-of-subprogram () "Move point to the end of the current Fortran subprogram." (interactive) - (save-match-data - (let ((case-fold-search t)) - (if (save-excursion ; on END - (beginning-of-line) - (and (looking-at fortran-end-prog-re) - (fortran-check-end-prog-re))) - (forward-line) - (beginning-of-line 2) - (when (catch 'ok - (while (re-search-forward fortran-end-prog-re nil 'move) - (if (fortran-check-end-prog-re) - (throw 'ok t)))) - (goto-char (match-beginning 0)) - (forward-line)))))) + (let ((case-fold-search t)) + (beginning-of-line) + (save-match-data + (while (and (re-search-forward fortran-end-prog-re nil 'move) + (not (fortran-check-end-prog-re)))) + (forward-line)))) (defun fortran-previous-statement () "Move point to beginning of the previous Fortran statement. @@ -2137,19 +2149,16 @@ arg DO-SPACE prevents stripping the whitespace." (replace-match "" nil nil nil 1) (unless do-space (delete-horizontal-space))))) -;; This code used to live in add-log.el, but this is a better place -;; for it. +;; This code used to live in add-log.el, but this is a better place for it. (defun fortran-current-defun () "Function to use for `add-log-current-defun-function' in Fortran mode." (save-excursion ;; We must be inside function body for this to work. (fortran-beginning-of-subprogram) - (let ((case-fold-search t)) ; case-insensitive + (let ((case-fold-search t)) ;; Search for fortran subprogram start. (if (re-search-forward - (concat "^[ \t]*\\(program\\|subroutine\\|function" - "\\|[ \ta-z0-9*()]*[ \t]+function\\|" - "\\(block[ \t]*data\\)\\)") + fortran-start-prog-re (save-excursion (fortran-end-of-subprogram) (point)) t) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 4784eea0942..f547f9a17c5 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -102,9 +102,7 @@ (require 'gud) (require 'json) (require 'bindat) -(require 'speedbar) -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl)) (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) @@ -143,6 +141,8 @@ set to nil. May be manually changed by user with `gdb-select-frame'.") +(defvar gdb-frame-address nil "Identity of frame for watch expression.") + ;; Used to show overlay arrow in source buffer. All set in ;; gdb-get-main-selected-frame. Disassembly buffer should not use ;; these but rely on buffer-local thread information instead. @@ -183,8 +183,9 @@ as returned from \"-break-list\" by `gdb-json-partial-output' (defvar gdb-current-language nil) (defvar gdb-var-list nil "List of variables in watch window. -Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where -STATUS is nil (unchanged), `changed' or `out-of-scope'.") +Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP) +where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame +address for root variables.") (defvar gdb-main-file nil "Source file from which program execution begins.") ;; Overlay arrow markers @@ -215,6 +216,7 @@ Emacs can't find.") (defvar gdb-source-window nil) (defvar gdb-inferior-status nil) (defvar gdb-continuation nil) +(defvar gdb-version nil) (defvar gdb-filter-output nil "Message to be shown in GUD console. @@ -264,7 +266,7 @@ Elements are either function names or pairs (buffer . function)") This function checks `gdb-pending-triggers' value every `gdb-wait-for-pending' seconds." - (run-with-timer + (run-with-timer 0.5 nil `(lambda () (if (not gdb-pending-triggers) @@ -293,7 +295,7 @@ argument (see `gdb-emit-signal')." (dolist (subscriber (gdb-get-subscribers publisher)) (funcall (cdr subscriber) signal))) -(defvar gdb-buf-publisher '() +(defvar gdb-buf-publisher '() "Used to invalidate GDB buffers by emitting a signal in `gdb-update'. @@ -315,7 +317,7 @@ valid signal handlers.") "GDB buffers" :group 'gdb :version "23.2") - + (defcustom gdb-debug-log-max 128 "Maximum size of `gdb-debug-log'. If nil, size is unlimited." :group 'gdb @@ -390,7 +392,7 @@ contains fields of corresponding MI *stopped async record: Note that \"reason\" is only present in non-stop debugging mode. -`gdb-get-field' may be used to access the fields of response. +`bindat-get-field' may be used to access the fields of response. Each function is called after the new current thread was selected and GDB buffers were updated in `gdb-stopped'." @@ -498,9 +500,6 @@ Also display the main routine in the disassembly buffer if present." :group 'gdb :version "22.1") -; Note: This mode requires a separate buffer for inferior IO. -(defconst gdb-use-separate-io-buffer t) - (defun gdb-force-mode-line-update (status) (let ((buffer gud-comint-buffer)) (if (and buffer (buffer-name buffer)) @@ -531,12 +530,16 @@ the list) is deleted every time a new one is added (at the front)." "Switch to non-stop/A mode." (interactive) (setq gdb-gud-control-all-threads t) + ;; Actually forcing the tool-bar to update. + (force-mode-line-update) (message "Now in non-stop/A mode.")) (defun gdb-control-current-thread () "Switch to non-stop/T mode." (interactive) (setq gdb-gud-control-all-threads nil) + ;; Actually forcing the tool-bar to update. + (force-mode-line-update) (message "Now in non-stop/T mode.")) (defun gdb-find-watch-expression () @@ -567,9 +570,10 @@ If NOALL is t, always add --thread option no matter what When `gdb-non-stop' is nil, return COMMAND unchanged." (if gdb-non-stop (if (and gdb-gud-control-all-threads - (not noall)) + (not noall) + (string-equal gdb-version "7.0+")) (concat command " --all ") - (gdb-current-context-command command t)) + (gdb-current-context-command command)) command)) (defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg) @@ -578,9 +582,8 @@ CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'. NOARG must be t when this macro is used outside `gud-def'" `(gud-call - (concat - (gdb-gud-context-command ,cmd1 ,noall) - ,cmd2) ,(when (not noarg) 'arg))) + (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2) + ,(when (not noarg) 'arg))) ;;;###autoload (defun gdb (command-line) @@ -752,15 +755,8 @@ detailed description of this mode. (gdb-update) - (add-hook - 'kill-buffer-hook - (function - (lambda () - (gdb-input (list "-target-detach" 'ignore)))) - nil t) - (run-hooks 'gdb-mode-hook)) - + (defun gdb-init-1 () ;; (re-)initialise (setq gdb-selected-frame nil @@ -792,22 +788,21 @@ detailed description of this mode. ;; (gdb-force-mode-line-update (propertize "initializing..." 'face font-lock-variable-name-face)) - (when gdb-use-separate-io-buffer - (gdb-get-buffer-create 'gdb-inferior-io) - (gdb-clear-inferior-io) - (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter) - (gdb-input - ;; Needs GDB 6.4 onwards - (list (concat "-inferior-tty-set " - (process-tty-name (get-process "gdb-inferior"))) - 'ignore))) + + (gdb-get-buffer-create 'gdb-inferior-io) + (gdb-clear-inferior-io) + (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter) + (gdb-input + ;; Needs GDB 6.4 onwards + (list (concat "-inferior-tty-set " + (process-tty-name (get-process "gdb-inferior"))) + 'ignore)) (if (eq window-system 'w32) (gdb-input (list "-gdb-set new-console off" 'ignore))) (gdb-input (list "-gdb-set height 0" 'ignore)) (when gdb-non-stop - (gdb-input (list "-gdb-set non-stop 1" 'ignore)) - (gdb-input (list "-gdb-set target-async 1" 'ignore))) + (gdb-input (list "-gdb-set non-stop 1" 'gdb-non-stop-handler))) ;; find source file and compilation directory here (gdb-input @@ -820,6 +815,17 @@ detailed description of this mode. (gdb-input (list "-gdb-show prompt" 'gdb-get-prompt))) +(defun gdb-non-stop-handler () + (goto-char (point-min)) + (if (re-search-forward "No symbol" nil t) + (progn + (message "This version of GDB doesn't support non-stop mode. Turning it off.") + (setq gdb-non-stop nil) + (setq gdb-version "pre-7.0")) + (setq gdb-version "7.0+") + (gdb-input (list "-gdb-set target-async 1" 'ignore)) + (gdb-input (list "-enable-pretty-printing" 'ignore)))) + (defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.") (defun gdb-create-define-alist () @@ -847,18 +853,14 @@ detailed description of this mode. (defvar tooltip-use-echo-area) (defun gdb-tooltip-print (expr) - (tooltip-show (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) (goto-char (point-min)) - (let ((string - (if (search-forward "=" nil t) - (concat expr (buffer-substring (- (point) 2) (point-max))) - (buffer-string)))) - ;; remove newline for gud-tooltip-echo-area - (substring string 0 (- (length string) 1)))) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not (display-graphic-p))))) - + (if (re-search-forward ".*value=\\(\".*\"\\)" nil t) + (tooltip-show + (concat expr " = " (read (match-string 1))) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not (display-graphic-p))))))) + ;; If expr is a macro for a function don't print because of possible dangerous ;; side-effects. Also printing a function within a tooltip generates an ;; unexpected starting annotation (phase error). @@ -868,7 +870,7 @@ detailed description of this mode. (if (search-forward "expands to: " nil t) (unless (looking-at "\\S-+.*(.*).*") (gdb-input - (list (concat "print " expr) + (list (concat "-data-evaluate-expression " expr) `(lambda () (gdb-tooltip-print ,expr)))))))) (defun gdb-init-buffer () @@ -902,7 +904,8 @@ with mouse-1 (default bindings)." (gud-call (concat "until " (number-to-string line)))) (gdb-if-arrow gdb-disassembly-position (save-excursion - (goto-line (line-number-at-pos (posn-point end))) + (goto-char (point-min)) + (forward-line (1- (line-number-at-pos (posn-point end)))) (forward-char 2) (gud-call (concat "until *%a")))))) @@ -922,7 +925,8 @@ line, and no execution takes place." (gud-call (concat "jump " (number-to-string line))))) (gdb-if-arrow gdb-disassembly-position (save-excursion - (goto-line (line-number-at-pos (posn-point end))) + (goto-char (point-min)) + (forward-line (1- (line-number-at-pos (posn-point end)))) (forward-char 2) (progn (gud-call (concat "tbreak *%a")) @@ -1004,30 +1008,25 @@ With arg, enter name of variable to be watched in the minibuffer." (defun gdb-var-create-handler (expr) (let* ((result (gdb-json-partial-output))) - (if (not (gdb-get-field result 'msg)) - (let - ((var - (list - (gdb-get-field result 'name) - (if (and (string-equal gdb-current-language "c") - gdb-use-colon-colon-notation gdb-selected-frame) - (setq expr (concat gdb-selected-frame "::" expr)) - expr) - (gdb-get-field result 'numchild) - (gdb-get-field result 'type) - (gdb-get-field result 'value) - nil))) - (push var gdb-var-list) - (speedbar 1) - (unless (string-equal - speedbar-initial-expansion-list-name "GUD") - (speedbar-change-initial-expansion-list "GUD")) - (gdb-input - (list - (concat "-var-evaluate-expression " (car var)) - `(lambda () (gdb-var-evaluate-expression-handler - ,(car var) nil))))) - (message-box "No symbol \"%s\" in current context." expr)))) + (if (not (bindat-get-field result 'msg)) + (let ((var + (list (bindat-get-field result 'name) + (if (and (string-equal gdb-current-language "c") + gdb-use-colon-colon-notation gdb-selected-frame) + (setq expr (concat gdb-selected-frame "::" expr)) + expr) + (bindat-get-field result 'numchild) + (bindat-get-field result 'type) + (bindat-get-field result 'value) + nil + (bindat-get-field result 'has_more) + gdb-frame-address))) + (push var gdb-var-list) + (speedbar 1) + (unless (string-equal + speedbar-initial-expansion-list-name "GUD") + (speedbar-change-initial-expansion-list "GUD"))) + (message-box "No symbol \"%s\" in current context." expr)))) (defun gdb-speedbar-update () (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) @@ -1061,25 +1060,25 @@ With arg, enter name of variable to be watched in the minibuffer." varnum) `(lambda () (gdb-var-list-children-handler ,varnum))))) -(defconst gdb-var-list-children-regexp - "child={.*?name=\"\\(.+?\\)\".*?,exp=\"\\(.+?\\)\".*?,\ -numchild=\"\\(.+?\\)\".*?,value=\\(\".*?\"\\).*?,type=\"\\(.+?\\)\".*?}") - (defun gdb-var-list-children-handler (varnum) - (goto-char (point-min)) - (let ((var-list nil)) - (catch 'child-already-watched + (let* ((var-list nil) + (output (bindat-get-field (gdb-json-partial-output "child"))) + (children (bindat-get-field output 'children))) + (catch 'child-already-watched (dolist (var gdb-var-list) (if (string-equal varnum (car var)) (progn + ;; With dynamic varobjs numchild may have increased. + (setcar (nthcdr 2 var) (bindat-get-field output 'numchild)) (push var var-list) - (while (re-search-forward gdb-var-list-children-regexp nil t) - (let ((varchild (list (match-string 1) - (match-string 2) - (match-string 3) - (match-string 5) - (read (match-string 4)) - nil))) + (dolist (child children) + (let ((varchild (list (bindat-get-field child 'name) + (bindat-get-field child 'exp) + (bindat-get-field child 'numchild) + (bindat-get-field child 'type) + (bindat-get-field child 'value) + nil + (bindat-get-field child 'has_more)))) (if (assoc (car varchild) gdb-var-list) (throw 'child-already-watched nil)) (push varchild var-list)))) @@ -1095,7 +1094,7 @@ numchild=\"\\(.+?\\)\".*?,value=\\(\".*?\"\\).*?,type=\"\\(.+?\\)\".*?}") (list (concat "-var-set-format " varnum " " format) 'ignore)) (gdb-var-update))) -(defun gdb-var-delete-1 (varnum) +(defun gdb-var-delete-1 (var varnum) (gdb-input (list (concat "-var-delete " varnum) 'ignore)) (setq gdb-var-list (delq var gdb-var-list)) @@ -1112,7 +1111,7 @@ numchild=\"\\(.+?\\)\".*?,value=\\(\".*?\"\\).*?,type=\"\\(.+?\\)\".*?}") (varnum (car var))) (if (string-match "\\." (car var)) (message-box "Can only delete a root expression") - (gdb-var-delete-1 varnum))))) + (gdb-var-delete-1 var varnum))))) (defun gdb-var-delete-children (varnum) "Delete children of variable object at point from the speedbar." @@ -1142,30 +1141,69 @@ numchild=\"\\(.+?\\)\".*?,value=\\(\".*?\"\\).*?,type=\"\\(.+?\\)\".*?}") (list "-var-update --all-values *" 'gdb-var-update-handler))) (gdb-add-pending 'gdb-var-update)) -(defconst gdb-var-update-regexp - "{.*?name=\"\\(.*?\\)\".*?,\\(?:value=\\(\".*?\"\\),\\)?.*?\ -in_scope=\"\\(.*?\\)\".*?}") - (defun gdb-var-update-handler () - (dolist (var gdb-var-list) - (setcar (nthcdr 5 var) nil)) - (goto-char (point-min)) - (while (re-search-forward gdb-var-update-regexp nil t) - (let* ((varnum (match-string 1)) - (var (assoc varnum gdb-var-list))) - (when var - (let ((match (match-string 3))) - (cond ((string-equal match "false") - (if gdb-delete-out-of-scope - (gdb-var-delete-1 varnum) - (setcar (nthcdr 5 var) 'out-of-scope))) - ((string-equal match "true") - (setcar (nthcdr 5 var) 'changed) - (setcar (nthcdr 4 var) - (read (match-string 2)))) - ((string-equal match "invalid") - (gdb-var-delete-1 varnum))))))) - (gdb-delete-pending 'gdb-var-update) + (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) + (dolist (var gdb-var-list) + (setcar (nthcdr 5 var) nil)) + (let ((temp-var-list gdb-var-list)) + (dolist (change changelist) + (let* ((varnum (bindat-get-field change 'name)) + (var (assoc varnum gdb-var-list)) + (new-num (bindat-get-field change 'new_num_children))) + (when var + (let ((scope (bindat-get-field change 'in_scope)) + (has-more (bindat-get-field change 'has_more))) + (cond ((string-equal scope "false") + (if gdb-delete-out-of-scope + (gdb-var-delete-1 var varnum) + (setcar (nthcdr 5 var) 'out-of-scope))) + ((string-equal scope "true") + (setcar (nthcdr 6 var) has-more) + (when (and (or (not has-more) + (string-equal has-more "0")) + (not new-num) + (string-equal (nth 2 var) "0")) + (setcar (nthcdr 4 var) + (bindat-get-field change 'value)) + (setcar (nthcdr 5 var) 'changed))) + ((string-equal scope "invalid") + (gdb-var-delete-1 var varnum))))) + (let ((var-list nil) var1 + (children (bindat-get-field change 'new_children))) + (if new-num + (progn + (setq var1 (pop temp-var-list)) + (while var1 + (if (string-equal varnum (car var1)) + (let ((new (string-to-number new-num)) + (previous (string-to-number (nth 2 var1)))) + (setcar (nthcdr 2 var1) new-num) + (push var1 var-list) + (cond ((> new previous) + ;; Add new children to list. + (dotimes (dummy previous) + (push (pop temp-var-list) var-list)) + (dolist (child children) + (let ((varchild + (list (bindat-get-field child 'name) + (bindat-get-field child 'exp) + (bindat-get-field child 'numchild) + (bindat-get-field child 'type) + (bindat-get-field child 'value) + 'changed + (bindat-get-field child 'has_more)))) + (push varchild var-list)))) + ;; Remove deleted children from list. + ((< new previous) + (dotimes (dummy new) + (push (pop temp-var-list) var-list)) + (dotimes (dummy (- previous new)) + (pop temp-var-list))))) + (push var1 var-list)) + (setq var1 (pop temp-var-list))) + (setq gdb-var-list (nreverse var-list))))))))) + (setq gdb-pending-triggers + (delq 'gdb-var-update gdb-pending-triggers)) (gdb-speedbar-update)) (defun gdb-speedbar-expand-node (text token indent) @@ -1236,7 +1274,7 @@ thread." (defun gdb-current-buffer-frame () "Get current stack frame object for thread of current buffer." - (gdb-get-field (gdb-current-buffer-thread) 'frame)) + (bindat-get-field (gdb-current-buffer-thread) 'frame)) (defun gdb-buffer-type (buffer) "Get value of `gdb-buffer-type' for BUFFER." @@ -1302,7 +1340,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (apply ',expr args)))) ;; Used to define all gdb-frame-*-buffer functions except -;; `gdb-frame-separate-io-buffer' +;; `gdb-frame-io-buffer' (defmacro def-gdb-frame-for-buffer (name buffer &optional doc) "Define a function NAME which shows gdb BUFFER in a separate frame. @@ -1325,7 +1363,8 @@ DOC is an optional documentation string." (gdb-get-buffer-create ,buffer thread) t))) ;; Used to display windows with thread-bound buffers -(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc split-horizontal) +(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc + split-horizontal) `(defun ,name (&optional thread) ,(when doc doc) (message thread) @@ -1359,14 +1398,14 @@ DOC is an optional documentation string." (buffer-disable-undo) ;; Delete buffer from gdb-buf-publisher when it's killed ;; (if it has an associated update trigger) - (add-hook + (add-hook 'kill-buffer-hook (function (lambda () (let ((trigger (gdb-rules-update-trigger (gdb-current-buffer-rules)))) (when trigger - (gdb-delete-subscriber + (gdb-delete-subscriber gdb-buf-publisher ;; This should match gdb-add-subscriber done in ;; gdb-get-buffer-create @@ -1374,9 +1413,6 @@ DOC is an optional documentation string." (gdb-bind-function-to-buffer trigger (current-buffer)))))))) nil t)) -;; GUD buffers are an exception to the rules -(gdb-set-buffer-rules 'gdbmi 'error) - ;; Partial-output buffer : This accumulates output from a command executed on ;; behalf of emacs (rather than the user). ;; @@ -1398,12 +1434,11 @@ DOC is an optional documentation string." (gdb-get-target-string) "*")) -(defun gdb-display-separate-io-buffer () +(defun gdb-display-io-buffer () "Display IO of debugged program in a separate window." (interactive) - (if gdb-use-separate-io-buffer - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-inferior-io) t))) + (gdb-display-buffer + (gdb-get-buffer-create 'gdb-inferior-io) t)) (defconst gdb-frame-parameters '((height . 14) (width . 80) @@ -1412,57 +1447,58 @@ DOC is an optional documentation string." (menu-bar-lines . nil) (minibuffer . nil))) -(defun gdb-frame-separate-io-buffer () +(defun gdb-frame-io-buffer () "Display IO of debugged program in a new frame." (interactive) - (if gdb-use-separate-io-buffer - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))) (defvar gdb-inferior-io-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt) - (define-key map "\C-c\C-z" 'gdb-separate-io-stop) - (define-key map "\C-c\C-\\" 'gdb-separate-io-quit) - (define-key map "\C-c\C-d" 'gdb-separate-io-eof) - (define-key map "\C-d" 'gdb-separate-io-eof) + (define-key map "\C-c\C-c" 'gdb-io-interrupt) + (define-key map "\C-c\C-z" 'gdb-io-stop) + (define-key map "\C-c\C-\\" 'gdb-io-quit) + (define-key map "\C-c\C-d" 'gdb-io-eof) + (define-key map "\C-d" 'gdb-io-eof) map)) +;; We want to use comint because it has various nifty and familiar features. (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O" - "Major mode for gdb inferior-io." + "Major mode for gdb inferior-io. + +The following commands are available: +\\{gdb-inferior-io-mode-map}" + :syntax-table nil :abbrev-table nil - ;; We want to use comint because it has various nifty and familiar features. - (start-process "gdb-inferior" -;; (concat "*input/output of " (gdb-get-target-string) "*") - (current-buffer) - nil)) + +(make-comint-in-buffer "gdb-inferior" (current-buffer) nil)) (defun gdb-inferior-filter (proc string) (unless (string-equal string "") (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t)) (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) - (insert-before-markers string))) + (comint-output-filter proc string))) -(defun gdb-separate-io-interrupt () +(defun gdb-io-interrupt () "Interrupt the program being debugged." (interactive) (interrupt-process (get-buffer-process gud-comint-buffer) comint-ptyp)) -(defun gdb-separate-io-quit () +(defun gdb-io-quit () "Send quit signal to the program being debugged." (interactive) (quit-process (get-buffer-process gud-comint-buffer) comint-ptyp)) -(defun gdb-separate-io-stop () +(defun gdb-io-stop () "Stop the program being debugged." (interactive) (stop-process (get-buffer-process gud-comint-buffer) comint-ptyp)) -(defun gdb-separate-io-eof () +(defun gdb-io-eof () "Send end-of-file to the program being debugged." (interactive) (process-send-eof @@ -1595,20 +1631,11 @@ static char *magick[] = { (concat (car item) "\n"))) ;; NOFRAME is used for gud execution control commands -(defun gdb-current-context-command (command &optional noframe) - "Add --thread and --frame options to gdb COMMAND. - -Option values are taken from `gdb-thread-number' and -`gdb-frame-number'. If `gdb-thread-number' is nil, COMMAND is -returned unchanged. If `gdb-frame-number' is nil of NOFRAME is t, -then no --frame option is added." - ;; gdb-frame-number may be nil while gdb-thread-number is non-nil - ;; (when current thread is running) - (if gdb-thread-number - (concat command " --thread " gdb-thread-number - (if (not (or noframe (not gdb-frame-number))) - (concat " --frame " gdb-frame-number) "") - " ") +(defun gdb-current-context-command (command) + "Add --thread to gdb COMMAND when needed." + (if (and gdb-thread-number + (string-equal gdb-version "7.0+")) + (concat command " --thread " gdb-thread-number) command)) (defun gdb-current-context-buffer-name (name) @@ -1616,7 +1643,7 @@ then no --frame option is added." If `gdb-thread-number' is nil, just wrap NAME in asterisks." (concat "*" name - (if (local-variable-p 'gdb-thread-number) + (if (local-variable-p 'gdb-thread-number) (format " (bound to thread %s)" gdb-thread-number) "") "*")) @@ -1647,14 +1674,14 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." (propertize "initializing..." 'face font-lock-variable-name-face)) (gdb-init-1) (setq gdb-first-prompt nil)) + + (gdb-get-main-selected-frame) ;; We may need to update gdb-threads-list so we can use (gdb-get-buffer-create 'gdb-threads-buffer) ;; gdb-break-list is maintained in breakpoints handler - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - - (gdb-emit-signal gdb-buf-publisher 'update) + (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (gdb-get-main-selected-frame) + (gdb-emit-signal gdb-buf-publisher 'update) (gdb-get-changed-registers) @@ -1670,7 +1697,8 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." "Only this function must be used to change `gdb-thread-number' value to NUMBER, because `gud-running' and `gdb-frame-number' need to be updated appropriately when current thread changes." - (setq gdb-thread-number number) + ;; GDB 6.8 and earlier always output thread-id="0" when stopping. + (unless (string-equal number "0") (setq gdb-thread-number number)) (setq gdb-frame-number "0") (gdb-update-gud-running)) @@ -1689,7 +1717,7 @@ For all-stop mode, thread information is unavailable while target is running." (let ((old-value gud-running)) (setq gud-running - (string= (gdb-get-field (gdb-current-buffer-thread) 'state) + (string= (bindat-get-field (gdb-current-buffer-thread) 'state) "running")) ;; Set frame number to "0" when _current_ threads stops (when (and (gdb-current-buffer-thread) @@ -1818,7 +1846,7 @@ is running." (defun gdb-thread-exited (output-field) "Handle =thread-exited async record: unset `gdb-thread-number' if current thread exited and update threads list." - (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'id))) + (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, @@ -1833,7 +1861,7 @@ is running." Sets `gdb-thread-number' to new id." (let* ((result (gdb-json-string output-field)) - (thread-id (gdb-get-field result 'id))) + (thread-id (bindat-get-field result 'id))) (gdb-setq-thread-number thread-id) ;; Typing `thread N` in GUD buffer makes GDB emit `^done` followed ;; by `=thread-selected` notification. `^done` causes `gdb-update` @@ -1846,7 +1874,7 @@ Sets `gdb-thread-number' to new id." (gdb-update)))) (defun gdb-running (output-field) - (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'thread-id))) + (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'thread-id))) ;; We reset gdb-frame-number to nil if current thread has gone ;; running. This can't be done in gdb-thread-list-handler-custom ;; because we need correct gdb-frame-number by the time @@ -1881,14 +1909,16 @@ Sets `gdb-thread-number' to new id." current thread and update GDB buffers." ;; Reason is available with target-async only (let* ((result (gdb-json-string output-field)) - (reason (gdb-get-field result 'reason)) - (thread-id (gdb-get-field result 'thread-id))) + (reason (bindat-get-field result 'reason)) + (thread-id (bindat-get-field result 'thread-id))) ;; -data-list-register-names needs to be issued for any stopped ;; thread (when (not gdb-register-names) (gdb-input - (list (concat "-data-list-register-names --thread " thread-id) + (list (concat "-data-list-register-names" + (if (string-equal gdb-version "7.0+") + (concat" --thread " thread-id))) 'gdb-register-names-handler))) ;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler @@ -1914,16 +1944,16 @@ current thread and update GDB buffers." ;; gdb-switch-when-another-stopped: (when (or gdb-switch-when-another-stopped (not (string= "stopped" - (gdb-get-field (gdb-current-buffer-thread) 'state)))) + (bindat-get-field (gdb-current-buffer-thread) 'state)))) ;; Switch if current reason has been selected or we have no ;; reasons (if (or (eq gdb-switch-reasons t) (member reason gdb-switch-reasons)) - (progn - (gdb-setq-thread-number thread-id) - (message (concat "Switched to thread " thread-id))) + (when (not (string-equal gdb-thread-number thread-id)) + (message (concat "Switched to thread " thread-id)) + (gdb-setq-thread-number thread-id)) (message (format "Thread %s stopped" thread-id))))) - + ;; Print "(gdb)" to GUD console (when gdb-first-done-or-error (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) @@ -2034,7 +2064,6 @@ incompatible with GDB/MI output syntax." (save-excursion (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t) (replace-match "" nil nil nil 1)))) - ;; Emacs bug #3794 (when fix-list (save-excursion ;; Find positions of braces which enclose broken list @@ -2052,9 +2081,9 @@ incompatible with GDB/MI output syntax." (insert "]")))))) (goto-char (point-min)) (insert "{") - ;; TODO: This breaks badly with foo= inside constants - (while (re-search-forward "\\([[:alpha:]-_]+\\)=" nil t) - (replace-match "\"\\1\":" nil nil)) + (while (re-search-forward + "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t) + (replace-match "\"\\1\":\\2" nil nil)) (goto-char (point-max)) (insert "}"))) @@ -2088,7 +2117,7 @@ FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." (let ((offset (1+ (- line (line-number-at-pos))))) (cons (line-beginning-position offset) - (line-end-position offset)))) + (line-end-position offset)))) (defmacro gdb-mark-line (line variable) "Set VARIABLE marker to point at beginning of LINE. @@ -2111,14 +2140,28 @@ Return position where LINE begins." ;; gdb-table struct is a way to programmatically construct simple ;; tables. It help to reliably align columns of data in GDB buffers -;; and provides -(defstruct +;; and provides +(defstruct gdb-table (column-sizes nil) (rows nil) (row-properties nil) (right-align nil)) +(defun gdb-mapcar* (function &rest seqs) + "Apply FUNCTION to each element of SEQS, and make a list of the results. +If there are several SEQS, FUNCTION is called with that many +arugments, and mapping stops as sson as the shortest list runs +out." + (let ((shortest (apply #'min (mapcar #'length seqs)))) + (mapcar (lambda (i) + (apply function + (mapcar + (lambda (seq) + (nth i seq)) + seqs))) + (number-sequence 0 (1- shortest))))) + (defun gdb-table-add-row (table row &optional properties) "Add ROW of string to TABLE and recalculate column sizes. @@ -2136,7 +2179,7 @@ calling `gdb-table-string'." (setf (gdb-table-row-properties table) (append row-properties (list properties))) (setf (gdb-table-column-sizes table) - (mapcar* (lambda (x s) + (gdb-mapcar* (lambda (x s) (let ((new-x (max (abs x) (string-width (or s ""))))) (if right-align new-x (- new-x)))) @@ -2152,26 +2195,24 @@ calling `gdb-table-string'." (res "")) (mapconcat 'identity - (mapcar* + (gdb-mapcar* (lambda (row properties) (apply 'propertize (mapconcat 'identity - (mapcar* (lambda (s x) (gdb-pad-string s x)) - row column-sizes) + (gdb-mapcar* (lambda (s x) (gdb-pad-string s x)) + row column-sizes) sep) properties)) (gdb-table-rows table) (gdb-table-row-properties table)) "\n"))) -;; gdb-get-field goes deep, gdb-get-many-fields goes wide -(defalias 'gdb-get-field 'bindat-get-field) - +;; bindat-get-field goes deep, gdb-get-many-fields goes wide (defun gdb-get-many-fields (struct &rest fields) "Return a list of FIELDS values from STRUCT." (let ((values)) (dolist (field fields values) - (setq values (append values (list (gdb-get-field struct field))))))) + (setq values (append values (list (bindat-get-field struct field))))))) (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command handler-name @@ -2257,41 +2298,44 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom '(start update)) -(gdb-set-buffer-rules +(gdb-set-buffer-rules 'gdb-breakpoints-buffer - 'gdb-breakpoints-buffer-name + 'gdb-breakpoints-buffer-name 'gdb-breakpoints-mode 'gdb-invalidate-breakpoints) (defun gdb-breakpoints-list-handler-custom () - (let ((breakpoints-list (gdb-get-field + (let ((breakpoints-list (bindat-get-field (gdb-json-partial-output "bkpt" "script") 'BreakpointTable 'body)) (table (make-gdb-table))) (setq gdb-breakpoints-list nil) - (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Hits" "Addr" "What")) + (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What")) (dolist (breakpoint breakpoints-list) - (add-to-list 'gdb-breakpoints-list - (cons (gdb-get-field breakpoint 'number) + (add-to-list 'gdb-breakpoints-list + (cons (bindat-get-field breakpoint 'number) breakpoint)) - (let ((at (gdb-get-field breakpoint 'at)) - (pending (gdb-get-field breakpoint 'pending)) - (func (gdb-get-field breakpoint 'func))) + (let ((at (bindat-get-field breakpoint 'at)) + (pending (bindat-get-field breakpoint 'pending)) + (func (bindat-get-field breakpoint 'func)) + (type (bindat-get-field breakpoint 'type))) (gdb-table-add-row table (list - (gdb-get-field breakpoint 'number) - (gdb-get-field breakpoint 'type) - (gdb-get-field breakpoint 'disp) - (let ((flag (gdb-get-field breakpoint 'enabled))) + (bindat-get-field breakpoint 'number) + type + (bindat-get-field breakpoint 'disp) + (let ((flag (bindat-get-field breakpoint 'enabled))) (if (string-equal flag "y") (propertize "y" 'font-lock-face font-lock-warning-face) (propertize "n" 'font-lock-face font-lock-comment-face))) - (gdb-get-field breakpoint 'times) - (gdb-get-field breakpoint 'addr) - (or pending at - (concat "in " - (propertize func 'font-lock-face font-lock-function-name-face) - (gdb-frame-location breakpoint)))) + (bindat-get-field breakpoint 'addr) + (bindat-get-field breakpoint 'times) + (if (string-match ".*watchpoint" type) + (bindat-get-field breakpoint 'what) + (or pending at + (concat "in " + (propertize func 'font-lock-face font-lock-function-name-face) + (gdb-frame-location breakpoint))))) ;; Add clickable properties only for breakpoints with file:line ;; information (append (list 'gdb-breakpoint breakpoint) @@ -2312,11 +2356,11 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is ; an associative list - (line (gdb-get-field breakpoint 'line))) + (line (bindat-get-field breakpoint 'line))) (when line - (let ((file (gdb-get-field breakpoint 'fullname)) - (flag (gdb-get-field breakpoint 'enabled)) - (bptno (gdb-get-field breakpoint 'number))) + (let ((file (bindat-get-field breakpoint 'fullname)) + (flag (bindat-get-field breakpoint 'enabled)) + (bptno (bindat-get-field breakpoint 'number))) (unless (file-exists-p file) (setq file (cdr (assoc bptno gdb-location-alist)))) (if (and file @@ -2462,8 +2506,8 @@ If not in a source or disassembly buffer just set point." ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. (define-key map "q" 'gdb-delete-frame-or-window) (define-key map "\r" 'gdb-goto-breakpoint) - (define-key map "\t" '(lambda () - (interactive) + (define-key map "\t" '(lambda () + (interactive) (gdb-set-window-buffer (gdb-get-buffer-create 'gdb-threads-buffer) t))) (define-key map [mouse-2] 'gdb-goto-breakpoint) @@ -2488,7 +2532,7 @@ corresponding to the mode line clicked." (defmacro gdb-propertize-header (name buffer help-echo mouse-face face) `(propertize ,name - 'help-echo ,help-echo + 'help-echo ,help-echo 'mouse-face ',mouse-face 'face ',face 'local-map @@ -2497,7 +2541,7 @@ corresponding to the mode line clicked." (lambda (event) (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (gdb-set-window-buffer + (gdb-set-window-buffer (gdb-get-buffer-create ',buffer) t) ))))) @@ -2518,12 +2562,12 @@ corresponding to the mode line clicked." "Display GDB threads in a new frame.") (def-gdb-trigger-and-handler - gdb-invalidate-threads (gdb-current-context-command "-thread-info" gud-running) + gdb-invalidate-threads (gdb-current-context-command "-thread-info") gdb-thread-list-handler gdb-thread-list-handler-custom '(start update update-threads)) (gdb-set-buffer-rules - 'gdb-threads-buffer + 'gdb-threads-buffer 'gdb-threads-buffer-name 'gdb-threads-mode 'gdb-invalidate-threads) @@ -2549,9 +2593,9 @@ corresponding to the mode line clicked." (define-key map "i" 'gdb-interrupt-thread) (define-key map "c" 'gdb-continue-thread) (define-key map "s" 'gdb-step-thread) - (define-key map "\t" '(lambda () - (interactive) - (gdb-set-window-buffer + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))) (define-key map [mouse-2] 'gdb-select-thread) (define-key map [follow-link] 'mouse-face) @@ -2578,7 +2622,7 @@ corresponding to the mode line clicked." 'gdb-invalidate-threads) (defun gdb-thread-list-handler-custom () - (let ((threads-list (gdb-get-field (gdb-json-partial-output) 'threads)) + (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads)) (table (make-gdb-table)) (marked-line nil)) (setq gdb-threads-list nil) @@ -2587,9 +2631,9 @@ corresponding to the mode line clicked." (set-marker gdb-thread-position nil) (dolist (thread (reverse threads-list)) - (let ((running (string-equal (gdb-get-field thread 'state) "running"))) + (let ((running (string-equal (bindat-get-field thread 'state) "running"))) (add-to-list 'gdb-threads-list - (cons (gdb-get-field thread 'id) + (cons (bindat-get-field thread 'id) thread)) (if running (incf gdb-running-threads-count) @@ -2597,36 +2641,36 @@ corresponding to the mode line clicked." (gdb-table-add-row table (list - (gdb-get-field thread 'id) + (bindat-get-field thread 'id) (concat (if gdb-thread-buffer-verbose-names - (concat (gdb-get-field thread 'target-id) " ") "") - (gdb-get-field thread 'state) + (concat (bindat-get-field thread 'target-id) " ") "") + (bindat-get-field thread 'state) ;; Include frame information for stopped threads (if (not running) (concat - " in " (gdb-get-field thread 'frame 'func) + " in " (bindat-get-field thread 'frame 'func) (if gdb-thread-buffer-arguments (concat " (" - (let ((args (gdb-get-field thread 'frame 'args))) + (let ((args (bindat-get-field thread 'frame 'args))) (mapconcat (lambda (arg) (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))) - args ",")) + args ",")) ")") "") (if gdb-thread-buffer-locations - (gdb-frame-location (gdb-get-field thread 'frame)) "") + (gdb-frame-location (bindat-get-field thread 'frame)) "") (if gdb-thread-buffer-addresses - (concat " at " (gdb-get-field thread 'frame 'addr)) "")) + (concat " at " (bindat-get-field thread 'frame 'addr)) "")) ""))) (list 'gdb-thread thread 'mouse-face 'highlight 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number - (gdb-get-field thread 'id)) + (bindat-get-field thread 'id)) (setq marked-line (length gdb-threads-list)))) (insert (gdb-table-string table " ")) (when marked-line @@ -2644,7 +2688,7 @@ be the value of 'gdb-thread property of the current line. If 'gdb-thread is nil, error is signaled." `(defun ,name (&optional event) ,(when doc doc) - (interactive) + (interactive (list last-input-event)) (if event (posn-set-point (event-end event))) (save-excursion (beginning-of-line) @@ -2657,11 +2701,11 @@ be the value of 'gdb-thread property of the current line. If "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." `(def-gdb-thread-buffer-command ,name - (,buffer-command (gdb-get-field thread 'id)) + (,buffer-command (bindat-get-field thread 'id)) ,doc)) (def-gdb-thread-buffer-command gdb-select-thread - (let ((new-id (gdb-get-field thread 'id))) + (let ((new-id (bindat-get-field thread 'id))) (gdb-setq-thread-number new-id) (gdb-input (list (concat "-thread-select " new-id) 'ignore)) (gdb-update)) @@ -2717,10 +2761,10 @@ current line.") line." `(def-gdb-thread-buffer-command ,name (if gdb-non-stop - (let ((gdb-thread-number (gdb-get-field thread 'id)) + (let ((gdb-thread-number (bindat-get-field thread 'id)) (gdb-gud-control-all-threads nil)) (call-interactively #',gud-command)) - (error "Available in non-stop mode only, customize gdb-non-stop-setting.")) + (error "Available in non-stop mode only, customize `gdb-non-stop-setting'")) ,doc)) (def-gdb-thread-buffer-gud-command @@ -2774,7 +2818,7 @@ line." (def-gdb-trigger-and-handler gdb-invalidate-memory - (format "-data-read-memory %s %s %d %d %d" + (format "-data-read-memory %s %s %d %d %d" gdb-memory-address gdb-memory-format gdb-memory-unit @@ -2812,16 +2856,16 @@ in `gdb-memory-format'." (defun gdb-read-memory-custom () (let* ((res (gdb-json-partial-output)) - (err-msg (gdb-get-field res 'msg))) + (err-msg (bindat-get-field res 'msg))) (if (not err-msg) - (let ((memory (gdb-get-field res 'memory))) - (setq gdb-memory-address (gdb-get-field res 'addr)) - (setq gdb-memory-next-page (gdb-get-field res 'next-page)) - (setq gdb-memory-prev-page (gdb-get-field res 'prev-page)) + (let ((memory (bindat-get-field res 'memory))) + (setq gdb-memory-address (bindat-get-field res 'addr)) + (setq gdb-memory-next-page (bindat-get-field res 'next-page)) + (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) (setq gdb-memory-last-address gdb-memory-address) (dolist (row memory) - (insert (concat (gdb-get-field row 'addr) ":")) - (dolist (column (gdb-get-field row 'data)) + (insert (concat (bindat-get-field row 'addr) ":")) + (dolist (column (bindat-get-field row 'data)) (insert (gdb-pad-string column (+ 2 (gdb-memory-column-width gdb-memory-unit @@ -3124,7 +3168,7 @@ DOC is an optional documentation string." (special-display-frame-alist `((left-fringe . 0) (right-fringe . 0) - (width . 83) + (width . 83) ,@gdb-frame-parameters))) (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) @@ -3151,8 +3195,8 @@ DOC is an optional documentation string." (def-gdb-auto-update-trigger gdb-invalidate-disassembly (let* ((frame (gdb-current-buffer-frame)) - (file (gdb-get-field frame 'fullname)) - (line (gdb-get-field frame 'line))) + (file (bindat-get-field frame 'fullname)) + (line (bindat-get-field frame 'line))) (when file (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) gdb-disassembly-handler @@ -3208,18 +3252,18 @@ DOC is an optional documentation string." 'gdb-invalidate-disassembly) (defun gdb-disassembly-handler-custom () - (let* ((instructions (gdb-get-field (gdb-json-partial-output) 'asm_insns)) - (address (gdb-get-field (gdb-current-buffer-frame) 'addr)) + (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns)) + (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) (pos 1) (table (make-gdb-table)) (marked-line nil)) (dolist (instr instructions) (gdb-table-add-row table (list - (gdb-get-field instr 'address) + (bindat-get-field instr 'address) (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) - (gdb-get-field instr 'inst))) - (when (string-equal (gdb-get-field instr 'address) + (bindat-get-field instr 'inst))) + (when (string-equal (bindat-get-field instr 'address) address) (progn (setq marked-line (length (gdb-table-rows table))) @@ -3236,16 +3280,16 @@ DOC is an optional documentation string." (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position)))) (setq mode-name (gdb-current-context-mode-name - (concat "Disassembly: " - (gdb-get-field (gdb-current-buffer-frame) 'func)))))) + (concat "Disassembly: " + (bindat-get-field (gdb-current-buffer-frame) 'func)))))) (defun gdb-disassembly-place-breakpoints () (gdb-remove-breakpoint-icons (point-min) (point-max)) (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) - (bptno (gdb-get-field breakpoint 'number)) - (flag (gdb-get-field breakpoint 'enabled)) - (address (gdb-get-field breakpoint 'addr))) + (bptno (bindat-get-field breakpoint 'number)) + (flag (bindat-get-field breakpoint 'enabled)) + (address (bindat-get-field breakpoint 'addr))) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^" address) nil t) @@ -3277,10 +3321,10 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call - (concat (if (string-equal "y" (gdb-get-field breakpoint 'enabled)) + (concat (if (string-equal "y" (bindat-get-field breakpoint 'enabled)) "-break-disable " "-break-enable ") - (gdb-get-field breakpoint 'number))) + (bindat-get-field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-delete-breakpoint () @@ -3290,9 +3334,9 @@ DOC is an optional documentation string." (beginning-of-line) (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint - (gud-basic-call (concat "-break-delete " (gdb-get-field breakpoint 'number))) + (gud-basic-call (concat "-break-delete " (bindat-get-field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) - + (defun gdb-goto-breakpoint (&optional event) "Go to the location of breakpoint at current line of breakpoints buffer." @@ -3305,9 +3349,9 @@ breakpoints buffer." (beginning-of-line) (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint - (let ((bptno (gdb-get-field breakpoint 'number)) - (file (gdb-get-field breakpoint 'fullname)) - (line (gdb-get-field breakpoint 'line))) + (let ((bptno (bindat-get-field breakpoint 'number)) + (file (bindat-get-field breakpoint 'fullname)) + (line (bindat-get-field breakpoint 'line))) (save-selected-window (let* ((buffer (find-file-noselect (if (file-exists-p file) file @@ -3316,7 +3360,8 @@ breakpoints buffer." (display-buffer buffer)))) (setq gdb-source-window window) (with-current-buffer buffer - (goto-line (string-to-number line)) + (goto-char (point-min)) + (forward-line (1- (string-to-number line))) (set-window-point window (point)))))) (error "Not recognized as break/watchpoint line"))))) @@ -3339,28 +3384,28 @@ breakpoints buffer." FRAME must have either \"file\" and \"line\" members or \"from\" member." - (let ((file (gdb-get-field frame 'file)) - (line (gdb-get-field frame 'line)) - (from (gdb-get-field frame 'from))) + (let ((file (bindat-get-field frame 'file)) + (line (bindat-get-field frame 'line)) + (from (bindat-get-field frame 'from))) (let ((res (or (and file line (concat file ":" line)) from))) (if res (concat " of " res) "")))) (defun gdb-stack-list-frames-custom () - (let ((stack (gdb-get-field (gdb-json-partial-output "frame") 'stack)) + (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack)) (table (make-gdb-table))) (set-marker gdb-stack-position nil) (dolist (frame stack) (gdb-table-add-row table (list - (gdb-get-field frame 'level) + (bindat-get-field frame 'level) "in" (concat - (gdb-get-field frame 'func) - (if gdb-stack-buffer-locations + (bindat-get-field frame 'func) + (if gdb-stack-buffer-locations (gdb-frame-location frame) "") - (if gdb-stack-buffer-addresses - (concat " at " (gdb-get-field frame 'addr)) ""))) + (if gdb-stack-buffer-addresses + (concat " at " (bindat-get-field frame 'addr)) ""))) `(mouse-face highlight help-echo "mouse-2, RET: Select frame" gdb-frame ,frame))) @@ -3422,11 +3467,11 @@ member." (let ((frame (get-text-property (point) 'gdb-frame))) (if frame (if (gdb-buffer-shows-main-thread-p) - (let ((new-level (gdb-get-field frame 'level))) + (let ((new-level (bindat-get-field frame 'level))) (setq gdb-frame-number new-level) (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore)) (gdb-update)) - (error "Could not select frame for non-current thread.")) + (error "Could not select frame for non-current thread")) (error "Not recognized as frame line")))) @@ -3466,7 +3511,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (gdb-get-field + (let* ((var (bindat-get-field (get-text-property (point) 'gdb-local-variable) 'name)) (value (read-string (format "New value (%s): " var)))) (gud-basic-call @@ -3475,12 +3520,12 @@ member." ;; Dont display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-locals-handler-custom () - (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals)) + (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals)) (table (make-gdb-table))) (dolist (local locals-list) - (let ((name (gdb-get-field local 'name)) - (value (gdb-get-field local 'value)) - (type (gdb-get-field local 'type))) + (let ((name (bindat-get-field local 'name)) + (value (bindat-get-field local 'value)) + (type (bindat-get-field local 'type))) (if (or (not value) (string-match "\\0x" value)) (add-text-properties 0 (length name) @@ -3493,8 +3538,8 @@ member." help-echo "mouse-2: edit value" local-map ,gdb-edit-locals-map-1) value)) - (gdb-table-add-row - table + (gdb-table-add-row + table (list (propertize type 'font-lock-face font-lock-type-face) (propertize name 'font-lock-face font-lock-variable-name-face) @@ -3503,7 +3548,7 @@ member." (insert (gdb-table-string table " ")) (setq mode-name (gdb-current-context-mode-name - (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func)))))) + (concat "Locals: " (bindat-get-field (gdb-current-buffer-frame) 'func)))))) (defvar gdb-locals-header (list @@ -3517,8 +3562,8 @@ member." (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "q" 'kill-this-buffer) - (define-key map "\t" '(lambda () - (interactive) + (define-key map "\t" '(lambda () + (interactive) (gdb-set-window-buffer (gdb-get-buffer-create 'gdb-registers-buffer @@ -3569,12 +3614,12 @@ member." (defun gdb-registers-handler-custom () (when gdb-register-names - (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values)) + (let ((register-values (bindat-get-field (gdb-json-partial-output) 'register-values)) (table (make-gdb-table))) (dolist (register register-values) - (let* ((register-number (gdb-get-field register 'number)) - (value (gdb-get-field register 'value)) - (register-name (nth (string-to-number register-number) + (let* ((register-number (bindat-get-field register 'number)) + (value (bindat-get-field register 'value)) + (register-name (nth (string-to-number register-number) gdb-register-names))) (gdb-table-add-row table @@ -3596,7 +3641,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (gdb-get-field + (let* ((var (bindat-get-field (get-text-property (point) 'gdb-register-name))) (value (read-string (format "New value (%s): " var)))) (gud-basic-call @@ -3608,8 +3653,8 @@ member." (define-key map "\r" 'gdb-edit-register-value) (define-key map [mouse-2] 'gdb-edit-register-value) (define-key map "q" 'kill-this-buffer) - (define-key map "\t" '(lambda () - (interactive) + (define-key map "\t" '(lambda () + (interactive) (gdb-set-window-buffer (gdb-get-buffer-create 'gdb-locals-buffer @@ -3664,14 +3709,14 @@ member." (defun gdb-changed-registers-handler () (gdb-delete-pending 'gdb-get-changed-registers) (setq gdb-changed-registers nil) - (dolist (register-number (gdb-get-field (gdb-json-partial-output) 'changed-registers)) + (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () ;; Don't use gdb-pending-triggers because this handler is called ;; only once (in gdb-init-1) (setq gdb-register-names nil) - (dolist (register-name (gdb-get-field (gdb-json-partial-output) 'register-names)) + (dolist (register-name (bindat-get-field (gdb-json-partial-output) 'register-names)) (push register-name gdb-register-names)) (setq gdb-register-names (reverse gdb-register-names))) @@ -3703,11 +3748,13 @@ thread. Called from `gdb-update'." "Sets `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." (gdb-delete-pending 'gdb-get-main-selected-frame) - (let ((frame (gdb-get-field (gdb-json-partial-output) 'frame))) + (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) (when frame - (setq gdb-selected-frame (gdb-get-field frame 'func)) - (setq gdb-selected-file (gdb-get-field frame 'fullname)) - (let ((line (gdb-get-field frame 'line))) + (setq gdb-selected-frame (bindat-get-field frame 'func)) + (setq gdb-selected-file (bindat-get-field frame 'fullname)) + (setq gdb-frame-number (bindat-get-field frame 'level)) + (setq gdb-frame-address (bindat-get-field frame 'addr)) + (let ((line (bindat-get-field frame 'line))) (setq gdb-selected-line (or (and line (string-to-number line)) nil)) ; don't fail if line is nil (when line ; obey the current file only if we have line info @@ -3724,7 +3771,7 @@ overlay arrow in source buffer." '((overlay-arrow . hollow-right-triangle)))) (setq gud-overlay-arrow-position (make-marker)) (set-marker gud-overlay-arrow-position position)))))))) - + (defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"") (defun gdb-get-prompt () @@ -3782,7 +3829,7 @@ SPLIT-HORIZONTAL and show BUF in the new window." (eq buf-type (gdb-buffer-type (window-buffer w))))))) (if dedicated-window - (set-window-buffer + (set-window-buffer (split-window dedicated-window nil split-horizontal) buf) (gdb-display-buffer buf t)))))) (error "Null buffer"))) @@ -3800,7 +3847,7 @@ SPLIT-HORIZONTAL and show BUF in the new window." '("Disassembly" . gdb-display-disassembly-buffer)) (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) (define-key menu [inferior] - '("Separate IO" . gdb-display-separate-io-buffer)) + '("IO" . gdb-display-io-buffer)) (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) (define-key menu [breakpoints] @@ -3816,7 +3863,7 @@ SPLIT-HORIZONTAL and show BUF in the new window." (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer)) (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) (define-key menu [inferior] - '("Separate IO" . gdb-frame-separate-io-buffer)) + '("IO" . gdb-frame-io-buffer)) (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) (define-key menu [breakpoints] @@ -3935,11 +3982,10 @@ window is dedicated." ;; can't find a source file. (list-buffers-noselect)))) (setq gdb-source-window (selected-window)) - (when gdb-use-separate-io-buffer - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-inferior-io))) + (split-window-horizontally) + (other-window 1) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-inferior-io)) (other-window 1) (gdb-set-window-buffer (gdb-stack-buffer-name)) (split-window-horizontally) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 9e63c1d0611..64e7dfdd174 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -120,6 +120,7 @@ Customize or call the function `grep-apply-setting'." The following place holders should be present in the string: <C> - place to put -i if case insensitive grep. <F> - file names and wildcards to search. + <X> - file names and wildcards to exclude. <R> - the regular expression searched for. <N> - place to insert null-device. @@ -176,18 +177,19 @@ Customize or call the function `grep-apply-setting'." :group 'grep) (defcustom grep-files-aliases - '(("asm" . "*.[sS]") + '(("all" . "* .*") + ("el" . "*.el") + ("ch" . "*.[ch]") ("c" . "*.c") ("cc" . "*.cc *.cxx *.cpp *.C *.CC *.c++") - ("cchh" . "*.cc *.[ch]xx *.[ch]pp *.[CHh] *.CC *.HH *.[ch]++") + ("cchh" . "*.cc *.[ch]xx *.[ch]pp *.[CHh] *.CC *.HH *.[ch]++") ("hh" . "*.hxx *.hpp *.[Hh] *.HH *.h++") - ("ch" . "*.[ch]") - ("el" . "*.el") ("h" . "*.h") - ("l" . "[Cc]hange[Ll]og*") + ("l" . "[Cc]hange[Ll]og*") ("m" . "[Mm]akefile*") - ("tex" . "*.tex") - ("texi" . "*.texi")) + ("tex" . "*.tex") + ("texi" . "*.texi") + ("asm" . "*.[sS]")) "*Alist of aliases for the FILES argument to `lgrep' and `rgrep'." :type 'alist :group 'grep) @@ -197,7 +199,20 @@ Customize or call the function `grep-apply-setting'." "*List of names of sub-directories which `rgrep' shall not recurse into. If an element is a cons cell, the car is called on the search directory to determine whether cdr should not be recursed into." - :type '(repeat string) + :type '(choice (repeat :tag "Ignored directories" string) + (const :tag "No ignored directories" nil)) + :group 'grep) + +(defcustom grep-find-ignored-files + (cons ".#*" (delq nil (mapcar (lambda (s) + (unless (string-match-p "/\\'" s) + (concat "*" s))) + completion-ignored-extensions))) + "*List of file names which `rgrep' and `lgrep' shall exclude. +If an element is a cons cell, the car is called on the search directory +to determine whether cdr should not be excluded." + :type '(choice (repeat :tag "Ignored file" string) + (const :tag "No ignored files" nil)) :group 'grep) (defcustom grep-error-screen-columns nil @@ -421,7 +436,7 @@ This variable's value takes effect when `grep-compute-defaults' is called.") ;; History of lgrep and rgrep regexp and files args. (defvar grep-regexp-history nil) -(defvar grep-files-history '("ch" "el")) +(defvar grep-files-history nil) ;;;###autoload (defun grep-process-setup () @@ -458,10 +473,11 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (run-hooks 'grep-setup-hook)) (defun grep-probe (command args &optional func result) - (equal (condition-case nil - (apply (or func 'process-file) command args) - (error nil)) - (or result 0))) + (let (process-file-side-effects) + (equal (condition-case nil + (apply (or func 'process-file) command args) + (error nil)) + (or result 0)))) ;;;###autoload (defun grep-compute-defaults () @@ -523,7 +539,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (format "%s %s " grep-program grep-options))) (unless grep-template (setq grep-template - (format "%s <C> %s <R> <F>" grep-program grep-options))) + (format "%s <X> <C> %s <R> <F>" grep-program grep-options))) (unless grep-find-use-xargs (setq grep-find-use-xargs (cond @@ -747,24 +763,29 @@ substitution string. Note dynamic scoping of variables.") (defun grep-read-files (regexp) "Read files arg for interactive grep." - (let* ((bn (or (buffer-file-name) (buffer-name))) + (let* ((bn (or (buffer-file-name) + (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))) (fn (and bn (stringp bn) (file-name-nondirectory bn))) + (default-alias + (and fn + (let ((aliases grep-files-aliases) + alias) + (while aliases + (setq alias (car aliases) + aliases (cdr aliases)) + (if (string-match (wildcard-to-regexp (cdr alias)) fn) + (setq aliases nil) + (setq alias nil))) + (cdr alias)))) + (default-extension + (and fn + (let ((ext (file-name-extension fn))) + (and ext (concat "*." ext))))) (default - (or (and fn - (let ((aliases grep-files-aliases) - alias) - (while aliases - (setq alias (car aliases) - aliases (cdr aliases)) - (if (string-match (wildcard-to-regexp (cdr alias)) fn) - (setq aliases nil) - (setq alias nil))) - (cdr alias))) - (and fn - (let ((ext (file-name-extension fn))) - (and ext (concat "*." ext)))) + (or default-alias + default-extension (car grep-files-history) (car (car grep-files-aliases)))) (files (read-string @@ -772,13 +793,16 @@ substitution string. Note dynamic scoping of variables.") "\" in files" (if default (concat " (default " default ")")) ": ") - nil 'grep-files-history default))) + nil 'grep-files-history + (delete-dups + (delq nil (append (list default default-alias default-extension) + (mapcar 'car grep-files-aliases))))))) (and files (or (cdr (assoc files grep-files-aliases)) files)))) ;;;###autoload -(defun lgrep (regexp &optional files dir) +(defun lgrep (regexp &optional files dir confirm) "Run grep, searching for REGEXP in FILES in directory DIR. The search is limited to file names matching shell pattern FILES. FILES may use abbreviations defined in `grep-files-aliases', e.g. @@ -800,17 +824,18 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (cond ((and grep-command (equal current-prefix-arg '(16))) (list (read-from-minibuffer "Run: " grep-command - nil nil 'grep-history) - nil)) + nil nil 'grep-history))) ((not grep-template) - (list nil - (read-string "grep.el: No `grep-template' available. Press RET."))) + (error "grep.el: No `grep-template' available")) (t (let* ((regexp (grep-read-regexp)) (files (grep-read-files regexp)) (dir (read-directory-name "In directory: " - nil default-directory t))) - (list regexp files dir)))))) + nil default-directory t)) + (confirm (equal current-prefix-arg '(4)))) + (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) + (unless (and dir (file-directory-p dir) (file-readable-p dir)) + (setq dir default-directory)) (let ((command regexp)) (if (null files) (if (string= command grep-command) @@ -819,15 +844,28 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (setq command (grep-expand-template grep-template regexp - files)) + files + nil + (and grep-find-ignored-files + (concat " --exclude=" + (mapconcat + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument ignore)) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (cdr ignore)))))) + grep-find-ignored-files + " --exclude="))))) (when command - (if (equal current-prefix-arg '(4)) + (if confirm (setq command (read-from-minibuffer "Confirm: " command nil nil 'grep-history)) (add-to-history 'grep-history command)))) (when command - (let ((default-directory (or dir default-directory))) + (let ((default-directory dir)) ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. (compilation-start (if (and grep-use-null-device null-device) @@ -841,7 +879,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (defvar find-name-arg) ; autoloaded ;;;###autoload -(defun rgrep (regexp &optional files dir) +(defun rgrep (regexp &optional files dir confirm) "Recursively grep for REGEXP in FILES in directory tree rooted at DIR. The search is limited to file names matching shell pattern FILES. FILES may use abbreviations defined in `grep-files-aliases', e.g. @@ -863,17 +901,18 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]." (cond ((and grep-find-command (equal current-prefix-arg '(16))) (list (read-from-minibuffer "Run: " grep-find-command - nil nil 'grep-find-history) - nil)) + nil nil 'grep-find-history))) ((not grep-find-template) - (list nil nil - (read-string "grep.el: No `grep-find-template' available. Press RET."))) + (error "grep.el: No `grep-find-template' available")) (t (let* ((regexp (grep-read-regexp)) (files (grep-read-files regexp)) (dir (read-directory-name "Base directory: " - nil default-directory t))) - (list regexp files dir)))))) + nil default-directory t)) + (confirm (equal current-prefix-arg '(4)))) + (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) + (unless (and dir (file-directory-p dir) (file-readable-p dir)) + (setq dir default-directory)) (if (null files) (if (not (string= regexp grep-find-command)) (compilation-start regexp 'grep-mode)) @@ -888,28 +927,46 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]." (concat " -o " find-name-arg " ")) " " (shell-quote-argument ")")) - dir + dir + (concat (and grep-find-ignored-directories (concat (shell-quote-argument "(") ;; we should use shell-quote-argument here " -path " (mapconcat - #'(lambda (ignore) - (cond ((stringp ignore) - (shell-quote-argument - (concat "*/" ignore))) - ((consp ignore) - (and (funcall (car ignore) dir) - (shell-quote-argument - (concat "*/" - (cdr ignore))))))) - grep-find-ignored-directories - " -o -path ") + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument + (concat "*/" ignore))) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (concat "*/" + (cdr ignore))))))) + grep-find-ignored-directories + " -o -path ") + " " + (shell-quote-argument ")") + " -prune -o ")) + (and grep-find-ignored-files + (concat (shell-quote-argument "(") + ;; we should use shell-quote-argument here + " -name " + (mapconcat + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument ignore)) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (cdr ignore)))))) + grep-find-ignored-files + " -o -name ") " " (shell-quote-argument ")") - " -prune -o "))))) + " -prune -o ")))))) (when command - (if current-prefix-arg + (if confirm (setq command (read-from-minibuffer "Confirm: " command nil nil 'grep-find-history)) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 4b77f4a1ff5..49637f9b970 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1,12 +1,12 @@ ;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> ;; Maintainer: FSF ;; Keywords: unix, tools -;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -438,8 +438,8 @@ The value t means that there is no stack, and we are in display-file mode.") (defun gud-speedbar-item-info () "Display the data type of the watch expression element." (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) - (if (nth 6 var) - (speedbar-message "%s: %s" (nth 6 var) (nth 3 var)) + (if (nth 7 var) + (speedbar-message "%s: %s" (nth 7 var) (nth 3 var)) (speedbar-message "%s" (nth 3 var))))) (defun gud-install-speedbar-variables () @@ -517,7 +517,8 @@ required by the caller." (let* (char (depth 0) (start 0) (var (car var-list)) (varnum (car var)) (expr (nth 1 var)) (type (if (nth 3 var) (nth 3 var) " ")) - (value (nth 4 var)) (status (nth 5 var))) + (value (nth 4 var)) (status (nth 5 var)) + (has-more (nth 6 var))) (put-text-property 0 (length expr) 'face font-lock-variable-name-face expr) (put-text-property @@ -526,9 +527,10 @@ required by the caller." (setq depth (1+ depth) start (1+ (match-beginning 0)))) (if (eq depth 0) (setq parent nil)) - (if (or (equal (nth 2 var) "0") - (and (equal (nth 2 var) "1") - (string-match "char \\*$" type))) + (if (and (or (not has-more) (string-equal has-more "0")) + (or (equal (nth 2 var) "0") + (and (equal (nth 2 var) "1") + (string-match "char \\*$" type)) )) (speedbar-make-tag-line 'bracket ?? nil nil (concat expr "\t" value) @@ -2715,7 +2717,8 @@ Obeying it means displaying in another window the specified file and line." (setq gud-keep-buffer t))) (save-restriction (widen) - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) (setq pos (point)) (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) @@ -3410,7 +3413,8 @@ With arg, dereference expr if ARG is positive, otherwise do not derereference." (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." (case gud-minor-mode - ((dbx gdbmi) (concat "print " expr)) + (gdbmi (concat "-data-evaluate-expression " expr)) + (dbx (concat "print " expr)) ((xdb pdb) (concat "p " expr)) (sdb (concat expr "/")))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 80bd91d4dd5..5928d18e46f 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -371,7 +371,7 @@ Use the command `hs-minor-mode' to toggle or set this variable.") ["Toggle Hiding" hs-toggle-hiding :help "Toggle the hiding state of the current block"] "----" - ["Hide comments when hiding all" + ["Hide comments when hiding all" (setq hs-hide-comments-when-hiding-all (not hs-hide-comments-when-hiding-all)) :help "If t also hide comment blocks when doing `hs-hide-all'" @@ -869,8 +869,8 @@ See documentation for functions `hs-hide-block' and `run-hooks'." q (progn (hs-forward-sexp (match-data t) 1) (point))))) (when (and p q) (hs-discard-overlays p q) - (goto-char (if end q (1+ p))))) - (run-hooks 'hs-show-hook)))) + (goto-char (if end q (1+ p)))))) + (run-hooks 'hs-show-hook))) (defun hs-hide-level (arg) "Hide all blocks ARG levels below this block. @@ -919,7 +919,7 @@ This can be useful if you have huge RCS logs in those comments." ;;;###autoload (define-minor-mode hs-minor-mode - "Minor mode to selectively hide/show code and comment blocks. + "Minor mode to selectively hide/show code and comment blocks. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The value '(hs . t) is added to `buffer-invisibility-spec'. @@ -935,7 +935,7 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. Key bindings: \\{hs-minor-mode-map}" - :group 'hideshow + :group 'hideshow :lighter " hs" :keymap hs-minor-mode-map (setq hs-headline nil) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 9500dfc8bf3..dffec272b6c 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -359,7 +359,7 @@ Here are all keybindings. (message "Cannot locate IDL Assistant, enabling default browser.") (setq idlwave-help-use-assistant nil) (unless idlwave-help-browse-url-available - (error "browse-url is not available; install it or IDL Assistant to use HTML help."))))) + (error "browse-url is not available; install it or IDL Assistant to use HTML help"))))) (defvar idlwave-current-obj_new-class) @@ -828,7 +828,7 @@ see if a link is set for it. Try extra help functions if necessary." ;; Just a regular file name (+ anchor name) (unless (and (stringp help-loc) (file-directory-p help-loc)) - (error "Invalid help location.")) + (error "Invalid help location")) (setq full-link (browse-url-file-url (expand-file-name link help-loc))) ;; Select the browser @@ -1320,7 +1320,7 @@ IDL assistant.") (if (string-match "\.html" link) (setq topic (substring link 0 (match-beginning 0)) anchor (substring link (match-end 0))) - (error "Malformed help link.")) + (error "Malformed help link")) (setq file (expand-file-name (concat topic ".html") help-loc)) (if (file-exists-p file) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index a57fba4e822..ee4fb984f9a 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1,7 +1,7 @@ ;; idlw-shell.el --- run IDL as an inferior process of Emacs. -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -;; Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Authors: J.D. Smith <jdsmith@as.arizona.edu> ;; Carsten Dominik <dominik@astro.uva.nl> @@ -241,13 +241,13 @@ to set this option to nil." (defcustom idlwave-shell-file-name-chars "~/A-Za-z0-9+:_.$#%={}\\- " "The characters allowed in file names, as a string. -Used for file name completion. Must not contain `'', `,' and `\"' +Used for file name completion. Must not contain `'', `,' and `\"' because these are used as separators by IDL." :group 'idlwave-shell-general-setup :type 'string) (defcustom idlwave-shell-mode-hook '() - "*Hook for customising `idlwave-shell-mode'." + "*Hook for customizing `idlwave-shell-mode'." :group 'idlwave-shell-general-setup :type 'hook) @@ -339,7 +339,7 @@ expression being examined." "*OBSOLETE VARIABLE, is no longer used.") (defcustom idlwave-shell-separate-examine-output t - "*Non-nil mean, put output of examine commands in their own buffer." + "*Non-nil means, put output of examine commands in their own buffer." :group 'idlwave-shell-command-setup :type 'boolean) @@ -444,7 +444,7 @@ popup help text on the line." ;; Breakpoint Overlays etc (defgroup idlwave-shell-highlighting-and-faces nil - "Highlighting and Faces used by the IDLWAVE Shell mode." + "Highlighting and faces used by the IDLWAVE Shell mode." :prefix "idlwave-shell" :group 'idlwave) @@ -521,7 +521,7 @@ t Glyph when possible, otherwise face (same effect as 'glyph)." (const :tag "Glyph or face." t))) (defvar idlwave-shell-use-breakpoint-glyph t - "Obsolete variable. See `idlwave-shell-mark-breakpoints.") + "Obsolete variable. See `idlwave-shell-mark-breakpoints'.") (defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp "*The face for breakpoint lines in the source code. @@ -640,7 +640,7 @@ the directory stack.") "The command which gets !PATH and !DIR info from the shell.") (defvar idlwave-shell-mode-line-info nil - "Additional info displayed in the mode line") + "Additional info displayed in the mode line.") (defvar idlwave-shell-default-directory nil "The default directory in the idlwave-shell buffer, of outside use.") @@ -722,7 +722,7 @@ the directory stack.") (defvar idlwave-shell-bp-query "help,/breakpoints" - "Command to obtain list of breakpoints") + "Command to obtain list of breakpoints.") (defvar idlwave-shell-command-output nil "String for accumulating current command output.") @@ -733,11 +733,10 @@ The current command is finished when the IDL prompt is displayed. This is evaluated if it is a list or called with funcall.") (defvar idlwave-shell-sentinel-hook nil - "Hook run when the idl process exits.") + "Hook run when the IDL process exits.") (defvar idlwave-shell-hide-output nil - "If non-nil the process output is not inserted into the output -buffer.") + "If non-nil the process output is not inserted into the output buffer.") (defvar idlwave-shell-show-if-error nil "If non-nil the process output is inserted into the output buffer if @@ -754,12 +753,12 @@ it contains an error message, even if hide-output is non-nil.") "List of commands to be sent to IDL. Each element of the list is list of \(CMD PCMD HIDE\), where CMD is a string to be sent to IDL and PCMD is a post-command to be placed on -`idlwave-shell-post-command-hook'. If HIDE is non-nil, hide the output -from command CMD. PCMD and HIDE are optional.") +`idlwave-shell-post-command-hook'. If HIDE is non-nil, hide the output +from command CMD. PCMD and HIDE are optional.") (defun idlwave-shell-buffer () "Name of buffer associated with IDL process. -The name of the buffer is made by surrounding `idlwave-shell-process-name +The name of the buffer is made by surrounding `idlwave-shell-process-name' with `*'s." (concat "*" idlwave-shell-process-name "*")) @@ -792,7 +791,7 @@ IDL is currently stopped.") (defconst idlwave-shell-halt-messages-re (mapconcat 'identity idlwave-shell-halt-messages "\\|") - "The regular expression computed from idlwave-shell-halt-messages") + "The regular expression computed from `idlwave-shell-halt-messages'.") (defconst idlwave-shell-trace-message-re "^% At " ;; First line of a trace message @@ -873,8 +872,8 @@ IDL has currently stepped.") ----------------- RET after the end of the process' output sends the text from the end of process to the end of the current line. RET before end of - process output copies the current line (except for the prompt) to the - end of the buffer. + process output copies the current line (except for the prompt) to + the end of the buffer. Command history, searching of previous commands, command line editing are available via the comint-mode key bindings, by default @@ -1126,9 +1125,9 @@ IDL has currently stepped.") (fset 'idl-shell 'idlwave-shell)) (defvar idlwave-shell-idl-wframe nil - "Frame for displaying the idl shell window.") + "Frame for displaying the IDL shell window.") (defvar idlwave-shell-display-wframe nil - "Frame for displaying the idl source files.") + "Frame for displaying the IDL source files.") (defvar idlwave-shell-calling-stack-index 0) (defvar idlwave-shell-calling-stack-routine nil) @@ -1271,9 +1270,9 @@ Return either nil or 'hide." show-if-error) "Send a command to IDL process. -\(CMD PCMD HIDE\) are placed at the end of ` -idlwave-shell-pending-commands'. If IDL is ready the first command, -CMD, in `idlwave-shell-pending-commands' is sent to the IDL process. +\(CMD PCMD HIDE\) are placed at the end of `idlwave-shell-pending-commands'. +If IDL is ready the first command in `idlwave-shell-pending-commands', +CMD, is sent to the IDL process. If optional second argument PCMD is non-nil it will be placed on `idlwave-shell-post-command-hook' when CMD is executed. @@ -1287,7 +1286,7 @@ stepping through code with output. If optional fourth argument PREEMPT is non-nil CMD is put at front of `idlwave-shell-pending-commands'. If PREEMPT is 'wait, wait for all output to complete and the next prompt to arrive before returning -\(useful if you need an answer now\). IDL is considered ready if the +\(useful if you need an answer now\). IDL is considered ready if the prompt is present and if `idlwave-shell-ready' is non-nil. If SHOW-IF-ERROR is non-nil, show the output if it contains an error @@ -1609,7 +1608,7 @@ and then calls `idlwave-shell-send-command' for any pending commands." idlwave-shell-post-command-hook nil idlwave-shell-hide-output nil idlwave-shell-show-if-error nil)) - ;; Done with post command. Do pending command if + ;; Done with post command. Do pending command if ;; any. (idlwave-shell-send-command))) (store-match-data data))))) @@ -1654,7 +1653,7 @@ and then calls `idlwave-shell-send-command' for any pending commands." (defvar idlwave-shell-syntax-error "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" "A regular expression to match an IDL syntax error. -The 1st pair matches the file name, the second pair matches the line +The first pair matches the file name, the second pair matches the line number.") (defvar idlwave-shell-other-error @@ -1697,13 +1696,14 @@ in IDL5 which inserts random linebreaks in long module and file names.") (defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode (defun idlwave-shell-scan-for-state () - "Scan for state info. Looks for messages in output from last IDL -command indicating where IDL has stopped. The types of messages we are -interested in are execution halted, stepped, breakpoint, interrupted -at and trace messages. For breakpoint messages process any attached -count or command parameters. Update the stop line if a message is -found. The variable `idlwave-shell-current-state' is set to 'error, -'halt, or 'breakpoint, which describes the status, or nil for none of + "Scan for state info. +Looks for messages in output from last IDL command indicating where +IDL has stopped. The types of messages we are interested in are +execution halted, stepped, breakpoint, interrupted at and trace +messages. For breakpoint messages process any attached count or +command parameters. Update the stop line if a message is found. +The variable `idlwave-shell-current-state' is set to 'error, 'halt, +or 'breakpoint, which describes the status, or nil for none of the above." (let (trace) (cond @@ -1936,7 +1936,7 @@ Also get rid of widget events in the queue." (idlwave-shell-hide-p 'misc) nil t)) (defun idlwave-shell-quit (&optional arg) - "Exit the idl process after confirmation. + "Exit the IDL process after confirmation. With prefix ARG, exit without confirmation." (interactive "P") (if (not (idlwave-shell-is-running)) @@ -2222,7 +2222,7 @@ args of an executive .run, .rnew or .compile." (memq (preceding-char) '(?\' ?\"))))) (defun idlwave-shell-batch-command () - "Returns t if we're in a batch command statement like @foo" + "Return t if we're in a batch command statement like @foo" (let ((limit (save-excursion (beginning-of-line) (point)))) (save-excursion ;; Skip backwards over filename @@ -2231,7 +2231,7 @@ args of an executive .run, .rnew or .compile." (and (eq (preceding-char) ?@) (not (idlwave-in-quote)))))) (defun idlwave-shell-shell-command () - "Returns t if we're in a shell command statement like $ls" + "Return t if we're in a shell command statement like $ls" (save-excursion (idlwave-beginning-of-statement) (looking-at "\\$"))) @@ -2239,7 +2239,7 @@ args of an executive .run, .rnew or .compile." ;; Debugging Commands ------------------------------------------------------ (defun idlwave-shell-redisplay (&optional hide) - "Tries to resync the display with where execution has stopped. + "Try to resync the display with where execution has stopped. Issues a \"help,/trace\" command followed by a call to `idlwave-shell-display-line'. Also updates the breakpoint overlays." @@ -2309,18 +2309,19 @@ overlays." (defun idlwave-shell-goto-frame (&optional frame) "Set buffer to FRAME with point at the frame line. -If the optional argument FRAME is nil then idlwave-shell-pc-frame is -used. Does nothing if the resulting frame is nil." +If the optional argument FRAME is nil then `idlwave-shell-pc-frame' +is used. Does nothing if the resulting frame is nil." (if frame () (setq frame (idlwave-shell-pc-frame))) (cond (frame (set-buffer (idlwave-find-file-noselect (car frame) 'shell)) (widen) - (goto-line (nth 1 frame))))) + (goto-char (point-min)) + (forward-line (1- (nth 1 frame)))))) (defun idlwave-shell-pc-frame () - "Returns the frame for IDL execution." + "Return the frame for IDL execution." (and idlwave-shell-halt-frame (list (nth 0 idlwave-shell-halt-frame) (nth 1 idlwave-shell-halt-frame) @@ -2340,13 +2341,13 @@ used. Does nothing if the resulting frame is nil." (defvar idlwave-shell-suppress-electric-debug nil) (defun idlwave-shell-display-line (frame &optional col debug) - "display frame file in other window with overlay arrow. + "Display frame file in other window with overlay arrow. -frame is a list of file name, line number, and subroutine name. if -frame is nil then remove overlay. if col is set, move point to that -column in the line. if debug is non-nil, enable the electric debug -mode. if it is 'disable, do not enable no matter what the setting of -'idlwave-shell-automatic-electric-debug'. if it is 'force, enable no +FRAME is a list of file name, line number, and subroutine name. If +FRAME is nil then remove overlay. If COL is set, move point to that +column in the line. If DEBUG is non-nil, enable the electric debug +mode. If it is 'disable, do not enable no matter what the setting of +`idlwave-shell-automatic-electric-debug'. If it is 'force, enable no matter what the settings of that variable." (if (not frame) ;; remove stop-line overlay from old position @@ -2388,8 +2389,8 @@ matter what the settings of that variable." (set-buffer buffer) (save-restriction (widen) - (goto-line (nth 1 frame)) - (forward-line 0) + (goto-char (point-min)) + (forward-line (1- (nth 1 frame))) (setq pos (point)) (setq idlwave-shell-is-stopped t) @@ -2448,7 +2449,8 @@ matter what the settings of that variable." (defun idlwave-shell-step (arg) - "Step one source line. If given prefix argument ARG, step ARG source lines." + "Step one source line. +If given prefix argument ARG, step ARG source lines." (interactive "p") (or (not arg) (< arg 1) (setq arg 1)) @@ -2473,14 +2475,14 @@ Uses IDL's stepover executive command which does not enter called functions." no-show) "Set breakpoint at current line. -If Count is nil then an ordinary breakpoint is set. We treat a count +If COUNT is nil then an ordinary breakpoint is set. We treat a COUNT of 1 as a temporary breakpoint using the ONCE keyword. Counts greater than 1 use the IDL AFTER=count keyword to break only after reaching -the statement count times. +the statement COUNT times. Optional argument CMD is a list or function to evaluate upon reaching the breakpoint. CONDITION is a break condition, and DISABLED, if -non-nil disables the breakpoint" +non-nil disables the breakpoint." (interactive "P") (when (listp count) (if (equal (car count) 4) @@ -2615,8 +2617,8 @@ Returns nil if unable to obtain a module name." (defun idlwave-shell-clear-current-bp () "Remove breakpoint at current line. -This command can be called from the shell buffer if IDL is currently stopped -at a breakpoint." +This command can be called from the shell buffer if IDL is currently +stopped at a breakpoint." (interactive) (let ((bp (idlwave-shell-find-current-bp))) (if bp (idlwave-shell-clear-bp bp)))) @@ -2691,8 +2693,8 @@ in the current routine." (defun idlwave-shell-set-bp-in-module (name type class) - "Set breakpoint in module. Assumes that `idlwave-shell-sources-alist' -contains an entry for that module." + "Set breakpoint in module. +Assumes that `idlwave-shell-sources-alist' contains an entry for that module." (let* ((module (idlwave-make-full-name class name)) (source-file (car-safe (cdr-safe @@ -2789,7 +2791,8 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (or (not bp-line) (funcall closer-func cur-line bp-line))) (setq bp-line cur-line)))) (unless bp-line (error "No further breakpoints")) - (goto-line bp-line))) + (goto-char (point-min)) + (forward-line (1- bp-line)))) ;; Examine Commands ------------------------------------------------------ @@ -2837,17 +2840,17 @@ Runs to the last statement and then steps 1 statement. Use the .out command." ;;; End terrible hack section (defun idlwave-shell-mouse-print (event) - "Print value of variable at the mouse position, with `help'" + "Print value of variable at the mouse position, with `print'." (interactive "e") (funcall (idlwave-shell-mouse-examine nil) event)) (defun idlwave-shell-mouse-help (event) - "Print value of variable at the mouse position, with `print'." + "Print value of variable at the mouse position, with `help'." (interactive "e") (funcall (idlwave-shell-mouse-examine 'help) event)) (defun idlwave-shell-examine-select (event) - "Pop-up a list to select from for examining the expression" + "Pop-up a list to select from for examining the expression." (interactive "e") (funcall (idlwave-shell-mouse-examine nil event) event)) @@ -2878,7 +2881,7 @@ An expression is an identifier plus 1 pair of matched parentheses directly following the identifier - an array or function call. Alternatively, an expression is the contents of any matched parentheses when the open parenthesis is not directly preceded by an -identifier. If point is at the beginning or within an expression +identifier. If point is at the beginning or within an expression return the inner-most containing expression, otherwise, return the preceding expression. @@ -2888,9 +2891,9 @@ use the current region as the expression. With double prefix arg ARG prompt for an expression. If EV is a valid event passed, pop-up a list from -idlw-shell-examine-alist from which to select the help command text. -If instead COMPLETE-HELP-TYPE is non-nil, choose from -idlw-shell-examine-alist via mini-buffer shortcut key." +`idlwave-shell-examine-alist' from which to select the help +command text. If instead COMPLETE-HELP-TYPE is non-nil, choose +from `idlwave-shell-examine-alist' via mini-buffer shortcut key." (interactive "P") ;; For speed: assume the helper routine hasn't been lost, e.g. with @@ -3269,7 +3272,7 @@ Remaining elements of the cdr: data - Data associated with the breakpoint by idlwave-shell currently contains four items: -count - number of times to execute breakpoint. When count reaches 0 +count - number of times to execute breakpoint. When count reaches 0 the breakpoint is cleared and removed from the alist. command - command to execute when breakpoint is reached, either a @@ -3278,16 +3281,16 @@ command - command to execute when breakpoint is reached, either a condition - any condition to apply to the breakpoint. -disabled - whether the bp is disabled") +disabled - whether the bp is disabled.") (defun idlwave-shell-run-region (beg end &optional n) "Compile and run the region using the IDL process. Copies the region to a temporary file `idlwave-shell-temp-pro-file' -and issues the IDL .run command for the file. Because the -region is compiled and run as a main program there is no -problem with begin-end blocks extending over multiple -lines - which would be a problem if `idlwave-shell-evaluate-region' -was used. An END statement is appended to the region if necessary. +and issues the IDL .run command for the file. Because the region +is compiled and run as a main program there is no problem with +begin-end blocks extending over multiple lines - which would be +a problem if `idlwave-shell-evaluate-region' was used. +An END statement is appended to the region if necessary. If there is a prefix argument, display IDL process." (interactive "r\nP") @@ -3376,12 +3379,12 @@ Queries IDL using the string in `idlwave-shell-bp-query'." 'hide)) (defun idlwave-shell-bp-get (bp &optional item) - "Get a value for a breakpoint. BP has the form of elements in -idlwave-shell-bp-alist. Optional second arg ITEM is the -particular value to retrieve. ITEM can be 'file, 'line, 'index, -'module, 'count, 'cmd, 'condition, 'disabled, 'type, or -'data. 'data returns a list of 'count, 'cmd and 'condition. -Defaults to 'index." + "Get a value for a breakpoint. +BP has the form of elements in `idlwave-shell-bp-alist'. +Optional second arg ITEM is the particular value to retrieve. +ITEM can be 'file, 'line, 'index, 'module, 'count, 'cmd, +'condition, 'disabled, 'type, or 'data. 'data returns a list +of 'count, 'cmd and 'condition. Defaults to 'index." (cond ;; Frame ((eq item 'line) (nth 1 (car bp))) @@ -3403,10 +3406,10 @@ Defaults to 'index." (t (nth 0 (car (cdr bp)))))) (defun idlwave-shell-filter-bp (&optional no-show) - "Get the breakpoints from `idlwave-shell-command-output'. Create -`idlwave-shell-bp-alist' updating breakpoint count and command data -from previous breakpoint list. If NO-SHOW is set, don't update the -breakpoint overlays." + "Get the breakpoints from `idlwave-shell-command-output'. +Create `idlwave-shell-bp-alist' updating breakpoint count and command +data from previous breakpoint list. If NO-SHOW is set, don't update +the breakpoint overlays." (save-excursion (set-buffer (get-buffer-create idlwave-shell-bp-buffer)) (erase-buffer) @@ -3487,10 +3490,11 @@ If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data." (setcdr (cdr bp) data)) (defun idlwave-shell-bp (frame &optional data module) - "Create a breakpoint structure containing FRAME and DATA. Second -and third args, DATA and MODULE, are optional. Returns a breakpoint -of the format used in `idlwave-shell-bp-alist'. Can be used in commands -attempting match a breakpoint in `idlwave-shell-bp-alist'." + "Create a breakpoint structure containing FRAME and DATA. +Second and third args, DATA and MODULE, are optional. Returns +a breakpoint of the format used in `idlwave-shell-bp-alist'. +Can be used in commands attempting match a breakpoint in +`idlwave-shell-bp-alist'." (cons frame ;; (file line) (cons (list nil module) ;; (index_id (module type) | module) data))) ;; (count command condition disabled) @@ -3501,7 +3505,7 @@ attempting match a breakpoint in `idlwave-shell-bp-alist'." (defun idlwave-shell-sources-bp (bp) "Check `idlwave-shell-sources-alist' for source of breakpoint using BP. If an equivalency is found, return the IDL internal source name. -Otherwise return the filename in bp." +Otherwise return the filename in BP." (let* ((bp-file (idlwave-shell-bp-get bp 'file)) (bp-module (idlwave-shell-bp-get bp 'module)) @@ -3619,7 +3623,7 @@ considered the new breakpoint if the file name of frame matches." (message "Failed to identify breakpoint in IDL")))) (defvar idlwave-shell-bp-overlays nil - "Alist of overlays marking breakpoints") + "Alist of overlays marking breakpoints.") (defvar idlwave-shell-bp-glyph) (defvar idlwave-shell-debug-line-map (make-sparse-keymap)) @@ -3950,7 +3954,7 @@ handled by this command." "Alist of IDL procedure names and compiled source files. Elements of the alist have the form: - (module name . (source-file-truename idlwave-internal-filename)).") + (module name . (source-file-truename idlwave-internal-filename))") (defun idlwave-shell-module-source-query (module &optional type) "Determine the source file for a given module. @@ -3963,7 +3967,7 @@ Query as a function if TYPE set to something beside 'pro." 'hide 'wait))) (defun idlwave-shell-module-source-filter (module) - "Get module source, and update idlwave-shell-sources-alist." + "Get module source, and update `idlwave-shell-sources-alist'." (let ((old (assoc (upcase module) idlwave-shell-sources-alist)) filename) (when (string-match "\.PATH *[\n\r]\\([^%][^\r\n]+\\)[\n\r]" @@ -3988,9 +3992,9 @@ Queries IDL using the string in `idlwave-shell-sources-query'." (defun idlwave-shell-sources-filter () "Get source files from `idlwave-shell-sources-query' output. -Create `idlwave-shell-sources-alist' consisting of -list elements of the form: - (module name . (source-file-truename idlwave-internal-filename))." +Create `idlwave-shell-sources-alist' consisting of list elements +of the form: + (module name . (source-file-truename idlwave-internal-filename))" (save-excursion (set-buffer (get-buffer-create idlwave-shell-bp-buffer)) (erase-buffer) @@ -4106,7 +4110,7 @@ Otherwise, just expand the file name." ;; Keybindings ------------------------------------------------------------ (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map) - "Keymap for idlwave-mode.") + "Keymap for `idlwave-mode'.") (defvar idlwave-shell-electric-debug-mode-map (make-sparse-keymap)) (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap)) (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map) @@ -4343,7 +4347,7 @@ idlwave-shell-electric-debug-mode-map) ;; easy-mmode defines electric-debug-mode for us, so we need to advise it. (defadvice idlwave-shell-electric-debug-mode (after print-enter activate) - "Print out an entrance message" + "Print out an entrance message." (when idlwave-shell-electric-debug-mode (message "Electric Debugging mode entered. Press [C-?] for help, [q] to quit")) @@ -4693,9 +4697,9 @@ static char * file[] = { ;;; Load the toolbar when wanted by the user. (autoload 'idlwave-toolbar-toggle "idlw-toolbar" - "Toggle the IDLWAVE toolbar") + "Toggle the IDLWAVE toolbar.") (autoload 'idlwave-toolbar-add-everywhere "idlw-toolbar" - "Add IDLWAVE toolbar") + "Add IDLWAVE toolbar.") (defun idlwave-shell-toggle-toolbar () "Toggle the display of the debugging toolbar." (interactive) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 266b46d0f3b..4f29d3c7079 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -237,8 +237,8 @@ this variable." :type 'integer) (defcustom idlwave-indent-to-open-paren t - "*Non-nil means, indent continuation lines to innermost open -parenthesis. This indentation occurs even if otherwise disallowed by + "*Non-nil means, indent continuation lines to innermost open parenthesis. +This indentation occurs even if otherwise disallowed by `idlwave-max-extra-continuation-indent'. Matching parens and the interleaving args are lined up. Example: @@ -249,15 +249,15 @@ interleaving args are lined up. Example: ))) When this variable is nil, paren alignment may still occur, based on -the value of `max-extra-continuation-indent', which, if zero, would -yield: +the value of `idlwave-max-extra-continuation-indent', which, if zero, +would yield: x = function_a(function_b(function_c( a, b, [1,2,3, $ 4,5,6 $ ], $ c, d $ )))" - :group 'idlwave-code-formatting + :group 'idlwave-code-formatting :type 'boolean) (defcustom idlwave-indent-parens-nested nil @@ -276,7 +276,7 @@ of the paragraph." (defcustom idlwave-hang-indent-regexp "- " "*Regular expression matching the position of the hanging indent -in the first line of a comment paragraph. The size of the indent +in the first line of a comment paragraph. The size of the indent extends to the end of the match for the regular expression." :group 'idlwave-code-formatting :type 'regexp) @@ -312,7 +312,7 @@ split then a terminal beep and warning are issued." (defcustom idlwave-no-change-comment ";;;" "*The indentation of a comment that starts with this regular -expression will not be changed. Note that the indentation of a comment +expression will not be changed. Note that the indentation of a comment at the beginning of a line is never changed." :group 'idlwave-code-formatting :type 'string) @@ -348,26 +348,25 @@ the comment is not preceded by whitespace it is unchanged." These files, named .idlwave_catalog, document routine information for individual directories and libraries of IDL .pro files. Many popular -libraries come with catalog files by default, so leaving this on is a -usually a good idea.." +libraries come with catalog files by default, so leaving this on is +usually a good idea." :group 'idlwave-routine-info :type 'boolean) (defcustom idlwave-init-rinfo-when-idle-after 10 - "*Seconds of idle time before routine info is automatically -initialized. Initializing the routine info can take a long time, in -particular if a large number of library catalogs are involved. When -Emacs is idle for more than the number of seconds specified by this -variable, it starts the initialization. The process is split into -five steps, in order to keep work interruption as short as possible. -If one of the steps finishes, and no user input has arrived in the -mean time, initialization proceeds immediately to the next step. A -good value for this variable is about 1/3 of the time initialization -take in your setup. So if you have a fast machine and no problems -with a slow network connection, don't hesitate to set this to 2 -seconds. A Value of 0 means, don't initialize automatically, but -instead wait until routine information is needed, and initialize -then." + "*Seconds of idle time before routine info is automatically initialized. +Initializing the routine info can take a long time, in particular if a +large number of library catalogs are involved. When Emacs is idle for +more than the number of seconds specified by this variable, it starts +the initialization. The process is split into five steps, in order to +keep work interruption as short as possible. If one of the steps +finishes, and no user input has arrived in the mean time, initialization +proceeds immediately to the next step. A good value for this variable +is about 1/3 of the time initialization take in your setup. So if you +have a fast machine and no problems with a slow network connection, +don't hesitate to set this to 2 seconds. A value of 0 means, don't +initialize automatically, but instead wait until routine information is +needed, and initialize then." :group 'idlwave-routine-info :type 'number) @@ -377,7 +376,7 @@ The scanning is done by the command `idlwave-update-routine-info'. The following values are allowed: nil Don't scan any buffers. -t Scan all idlwave-mode buffers in the current editing session. +t Scan all `idlwave-mode' buffers in the current editing session. current Scan only the current buffer, but no other buffers." :group 'idlwave-routine-info :type '(choice @@ -399,7 +398,7 @@ scan, this is not necessary." Possible values: nil Never t All available -\(...) A list of circumstances. Allowed members are: +\(...) A list of circumstances. Allowed members are: find-file Add info for new IDLWAVE buffers. save-buffer Update buffer info when buffer is saved kill-buffer Remove buffer info when buffer gets killed @@ -417,7 +416,7 @@ t All available (defcustom idlwave-rinfo-max-source-lines 5 "*Maximum number of source files displayed in the Routine Info window. When an integer, it is the maximum number of source files displayed. -t means to show all source files." +A value of t means to show all source files." :group 'idlwave-routine-info :type 'integer) @@ -804,9 +803,9 @@ spaces are left unchanged." (defcustom idlwave-abbrev-move t "*Non-nil means the abbrev hook can move point. -Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev +Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev definitions, use the command `list-abbrevs', for abbrevs that move -point. Moving point is useful, for example, to place point between +point. Moving point is useful, for example, to place point between parentheses of expanded functions. See `idlwave-check-abbrev'." @@ -862,7 +861,7 @@ Has effect only if in abbrev-mode." (defvar idlwave-indent-action-table nil "*Associated array containing action lists of search string (car), -and function as a cdr. This table is used by `idlwave-indent-line'. +and function as a cdr. This table is used by `idlwave-indent-line'. See documentation for `idlwave-do-action' for a complete description of the action lists. @@ -872,8 +871,8 @@ See help on `idlwave-action-and-binding' for examples.") (defvar idlwave-indent-expand-table nil "*Associated array containing action lists of search string (car), -and function as a cdr. The table is used by the -`idlwave-indent-and-action' function. See documentation for +and function as a cdr. The table is used by the +`idlwave-indent-and-action' function. See documentation for `idlwave-do-action' for a complete description of the action lists. Additions to the table are made with `idlwave-action-and-binding' when a @@ -951,8 +950,8 @@ See help on `idlwave-action-and-binding' for examples.") ;- ") "*A list (PATHNAME STRING) specifying the doc-header template to use for -summarizing a file. If PATHNAME is non-nil then this file will be included. -Otherwise STRING is used. If nil, the file summary will be omitted. +summarizing a file. If PATHNAME is non-nil then this file will be included. +Otherwise STRING is used. If nil, the file summary will be omitted. For example you might set PATHNAME to the path for the lib_template.pro file included in the IDL distribution.") @@ -997,10 +996,10 @@ If nil it will not be inserted." "*If non-nil, this is the command to run IDL. Should be an absolute file path or path relative to the current environment execution search path. If you want to specify command line switches -for the idl program, use `idlwave-shell-command-line-options'. +for the IDL program, use `idlwave-shell-command-line-options'. I know the name of this variable is badly chosen, but I cannot change -it without compromizing backwards-compatibility." +it without compromising backwards-compatibility." :group 'idlwave-external-programs :type 'string) @@ -1042,7 +1041,7 @@ are `control', `meta', `super', `hyper', `alt', and `shift'." (const shift))) (defcustom idlwave-shell-automatic-start nil - "*If non-nil attempt invoke idlwave-shell if not already running. + "*If non-nil attempt invoke `idlwave-shell' if not already running. This is checked when an attempt to send a command to an IDL process is made." :group 'idlwave-shell-general-setup @@ -1066,8 +1065,8 @@ IDL process is made." "Items which should be fontified on the default fontification level 2. IDLWAVE defines 3 levels of fontification. Level 1 is very little, level 3 is everything and level 2 is specified by this list. -This variable must be set before IDLWAVE gets loaded. It is -a list of symbols, the following symbols are allowed. +This variable must be set before IDLWAVE gets loaded. +It is a list of symbols; the following symbols are allowed: pros-and-functions Procedure and Function definitions batch-files Batch Files @@ -1272,25 +1271,25 @@ only by whitespace.") (defconst idlwave-begin-block-reg "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" - "Regular expression to find the beginning of a block. The case does -not matter. The search skips matches in comments.") + "Regular expression to find the beginning of a block. +The case does not matter. The search skips matches in comments.") (defconst idlwave-begin-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\`" - "Regular expression to find the beginning of a unit. The case does -not matter.") + "Regular expression to find the beginning of a unit. +The case does not matter.") (defconst idlwave-end-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\'" "Regular expression to find the line that indicates the end of unit. -This line is the end of buffer or the start of another unit. The case does -not matter. The search skips matches in comments.") +This line is the end of buffer or the start of another unit. +The case does not matter. The search skips matches in comments.") (defconst idlwave-continue-line-reg "\\<\\$" "Regular expression to match a continued line.") (defconst idlwave-end-block-reg "\\<end\\(\\|case\\|switch\\|else\\|for\\|if\\|rep\\|while\\)\\>" - "Regular expression to find the end of a block. The case does -not matter. The search skips matches found in comments.") + "Regular expression to find the end of a block. +The case does not matter. The search skips matches in comments.") (defconst idlwave-block-matches '(("pro" . "end") @@ -1313,7 +1312,7 @@ to expand generic end statements to their detailed form.") "\\<\\(else\\|for\\|then\\|repeat\\|while\\)\\>" "Regular expression matching reserved words which can stand before blocks starting with a BEGIN statement. The matches must have associations -`idlwave-block-matches'") +`idlwave-block-matches'.") (defconst idlwave-identifier "[a-zA-Z_][a-zA-Z0-9$_]*" "Regular expression matching an IDL identifier.") @@ -1359,8 +1358,8 @@ blocks starting with a BEGIN statement. The matches must have associations "\\(" idlwave-variable "\\) *=") nil))) "Associated list of statement matching regular expressions. -Each regular expression matches the start of an IDL statement. The -first element of each association is a symbol giving the statement +Each regular expression matches the start of an IDL statement. +The first element of each association is a symbol giving the statement type. The associated value is a list. The first element of this list is a regular expression matching the start of an IDL statement for identifying the statement type. The second element of this list is a @@ -1369,7 +1368,7 @@ substatement starts after the end of the found match modulo whitespace. If it is nil then the statement has no substatement. The list order matters since matching an assignment statement exactly is not possible without parsing. Thus assignment statement become just -the leftover unidentified statements containing an equal sign." ) +the leftover unidentified statements containing an equal sign.") (defvar idlwave-fill-function 'auto-fill-function "IDL mode auto fill function.") @@ -1628,14 +1627,14 @@ Capitalize system variables - action only ;;; the abbrev). ;;; (defvar idlwave-mode-abbrev-table nil - "Abbreviation table used for IDLWAVE mode") + "Abbreviation table used for IDLWAVE mode.") (define-abbrev-table 'idlwave-mode-abbrev-table ()) (defun idlwave-define-abbrev (name expansion hook &optional noprefix table) "Define-abbrev with backward compatibility. If NOPREFIX is non-nil, don't prepend prefix character. Installs into -idlwave-mode-abbrev-table unless TABLE is non-nil." +`idlwave-mode-abbrev-table' unless TABLE is non-nil." (let ((abbrevs-changed nil) ;; mask the current value to avoid save (args (list (or table idlwave-mode-abbrev-table) (if noprefix name (concat idlwave-abbrev-start-char name)) @@ -1842,7 +1841,7 @@ The main features of this mode are 5. Code Templates and Abbreviations -------------------------------- Many Abbreviations are predefined to expand to code fragments and templates. - The abbreviations start generally with a `\\`. Some examples + The abbreviations start generally with a `\\`. Some examples: \\pr PROCEDURE template \\fu FUNCTION template @@ -2030,7 +2029,7 @@ The main features of this mode are ;; (defun idlwave-hard-tab () - "Inserts TAB in buffer in current position." + "Insert TAB in buffer in current position." (interactive) (insert "\t")) @@ -2058,7 +2057,7 @@ sets the variable to zero afterwards." ;; versatility. (defun idlwave-check-abbrev (arg &optional reserved) - "Reverses abbrev expansion if in comment or string. + "Reverse abbrev expansion if in comment or string. Argument ARG is the number of characters to move point backward if `idlwave-abbrev-move' is non-nil. If optional argument RESERVED is non-nil then the expansion @@ -2085,7 +2084,7 @@ Returns non-nil if abbrev is left expanded." t)) (defun idlwave-in-comment () - "Returns t if point is inside a comment, nil otherwise." + "Return t if point is inside a comment, nil otherwise." (save-excursion (let ((here (point))) (and (idlwave-goto-comment) (> here (point)))))) @@ -2142,8 +2141,8 @@ An END token must be preceded by whitespace." (idlwave-show-begin)))) (defun idlwave-show-begin () - "Finds the start of current block and blinks to it for a second. -Also checks if the correct end statement has been used." + "Find the start of current block and blinks to it for a second. +Also checks if the correct END statement has been used." ;; All end statements are reserved words ;; Re-indent end line ;;(insert-char ?\ 1) ;; So indent, etc. work well @@ -2229,7 +2228,7 @@ Also checks if the correct end statement has been used." (idlwave-show-begin))) (defun idlwave-custom-ampersand-surround (&optional is-action) - "Surround &, leaving room for && (which surrround as well)." + "Surround &, leaving room for && (which surround as well)." (let* ((prev-char (char-after (- (point) 2))) (next-char (char-after (point))) (amp-left (eq prev-char ?&)) @@ -2313,7 +2312,7 @@ nil - do nothing. )))) (defun idlwave-newline () - "Inserts a newline and indents the current and previous line." + "Insert a newline and indent the current and previous line." (interactive) ;; ;; Handle unterminated single and double quotes @@ -2363,7 +2362,7 @@ nil - do nothing. (defun idlwave-split-line () "Continue line by breaking line at point and indent the lines. -For a code line insert continuation marker. If the line is a line comment +For a code line insert continuation marker. If the line is a line comment then the new line will contain a comment with the same indentation. Splits strings with the IDL operator `+' if `idlwave-split-line-string' is non-nil." @@ -2402,13 +2401,13 @@ non-nil." (idlwave-indent-line))) (defun idlwave-beginning-of-subprogram (&optional nomark) - "Moves point to the beginning of the current program unit. + "Move point to the beginning of the current program unit. If NOMARK is non-nil, do not push mark." (interactive) (idlwave-find-key idlwave-begin-unit-reg -1 nomark)) (defun idlwave-end-of-subprogram (&optional nomark) - "Moves point to the start of the next program unit. + "Move point to the start of the next program unit. If NOMARK is non-nil, do not push mark." (interactive) (idlwave-end-of-statement) @@ -2552,7 +2551,7 @@ actual statement." (beginning-of-line))))) (defun idlwave-previous-statement () - "Moves point to beginning of the previous statement. + "Move point to beginning of the previous statement. Returns t if the current line before moving is the beginning of the first non-comment statement in the file, and nil otherwise." (interactive) @@ -2580,7 +2579,7 @@ the first non-comment statement in the file, and nil otherwise." first-statement))) (defun idlwave-end-of-statement () - "Moves point to the end of the current IDL statement. + "Move point to the end of the current IDL statement. If not in a statement just moves to end of line. Returns position." (interactive) (while (and (idlwave-is-continuation-line) @@ -2591,8 +2590,8 @@ If not in a statement just moves to end of line. Returns position." (point)) (defun idlwave-end-of-statement0 () - "Moves point to the end of the current IDL statement. -If not in a statement just moves to end of line. Returns position." + "Move point to the end of the current IDL statement. +If not in a statement just moves to end of line. Returns position." (interactive) (while (and (idlwave-is-continuation-line) (= (forward-line 1) 0))) @@ -2600,9 +2599,9 @@ If not in a statement just moves to end of line. Returns position." (point)) (defun idlwave-next-statement () - "Moves point to beginning of the next IDL statement. - Returns t if that statement is the last - non-comment IDL statement in the file, and nil otherwise." + "Move point to beginning of the next IDL statement. +Returns t if that statement is the last non-comment IDL statement +in the file, and nil otherwise." (interactive) (let (last-statement) (idlwave-end-of-statement) @@ -2692,9 +2691,9 @@ substatement." (defun idlwave-statement-type () "Return the type of the current IDL statement. Uses `idlwave-statement-match' to return a cons of (type . point) with -point the ending position where the type was determined. Type is the +point the ending position where the type was determined. Type is the association from `idlwave-statement-match', i.e. the cons cell from the -list not just the type symbol. Returns nil if not an identifiable +list not just the type symbol. Returns nil if not an identifiable statement." (save-excursion ;; Skip whitespace within a statement which is spaces, tabs, continuations @@ -2710,14 +2709,14 @@ statement." (append st (match-end 0)))))) (defun idlwave-expand-equal (&optional before after is-action) - "Pad '=' with spaces. Two cases: Assignment statement, and keyword -assignment. Which case is determined using -`idlwave-start-of-substatement' and `idlwave-statement-type'. The -equal sign will be surrounded by BEFORE and AFTER blanks. If -`idlwave-pad-keyword' is t then keyword assignment is treated just -like assignment statements. When nil, spaces are removed for keyword -assignment. Any other value keeps the current space around the `='. -Limits in for loops are treated as keyword assignment. + "Pad '=' with spaces. +Two cases: Assignment statement, and keyword assignment. +Which case is determined using `idlwave-start-of-substatement' and +`idlwave-statement-type'. The equal sign will be surrounded by BEFORE +and AFTER blanks. If `idlwave-pad-keyword' is t then keyword assignment +is treated just like assignment statements. When nil, spaces are +removed for keyword assignment. Any other value keeps the current space +around the `='. Limits in for loops are treated as keyword assignment. Starting with IDL 6.0, a number of op= assignments are available. Since ambiguities of the form: @@ -2793,7 +2792,7 @@ With prefix ARG non-nil, indent the entire sub-statement." (idlwave-indent-line t))) (defun idlwave-indent-line (&optional expand) - "Indents current IDL line as code or as a comment. + "Indent current IDL line as code or as a comment. The actions in `idlwave-indent-action-table' are performed. If the optional argument EXPAND is non-nil then the actions in `idlwave-indent-expand-table' are performed." @@ -2850,13 +2849,13 @@ If the optional argument EXPAND is non-nil then the actions in (set-marker mloc nil))) (defun idlwave-do-action (action) - "Perform an action repeatedly on a line. ACTION is a list (REG -. FUNC). REG is a regular expression. FUNC is either a function name -to be called with `funcall' or a list to be evaluated with `eval'. -The action performed by FUNC should leave point after the match for -REG - otherwise an infinite loop may be entered. FUNC is always -passed a final argument of 'is-action, so it can discriminate between -being run as an action, or a key binding" + "Perform an action repeatedly on a line. +ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is +either a function name to be called with `funcall' or a list to be +evaluated with `eval'. The action performed by FUNC should leave +point after the match for REG - otherwise an infinite loop may be +entered. FUNC is always passed a final argument of 'is-action, so it +can discriminate between being run as an action, or a key binding." (let ((action-key (car action)) (action-routine (cdr action))) (beginning-of-line) @@ -2882,7 +2881,7 @@ Inserts spaces before markers at point." (idlwave-indent-to col))) (defun idlwave-indent-subprogram () - "Indents program unit which contains point." + "Indent program unit which contains point." (interactive) (save-excursion (idlwave-end-of-statement) @@ -2961,7 +2960,7 @@ Inserts spaces before markers at point." (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) "Calculate the continuation indent inside a paren group. Returns a cons-cell with (open . indent), where open is the -location of the open paren" +location of the open paren." (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) ;; Found an innermost open paren. (when open @@ -2990,12 +2989,11 @@ location of the open paren" (current-column)))))))) (defun idlwave-calculate-cont-indent () - "Calculates the IDL continuation indent column from the previous -statement. Note that here previous statement usually means the -beginning of the current statement if this statement is a continuation -of the previous line. Various special types of continuations, -including assignments, routine definitions, and parenthetical -groupings, are treated separately." + "Calculates the IDL continuation indent column from the previous statement. +Note that here previous statement usually means the beginning of the +current statement if this statement is a continuation of the previous +line. Various special types of continuations, including assignments, +routine definitions, and parenthetical groupings, are treated separately." (save-excursion (let* ((case-fold-search t) (end-reg (progn (beginning-of-line) (point))) @@ -3144,10 +3142,10 @@ Return value is the beginning of the match or (in case of failure) nil." (defun idlwave-block-jump-out (&optional dir nomark) "When optional argument DIR is non-negative, move forward to end of current block using the `idlwave-begin-block-reg' and `idlwave-end-block-reg' -regular expressions. When DIR is negative, move backwards to block beginning. -Recursively calls itself to skip over nested blocks. DIR defaults to -forward. Calls `push-mark' unless the optional argument NOMARK is -non-nil. Movement is limited by the start of program units because of +regular expressions. When DIR is negative, move backwards to block beginning. +Recursively calls itself to skip over nested blocks. DIR defaults to +forward. Calls `push-mark' unless the optional argument NOMARK is +non-nil. Movement is limited by the start of program units because of possibility of unbalanced blocks." (interactive "P") (or dir (setq dir 0)) @@ -3203,7 +3201,7 @@ If in a statement, moves to beginning of statement before finding indent." (defun idlwave-current-indent () "Return the column of the indentation of the current line. -Skips any whitespace. Returns 0 if the end-of-line follows the whitespace." +Skips any whitespace. Returns 0 if the end-of-line follows the whitespace." (save-excursion (beginning-of-line) (skip-chars-forward " \t") @@ -3212,7 +3210,7 @@ Skips any whitespace. Returns 0 if the end-of-line follows the whitespace." ((current-column))))) (defun idlwave-is-continuation-line () - "Tests if current line is continuation line. + "Test if current line is continuation line. Blank or comment-only lines following regular continuation lines (with `$') count as continuations too." (let (p) @@ -3225,19 +3223,19 @@ Blank or comment-only lines following regular continuation lines (with (if (setq p (idlwave-look-at "\\<\\$")) (throw 'loop p)))))))) (defun idlwave-is-comment-line () - "Tests if the current line is a comment line." + "Test if the current line is a comment line." (save-excursion (beginning-of-line 1) (looking-at "[ \t]*;"))) (defun idlwave-is-comment-or-empty-line () - "Tests if the current line is a comment line." + "Test if the current line is a comment line." (save-excursion (beginning-of-line 1) (looking-at "[ \t]*[;\n]"))) (defun idlwave-look-at (regexp &optional cont beg) - "Searches current line from current point for REGEXP. + "Search current line from current point for REGEXP. If optional argument CONT is non-nil, searches to the end of the current statement. If optional arg BEG is non-nil, search starts from the beginning of the @@ -3245,7 +3243,7 @@ current statement. Ignores matches that end in a comment or inside a string expression. Returns point if successful, nil otherwise. This function produces unexpected results if REGEXP contains quotes or -a comment delimiter. The search is case insensitive. +a comment delimiter. The search is case insensitive. If successful leaves point after the match, otherwise, does not move point." (let ((here (point)) (case-fold-search t) @@ -3261,17 +3259,17 @@ If successful leaves point after the match, otherwise, does not move point." found)) (defun idlwave-fill-paragraph (&optional nohang) - "Fills paragraphs in comments. + "Fill paragraphs in comments. A paragraph is made up of all contiguous lines having the same comment leader (the leading whitespace before the comment delimiter and the comment delimiter). In addition, paragraphs are separated by blank -line comments. The indentation is given by the hanging indent of the +line comments. The indentation is given by the hanging indent of the first line, otherwise by the minimum indentation of the lines after -the first line. The indentation of the first line does not change. -Does not effect code lines. Does not fill comments on the same line +the first line. The indentation of the first line does not change. +Does not effect code lines. Does not fill comments on the same line with code. The hanging indent is given by the end of the first match -matching `idlwave-hang-indent-regexp' on the paragraph's first line . If the -optional argument NOHANG is non-nil then the hanging indent is +matching `idlwave-hang-indent-regexp' on the paragraph's first line. +If the optional argument NOHANG is non-nil then the hanging indent is ignored." (interactive "P") ;; check if this is a line comment @@ -3440,11 +3438,11 @@ ignored." (setq fill-prefix nil)))) (defun idlwave-calc-hanging-indent () - "Calculate the position of the hanging indent for the comment -paragraph. The hanging indent position is given by the first match -with the `idlwave-hang-indent-regexp'. If `idlwave-use-last-hang-indent' is -non-nil then use last occurrence matching `idlwave-hang-indent-regexp' on -the line. + "Calculate the position of the hanging indent for the comment paragraph. +The hanging indent position is given by the first match with the +`idlwave-hang-indent-regexp'. If `idlwave-use-last-hang-indent' is +non-nil then use last occurrence matching `idlwave-hang-indent-regexp' +on the line. If not found returns nil." (if idlwave-use-last-hang-indent (save-excursion @@ -3581,11 +3579,11 @@ automatically breaks the line at a previous space." ; (let ((where (idlwave-where))))) -(defun idlwave-doc-header (&optional nomark ) +(defun idlwave-doc-header (&optional nomark) "Insert a documentation header at the beginning of the unit. -Inserts the value of the variable idlwave-file-header. Sets mark before -moving to do insertion unless the optional prefix argument NOMARK -is non-nil." +Inserts the value of the variable `idlwave-file-header'. Sets mark +before moving to do insertion unless the optional prefix argument +NOMARK is non-nil." (interactive "P") (or nomark (push-mark)) ;; make sure we catch the current line if it begins the unit @@ -3608,7 +3606,7 @@ is non-nil." (goto-char pos))) (defun idlwave-default-insert-timestamp () - "Default timestamp insertion function" + "Default timestamp insertion function." (insert (current-time-string)) (insert ", " (user-full-name)) (if (boundp 'user-mail-address) @@ -3623,8 +3621,8 @@ is non-nil." (defun idlwave-doc-modification () "Insert a brief modification log at the beginning of the current program. Looks for an occurrence of the value of user variable -`idlwave-doc-modifications-keyword' if non-nil. Inserts time and user name -and places the point for the user to add a log. Before moving, saves +`idlwave-doc-modifications-keyword' if non-nil. Inserts time and user +name and places the point for the user to add a log. Before moving, saves location on mark ring so that the user can return to previous point." (interactive) (push-mark) @@ -3672,12 +3670,12 @@ Calling from a program, arguments are START END." (expand-region-abbrevs start end 'noquery)))) (defun idlwave-quoted () - "Returns t if point is in a comment or quoted string. -nil otherwise." + "Return t if point is in a comment or quoted string. +Returns nil otherwise." (or (idlwave-in-comment) (idlwave-in-quote))) (defun idlwave-in-quote () - "Returns location of the opening quote + "Return location of the opening quote if point is in a IDL string constant, nil otherwise. Ignores comment delimiters on the current line. Properly handles nested quotation marks and octal @@ -3730,7 +3728,7 @@ constants - a double quote followed by an octal digit." (if (> start bq) bq)))) (defun idlwave-is-pointer-dereference (&optional limit) - "Determines if the character after point is a pointer dereference *." + "Determine if the character after point is a pointer dereference *." (let ((pos (point))) (and (eq (char-after) ?\*) @@ -3753,8 +3751,8 @@ constants - a double quote followed by an octal digit." Opens a line if point is not followed by a newline modulo intervening whitespace. S1 and S2 are strings. S1 is inserted at point followed by S2. Point is inserted between S1 and S2. The case of S1 and S2 is -adjusted according to `idlwave-abbrev-change-case'. If optional argument -PROMPT is a string then it is displayed as a message in the +adjusted according to `idlwave-abbrev-change-case'. If optional +argument PROMPT is a string then it is displayed as a message in the minibuffer. The PROMPT serves as a reminder to the user of an expression to enter. @@ -3815,7 +3813,7 @@ unless the optional second argument NOINDENT is non-nil." "Selector expression")) (defun idlwave-for () - "Build skeleton for loop statment." + "Build skeleton IDL loop statement." (interactive) (idlwave-template (idlwave-rw-case "for") @@ -3823,7 +3821,7 @@ unless the optional second argument NOINDENT is non-nil." "Loop expression")) (defun idlwave-if () - "Build skeleton for loop statment." + "Build skeleton IDL if statement." (interactive) (idlwave-template (idlwave-rw-case "if") @@ -3891,7 +3889,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (t (error "This should not happen (idlwave-get-buffer-visiting)")))) (defvar idlwave-outlawed-buffers nil - "List of buffer pulled up by idlwave for special reasons. + "List of buffers pulled up by IDLWAVE for special reasons. Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") (defun idlwave-find-file-noselect (file &optional why) @@ -3912,7 +3910,7 @@ s Buffers created by the IDLWAVE Shell to display where execution stopped or an error was found. a Both of the above. -Buffer containing unsaved changes require confirmation before they are killed." +Buffers containing unsaved changes require confirmation before they are killed." (interactive) (if (null idlwave-outlawed-buffers) (error "No IDLWAVE-created buffers available") @@ -3986,11 +3984,11 @@ Intended for `after-save-hook'." (t (idlwave-locate-lib-file file)))) (defun idlwave-make-tags () - "Creates the IDL tags file IDLTAGS in the current directory from -the list of directories specified in the minibuffer. Directories may be -for example: . /usr/local/rsi/idl/lib. All the subdirectories of the + "Create the IDL tags file IDLTAGS in the current directory from +the list of directories specified in the minibuffer. Directories may be +for example: . /usr/local/rsi/idl/lib. All the subdirectories of the specified top directories are searched if the directory name is prefixed -by @. Specify @ directories with care, it may take a long, long time if +by @. Specify @ directories with care, it may take a long, long time if you specify /." (interactive) (let (directory directories cmd append status numdirs dir getsubdirs @@ -4076,7 +4074,7 @@ you specify /." (defun idlwave-toggle-comment-region (beg end &optional n) "Comment the lines in the region if the first non-blank line is -commented, and conversely, uncomment region. If optional prefix arg +commented, and conversely, uncomment region. If optional prefix arg N is non-nil, then for N positive, add N comment delimiters or for N negative, remove N comment delimiters. Uses `comment-region' which does not place comment delimiters on @@ -4238,9 +4236,10 @@ blank lines." kwd-list) (defun idlwave-sintern-rinfo-list (list &optional set default-dir) - "Sintern all strings in the rinfo LIST. With optional parameter -SET: also set new patterns. Probably this will always have to be t. -If DEFAULT-DIR is passed, it is used as the base of the directory" + "Sintern all strings in the rinfo LIST. +With optional parameter SET: also set new patterns. Probably this +will always have to be t. If DEFAULT-DIR is passed, it is used as +the base of the directory." (let (entry name type class kwds res source call new) (while list (setq entry (car list) @@ -4352,8 +4351,8 @@ catalog \('lib).") (defun idlwave-routines () "Provide a list of IDL routines. -This routine loads the builtin routines on the first call. Later it -only returns the value of the variable." +This routine loads the builtin routines on the first call. +Later it only returns the value of the variable." (if (and idlwave-catalog-process (processp idlwave-catalog-process)) (progn @@ -4383,7 +4382,7 @@ only returns the value of the variable." Does not run after automatic updates of buffer or the shell.") (defun idlwave-rescan-catalog-directories () - "Rescan the previously selected directories. For batch processing." + "Rescan the previously selected directories. For batch processing." (idlwave-update-routine-info '(16))) (defun idlwave-rescan-asynchronously () @@ -5168,7 +5167,8 @@ Cache to disk for quick recovery." (idlwave-update-current-buffer-info 'find-file)) (defun idlwave-update-current-buffer-info (why) - "Update idlwave-routines for current buffer. Can run from after-save-hook." + "Update `idlwave-routines' for current buffer. +Can run from `after-save-hook'." (when (and (eq major-mode 'idlwave-mode) (or (eq t idlwave-auto-routine-info-updates) (memq why idlwave-auto-routine-info-updates)) @@ -5324,9 +5324,9 @@ Cache to disk for quick recovery." A widget checklist will allow you to choose the directories. Write the result as a file `idlwave-user-catalog-file'. When this file -exists, will be automatically loaded to give routine information about -library routines. With ARG, just rescan the same directories as last -time - so no widget will pop up." +exists, it will be automatically loaded to give routine information +about library routines. With ARG, just rescan the same directories +as last time - so no widget will pop up." (interactive "P") ;; Make sure the file is loaded if it exists. (if (and (stringp idlwave-user-catalog-file) @@ -5807,10 +5807,10 @@ pro idlwave_get_class_tags, class end ;; END OF IDLWAVE SUPPORT ROUTINES " - "The idl programs to get info from the shell.") + "The IDL programs to get info from the shell.") (defvar idlwave-idlwave_routine_info-compiled nil - "Remembers if the routine info procedure is already compiled.") + "Remember if the routine info procedure is already compiled.") (defvar idlwave-shell-temp-pro-file) (defvar idlwave-shell-temp-rinfo-save-file) @@ -5875,12 +5875,12 @@ This function is smart and figures out what can be completed at this point. - At the beginning of a statement it completes procedure names. - In the middle of a statement it completes function names. -- after a `(' or `,' in the argument list of a function or procedure, +- After a `(' or `,' in the argument list of a function or procedure, it completes a keyword of the relevant function or procedure. - In the first arg of `OBJ_NEW', it completes a class name. -When several completions are possible, a list will be displayed in the -*Completions* buffer. If this list is too long to fit into the +When several completions are possible, a list will be displayed in +the *Completions* buffer. If this list is too long to fit into the window, scrolling can be achieved by repeatedly pressing \\[idlwave-complete]. @@ -6303,7 +6303,8 @@ If yes, return the index (>=1)." (nreverse rtn))) (defun idlwave-all-method-classes (method &optional type) - "Return all classes which have a method METHOD. TYPE is 'fun or 'pro. + "Return all classes which have a method METHOD. +TYPE is 'fun or 'pro. When TYPE is not specified, both procedures and functions will be considered." (if (null method) (mapcar 'car (idlwave-class-alist)) @@ -6354,7 +6355,7 @@ When TYPE is not specified, both procedures and functions will be considered." (defun idlwave-explicit-class-listed (info) "Return whether or not the class is listed explicitly, ala a->b::c. -INFO is as returned by idlwave-what-function or -procedure." +INFO is as returned by `idlwave-what-function' or `-procedure'." (let ((apos (nth 3 info))) (if apos (save-excursion (goto-char apos) @@ -6362,7 +6363,7 @@ INFO is as returned by idlwave-what-function or -procedure." (defvar idlwave-determine-class-special nil "List of special functions for determining class. -Must accept two arguments: `apos' and `info'") +Must accept two arguments: `apos' and `info'.") (defun idlwave-determine-class (info type) ;; Determine the class of a routine call. @@ -6711,7 +6712,7 @@ This function is not general, can only be used for completion stuff." "Perform TYPE completion of word before point against LIST. SELECTOR is the PREDICATE argument for the completion function. Show PROMPT in echo area. TYPE is one of the intern types, e.g. 'function, -'procedure, 'class-tag, 'keyword, 'sysvar, etc.. SPECIAL-SELECTOR is +'procedure, 'class-tag, 'keyword, 'sysvar, etc. SPECIAL-SELECTOR is used only once, for `all-completions', and can be used to, e.g., accumulate information on matching completions." (let* ((completion-ignore-case t) @@ -6922,7 +6923,7 @@ accumulate information on matching completions." (defun idlwave-popup-select (ev list title &optional sort) "Select an item in LIST with a popup menu. TITLE is the title to put atop the popup. If SORT is non-nil, -sort the list before displaying" +sort the list before displaying." (let ((maxpopup idlwave-max-popup-menu-items) rtn menu resp) (cond ((null list)) @@ -7186,7 +7187,7 @@ If these don't exist, a letter in the string is automatically selected." ;; help feature. (defvar idlwave-completion-map nil - "Keymap for completion-list-mode with idlwave-complete.") + "Keymap for `completion-list-mode' with `idlwave-complete'.") (defun idlwave-display-completion-list-xemacs (list &rest cl-args) (with-output-to-temp-buffer "*Completions*" @@ -7263,8 +7264,7 @@ If these don't exist, a letter in the string is automatically selected." (defvar idlwave-struct-skip "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" - "Regexp for skipping continued blank or comment-only lines in -structures") + "Regexp for skipping continued blank or comment-only lines in structures.") (defvar idlwave-struct-tag-regexp (concat "[{,]" ;leading comma/brace @@ -7348,13 +7348,13 @@ Point is expected just before the opening `{' of the struct definition." (cons beg (point))))) (defun idlwave-find-structure-definition (&optional var name bound) - "Search forward for a structure definition. If VAR is non-nil, -search for a structure assigned to variable VAR. If NAME is non-nil, -search for a named structure NAME, if a string, or a generic named -structure otherwise. If BOUND is an integer, limit the search. If -BOUND is the symbol `all', we search first back and then forward -through the entire file. If BOUND is the symbol `back' we search only -backward." + "Search forward for a structure definition. +If VAR is non-nil, search for a structure assigned to variable VAR. +If NAME is non-nil, search for a named structure NAME, if a string, +or a generic named structure otherwise. If BOUND is an integer, limit +the search. If BOUND is the symbol `all', we search first back and +then forward through the entire file. If BOUND is the symbol `back' +we search only backward." (let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*") (case-fold-search t) (lim (if (integerp bound) bound nil)) @@ -7420,11 +7420,11 @@ backward." (cdr inherits)))))) (defun idlwave-find-class-definition (class &optional all-hook alt-class) - "Find class structure definition(s) + "Find class structure definition(s). If ALL-HOOK is set, find all named structure definitions in a given class__define routine, on which ALL-HOOK will be run. If ALT-CLASS is set, look for the name__define pro, and inside of it, for the ALT-CLASS -class/struct definition" +class/struct definition." (let ((case-fold-search t) end-lim list name) (when (re-search-forward (concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t) @@ -7439,7 +7439,7 @@ class/struct definition" (defun idlwave-class-file-or-buffer (class) - "Find buffer visiting CLASS definition" + "Find buffer visiting CLASS definition." (let* ((pro (concat (downcase class) "__define")) (file (idlwave-routine-source-file (nth 3 (idlwave-rinfo-assoc pro 'pro nil @@ -7448,7 +7448,7 @@ class/struct definition" (defun idlwave-scan-class-info (class) - "Scan all class and named structure info in the class__define pro" + "Scan all class and named structure info in the class__define pro." (let* ((idlwave-auto-routine-info-updates nil) (filebuf (idlwave-class-file-or-buffer class)) (file (car filebuf)) @@ -7484,7 +7484,7 @@ class/struct definition" (push entry idlwave-class-info))))))))) (defun idlwave-class-found-in (class) - "Return the FOUND-IN property of the class." + "Return the FOUND-IN property of the CLASS." (cdr (assq 'found-in (idlwave-class-info class)))) (defun idlwave-class-tags (class) "Return the native tags in CLASS." @@ -7563,7 +7563,7 @@ property indicating the link is added." (nreverse kwds))) (defun idlwave-entry-find-keyword (entry keyword) - "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" + "Find keyword KEYWORD in entry ENTRY, and return (with link) if set." (catch 'exit (mapc (lambda (key-list) @@ -7722,13 +7722,13 @@ property indicating the link is added." (t (error "This should not happen"))))) (defun idlwave-split-link-target (link) - "Split a given link into link file and anchor." + "Split a given LINK into link file and anchor." (if (string-match idlwave-html-link-sep link) (cons (substring link 0 (match-beginning 0)) (string-to-number (substring link (match-end 0)))))) (defun idlwave-substitute-link-target (link target) - "Substitute the target anchor for the given link." + "Substitute the TARGET anchor for the given LINK." (let (main-base) (setq main-base (if (string-match "#" link) (substring link 0 (match-beginning 0)) @@ -7920,14 +7920,14 @@ itself." (idlwave-do-mouse-completion-help ev)) (defun idlwave-routine-info (&optional arg external) - "Display a routines calling sequence and list of keywords. When -point is on the name a function or procedure, or in the argument list -of a function or procedure, this command displays a help buffer with + "Display a routines calling sequence and list of keywords. +When point is on the name a function or procedure, or in the argument +list of a function or procedure, this command displays a help buffer with the information. When called with prefix arg, enforce class query. When point is on an object operator `->', display the class stored in -this arrow, if any (see `idlwave-store-inquired-class'). With a -prefix arg, the class property is cleared out." +this arrow, if any (see `idlwave-store-inquired-class'). With a prefix +arg, the class property is cleared out." (interactive "P") (idlwave-routines) @@ -8008,8 +8008,8 @@ With ARG, enforce query for the class of object methods." (defun idlwave-find-module (&optional arg) "Find the source code of an IDL module. -Works for modules for which IDLWAVE has routine info available. The -function offers as default the module name `idlwave-routine-info' +Works for modules for which IDLWAVE has routine info available. +The function offers as default the module name `idlwave-routine-info' would use. With ARG limit to this buffer. With two prefix ARG's force class query for object methods." (interactive "P") @@ -8166,7 +8166,7 @@ Used by `idlwave-routine-info' and `idlwave-find-module'." (t nil))))) (defun idlwave-what-module-find-class () - "Call idlwave-what-module and find the inherited class if necessary." + "Call `idlwave-what-module' and find the inherited class if necessary." (let* ((module (idlwave-what-module)) (class (nth 2 module)) classes) @@ -8210,7 +8210,7 @@ appropriate Init method." &optional super-classes system) "Update a list of keywords. Translate OBJ_NEW, adding all super-class keywords, or all keywords -from all classes if class equals t. If SYSTEM is non-nil, don't +from all classes if CLASS equals t. If SYSTEM is non-nil, don't demand _EXTRA in the keyword list." (let ((case-fold-search t)) @@ -8492,8 +8492,8 @@ If we do not know about MODULE, just return KEYWORD literally." (defun idlwave-insert-source-location (prefix entry &optional file-props) "Insert a source location into the routine info buffer. -Start line with PREFIX. If a file name is inserted, add FILE-PROPS to -it." +Start line with PREFIX. If a file name is inserted, add FILE-PROPS +to it." (let* ((key (car entry)) (file (nth 1 entry)) (types (nth 2 entry)) @@ -8591,7 +8591,7 @@ Return the name of the special lib if there is a match." (idlwave-mouse-active-rinfo nil 'right)) (defun idlwave-mouse-active-rinfo (ev &optional right shift) - "Does the mouse actions in the routine info buffer. + "Do the mouse actions in the routine info buffer. Optional args RIGHT and SHIFT indicate, if mouse-3 was used, and if SHIFT was pressed." (interactive "e") @@ -8704,8 +8704,8 @@ definitions. When SPECIAL-ROUTINES in non-nil, only look for shadows of these routines. When IDL hits a routine call which is not defined, it will search on -the load path in order to find a definition. The output of this -command can be used to detect possible name clashes during this process." +the load path in order to find a definition. The output of this command +can be used to detect possible name clashes during this process." (idlwave-routines) ; Make sure everything is loaded. (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) (or (y-or-n-p @@ -8889,10 +8889,11 @@ routines, and may have been scanned." (not (and ,a ,b)))) (defun idlwave-routine-entry-compare (a b) - "Compare two routine info entries for sortiung. This is the general case. -It first compates class, names, and type. If it turns out that A and B -are twins (same name, class, and type), calls another routine which -compares twins on the basis of their file names and path locations." + "Compare two routine info entries for sorting. +This is the general case. It first compares class, names, and type. +If it turns out that A and B are twins (same name, class, and type), +calls another routine which compares twins on the basis of their file +names and path locations." (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a))) (cond ((not (equal (idlwave-downcase-safe class) @@ -8913,9 +8914,8 @@ compares twins on the basis of their file names and path locations." (idlwave-routine-entry-compare-twins a b))))) (defun idlwave-routine-entry-compare-twins (a b) - "Compare two routine entries, under the assumption that they are -twins. This basically calls `idlwave-routine-twin-compare' with the -correct args." + "Compare two routine entries, under the assumption that they are twins. +This basically calls `idlwave-routine-twin-compare' with the correct args." (let* ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside (asrc (nth 3 a)) (atype (car asrc)) @@ -9022,7 +9022,7 @@ This expects NAME TYPE CLASS to be bound to the right values." (string-match (concat "^" (regexp-quote true-syslib)) true-file))) (defun idlwave-lib-p (file) - "Non-nil if file is in the library" + "Non-nil if FILE is in the library." (let ((true-dir (file-name-directory (file-truename file)))) (assoc true-dir (idlwave-true-path-alist)))) @@ -9254,7 +9254,7 @@ Assumes that point is at the beginning of the unit as found by idlwave-mode-debug-menu-def))) (defun idlwave-customize () - "Call the customize function with idlwave as argument." + "Call the customize function with `idlwave' as argument." (interactive) ;; Try to load the code for the shell, so that we can customize it ;; as well. diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index d3c7d998269..84b3b797b65 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -214,7 +214,7 @@ buffer with \\[set-variable].") ;;;###autoload (defvar inferior-lisp-mode-hook '() - "*Hook for customising Inferior Lisp mode.") + "*Hook for customizing Inferior Lisp mode.") (put 'inferior-lisp-mode 'mode-class 'special) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 0fad9322416..d2264043cb5 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -98,8 +98,8 @@ name.") (concat "^\\s-*?\\(" js--dotted-name-re "\\)\\.prototype" "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(function\\)\\_>") "Regexp matching an explicit JavaScript prototype \"method\" declaration. -Group 1 is a (possibly-dotted) class name, group 2 is a method -name, and group 3 is the 'function' keyword." ) +Group 1 is a (possibly-dotted) class name, group 2 is a method name, +and group 3 is the 'function' keyword.") (defconst js--plain-class-re (concat "^\\s-*\\(" js--dotted-name-re "\\)\\.prototype" @@ -227,14 +227,14 @@ A class definition style is a plist with the following keys: :name is a human-readable name of the class type :class-decl is a regular expression giving the start of the -class. Its first group must match the name of its class. If there -is a parent class, the second group should match, and it should -be the name of the class. +class. Its first group must match the name of its class. If there +is a parent class, the second group should match, and it should be +the name of the class. If :prototype is present and non-nil, the parser will merge declarations for this constructs with others at the same lexical -level that have the same name. Otherwise, multiple definitions -will create multiple top-level entries. Don't use :prototype +level that have the same name. Otherwise, multiple definitions +will create multiple top-level entries. Don't use :prototype unnecessarily: it has an associated cost in performance. If :strip-prototype is present and non-nil, then if the class @@ -272,7 +272,7 @@ Match group 1 is MUMBLE.") (defconst js--macro-decl-re (concat "^\\s-*#\\s-*define\\s-+\\(" js--cpp-name-re "\\)\\s-*(") "Regexp matching a CPP macro definition, up to the opening parenthesis. -Match group 1 is the name of the function.") +Match group 1 is the name of the macro.") (defun js--regexp-opt-symbol (list) "Like `regexp-opt', but surround the result with `\\\\_<' and `\\\\_>'." @@ -538,8 +538,8 @@ getting timeout messages." "Helper function for `js--update-quick-match-re'. If LIST contains any element that is not nil, return its non-nil elements, separated by SEPARATOR, prefixed by PREFIX, and ended -with SUFFIX as with `concat'. Otherwise, if LIST is empty, return -nil. If any element in LIST is itself a list, flatten that +with SUFFIX as with `concat'. Otherwise, if LIST is empty, return +nil. If any element in LIST is itself a list, flatten that element." (setq list (js--flatten-list list)) (when list @@ -793,7 +793,7 @@ determined. Otherwise, return nil." (defun js--function-prologue-beginning (&optional pos) "Return the start of the JavaScript function prologue containing POS. A function prologue is everything from start of the definition up -to and including the opening brace. POS defaults to point. +to and including the opening brace. POS defaults to point. If POS is not in a function prologue, return nil." (let (prologue-begin) (save-excursion @@ -901,7 +901,7 @@ Return the pitem of the function we went to the beginning of." (defun js--flush-caches (&optional beg ignored) "Flush the `js-mode' syntax cache after position BEG. -BEG defaults to point-min, meaning to flush the entire cache." +BEG defaults to `point-min', meaning to flush the entire cache." (interactive) (setq beg (or beg (save-restriction (widen) (point-min)))) (setq js--cache-end (min js--cache-end beg))) @@ -968,8 +968,8 @@ the body of `js--ensure-cache'." (defun js--split-name (string) "Split a JavaScript name into its dot-separated parts. -This also removes any prototype parts from the split name (unless -the name is just \"prototype\" to start with)." +This also removes any prototype parts from the split name +\(unless the name is just \"prototype\" to start with)." (let ((name (save-match-data (split-string string "\\." t)))) (unless (and (= (length name) 1) @@ -1211,12 +1211,11 @@ LIMIT defaults to point." "Value of `end-of-defun-function' for `js-mode'." (setq arg (or arg 1)) (while (and (not (bobp)) (< arg 0)) - (let (orig-pos (point)) - (incf arg) - (js-beginning-of-defun) - (js-beginning-of-defun) - (unless (bobp) - (js-end-of-defun)))) + (incf arg) + (js-beginning-of-defun) + (js-beginning-of-defun) + (unless (bobp) + (js-end-of-defun))) (while (> arg 0) (decf arg) @@ -1389,8 +1388,8 @@ spec. FUNC must preserve the match data." (defun js--variable-decl-matcher (limit) "Font-lock matcher for variable names in a variable declaration. This is a cc-mode-style matcher that *always* fails, from the -point of view of font-lock. It applies highlighting directly with -`font-lock-apply-higlight'." +point of view of font-lock. It applies highlighting directly with +`font-lock-apply-highlight'." (condition-case nil (save-restriction (narrow-to-region (point-min) limit) @@ -1546,7 +1545,7 @@ point of view of font-lock. It applies highlighting directly with "Level three font lock for `js-mode'.") (defun js--inside-pitem-p (pitem) - "Return whether point is inside the given pitem's header or body" + "Return whether point is inside the given pitem's header or body." (js--ensure-cache) (assert (js--pitem-h-begin pitem)) (assert (js--pitem-paren-depth pitem)) @@ -1558,7 +1557,7 @@ point of view of font-lock. It applies highlighting directly with (defun js--parse-state-at-point () "Parse the JavaScript program state at point. Return a list of `js--pitem' instances that apply to point, most -specific first. In the worst case, the current toplevel instance +specific first. In the worst case, the current toplevel instance will be returned." (save-excursion (save-restriction @@ -1753,7 +1752,7 @@ nil." (if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)") (progn (skip-syntax-backward " ") - (when (= (char-before) ?\)) (backward-list)) + (when (eq (char-before) ?\)) (backward-list)) (back-to-indentation) (cond (same-indent-p (current-column)) @@ -1827,8 +1826,8 @@ nil." (defun js--make-merged-item (item child name-parts) "Helper function for `js--splice-into-items'. Return a new item that is the result of merging CHILD into -ITEM. NAME-PARTS is a list of parts of the name of CHILD that we -haven't consumed yet." +ITEM. NAME-PARTS is a list of parts of the name of CHILD +that we haven't consumed yet." (js--debug "js--make-merged-item: {%s} into {%s}" (js--pitem-format child) (js--pitem-format item)) @@ -1878,9 +1877,9 @@ haven't consumed yet." (defun js--splice-into-items (items child name-parts) "Splice CHILD into the `js--pitem' ITEMS at NAME-PARTS. -If a class doesn't exist in the tree, create it. Return the new -items list. NAME-PARTS is a list of strings given the -broken-down class name of the item to insert." +If a class doesn't exist in the tree, create it. Return +the new items list. NAME-PARTS is a list of strings given +the broken-down class name of the item to insert." (let ((top-name (car name-parts)) (item-ptr items) @@ -2086,7 +2085,7 @@ broken-down class name of the item to insert." (puthash name2 (cdr item) symbols)))) (defun js--get-all-known-symbols () - "Return a hash table of all Javascript symbols. + "Return a hash table of all JavaScript symbols. This searches all existing `js-mode' buffers. Each key is the name of a symbol (possibly disambiguated with <N>, where N > 1), and each value is a marker giving the location of that symbol." @@ -2100,7 +2099,7 @@ and each value is a marker giving the location of that symbol." finally return symbols)) (defvar js--symbol-history nil - "History of entered Javascript symbols") + "History of entered JavaScript symbols.") (defun js--read-symbol (symbols-table prompt &optional initial-input) "Helper function for `js-find-symbol'. @@ -2131,9 +2130,9 @@ marker." (buffer-substring (car bounds) (cdr bounds))))) (defun js-find-symbol (&optional arg) - "Read a Javascript symbol and jump to it. + "Read a JavaScript symbol and jump to it. With a prefix argument, restrict symbols to those from the -current buffer. Pushes a mark onto the tag ring just like +current buffer. Pushes a mark onto the tag ring just like `find-tag'." (interactive "P") (let (symbols marker) @@ -2192,7 +2191,7 @@ Otherwise, use the current value of `process-mark'." (inferior-moz-process)))) (defvar js--js-references nil - "Maps Elisp Javascript proxy objects to their Javascript IDs.") + "Maps Elisp JavaScript proxy objects to their JavaScript IDs.") (defvar js--js-process nil "The most recent MozRepl process object.") @@ -2512,12 +2511,12 @@ Otherwise, use the current value of `process-mark'." }) ") - "String to set MozRepl up into a simple-minded evaluation mode") + "String to set MozRepl up into a simple-minded evaluation mode.") (defun js--js-encode-value (x) "Marshall the given value for JS. Strings and numbers are JSON-encoded. Lists (including nil) are -made into Javascript array literals and their contents encoded +made into JavaScript array literals and their contents encoded with `js--js-encode-value'." (cond ((stringp x) (json-encode-string x)) ((numberp x) (json-encode-number x)) @@ -2910,7 +2909,7 @@ left-to-right." (defun js--read-tab (prompt) "Read a Mozilla tab with prompt PROMPT. Return a cons of (TYPE . OBJECT). TYPE is either 'window or -'tab, and OBJECT is a Javascript handle to a ChromeWindow or a +'tab, and OBJECT is a JavaScript handle to a ChromeWindow or a browser, respectively." ;; Prime IDO diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index fa8cf63c87a..7eb3df185e9 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -104,7 +104,7 @@ (t (:reverse-video t))) "Face to use for highlighting leading spaces in Font-Lock mode." :group 'makefile) -(put 'makefile-space-face 'face-alias 'makefile-space) +(define-obsolete-face-alias 'makefile-space-face 'makefile-space "22.1") (defface makefile-targets ;; This needs to go along both with foreground and background colors (i.e. shell) @@ -1486,9 +1486,10 @@ definition and conveniently use this command." (let ((this-line (count-lines (point-min) (point)))) (setq this-line (max 1 this-line)) (makefile-browser-toggle-state-for-line this-line) - (goto-line this-line) + (goto-char (point-min)) + (forward-line (1- this-line)) (let ((inhibit-read-only t)) - (beginning-of-line) + (beginning-of-line) ; redundant? (if (makefile-browser-on-macro-line-p) (let ((macro-name (makefile-browser-this-line-macro-name))) (delete-region (point) (progn (end-of-line) (point))) @@ -1528,7 +1529,7 @@ large dependencies from the browser to the client buffer. Insertion takes place at point." (interactive) (save-excursion - (goto-line 1) + (goto-char (point-min)) (let ((current-line 1)) (while (not (eobp)) (if (makefile-browser-get-state-for-line current-line) diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 28687fb33cd..e0b19486a6f 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -7,7 +7,7 @@ ;; Maintainer: Pieter E.J. Pareit <pieter.pareit@gmail.com> ;; Created: 09 Nov 2002 ;; Version: 0.1 -;; Keywords: Knuth mix mixal asm mixvm "The Art Of Computer Programming" +;; Keywords: languages Knuth mix mixal asm mixvm "The Art Of Computer Programming" ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index d422d85b13a..53a010abdac 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -247,6 +247,7 @@ rigidly along with this one (not yet)." (declare-function comint-send-string "comint" (process string)) (declare-function comint-send-region "comint" (process start end)) (declare-function comint-send-eof "comint" ()) +(defvar compilation-error-regexp-alist) (define-derived-mode inferior-prolog-mode comint-mode "Inferior Prolog" "Major mode for interacting with an inferior Prolog process. @@ -394,6 +395,9 @@ If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." (prolog-consult-region compile beg end) (pop-to-buffer inferior-prolog-buffer)) +;; inferior-prolog-mode uses the autoloaded compilation-shell-minor-mode. +(declare-function compilation-forget-errors "compile" ()) + (defun inferior-prolog-load-file () "Pass the current buffer's file to the inferior prolog process." (interactive) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 308af6c02cc..4582163e17b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2203,7 +2203,8 @@ Interactively, prompt for name." (unless file (error "Don't know where `%s' is defined" name)) (pop-to-buffer (find-file-noselect file)) (when (integerp line) - (goto-line line)))) + (goto-char (point-min)) + (forward-line (1- line))))) ;;;; Skeletons @@ -2614,7 +2615,8 @@ find it." target_buffer (cadr target) target_fname (buffer-file-name target_buffer)) (switch-to-buffer-other-window target_buffer) - (goto-line target_lineno) + (goto-char (point-min)) + (forward-line (1- target_lineno)) (message "pdbtrack: line %s, file %s" target_lineno target_fname) (python-pdbtrack-overlay-arrow t) (pop-to-buffer origbuf t) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index d948f9f61f9..1adea78c2f5 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1,7 +1,7 @@ ;;; sh-script.el --- shell-script editing commands for Emacs -;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> ;; Version: 2.0f @@ -889,9 +889,7 @@ See `sh-feature'.") (:weight bold))) "Face to show quoted execs like ``" :group 'sh-indentation) - -;; backward-compatibility alias -(put 'sh-heredoc-face 'face-alias 'sh-heredoc) +(define-obsolete-face-alias 'sh-heredoc-face 'sh-heredoc "22.1") (defvar sh-heredoc-face 'sh-heredoc) (defface sh-escaped-newline '((t :inherit font-lock-string-face)) @@ -2999,7 +2997,8 @@ so that `occur-next' and `occur-prev' will work." Output in buffer \"*indent*\" shows any lines which have conflicting values of a variable, and the final value of all variables learned. -This buffer is popped to automatically if there are any discrepancies. +When called interactively, pop to this buffer automatically if +there are any discrepancies. If no prefix ARG is given, then variables are set to numbers. If a prefix arg is given, then variables are set to symbols when @@ -3211,9 +3210,9 @@ This command can often take a long time to run." ))) ;; Are abnormal hooks considered bad form? (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) - (if (or sh-popup-occur-buffer (> num-diffs 0)) - (pop-to-buffer out-buffer)) - ))) + (and (called-interactively-p) + (or sh-popup-occur-buffer (> num-diffs 0)) + (pop-to-buffer out-buffer))))) (defun sh-guess-basic-offset (vec) "See if we can determine a reasonable value for `sh-basic-offset'. diff --git a/lisp/progmodes/sym-comp.el b/lisp/progmodes/sym-comp.el index cb0c0b7f6d2..ed49c9d1f83 100644 --- a/lisp/progmodes/sym-comp.el +++ b/lisp/progmodes/sym-comp.el @@ -57,7 +57,12 @@ point." (defvar symbol-completion-symbol-function 'symbol-completion-symbol "Function to return a partial symbol before point for completion. The value it returns should be a string (or nil). -Major modes may set this locally if the default isn't appropriate.") +Major modes may set this locally if the default isn't appropriate. + +Beware: the length of the string STR returned need to be equal to the length +of text before point that's subject to completion. Typically, this amounts +to saying that STR is equal to +\(buffer-substring (- (point) (length STR)) (point)).") (defvar symbol-completion-completions-function nil "Function to return possible symbol completions. @@ -97,7 +102,7 @@ The predicate being used for selecting completions (from dynamically-bound as `symbol-completion-predicate' in case the transform needs it.") -(defvar displayed-completions) +(defvar symbol-completion-predicate) ;;;###autoload (defun symbol-complete (&optional predicate) @@ -119,63 +124,33 @@ to be set buffer-locally. Variables `symbol-completion-symbol-function', ;; Fixme: Punt to `complete-symbol' in this case? (unless (functionp symbol-completion-completions-function) (error "symbol-completion-completions-function not defined")) - (let ((window (get-buffer-window "*Completions*"))) - (let* ((pattern (or (funcall symbol-completion-symbol-function) - (error "No preceding symbol to complete"))) - (predicate (or predicate - (if symbol-completion-predicate-function - (funcall symbol-completion-predicate-function - (- (point) (length pattern)) - (point))))) - (completions (funcall symbol-completion-completions-function - pattern)) - (completion (try-completion pattern completions predicate))) - ;; If this command was repeated, and there's a fresh completion - ;; window with a live buffer and a displayed completion list - ;; matching the current completions, then scroll the window. - (unless (and (eq last-command this-command) - window (window-live-p window) (window-buffer window) - (buffer-name (window-buffer window)) - (with-current-buffer (window-buffer window) - (if (equal displayed-completions - (all-completions pattern completions predicate)) - (progn - (if (pos-visible-in-window-p (point-max) window) - (set-window-start window (point-min)) - (save-selected-window - (select-window window) - (scroll-up))) - t)))) - ;; Otherwise, do completion. - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region (- (point) (length pattern)) (point)) - (insert completion)) - (t - (message "Making completion list...") - (let* ((list (all-completions pattern completions predicate)) - ;; In case the transform needs to access it. - (symbol-completion-predicate predicate) - ;; Copy since list is side-effected by sorting. - (copy (copy-sequence list))) - (setq list (sort list 'string<)) - (if (functionp symbol-completion-transform-function) - (setq list - (mapcar (funcall - symbol-completion-transform-function) - list))) - (with-output-to-temp-buffer "*Completions*" - (condition-case () - (display-completion-list list pattern) ; Emacs 22 - (error (display-completion-list list)))) - ;; Record the list for determining whether to scroll - ;; (above). - (with-current-buffer "*Completions*" - (set (make-local-variable 'displayed-completions) copy))) - (message "Making completion list...%s" "done"))))))) + (let* ((pattern (or (funcall symbol-completion-symbol-function) + (error "No preceding symbol to complete"))) + ;; FIXME: We assume below that `pattern' holds the text just + ;; before point. This is a problem in the way + ;; symbol-completion-symbol-function was defined. + (predicate (or predicate + (if symbol-completion-predicate-function + (funcall symbol-completion-predicate-function + (- (point) (length pattern)) + (point))))) + (completions (funcall symbol-completion-completions-function + pattern)) + ;; In case the transform needs to access it. + (symbol-completion-predicate predicate) + (completion-annotate-function + (if (functionp symbol-completion-transform-function) + (lambda (str) + (car-safe (cdr-safe + (funcall symbol-completion-transform-function + str)))))) + (minibuffer-completion-table completions) + (minibuffer-completion-predicate predicate) + (ol (make-overlay (- (point) (length pattern)) (point) nil nil t))) + (overlay-put ol 'field 'sym-comp) + (unwind-protect + (call-interactively 'minibuffer-complete) + (delete-overlay ol)))) (eval-when-compile (require 'hippie-exp)) @@ -246,8 +221,6 @@ completion: ;; Else, we assume that a function name is expected. 'fboundp)))) -(defvar symbol-completion-predicate) - (defun lisp-symbol-completion-transform () "`symbol-completion-transform-function' for Lisp." (lambda (elt) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index febd0dfed8b..557d587e6f3 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -4071,7 +4071,8 @@ becomes: (and (file-exists-p name) (find-file-noselect name)))))))) (switch-to-buffer buffer) - (goto-line (string-to-number line)) + (goto-char (point-min)) + (forward-line (- (string-to-number line))) (end-of-line) (catch 'already (cond @@ -4136,18 +4137,18 @@ This lets programs calling batch mode to easily extract error messages." (defun verilog-batch-execute-func (funref) "Internal processing of a batch command, running FUNREF on all command arguments." (verilog-batch-error-wrapper + ;; !!! FIXME: Setting global variables like that is *VERY NASTY* !!! --Stef ;; General globals needed (setq make-backup-files nil) (setq-default make-backup-files nil) (setq enable-local-variables t) (setq enable-local-eval t) ;; Make sure any sub-files we read get proper mode - (setq default-major-mode `verilog-mode) + (setq-default major-mode 'verilog-mode) ;; Ditto files already read in (mapc (lambda (buf) (when (buffer-file-name buf) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (verilog-mode)))) (buffer-list)) ;; Process the files @@ -10973,8 +10974,7 @@ and the case items." ;; second (emacs/xemacs) impl.: G. Van der Plas (spice-mode.el) (if (featurep 'xemacs) - (require 'overlay) - (require 'lucid)) ;; what else can we do ?? + (require 'overlay)) (defconst verilog-include-file-regexp "^`include\\s-+\"\\([^\n\"]*\\)\"" diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index a7f033c7045..35c372d0b4b 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -15152,7 +15152,8 @@ is already shown in a buffer." (let ((buffer (get-file-buffer (car token)))) (speedbar-find-file-in-frame (car token)) (when (or vhdl-speedbar-jump-to-unit buffer) - (goto-line (cdr token)) + (goto-char (point-min)) + (forward-line (1- (cdr token))) (recenter)) (vhdl-speedbar-update-current-unit t t) (speedbar-set-timer dframe-update-speed) @@ -15170,7 +15171,8 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-line (cdr token)) + (progn (goto-char (point-min)) + (forward-line (1- (cdr token))) (end-of-line) (if is-entity (vhdl-port-copy) @@ -15919,7 +15921,8 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-line (nth 3 (car ent-alist))) + (progn (goto-char (point-min)) + (forward-line (1- (nth 3 (car ent-alist)))) (end-of-line) (vhdl-port-copy))) (goto-char component-pos) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 56c4aaaa5da..5cf4651ad13 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -134,7 +134,7 @@ has finished evaluating will signal an error." (defcustom xscheme-startup-message "This is the Scheme process buffer. -Type \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point. +Type \\[xscheme-send-previous-expression] to evaluate the expression before point. Type \\[xscheme-send-control-g-interrupt] to abort evaluation. Type \\[describe-mode] for more information. @@ -158,7 +158,8 @@ When called, the current buffer will be the Scheme process-buffer." (defun xscheme-evaluation-commands (keymap) (define-key keymap "\e\C-x" 'xscheme-send-definition) - (define-key keymap "\C-x\C-e" 'advertised-xscheme-send-previous-expression) + (define-key keymap "\C-x\C-e" 'xscheme-send-previous-expression) + (put 'xscheme-send-previous-expression :advertised-binding "\C-x\C-e") (define-key keymap "\eo" 'xscheme-send-buffer) (define-key keymap "\ez" 'xscheme-send-definition) (define-key keymap "\e\C-m" 'xscheme-send-previous-expression) @@ -317,7 +318,7 @@ With argument, asks for a command line." "Major mode for interacting with an inferior MIT Scheme process. Like scheme-mode except that: -\\[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input +\\[xscheme-send-previous-expression] sends the expression before point to the Scheme process as input \\[xscheme-yank-pop] yanks an expression previously sent to Scheme \\[xscheme-yank-push] yanks an expression more recently sent to Scheme @@ -475,8 +476,8 @@ with no args, if that value is non-nil. (scheme-interaction-mode-initialize) (scheme-interaction-mode t))))) -(fset 'advertised-xscheme-send-previous-expression - 'xscheme-send-previous-expression) +(define-obsolete-function-alias 'advertised-xscheme-send-previous-expression + 'xscheme-send-previous-expression "23.2") ;;;; Debugger Mode diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 16be4439a59..48a494a787b 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1478,7 +1478,7 @@ Please send all bug fixes and enhancements to (defconst ps-windows-system - (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) (defconst ps-lp-system (memq system-type '(usg-unix-v hpux irix))) @@ -5881,7 +5881,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-get-page-dimensions) ;; final check (unless (listp ps-lpr-switches) - (error "`ps-lpr-switches' value should be a list.")) + (error "`ps-lpr-switches' value should be a list")) (and ps-color-p (equal ps-default-background ps-default-foreground) (error diff --git a/lisp/recentf.el b/lisp/recentf.el index bc8904f9211..2a6955f88b8 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -26,11 +26,14 @@ ;; This package maintains a menu for visiting files that were operated ;; on recently. When enabled a new "Open Recent" sub menu is -;; displayed in the "Files" menu. The recent files list is +;; displayed in the "File" menu. The recent files list is ;; automatically saved across Emacs sessions. You can customize the ;; number of recent files displayed, the location of the menu and ;; others options (see the source code for details). +;; To enable this package, add the following to your .emacs: +;; (recentf-mode 1) + ;;; History: ;; @@ -1307,13 +1310,20 @@ empty `file-name-history' with the recent list." That is, remove duplicates, non-kept, and excluded files." (interactive) (message "Cleaning up the recentf list...") - (let ((n 0) newlist) + (let ((n 0) + (ht (make-hash-table + :size recentf-max-saved-items + :test 'equal)) + newlist key) (dolist (f recentf-list) - (setq f (recentf-expand-file-name f)) + (setq f (recentf-expand-file-name f) + key (if recentf-case-fold-search (downcase f) f)) (if (and (recentf-include-p f) (recentf-keep-p f) - (not (recentf-string-member f newlist))) - (push f newlist) + (not (gethash key ht))) + (progn + (push f newlist) + (puthash key t ht)) (setq n (1+ n)) (message "File %s removed from the recentf list" f))) (message "Cleaning up the recentf list...done (%d removed)" n) diff --git a/lisp/register.el b/lisp/register.el index a5e1cff2da4..4144bba7d0b 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -30,19 +30,19 @@ ;;; Global key bindings -;;;###autoload (define-key ctl-x-r-map "\C-@" 'point-to-register) -;;;###autoload (define-key ctl-x-r-map [?\C-\ ] 'point-to-register) -;;;###autoload (define-key ctl-x-r-map " " 'point-to-register) -;;;###autoload (define-key ctl-x-r-map "j" 'jump-to-register) -;;;###autoload (define-key ctl-x-r-map "s" 'copy-to-register) -;;;###autoload (define-key ctl-x-r-map "x" 'copy-to-register) -;;;###autoload (define-key ctl-x-r-map "i" 'insert-register) -;;;###autoload (define-key ctl-x-r-map "g" 'insert-register) -;;;###autoload (define-key ctl-x-r-map "r" 'copy-rectangle-to-register) -;;;###autoload (define-key ctl-x-r-map "n" 'number-to-register) -;;;###autoload (define-key ctl-x-r-map "+" 'increment-register) -;;;###autoload (define-key ctl-x-r-map "w" 'window-configuration-to-register) -;;;###autoload (define-key ctl-x-r-map "f" 'frame-configuration-to-register) +(define-key ctl-x-r-map "\C-@" 'point-to-register) +(define-key ctl-x-r-map [?\C-\ ] 'point-to-register) +(define-key ctl-x-r-map " " 'point-to-register) +(define-key ctl-x-r-map "j" 'jump-to-register) +(define-key ctl-x-r-map "s" 'copy-to-register) +(define-key ctl-x-r-map "x" 'copy-to-register) +(define-key ctl-x-r-map "i" 'insert-register) +(define-key ctl-x-r-map "g" 'insert-register) +(define-key ctl-x-r-map "r" 'copy-rectangle-to-register) +(define-key ctl-x-r-map "n" 'number-to-register) +(define-key ctl-x-r-map "+" 'increment-register) +(define-key ctl-x-r-map "w" 'window-configuration-to-register) +(define-key ctl-x-r-map "f" 'frame-configuration-to-register) ;;; Code: diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index eb54636e105..5788ab7447b 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -216,6 +216,11 @@ that portion dim, invisible, or otherwise less visually noticeable. With prefix argument ARG, turn on if positive, otherwise off. Returns non-nil if the new state is enabled." :global t + ;; We'd like to use custom-initialize-set here so the setup is done + ;; before dumping, but at the point where the defcustom is evaluated, + ;; the corresponding function isn't defined yet, so + ;; custom-initialize-set signals an error. + :initialize 'custom-initialize-delay :init-value t :group 'minibuffer :version "22.1" diff --git a/lisp/server.el b/lisp/server.el index e06fb030e78..a1d0fbf32cf 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1,7 +1,8 @@ ;;; server.el --- Lisp code for GNU Emacs running as server process ;; Copyright (C) 1986, 1987, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: William Sommerfeld <wesommer@athena.mit.edu> ;; Maintainer: FSF @@ -112,7 +113,12 @@ If set, the server accepts remote connections; otherwise it is local." (put 'server-host 'risky-local-variable t) (defcustom server-auth-dir (locate-user-emacs-file "server/") - "Directory for server authentication files." + "Directory for server authentication files. + +NOTE: On FAT32 filesystems, directories are not secure; +files can be read and modified by any user or process. +It is strongly suggested to set `server-auth-dir' to a +directory residing in a NTFS partition instead." :group 'server :type 'directory :version "22.1") @@ -448,15 +454,35 @@ Creates the directory if necessary and makes sure: - it's owned by us - it's not readable/writable by anybody else." (setq dir (directory-file-name dir)) - (let ((attrs (file-attributes dir))) + (let ((attrs (file-attributes dir 'integer))) (unless attrs (letf (((default-file-modes) ?\700)) (make-directory dir t)) - (setq attrs (file-attributes dir))) + (setq attrs (file-attributes dir 'integer))) + ;; Check that it's safe for use. - (unless (and (eq t (car attrs)) (eql (nth 2 attrs) (user-uid)) - (or (eq system-type 'windows-nt) - (zerop (logand ?\077 (file-modes dir))))) - (error "The directory %s is unsafe" dir)))) + (let* ((uid (nth 2 attrs)) + (w32 (eq system-type 'windows-nt)) + (safe (catch :safe + (unless (eq t (car attrs)) ; is a dir? + (throw :safe nil)) + (when (and w32 (zerop uid)) ; on FAT32? + (display-warning + 'server + (format "Using `%s' to store Emacs-server authentication files. +Directories on FAT32 filesystems are NOT secure against tampering. +See variable `server-auth-dir' for details." + (file-name-as-directory dir)) + :warning) + (throw :safe t)) + (unless (eql uid (user-uid)) ; is the dir ours? + (throw :safe nil)) + (when w32 ; on NTFS? + (throw :safe t)) + (unless (zerop (logand ?\077 (file-modes dir))) + (throw :safe nil)) + t))) + (unless safe + (error "The directory `%s' is unsafe" dir))))) ;;;###autoload (defun server-start (&optional leave-dead) @@ -868,7 +894,7 @@ The following commands are accepted by the client: ;; supported any more. (assert (eq (match-end 0) (length string))) (let ((request (substring string 0 (match-beginning 0))) - (coding-system (and default-enable-multibyte-characters + (coding-system (and (default-value 'enable-multibyte-characters) (or file-name-coding-system default-file-name-coding-system))) nowait ; t if emacsclient does not want to wait for us. @@ -1098,7 +1124,8 @@ The following commands are accepted by the client: "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)) + (goto-char (point-min)) + (forward-line (1- (car line-col))) (let ((column-number (cdr line-col))) (when (> column-number 0) (move-to-column (1- column-number)))))) diff --git a/lisp/ses.el b/lisp/ses.el index 95685e7d7e3..86239022ed6 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -3011,7 +3011,7 @@ current column and continues until the next nonblank column." (dolist (buf (buffer-list)) (set-buffer buf) (when (eq major-mode 'ses-mode) - (funcall (or default-major-mode 'fundamental-mode))))) + (funcall (or (default-value 'major-mode) 'fundamental-mode))))) ;; continue standard unloading nil) diff --git a/lisp/shell.el b/lisp/shell.el index a07eb76fba9..dde06ef075f 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -355,7 +355,7 @@ Thus, this does not include the shell's current directory.") 'complete-expand))) (defcustom shell-mode-hook '() - "Hook for customising Shell mode." + "Hook for customizing Shell mode." :type 'hook :group 'shell) @@ -440,10 +440,9 @@ buffer." (make-local-variable 'shell-last-dir) (setq shell-last-dir nil) (setq comint-input-autoexpand shell-input-autoexpand) + (shell-dirtrack-mode 1) ;; This is not really correct, since the shell buffer does not really ;; edit this directory. But it is useful in the buffer list and menus. - (make-local-variable 'list-buffers-directory) - (shell-dirtrack-mode 1) (setq list-buffers-directory (expand-file-name default-directory)) ;; shell-dependent assignments. (when (ring-empty-p comint-input-ring) diff --git a/lisp/simple.el b/lisp/simple.el index c8e537cdf50..e95c736951c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -425,7 +425,8 @@ Other major modes are defined by comparison with this one." ;; Making and deleting lines. -(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))) +(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) + "Propertized string representing a hard newline character.") (defun newline (&optional arg) "Insert a newline, and move to left margin of the new line if it's blank. @@ -999,7 +1000,7 @@ in *Help* buffer. See also the command `describe-char'." encoded encoding-msg display-prop under-display) (if (or (not coding) (eq (coding-system-type coding) t)) - (setq coding default-buffer-file-coding-system)) + (setq coding (default-value 'buffer-file-coding-system))) (if (eq (char-charset char) 'eight-bit) (setq encoding-msg (format "(%d, #o%o, #x%x, raw-byte)" char char char)) @@ -1610,7 +1611,7 @@ Go to the history element by the absolute history position HIST-POS." ;Put this on C-x u, so we can force that rather than C-_ into startup msg -(defalias 'advertised-undo 'undo) +(define-obsolete-function-alias 'advertised-undo 'undo "23.2") (defconst undo-equiv-table (make-hash-table :test 'eq :weakness t) "Table mapping redo records to the corresponding undo one. @@ -2214,7 +2215,11 @@ specifies the value of ERROR-BUFFER." (setq mode-line-process '(":%s")) (require 'shell) (shell-mode) (set-process-sentinel proc 'shell-command-sentinel) + ;; Use the comint filter for proper handling of carriage motion + ;; (see `comint-inhibit-carriage-motion'),. + (set-process-filter proc 'comint-output-filter) )) + ;; Otherwise, command is executed synchronously. (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))))) @@ -2513,6 +2518,17 @@ value passed." (when stderr-file (delete-file stderr-file)) (when lc (delete-file lc))))) +(defvar process-file-side-effects t + "Whether a call of `process-file' changes remote files. + +Per default, this variable is always set to `t', meaning that a +call of `process-file' could potentially change any file on a +remote host. When set to `nil', a file handler could optimize +its behaviour with respect to remote file attributes caching. + +This variable should never be changed by `setq'. Instead of, it +shall be set only by let-binding.") + (defun start-file-process (name buffer program &rest program-args) "Start a program in a subprocess. Return the process object for it. @@ -2783,6 +2799,23 @@ ring directly.") (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") +(defcustom save-interprogram-paste-before-kill nil + "Save the paste strings into `kill-ring' before replacing it with emacs strings. +When one selects something in another program to paste it into Emacs, +but kills something in Emacs before actually pasting it, +this selection is gone unless this variable is non-nil, +in which case the other program's selection is saved in the `kill-ring' +before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]." + :type 'boolean + :group 'killing + :version "23.2") + +(defcustom kill-do-not-save-duplicates nil + "Do not add a new string to `kill-ring' when it is the same as the last one." + :type 'boolean + :group 'killing + :version "23.2") + (defun kill-new (string &optional replace yank-handler) "Make STRING the latest kill in the kill ring. Set `kill-ring-yank-pointer' to point to it. @@ -2795,6 +2828,10 @@ inserted into a buffer; see `insert-for-yank' for details. When a yank handler is specified, STRING must be non-empty (the yank handler, if non-nil, is stored as a `yank-handler' text property on STRING). +When `save-interprogram-paste-before-kill' and `interprogram-paste-function' +are non-nil, saves the interprogram paste string(s) into `kill-ring' before +STRING. + When the yank handler has a non-nil PARAM element, the original STRING argument is not used by `insert-for-yank'. However, since Lisp code may access and use elements from the kill ring directly, the STRING @@ -2806,8 +2843,19 @@ argument should still be a \"useful\" string for such uses." (if yank-handler (signal 'args-out-of-range (list string "yank-handler specified for empty string")))) + (when (and kill-do-not-save-duplicates + (equal string (car kill-ring))) + (setq replace t)) (if (fboundp 'menu-bar-update-yank-menu) (menu-bar-update-yank-menu string (and replace (car kill-ring)))) + (when save-interprogram-paste-before-kill + (let ((interprogram-paste (and interprogram-paste-function + (funcall interprogram-paste-function)))) + (when interprogram-paste + (if (listp interprogram-paste) + (dolist (s (nreverse interprogram-paste)) + (push s kill-ring)) + (push interprogram-paste kill-ring))))) (if (and replace kill-ring) (setcar kill-ring string) (push string kill-ring) @@ -3851,6 +3899,7 @@ Invoke \\[apropos-documentation] and type \"transient\" or commands which are sensitive to the Transient Mark mode." :global t :init-value (not noninteractive) + :initialize 'custom-initialize-delay :group 'editing-basics) ;; The variable transient-mark-mode is ugly: it can take on special @@ -6056,7 +6105,17 @@ PREFIX is the string that represents this modifier in an event type symbol." (kp-subtract ?-) (kp-decimal ?.) (kp-divide ?/) - (kp-equal ?=))) + (kp-equal ?=) + ;; Do the same for various keys that are represented as symbols under + ;; GUIs but naturally correspond to characters. + (backspace 127) + (delete 127) + (tab ?\t) + (linefeed ?\n) + (clear ?\C-l) + (return ?\C-m) + (escape ?\e) + )) ;;;; ;;;; forking a twin copy of a buffer. diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el index a942d09c6a0..0e72d4c233a 100644 --- a/lisp/smerge-mode.el +++ b/lisp/smerge-mode.el @@ -89,8 +89,7 @@ Used in `smerge-diff-base-mine' and related functions." (:foreground "cyan"))) "Face for your code." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-mine-face 'face-alias 'smerge-mine) +(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1") (defvar smerge-mine-face 'smerge-mine) (defface smerge-other @@ -100,8 +99,7 @@ Used in `smerge-diff-base-mine' and related functions." (:foreground "lightgreen"))) "Face for the other code." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-other-face 'face-alias 'smerge-other) +(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1") (defvar smerge-other-face 'smerge-other) (defface smerge-base @@ -113,8 +111,7 @@ Used in `smerge-diff-base-mine' and related functions." (:foreground "orange"))) "Face for the base code." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-base-face 'face-alias 'smerge-base) +(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1") (defvar smerge-base-face 'smerge-base) (defface smerge-markers @@ -124,8 +121,7 @@ Used in `smerge-diff-base-mine' and related functions." (:background "grey30"))) "Face for the conflict markers." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-markers-face 'face-alias 'smerge-markers) +(define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1") (defvar smerge-markers-face 'smerge-markers) (defface smerge-refined-change @@ -371,9 +367,8 @@ according to `smerge-match-conflict'.") ;; during font-locking so inhibit-modification-hooks is non-nil, so we ;; can't just modify the buffer and expect font-lock to be triggered as in: ;; (put-text-property beg end 'smerge-force-highlighting nil) - (let ((modified (buffer-modified-p))) - (remove-text-properties beg end '(fontified nil)) - (restore-buffer-modified-p modified))) + (with-silent-modifications + (remove-text-properties beg end '(fontified nil)))) (defun smerge-popup-context-menu (event) "Pop up the Smerge mode context menu under mouse." @@ -1019,9 +1014,10 @@ repeating the command will highlight other 2 parts." (n2 (if (eq part 3) 2 3))) (smerge-ensure-match n1) (smerge-ensure-match n2) - (put-text-property (match-beginning 0) (1+ (match-beginning 0)) - 'smerge-refine-part - (cons (buffer-chars-modified-tick) part)) + (with-silent-modifications + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'smerge-refine-part + (cons (buffer-chars-modified-tick) part))) (smerge-refine-subst (match-beginning n1) (match-end n1) (match-beginning n2) (match-end n2) '((smerge . refine) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index df6cd0bc005..38d2327d36b 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1291,7 +1291,7 @@ and the existence of packages." (if (eq major-mode 'speedbar-mode) ;; XEmacs may let us get in here in other mode buffers. (speedbar-item-info))) - (t (speedbar-message nil))))))) + (error (speedbar-message nil))))))) (defun speedbar-show-info-under-mouse () "Call the info function for the line under the mouse." diff --git a/lisp/startup.el b/lisp/startup.el index c28a2fe599c..c3cfcdcc56a 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -366,8 +366,6 @@ from being initialized." string) :group 'auto-save) -(defvar emacs-quick-startup nil) - (defvar emacs-basic-display nil) (defvar init-file-debug nil) @@ -388,13 +386,12 @@ from being initialized." Warning Warning!!! Pure space overflow !!!Warning Warning \(See the node Pure Storage in the Lisp manual for details.)\n") -(defvar tutorial-directory nil - "Directory containing the Emacs TUTORIAL files.") - -;; Get correct value in a dumped, installed Emacs. -(eval-at-startup - (setq tutorial-directory (file-name-as-directory - (expand-file-name "tutorials" data-directory)))) +(defcustom tutorial-directory + (file-name-as-directory (expand-file-name "tutorials" data-directory)) + "Directory containing the Emacs TUTORIAL files." + :group 'installation + :type 'directory + :initialize 'custom-initialize-delay) (defun normal-top-level-add-subdirs-to-load-path () "Add all subdirectories of current directory to `load-path'. @@ -501,8 +498,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (delete (concat "PWD=" pwd) process-environment))))) (setq default-directory (abbreviate-file-name default-directory)) - (let ((menubar-bindings-done nil) - (old-face-font-rescale-alist face-font-rescale-alist)) + (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect (command-line) ;; Do this again, in case .emacs defined more abbreviations. @@ -571,10 +567,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (if (fboundp 'font-menu-add-default) (font-menu-add-default)) (and window-setup-hook - (run-hooks 'window-setup-hook)) - (or menubar-bindings-done - (if (display-popup-menus-p) - (precompute-menubar-bindings))))) + (run-hooks 'window-setup-hook)))) ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the @@ -595,20 +588,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (delete display process-environment))))) ;; Precompute the keyboard equivalents in the menu bar items. -(defun precompute-menubar-bindings () - (let ((submap (lookup-key global-map [menu-bar]))) - (while submap - (and (consp (car submap)) - (symbolp (car (car submap))) - (stringp (car-safe (cdr (car submap)))) - (keymapp (cdr (cdr (car submap)))) - (progn - (x-popup-menu nil (cdr (cdr (car submap)))) - (if purify-flag - (garbage-collect)))) - (setq submap (cdr submap)))) - (setq define-key-rebound-commands t)) - ;; Command-line options supported by tty's: (defconst tty-long-option-alist '(("--name" . "-name") @@ -717,10 +696,8 @@ opening the first frame (e.g. open a connection to an X server).") after-init-time nil command-line-default-directory default-directory) - ;; Choose a reasonable location for temporary files. - (custom-reevaluate-setting 'temporary-file-directory) - (custom-reevaluate-setting 'small-temporary-file-directory) - (custom-reevaluate-setting 'auto-save-file-name-transforms) + ;; Force recomputation, in case it was computed during the dump. + (setq abbreviated-home-dir nil) ;; See if we should import version-control from the environment variable. (let ((vc (getenv "VERSION_CONTROL"))) @@ -741,55 +718,13 @@ opening the first frame (e.g. open a connection to an X server).") ;; Set the default strings to display in mode line for ;; end-of-line formats that aren't native to this platform. (cond - ((memq system-type '(ms-dos windows-nt emx)) + ((memq system-type '(ms-dos windows-nt)) (setq eol-mnemonic-unix "(Unix)" eol-mnemonic-mac "(Mac)")) - ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the - ;; abbreviated strings `/' and `:' set in coding.c for them. - ((eq system-type 'macos) - (setq eol-mnemonic-dos "(DOS)")) (t ; this is for Unix/GNU/Linux systems (setq eol-mnemonic-dos "(DOS)" eol-mnemonic-mac "(Mac)"))) - ;; Make sure window system's init file was loaded in loadup.el if - ;; using a window system. - (condition-case error - (unless noninteractive - (if (and initial-window-system - (not (featurep - (intern - (concat (symbol-name initial-window-system) "-win"))))) - (error "Unsupported window system `%s'" initial-window-system)) - ;; Process window-system specific command line parameters. - (setq command-line-args - (funcall - (or (cdr (assq initial-window-system handle-args-function-alist)) - (error "Unsupported window system `%s'" initial-window-system)) - command-line-args)) - ;; Initialize the window system. (Open connection, etc.) - (funcall - (or (cdr (assq initial-window-system window-system-initialization-alist)) - (error "Unsupported window system `%s'" initial-window-system)))) - ;; If there was an error, print the error message and exit. - (error - (princ - (if (eq (car error) 'error) - (apply 'concat (cdr error)) - (if (memq 'file-error (get (car error) 'error-conditions)) - (format "%s: %s" - (nth 1 error) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr (cdr error)) ", ")) - (format "%s: %s" - (get (car error) 'error-message) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr error) ", ")))) - 'external-debugging-output) - (terpri 'external-debugging-output) - (setq initial-window-system nil) - (kill-emacs))) - (set-locale-environment nil) ;; Convert preloaded file names in load-history to absolute. @@ -862,7 +797,7 @@ opening the first frame (e.g. open a connection to an X server).") ((member argi '("-Q" "-quick")) (setq init-file-user nil site-run-file nil - emacs-quick-startup t)) + inhibit-x-resources t)) ((member argi '("-D" "-basic-display")) (setq no-blinking-cursor t emacs-basic-display t) @@ -894,6 +829,46 @@ opening the first frame (e.g. open a connection to an X server).") (and command-line-args (setcdr command-line-args args))) + ;; Make sure window system's init file was loaded in loadup.el if + ;; using a window system. + ;; Initialize the window-system only after processing the command-line + ;; args so that -Q can influence this initialization. + (condition-case error + (unless noninteractive + (if (and initial-window-system + (not (featurep + (intern + (concat (symbol-name initial-window-system) "-win"))))) + (error "Unsupported window system `%s'" initial-window-system)) + ;; Process window-system specific command line parameters. + (setq command-line-args + (funcall + (or (cdr (assq initial-window-system handle-args-function-alist)) + (error "Unsupported window system `%s'" initial-window-system)) + command-line-args)) + ;; Initialize the window system. (Open connection, etc.) + (funcall + (or (cdr (assq initial-window-system window-system-initialization-alist)) + (error "Unsupported window system `%s'" initial-window-system)))) + ;; If there was an error, print the error message and exit. + (error + (princ + (if (eq (car error) 'error) + (apply 'concat (cdr error)) + (if (memq 'file-error (get (car error) 'error-conditions)) + (format "%s: %s" + (nth 1 error) + (mapconcat (lambda (obj) (prin1-to-string obj t)) + (cdr (cdr error)) ", ")) + (format "%s: %s" + (get (car error) 'error-message) + (mapconcat (lambda (obj) (prin1-to-string obj t)) + (cdr error) ", ")))) + 'external-debugging-output) + (terpri 'external-debugging-output) + (setq initial-window-system nil) + (kill-emacs))) + (run-hooks 'before-init-hook) ;; Under X Window, this creates the X frame and deletes the terminal frame. @@ -928,19 +903,13 @@ opening the first frame (e.g. open a connection to an X server).") ;; Otherwise, enable tool-bar-mode. (tool-bar-mode 1))) - ;; Can't do this init in defcustom because the relevant variables - ;; are not set. - (custom-reevaluate-setting 'blink-cursor-mode) - (custom-reevaluate-setting 'tooltip-mode) - (custom-reevaluate-setting 'global-font-lock-mode) - (custom-reevaluate-setting 'mouse-wheel-down-event) - (custom-reevaluate-setting 'mouse-wheel-up-event) - (custom-reevaluate-setting 'file-name-shadow-mode) - (custom-reevaluate-setting 'send-mail-function) - (custom-reevaluate-setting 'focus-follows-mouse) - (custom-reevaluate-setting 'global-auto-composition-mode) - (custom-reevaluate-setting 'transient-mark-mode) - (custom-reevaluate-setting 'auto-encryption-mode) + ;; Re-evaluate predefined variables whose initial value depends on + ;; the runtime context. + (mapc 'custom-reevaluate-setting + ;; Initialize them in the same order they were loaded, in case there + ;; are dependencies between them. + (prog1 (nreverse custom-delayed-init-variables) + (setq custom-delayed-init-variables nil))) (normal-erase-is-backspace-setup-frame) @@ -1016,7 +985,7 @@ opening the first frame (e.g. open a connection to an X server).") debug-on-error-should-be-set (debug-on-error-initial (if (eq init-file-debug t) 'startup init-file-debug)) - (orig-enable-multibyte default-enable-multibyte-characters)) + (orig-enable-multibyte (default-value 'enable-multibyte-characters))) (let ((debug-on-error debug-on-error-initial) ;; This function actually reads the init files. (inner @@ -1126,8 +1095,9 @@ the `--debug-init' option to view a complete error backtrace." debug-on-error-from-init-file debug-on-error))) (if debug-on-error-should-be-set (setq debug-on-error debug-on-error-from-init-file)) - (unless (or default-enable-multibyte-characters - (eq orig-enable-multibyte default-enable-multibyte-characters)) + (unless (or (default-value 'enable-multibyte-characters) + (eq orig-enable-multibyte (default-value + 'enable-multibyte-characters))) ;; Init file changed to unibyte. Reset existing multibyte ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*). ;; Arguably this should only be done if they're free of @@ -1193,7 +1163,7 @@ the `--debug-init' option to view a complete error backtrace." (run-hooks 'after-init-hook) ;; Decode all default-directory. - (if (and default-enable-multibyte-characters locale-coding-system) + (if (and (default-value 'enable-multibyte-characters) locale-coding-system) (save-excursion (dolist (elt (buffer-list)) (set-buffer elt) @@ -1826,68 +1796,45 @@ To quit a partially entered command, type Control-g.\n") ;; If keys have their default meanings, ;; use precomputed string to save lots of time. - (let ((c-h-accessible - ;; If normal-erase-is-backspace is used on a tty, there's - ;; no way to invoke C-h and you have to use F1 instead. - (or (not (char-table-p keyboard-translate-table)) - (eq (aref keyboard-translate-table ?\C-h) ?\C-h)))) - (if (and (eq (key-binding "\C-h") 'help-command) - (eq (key-binding "\C-xu") 'advertised-undo) - (eq (key-binding "\C-x\C-c") 'save-buffers-kill-terminal) - (eq (key-binding "\C-ht") 'help-with-tutorial) - (eq (key-binding "\C-hi") 'info) - (eq (key-binding "\C-hr") 'info-emacs-manual) - (eq (key-binding "\C-h\C-n") 'view-emacs-news)) - (let ((help (if c-h-accessible "C-h" "<f1>"))) - (insert " -Get help\t " help " (Hold down CTRL and press h) -") - (insert-button "Emacs manual" - 'action (lambda (button) (info-emacs-manual)) - 'follow-link t) - (insert " " help " r\t") - (insert-button "Browse manuals" - 'action (lambda (button) (Info-directory)) - 'follow-link t) - (insert "\t " help " i -") - (insert-button "Emacs tutorial" - 'action (lambda (button) (help-with-tutorial)) - 'follow-link t) - (insert " " help " t\tUndo changes\t C-x u -") - (insert-button "Buy manuals" - 'action (lambda (button) (view-order-manuals)) - 'follow-link t) - (insert "\t " help " C-m\tExit Emacs\t C-x C-c")) - - (insert (format " -Get help\t %s -" - (let ((where (where-is-internal 'help-command nil t))) - (if where - (key-description where) - "M-x help")))) - (insert-button "Emacs manual" - 'action (lambda (button) (info-emacs-manual)) - 'follow-link t) - (insert (substitute-command-keys"\t \\[info-emacs-manual]\t")) - (insert-button "Browse manuals" - 'action (lambda (button) (Info-directory)) - 'follow-link t) - (insert (substitute-command-keys "\t \\[info] -")) - (insert-button "Emacs tutorial" - 'action (lambda (button) (help-with-tutorial)) - 'follow-link t) - (insert (substitute-command-keys - "\t \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo] -")) - (insert-button "Buy manuals" - 'action (lambda (button) (view-order-manuals)) - 'follow-link t) - (insert (substitute-command-keys - "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]")))) + (let* ((c-h-accessible + ;; If normal-erase-is-backspace is used on a tty, there's + ;; no way to invoke C-h and you have to use F1 instead. + (or (not (char-table-p keyboard-translate-table)) + (eq (aref keyboard-translate-table ?\C-h) ?\C-h))) + (minor-mode-overriding-map-alist + (cons (cons (not c-h-accessible) + ;; If C-h can't be invoked, temporarily disable its + ;; binding, so where-is uses alternative bindings. + (let ((map (make-sparse-keymap))) + (define-key map [?\C-h] 'undefined) + map)) + minor-mode-overriding-map-alist))) + + (insert (format "\nGet help\t %s\n" + (let ((where (where-is-internal 'help-command nil t))) + (cond + ((equal where [?\C-h]) + "C-h (Hold down CTRL and press h)") + (where (key-description where)) + (t "M-x help"))))) + (insert-button "Emacs manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert (substitute-command-keys"\t \\[info-emacs-manual]\t")) + (insert-button "Browse manuals" + 'action (lambda (button) (Info-directory)) + 'follow-link t) + (insert (substitute-command-keys "\t \\[info]\n")) + (insert-button "Emacs tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert (substitute-command-keys + "\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n")) + (insert-button "Buy manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert (substitute-command-keys + "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]"))) ;; Say how to use the menu bar with the keyboard. (insert "\n") @@ -2039,8 +1986,7 @@ Type \\[describe-distribution] for information on ")) (let ((buffer (get-buffer-create " *temp*"))) (prog1 (condition-case nil - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (insert-file-contents user-init-file) (re-search-forward (concat @@ -2094,8 +2040,11 @@ A fancy display is used on graphic displays, normal otherwise." first-file-buffer) (when command-line-args-left ;; We have command args; process them. - (let ((dir command-line-default-directory) - tem + ;; Note that any local variables in this function affect the + ;; ability of -f batch-byte-compile to detect free variables. + ;; So we give some of them with common names a cl1- prefix. + (let ((cl1-dir command-line-default-directory) + cl1-tem ;; This approach loses for "-batch -L DIR --eval "(require foo)", ;; if foo is intended to be found in DIR. ;; @@ -2113,19 +2062,18 @@ A fancy display is used on graphic displays, normal otherwise." ;; This includes our standard options' long versions ;; and long versions of what's on command-switch-alist. (longopts - (append '(("--funcall") ("--load") ("--insert") ("--kill") - ("--directory") ("--eval") ("--execute") ("--no-splash") - ("--find-file") ("--visit") ("--file") ("--no-desktop")) - (mapcar (lambda (elt) - (list (concat "-" (car elt)))) + (append '("--funcall" "--load" "--insert" "--kill" + "--directory" "--eval" "--execute" "--no-splash" + "--find-file" "--visit" "--file" "--no-desktop") + (mapcar (lambda (elt) (concat "-" (car elt))) command-switch-alist))) - (line 0) - (column 0)) + (cl1-line 0) + (cl1-column 0)) ;; Add the long X options to longopts. (dolist (tem command-line-x-option-alist) (if (string-match "^--" (car tem)) - (push (list (car tem)) longopts))) + (push (car tem) longopts))) ;; Add the long NS options to longopts. (dolist (tem command-line-ns-option-alist) @@ -2153,7 +2101,7 @@ A fancy display is used on graphic displays, normal otherwise." (if (eq completion t) (setq argi (substring argi 1)) (if (stringp completion) - (let ((elt (assoc completion longopts))) + (let ((elt (member completion longopts))) (or elt (error "Option `%s' is ambiguous" argi)) (setq argi (substring (car elt) 1))) @@ -2161,12 +2109,12 @@ A fancy display is used on graphic displays, normal otherwise." argi orig-argi))))) ;; Execute the option. - (cond ((setq tem (assoc argi command-switch-alist)) + (cond ((setq cl1-tem (assoc argi command-switch-alist)) (if argval (let ((command-line-args-left (cons argval command-line-args-left))) - (funcall (cdr tem) argi)) - (funcall (cdr tem) argi))) + (funcall (cdr cl1-tem) argi)) + (funcall (cdr cl1-tem) argi))) ((equal argi "-no-splash") (setq inhibit-startup-screen t)) @@ -2175,22 +2123,22 @@ A fancy display is used on graphic displays, normal otherwise." "-funcall" "-e")) ; what the source used to say (setq inhibit-startup-screen t) - (setq tem (intern (or argval (pop command-line-args-left)))) - (if (commandp tem) - (command-execute tem) - (funcall tem))) + (setq cl1-tem (intern (or argval (pop command-line-args-left)))) + (if (commandp cl1-tem) + (command-execute cl1-tem) + (funcall cl1-tem))) ((member argi '("-eval" "-execute")) (setq inhibit-startup-screen t) (eval (read (or argval (pop command-line-args-left))))) ((member argi '("-L" "-directory")) - (setq tem (expand-file-name + (setq cl1-tem (expand-file-name (command-line-normalize-file-name (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons tem (cdr splice))) + (cond (splice (setcdr splice (cons cl1-tem (cdr splice))) (setq splice (cdr splice))) - (t (setq load-path (cons tem load-path) + (t (setq load-path (cons cl1-tem load-path) splice load-path)))) ((member argi '("-l" "-load")) @@ -2214,10 +2162,10 @@ A fancy display is used on graphic displays, normal otherwise." ((equal argi "-insert") (setq inhibit-startup-screen t) - (setq tem (or argval (pop command-line-args-left))) - (or (stringp tem) + (setq cl1-tem (or argval (pop command-line-args-left))) + (or (stringp cl1-tem) (error "File name omitted from `-insert' option")) - (insert-file-contents (command-line-normalize-file-name tem))) + (insert-file-contents (command-line-normalize-file-name cl1-tem))) ((equal argi "-kill") (kill-emacs t)) @@ -2230,40 +2178,42 @@ A fancy display is used on graphic displays, normal otherwise." (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) ((string-match "^\\+[0-9]+\\'" argi) - (setq line (string-to-number argi))) + (setq cl1-line (string-to-number argi))) ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) - (setq line (string-to-number (match-string 1 argi)) - column (string-to-number (match-string 2 argi)))) + (setq cl1-line (string-to-number (match-string 1 argi)) + cl1-column (string-to-number (match-string 2 argi)))) - ((setq tem (assoc argi command-line-x-option-alist)) + ((setq cl1-tem (assoc argi command-line-x-option-alist)) ;; Ignore X-windows options and their args if not using X. (setq command-line-args-left - (nthcdr (nth 1 tem) command-line-args-left))) + (nthcdr (nth 1 cl1-tem) command-line-args-left))) - ((setq tem (assoc argi command-line-ns-option-alist)) + ((setq cl1-tem (assoc argi command-line-ns-option-alist)) ;; Ignore NS-windows options and their args if not using NS. (setq command-line-args-left - (nthcdr (nth 1 tem) command-line-args-left))) + (nthcdr (nth 1 cl1-tem) command-line-args-left))) ((member argi '("-find-file" "-file" "-visit")) (setq inhibit-startup-screen t) ;; An explicit option to specify visiting a file. - (setq tem (or argval (pop command-line-args-left))) - (unless (stringp tem) + (setq cl1-tem (or argval (pop command-line-args-left))) + (unless (stringp cl1-tem) (error "File name omitted from `%s' option" argi)) (setq file-count (1+ file-count)) (let ((file (expand-file-name - (command-line-normalize-file-name tem) dir))) + (command-line-normalize-file-name cl1-tem) + cl1-dir))) (if (= file-count 1) (setq first-file-buffer (find-file file)) (find-file-other-window file))) - (or (zerop line) - (goto-line line)) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)) + (unless (zerop cl1-line) + (goto-char (point-min)) + (forward-line (1- cl1-line))) + (setq cl1-line 0) + (unless (< cl1-column 1) + (move-to-column (1- cl1-column))) + (setq cl1-column 0)) ((equal argi "--") (setq just-files t)) @@ -2286,18 +2236,19 @@ A fancy display is used on graphic displays, normal otherwise." (let ((file (expand-file-name (command-line-normalize-file-name orig-argi) - dir))) + cl1-dir))) (cond ((= file-count 1) (setq first-file-buffer (find-file file))) (inhibit-startup-screen (find-file-other-window file)) (t (find-file file)))) - (or (zerop line) - (goto-line line)) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)))))) + (unless (zerop cl1-line) + (goto-char (point-min)) + (forward-line (1- cl1-line))) + (setq cl1-line 0) + (unless (< cl1-column 1) + (move-to-column (1- cl1-column))) + (setq cl1-column 0)))))) ;; In unusual circumstances, the execution of Lisp code due ;; to command-line options can cause the last visible frame ;; to be deleted. In this case, kill emacs to avoid an @@ -2321,7 +2272,7 @@ A fancy display is used on graphic displays, normal otherwise." (if (or inhibit-startup-screen initial-buffer-choice noninteractive - emacs-quick-startup) + inhibit-x-resources) ;; Not displaying a startup screen. If 3 or more files ;; visited, and not all visible, show user what they all are. @@ -2375,6 +2326,9 @@ A fancy display is used on graphic displays, normal otherwise." ;; However, /// at the beginning is supposed to mean just /, not //. (if (string-match "^///+" file) (setq file (replace-match "/" t t file))) + (and (memq system-type '(ms-dos windows-nt)) + (string-match "^[A-Za-z]:\\(\\\\[\\\\/]\\)" file) ; C:\/ or C:\\ + (setq file (replace-match "/" t t file 1))) (while (string-match "//+" file 1) (setq file (replace-match "/" t t file))) file)) diff --git a/lisp/strokes.el b/lisp/strokes.el index 673a0fb50d5..75278f69d13 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1187,14 +1187,16 @@ the stroke as a character in some language." (let ((char (or (car rainbow-chars) ?\.))) (loop for i from 0 to 2 do (loop for j from 0 to 2 do - (goto-line (+ 16 i y)) + (goto-char (point-min)) + (forward-line (+ 15 i y)) (forward-char (+ 1 j x)) (delete-char 1) (insert char))) (setq rainbow-chars (cdr rainbow-chars) lift-flag nil)) ;; Otherwise, just plot the point... - (goto-line (+ 17 y)) + (goto-char (point-min)) + (forward-line (+ 16 y)) (forward-char (+ 2 x)) (subst-char-in-region (point) (1+ (point)) ?\s ?\*))) ((strokes-lift-p point) diff --git a/lisp/subr.el b/lisp/subr.el index f2709f3b777..ac8743e683e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -119,13 +119,18 @@ BODY should be a list of Lisp expressions. ;; depend on backquote.el. (list 'function (cons 'lambda cdr))) +(if (null (featurep 'cl)) + (progn + ;; If we reload subr.el after having loaded CL, be careful not to + ;; overwrite CL's extended definition of `dolist', `dotimes', + ;; `declare', `push' and `pop'. (defmacro push (newelt listname) "Add NEWELT to the list stored in the symbol LISTNAME. This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)). LISTNAME must be a symbol." (declare (debug (form sexp))) (list 'setq listname - (list 'cons newelt listname))) + (list 'cons newelt listname))) (defmacro pop (listname) "Return the first element of LISTNAME's value, and remove it from the list. @@ -134,8 +139,9 @@ If the value is nil, `pop' returns nil but does not actually change the list." (declare (debug (sexp))) (list 'car - (list 'prog1 listname - (list 'setq listname (list 'cdr listname))))) + (list 'prog1 listname + (list 'setq listname (list 'cdr listname))))) +)) (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. @@ -155,6 +161,11 @@ value of last one, or nil if there are none. (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) +(if (null (featurep 'cl)) + (progn + ;; If we reload subr.el after having loaded CL, be careful not to + ;; overwrite CL's extended definition of `dolist', `dotimes', + ;; `declare', `push' and `pop'. (defvar --dolist-tail-- nil "Temporary variable used in `dolist' expansion.") @@ -207,6 +218,7 @@ the return value (nil if RESULT is omitted). Treated as a declaration when used at the right place in a `defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" nil) +)) (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. @@ -726,8 +738,8 @@ in a cleaner way with command remapping, like this: ;;;; The global keymap tree. -;;; global-map, esc-map, and ctl-x-map have their values set up in -;;; keymap.c; we just give them docstrings here. +;; global-map, esc-map, and ctl-x-map have their values set up in +;; keymap.c; we just give them docstrings here. (defvar global-map nil "Default global keymap mapping Emacs keyboard input into commands. @@ -1000,6 +1012,45 @@ and `event-end' functions." ;;;; Obsolescent names for functions. +;; Special "default-FOO" variables which contain the default value of +;; the "FOO" variable are nasty. Their implementation is brittle, and +;; slows down several unrelated variable operations; furthermore, they +;; can lead to really odd behavior if you decide to make them +;; buffer-local. + +;; Not used at all in Emacs, last time I checked: +(make-obsolete-variable 'default-mode-line-format 'mode-line-format "23.2") +(make-obsolete-variable 'default-header-line-format 'header-line-format "23.2") +(make-obsolete-variable 'default-line-spacing 'line-spacing "23.2") +(make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2") +(make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2") +(make-obsolete-variable 'default-direction-reversed 'direction-reversed "23.2") +(make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2") +(make-obsolete-variable 'default-left-margin 'left-margin "23.2") +(make-obsolete-variable 'default-tab-width 'tab-width "23.2") +(make-obsolete-variable 'default-case-fold-search 'case-fold-search "23.2") +(make-obsolete-variable 'default-left-margin-width 'left-margin-width "23.2") +(make-obsolete-variable 'default-right-margin-width 'right-margin-width "23.2") +(make-obsolete-variable 'default-left-fringe-width 'left-fringe-width "23.2") +(make-obsolete-variable 'default-right-fringe-width 'right-fringe-width "23.2") +(make-obsolete-variable 'default-fringes-outside-margins 'fringes-outside-margins "23.2") +(make-obsolete-variable 'default-scroll-bar-width 'scroll-bar-width "23.2") +(make-obsolete-variable 'default-vertical-scroll-bar 'vertical-scroll-bar "23.2") +(make-obsolete-variable 'default-indicate-empty-lines 'indicate-empty-lines "23.2") +(make-obsolete-variable 'default-indicate-buffer-boundaries 'indicate-buffer-boundaries "23.2") +(make-obsolete-variable 'default-fringe-indicator-alist 'fringe-indicator-alist "23.2") +(make-obsolete-variable 'default-fringe-cursor-alist 'fringe-cursor-alist "23.2") +(make-obsolete-variable 'default-scroll-up-aggressively 'scroll-up-aggressively "23.2") +(make-obsolete-variable 'default-scroll-down-aggressively 'scroll-down-aggressively "23.2") +(make-obsolete-variable 'default-fill-column 'fill-column "23.2") +(make-obsolete-variable 'default-cursor-type 'cursor-type "23.2") +(make-obsolete-variable 'default-buffer-file-type 'buffer-file-type "23.2") +(make-obsolete-variable 'default-cursor-in-non-selected-windows 'cursor-in-non-selected-windows "23.2") +(make-obsolete-variable 'default-buffer-file-coding-system 'buffer-file-coding-system "23.2") +(make-obsolete-variable 'default-major-mode 'major-mode "23.2") +(make-obsolete-variable 'default-enable-multibyte-characters + "use enable-multibyte-characters or set-buffer-multibyte instead" "23.2") + (define-obsolete-function-alias 'window-dot 'window-point "22.1") (define-obsolete-function-alias 'set-window-dot 'set-window-point "22.1") (define-obsolete-function-alias 'read-input 'read-string "22.1") @@ -1021,12 +1072,6 @@ is converted into a string by expressing it in decimal." (defun makehash (&optional test) (make-hash-table :test (or test 'eql))) (make-obsolete 'makehash 'make-hash-table "22.1") -;; Some programs still use this as a function. -(defun baud-rate () - "Return the value of the `baud-rate' variable." - baud-rate) -(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15") - ;; These are used by VM and some old programs (defalias 'focus-frame 'ignore "") (make-obsolete 'focus-frame "it does nothing." "22.1") @@ -1037,6 +1082,7 @@ is converted into a string by expressing it in decimal." ;;;; Obsolescence declarations for variables, and aliases. +(make-obsolete-variable 'define-key-rebound-commands nil "23.2") (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") (make-obsolete 'window-redisplay-end-trigger nil "23.1") (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") @@ -1551,22 +1597,6 @@ and the file name is displayed in the echo area." ;;;; Specifying things to do later. -(defmacro eval-at-startup (&rest body) - "Make arrangements to evaluate BODY when Emacs starts up. -If this is run after Emacs startup, evaluate BODY immediately. -Always returns nil. - -This works by adding a function to `before-init-hook'. -That function's doc string says which file created it." - `(progn - (if command-line-processed - (progn . ,body) - (add-hook 'before-init-hook - '(lambda () ,(concat "From " (or load-file-name "no file")) - . ,body) - t)) - nil)) - (defun load-history-regexp (file) "Form a regexp to find FILE in `load-history'. FILE, a string, is described in the function `eval-after-load'." @@ -1646,25 +1676,39 @@ This function makes or adds to an entry on `after-load-alist'." (featurep file)) (eval form)))) +(defvar after-load-functions nil + "Special hook run after loading a file. +Each function there is called with a single argument, the absolute +name of the file just loaded.") + (defun do-after-load-evaluation (abs-file) "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. -ABS-FILE, a string, should be the absolute true name of a file just loaded." - (let ((after-load-elts after-load-alist) - a-l-element file-elements file-element form) - (while after-load-elts - (setq a-l-element (car after-load-elts) - after-load-elts (cdr after-load-elts)) - (when (and (stringp (car a-l-element)) - (string-match (car a-l-element) abs-file)) - (while (setq a-l-element (cdr a-l-element)) ; discard the file name - (setq form (car a-l-element)) - (eval form)))))) +ABS-FILE, a string, should be the absolute true name of a file just loaded. +This function is called directly from the C code." + ;; Run the relevant eval-after-load forms. + (mapc #'(lambda (a-l-element) + (when (and (stringp (car a-l-element)) + (string-match-p (car a-l-element) abs-file)) + ;; discard the file name regexp + (mapc #'eval (cdr a-l-element)))) + after-load-alist) + ;; Complain when the user uses obsolete files. + (when (string-match-p "/obsolete/[^/]*\\'" abs-file) + (run-with-timer 0 nil + (lambda (file) + (message "Package %s is obsolete!" + (substring file 0 + (string-match "\\.elc?\\>" file)))) + (file-name-nondirectory abs-file))) + ;; Finally, run any other hook. + (run-hook-with-args 'after-load-functions abs-file)) (defun eval-next-after-load (file) "Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name." (eval-after-load file (read))) +(make-obsolete 'eval-next-after-load `eval-after-load "23.2") ;;;; Process stuff. @@ -2714,6 +2758,29 @@ See also `with-temp-file' and `with-output-to-string'." (and (buffer-name ,temp-buffer) (kill-buffer ,temp-buffer))))))) +(defmacro with-silent-modifications (&rest body) + "Execute BODY, pretending it does not modifies the buffer. +If BODY performs real modifications to the buffer's text, other +than cosmetic ones, undo data may become corrupted. +Typically used around modifications of text-properties which do not really +affect the buffer's content." + (declare (debug t) (indent 0)) + (let ((modified (make-symbol "modified"))) + `(let* ((,modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-modification-hooks t) + deactivate-mark + ;; Avoid setting and removing file locks and checking + ;; buffer's uptodate-ness w.r.t the underlying file. + buffer-file-name + buffer-file-truename) + (unwind-protect + (progn + ,@body) + (unless ,modified + (restore-buffer-modified-p nil)))))) + (defmacro with-output-to-string (&rest body) "Execute BODY, return the text it sent to `standard-output', as a string." (declare (indent 0) (debug t)) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index e0c78c8b781..762ecc07284 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,7 +1,8 @@ ;;; tar-mode.el --- simple editing of tar files from GNU emacs ;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Maintainer: FSF @@ -267,7 +268,7 @@ write-date, checksum, link-type, and link-name." (setq name (concat (substring string tar-prefix-offset (1- (match-end 0))) "/" name))) - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) (setq name (decode-coding-string name coding) linkname @@ -819,7 +820,7 @@ appear on disk when you save the tar-file's buffer." (if (or (not coding) (eq (coding-system-type coding) 'undecided)) (setq coding (detect-coding-region start end t))) - (if (and default-enable-multibyte-characters + (if (and (default-value 'enable-multibyte-characters) (coding-system-get coding :for-unibyte)) (with-current-buffer buffer (set-buffer-multibyte nil))) diff --git a/lisp/term.el b/lisp/term.el index 4511c394fd2..b7eb9fd1845 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -399,7 +399,8 @@ (defconst term-protocol-version "0.96") (eval-when-compile - (require 'ange-ftp)) + (require 'ange-ftp) + (require 'cl)) (require 'ring) (require 'ehelp) @@ -739,12 +740,18 @@ Buffer local variable.") ;;; faces -mm -(defcustom term-default-fg-color (face-foreground term-current-face) +(defcustom term-default-fg-color + ;; FIXME: This depends on the current frame, so depending on when + ;; it's loaded, the result may be different. + (face-foreground term-current-face) "Default color for foreground in `term'." :group 'term :type 'string) -(defcustom term-default-bg-color (face-background term-current-face) +(defcustom term-default-bg-color + ;; FIXME: This depends on the current frame, so depending on when + ;; it's loaded, the result may be different. + (face-background term-current-face) "Default color for background in `term'." :group 'term :type 'string) @@ -959,6 +966,20 @@ is buffer-local.") (setq i (1+ i))) dt)) +(defun term-ansi-reset () + (setq term-current-face (nconc + (if term-default-bg-color + (list :background term-default-bg-color)) + (if term-default-fg-color + (list :foreground term-default-fg-color)))) + (setq term-ansi-current-underline nil) + (setq term-ansi-current-bold nil) + (setq term-ansi-current-reverse nil) + (setq term-ansi-current-color 0) + (setq term-ansi-current-invisible nil) + (setq term-ansi-face-already-done t) + (setq term-ansi-current-bg-color 0)) + (defun term-mode () "Major mode for interacting with an inferior interpreter. The interpreter name is same as buffer name, sans the asterisks. @@ -1111,8 +1132,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-pending-delete-marker) (setq term-pending-delete-marker (make-marker)) (make-local-variable 'term-current-face) - (setq term-current-face (list :background term-default-bg-color - :foreground term-default-fg-color)) + (term-ansi-reset) (make-local-variable 'term-pending-frame) (setq term-pending-frame nil) ;; Cua-mode's keybindings interfere with the term keybindings, disable it. @@ -3117,24 +3137,22 @@ See `term-prompt-regexp'." (defun term-reset-terminal () "Reset the terminal, delete all the content and set the face to the default one." (erase-buffer) + (term-ansi-reset) (setq term-current-row 0) (setq term-current-column 1) (setq term-scroll-start 0) (setq term-scroll-end term-height) (setq term-insert-mode nil) - (setq term-current-face (list :background term-default-bg-color - :foreground term-default-fg-color)) - (setq term-ansi-current-underline nil) - (setq term-ansi-current-bold nil) - (setq term-ansi-current-reverse nil) - (setq term-ansi-current-color 0) - (setq term-ansi-current-invisible nil) - (setq term-ansi-face-already-done nil) - (setq term-ansi-current-bg-color 0)) + ;; FIXME: No idea why this is here, it looks wrong. --Stef + (setq term-ansi-face-already-done nil)) ;; New function to deal with ansi colorized output, as you can see you can ;; have any bold/underline/fg/bg/reverse combination. -mm +(defvar term-bold-attribute '(:weight bold) + "Attribute to use for the bold terminal attribute. +Set it to nil to disable bold.") + (defun term-handle-colors-array (parameter) (cond @@ -3185,15 +3203,7 @@ See `term-prompt-regexp'." ;; 0 (Reset) or unknown (reset anyway) (t - (setq term-current-face (list :background term-default-bg-color - :foreground term-default-fg-color)) - (setq term-ansi-current-underline nil) - (setq term-ansi-current-bold nil) - (setq term-ansi-current-reverse nil) - (setq term-ansi-current-color 0) - (setq term-ansi-current-invisible nil) - (setq term-ansi-face-already-done t) - (setq term-ansi-current-bg-color 0))) + (term-ansi-reset))) ;; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d" ;; term-ansi-current-underline @@ -3206,65 +3216,47 @@ See `term-prompt-regexp'." (unless term-ansi-face-already-done - (if term-ansi-current-reverse - (if term-ansi-current-invisible - (setq term-current-face - (if (= term-ansi-current-color 0) - (list :background - term-default-fg-color - :foreground - term-default-fg-color) - (list :background - (elt ansi-term-color-vector term-ansi-current-color) - :foreground - (elt ansi-term-color-vector term-ansi-current-color))) - ;; No need to bother with anything else if it's invisible - ) - (setq term-current-face - (list :background - (if (= term-ansi-current-color 0) - term-default-fg-color - (elt ansi-term-color-vector term-ansi-current-color)) - :foreground - (if (= term-ansi-current-bg-color 0) - term-default-bg-color - (elt ansi-term-color-vector term-ansi-current-bg-color)))) - (when term-ansi-current-bold - (setq term-current-face - (append '(:weight bold) term-current-face))) - (when term-ansi-current-underline - (setq term-current-face - (append '(:underline t) term-current-face)))) - (if term-ansi-current-invisible - (setq term-current-face - (if (= term-ansi-current-bg-color 0) - (list :background - term-default-bg-color - :foreground - term-default-bg-color) - (list :foreground - (elt ansi-term-color-vector term-ansi-current-bg-color) - :background - (elt ansi-term-color-vector term-ansi-current-bg-color))) - ;; No need to bother with anything else if it's invisible - ) - (setq term-current-face - (list :foreground - (if (= term-ansi-current-color 0) - term-default-fg-color - (elt ansi-term-color-vector term-ansi-current-color)) - :background - (if (= term-ansi-current-bg-color 0) - term-default-bg-color - (elt ansi-term-color-vector term-ansi-current-bg-color)))) - (when term-ansi-current-bold - (setq term-current-face - (append '(:weight bold) term-current-face))) - (when term-ansi-current-underline - (setq term-current-face - (append '(:underline t) term-current-face)))))) + (if term-ansi-current-invisible + (let ((color + (if term-ansi-current-reverse + (if (= term-ansi-current-color 0) + term-default-fg-color + (elt ansi-term-color-vector term-ansi-current-color)) + (if (= term-ansi-current-bg-color 0) + term-default-bg-color + (elt ansi-term-color-vector term-ansi-current-bg-color))))) + (setq term-current-face + (list :background color + :foreground color)) + ) ;; No need to bother with anything else if it's invisible. + + (setq term-current-face + (if term-ansi-current-reverse + (if (= term-ansi-current-color 0) + (list :background term-default-fg-color + :foreground term-default-bg-color) + (list :background + (elt ansi-term-color-vector term-ansi-current-color) + :foreground + (elt ansi-term-color-vector term-ansi-current-bg-color))) + + (if (= term-ansi-current-color 0) + (list :foreground term-default-fg-color + :background term-default-bg-color) + (list :foreground + (elt ansi-term-color-vector term-ansi-current-color) + :background + (elt ansi-term-color-vector term-ansi-current-bg-color))))) + + (when term-ansi-current-bold + (setq term-current-face + (append term-bold-attribute term-current-face))) + (when term-ansi-current-underline + (setq term-current-face + (list* :underline t term-current-face))))) ;; (message "Debug %S" term-current-face) + ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef (setq term-ansi-face-already-done nil)) @@ -3465,7 +3457,8 @@ The top-most line is line 0." (set-buffer buffer) (save-restriction (widen) - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) (setq pos (point)) (setq overlay-arrow-string "=>") (or overlay-arrow-position diff --git a/lisp/term/internal.el b/lisp/term/internal.el index 6219e7bb0b9..995605bacf0 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -1,7 +1,7 @@ ;;; internal.el --- support for PC internal terminal -;; Copyright (C) 1993, 1994, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1998, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Morten Welinder <terra@diku.dk> @@ -28,13 +28,6 @@ (defvar msdos-key-remapping-map (let ((map (make-sparse-keymap))) ;; keyboard setup -- that's simple! - (define-key map [backspace] "\177") ; Normal behavior for BS - (define-key map [delete] "\C-d") ; ... and Delete - (define-key map [tab] [?\t]) - (define-key map [linefeed] [?\n]) - (define-key map [clear] [11]) - (define-key map [return] [13]) - (define-key map [escape] [?\e]) (define-key map [M-backspace] [?\M-\d]) (define-key map [M-delete] [?\M-d]) (define-key map [M-tab] [?\M-\t]) @@ -45,15 +38,6 @@ map) "Keymap for remapping special keys on MS-DOS keyboard.") -;; These tell read-char how to convert these special chars to ASCII. -(put 'backspace 'ascii-character 127) -(put 'delete 'ascii-character 127) -(put 'tab 'ascii-character ?\t) -(put 'linefeed 'ascii-character ?\n) -(put 'clear 'ascii-character 12) -(put 'return 'ascii-character 13) -(put 'escape 'ascii-character ?\e) - (defun msdos-setup-keyboard (frame) "Setup `local-function-key-map' for MS-DOS keyboard." ;; Don't do this twice on the same display, or it would break @@ -609,7 +593,7 @@ list. You can (and should) also run it if and when the value of (set-selection-coding-system coding-dos) (IT-setup-unicode-display coding-unix) (prefer-coding-system coding-dos) - (and default-enable-multibyte-characters + (and (default-value 'enable-multibyte-characters) (setq unibyte-display-via-language-environment t)) ;; Some codepages have sporadic support for Latin-1, Greek, and ;; symbol glyphs, which don't belong to their native character diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 4435b6cbf04..399043049c1 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -101,7 +101,9 @@ ;; Set (but not used?) in frame.el. (defvar x-display-name nil - "The name of the Nextstep display on which Emacs was started.") + "The name of the window display on which Emacs was started. +On X, the display name of individual X frames is recorded in the +`display' frame parameter.") ;; nsterm.m. (defvar ns-input-file) @@ -185,33 +187,13 @@ The properties returned may include `top', `left', `height', and `width'." ;;;; Keyboard mapping. ;; These tell read-char how to convert these special chars to ASCII. -;;TODO: all terms have these, and at least the return mapping is necessary -;; for tramp to recognize the enter key. -;; Perhaps they should be moved into common code somewhere -;; (when a window system is active). -;; Remove if no problems for some time after 2008-08-06. -(put 'backspace 'ascii-character 127) -(put 'delete 'ascii-character 127) -(put 'tab 'ascii-character ?\t) (put 'S-tab 'ascii-character (logior 16 ?\t)) -(put 'linefeed 'ascii-character ?\n) -(put 'clear 'ascii-character 12) -(put 'return 'ascii-character 13) -(put 'escape 'ascii-character ?\e) - (defvar ns-alternatives-map (let ((map (make-sparse-keymap))) ;; Map certain keypad keys into ASCII characters ;; that people usually expect. - (define-key map [backspace] [?\d]) - (define-key map [delete] [?\d]) - (define-key map [tab] [?\t]) (define-key map [S-tab] [25]) - (define-key map [linefeed] [?\n]) - (define-key map [clear] [?\C-l]) - (define-key map [return] [?\C-m]) - (define-key map [escape] [?\e]) (define-key map [M-backspace] [?\M-\d]) (define-key map [M-delete] [?\M-\d]) (define-key map [M-tab] [?\M-\t]) @@ -309,7 +291,7 @@ The properties returned may include `top', `left', `height', and `width'." (defalias 'do-applescript 'ns-do-applescript) (defun x-setup-function-keys (frame) - "Set up function keys on the graphical frame FRAME." + "Set up `function-key-map' on the graphical frame FRAME." (unless (terminal-parameter frame 'x-setup-function-keys) (with-selected-frame frame (setq interprogram-cut-function 'x-select-text @@ -417,14 +399,6 @@ The properties returned may include `top', `left', `height', and `width'." (set-terminal-parameter frame 'x-setup-function-keys t))) - -;; Must come after keybindings. - -;; (fmakunbound 'clipboard-yank) -;; (fmakunbound 'clipboard-kill-ring-save) -;; (fmakunbound 'clipboard-kill-region) -;; (fmakunbound 'menu-bar-enable-clipboard) - ;; Add a couple of menus and rearrange some others; easiest just to redo toplvl ;; Note keymap defns must be given last-to-first (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) @@ -723,9 +697,10 @@ Lines are highlighted according to `ns-input-line'." (if ns-select-overlay (setq ns-select-overlay (delete-overlay ns-select-overlay))) (deactivate-mark) - (goto-line (if (consp ns-input-line) - (min (car ns-input-line) (cdr ns-input-line)) - ns-input-line))) + (goto-char (point-min)) + (forward-line (1- (if (consp ns-input-line) + (min (car ns-input-line) (cdr ns-input-line)) + ns-input-line)))) (ns-input-line (if (not ns-select-overlay) (overlay-put (setq ns-select-overlay (make-overlay (point-min) @@ -983,6 +958,46 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (format "Creation of the standard fontset failed: %s" err) :error))))) +(defvar ns-reg-to-script) ; nsfont.m + +;; This maps font registries (not exposed by NS APIs for font selection) to +;; unicode scripts (which can be mapped to unicode character ranges which are). +;; See ../international/fontset.el +(setq ns-reg-to-script + '(("iso8859-1" . latin) + ("iso8859-2" . latin) + ("iso8859-3" . latin) + ("iso8859-4" . latin) + ("iso8859-5" . cyrillic) + ("microsoft-cp1251" . cyrillic) + ("koi8-r" . cyrillic) + ("iso8859-6" . arabic) + ("iso8859-7" . greek) + ("iso8859-8" . hebrew) + ("iso8859-9" . latin) + ("iso8859-10" . latin) + ("iso8859-11" . thai) + ("tis620" . thai) + ("iso8859-13" . latin) + ("iso8859-14" . latin) + ("iso8859-15" . latin) + ("iso8859-16" . latin) + ("viscii1.1-1" . latin) + ("jisx0201" . kana) + ("jisx0208" . han) + ("jisx0212" . han) + ("jisx0213" . han) + ("gb2312.1980" . han) + ("gb18030" . han) + ("gbk-0" . han) + ("big5" . han) + ("cns11643" . han) + ("sisheng_cwnn" . bopomofo) + ("ksc5601.1987" . hangul) + ("ethiopic-unicode" . ethiopic) + ("is13194-devanagari" . indian-is13194) + ("iso10646.indian-1" . devanagari))) + ;;;; Pasteboard support. @@ -1054,14 +1069,6 @@ On Nextstep, put TEXT in the pasteboard; PUSH is ignored." (interactive) (insert (ns-get-cut-buffer-internal 'SECONDARY))) -;; PENDING: not sure what to do here.. for now interprog- are set in -;; init-fn-keys, and unsure whether these x- settings have an effect. -;;(setq interprogram-cut-function 'x-select-text -;; interprogram-paste-function 'x-cut-buffer-or-selection-value) -;; These only needed if above not working. - -(set-face-background 'region "ns_selection_color") - ;;;; Scrollbar handling. @@ -1250,7 +1257,6 @@ the operating system.") ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings. (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) - (mouse-wheel-mode 1) (setq ns-initialized t)) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 4b8d48ce16b..28940802ab3 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -305,9 +305,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; that this is only annoying. (setq split-window-keep-point t) - ;; Turn on support for mouse wheels - (mouse-wheel-mode 1) - ;; W32 expects the menu bar cut and paste commands to use the clipboard. (menu-bar-enable-clipboard) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 17c0f3aef93..e10e6c6e2d0 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -272,13 +272,6 @@ exists." (defvar x-alternatives-map (let ((map (make-sparse-keymap))) ;; Map certain keypad keys into ASCII characters that people usually expect. - (define-key map [backspace] [127]) - (define-key map [delete] [127]) - (define-key map [tab] [?\t]) - (define-key map [linefeed] [?\n]) - (define-key map [clear] [?\C-l]) - (define-key map [return] [?\C-m]) - (define-key map [escape] [?\e]) (define-key map [M-backspace] [?\M-\d]) (define-key map [M-delete] [?\M-\d]) (define-key map [M-tab] [?\M-\t]) @@ -302,17 +295,6 @@ exists." (set-keymap-parent map (keymap-parent local-function-key-map)) (set-keymap-parent local-function-key-map map))) (set-terminal-parameter frame 'x-setup-function-keys t))) - -;; These tell read-char how to convert -;; these special chars to ASCII. -(put 'backspace 'ascii-character 127) -(put 'delete 'ascii-character 127) -(put 'tab 'ascii-character ?\t) -(put 'linefeed 'ascii-character ?\n) -(put 'clear 'ascii-character 12) -(put 'return 'ascii-character 13) -(put 'escape 'ascii-character ?\e) - ;;;; Keysyms @@ -1445,7 +1427,9 @@ The value nil is the same as this list: (defun x-menu-bar-open (&optional frame) "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'." (interactive "i") - (if menu-bar-mode (accelerate-menu frame) + (if (and menu-bar-mode + (fboundp 'accelerate-menu)) + (accelerate-menu frame) (tmm-menubar))) @@ -1573,9 +1557,6 @@ The value nil is the same as this list: ;; (if (featurep 'motif) ;; (global-set-key [f10] 'ignore)) - ;; Turn on support for mouse wheels. - (mouse-wheel-mode 1) - ;; Enable CLIPBOARD copy/paste through menu bar commands. (menu-bar-enable-clipboard) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index a45a187354e..8ae49c63eb2 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -216,7 +216,7 @@ If value of `bibtex-maintain-sorted-entries' is `entry-class' entries are ordered according to the classes they belong to. Each class contains a list of entry types. An entry `catch-all' applies to all entries not explicitly mentioned." - :group 'BibTeX + :group 'bibtex :type '(repeat (choice :tag "Class" (const :tag "catch-all" (catch-all)) (repeat :tag "Entry type" string)))) @@ -3845,7 +3845,8 @@ Return t if test was successful, nil otherwise." (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) (set-buffer-modified-p nil) (toggle-read-only 1) - (goto-line 3)) ; first error message + (goto-char (point-min)) + (forward-line 2)) ; first error message (display-buffer err-buf) nil) ; return `nil' (i.e., buffer is invalid) (message "%s is syntactically correct" @@ -3902,7 +3903,8 @@ Return t if test was successful, nil otherwise." (dolist (err (sort error-list 'string-lessp)) (insert err)) (set-buffer-modified-p nil) (toggle-read-only 1) - (goto-line 3)) ; first error message + (goto-char (point-min)) + (forward-line 2)) ; first error message (display-buffer err-buf) nil) ; return `nil' (i.e., buffer is invalid) (message "No duplicate keys.") diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index c3ec0b95cb4..26dec949e90 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1,4 +1,4 @@ -;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*- +;;; fill.el --- fill commands for Emacs -*- coding: utf-8 -*- ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002, ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. @@ -92,7 +92,7 @@ reinserts the fill prefix in each resulting line." ;; Added `!' for doxygen comments starting with `//!' or `/*!'. ;; Added `%' for TeX comments. ;; RMS: deleted the code to match `1.' and `(1)'. - "[ \t]*\\([-!|#%;>*,A7$,1s"s#sC$,2"F(B]+[ \t]*\\)*" + "[ \t]*\\([-!|#%;>*·•‣âƒâ—¦]+[ \t]*\\)*" "Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, a prefix matching this pattern on the first and second lines of a paragraph is used as the @@ -317,12 +317,12 @@ after an opening paren or just before a closing paren or a punctuation mark such as `?' or `:'. It is common in French writing to put a space at such places, which would normally allow breaking the line at those places." - (or (looking-at "[ \t]*[])},A;,b;(B?!;:-]") + (or (looking-at "[ \t]*[])}»?!;:-]") (save-excursion (skip-chars-backward " \t") (unless (bolp) (backward-char 1) - (or (looking-at "[([{,A+,b+(B]") + (or (looking-at "[([{«]") ;; Don't cut right after a single-letter word. (and (memq (preceding-char) '(?\t ?\s)) (eq (char-syntax (following-char)) ?w))))))) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index f3a15b2c5cc..eff19e632fb 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1,7 +1,7 @@ ;;; flyspell.el --- on-the-fly spell checker -;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr> ;; Maintainer: FSF @@ -363,9 +363,10 @@ property of the major mode name.") "Function used for `flyspell-generic-check-word-predicate' in SGML mode." (not (save-excursion (or (looking-at "[^<\n]*>") - (ispell-looking-back "<[^>\n]*") + (ispell-looking-back "<[^>\n]*" (line-beginning-position)) (and (looking-at "[^&\n]*;") - (ispell-looking-back "&[^;\n]*")))))) + (ispell-looking-back "&[^;\n]*" + (line-beginning-position))))))) ;;*---------------------------------------------------------------------*/ ;;* Programming mode */ @@ -440,8 +441,7 @@ property of the major mode name.") (t (:bold t))) "Face used for marking a misspelled word in Flyspell." :group 'flyspell) -;; backward-compatibility alias -(put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect) +(define-obsolete-face-alias 'flyspell-incorrect-face 'flyspell-incorrect "22.1") (defface flyspell-duplicate '((((class color)) (:foreground "Gold3" :bold t :underline t)) @@ -449,8 +449,7 @@ property of the major mode name.") "Face used for marking a misspelled word that appears twice in the buffer. See also `flyspell-duplicate-distance'." :group 'flyspell) -;; backward-compatibility alias -(put 'flyspell-duplicate-face 'face-alias 'flyspell-duplicate) +(define-obsolete-face-alias 'flyspell-duplicate-face 'flyspell-duplicate "22.1") (defvar flyspell-overlay nil) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index fa35493b7ab..6d02cf9369e 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -785,9 +785,7 @@ Otherwise returns the library directory name, if that is defined." ;; all versions, since versions earlier than 3.0.09 didn't identify ;; themselves on startup. (interactive "p") - (let (;; avoid bugs when syntax of `.' changes in various default modes - (default-major-mode 'fundamental-mode) - (default-directory (or (and (boundp 'temporary-file-directory) + (let ((default-directory (or (and (boundp 'temporary-file-directory) temporary-file-directory) default-directory)) result status ispell-program-version) @@ -814,7 +812,7 @@ Otherwise returns the library directory name, if that is defined." (message "%s" result)) ;; return library directory. (if (re-search-forward "LIBDIR = \\\"\\([^ \t\n]*\\)\\\"" nil t) - (setq result (buffer-substring (match-beginning 1) (match-end 1))))) + (setq result (match-string 1)))) (goto-char (point-min)) (if (not (memq status '(0 nil))) (error "%s exited with %s %s" ispell-program-name @@ -839,7 +837,8 @@ Otherwise returns the library directory name, if that is defined." (match-string 1))) (setq ispell-really-hunspell (and (search-forward-regexp - "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)" nil t) + "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)" + nil t) (match-string 1))))) (let ((aspell-minver "0.50") @@ -887,10 +886,9 @@ Otherwise returns the library directory name, if that is defined." -;;; The preparation of the menu bar menu must be autoloaded -;;; because otherwise this file gets autoloaded every time Emacs starts -;;; so that it can set up the menus and determine keyboard equivalents. - +;; The preparation of the menu bar menu must be autoloaded +;; because otherwise this file gets autoloaded every time Emacs starts +;; so that it can set up the menus and determine keyboard equivalents. ;;;###autoload (defvar ispell-menu-map nil "Key map for ispell menu.") @@ -940,7 +938,7 @@ Internal use.") (defun ispell-find-aspell-dictionaries () "Find Aspell's dictionaries, and record in `ispell-dictionary-alist'." (unless (and ispell-really-aspell ispell-encoding8-command) - (error "This function only works with aspell >= 0.60.")) + (error "This function only works with aspell >= 0.60")) (let* ((dictionaries (split-string (with-temp-buffer @@ -1524,13 +1522,11 @@ pass it the output of the last ispell invocation." ispell-output) (if (not (bufferp buf)) (setq ispell-filter nil) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (setq ispell-output (buffer-substring-no-properties (point-min) (point-max)))) (ispell-filter t ispell-output) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (erase-buffer))))))) (defun ispell-send-replacement (misspelled replacement) @@ -1553,14 +1549,12 @@ This allows it to improve the suggestion list based on actual misspellings." ;; The following commands are not passed to Ispell until ;; we have a *real* reason to invoke it. (cmds-to-defer '(?* ?@ ?~ ?+ ?- ?! ?%)) - (default-major-mode 'fundamental-mode) (session-buf ispell-session-buffer) (output-buf ispell-output-buffer) (ispell-args ispell-cmd-args) (defdir ispell-process-directory) prev-pos) - (save-excursion - (set-buffer session-buf) + (with-current-buffer session-buf (setq prev-pos (point)) (setq default-directory defdir) (insert string) @@ -1875,8 +1869,7 @@ Global `ispell-quit' set to start location to continue spell session." char num result textwin dedicated-win) ;; setup the *Choices* buffer with valid data. - (save-excursion - (set-buffer (get-buffer-create ispell-choices-buffer)) + (with-current-buffer (get-buffer-create ispell-choices-buffer) (setq mode-line-format (concat "-- %b -- word: " word " -- dict: " (or ispell-current-dictionary "default") @@ -1959,7 +1952,7 @@ Global `ispell-quit' set to start location to continue spell session." ;; event), stop ispell. As a special exception, ;; ignore mouse events occuring in the same frame. (while (and input-valid (not (characterp char))) - (setq char (read-event)) + (setq char (read-key)) (setq input-valid (or (characterp char) (and (mouse-event-p char) @@ -2042,9 +2035,8 @@ Global `ispell-quit' set to start location to continue spell session." word))) (if new-word (progn - (save-excursion - (set-buffer (get-buffer-create - ispell-choices-buffer)) + (with-current-buffer (get-buffer-create + ispell-choices-buffer) (erase-buffer) (setq count ?0 skipped 0 diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index e650a88f6f3..7f52cf56ff8 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -149,11 +149,12 @@ thus showing a page other than the one point was originally in." (save-restriction (widen) (save-excursion - (beginning-of-line) (let ((count 1) (opoint (point))) - (goto-char 1) + (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) + (if (= (match-beginning 0) (match-end 0)) + (forward-char 1)) (setq count (1+ count))) (message "Page %d, line %d" count diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 1f532b41974..378c2e668b9 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -1,7 +1,7 @@ ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model -;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF @@ -559,7 +559,8 @@ Leaves the region surrounding the rectangle." (left (min c1 c2)) (top (min r1 r2)) (bottom (max r1 r2))) - (goto-line top) + (goto-char (point-min)) + (forward-line (1- top)) (move-to-column left t) (picture-update-desired-column t) @@ -580,7 +581,8 @@ Leaves the region surrounding the rectangle." (picture-insert picture-rectangle-v (- (picture-current-line) top)) (picture-set-motion pvs phs) - (goto-line sl) + (goto-char (point-min)) + (forward-line (1- sl)) (move-to-column sc t))) @@ -717,7 +719,7 @@ You can manipulate rectangles with these commands: Insert rectangle from named register: \\[picture-yank-rectangle-from-register] Draw a rectangular box around mark and point: \\[picture-draw-rectangle] Copies a rectangle to a register: \\[copy-rectangle-to-register] - Undo effects of rectangle overlay commands: \\[advertised-undo] + Undo effects of rectangle overlay commands: \\[undo] You can return to the previous mode with \\[picture-mode-exit], which also strips trailing whitespace from every line. Stripping is suppressed diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 8f45551c3ab..c81d20fb4e1 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -685,7 +685,7 @@ While entering the regexp, completion on knows citation keys is possible. ;; it has to go. If there is only a single arg and empty, it can go ;; as well. (when reftex-cite-cleanup-optional-args - (cond + (cond ((string-match "\\([a-zA-Z0-9]\\)\\[\\]{" string) (setq string (replace-match "\\1{" nil nil string))) ((string-match "\\[\\]\\(\\[[a-zA-Z0-9., ]+\\]\\)" string) @@ -724,7 +724,7 @@ While entering the regexp, completion on knows citation keys is possible. (decf arg) (reftex-do-citation arg)) (forward-char 1))) - + ;; Return the citation key (car (car selected-entries)))) @@ -738,7 +738,7 @@ While entering the regexp, completion on knows citation keys is possible. (no-insert ;; Format does not really matter because nothing will be inserted. (setq format "%l")) - + ((and (stringp macro) (string-match "\\`\\\\cite\\|cite\\'" macro)) ;; We are already inside a cite macro @@ -759,7 +759,7 @@ While entering the regexp, completion on knows citation keys is possible. (when (listp format) (setq key (or format-key - (reftex-select-with-char + (reftex-select-with-char "" (concat "SELECT A CITATION FORMAT\n\n" (mapconcat (lambda (x) @@ -788,8 +788,8 @@ While entering the regexp, completion on knows citation keys is possible. (let ((bibtype (reftex-bib-or-thebib)) found-list rtn key data selected-entries) - (while - (not + (while + (not (catch 'done ;; Scan bibtex files (setq found-list @@ -804,31 +804,30 @@ While entering the regexp, completion on knows citation keys is possible. (reftex-extract-bib-entries-from-thebibliography (reftex-uniquify (mapcar 'cdr - (reftex-all-assq + (reftex-all-assq 'thebib (symbol-value reftex-docstruct-symbol)))))) (reftex-default-bibliography (message "Using default bibliography") (reftex-extract-bib-entries (reftex-default-bibliography))) (t (error "No valid bibliography in this document, and no default available")))) - + (unless found-list (error "Sorry, no matches found")) - + ;; Remember where we came from (setq reftex-call-back-to-this-buffer (current-buffer)) (set-marker reftex-select-return-marker (point)) - + ;; Offer selection (save-window-excursion (delete-other-windows) - (let ((default-major-mode 'reftex-select-bib-mode)) - (reftex-kill-buffer "*RefTeX Select*") - (switch-to-buffer-other-window "*RefTeX Select*") - (unless (eq major-mode 'reftex-select-bib-mode) - (reftex-select-bib-mode)) - (let ((buffer-read-only nil)) - (erase-buffer) - (reftex-insert-bib-matches found-list))) + (reftex-kill-buffer "*RefTeX Select*") + (switch-to-buffer-other-window "*RefTeX Select*") + (unless (eq major-mode 'reftex-select-bib-mode) + (reftex-select-bib-mode)) + (let ((buffer-read-only nil)) + (erase-buffer) + (reftex-insert-bib-matches found-list)) (setq buffer-read-only t) (if (= 0 (buffer-size)) (error "No matches found")) @@ -858,15 +857,15 @@ While entering the regexp, completion on knows citation keys is possible. (goto-char 1)) ((eq key ?A) ;; Take all (marked) - (setq selected-entries + (setq selected-entries (if reftex-select-marked (mapcar 'car (nreverse reftex-select-marked)) found-list)) (throw 'done t)) ((eq key ?a) ;; Take all (marked), and push the symbol 'concat - (setq selected-entries - (cons 'concat + (setq selected-entries + (cons 'concat (if reftex-select-marked (mapcar 'car (nreverse reftex-select-marked)) found-list))) @@ -885,9 +884,9 @@ While entering the regexp, completion on knows citation keys is possible. ((or (eq key ?\C-m) (eq key 'return)) ;; Take selected - (setq selected-entries + (setq selected-entries (if reftex-select-marked - (cons 'concat + (cons 'concat (mapcar 'car (nreverse reftex-select-marked))) (if data (list data) nil))) (throw 'done t)) @@ -927,7 +926,7 @@ While entering the regexp, completion on knows citation keys is possible. (let ((file (read-file-name "File to create: "))) (find-file-other-window file) (if (> (buffer-size) 0) - (unless (yes-or-no-p + (unless (yes-or-no-p (format "Overwrite non-empty file %s? " file)) (error "Abort"))) (erase-buffer) @@ -1047,7 +1046,7 @@ While entering the regexp, completion on knows citation keys is possible. (defun reftex-make-cite-echo-string (entry docstruct-symbol) ;; Format a bibtex entry for the echo area and cache the result. (let* ((key (reftex-get-bib-field "&key" entry)) - (string + (string (let* ((reftex-cite-punctuation '(" " " & " " etal."))) (reftex-format-citation entry reftex-cite-view-format))) (cache (assq 'bibview-cache (symbol-value docstruct-symbol))) @@ -1089,7 +1088,7 @@ While entering the regexp, completion on knows citation keys is possible. (setq bibfile-list (reftex-uniquify (mapcar 'cdr - (reftex-all-assq + (reftex-all-assq 'thebib (symbol-value reftex-docstruct-symbol)))) item t)) (reftex-default-bibliography @@ -1100,10 +1099,10 @@ While entering the regexp, completion on knows citation keys is possible. (setq bibfile-list (reftex-visited-files bibfile-list))) (condition-case nil - (reftex-pop-to-bibtex-entry + (reftex-pop-to-bibtex-entry key bibfile-list (not reftex-keep-temporary-buffers) t item) (error (ding)))) - + (select-window win))) ;;; Global BibTeX file @@ -1132,7 +1131,7 @@ While entering the regexp, completion on knows citation keys is possible. "Create a new BibTeX database file with all entries referenced in document. The command prompts for a filename and writes the collected entries to that file. Only entries referenced in the current document with -any \\cite-like macros are used. +any \\cite-like macros are used. The sequence in the new file is the same as it was in the old database." (interactive "FNew BibTeX file: ") (let ((keys (reftex-all-used-citation-keys)) @@ -1146,7 +1145,7 @@ The sequence in the new file is the same as it was in the old database." (save-restriction (widen) (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward "^[ \t]*@[a-zA-Z]+[ \t]*{\\([^ \t\r\n]+\\)," nil t) (setq key (match-string 1) @@ -1163,7 +1162,7 @@ The sequence in the new file is the same as it was in the old database." keys (delete key keys))))))))) (find-file-other-window bibfile) (if (> (buffer-size) 0) - (unless (yes-or-no-p + (unless (yes-or-no-p (format "Overwrite non-empty file %s? " bibfile)) (error "Abort"))) (erase-buffer) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 21602d3f670..d26365b6d70 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -424,8 +424,7 @@ With prefix 3, restrict index to region." (if (get-buffer-window buffer-name) (select-window (get-buffer-window buffer-name)) - (let ((default-major-mode 'reftex-index-mode)) - (switch-to-buffer buffer-name))) + (switch-to-buffer buffer-name)) (or (eq major-mode 'reftex-index-mode) (reftex-index-mode)) @@ -1088,7 +1087,8 @@ When index is restricted, select the previous section as restriction criterion." "Go to the CHAR section in the index." (let ((pos (point)) (case-fold-search nil)) - (goto-line 3) + (goto-char (point-min)) + (forward-line 2) (if (re-search-forward (concat "^" (char-to-string char)) nil t) (progn (beginning-of-line) diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 4e892deca7f..3ec284eacac 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -536,14 +536,13 @@ When called with 2 C-u prefix args, disable magic word recognition." (delete-other-windows) (setq reftex-call-back-to-this-buffer buf reftex-latex-syntax-table (syntax-table)) - (let ((default-major-mode 'reftex-select-label-mode)) - (if reftex-use-multiple-selection-buffers - (switch-to-buffer-other-window - (save-excursion - (set-buffer buf) - (reftex-make-selection-buffer-name typekey))) - (switch-to-buffer-other-window "*RefTeX Select*") - (reftex-erase-buffer))) + (if reftex-use-multiple-selection-buffers + (switch-to-buffer-other-window + (save-excursion + (set-buffer buf) + (reftex-make-selection-buffer-name typekey))) + (switch-to-buffer-other-window "*RefTeX Select*") + (reftex-erase-buffer)) (unless (eq major-mode 'reftex-select-label-mode) (reftex-select-label-mode)) (add-to-list 'selection-buffers (current-buffer)) diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index e35ac10a6c9..f6f384fcb7d 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -39,7 +39,7 @@ started with the command \\[reftex-reference].") (defun reftex-select-label-mode () "Major mode for selecting a label in a LaTeX document. This buffer was created with RefTeX. -It only has a meaningful keymap when you are in the middle of a +It only has a meaningful keymap when you are in the middle of a selection process. To select a label, move the cursor to it and press RET. Press `?' for a summary of important key bindings. @@ -70,7 +70,7 @@ started with the command \\[reftex-citation].") (defun reftex-select-bib-mode () "Major mode for selecting a citation key in a LaTeX document. This buffer was created with RefTeX. -It only has a meaningful keymap when you are in the middle of a +It only has a meaningful keymap when you are in the middle of a selection process. In order to select a citation, move the cursor to it and press RET. Press `?' for a summary of important key bindings. @@ -263,7 +263,7 @@ During a selection process, these are the local bindings. note (nth 5 cell)) (when (and labels - (or (eq labels t) + (or (eq labels t) (string= typekey labels) (string= labels " ")) (or show-commented (null comment))) @@ -297,7 +297,7 @@ During a selection process, these are the local bindings. (put-text-property from to :data cell) (when mouse-face (put-text-property from (1- to) - 'mouse-face mouse-face)) + 'mouse-face mouse-face)) (goto-char to))) ((eq (car cell) 'index) @@ -315,7 +315,7 @@ During a selection process, these are the local bindings. (when font (setq to (point)) - (put-text-property + (put-text-property (- (point) (length (nth 7 cell))) to 'face index-face) (goto-char to)) @@ -328,10 +328,10 @@ During a selection process, these are the local bindings. (put-text-property from to :data cell) (when mouse-face (put-text-property from (1- to) - 'mouse-face mouse-face)) + 'mouse-face mouse-face)) (goto-char to)))) - (if (eq cell here-I-am) + (if (eq cell here-I-am) (setq offset 'attention)) (if (and prev-inserted (eq offset 'attention)) (setq offset prev-inserted)) @@ -358,11 +358,12 @@ During a selection process, these are the local bindings. ((listp loc) (setq pos (text-property-any (point-min) (point-max) :data loc)) (when pos - (goto-char pos) + (goto-char pos) (throw 'exit t))) ((integerp loc) (when (<= loc (count-lines (point-min) (point-max))) - (goto-line loc) + (goto-char (point-min)) + (forward-line (1- loc)) (throw 'exit t))))) (goto-char fallback)))) @@ -395,7 +396,7 @@ During a selection process, these are the local bindings. (setq truncate-lines t) ;; Find a good starting point - (reftex-find-start-point + (reftex-find-start-point (point-min) offset reftex-last-data reftex-last-line) (beginning-of-line 1) (set (make-local-variable 'reftex-last-follow-point) (point)) @@ -452,11 +453,11 @@ During a selection process, these are the local bindings. (let (b e) (setq data (get-text-property (point) :data)) (setq last-data (or data last-data)) - + (when (and data cb-flag (not (equal reftex-last-follow-point (point)))) (setq reftex-last-follow-point (point)) - (funcall call-back data reftex-callback-fwd + (funcall call-back data reftex-callback-fwd (not reftex-revisit-to-follow))) (if data (setq b (or (previous-single-property-change @@ -525,7 +526,8 @@ Useful for large TOC's." (goto-char pos)) ((and (local-variable-p 'reftex-last-line (current-buffer)) (integerp reftex-last-line)) - (goto-line reftex-last-line)) + (goto-char (point-min)) + (forward-line (1- reftex-last-line))) (t (ding))))) (defun reftex-select-toggle-follow () "Toggle follow mode: Other window follows with full context." @@ -576,7 +578,7 @@ Useful for large TOC's." (defun reftex-select-read-label () "Use minibuffer to read a label to reference, with completion." (interactive) - (let ((label (completing-read + (let ((label (completing-read "Label: " (symbol-value reftex-docstruct-symbol) nil nil reftex-prefix))) (unless (or (equal label "") (equal label reftex-prefix)) @@ -676,7 +678,7 @@ Useful for large TOC's." ([(up)] . reftex-select-previous) ("f" . reftex-select-toggle-follow) ("\C-m" . reftex-select-accept) - ([(return)] . reftex-select-accept) + ([(return)] . reftex-select-accept) ("q" . reftex-select-quit) ("." . reftex-select-show-insertion-point) ("?" . reftex-select-help)) @@ -687,7 +689,7 @@ Useful for large TOC's." (define-key map [(button2)] 'reftex-select-mouse-accept) (define-key map [(mouse-2)] 'reftex-select-mouse-accept) (define-key map [follow-link] 'mouse-face)) - + ;; Digit arguments (loop for key across "0123456789" do @@ -701,7 +703,7 @@ Useful for large TOC's." ;; Specific bindings in reftex-select-label-map (loop for key across "aAcgFlrRstx#%" do (define-key reftex-select-label-map (vector (list key)) - (list 'lambda '() + (list 'lambda '() "Press `?' during selection to find out about this key." '(interactive) (list 'throw '(quote myexit) key)))) @@ -725,7 +727,7 @@ Useful for large TOC's." ;; Specific bindings in reftex-select-bib-map (loop for key across "grRaAeE" do (define-key reftex-select-bib-map (vector (list key)) - (list 'lambda '() + (list 'lambda '() "Press `?' during selection to find out about this key." '(interactive) (list 'throw '(quote myexit) key)))) @@ -735,7 +737,7 @@ Useful for large TOC's." ("m" . reftex-select-mark) ("u" . reftex-select-unmark)) do (define-key reftex-select-bib-map (car x) (cdr x))) - + ;; arch-tag: 842078ff-0586-4e0b-957e-536e08218464 ;;; reftex-sel.el ends here diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index c8fa5a7032e..6f7d536d6c6 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -1,6 +1,7 @@ ;;; reftex-toc.el --- RefTeX's table of contents mode -;; Copyright (C) 1997, 1998, 1999, 2000, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Copyright (C) 1997, 1998, 1999, 2000, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009 Free Software Foundation, Inc. ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org @@ -149,7 +150,7 @@ When called with a raw C-u prefix, rescan the document first." (frame-parameter (selected-frame) 'unsplittable))) offset toc-window) - (if (setq toc-window (get-buffer-window + (if (setq toc-window (get-buffer-window "*toc*" (if reuse 'visible))) (select-window toc-window) @@ -165,12 +166,11 @@ When called with a raw C-u prefix, rescan the document first." (split-window-horizontally (floor (* (window-width) reftex-toc-split-windows-fraction))) - (split-window-vertically + (split-window-vertically (floor (* (window-height) reftex-toc-split-windows-fraction))))) - (let ((default-major-mode 'reftex-toc-mode)) - (switch-to-buffer "*toc*"))) + (switch-to-buffer "*toc*")) (or (eq major-mode 'reftex-toc-mode) (reftex-toc-mode)) (set (make-local-variable 'reftex-docstruct-symbol) docstruct-symbol) @@ -210,11 +210,11 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help reftex-toc-include-context nil ; counter nil ; commented - here-I-am + here-I-am "" ; xr-prefix t ; a toc buffer )) - + (run-hooks 'reftex-display-copied-context-hook) (message "Building *toc* buffer...done.") (setq buffer-read-only t)) @@ -226,12 +226,12 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help t reftex-toc-include-index-entries reftex-toc-include-file-boundaries) - (reftex-last-assoc-before-elt + (reftex-last-assoc-before-elt 'toc here-I-am (symbol-value reftex-docstruct-symbol)))) (put 'reftex-toc :reftex-line 3) - (goto-line 3) - (beginning-of-line))) + (goto-char (point-min)) + (forward-line 2))) ;; Find the correct starting point (reftex-find-start-point (point) offset (get 'reftex-toc :reftex-line)) @@ -251,7 +251,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (not (get-text-property (point) 'intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 2 - (or (previous-single-property-change + (or (previous-single-property-change (min (point-max) (1+ (point))) :data) (point-min)) (or (next-single-property-change (point) :data) @@ -298,10 +298,10 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (window-height)))))) (defun reftex-toc-dframe-p (&optional frame error) - ;; Check if FRAME is the dedicated TOC frame. + ;; Check if FRAME is the dedicated TOC frame. ;; If yes, and ERROR is non-nil, throw an error. (setq frame (or frame (selected-frame))) - (let ((res (equal + (let ((res (equal (if (fboundp 'frame-property) (frame-property frame 'name) (frame-parameter frame 'name)) @@ -327,7 +327,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (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) + (goto-char (or (next-single-property-change (point) :data) (point)))) (defun reftex-toc-previous (&optional arg) "Move to previous selectable item." @@ -364,7 +364,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help With prefix ARG, prompt for a label type and include only labels of that specific type." (interactive "P") - (setq reftex-toc-include-labels + (setq reftex-toc-include-labels (if arg (reftex-query-label-type) (not reftex-toc-include-labels))) (reftex-toc-revert)) @@ -468,7 +468,7 @@ With prefix arg 1, restrict index to the section at point." (defun reftex-toc-rescan (&rest ignore) "Regenerate the *toc* buffer by reparsing file of section at point." (interactive) - (if (and reftex-enable-partial-scans + (if (and reftex-enable-partial-scans (null current-prefix-arg)) (let* ((data (get-text-property (point) :data)) (what (car data)) @@ -502,7 +502,7 @@ With prefix arg 1, restrict index to the section at point." (defun reftex-toc-revert (&rest ignore) "Regenerate the *toc* from the internal lists." (interactive) - (let ((unsplittable + (let ((unsplittable (if (fboundp 'frame-property) (frame-property (selected-frame) 'unsplittable) (frame-parameter (selected-frame) 'unsplittable))) @@ -596,7 +596,7 @@ point." (goto-char start-pos) (setq sections (reftex-toc-extract-section-number (car entries))) (if (> (setq nsec (length entries)) 1) - (setq sections + (setq sections (concat sections "-" (reftex-toc-extract-section-number (nth (1- nsec) entries))))) @@ -621,17 +621,20 @@ point." (save-window-excursion (reftex-toc-Rescan)) (reftex-toc-restore-region start-line mark-line) - (message "%d section%s %smoted" + (message "%d section%s %smoted" nsec (if (= 1 nsec) "" "s") pro-or-de) nil)) (if msg (progn (ding) (message "%s" msg))))) (defun reftex-toc-restore-region (point-line &optional mark-line) - (if mark-line - (progn (goto-line mark-line) - (setq mpos (point)))) - (if point-line (goto-line point-line)) + (when mark-line + (goto-char (point-min)) + (forward-line (1- mark-line)) + (setq mpos (point))) + (when point-line + (goto-char (point-min)) + (forward-line (1- point-line))) (if mark-line (progn (set-mark mpos) @@ -672,7 +675,7 @@ promotion/demotion later." (beginning-of-line 1) (if (looking-at reftex-section-regexp) (setq name (reftex-match-string 2)) - (error "Something is wrong! Contact maintainer!"))) + (error "Something is wrong! Contact maintainer!"))) ;; Section has changed, request scan and loading ;; We use a variable to delay until after the safe-exc. ;; because otherwise we loose the region. @@ -778,10 +781,10 @@ label prefix determines the wording of a reference." (let* ((toc (get-text-property (point) :data)) (label (car toc)) newlabel) (if (not (stringp label)) - (error "This is not a label entry.")) + (error "This is not a label entry")) (setq newlabel (read-string (format "Rename label \"%s\" to:" label))) (if (assoc newlabel (symbol-value reftex-docstruct-symbol)) - (if (not (y-or-n-p + (if (not (y-or-n-p (format "Label '%s' exists. Use anyway? " label))) (error "Abort"))) (save-excursion @@ -791,7 +794,7 @@ label prefix determines the wording of a reference." (reftex-query-replace-document (concat "{" (regexp-quote label) "}") (format "{%s}" newlabel)) - (error t)))) + (error t)))) (reftex-toc-rescan))) @@ -810,9 +813,9 @@ label prefix determines the wording of a reference." show-window show-buffer match) (unless toc (error "Don't know which toc line to visit")) - + (cond - + ((eq (car toc) 'toc) ;; a toc entry (setq match (reftex-toc-find-section toc no-revisit))) @@ -828,7 +831,7 @@ label prefix determines the wording of a reference." (file (nth 1 toc))) (if (or (not no-revisit) (reftex-get-buffer-visiting file)) (progn - (switch-to-buffer-other-window + (switch-to-buffer-other-window (reftex-get-file-buffer-force file nil)) (goto-char (if (eq where 'bof) (point-min) (point-max)))) (message "%s" reftex-no-follow-message) nil)))) @@ -881,8 +884,8 @@ label prefix determines the wording of a reference." (looking-at (reftex-make-desperate-section-regexp literal)) (looking-at (concat "\\\\" (regexp-quote - (car - (rassq level + (car + (rassq level reftex-section-levels-all))) "[[{]?")))) ((or (not no-revisit) @@ -1056,7 +1059,7 @@ always show the current section in connection with the option (define-key reftex-toc-map (vector (list key)) 'digit-argument)) (define-key reftex-toc-map "-" 'negative-argument) -(easy-menu-define +(easy-menu-define reftex-toc-menu reftex-toc-map "Menu for Table of Contents buffer" '("TOC" @@ -1089,7 +1092,7 @@ always show the current section in connection with the option ["Context" reftex-toc-toggle-context :style toggle :selected reftex-toc-include-context] "--" - ["Follow Mode" reftex-toc-toggle-follow :style toggle + ["Follow Mode" reftex-toc-toggle-follow :style toggle :selected reftex-toc-follow-mode] ["Auto Recenter" reftex-toggle-auto-toc-recenter :style toggle :selected reftex-toc-auto-recenter-timer] diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 23cf167dc93..d905ce66905 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -2063,11 +2063,11 @@ When DIE is non-nil, throw an error if file not found." ;; with limited Magic ;; The magic goes away - (let ((format-alist nil) - (auto-mode-alist (reftex-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil)) + (letf ((format-alist nil) + (auto-mode-alist (reftex-auto-mode-alist)) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil)) (setq buf (find-file-noselect file))) ;; Is there a hook to run? diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index de2a5350f3c..d24bcf7e2b4 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1398,7 +1398,8 @@ hierarchy is similar to that used by `rst-adjust-decoration'." (let (m line) (while (and cur (< (setq line (caar cur)) region-end-line)) (setq m (make-marker)) - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) (push (list (set-marker m (point)) (cdar cur)) marker-list) (setq cur (cdr cur)) )) @@ -1463,7 +1464,8 @@ in order to adapt it to our preferred style." (lambda (deco) (cons (rst-position (cdr deco) hier) (let ((m (make-marker))) - (goto-line (car deco)) + (goto-char (point-min)) + (forward-line (1- (car deco))) (set-marker m (point)) m))) alldecos)) @@ -1497,7 +1499,8 @@ section levels." ;; adjust for the changes in the document. (dolist (deco (nreverse alldecos)) ;; Go to the appropriate position. - (goto-line (car deco)) + (goto-char (point-min)) + (forward-line (1- (car deco))) (insert "@\n") ;; FIXME: todo, we ) @@ -1628,7 +1631,8 @@ child. This has advantages later in processing the graph." (save-excursion (setq lines (mapcar (lambda (deco) - (goto-line (car deco)) + (goto-char (point-min)) + (forward-line (1- (car deco))) (list (gethash (cons (cadr deco) (caddr deco)) levels) (rst-get-stripped-line) (let ((m (make-marker))) @@ -2019,7 +2023,8 @@ brings the cursor in that section." (set (make-local-variable 'rst-toc-return-buffer) curbuf) ;; Move the cursor near the right section in the TOC. - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) )) @@ -2134,7 +2139,9 @@ backwards in the file (default is to use 1)." ;; If the index is positive, goto the line, otherwise go to the buffer ;; boundaries. (if (and cur (>= idx 0)) - (goto-line (car cur)) + (progn + (goto-char (point-min)) + (forward-line (1- (car cur)))) (if (> offset 0) (goto-char (point-max)) (goto-char (point-min)))) )) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 9d9dcf3d89a..74cf99bd865 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -495,11 +495,6 @@ Do \\[describe-key] on the following bindings to discover what they do. "\\)\\(" sgml-name-re "\\)\\1") 2)))) -;; Some programs (such as Glade 2) generate XML which has -;; -*- mode: xml -*-. -;;;###autoload -(defalias 'xml-mode 'sgml-mode) - (defun sgml-comment-indent () (if (looking-at "--") comment-column 0)) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8c8a9d5ac1a..b45cb25b3b7 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -719,8 +719,7 @@ Not smaller than the value set by `tex-suscript-height-minimum'." '((t :inherit font-lock-string-face)) "Face used to highlight TeX math expressions." :group 'tex) -;; backward-compatibility alias -(put 'tex-math-face 'face-alias 'tex-math) +(define-obsolete-face-alias 'tex-math-face 'tex-math "22.1") (defvar tex-math-face 'tex-math) (defface tex-verbatim @@ -728,8 +727,7 @@ Not smaller than the value set by `tex-suscript-height-minimum'." '((t :family "courier")) "Face used to highlight TeX verbatim environments." :group 'tex) -;; backward-compatibility alias -(put 'tex-verbatim-face 'face-alias 'tex-verbatim) +(define-obsolete-face-alias 'tex-verbatim-face 'tex-verbatim "22.1") (defvar tex-verbatim-face 'tex-verbatim) (defun tex-font-lock-verb (end) @@ -2210,7 +2208,7 @@ for the error messages." (with-syntax-table tex-error-parse-syntax-table (backward-up-list 1) (skip-syntax-forward "(_") - (while (not + (while (not (and (setq try-filename (thing-at-point 'filename)) (not (string= "" try-filename)) @@ -2229,7 +2227,10 @@ for the error messages." (find-file-noselect filename)) (save-excursion (if new-file - (progn (goto-line linenum) (setq last-position nil)) + (progn + (goto-char (point-min)) + (forward-line (1- linenum)) + (setq last-position nil)) (goto-char last-position) (forward-line (- linenum last-linenum))) ;; first try a forward search for the error text, diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index b936c45b50c..d7098639ae5 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -1,7 +1,8 @@ ;;; texinfo.el --- major mode for editing Texinfo files -*- coding: utf-8 -*- ;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Date: [See date below for texinfo-version] @@ -338,8 +339,7 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") '((t (:inherit font-lock-function-name-face))) "Face used for section headings in `texinfo-mode'." :group 'texinfo) -;; backward-compatibility alias -(put 'texinfo-heading-face 'face-alias 'texinfo-heading) +(define-obsolete-face-alias 'texinfo-heading-face 'texinfo-heading "22.1") (defvar texinfo-heading-face 'texinfo-heading) (defvar texinfo-font-lock-keywords diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el index d8d298909c1..c393e1d9bcd 100644 --- a/lisp/textmodes/two-column.el +++ b/lisp/textmodes/two-column.el @@ -537,7 +537,8 @@ off trailing spaces with \\[delete-trailing-whitespace]." (if (get-buffer-window (2C-other t)) (select-window (get-buffer-window (2C-other))) (switch-to-buffer (2C-other))) - (newline (goto-line line)) + (goto-char (point-min)) + (newline (forward-line (1- line))) (if col (move-to-column col) (end-of-line 1)))) diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 7e4a3df8750..d2adad1e82f 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -705,73 +705,6 @@ around literals." (setq list (cdr list))) return-string)) -;;; Some functions used in time-stamp-format - -;;; These functions have been obsolete since 1995 -;;; and will be removed in Emacs 23. -;;; Meanwhile, discourage other packages from using them. -(dolist (function '(time-stamp-month-dd-yyyy time-stamp-dd/mm/yyyy - time-stamp-mon-dd-yyyy time-stamp-dd-mon-yy - time-stamp-yy/mm/dd time-stamp-yyyy/mm/dd - time-stamp-yyyy-mm-dd time-stamp-yymmdd - time-stamp-hh:mm:ss time-stamp-hhmm)) - (make-obsolete function - "use `time-stamp-string' or `format-time-string' instead." - "20.1")) - -;;; pretty form, suitable for a title page - -(defun time-stamp-month-dd-yyyy () - "Return the current date as a string in \"Month DD, YYYY\" form." - (format-time-string "%B %e, %Y")) - -(defun time-stamp-dd/mm/yyyy () - "Return the current date as a string in \"DD/MM/YYYY\" form." - (format-time-string "%d/%m/%Y")) - -;;; same as __DATE__ in ANSI C - -(defun time-stamp-mon-dd-yyyy () - "Return the current date as a string in \"Mon DD YYYY\" form. -The first character of DD is space if the value is less than 10." - (format-time-string "%b %d %Y")) - -;;; RFC 822 date - -(defun time-stamp-dd-mon-yy () - "Return the current date as a string in \"DD Mon YY\" form." - (format-time-string "%d %b %y")) - -;;; RCS 3 date - -(defun time-stamp-yy/mm/dd () - "Return the current date as a string in \"YY/MM/DD\" form." - (format-time-string "%y/%m/%d")) - -;;; RCS 5 date - -(defun time-stamp-yyyy/mm/dd () - "Return the current date as a string in \"YYYY/MM/DD\" form." - (format-time-string "%Y/%m/%d")) - -;;; ISO 8601 date - -(defun time-stamp-yyyy-mm-dd () - "Return the current date as a string in \"YYYY-MM-DD\" form." - (format-time-string "%Y-%m-%d")) - -(defun time-stamp-yymmdd () - "Return the current date as a string in \"YYMMDD\" form." - (format-time-string "%y%m%d")) - -(defun time-stamp-hh:mm:ss () - "Return the current time as a string in \"HH:MM:SS\" form." - (format-time-string "%T")) - -(defun time-stamp-hhmm () - "Return the current time as a string in \"HHMM\" form." - (format-time-string "%H%M")) - (provide 'time-stamp) ;; arch-tag: 8a12c5c3-25d6-4a71-adc5-24b0e025a1e7 diff --git a/lisp/time.el b/lisp/time.el index 912ab43c481..2ff840db762 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -105,6 +105,7 @@ A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used." :group 'display-time) (defvar display-time-string nil) +;;;###autoload(put 'display-time-string 'risky-local-variable t) (defcustom display-time-hook nil "List of functions to be called when the time is updated on the mode line." @@ -559,7 +560,7 @@ For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"." (interactive) (let ((str (format-seconds (or format "%Y, %D, %H, %M, %z%S") - (time-to-seconds + (float-time (time-subtract (current-time) before-init-time))))) (if (interactive-p) (message "%s" str) @@ -571,7 +572,7 @@ For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"." (interactive) (let ((str (format "%.1f seconds" - (time-to-seconds + (float-time (time-subtract after-init-time before-init-time))))) (if (interactive-p) (message "%s" str) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 6c34e950268..49ecaffd0e6 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -52,7 +52,7 @@ the help text in the echo area, and does not make a pop-up window." ;; Even if we start on a text-only terminal, make this non-nil by ;; default because we can open a graphical frame later (multi-tty). :init-value t - :initialize 'custom-initialize-safe-default + :initialize 'custom-initialize-delay :group 'tooltip (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) (error "Sorry, tooltips are not yet available on this system")) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 7d6bf1c7c72..3290d67a99a 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -264,8 +264,7 @@ LEFT and RIGHT are the elements to compare." (yank-pop [?\M-y]) ;; * UNDO - (advertised-undo [?\C-x ?u]) - (advertised-undo [?\C-x ?u]) + (undo [?\C-x ?u]) ;; * FILES (find-file [?\C-x ?\C-f]) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index a081ff74c97..7b38fb7ed11 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,24 @@ +2009-09-13 Chong Yidong <cyd@stupidchicken.com> + + * url-handlers.el (url-copy-file): Add fifth arg for compatibility + with 2005-06-25 change to copy-file (Bug#4410). + +2009-09-13 Glenn Morris <rgm@gnu.org> + + * url-file.el (url-file): Avoid assignment to free variable `filename'. + +2009-09-12 Chong Yidong <cyd@stupidchicken.com> + + * url-methods.el (url-scheme--registering-proxy): New variable. + (url-scheme-register-proxy, url-scheme-get-property): Avoid + calling url-scheme-register-proxy in an infloop (Bug#4191). + +2009-08-22 Glenn Morris <rgm@gnu.org> + + * url-file.el (url-file-build-filename): + * url-privacy.el (url-setup-privacy-info): Remove code for defunct + system-types Apple-Macintosh, emx, ms-windows, next-mach. + 2009-06-21 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.1. diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index bb8f136c6a1..f0808a34872 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -1,7 +1,7 @@ ;;; url-file.el --- File retrieval code -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -105,8 +105,7 @@ to them." (file (url-unhex-string (url-filename url))) (filename (if (or user (not (url-file-host-is-local-p host))) (concat "/" (or user "anonymous") "@" site ":" file) - (if (and (memq system-type - '(emx ms-dos windows-nt ms-windows)) + (if (and (memq system-type '(ms-dos windows-nt)) (string-match "^/[a-zA-Z]:/" file)) (substring file 1) file))) @@ -157,13 +156,9 @@ to them." (uncompressed-filename nil) (content-type nil) (content-encoding nil) - (coding-system-for-read 'binary)) - - (setq filename (url-file-build-filename url)) - - (if (not filename) - (error "File does not exist: %s" (url-recreate-url url))) - + (coding-system-for-read 'binary) + (filename (url-file-build-filename url))) + (or filename (error "File does not exist: %s" (url-recreate-url url))) ;; Need to figure out the content-type from the real extension, ;; not the compressed one. (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)$" filename) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index c06e841b2c8..2cf88e8f202 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -215,7 +215,8 @@ the arguments that would have been passed to OPERATION." ;; The actual implementation ;;;###autoload -(defun url-copy-file (url newname &optional ok-if-already-exists keep-time) +(defun url-copy-file (url newname &optional ok-if-already-exists + keep-time preserve-uid-gid) "Copy URL to NEWNAME. Both args must be strings. Signals a `file-already-exists' error if file NEWNAME already exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. @@ -223,6 +224,7 @@ A number as third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x. Fourth arg KEEP-TIME non-nil means give the new file the same last-modified time as the old one. (This works on only some systems.) +Fifth arg PRESERVE-UID-GID is ignored. A prefix arg makes KEEP-TIME non-nil." (if (and (file-exists-p newname) (not ok-if-already-exists)) diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index 20f52a94335..b73a6fc15a4 100644 --- a/lisp/url/url-methods.el +++ b/lisp/url/url-methods.el @@ -65,13 +65,16 @@ "Signal an error for an unknown URL scheme." (error "Unkown URL scheme: %s" (url-type url))) +(defvar url-scheme--registering-proxy nil) + (defun url-scheme-register-proxy (scheme) "Automatically find a proxy for SCHEME and put it in `url-proxy-services'." (let* ((env-var (concat scheme "_proxy")) (env-proxy (or (getenv (upcase env-var)) (getenv (downcase env-var)))) (cur-proxy (assoc scheme url-proxy-services)) - (urlobj nil)) + (urlobj nil) + (url-scheme--registering-proxy t)) ;; If env-proxy is an empty string, treat it as if it were nil (when (and (stringp env-proxy) @@ -124,7 +127,8 @@ it has not already been loaded." (if (fboundp loader) (progn ;; Found the module to handle <scheme> URLs - (url-scheme-register-proxy scheme) + (unless url-scheme--registering-proxy + (url-scheme-register-proxy scheme)) (setq desc (list 'name scheme 'loader loader)) (dolist (cell url-scheme-methods) diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index 11eb6016442..9198678d507 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -1,7 +1,7 @@ ;;; url-privacy.el --- Global history tracking for URL package -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -42,10 +42,7 @@ nil) ;; First, we handle the inseparable OS/Windowing system ;; combinations - ((eq system-type 'Apple-Macintosh) "Macintosh") - ((eq system-type 'next-mach) "NeXT") ((eq system-type 'windows-nt) "Windows-NT; 32bit") - ((eq system-type 'ms-windows) "Windows; 16bit") ((eq system-type 'ms-dos) "MS-DOS; 32bit") ((memq (url-device-type) '(win32 w32)) "Windows; 32bit") ((eq (url-device-type) 'pm) "OS/2; 32bit") diff --git a/lisp/vc-annotate.el b/lisp/vc-annotate.el index 22ff3dac992..6c7ae5a876b 100644 --- a/lisp/vc-annotate.el +++ b/lisp/vc-annotate.el @@ -375,7 +375,8 @@ mode-specific menu. `vc-annotate-color-map' and ;; In case it had to be uniquified. (setq temp-buffer-name (buffer-name)))) (with-output-to-temp-buffer temp-buffer-name - (let ((backend (vc-backend file))) + (let ((backend (vc-backend file)) + (coding-system-for-read buffer-file-coding-system)) (vc-call-backend backend 'annotate-command file (get-buffer temp-buffer-name) rev) ;; we must setup the mode first, and then set our local diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index f9ead184731..68146bcf1f7 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -456,7 +456,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (setq newvers nil)) (if newvers (error "Diffing specific revisions not implemented") - (let* ((async (not vc-disable-async-diff)) + (let* (process-file-side-effects + (async (not vc-disable-async-diff)) ;; Run the command from the root dir. (default-directory (vc-arch-root file)) (status diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index b97190056b4..da9c97f2c17 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -134,7 +134,8 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and (with-temp-buffer (set-buffer-multibyte nil) (let ((prog sha1-program) - (args nil)) + (args nil) + process-file-side-effects) (when (consp prog) (setq args (cdr prog)) (setq prog (car prog))) @@ -452,6 +453,7 @@ REV non-nil gets an error." (defvar log-view-font-lock-keywords) (defvar log-view-current-tag-function) (defvar log-view-per-file-logs) +(defvar vc-short-log) (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. @@ -459,19 +461,27 @@ REV non-nil gets an error." (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-message-re) - "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)") + (if vc-short-log + "^ +\\([0-9]+\\) \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?" + "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) ;; log-view-font-lock-keywords is careful to use the buffer-local ;; value of log-view-message-re only since Emacs-23. - (append `((,log-view-message-re . 'log-view-message-face)) - ;; log-view-font-lock-keywords - '(("^ *committer: \ + (if vc-short-log + (append `((,log-view-message-re + (1 'log-view-message-face) + (2 'change-log-name) + (3 'change-log-date) + (4 'change-log-list)))) + (append `((,log-view-message-re . 'log-view-message-face)) + ;; log-view-font-lock-keywords + '(("^ *committer: \ \\([^<(]+?\\)[ ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]" - (1 'change-log-name) - (2 'change-log-email)) - ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)))))) + (1 'change-log-name) + (2 'change-log-email)) + ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))))))) -(defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22 +(defun vc-bzr-print-log (files &optional buffer shortlog) ; get buffer arg in Emacs 22 "Get bzr change log for FILES into specified BUFFER." ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. @@ -483,6 +493,7 @@ REV non-nil gets an error." ;; way of getting the above regexps working. (with-current-buffer buffer (apply 'vc-bzr-command "log" buffer 'async files + (if shortlog "--short") (if (stringp vc-bzr-log-switches) (list vc-bzr-log-switches) vc-bzr-log-switches)))) @@ -593,14 +604,6 @@ stream. Standard error output is discarded." (apply #'process-file command nil (list (current-buffer) nil) nil args) (buffer-substring (point-min) (point-max))))) -(defun vc-bzr-prettify-state-info (file) - "Bzr-specific version of `vc-prettify-state-info'." - (if (eq 'edited (vc-state file)) - (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) - 'edited)) ")") - ;; else fall back to default vc.el representation - (vc-default-prettify-state-info 'Bzr file))) - (defstruct (vc-bzr-extra-fileinfo (:copier nil) (:constructor vc-bzr-create-extra-fileinfo (extra-name)) @@ -751,7 +754,8 @@ stream. Standard error output is discarded." ((string-match "\\`\\(tag\\):" string) (let ((prefix (substring string 0 (match-end 0))) (tag (substring string (match-end 0))) - (table nil)) + (table nil) + process-file-side-effects) (with-temp-buffer ;; "bzr-1.2 tags" is much faster with --show-ids. (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids") diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index 9d153e5c9fc..2d433b08e26 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -225,7 +225,8 @@ See also variable `vc-cvs-sticky-date-format-string'." state)) (with-temp-buffer (cd (file-name-directory file)) - (vc-cvs-command t 0 file "status") + (let (process-file-side-effects) + (vc-cvs-command t 0 file "status")) (vc-cvs-parse-status t)))) (defun vc-cvs-state-heuristic (file) @@ -493,13 +494,18 @@ Will fail unless you have administrative privileges on the repo." ;;; History functions ;;; -(defun vc-cvs-print-log (files &optional buffer) +(declare-function vc-rcs-print-log-cleanup "vc-rcs" ()) + +(defun vc-cvs-print-log (files &optional buffer shortlog) "Get change logs associated with FILES." + (require 'vc-rcs) ;; It's just the catenation of the individual logs. (vc-cvs-command buffer (if (vc-stay-local-p files 'CVS) 'async 0) - files "log")) + files "log") + (with-current-buffer buffer + (vc-exec-after (vc-rcs-print-log-cleanup)))) (defun vc-cvs-comment-history (file) "Get comment history of a file." @@ -507,7 +513,8 @@ Will fail unless you have administrative privileges on the repo." (defun vc-cvs-diff (files &optional oldvers newvers buffer) "Get a difference report using CVS between two revisions of FILE." - (let* ((async (and (not vc-disable-async-diff) + (let* (process-file-side-effects + (async (and (not vc-disable-async-diff) (vc-stay-local-p files 'CVS))) (invoke-cvs-diff-list nil) status) @@ -631,6 +638,16 @@ systime, or nil if there is none." (match-string-no-properties 1) nil))) +(defun vc-cvs-previous-revision (file rev) + (vc-call-backend 'RCS 'previous-revision file rev)) + +(defun vc-cvs-next-revision (file rev) + (vc-call-backend 'RCS 'next-revision file rev)) + +;; FIXME: This should probably be replaced by code using cvs2cl. +(defun vc-cvs-update-changelog (files) + (vc-call-backend 'RCS 'update-changelog files)) + ;;; ;;; Tag system ;;; @@ -1166,7 +1183,8 @@ is non-nil." ;; tag names. (defun vc-cvs-revision-table (file) - (let ((default-directory (file-name-directory file)) + (let (process-file-side-effects + (default-directory (file-name-directory file)) (res nil)) (with-temp-buffer (vc-cvs-command t nil file "log") diff --git a/lisp/vc-dir.el b/lisp/vc-dir.el index 2c1138f858f..b20e67b9488 100644 --- a/lisp/vc-dir.el +++ b/lisp/vc-dir.el @@ -326,8 +326,9 @@ If BODY uses EVENT, it should be a variable, (or (vc-dir-fileinfo->directory data) ;; Otherwise compute it from the file name. (file-name-directory - (expand-file-name - (vc-dir-fileinfo->name data)))))) + (directory-file-name + (expand-file-name + (vc-dir-fileinfo->name data))))))) (defun vc-dir-update (entries buffer &optional noinsert) "Update BUFFER's ewoc from the list of ENTRIES. @@ -343,8 +344,10 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." ;; names too many times (sort entries (lambda (entry1 entry2) - (let ((dir1 (file-name-directory (expand-file-name (car entry1)))) - (dir2 (file-name-directory (expand-file-name (car entry2))))) + (let ((dir1 (file-name-directory + (directory-file-name (expand-file-name (car entry1))))) + (dir2 (file-name-directory + (directory-file-name (expand-file-name (car entry2)))))) (cond ((string< dir1 dir2) t) ((not (string= dir1 dir2)) nil) @@ -362,7 +365,8 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." (while (and entry node) (let* ((entryfile (car entry)) - (entrydir (file-name-directory (expand-file-name entryfile))) + (entrydir (file-name-directory (directory-file-name + (expand-file-name entryfile)))) (nodedir (vc-dir-node-directory node))) (cond ;; First try to find the directory. @@ -406,7 +410,8 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." (unless (or node noinsert) (let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1)))) (dolist (entry entries) - (let ((entrydir (file-name-directory (expand-file-name (car entry))))) + (let ((entrydir (file-name-directory + (directory-file-name (expand-file-name (car entry)))))) ;; Insert a directory node if needed. (unless (string-equal lastdir entrydir) (setq lastdir entrydir) @@ -923,8 +928,7 @@ the *vc-dir* buffer. (set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer)) (set (make-local-variable 'revert-buffer-function) 'vc-dir-revert-buffer-function) - (set (make-local-variable 'list-buffers-directory) - (expand-file-name default-directory)) + (setq list-buffers-directory (expand-file-name default-directory)) (add-hook 'after-save-hook 'vc-dir-resynch-file) ;; Make sure that if the directory buffer is killed, the update ;; process running in the background is also killed. diff --git a/lisp/vc-dispatcher.el b/lisp/vc-dispatcher.el index a209e139bc2..07cf4a1ad28 100644 --- a/lisp/vc-dispatcher.el +++ b/lisp/vc-dispatcher.el @@ -87,7 +87,7 @@ ;; ;; The main interface to the lower level is vc-do-command. This launches a ;; command, synchronously or asynchronously, making the output available -;; in a command log buffer. Two other functions, (vc-start-annotation) and +;; in a command log buffer. Two other functions, (vc-start-logentry) and ;; (vc-finish-logentry), allow you to associate a command closure with an ;; annotation buffer so that when the user confirms the comment the closure ;; is run (with the comment as part of its context). @@ -280,7 +280,9 @@ subprocess; if it is t it means to ignore all execution errors). FILE-OR-LIST is the name of a working file; it may be a list of files or be nil (to execute commands that don't expect a file name or set of files). If an optional list of FLAGS is present, -that is inserted into the command line before the filename." +that is inserted into the command line before the filename. +Return the return value of the slave command in the synchronous +case, and the process object in the asynchronous case." ;; FIXME: file-relative-name can return a bogus result because ;; it doesn't look at the actual file-system to see if symlinks ;; come into play. @@ -310,7 +312,7 @@ that is inserted into the command line before the filename." ;; something, we'd have used vc-eval-after. ;; Use `delete-process' rather than `kill-process' because we don't ;; want any of its output to appear from now on. - (if oldproc (delete-process oldproc))) + (when oldproc (delete-process oldproc))) (let ((squeezed (remq nil flags)) (inhibit-read-only t) (status 0)) @@ -330,13 +332,14 @@ that is inserted into the command line before the filename." (let ((process-connection-type nil)) (apply 'start-file-process command (current-buffer) command squeezed)))) - (if vc-command-messages - (message "Running %s in background..." full-command)) + (when vc-command-messages + (message "Running %s in background..." full-command)) ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) (set-process-filter proc 'vc-process-filter) - (vc-exec-after - `(if vc-command-messages - (message "Running %s in background... done" ',full-command)))) + (setq status proc) + (when vc-command-messages + (vc-exec-after + `(message "Running %s in background... done" ',full-command)))) ;; Run synchronously (when vc-command-messages (message "Running %s in foreground..." full-command)) @@ -350,11 +353,9 @@ that is inserted into the command line before the filename." (goto-char (point-min)) (shrink-window-if-larger-than-buffer)) (error "Running %s...FAILED (%s)" full-command - (if (integerp status) (format "status %d" status) status)))) - ;; We're done. But don't emit a status message if running - ;; asynchronously, it would just mislead. - (if (and vc-command-messages (not (eq okstatus 'async))) - (message "Running %s...OK = %d" full-command status))) + (if (integerp status) (format "status %d" status) status))) + (when vc-command-messages + (message "Running %s...OK = %d" full-command status)))) (vc-exec-after `(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags)) diff --git a/lisp/vc-git.el b/lisp/vc-git.el index 0d35afa739e..fe7b95cb43a 100644 --- a/lisp/vc-git.el +++ b/lisp/vc-git.el @@ -43,64 +43,64 @@ ;; beginning of vc.el. The current status is: ;; ("??" means: "figure out what to do about it") ;; -;; FUNCTION NAME STATUS +;; FUNCTION NAME STATUS ;; BACKEND PROPERTIES -;; * revision-granularity OK +;; * revision-granularity OK ;; STATE-QUERYING FUNCTIONS -;; * registered (file) OK -;; * state (file) OK -;; - state-heuristic (file) NOT NEEDED -;; * working-revision (file) OK -;; - latest-on-branch-p (file) NOT NEEDED -;; * checkout-model (files) OK -;; - workfile-unchanged-p (file) OK -;; - mode-line-string (file) OK +;; * registered (file) OK +;; * state (file) OK +;; - state-heuristic (file) NOT NEEDED +;; * working-revision (file) OK +;; - latest-on-branch-p (file) NOT NEEDED +;; * checkout-model (files) OK +;; - workfile-unchanged-p (file) OK +;; - mode-line-string (file) OK ;; STATE-CHANGING FUNCTIONS -;; * create-repo () OK -;; * register (files &optional rev comment) OK -;; - init-revision (file) NOT NEEDED -;; - responsible-p (file) OK -;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD -;; - receive-file (file rev) NOT NEEDED -;; - unregister (file) OK -;; * checkin (files rev comment) OK -;; * find-revision (file rev buffer) OK -;; * checkout (file &optional editable rev) OK -;; * revert (file &optional contents-done) OK -;; - rollback (files) COULD BE SUPPORTED +;; * create-repo () OK +;; * register (files &optional rev comment) OK +;; - init-revision (file) NOT NEEDED +;; - responsible-p (file) OK +;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD +;; - receive-file (file rev) NOT NEEDED +;; - unregister (file) OK +;; * checkin (files rev comment) OK +;; * find-revision (file rev buffer) OK +;; * checkout (file &optional editable rev) OK +;; * revert (file &optional contents-done) OK +;; - rollback (files) COULD BE SUPPORTED ;; - merge (file rev1 rev2) It would be possible to merge ;; changes into a single file, but when ;; committing they wouldn't ;; be identified as a merge ;; by git, so it's probably ;; not a good idea. -;; - merge-news (file) see `merge' -;; - steal-lock (file &optional revision) NOT NEEDED +;; - merge-news (file) see `merge' +;; - steal-lock (file &optional revision) NOT NEEDED ;; HISTORY FUNCTIONS -;; * print-log (files &optional buffer) OK -;; - log-view-mode () OK -;; - show-log-entry (revision) OK -;; - comment-history (file) ?? -;; - update-changelog (files) COULD BE SUPPORTED -;; * diff (file &optional rev1 rev2 buffer) OK -;; - revision-completion-table (files) OK -;; - annotate-command (file buf &optional rev) OK -;; - annotate-time () OK -;; - annotate-current-time () NOT NEEDED -;; - annotate-extract-revision-at-line () OK +;; * print-log (files &optional buffer shortlog) OK +;; - log-view-mode () OK +;; - show-log-entry (revision) OK +;; - comment-history (file) ?? +;; - update-changelog (files) COULD BE SUPPORTED +;; * diff (file &optional rev1 rev2 buffer) OK +;; - revision-completion-table (files) OK +;; - annotate-command (file buf &optional rev) OK +;; - annotate-time () OK +;; - annotate-current-time () NOT NEEDED +;; - annotate-extract-revision-at-line () OK ;; TAG SYSTEM -;; - create-tag (dir name branchp) OK -;; - retrieve-tag (dir name update) OK, needs to update buffers +;; - create-tag (dir name branchp) OK +;; - retrieve-tag (dir name update) OK ;; MISCELLANEOUS -;; - make-version-backups-p (file) NOT NEEDED -;; - repository-hostname (dirname) NOT NEEDED -;; - previous-revision (file rev) OK -;; - next-revision (file rev) OK -;; - check-headers () COULD BE SUPPORTED -;; - clear-headers () NOT NEEDED -;; - delete-file (file) OK -;; - rename-file (old new) OK -;; - find-file-hook () NOT NEEDED +;; - make-version-backups-p (file) NOT NEEDED +;; - repository-hostname (dirname) NOT NEEDED +;; - previous-revision (file rev) OK +;; - next-revision (file rev) OK +;; - check-headers () COULD BE SUPPORTED +;; - clear-headers () NOT NEEDED +;; - delete-file (file) OK +;; - rename-file (old new) OK +;; - find-file-hook () NOT NEEDED (eval-when-compile (require 'cl) @@ -146,7 +146,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." "Check whether FILE is registered with git." (when (vc-git-root file) (with-temp-buffer - (let* ((dir (file-name-directory file)) + (let* (process-file-side-effects + (dir (file-name-directory file)) (name (file-relative-name file dir)) (str (ignore-errors (when dir (cd dir)) @@ -183,9 +184,10 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (defun vc-git-working-revision (file) "Git-specific version of `vc-working-revision'." - (let ((str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD"))))) + (let* (process-file-side-effects + (str (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "symbolic-ref" "HEAD"))))) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (match-string 2 str) str))) @@ -260,7 +262,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (defun vc-git-rename-as-string (state extra) "Return a string describing the copy or rename associated with INFO, or an empty string if none." - (let ((rename-state (when extra + (let ((rename-state (when extra (vc-git-extra-fileinfo->rename-state extra)))) (if rename-state (propertize @@ -401,21 +403,51 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (let ((str (with-output-to-string (with-current-buffer standard-output (vc-git--out-ok "symbolic-ref" "HEAD")))) - (stash (vc-git-stash-list))) + (stash (vc-git-stash-list)) + branch remote remote-url) + (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) + (progn + (setq branch (match-string 2 str)) + (setq remote + (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "config" (concat "branch." branch ".remote"))))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when remote + (setq remote-url + (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "config" (concat "remote." remote ".url")))))) + (when (string-match "\\([^\n]+\\)" remote-url) + (setq remote-url (match-string 1 remote-url)))) + "not (detached HEAD)") ;; FIXME: maybe use a different face when nothing is stashed. - (when (string= stash "") (setq stash "Nothing stashed")) (concat (propertize "Branch : " 'face 'font-lock-type-face) - (propertize - (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) - (match-string 2 str) - "not (detached HEAD)") - 'face 'font-lock-variable-name-face) + (propertize branch + 'face 'font-lock-variable-name-face) + (when remote + (concat + "\n" + (propertize "Remote : " 'face 'font-lock-type-face) + (propertize remote-url + 'face 'font-lock-variable-name-face))) "\n" - (propertize "Stash : " 'face 'font-lock-type-face) - (propertize - stash - 'face 'font-lock-variable-name-face)))) + (if stash + (concat + (propertize "Stash :\n" 'face 'font-lock-type-face) + (mapconcat + (lambda (x) + (propertize x + 'face 'font-lock-variable-name-face + 'mouse-face 'highlight + 'keymap vc-git-stash-map)) + stash "\n")) + (concat + (propertize "Stash : " 'face 'font-lock-type-face) + (propertize "Nothing stashed" + 'face 'font-lock-variable-name-face)))))) ;;; STATE-CHANGING FUNCTIONS @@ -424,8 +456,16 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (vc-git-command nil 0 nil "init")) (defun vc-git-register (files &optional rev comment) - "Register FILE into the git version-control system." - (vc-git-command nil 0 files "update-index" "--add" "--")) + "Register FILES into the git version-control system." + (let (flist dlist) + (dolist (crt files) + (if (file-directory-p crt) + (push crt dlist) + (push crt flist))) + (when flist + (vc-git-command nil 0 flist "update-index" "--add" "--")) + (when dlist + (vc-git-command nil 0 dlist "add")))) (defalias 'vc-git-responsible-p 'vc-git-root) @@ -439,12 +479,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (if vc-git-add-signoff "-s") "-m" comment "--only" "--"))) (defun vc-git-find-revision (file rev buffer) - (let ((coding-system-for-read 'binary) - (coding-system-for-write 'binary) - (fullname (substring - (vc-git--run-command-string - file "ls-files" "-z" "--full-name" "--") - 0 -1))) + (let* (process-file-side-effects + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (fullname (substring + (vc-git--run-command-string + file "ls-files" "-z" "--full-name" "--") + 0 -1))) (vc-git-command buffer 0 (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob"))) @@ -460,7 +501,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;;; HISTORY FUNCTIONS -(defun vc-git-print-log (files &optional buffer) +(defun vc-git-print-log (files &optional buffer shortlog) "Get change log associated with FILES." (let ((coding-system-for-read git-commits-coding-system) ;; Support both the old print-log interface that passes a @@ -474,22 +515,38 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (let ((inhibit-read-only t)) (with-current-buffer buffer + (if shortlog (vc-git-command buffer 'async files - "rev-list" "--pretty" "HEAD" "--"))))) + "log" ;; "--graph" + "--date=short" "--pretty=format:%h %ad %s" "--abbrev-commit" + "--") + (vc-git-command buffer 'async files + "rev-list" ;; "--graph" + "--pretty" "HEAD" "--")))))) (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) +;; Dynamically bound. +(defvar vc-short-log) + (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" (require 'add-log) ;; we need the faces add-log ;; Don't have file markers, so use impossible regexp. (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - "^commit *\\([0-9a-z]+\\)") + (if vc-short-log + "^\\(?:[*/\\| ]+ \\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" + "^commit *\\([0-9a-z]+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) + (if vc-short-log + (append + `((,log-view-message-re + (1 'change-log-acknowledgement) + (2 'change-log-date)))) (append `((,log-view-message-re (1 'change-log-acknowledgement))) ;; Handle the case: @@ -510,7 +567,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (1 'change-log-acknowledgement) (2 'change-log-acknowledgement)) ("^Date: \\(.+\\)" (1 'change-log-date)) - ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) + (defun vc-git-show-log-entry (revision) "Move to the log entry for REVISION. @@ -528,15 +586,17 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-diff (files &optional rev1 rev2 buffer) "Get a difference report using Git between two revisions of FILES." - (apply #'vc-git-command (or buffer "*vc-diff*") 1 files - (if (and rev1 rev2) "diff-tree" "diff-index") - "--exit-code" - (append (vc-switches 'git 'diff) - (list "-p" (or rev1 "HEAD") rev2 "--")))) + (let (process-file-side-effects) + (apply #'vc-git-command (or buffer "*vc-diff*") 1 files + (if (and rev1 rev2) "diff-tree" "diff-index") + "--exit-code" + (append (vc-switches 'git 'diff) + (list "-p" (or rev1 "HEAD") rev2 "--"))))) (defun vc-git-revision-table (files) ;; What about `files'?!? --Stef - (let ((table (list "HEAD"))) + (let (process-file-side-effects + (table (list "HEAD"))) (with-temp-buffer (vc-git-command t nil nil "for-each-ref" "--format=%(refname)") (goto-char (point-min)) @@ -553,7 +613,7 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-annotate-command (file buf &optional rev) (let ((name (file-relative-name file))) - (vc-git-command buf 'async name "blame" "--date=iso" rev))) + (vc-git-command buf 'async name "blame" "--date=iso" rev "--"))) (declare-function vc-annotate-convert-time "vc-annotate" (time)) @@ -649,6 +709,12 @@ or BRANCH^ (where \"^\" can be repeated)." (define-key map [git-grep] '(menu-item "Git grep..." vc-git-grep :help "Run the `git grep' command")) + (define-key map [git-st] + '(menu-item "Stash..." vc-git-stash + :help "Stash away changes")) + (define-key map [git-ss] + '(menu-item "Show Stash..." vc-git-stash-show + :help "Show stash contents")) (define-key map [git-sig] '(menu-item "Add Signed-off-by on commit" vc-git-toggle-signoff :help "Add Add Signed-off-by when commiting (i.e. add the -s flag)" @@ -659,6 +725,9 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-extra-status-menu () vc-git-extra-menu-map) +(defun vc-git-root (file) + (vc-find-root file ".git")) + (defun vc-git-toggle-signoff () (interactive) (setq vc-git-add-signoff (not vc-git-add-signoff))) @@ -717,18 +786,61 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) +(defun vc-git-stash (name) + "Create a stash." + (interactive "sStash name: ") + (let ((root (vc-git-root default-directory))) + (when root + (vc-git--call nil "stash" "save" name) + (vc-resynch-buffer root t t)))) + +(defun vc-git-stash-show (name) + "Show the contents of stash NAME." + (interactive "sStash name: ") + (vc-setup-buffer "*vc-git-stash*") + (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name) + (set-buffer "*vc-git-stash*") + (diff-mode) + (setq buffer-read-only t) + (pop-to-buffer (current-buffer))) + (defun vc-git-stash-list () - (replace-regexp-in-string - "\n" "\n " - (replace-regexp-in-string - "^stash@" "" (vc-git--run-command-string nil "stash" "list")))) + (delete + "" + (split-string + (replace-regexp-in-string + "^stash@" " " (vc-git--run-command-string nil "stash" "list")) + "\n"))) + +(defun vc-git-stash-get-at-point (point) + (save-excursion + (goto-char point) + (beginning-of-line) + (if (looking-at "^ +\\({[0-9]+}\\):") + (match-string 1) + (error "Cannot find stash at point")))) + +(defun vc-git-stash-delete-at-point () + (interactive) + (let ((stash (vc-git-stash-get-at-point (point)))) + (when (y-or-n-p (format "Remove stash %s ?" stash)) + (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash)) + (vc-dir-refresh)))) + +(defun vc-git-stash-show-at-point () + (interactive) + (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point))))) + +(defvar vc-git-stash-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-k" 'vc-git-stash-delete-at-point) + (define-key map "=" 'vc-git-stash-show-at-point) + (define-key map "\C-m" 'vc-git-stash-show-at-point) + map)) ;;; Internal commands -(defun vc-git-root (file) - (vc-find-root file ".git")) - (defun vc-git-command (buffer okstatus file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-git.el. The difference to vc-do-command is that this function always invokes `git'." @@ -736,7 +848,8 @@ The difference to vc-do-command is that this function always invokes `git'." (defun vc-git--empty-db-p () "Check if the git db is empty (no commit done yet)." - (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))) + (let (process-file-side-effects) + (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD"))))) (defun vc-git--call (buffer command &rest args) ;; We don't need to care the arguments. If there is a file name, it diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index a8a8895de01..9ced663fade 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -68,7 +68,7 @@ ;; - merge-news (file) NEEDED ;; - steal-lock (file &optional revision) NOT NEEDED ;; HISTORY FUNCTIONS -;; * print-log (files &optional buffer) OK +;; * print-log (files &optional buffer shortlog)OK ;; - log-view-mode () OK ;; - show-log-entry (revision) NOT NEEDED, DEFAULT IS GOOD ;; - comment-history (file) NOT NEEDED @@ -127,9 +127,9 @@ "String or list of strings specifying switches for Hg diff under VC. If nil, use the value of `vc-diff-switches'. If t, use no switches." :type '(choice (const :tag "Unspecified" nil) - (const :tag "None" t) - (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) + (const :tag "None" t) + (string :tag "Argument String") + (repeat :tag "Argument List" :value ("") string)) :version "23.1" :group 'vc) @@ -160,53 +160,53 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (let* ((status nil) (out - (with-output-to-string - (with-current-buffer - standard-output - (setq status - (condition-case nil - ;; Ignore all errors. - (call-process - "hg" nil t nil "--cwd" (file-name-directory file) - "status" "-A" (file-name-nondirectory file)) - ;; Some problem happened. E.g. We can't find an `hg' - ;; executable. - (error nil))))))) + (with-output-to-string + (with-current-buffer + standard-output + (setq status + (condition-case nil + ;; Ignore all errors. + (call-process + "hg" nil t nil "--cwd" (file-name-directory file) + "status" "-A" (file-name-nondirectory file)) + ;; Some problem happened. E.g. We can't find an `hg' + ;; executable. + (error nil))))))) (when (eq 0 status) - (when (null (string-match ".*: No such file or directory$" out)) - (let ((state (aref out 0))) - (cond - ((eq state ?=) 'up-to-date) - ((eq state ?A) 'added) - ((eq state ?M) 'edited) - ((eq state ?I) 'ignored) - ((eq state ?R) 'removed) - ((eq state ?!) 'missing) - ((eq state ??) 'unregistered) - ((eq state ?C) 'up-to-date) ;; Older mercurials use this - (t 'up-to-date))))))) + (when (null (string-match ".*: No such file or directory$" out)) + (let ((state (aref out 0))) + (cond + ((eq state ?=) 'up-to-date) + ((eq state ?A) 'added) + ((eq state ?M) 'edited) + ((eq state ?I) 'ignored) + ((eq state ?R) 'removed) + ((eq state ?!) 'missing) + ((eq state ??) 'unregistered) + ((eq state ?C) 'up-to-date) ;; Older mercurials use this + (t 'up-to-date))))))) (defun vc-hg-working-revision (file) "Hg-specific version of `vc-working-revision'." (let* ((status nil) (out - (with-output-to-string - (with-current-buffer - standard-output - (setq status - (condition-case nil - ;; Ignore all errors. - (call-process - "hg" nil t nil "--cwd" (file-name-directory file) - "log" "-l1" (file-name-nondirectory file)) - ;; Some problem happened. E.g. We can't find an `hg' - ;; executable. - (error nil))))))) + (with-output-to-string + (with-current-buffer + standard-output + (setq status + (condition-case nil + ;; Ignore all errors. + (call-process + "hg" nil t nil "--cwd" (file-name-directory file) + "log" "-l1" (file-name-nondirectory file)) + ;; Some problem happened. E.g. We can't find an `hg' + ;; executable. + (error nil))))))) (when (eq 0 status) (if (string-match "changeset: *\\([0-9]*\\)" out) - (match-string 1 out) - "0")))) + (match-string 1 out) + "0")))) ;;; History functions @@ -217,7 +217,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (repeat :tag "Argument List" :value ("") string)) :group 'vc-hg) -(defun vc-hg-print-log (files &optional buffer) +(defun vc-hg-print-log (files &optional buffer shortlog) "Get change log associated with FILES." ;; `log-view-mode' needs to have the file names in order to function ;; correctly. "hg log" does not print it, so we insert it here by @@ -231,57 +231,69 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (let ((inhibit-read-only t)) (with-current-buffer buffer - (apply 'vc-hg-command buffer 0 files "log" vc-hg-log-switches)))) + (apply 'vc-hg-command buffer 0 files "log" + (if shortlog + (append '("--style" "compact") vc-hg-log-switches) + vc-hg-log-switches))))) (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) +(defvar vc-short-log) (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (require 'add-log) ;; we need the add-log faces (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)") + (if vc-short-log + "^\\([0-9]+\\)\\(?:\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$" + "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) + (if vc-short-log + (append `((,log-view-message-re + (1 'log-view-message-face) + (2 'log-view-message-face) + (3 'change-log-date) + (4 'change-log-name)))) (append - log-view-font-lock-keywords - '( - ;; Handle the case: - ;; user: FirstName LastName <foo@bar> - ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" - (1 'change-log-name) - (2 'change-log-email)) - ;; Handle the cases: - ;; user: foo@bar - ;; and - ;; user: foo - ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" - (1 'change-log-email)) - ("^date: \\(.+\\)" (1 'change-log-date)) - ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) + log-view-font-lock-keywords + '( + ;; Handle the case: + ;; user: FirstName LastName <foo@bar> + ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ;; Handle the cases: + ;; user: foo@bar + ;; and + ;; user: foo + ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" + (1 'change-log-email)) + ("^date: \\(.+\\)" (1 'change-log-date)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) (defun vc-hg-diff (files &optional oldvers newvers buffer) "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) - (cwd (if firstfile (file-name-directory firstfile) - (expand-file-name default-directory))) - (working (and firstfile (vc-working-revision firstfile)))) + (cwd (if firstfile (file-name-directory firstfile) + (expand-file-name default-directory))) + (working (and firstfile (vc-working-revision firstfile)))) (when (and (equal oldvers working) (not newvers)) (setq oldvers nil)) (when (and (not oldvers) newvers) (setq oldvers working)) (apply #'vc-hg-command (or buffer "*vc-diff*") nil - (mapcar (lambda (file) (file-relative-name file cwd)) files) - "--cwd" cwd - "diff" - (append - (vc-switches 'hg 'diff) - (when oldvers - (if newvers - (list "-r" oldvers "-r" newvers) - (list "-r" oldvers))))))) + (mapcar (lambda (file) (file-relative-name file cwd)) files) + "--cwd" cwd + "diff" + (append + (vc-switches 'hg 'diff) + (when oldvers + (if newvers + (list "-r" oldvers "-r" newvers) + (list "-r" oldvers))))))) (defun vc-hg-revision-table (files) (let ((default-directory (file-name-directory (car files)))) @@ -302,7 +314,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." (vc-hg-command buffer 0 file "annotate" "-d" "-n" - (when revision (concat "-r" revision))) + (when revision (concat "-r" revision))) (with-current-buffer buffer (goto-char (point-min)) (re-search-forward "^[ \t]*[0-9]") @@ -337,12 +349,12 @@ Optional arg REVISION is a revision to annotate from." (defun vc-hg-next-revision (file rev) (let ((newrev (1+ (string-to-number rev))) - (tip-revision - (with-temp-buffer - (vc-hg-command t 0 nil "tip") - (goto-char (point-min)) - (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") - (string-to-number (match-string-no-properties 1))))) + (tip-revision + (with-temp-buffer + (vc-hg-command t 0 nil "tip") + (goto-char (point-min)) + (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") + (string-to-number (match-string-no-properties 1))))) ;; We don't want to exceed the maximum possible revision number, ie ;; the tip revision. (when (<= newrev tip-revision) @@ -398,7 +410,7 @@ REV is ignored." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (if rev - (vc-hg-command buffer 0 file "cat" "-r" rev) + (vc-hg-command buffer 0 file "cat" "-r" rev) (vc-hg-command buffer 0 file "cat")))) ;; Modeled after the similar function in vc-bzr.el @@ -453,64 +465,64 @@ REV is the revision to check out into WORKFILE." (vc-default-dir-printer 'Hg info) (when extra (insert (propertize - (format " (%s %s)" - (case (vc-hg-extra-fileinfo->rename-state extra) - ('copied "copied from") - ('renamed-from "renamed from") - ('renamed-to "renamed to")) - (vc-hg-extra-fileinfo->extra-name extra)) - 'face 'font-lock-comment-face))))) + (format " (%s %s)" + (case (vc-hg-extra-fileinfo->rename-state extra) + ('copied "copied from") + ('renamed-from "renamed from") + ('renamed-to "renamed to")) + (vc-hg-extra-fileinfo->extra-name extra)) + 'face 'font-lock-comment-face))))) (defun vc-hg-after-dir-status (update-function) (let ((status-char nil) - (file nil) - (translation '((?= . up-to-date) - (?C . up-to-date) - (?A . added) - (?R . removed) - (?M . edited) - (?I . ignored) - (?! . missing) - (? . copy-rename-line) - (?? . unregistered))) - (translated nil) - (result nil) - (last-added nil) - (last-line-copy nil)) + (file nil) + (translation '((?= . up-to-date) + (?C . up-to-date) + (?A . added) + (?R . removed) + (?M . edited) + (?I . ignored) + (?! . missing) + (? . copy-rename-line) + (?? . unregistered))) + (translated nil) + (result nil) + (last-added nil) + (last-line-copy nil)) (goto-char (point-min)) (while (not (eobp)) - (setq translated (cdr (assoc (char-after) translation))) - (setq file - (buffer-substring-no-properties (+ (point) 2) - (line-end-position))) - (cond ((not translated) - (setq last-line-copy nil)) - ((eq translated 'up-to-date) - (setq last-line-copy nil)) - ((eq translated 'copy-rename-line) - ;; For copied files the output looks like this: - ;; A COPIED_FILE_NAME - ;; ORIGINAL_FILE_NAME - (setf (nth 2 last-added) - (vc-hg-create-extra-fileinfo 'copied file)) - (setq last-line-copy t)) - ((and last-line-copy (eq translated 'removed)) - ;; For renamed files the output looks like this: - ;; A NEW_FILE_NAME - ;; ORIGINAL_FILE_NAME - ;; R ORIGINAL_FILE_NAME - ;; We need to adjust the previous entry to not think it is a copy. - (setf (vc-hg-extra-fileinfo->rename-state (nth 2 last-added)) - 'renamed-from) - (push (list file translated - (vc-hg-create-extra-fileinfo - 'renamed-to (nth 0 last-added))) result) - (setq last-line-copy nil)) - (t - (setq last-added (list file translated nil)) - (push last-added result) - (setq last-line-copy nil))) - (forward-line)) + (setq translated (cdr (assoc (char-after) translation))) + (setq file + (buffer-substring-no-properties (+ (point) 2) + (line-end-position))) + (cond ((not translated) + (setq last-line-copy nil)) + ((eq translated 'up-to-date) + (setq last-line-copy nil)) + ((eq translated 'copy-rename-line) + ;; For copied files the output looks like this: + ;; A COPIED_FILE_NAME + ;; ORIGINAL_FILE_NAME + (setf (nth 2 last-added) + (vc-hg-create-extra-fileinfo 'copied file)) + (setq last-line-copy t)) + ((and last-line-copy (eq translated 'removed)) + ;; For renamed files the output looks like this: + ;; A NEW_FILE_NAME + ;; ORIGINAL_FILE_NAME + ;; R ORIGINAL_FILE_NAME + ;; We need to adjust the previous entry to not think it is a copy. + (setf (vc-hg-extra-fileinfo->rename-state (nth 2 last-added)) + 'renamed-from) + (push (list file translated + (vc-hg-create-extra-fileinfo + 'renamed-to (nth 0 last-added))) result) + (setq last-line-copy nil)) + (t + (setq last-added (list file translated nil)) + (push last-added result) + (setq last-line-copy nil))) + (forward-line)) (funcall update-function result))) (defun vc-hg-dir-status (dir update-function) @@ -557,14 +569,14 @@ REV is the revision to check out into WORKFILE." (defun vc-hg-outgoing () (interactive) - (let ((bname "*Hg outgoing*")) - (vc-hg-command bname 0 nil "outgoing" "-n") + (let ((bname "*Hg outgoing*") (vc-short-log nil)) + (vc-hg-command bname 1 nil "outgoing" "-n") (pop-to-buffer bname) (vc-hg-outgoing-mode))) (defun vc-hg-incoming () (interactive) - (let ((bname "*Hg incoming*")) + (let ((bname "*Hg incoming*") (vc-short-log nil)) (vc-hg-command bname 0 nil "incoming" "-n") (pop-to-buffer bname) (vc-hg-incoming-mode))) @@ -576,22 +588,22 @@ REV is the revision to check out into WORKFILE." (interactive) (let ((marked-list (log-view-get-marked))) (if marked-list - (vc-hg-command - nil 0 nil - (cons "push" - (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) - (error "No log entries selected for push")))) + (vc-hg-command + nil 0 nil + (cons "push" + (apply 'nconc + (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) + (error "No log entries selected for push")))) (defun vc-hg-pull () (interactive) (let ((marked-list (log-view-get-marked))) (if marked-list - (vc-hg-command - nil 0 nil - (cons "pull" - (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) + (vc-hg-command + nil 0 nil + (cons "pull" + (apply 'nconc + (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) (error "No log entries selected for pull")))) ;;; Internal functions diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index d35471a4738..3ce54881aee 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -1,7 +1,8 @@ ;;; vc-hooks.el --- resident support for version-control ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> @@ -204,6 +205,8 @@ individually should stay local." ;; Tell Emacs about this new kind of minor mode ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) +;; Autoload if this file no longer dumped. +(put 'vc-mode 'risky-local-variable t) (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) @@ -436,7 +439,8 @@ For registered files, the possible values are: "Return the name under which the user accesses the given FILE." (or (and (eq (string-match tramp-file-name-regexp file) 0) ;; tramp case: execute "whoami" via tramp - (let ((default-directory (file-name-directory file))) + (let ((default-directory (file-name-directory file)) + process-file-side-effects) (with-temp-buffer (if (not (zerop (process-file "whoami" nil t))) ;; fall through if "whoami" didn't work @@ -660,7 +664,7 @@ will properly intercept all attempts to toggle the read-only flag on version-controlled buffer." (interactive "P") (if (vc-backend buffer-file-name) - (error "Toggling the readability of a version controlled file is likely to wreak havoc.") + (error "Toggling the readability of a version controlled file is likely to wreak havoc") (toggle-read-only))) (defun vc-default-make-version-backups-p (backend file) @@ -934,6 +938,7 @@ current, and kill the buffer that visits the link." (define-key map "h" 'vc-insert-headers) (define-key map "i" 'vc-register) (define-key map "l" 'vc-print-log) + (define-key map "L" 'vc-print-root-log) (define-key map "m" 'vc-merge) (define-key map "r" 'vc-retrieve-tag) (define-key map "s" 'vc-create-tag) @@ -941,6 +946,7 @@ current, and kill the buffer that visits the link." (define-key map "v" 'vc-next-action) (define-key map "+" 'vc-update) (define-key map "=" 'vc-diff) + (define-key map "D" 'vc-root-diff) (define-key map "~" 'vc-revision-other-window) map)) (fset 'vc-prefix-map vc-prefix-map) @@ -969,12 +975,18 @@ current, and kill the buffer that visits the link." (define-key map [vc-diff] '(menu-item "Compare with Base Version" vc-diff :help "Compare file set with the base version")) + (define-key map [vc-root-diff] + '(menu-item "Compare Tree with Base Version" vc-root-diff + :help "Compare current tree with the base version")) (define-key map [vc-update-change-log] '(menu-item "Update ChangeLog" vc-update-change-log :help "Find change log file and add entries from recent version control logs")) (define-key map [vc-print-log] '(menu-item "Show History" vc-print-log :help "List the change log of the current file set in a window")) + (define-key map [vc-print-root-log] + '(menu-item "Show Top of the Tree History " vc-print-root-log + :help "List the change log for the current tree in a window")) (define-key map [separator2] '("----")) (define-key map [vc-insert-header] '(menu-item "Insert Header" vc-insert-headers diff --git a/lisp/vc-mtn.el b/lisp/vc-mtn.el index a6d1d99de81..e03dfaad350 100644 --- a/lisp/vc-mtn.el +++ b/lisp/vc-mtn.el @@ -188,7 +188,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; (defun vc-mtn-roolback (files) ;; ) -(defun vc-mtn-print-log (files &optional buffer) +(defun vc-mtn-print-log (files &optional buffer shortlog) (vc-mtn-command buffer 0 files "log")) (defvar log-view-message-re) @@ -221,7 +221,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2))))) (defun vc-mtn-annotate-command (file buf &optional rev) - (apply 'vc-mtn-command buf 0 file "annotate" + (apply 'vc-mtn-command buf 'async file "annotate" (if rev (list "-r" rev)))) (declare-function vc-annotate-convert-time "vc-annotate" (time)) diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el index 8e6eb62ae75..9f225e3dff7 100644 --- a/lisp/vc-rcs.el +++ b/lisp/vc-rcs.el @@ -220,7 +220,7 @@ When VERSION is given, perform check for that version." (unless version (setq version (vc-working-revision file))) (with-temp-buffer (string= version - (if (vc-trunk-p version) + (if (vc-rcs-trunk-p version) (progn ;; Compare VERSION to the head version number. (vc-insert-file (vc-name file) "^[0-9]") @@ -378,7 +378,7 @@ whether to remove it." (not (string= (vc-branch-part old-version) (vc-branch-part new-version)))) (vc-rcs-set-default-branch file - (if (vc-trunk-p new-version) nil + (if (vc-rcs-trunk-p new-version) nil (vc-branch-part new-version))) ;; If this is an old RCS release, we might have ;; to remove a remaining lock. @@ -438,7 +438,7 @@ attempt the checkout for all registered files beneath it." ;; use current workfile version workrev ;; REV is t ... - (if (not (vc-trunk-p workrev)) + (if (not (vc-rcs-trunk-p workrev)) ;; ... go to head of current branch (vc-branch-part workrev) ;; ... go to head of trunk @@ -456,7 +456,7 @@ attempt the checkout for all registered files beneath it." (vc-rcs-set-default-branch file (if (vc-rcs-latest-on-branch-p file new-version) - (if (vc-trunk-p new-version) nil + (if (vc-rcs-trunk-p new-version) nil (vc-branch-part new-version)) new-version))))) (message "Checking out %s...done" file)))))) @@ -465,10 +465,10 @@ attempt the checkout for all registered files beneath it." "Roll back, undoing the most recent checkins of FILES. Directories are expanded to all registered subfiles in them." (if (not files) - (error "RCS backend doesn't support directory-level rollback.")) + (error "RCS backend doesn't support directory-level rollback")) (dolist (file (vc-expand-dirs files)) (let* ((discard (vc-working-revision file)) - (previous (if (vc-trunk-p discard) "" (vc-branch-part discard))) + (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard))) (config (current-window-configuration)) (done nil)) (if (null (yes-or-no-p (format "Remove version %s from %s history? " @@ -538,10 +538,23 @@ directory the operation is applied to all registered files beneath it." ;;; History functions ;;; -(defun vc-rcs-print-log (files &optional buffer) +(defun vc-rcs-print-log-cleanup () + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (forward-line -1) + (while (looking-at "=*\n") + (delete-char (- (match-end 0) (match-beginning 0))) + (forward-line -1)) + (goto-char (point-min)) + (when (looking-at "[\b\t\n\v\f\r ]+") + (delete-char (- (match-end 0) (match-beginning 0)))))) + +(defun vc-rcs-print-log (files &optional buffer shortlog) "Get change log associated with FILE. If FILE is a directory the operation is applied to all registered files beneath it." - (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files)))) + (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files))) + (with-current-buffer (or buffer "*vc*") + (vc-rcs-print-log-cleanup))) (defun vc-rcs-diff (files &optional oldvers newvers buffer) "Get a difference report using RCS between two sets of files." @@ -673,7 +686,8 @@ Optional arg REVISION is a revision to annotate from." ;; property of this approach is ability to push instructions ;; onto `path' directly, w/o need to maintain rev boundaries. (dolist (insn (cdr (assq :insn meta))) - (goto-line (pop insn)) + (goto-char (point-min)) + (forward-line (1- (pop insn))) (setq p (point)) (case (pop insn) (k (setq s (buffer-substring-no-properties @@ -705,7 +719,8 @@ Optional arg REVISION is a revision to annotate from." (setq meta (cdr (assoc pre revisions)) prda nil) (dolist (insn (cdr (assq :insn meta))) - (goto-line (pop insn)) + (goto-char (point-min)) + (forward-line (1- (pop insn))) (case (pop insn) (k (delete-region (point) (progn (forward-line (car insn)) @@ -799,6 +814,95 @@ systime, or nil if there is none. Also, reposition point." ;;; Miscellaneous ;;; +(defun vc-rcs-trunk-p (rev) + "Return t if REV is a revision on the trunk." + (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) + +(defun vc-rcs-minor-part (rev) + "Return the minor revision number of a revision number REV." + (string-match "[0-9]+\\'" rev) + (substring rev (match-beginning 0) (match-end 0))) + +(defun vc-rcs-previous-revision (file rev) + "Return the revision number immediately preceding REV for FILE, +or nil if there is no previous revision. This default +implementation works for MAJOR.MINOR-style revision numbers as +used by RCS and CVS." + (let ((branch (vc-branch-part rev)) + (minor-num (string-to-number (vc-rcs-minor-part rev)))) + (when branch + (if (> minor-num 1) + ;; revision does probably not start a branch or release + (concat branch "." (number-to-string (1- minor-num))) + (if (vc-rcs-trunk-p rev) + ;; we are at the beginning of the trunk -- + ;; don't know anything to return here + nil + ;; we are at the beginning of a branch -- + ;; return revision of starting point + (vc-branch-part branch)))))) + +(defun vc-rcs-next-revision (file rev) + "Return the revision number immediately following REV for FILE, +or nil if there is no next revision. This default implementation +works for MAJOR.MINOR-style revision numbers as used by RCS +and CVS." + (when (not (string= rev (vc-working-revision file))) + (let ((branch (vc-branch-part rev)) + (minor-num (string-to-number (vc-rcs-minor-part rev)))) + (concat branch "." (number-to-string (1+ minor-num)))))) + +(defun vc-rcs-update-changelog (files) + "Default implementation of update-changelog. +Uses `rcs2log' which only works for RCS and CVS." + ;; FIXME: We (c|sh)ould add support for cvs2cl + (let ((odefault default-directory) + (changelog (find-change-log)) + ;; Presumably not portable to non-Unixy systems, along with rcs2log: + (tempfile (make-temp-file + (expand-file-name "vc" + (or small-temporary-file-directory + temporary-file-directory)))) + (login-name (or user-login-name + (format "uid%d" (number-to-string (user-uid))))) + (full-name (or add-log-full-name + (user-full-name) + (user-login-name) + (format "uid%d" (number-to-string (user-uid))))) + (mailing-address (or add-log-mailing-address + user-mail-address))) + (find-file-other-window changelog) + (barf-if-buffer-read-only) + (vc-buffer-sync) + (undo-boundary) + (goto-char (point-min)) + (push-mark) + (message "Computing change log entries...") + (message "Computing change log entries... %s" + (unwind-protect + (progn + (setq default-directory odefault) + (if (eq 0 (apply 'call-process + (expand-file-name "rcs2log" + exec-directory) + nil (list t tempfile) nil + "-c" changelog + "-u" (concat login-name + "\t" full-name + "\t" mailing-address) + (mapcar + (lambda (f) + (file-relative-name + (expand-file-name f odefault))) + files))) + "done" + (pop-to-buffer (get-buffer-create "*vc*")) + (erase-buffer) + (insert-file-contents tempfile) + "failed")) + (setq default-directory (file-name-directory changelog)) + (delete-file tempfile))))) + (defun vc-rcs-check-headers () "Check if the current file has any headers in it." (save-excursion diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el index 9236f604f80..44b2b289477 100644 --- a/lisp/vc-sccs.el +++ b/lisp/vc-sccs.el @@ -288,7 +288,7 @@ locked. REV is the revision to check out." are expanded to all version-controlled subfiles." (setq files (vc-expand-dirs files)) (if (not files) - (error "SCCS backend doesn't support directory-level rollback.")) + (error "SCCS backend doesn't support directory-level rollback")) (dolist (file files) (let ((discard (vc-working-revision file))) (if (null (yes-or-no-p (format "Remove version %s from %s history? " @@ -331,7 +331,7 @@ revert all subfiles." ;;; History functions ;;; -(defun vc-sccs-print-log (files &optional buffer) +(defun vc-sccs-print-log (files &optional buffer shortlog) "Get change log associated with FILES." (setq files (vc-expand-dirs files)) (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files))) @@ -370,6 +370,12 @@ revert all subfiles." ;;; Miscellaneous ;;; +(defun vc-sccs-previous-revision (file rev) + (vc-call-backend 'RCS 'previous-revision file rev)) + +(defun vc-sccs-next-revision (file rev) + (vc-call-backend 'RCS 'next-revision file rev)) + (defun vc-sccs-check-headers () "Check if the current file has any headers in it." (save-excursion diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index 830e1582978..ff3eef245f1 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -126,7 +126,8 @@ want to force an empty list of arguments, use t." (file-name-directory file))) (with-temp-buffer (cd (file-name-directory file)) - (let ((status + (let* (process-file-side-effects + (status (condition-case nil ;; Ignore all errors. (vc-svn-command t t file "status" "-v") @@ -142,11 +143,12 @@ want to force an empty list of arguments, use t." (defun vc-svn-state (file &optional localp) "SVN-specific version of `vc-state'." - (setq localp (or localp (vc-stay-local-p file 'SVN))) - (with-temp-buffer - (cd (file-name-directory file)) - (vc-svn-command t 0 file "status" (if localp "-v" "-u")) - (vc-svn-parse-status file))) + (let (process-file-side-effects) + (setq localp (or localp (vc-stay-local-p file 'SVN))) + (with-temp-buffer + (cd (file-name-directory file)) + (vc-svn-command t 0 file "status" (if localp "-v" "-u")) + (vc-svn-parse-status file)))) (defun vc-svn-state-heuristic (file) "SVN-specific state heuristic." @@ -203,7 +205,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (defun vc-svn-dir-extra-headers (dir) "Generate extra status headers for a Subversion working copy." - (vc-svn-command "*vc*" 0 nil "info") + (let (process-file-side-effects) + (vc-svn-command "*vc*" 0 nil "info")) (let ((repo (save-excursion (and (progn @@ -305,12 +308,13 @@ This is only possible if SVN is responsible for FILE's directory.") (defun vc-svn-find-revision (file rev buffer) "SVN-specific retrieval of a specified version into a buffer." - (apply 'vc-svn-command - buffer 0 file - "cat" - (and rev (not (string= rev "")) - (concat "-r" rev)) - (vc-switches 'SVN 'checkout))) + (let (process-file-side-effects) + (apply 'vc-svn-command + buffer 0 file + "cat" + (and rev (not (string= rev "")) + (concat "-r" rev)) + (vc-switches 'SVN 'checkout)))) (defun vc-svn-checkout (file &optional editable rev) (message "Checking out %s..." file) @@ -458,7 +462,7 @@ or svn+ssh://." (require 'add-log) (set (make-local-variable 'log-view-per-file-logs) nil)) -(defun vc-svn-print-log (files &optional buffer) +(defun vc-svn-print-log (files &optional buffer shortlog) "Get change log(s) associated with FILES." (save-current-buffer (vc-setup-buffer buffer) @@ -684,7 +688,7 @@ information about FILENAME and return its status." ;; Support for `svn annotate' (defun vc-svn-annotate-command (file buf &optional rev) - (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev)))) + (vc-svn-command buf 'async file "annotate" (if rev (concat "-r" rev)))) (defun vc-svn-annotate-time-of-rev (rev) ;; Arbitrarily assume 10 commmits per day. diff --git a/lisp/vc.el b/lisp/vc.el index 1f3ea9ddcaf..f0275153679 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -225,12 +225,6 @@ ;; The default implementation deals well with all states that ;; `vc-state' can return. ;; -;; - prettify-state-info (file) -;; -;; Translate the `vc-state' property of FILE into a string that can be -;; used in a human-readable buffer. The default implementation deals well -;; with all states that `vc-state' can return. -;; ;; STATE-CHANGING FUNCTIONS ;; ;; * create-repo (backend) @@ -313,6 +307,8 @@ ;; arg CONTENTS-DONE is non-nil, then the contents of FILE have ;; already been reverted from a version backup, and this function ;; only needs to update the status of FILE within the backend. +;; If FILE is in the `added' state it should be returned to the +;; `unregistered' state. ;; ;; - rollback (files) ;; @@ -350,11 +346,12 @@ ;; ;; HISTORY FUNCTIONS ;; -;; * print-log (files &optional buffer) +;; * print-log (files &optional buffer shortlog) ;; ;; Insert the revision log for FILES into BUFFER, or the *vc* buffer ;; if BUFFER is nil. (Note: older versions of this function expected ;; only a single file argument.) +;; If SHORTLOG is true insert a short version of the log. ;; ;; - log-view-mode () ;; @@ -465,6 +462,9 @@ ;; `revert' operations itself, without calling the backend system. The ;; default implementation always returns nil. ;; +;; - root (file) +;; Return the root of the VC controlled hierarchy for file. +;; ;; - repository-hostname (dirname) ;; ;; Return the hostname that the backend will have to contact @@ -941,7 +941,7 @@ current buffer." (list (vc-responsible-backend (file-name-directory (buffer-file-name))) (list buffer-file-name)))) - (t (error "No fileset is available here."))))) + (t (error "No fileset is available here"))))) (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." @@ -1025,9 +1025,9 @@ merge in the changes into your working copy." ;; Do the right thing (cond ((eq state 'missing) - (error "Fileset files are missing, so cannot be operated on.")) + (error "Fileset files are missing, so cannot be operated on")) ((eq state 'ignored) - (error "Fileset files are ignored by the version-control system.")) + (error "Fileset files are ignored by the version-control system")) ((or (null state) (eq state 'unregistered)) (vc-register nil vc-fileset)) ;; Files are up-to-date, or need a merge and user specified a revision @@ -1251,7 +1251,7 @@ first backend that could register the file is used." "Register the current file with a specified back end." (interactive "SBackend: ") (when (not (member backend vc-handled-backends)) - (error "Unknown back end.")) + (error "Unknown back end")) (let ((vc-handled-backends (list backend))) (call-interactively 'vc-register))) @@ -1481,7 +1481,8 @@ returns t if the buffer had changes, nil otherwise." ;; I made it conditional on vc-diff-added-files but it should probably ;; just be removed (or copied/moved to specific backends). --Stef. (when vc-diff-added-files - (let ((filtered '())) + (let ((filtered '()) + process-file-side-effects) (dolist (file files) (if (or (file-directory-p file) (not (string= (vc-working-revision file) "0"))) @@ -1518,6 +1519,20 @@ returns t if the buffer had changes, nil otherwise." ;; because we don't know that yet. t))) +(defun vc-read-revision (prompt &optional files backend default initial-input) + (cond + ((null files) + (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef + (setq files (cadr vc-fileset)) + (setq backend (car vc-fileset)))) + ((null backend) (setq backend (vc-backend (car files))))) + (let ((completion-table + (vc-call-backend backend 'revision-completion-table files))) + (if completion-table + (completing-read prompt completion-table + nil nil initial-input nil default) + (read-string prompt initial-input nil default)))) + ;;;###autoload (defun vc-version-diff (files rev1 rev2) "Report diffs between revisions of the fileset in the repository history." @@ -1526,8 +1541,6 @@ returns t if the buffer had changes, nil otherwise." (files (cadr vc-fileset)) (backend (car vc-fileset)) (first (car files)) - (completion-table - (vc-call-backend backend 'revision-completion-table files)) (rev1-default nil) (rev2-default nil)) (cond @@ -1554,20 +1567,14 @@ returns t if the buffer had changes, nil otherwise." "Older revision: ")) (rev2-prompt (concat "Newer revision (default " (or rev2-default "current source") "): ")) - (rev1 (if completion-table - (completing-read rev1-prompt completion-table - nil nil nil nil rev1-default) - (read-string rev1-prompt nil nil rev1-default))) - (rev2 (if completion-table - (completing-read rev2-prompt completion-table - nil nil nil nil rev2-default) - (read-string rev2-prompt nil nil rev2-default)))) + (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) + (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) (when (string= rev1 "") (setq rev1 nil)) (when (string= rev2 "") (setq rev2 nil)) (list files rev1 rev2)))) ;; All that was just so we could do argument completion! (when (and (not rev1) rev2) - (error "Not a valid revision range.")) + (error "Not a valid revision range")) ;; Yes, it's painful to call (vc-deduce-fileset) again. Alas, the ;; placement rules for (interactive) don't actually leave us a choice. (vc-diff-internal t (vc-deduce-fileset) rev1 rev2 (interactive-p))) @@ -1594,6 +1601,33 @@ saving the buffer." (vc-diff-internal t (vc-deduce-fileset) nil nil (interactive-p)))) ;;;###autoload +(defun vc-root-diff (historic &optional not-urgent) + "Display diffs between file revisions. +Normally this compares the currently selected fileset with their +working revisions. With a prefix argument HISTORIC, it reads two revision +designators specifying which revisions to compare. + +The optional argument NOT-URGENT non-nil means it is ok to say no to +saving the buffer." + (interactive (list current-prefix-arg t)) + (if historic + ;; FIXME: this does not work right, `vc-version-diff' ends up + ;; calling `vc-deduce-fileset' to find the files to diff, and + ;; that's not what we want here, we want the diff for the VC root dir. + (call-interactively 'vc-version-diff) + (when buffer-file-name (vc-buffer-sync not-urgent)) + (let ((backend + (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + (vc-mode (vc-backend buffer-file-name)))) + rootdir working-revision) + (unless backend + (error "Buffer is not version controlled")) + (setq rootdir (vc-call-backend backend 'root default-directory)) + (setq working-revision (vc-working-revision rootdir)) + (vc-diff-internal + t (list backend (list rootdir) working-revision) nil nil (interactive-p))))) + +;;;###autoload (defun vc-revision-other-window (rev) "Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -1601,13 +1635,9 @@ If `F.~REV~' already exists, use it instead of checking it out again." (interactive (save-current-buffer (vc-ensure-vc-buffer) - (let ((completion-table - (vc-call revision-completion-table (list buffer-file-name))) - (prompt "Revision to visit (default is working revision): ")) - (list - (if completion-table - (completing-read prompt completion-table) - (read-string prompt)))))) + (list + (vc-read-revision "Revision to visit (default is working revision): " + (list buffer-file-name))))) (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (revision (if (string-equal rev "") @@ -1733,16 +1763,22 @@ See Info node `Merging'." (vc-checkout file t) (error "Merge aborted")))) (setq first-revision - (read-string (concat "Branch or revision to merge from " - "(default news on current branch): "))) + (vc-read-revision + (concat "Branch or revision to merge from " + "(default news on current branch): ") + (list file) + backend)) (if (string= first-revision "") (setq status (vc-call-backend backend 'merge-news file)) (if (not (vc-find-backend-function backend 'merge)) (error "Sorry, merging is not implemented for %s" backend) (if (not (vc-branch-p first-revision)) (setq second-revision - (read-string "Second revision: " - (concat (vc-branch-part first-revision) "."))) + (vc-read-revision + "Second revision: " + (list file) backend nil + ;; FIXME: This is CVS/RCS/SCCS specific. + (concat (vc-branch-part first-revision) "."))) ;; We want to merge an entire branch. Set revisions ;; accordingly, so that vc-BACKEND-merge understands us. (setq second-revision first-revision) @@ -1817,34 +1853,43 @@ allowed and simply skipped)." ;; Miscellaneous other entry points +;; FIXME: this should be a defcustom +;; FIXME: maybe add another choice: +;; `root-directory' (or somesuch), which would mean show a short log +;; for the root directory. +(defvar vc-log-short-style '(directory) + "Whether or not to show a short log. +If it contains `directory' then if the fileset contains a directory show a short log. +If it contains `file' then show short logs for files. +Not all VC backends support short logs!") + (defun vc-print-log-internal (backend files working-revision) ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled ;; buffer can be accessed by the command. - (vc-call-backend backend 'print-log files "*vc-change-log*") - (pop-to-buffer "*vc-change-log*") - (vc-exec-after - `(let ((inhibit-read-only t)) - (vc-call-backend ',backend 'log-view-mode) - (set (make-local-variable 'log-view-vc-backend) ',backend) - (set (make-local-variable 'log-view-vc-fileset) ',files) - - ;; FIXME: this seems to apply only to RCS/CVS, it doesn't quite - ;; belong here in the generic code. - (goto-char (point-max)) - (forward-line -1) - (while (looking-at "=*\n") - (delete-char (- (match-end 0) (match-beginning 0))) - (forward-line -1)) - (goto-char (point-min)) - (when (looking-at "[\b\t\n\v\f\r ]+") - (delete-char (- (match-end 0) (match-beginning 0)))) - - (shrink-window-if-larger-than-buffer) - ;; move point to the log entry for the working revision - (vc-call-backend ',backend 'show-log-entry ',working-revision) - (setq vc-sentinel-movepoint (point)) - (set-buffer-modified-p nil)))) + (let ((dir-present nil) + (vc-short-log nil)) + (dolist (file files) + (when (file-directory-p file) + (setq dir-present t))) + (setq vc-short-log + (not (null (if dir-present + (memq 'directory vc-log-short-style) + (memq 'file vc-log-short-style))))) + (vc-call-backend backend 'print-log files "*vc-change-log*" vc-short-log) + (pop-to-buffer "*vc-change-log*") + (vc-exec-after + `(let ((inhibit-read-only t) + (vc-short-log ,vc-short-log)) + (vc-call-backend ',backend 'log-view-mode) + (set (make-local-variable 'log-view-vc-backend) ',backend) + (set (make-local-variable 'log-view-vc-fileset) ',files) + + (shrink-window-if-larger-than-buffer) + ;; move point to the log entry for the working revision + (vc-call-backend ',backend 'show-log-entry ',working-revision) + (setq vc-sentinel-movepoint (point)) + (set-buffer-modified-p nil))))) ;;;###autoload (defun vc-print-log (&optional working-revision) @@ -1858,6 +1903,20 @@ If WORKING-REVISION is non-nil, leave the point at that revision." (vc-print-log-internal backend files working-revision))) ;;;###autoload +(defun vc-print-root-log () + "List the change log of for the current VC controlled tree in a window." + (interactive) + (let ((backend + (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + (vc-mode (vc-backend buffer-file-name)))) + rootdir working-revision) + (unless backend + (error "Buffer is not version controlled")) + (setq rootdir (vc-call-backend backend 'root default-directory)) + (setq working-revision (vc-working-revision rootdir)) + (vc-print-log-internal backend (list rootdir) working-revision))) + +;;;###autoload (defun vc-revert () "Revert working copies of the selected fileset to their repository contents. This asks for confirmation if the buffer contents are not identical @@ -1874,7 +1933,7 @@ to the working revision (except for keyword expansion)." (dolist (file files) (let ((buf (get-file-buffer file))) (when (and buf (buffer-modified-p buf)) - (error "Please kill or save all modified buffers before reverting."))) + (error "Please kill or save all modified buffers before reverting"))) (when (vc-up-to-date-p file) (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) (error "Revert canceled")))) @@ -1909,7 +1968,7 @@ depending on the underlying version-control system." (error "Rollback requires a singleton fileset or repository versioning")) ;; FIXME: latest-on-branch-p should take the fileset. (when (not (vc-call-backend backend 'latest-on-branch-p (car files))) - (error "Rollback is only possible at the tip revision.")) + (error "Rollback is only possible at the tip revision")) ;; If any of the files is visited by the current buffer, make ;; sure buffer is saved. If the user says `no', abort since ;; we cannot show the changes and ask for confirmation to @@ -1918,9 +1977,9 @@ depending on the underlying version-control system." (vc-buffer-sync nil)) (dolist (file files) (when (buffer-modified-p (get-file-buffer file)) - (error "Please kill or save all modified buffers before rollback.")) + (error "Please kill or save all modified buffers before rollback")) (when (not (vc-up-to-date-p file)) - (error "Please revert all modified workfiles before rollback."))) + (error "Please revert all modified workfiles before rollback"))) ;; Accumulate changes associated with the fileset (vc-setup-buffer "*vc-diff*") (not-modified) @@ -2246,11 +2305,6 @@ log entries should be gathered." ;; functions that operate on RCS revision numbers. This code should ;; also be moved into the backends. It stays for now, however, since ;; it is used in code below. -;;;###autoload -(defun vc-trunk-p (rev) - "Return t if REV is a revision on the trunk." - (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) - (defun vc-branch-p (rev) "Return t if REV is a branch revision." (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev)))) @@ -2262,43 +2316,9 @@ log entries should be gathered." (when index (substring rev 0 index)))) -(defun vc-minor-part (rev) - "Return the minor revision number of a revision number REV." - (string-match "[0-9]+\\'" rev) - (substring rev (match-beginning 0) (match-end 0))) - (define-obsolete-function-alias 'vc-default-previous-version 'vc-default-previous-revision "23.1") -(defun vc-default-previous-revision (backend file rev) - "Return the revision number immediately preceding REV for FILE, -or nil if there is no previous revision. This default -implementation works for MAJOR.MINOR-style revision numbers as -used by RCS and CVS." - (let ((branch (vc-branch-part rev)) - (minor-num (string-to-number (vc-minor-part rev)))) - (when branch - (if (> minor-num 1) - ;; revision does probably not start a branch or release - (concat branch "." (number-to-string (1- minor-num))) - (if (vc-trunk-p rev) - ;; we are at the beginning of the trunk -- - ;; don't know anything to return here - nil - ;; we are at the beginning of a branch -- - ;; return revision of starting point - (vc-branch-part branch)))))) - -(defun vc-default-next-revision (backend file rev) - "Return the revision number immediately following REV for FILE, -or nil if there is no next revision. This default implementation -works for MAJOR.MINOR-style revision numbers as used by RCS -and CVS." - (when (not (string= rev (vc-working-revision file))) - (let ((branch (vc-branch-part rev)) - (minor-num (string-to-number (vc-minor-part rev)))) - (concat branch "." (number-to-string (1+ minor-num)))))) - (defun vc-default-responsible-p (backend file) "Indicate whether BACKEND is reponsible for FILE. The default is to return nil always." @@ -2317,63 +2337,6 @@ editing non-current revisions is not supported by default." (defun vc-default-init-revision (backend) vc-default-init-revision) -(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log) - -(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log) - -;; FIXME: This should probably be moved to vc-rcs.el and replaced in -;; vc-cvs.el by code using cvs2cl. -(defun vc-update-changelog-rcs2log (files) - "Default implementation of update-changelog. -Uses `rcs2log' which only works for RCS and CVS." - ;; FIXME: We (c|sh)ould add support for cvs2cl - (let ((odefault default-directory) - (changelog (find-change-log)) - ;; Presumably not portable to non-Unixy systems, along with rcs2log: - (tempfile (make-temp-file - (expand-file-name "vc" - (or small-temporary-file-directory - temporary-file-directory)))) - (login-name (or user-login-name - (format "uid%d" (number-to-string (user-uid))))) - (full-name (or add-log-full-name - (user-full-name) - (user-login-name) - (format "uid%d" (number-to-string (user-uid))))) - (mailing-address (or add-log-mailing-address - user-mail-address))) - (find-file-other-window changelog) - (barf-if-buffer-read-only) - (vc-buffer-sync) - (undo-boundary) - (goto-char (point-min)) - (push-mark) - (message "Computing change log entries...") - (message "Computing change log entries... %s" - (unwind-protect - (progn - (setq default-directory odefault) - (if (eq 0 (apply 'call-process - (expand-file-name "rcs2log" - exec-directory) - nil (list t tempfile) nil - "-c" changelog - "-u" (concat login-name - "\t" full-name - "\t" mailing-address) - (mapcar - (lambda (f) - (file-relative-name - (expand-file-name f odefault))) - files))) - "done" - (pop-to-buffer (get-buffer-create "*vc*")) - (erase-buffer) - (insert-file-contents tempfile) - "failed")) - (setq default-directory (file-name-directory changelog)) - (delete-file tempfile))))) - (defun vc-default-find-revision (backend file rev buffer) "Provide the new `find-revision' op based on the old `checkout' op. This is only for compatibility with old backends. They should be updated @@ -2386,26 +2349,6 @@ to provide the `find-revision' operation instead." (insert-file-contents-literally tmpfile))) (delete-file tmpfile)))) -(defun vc-default-prettify-state-info (backend file) - (let* ((state (vc-state file)) - (statestring - (cond - ((stringp state) (concat "(locked:" state ")")) - ((eq state 'edited) "(modified)") - ((eq state 'needs-merge) "(merge)") - ((eq state 'needs-update) "(update)") - ((eq state 'added) "(added)") - ((eq state 'removed) "(removed)") - ((eq state 'ignored) "(ignored)") - ((eq state 'unregistered) "(unregistered)") - ((eq state 'unlocked-changes) "(stale)") - (t (format "(unknown:%s)" state)))) - (buffer - (get-file-buffer file)) - (modflag - (if (and buffer (buffer-modified-p buffer)) "+" ""))) - (concat statestring modflag))) - (defun vc-default-rename-file (backend old new) (condition-case nil (add-name-to-file old new) diff --git a/lisp/version.el b/lisp/version.el index 269c3660e75..01347a5735a 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -1,7 +1,7 @@ ;;; version.el --- record version number of Emacs -*- no-byte-compile: t -*- -;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -24,24 +24,23 @@ ;;; Commentary: +;; This file is loaded uncompiled when dumping Emacs. +;; Doc-strings should adhere to the conventions of make-docfile. + ;;; Code: -(defconst emacs-copyright "Copyright (C) 2009 Free Software Foundation, Inc." - "Short copyright string for this version of Emacs.") +(defconst emacs-copyright "Copyright (C) 2009 Free Software Foundation, Inc." "\ +Short copyright string for this version of Emacs.") (defconst emacs-version "23.1.50" "\ Version numbers of this version of Emacs.") -(defconst emacs-major-version - (progn (string-match "^[0-9]+" emacs-version) - (string-to-number (match-string 0 emacs-version))) - "Major version number of this version of Emacs. +(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\ +Major version number of this version of Emacs. This variable first existed in version 19.23.") -(defconst emacs-minor-version - (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) - (string-to-number (match-string 1 emacs-version))) - "Minor version number of this version of Emacs. +(defconst emacs-minor-version (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) (string-to-number (match-string 1 emacs-version))) "\ +Minor version number of this version of Emacs. This variable first existed in version 19.23.") (defconst emacs-build-time (current-time) "\ diff --git a/lisp/view.el b/lisp/view.el index 311d5e3123c..5ec94411ad1 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -677,7 +677,7 @@ OLD-WINDOW." ;; Not the only frame, so can safely be removed. (if view-remove-frame-by-deleting (delete-frame frame) - (setq notlost t) ; Keep the window. See below. + (setq notlost t) ; Keep the window. See below. (iconify-frame frame)))))))) ;; If a frame is removed by iconifying it, the window is not ;; really lost. In this case we keep the entry in @@ -817,7 +817,8 @@ Display is centered at LINE. Also set the mark at the position where point was." (interactive "p") (push-mark) - (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) (view-recenter)) (defun View-back-to-mark (&optional ignore) @@ -835,7 +836,7 @@ invocations return to earlier marks." ;; Scroll forward LINES lines. If BACKWARD is non-nil, scroll backwards. ;; If LINES is negative scroll in the other direction. ;; If LINES is 0 or nil, scroll DEFAULT lines (if DEFAULT is nil, scroll - ;; by one page). If MAXDEFAULT is non-nil, scroll no more than a window. + ;; by one page). If MAXDEFAULT is non-nil, scroll no more than a window. (if (or (null lines) (zerop (setq lines (prefix-numeric-value lines)))) (setq lines default)) (when (and lines (< lines 0)) @@ -930,7 +931,7 @@ See also `View-scroll-page-forward-set-page-size'." (defun View-scroll-line-forward (&optional lines) "Scroll forward one line (or prefix LINES lines) in View mode. -See also `View-scroll-page-forward,' but note that scrolling is limited +See also `View-scroll-page-forward', but note that scrolling is limited to minimum of LINES and one window-full." (interactive "P") (view-scroll-lines lines nil 1 t)) @@ -1031,8 +1032,8 @@ for highlighting the match that is found." (defun view-search (times regexp) ;; This function does the job for all the View-search- commands. - ;; Search for the TIMESt match for REGEXP. If TIMES is negative - ;; search backwards. If REGEXP is nil use `view-last-regexp'. + ;; Search for the TIMESt match for REGEXP. If TIMES is negative + ;; search backwards. If REGEXP is nil use `view-last-regexp'. ;; Characters "!" and "@" have a special meaning at the beginning of ;; REGEXP and are removed from REGEXP before the search "!" means ;; search for lines with no match for REGEXP. "@" means search in diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 6303287dee2..f1579a97663 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -1,7 +1,7 @@ ;;; w32-fns.el --- Lisp routines for Windows NT -;; Copyright (C) 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009 Free Software Foundation, Inc. ;; Author: Geoff Voelker <voelker@cs.washington.edu> ;; Keywords: internal @@ -34,13 +34,6 @@ (defvar x-alternatives-map (let ((map (make-sparse-keymap))) ;; Map certain keypad keys into ASCII characters that people usually expect. - (define-key map [backspace] [127]) - (define-key map [delete] [127]) - (define-key map [tab] [?\t]) - (define-key map [linefeed] [?\n]) - (define-key map [clear] [?\C-l]) - (define-key map [return] [?\C-m]) - (define-key map [escape] [?\e]) (define-key map [M-backspace] [?\M-\d]) (define-key map [M-delete] [?\M-\d]) (define-key map [M-tab] [?\M-\t]) @@ -170,26 +163,26 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'after-init-hook 'w32-check-shell-configuration) -;;; Override setting chosen at startup. +;; Override setting chosen at startup. (defun set-default-process-coding-system () ;; Most programs on Windows will accept Unix line endings on input ;; (and some programs ported from Unix require it) but most will ;; produce DOS line endings on output. (setq default-process-coding-system - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-unix) '(raw-text-dos . raw-text-unix))) ;; Make cmdproxy default to using DOS line endings for input, ;; because some Windows programs (including command.com) require it. (add-to-list 'process-coding-system-alist `("[cC][mM][dD][pP][rR][oO][xX][yY]" - . ,(if default-enable-multibyte-characters + . ,(if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-dos) '(raw-text-dos . raw-text-dos)))) ;; plink needs DOS input when entering the password. (add-to-list 'process-coding-system-alist `("[pP][lL][iI][nN][kK]" - . ,(if default-enable-multibyte-characters + . ,(if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-dos) '(raw-text-dos . raw-text-dos))))) @@ -201,8 +194,8 @@ You should set this to t when using a non-system shell.\n\n")))) (defvar w32-valid-locales nil "List of locale ids known to be supported.") -;;; This is the brute-force version; an efficient version is now -;;; built-in though. +;; This is the brute-force version; an efficient version is now +;; built-in though. (if (not (fboundp 'w32-get-valid-locale-ids)) (defun w32-get-valid-locale-ids () "Return list of all valid Windows locale ids." @@ -227,11 +220,11 @@ You should set this to t when using a non-system shell.\n\n")))) (w32-get-locale-info locale) (w32-get-locale-info locale t)))))) -;;; Setup Info-default-directory-list to include the info directory -;;; near where Emacs executable was installed. We used to set INFOPATH, -;;; but when this is set Info-default-directory-list is ignored. We -;;; also cannot rely upon what is set in paths.el because they assume -;;; that configuration during build time is correct for runtime. +;; Setup Info-default-directory-list to include the info directory +;; near where Emacs executable was installed. We used to set INFOPATH, +;; but when this is set Info-default-directory-list is ignored. We +;; also cannot rely upon what is set in paths.el because they assume +;; that configuration during build time is correct for runtime. (defun w32-init-info () (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) @@ -245,20 +238,20 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'before-init-hook 'w32-init-info) -;;; The variable source-directory is used to initialize Info-directory-list. -;;; However, the common case is that Emacs is being used from a binary -;;; distribution, and the value of source-directory is meaningless in that -;;; case. Even worse, source-directory can refer to a directory on a drive -;;; on the build machine that happens to be a removable drive on the user's -;;; machine. When this happens, Emacs tries to access the removable drive -;;; and produces the abort/retry/ignore dialog. Since we do not use -;;; source-directory, set it to something that is a reasonable approximation -;;; on the user's machine. - -;(add-hook 'before-init-hook -; '(lambda () -; (setq source-directory (file-name-as-directory -; (expand-file-name ".." exec-directory))))) +;; The variable source-directory is used to initialize Info-directory-list. +;; However, the common case is that Emacs is being used from a binary +;; distribution, and the value of source-directory is meaningless in that +;; case. Even worse, source-directory can refer to a directory on a drive +;; on the build machine that happens to be a removable drive on the user's +;; machine. When this happens, Emacs tries to access the removable drive +;; and produces the abort/retry/ignore dialog. Since we do not use +;; source-directory, set it to something that is a reasonable approximation +;; on the user's machine. + +;;(add-hook 'before-init-hook +;; (lambda () +;; (setq source-directory (file-name-as-directory +;; (expand-file-name ".." exec-directory))))) (defun convert-standard-filename (filename) "Convert a standard file's name to something suitable for the current OS. @@ -360,25 +353,15 @@ This function is provided for backward compatibility, since ;; w32-system-coding-system. Use that instead. (defvaralias 'w32-system-coding-system 'locale-coding-system) -;;; Set to a system sound if you want a fancy bell. +;; Set to a system sound if you want a fancy bell. (set-message-beep nil) -;;; The "Windows" keys on newer keyboards bring up the Start menu -;;; whether you want it or not - make Emacs ignore these keystrokes -;;; rather than beep. +;; The "Windows" keys on newer keyboards bring up the Start menu +;; whether you want it or not - make Emacs ignore these keystrokes +;; rather than beep. (global-set-key [lwindow] 'ignore) (global-set-key [rwindow] 'ignore) -;; These tell read-char how to convert -;; these special chars to ASCII. -(put 'tab 'ascii-character ?\t) -(put 'linefeed 'ascii-character ?\n) -(put 'clear 'ascii-character 12) -(put 'return 'ascii-character 13) -(put 'escape 'ascii-character ?\e) -(put 'backspace 'ascii-character 127) -(put 'delete 'ascii-character 127) - (defun w32-add-charset-info (xlfd-charset windows-charset codepage) "Function to add character sets to display with Windows fonts. Creates entries in `w32-charset-info-alist'. @@ -442,13 +425,13 @@ bit output with no translation." ;;;; Selections and cut buffers -;;; We keep track of the last text selected here, so we can check the -;;; current selection against it, and avoid passing back our own text -;;; from x-cut-buffer-or-selection-value. +;; We keep track of the last text selected here, so we can check the +;; current selection against it, and avoid passing back our own text +;; from x-cut-buffer-or-selection-value. (defvar x-last-selected-text nil) -;;; It is said that overlarge strings are slow to put into the cut buffer. -;;; Note this value is overridden below. +;; It is said that overlarge strings are slow to put into the cut buffer. +;; Note this value is overridden below. (defvar x-cut-buffer-max 20000 "Max number of characters to put in the cut buffer.") @@ -493,7 +476,7 @@ they were unset." (defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) -;;; Arrange for the kill and yank functions to set and check the clipboard. +;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-get-selection-value) diff --git a/lisp/wdired.el b/lisp/wdired.el index 11b2d9f617d..1c5ac2f23c6 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -486,7 +486,7 @@ non-nil means return old filename." file-new "' failed:\n%s\n") err))))))))) errors)) - + (defun wdired-exit () "Exit wdired and return to dired mode. @@ -553,7 +553,7 @@ Optional arguments are ignored." (if (and (buffer-modified-p) (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? "))) - (error "Error."))) + (error "Error"))) (defun wdired-next-line (arg) "Move down lines then position at filename or the current column. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 7360ccad92c..118a151d67d 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: data, wp -;; Version: 11.2.2 +;; Version: 12.0 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -870,8 +870,8 @@ Used when `whitespace-style' includes `lines' or `lines-tail'." ;; Hacked from `visible-whitespace-mappings' in visws.el (defcustom whitespace-display-mappings '( - (space-mark ?\ [?\xB7] [?.]) ; space - centered dot - (space-mark ?\xA0 [?\xA4] [?_]) ; hard space - currency + (space-mark ?\ [?\u00B7] [?.]) ; space - centered dot + (space-mark ?\xA0 [?\u00A4] [?_]) ; hard space - currency (space-mark ?\x8A0 [?\x8A4] [?_]) ; hard space - currency (space-mark ?\x920 [?\x924] [?_]) ; hard space - currency (space-mark ?\xE20 [?\xE24] [?_]) ; hard space - currency @@ -879,7 +879,7 @@ Used when `whitespace-style' includes `lines' or `lines-tail'." ;; NEWLINE is displayed using the face `whitespace-newline' (newline-mark ?\n [?$ ?\n]) ; eol - dollar sign ;; (newline-mark ?\n [?\u21B5 ?\n] [?$ ?\n]) ; eol - downwards arrow - ;; (newline-mark ?\n [?\xB6 ?\n] [?$ ?\n]) ; eol - pilcrow + ;; (newline-mark ?\n [?\u00B6 ?\n] [?$ ?\n]) ; eol - pilcrow ;; (newline-mark ?\n [?\x8AF ?\n] [?$ ?\n]) ; eol - overscore ;; (newline-mark ?\n [?\x8AC ?\n] [?$ ?\n]) ; eol - negation ;; (newline-mark ?\n [?\x8B0 ?\n] [?$ ?\n]) ; eol - grade @@ -889,7 +889,7 @@ Used when `whitespace-style' includes `lines' or `lines-tail'." ;; 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. - (tab-mark ?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark + (tab-mark ?\t [?\u00BB ?\t] [?\\ ?\t]) ; tab - left quote mark ) "Specify an alist of mappings for displaying characters. @@ -1220,6 +1220,14 @@ SYMBOL is a valid symbol associated with CHAR. (defvar whitespace-tab-width tab-width "Used to save locally `tab-width' value.") +(defvar whitespace-point (point) + "Used to save locally current point value. +Used by `whitespace-trailing-regexp' function (which see).") + +(defvar whitespace-font-lock-refontify nil + "Used to save locally the font-lock refontify state. +Used by `whitespace-post-command-hook' function (which see).") + ;;;###autoload (defun whitespace-toggle-options (arg) @@ -2139,6 +2147,12 @@ resultant list will be returned." (setq whitespace-font-lock t whitespace-font-lock-keywords (copy-sequence font-lock-keywords))) + ;; save current point and refontify when necessary + (set (make-local-variable 'whitespace-point) + (point)) + (set (make-local-variable 'whitespace-font-lock-refontify) + nil) + (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) ;; turn off font lock (set (make-local-variable 'whitespace-font-lock-mode) font-lock-mode) @@ -2149,7 +2163,7 @@ resultant list will be returned." nil (list ;; Show SPACEs - (list whitespace-space-regexp 1 whitespace-space t) + (list #'whitespace-space-regexp 1 whitespace-space t) ;; Show HARD SPACEs (list whitespace-hspace-regexp 1 whitespace-hspace t)) t)) @@ -2158,14 +2172,14 @@ resultant list will be returned." nil (list ;; Show TABs - (list whitespace-tab-regexp 1 whitespace-tab t)) + (list #'whitespace-tab-regexp 1 whitespace-tab t)) t)) (when (memq 'trailing whitespace-active-style) (font-lock-add-keywords nil (list ;; Show trailing blanks - (list whitespace-trailing-regexp 1 whitespace-trailing t)) + (list #'whitespace-trailing-regexp 1 whitespace-trailing t)) t)) (when (or (memq 'lines whitespace-active-style) (memq 'lines-tail whitespace-active-style)) @@ -2177,7 +2191,7 @@ resultant list will be returned." (format "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" whitespace-tab-width (1- whitespace-tab-width) - (/ whitespace-line-column tab-width) + (/ whitespace-line-column whitespace-tab-width) (let ((rem (% whitespace-line-column whitespace-tab-width))) (if (zerop rem) "" @@ -2243,14 +2257,14 @@ resultant list will be returned." nil (list ;; Show empty lines at beginning of buffer - (list whitespace-empty-at-bob-regexp + (list #'whitespace-empty-at-bob-regexp 1 whitespace-empty t)) t) (font-lock-add-keywords nil (list ;; Show empty lines at end of buffer - (list whitespace-empty-at-eob-regexp + (list #'whitespace-empty-at-eob-regexp 1 whitespace-empty t)) t)) (cond @@ -2287,12 +2301,60 @@ resultant list will be returned." ;; turn off font lock (when (whitespace-style-face-p) (font-lock-mode 0) + (remove-hook 'post-command-hook #'whitespace-post-command-hook) (when whitespace-font-lock (setq whitespace-font-lock nil font-lock-keywords whitespace-font-lock-keywords)) ;; restore original font lock state (font-lock-mode whitespace-font-lock-mode))) + +(defun whitespace-trailing-regexp (limit) + "Match trailing spaces which do not contain the point at end of line." + (let ((status t)) + (while (if (re-search-forward whitespace-trailing-regexp limit t) + (save-match-data + (= whitespace-point (match-end 1))) ;; loop if point at eol + (setq status nil))) ;; end of buffer + status)) + + +(defun whitespace-empty-at-bob-regexp (limit) + "Match spaces at beginning of buffer which do not contain the point at \ +beginning of buffer." + (and (/= whitespace-point 1) + (re-search-forward whitespace-empty-at-bob-regexp limit t))) + + +(defun whitespace-empty-at-eob-regexp (limit) + "Match spaces at end of buffer which do not contain the point at end of \ +buffer." + (and (/= whitespace-point (1+ (buffer-size))) + (re-search-forward whitespace-empty-at-eob-regexp limit t))) + + +(defun whitespace-space-regexp (limit) + "Match spaces." + (setq whitespace-font-lock-refontify t) + (re-search-forward whitespace-space-regexp limit t)) + + +(defun whitespace-tab-regexp (limit) + "Match tabs." + (setq whitespace-font-lock-refontify t) + (re-search-forward whitespace-tab-regexp limit t)) + + +(defun whitespace-post-command-hook () + "Save current point into `whitespace-point' variable. +Also refontify when necessary." + (setq whitespace-point (point)) + (let ((refontify (or (eolp) ; end of line + (= whitespace-point 1)))) ; beginning of buffer + (when (or whitespace-font-lock-refontify refontify) + (setq whitespace-font-lock-refontify refontify) + (jit-lock-refontify)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index ef89a01e050..5a22b371db0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -104,8 +104,8 @@ This exists as a variable so it can be set locally in certain buffers.") "Face used for documentation text." :group 'widget-documentation :group 'widget-faces) -;; backward compatibility alias -(put 'widget-documentation-face 'face-alias 'widget-documentation) +(define-obsolete-face-alias 'widget-documentation-face + 'widget-documentation "22.1") (defvar widget-button-face 'widget-button "Face used for buttons in widgets. @@ -114,8 +114,7 @@ This exists as a variable so it can be set locally in certain buffers.") (defface widget-button '((t (:weight bold))) "Face used for widget buttons." :group 'widget-faces) -;; backward compatibility alias -(put 'widget-button-face 'face-alias 'widget-button) +(define-obsolete-face-alias 'widget-button-face 'widget-button "22.1") (defcustom widget-mouse-face 'highlight "Face used for widget buttons when the mouse is above them." @@ -138,8 +137,7 @@ This exists as a variable so it can be set locally in certain buffers.") :slant italic)) "Face used for editable fields." :group 'widget-faces) -;; backward-compatibility alias -(put 'widget-field-face 'face-alias 'widget-field) +(define-obsolete-face-alias 'widget-field-face 'widget-field "22.1") (defface widget-single-line-field '((((type tty)) :background "green3" @@ -154,8 +152,8 @@ This exists as a variable so it can be set locally in certain buffers.") :slant italic)) "Face used for editable fields spanning only a single line." :group 'widget-faces) -;; backward-compatibility alias -(put 'widget-single-line-field-face 'face-alias 'widget-single-line-field) +(define-obsolete-face-alias 'widget-single-line-field-face + 'widget-single-line-field "22.1") ;;; This causes display-table to be loaded, and not usefully. ;;;(defvar widget-single-line-display-table @@ -455,8 +453,8 @@ new value.") '((t :inherit shadow)) "Face used for inactive widgets." :group 'widget-faces) -;; backward-compatibility alias -(put 'widget-inactive-face 'face-alias 'widget-inactive) +(define-obsolete-face-alias 'widget-inactive-face + 'widget-inactive "22.1") (defun widget-specify-inactive (widget from to) "Make WIDGET inactive for user modifications." @@ -859,14 +857,16 @@ button end points." ;; This alias exists only so that one can choose in doc-strings (e.g. ;; Custom-mode) which key-binding of widget-keymap one wants to refer to. ;; http://lists.gnu.org/archive/html/emacs-devel/2008-11/msg00480.html -(defalias 'advertised-widget-backward 'widget-backward) +(define-obsolete-function-alias 'advertised-widget-backward + 'widget-backward "23.2") ;;;###autoload (defvar widget-keymap (let ((map (make-sparse-keymap))) (define-key map "\t" 'widget-forward) (define-key map "\e\t" 'widget-backward) - (define-key map [(shift tab)] 'advertised-widget-backward) + (define-key map [(shift tab)] 'widget-backward) + (put 'widget-backward :advertised-binding [(shift tab)]) (define-key map [backtab] 'widget-backward) (define-key map [down-mouse-2] 'widget-button-click) (define-key map [down-mouse-1] 'widget-button-click) @@ -920,8 +920,8 @@ Recommended as a parent keymap for modes using widgets.") (:weight bold :underline t))) "Face used for pressed buttons." :group 'widget-faces) -;; backward-compatibility alias -(put 'widget-button-pressed-face 'face-alias 'widget-button-pressed) +(define-obsolete-face-alias 'widget-button-pressed-face + 'widget-button-pressed "22.1") (defvar widget-button-click-moves-point nil "If non-nil, `widget-button-click' moves point to a button after invoking it. diff --git a/lisp/window.el b/lisp/window.el index 27daf684e3f..a4931d446a1 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -591,6 +591,8 @@ and `same-window-regexps'. Those variables take precedence over this one. See also `special-display-regexps'." + ;; Autoload if this file no longer dumped. + :risky t :type '(repeat (choice :tag "Buffer" :value "" diff --git a/lisp/woman.el b/lisp/woman.el index 90185c6c846..302a96419e0 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -946,25 +946,25 @@ or different fonts." '((t :inherit italic)) "Face for italic font in man pages." :group 'woman-faces) -(put 'woman-italic-face 'face-alias 'woman-italic) +(define-obsolete-face-alias 'woman-italic-face 'woman-italic "22.1") (defface woman-bold '((t :inherit bold)) "Face for bold font in man pages." :group 'woman-faces) -(put 'woman-bold-face 'face-alias 'woman-bold) +(define-obsolete-face-alias 'woman-bold-face 'woman-bold "22.1") (defface woman-unknown '((t :inherit font-lock-warning-face)) "Face for all unknown fonts in man pages." :group 'woman-faces) -(put 'woman-unknown-face 'face-alias 'woman-unknown) +(define-obsolete-face-alias 'woman-unknown-face 'woman-unknown "22.1") (defface woman-addition '((t :inherit font-lock-builtin-face)) "Face for all WoMan additions to man pages." :group 'woman-faces) -(put 'woman-addition-face 'face-alias 'woman-addition) +(define-obsolete-face-alias 'woman-addition-face 'woman-addition "22.1") (defun woman-default-faces () "Set foreground colors of italic and bold faces to their default values." diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 74c6321c815..f10506a6a9f 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -1,6 +1,7 @@ ;;; x-dnd.el --- drag and drop support for X. -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Jan Dj,Ad(Brv <jan.h.d@swipnet.se> ;; Maintainer: FSF @@ -263,7 +264,7 @@ STRING is the uri-list as a string. The URIs are separated by \\r\\n." WINDOW is the window where the drop happened. STRING is the file names as a string, separated by nulls." (let ((uri-list (split-string string "[\0\r\n]" t)) - (coding (and default-enable-multibyte-characters + (coding (and (default-value 'enable-multibyte-characters) (or file-name-coding-system default-file-name-coding-system))) retval) |