diff options
Diffstat (limited to 'lisp')
103 files changed, 1896 insertions, 1070 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 867d7f9aa23..35f663ee3e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,415 @@ +2011-04-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/cua-base.el (cua-selection-mode): Make it toggle again. + +2011-04-25 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-process-actions): Add POS argument. + Delete region between POS and (pos). + + * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): + Use `nil' position in `tramp-process-actions' call. + (tramp-maybe-open-connection): Call `tramp-process-actions' with pos. + + * net/tramp-smb.el (tramp-smb-maybe-open-connection): Use `nil' + position in `tramp-process-actions' call. + + * net/trampver.el: Update release number. + +2011-04-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * custom.el (defcustom): Obey lexical-binding. + + Fix octave-inf completion problems reported by Alexander Klimov. + * progmodes/octave-inf.el (inferior-octave-mode-syntax-table): + Inherit from octave-mode-syntax-table. + (inferior-octave-mode): Set info-lookup-mode. + (inferior-octave-completion-at-point): New function. + (inferior-octave-complete): Use it and completion-in-region. + (inferior-octave-dynamic-complete-functions): Use it as well, and use + comint-filename-completion. + * progmodes/octave-mod.el (octave-mode-syntax-table): Use _ syntax for + symbol elements which shouldn't be word elements. + (octave-font-lock-keywords, octave-beginning-of-defun) + (octave-function-header-regexp): Adjust regexps accordingly. + (octave-mode-map): Also use info-lookup-symbol for C-c C-h. + +2011-04-25 Juanma Barranquero <lekktu@gmail.com> + + * net/gnutls.el (gnutls-errorp): Declare before first use. + +2011-04-24 Teodor Zlatanov <tzz@lifelogs.com> + + * net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags, + verify-error, and verify-hostname-error parameters. Check whether + default trustfile exists before going to use it. Add missing + argument to gnutls-message-maybe call. Return return value. + Reported by Claudio Bley <claudio.bley@gmail.com>. + (open-gnutls-stream): Add usage example. + + * net/network-stream.el (network-stream-open-starttls): Give host + parameter to `gnutls-negotiate'. + (gnutls-negotiate): Adjust `gnutls-negotiate' declaration. + +2011-04-24 Daniel Colascione <dan.colascione@gmail.com> + + * progmodes/cc-engine.el (c-forward-decl-or-cast-1): + Use correct match group (bug#8438). + +2011-04-24 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-built-in-p): Fix typo. + (package-menu--generate): New arg specifying packages to show. + (package-menu-refresh, package-menu-execute, list-packages): + Callers changed. + (package-show-package-list): New function, replacing deleted + package--list-packages (renamed because it is non-internal). + + * finder.el (finder-list-matches): Use package-show-package-list + instead of deleted package--list-packages. + + * vc/vc-annotate.el (vc-annotate-goto-line): New command. + Based on a previous implementation by Juanma Barranquero (Bug#8366). + (vc-annotate-mode-map): Bind it to RET. + +2011-04-24 Uday S Reddy <u.s.reddy@cs.bham.ac.uk> (tiny change) + + * progmodes/etags.el (next-file): Don't use set-buffer to change + buffers (Bug#8478). + +2011-04-24 Chong Yidong <cyd@stupidchicken.com> + + * files.el (auto-mode-alist): Use js-mode for .json (Bug#8529). + + * apropos.el (apropos-label-face): Avoid variable-pitch face. + (apropos-accumulator): Doc fix. + (apropos-function, apropos-macro, apropos-command) + (apropos-variable, apropos-face, apropos-group, apropos-widget) + (apropos-plist): Add face property. + (apropos-symbols-internal): Fix indentation. + (apropos-print): Simplify help, and recognize apropos-multi-type. + (apropos-print-doc): Use button-type-get to extract the button's + face property. Fill docstring (Bug#8352). + +2011-04-23 Juanma Barranquero <lekktu@gmail.com> + + * buff-menu.el (Buffer-menu--buffers): Fix typo in docstring (bug#8535). + + * play/mpuz.el (mpuz-silent): Doc fix. + (mpuz-mode-map): Use mapc. + (mpuz-put-number-on-board): Rename parameter L to COLUMNS. + (mpuz-letter-to-digit, mpuz-check-all-solved, mpuz-create-buffer): + Fix typos in docstrings. + + * play/doctor.el (doc$, doctor-$, doctor-read-print, doctor-read-token) + (doctor-nounp, doctor-pronounp): Fix typos in docstrings. + + * mouse-drag.el (mouse-drag-throw): Fix typo in docstring. + +2011-04-23 Chong Yidong <cyd@stupidchicken.com> + + * minibuffer.el (completion--do-completion): Avoid the "Next char + not unique" prompt if icomplete-mode is enabled (Bug#5849). + + * mouse.el (mouse-drag-mode-line-1): Make sure that if we push + mouse-2 into unread-command-events, it is interpreted correctly. + + * image-mode.el (image-type, image-mode-map, image-minor-mode-map) + (image-toggle-display): Doc fix. + +2011-04-23 Stephen Berman <stephen.berman@gmx.net> + + * textmodes/page.el (what-page): Use line-number-at-pos to + calculate line number (Bug#6825). + +2011-04-22 Juanma Barranquero <lekktu@gmail.com> + + * eshell/esh-mode.el (find-tag-interactive): Declare function. + (eshell-find-tag): Remove `with-no-warnings', unneeded now. + Pass argument NO-DEFAULT to `find-tag-interactive'. + +2011-04-22 Juanma Barranquero <lekktu@gmail.com> + + Lexical-binding cleanup. + + * progmodes/ada-mode.el (ada-after-change-function, ada-loose-case-word) + (ada-no-auto-case, ada-capitalize-word, ada-untab, ada-narrow-to-defun): + * progmodes/ada-prj.el (ada-prj-initialize-values) + (ada-prj-display-page, ada-prj-field-modified, ada-prj-display-help) + (ada-prj-show-value): + * progmodes/ada-xref.el (ada-find-any-references, ada-gdb-application): + * progmodes/antlr-mode.el (antlr-with-displaying-help-buffer) + (antlr-invalidate-context-cache, antlr-options-menu-filter) + (antlr-language-option-extra, antlr-c++-mode-extra, antlr-run-tool): + * progmodes/bug-reference.el (bug-reference-push-button): + * progmodes/fortran.el (fortran-line-length): + * progmodes/glasses.el (glasses-change): + * progmodes/octave-mod.el (octave-fill-paragraph): + * progmodes/python.el (python-mode, python-pdbtrack-track-stack-file) + (python-pdbtrack-grub-for-buffer, python-sentinel): + * progmodes/sql.el (sql-save-connection): + * progmodes/tcl.el (tcl-indent-command, tcl-popup-menu): + * progmodes/xscheme.el (xscheme-enter-debugger-mode): + Mark unused parameters. + + * progmodes/compile.el (compilation--flush-directory-cache) + (compilation--flush-parse, compile-internal): Mark unused parameters. + (compilation-buffer-name): Rename parameter MODE-NAME to NAME-OF-MODE. + (compilation-next-error-function): Remove unused variable `timestamp'. + + * progmodes/cpp.el (cpp-parse-close): Remove unused variable `begin'. + (cpp-signal-read-only, cpp-grow-overlay): Mark unused parameters. + + * progmodes/dcl-mode.el (dcl-end-of-command): + Remove unused variable `start'. + (dcl-calc-command-indent-multiple, dcl-calc-cont-indent-relative) + (dcl-option-value-basic, dcl-option-value-offset) + (dcl-option-value-margin-offset, dcl-option-value-comment-line): + Mark unused parameters. + (dcl-save-local-variable): Remove unused variable `val'. + (mode): Declare. + + * progmodes/delphi.el (delphi-save-state, delphi-after-change): + Mark unused parameters. + (delphi-ignore-changes): Move before first use. + (delphi-charset-token-at): Remove unused variable `start'. + (delphi-else-start): Remove unused variable `if-count'. + (delphi-comment-block-start, delphi-comment-block-end): + Remove unused variable `kind'. + (delphi-indent-line): Remove unused variable `new-point'. + + * progmodes/ebrowse.el (ebrowse-files-list) + (ebrowse-list-of-matching-members, ebrowse-tags-list-members-in-file): + Mark unused parameters. Don't quote `lambda'. + (ebrowse-sort-tree-list, ebrowse-same-tree-member-buffer-list): + Don't quote `lambda'. + (ebrowse-revert-tree-buffer-from-file, ebrowse-tags-choose-class) + (ebrowse-goto-visible-member/all-member-lists): Mark unused parameters. + (ebrowse-create-tree-buffer): Rename parameter OBARRAY to CLASSES. + (ebrowse-toggle-mark-at-point): Remove unused variable `pnt'. + Use `ignore-errors'. + (ebrowse-frozen-tree-buffer-name, ebrowse-find-source-file) + (ebrowse-view/find-file-and-search-pattern) + (ebrowse-view/find-member-declaration/definition): + Rename parameter TAGS-FILE-NAME to TAGS-FILE. + (ebrowse-find-class-declaration, ebrowse-view-class-declaration): + Rename parameter PREFIX-ARG to PREFIX. + (ebrowse-tags-read-name): Remove unused variables `start' and + `member-info'. + (ebrowse-display-member-buffer): Rename variable `tags-file-name' + to `tags-file'. + + * progmodes/etags.el (local-find-tag-hook): Declare. + (tag-partial-file-name-match-p, tag-any-match-p, list-tags): + Mark unused parameters. + + * progmodes/executable.el (compilation-error-regexp-alist): Declare. + (executable-interpret): Mark unused parameter. + + * progmodes/flymake.el (flymake-process-sentinel) + (flymake-after-change-function) + (flymake-create-temp-with-folder-structure) + (flymake-get-include-dirs-dot): Mark unused parameters. + (flymake-safe-delete-directory): Remove unused variable `err'. + + * progmodes/gdb-mi.el (speedbar-change-initial-expansion-list) + (speedbar-timer-fn, speedbar-line-text) + (speedbar-change-expand-button-char, speedbar-delete-subblock) + (speedbar-center-buffer-smartly): Declare functions. + (gdb-find-watch-expression): Remove unused variable `array'. + (gdb-edit-value, gdb-gdb, gdb-ignored-notification, gdb-thread-created) + (gdb-starting): Mark unused parameters. + (gud-gdbmi-marker-filter): Remove unused variable `output-record'. + (gdb-table-string): Remove unused variable `res'. + (gdb-place-breakpoints): Remove unused variables `flag' and `bptno'. + (gdb-disassembly-handler-custom): Remove unused variable `pos'. + (gdb-display-buffer): Remove unused variable `cur-size'. + + * progmodes/gud.el (gud-def): Use `defalias' instead of `defun' to + allow lexical-binding compilation. + (gud-expansion-speedbar-buttons, gud-gdb-goto-stackframe) + (gud-dbx-massage-args, gud-xdb-massage-args, gud-perldb-massage-args) + (gud-jdb-massage-args, gud-jdb-find-source, gud-find-class): + Mark unused parameters. + (gud-gdb-marker-filter): Remove unused variable `match'. + (gud-find-class): Bind `syntax-symbol' and `syntax-point' to suitable + lambda expressions and funcall them, instead of using `fset'. + + * progmodes/hideif.el (hif-parse-if-exp): Rename parameter + HIF-TOKEN-LIST to TOKEN-LIST and let-bind `hif-token-list'. + + * progmodes/hideshow.el (hs-hide-block-at-point): Remove unused + variable `header-beg'; use `let'. + + * progmodes/icon.el (indent-icon-exp): Remove unused variables + `restart', `last-sexp' and `at-do'. + + * progmodes/js.el (js--debug): Mark unused parameter. + (js--parse-state-at-point): Remove unused variable `bound'; use `let'. + (js--splice-into-items): Remove unused variable `item'. + (js--read-symbol, js--read-tab): Pass 1/-1 to `ido-mode', not t/nil. + + * progmodes/make-mode.el (makefile-make-font-lock-keywords): + Rename parameter FONT-LOCK-KEYWORDS to FL-KEYWORDS. + (makefile-complete): Remove unused variable `try'. + (makefile-fill-paragraph, makefile-match-function-end): + Mark unused parameters. + + * progmodes/octave-inf.el (inferior-octave-complete): + Remove unused variable `proc'. + (inferior-octave-output-digest): Mark unused parameter. + + * progmodes/perl-mode.el (perl-calculate-indent): + Remove unused variable `err'. + + * progmodes/prolog.el (prolog-mode-keybindings-inferior) + (prolog-indent-line): Mark unused parameters. + (prolog-indent-line): Remove unused variable `beg'. + + * progmodes/ps-mode.el (reporter-prompt-for-summary-p) + (reporter-dont-compact-list): Declare. + + * progmodes/sh-script.el (sh-font-lock-quoted-subshell): + Remove unused variable `char'. + (sh-debug): Mark unused parameter. + (sh-get-indent-info): Remove unused variable `start'. + (sh-calculate-indent): Remove unused variable `var'. + + * progmodes/simula.el (simula-popup-menu): Mark unused parameter. + (simula-electric-keyword): Remove unused variable `null'. + (simula-search-backward, simula-search-forward): Remove unused + variables `begin' and `end'. + + * progmodes/vera-mode.el (vera-guess-basic-syntax): + Remove unused variable `pos'. + (vera-electric-tab, vera-comment-uncomment-region): + Mark unused parameters. + (vera-electric-tab): Rename parameter PREFIX-ARG to PREFIX. + +2011-04-22 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package--builtins, package-alist) + (package-load-descriptor, package-built-in-p, package-activate) + (define-package, package-installed-p) + (package-compute-transaction, package-buffer-info) + (package--push): Doc fix. Distinguish more clearly between + version strings and version lists. + +2011-04-21 Juanma Barranquero <lekktu@gmail.com> + + Lexical-binding cleanup. + + * play/5x5.el (5x5-make-random-solution, 5x5-make-mutate-current) + (5x5-make-mutate-best): + * play/fortune.el (fortune-in-buffer): + * play/gomoku.el (gomoku-init-display): + * play/solitaire.el (solitaire, solitaire-do-check): + * play/tetris.el (tetris-default-update-speed-function): + Mark unused parameters. + + * play/bubbles.el (bubbles-mode): Set `show-trailing-whitespace'. + (bubbles--shift): Remove unused variable `char-org'. + (bubbles--set-faces): Remove unused variable `fg-col'. Simplify. + (bubbles--show-images): Remove unused variable `char'. + + * play/decipher.el (decipher-keypress, decipher-alphabet-keypress) + (decipher-get-undo, decipher-set-map, decipher-complete-alphabet) + (decipher-resync, decipher-loop-with-breaks, decipher--analyze) + (decipher-analyze-buffer): Use ?\s. + (decipher-make-checkpoint): Remove unused variable `mapping'. + + * play/doctor.el (doctor-doc): Rename parameter DOCTOR-SENT to SENT. + + * play/gamegrid.el (gamegrid-add-score-with-update-game-score): + Remove unused variable `result'; use `let'. + + * play/gametree.el (gametree-current-layout, gametree-apply-layout): + Rename parameter TOP-LEVEL to FROM-TOP-LEVEL; use `ignore-errors'. + (gametree-children-shown-p, gametree-compute-reduced-score): + Use `ignore-errors'. + + * play/handwrite.el (ps-lpr-switches): Declare. + (handwrite): Remove unused variables `pmin' and `lastp'. + + * play/hanoi.el (hanoi-move-ring): Remove unused variable `total-steps'. + + * play/landmark.el (landmark-init-display) + (landmark-update-naught-weights): Mark unused parameters. + (landmark-y): Remove unused variable `noise'. Simplify. + (landmark-human-plays): Remove unused variable `score'. + + * play/mpuz.el (mpuz-try-letter): Remove unused variable `message'. + (mpuz-try-proposal): Remove unused variable `game'. + + * play/zone.el (life-patterns): Declare. + +2011-04-20 Juanma Barranquero <lekktu@gmail.com> + + * vc/vc.el (ediff-vc-internal): Declare function. + +2011-04-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * shell.el: Use lexical-binding and std completion UI. + (shell-filter-ctrl-a-ctrl-b): Work as a preoutput filter. + (shell-mode): Put shell-filter-ctrl-a-ctrl-b on + comint-preoutput-filter-functions rather than on + comint-output-filter-functions. + (shell-command-completion, shell--command-completion-data) + (shell-filename-completion, shell-environment-variable-completion) + (shell-c-a-p-replace-by-expanded-directory): New functions. + (shell-dynamic-complete-functions, shell-dynamic-complete-command) + (shell-dynamic-complete-filename, shell-replace-by-expanded-directory) + (shell-dynamic-complete-environment-variable): Use them. + (shell-dynamic-complete-as-environment-variable) + (shell-dynamic-complete-as-command): Remove. + (shell-match-partial-variable): Match past point. + * comint.el: Clean up use of completion-at-point-functions. + (comint-completion-at-point): New function. + (comint-mode): Use it completion-at-point-functions. + (comint-dynamic-complete): Make it obsolete. + (comint-replace-by-expanded-history-before-point): Add dry-run arg. + (comint-c-a-p-replace-by-expanded-history): New function. + (comint-dynamic-complete-functions) + (comint-replace-by-expanded-history): Use it. + * minibuffer.el (completion-table-with-terminator): Allow dynamic + termination strings. Try harder to avoid second try-completion. + (completion-in-region-mode-map): Disable bindings that don't work yet. + + * comint.el: Use lexical-binding. Require CL. + (comint-dynamic-complete-functions): Use comint-filename-completion. + (comint-completion-addsuffix): Tweak custom type. + (comint-filename-completion, comint--common-suffix) + (comint--common-quoted-suffix, comint--table-subvert) + (comint--complete-file-name-data): New functions. + (comint-dynamic-complete-as-filename, comint-dynamic-complete-filename) + (comint-dynamic-list-filename-completions): Use them. + (comint-dynamic-simple-complete): Make obsolete. + + * minibuffer.el (completion-in-region-mode): + Keep completion-in-region-mode--predicate global. + (completion-in-region--postch): + Assume completion-in-region-mode--predicate is not null. + + * progmodes/flymake.el (flymake-start-syntax-check-process): + Obey `dir'. Simplify. + + * vc/vc.el (vc-version-ediff): Call ediff-vc-internal directly, since + we're in VC after all. + +2011-04-20 Christoph Scholtes <cschol2112@googlemail.com> + + * vc/vc.el (vc-diff-build-argument-list-internal) + (vc-version-ediff, vc-ediff): New commands. + (vc-version-diff): Use vc-diff-build-argument-list-internal. + +2011-04-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Remove dead code, + add sanity check. + + * obsolete/erc-hecomplete.el: Make obsolete. + * obsolete/: Standardize obsolescence info in the header. + 2011-04-20 Glenn Morris <rgm@gnu.org> * calendar/solar.el (solar-horizontal-coordinates): diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 7c32b11ec14..c1313cfd16f 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -4287,7 +4287,7 @@ (proced-descend): New variable. (proced-sort): New arg descend. (proced-sort-interactive): Repeated calls toggle sort order. - (proced-format): Accomodate changes of proced-format-alist. + (proced-format): Accommodate changes of proced-format-alist. Undefined attributes are displayed as "?". (proced-process-attributes): New optional arg pid-list. Ignore processes with empty attribute list. diff --git a/lisp/apropos.el b/lisp/apropos.el index 35a3ac3c09a..f1baee8dafe 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -83,7 +83,7 @@ Slows them down more or less. Set this non-nil if you have a fast machine." :group 'apropos :type 'face) -(defcustom apropos-label-face '(italic variable-pitch) +(defcustom apropos-label-face '(italic) "Face for label (`Command', `Variable' ...) in Apropos output. A value of nil means don't use any special font for them, and also turns off mouse highlighting." @@ -155,7 +155,17 @@ If value is `verbose', the computed score is shown for each match." "List of elc files already scanned in current run of `apropos-documentation'.") (defvar apropos-accumulator () - "Alist of symbols already found in current apropos run.") + "Alist of symbols already found in current apropos run. +Each element has the form + + (SYMBOL SCORE FUN-DOC VAR-DOC PLIST WIDGET-DOC FACE-DOC CUS-GROUP-DOC) + +where SYMBOL is the symbol name, SCORE is its relevance score (a +number), FUN-DOC is the function docstring, VAR-DOC is the +variable docstring, PLIST is the list of the symbols names in the +property list, WIDGET-DOC is the widget docstring, FACE-DOC is +the face docstring, and CUS-GROUP-DOC is the custom group +docstring. Each docstring is either nil or a string.") (defvar apropos-item () "Current item in or for `apropos-accumulator'.") @@ -187,6 +197,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-function 'apropos-label "Function" 'apropos-short-label "f" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this function" 'follow-link t 'action (lambda (button) @@ -195,6 +206,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-macro 'apropos-label "Macro" 'apropos-short-label "m" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this macro" 'follow-link t 'action (lambda (button) @@ -203,6 +215,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-command 'apropos-label "Command" 'apropos-short-label "c" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this command" 'follow-link t 'action (lambda (button) @@ -216,6 +229,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-variable 'apropos-label "Variable" 'apropos-short-label "v" + 'face '(font-lock-variable-name-face button) 'help-echo "mouse-2, RET: Display more help on this variable" 'follow-link t 'action (lambda (button) @@ -224,6 +238,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-face 'apropos-label "Face" 'apropos-short-label "F" + 'face '(font-lock-variable-name-face button) 'help-echo "mouse-2, RET: Display more help on this face" 'follow-link t 'action (lambda (button) @@ -232,6 +247,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-group 'apropos-label "Group" 'apropos-short-label "g" + 'face '(font-lock-builtin-face button) 'help-echo "mouse-2, RET: Display more help on this group" 'follow-link t 'action (lambda (button) @@ -241,14 +257,16 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-widget 'apropos-label "Widget" 'apropos-short-label "w" + 'face '(font-lock-builtin-face button) 'help-echo "mouse-2, RET: Display more help on this widget" 'follow-link t 'action (lambda (button) (widget-browse-other-window (button-get button 'apropos-symbol)))) (define-button-type 'apropos-plist - 'apropos-label "Plist" + 'apropos-label "Properties" 'apropos-short-label "p" + 'face '(font-lock-keyword-face button) 'help-echo "mouse-2, RET: Display more help on this plist" 'follow-link t 'action (lambda (button) @@ -636,15 +654,15 @@ thus be found in `load-history'." "(not documented)")) (when (boundp symbol) (apropos-documentation-property - symbol 'variable-documentation t)) - (when (setq properties (symbol-plist symbol)) - (setq doc (list (car properties))) - (while (setq properties (cdr (cdr properties))) - (setq doc (cons (car properties) doc))) - (mapconcat #'symbol-name (nreverse doc) " ")) - (when (get symbol 'widget-type) - (apropos-documentation-property - symbol 'widget-documentation t)) + symbol 'variable-documentation t)) + (when (setq properties (symbol-plist symbol)) + (setq doc (list (car properties))) + (while (setq properties (cdr (cdr properties))) + (setq doc (cons (car properties) doc))) + (mapconcat #'symbol-name (nreverse doc) " ")) + (when (get symbol 'widget-type) + (apropos-documentation-property + symbol 'widget-documentation t)) (when (facep symbol) (let ((alias (get symbol 'face-alias))) (if alias @@ -660,8 +678,8 @@ thus be found in `load-history'." (apropos-documentation-property symbol 'face-documentation t)))) (when (get symbol 'custom-group) - (apropos-documentation-property - symbol 'group-documentation t))))) + (apropos-documentation-property + symbol 'group-documentation t))))) symbols))) (apropos-print keys nil text))) @@ -976,15 +994,9 @@ If non-nil TEXT is a string that will be printed as a heading." symbol item) (set-buffer standard-output) (apropos-mode) - (if (display-mouse-p) - (insert - "If moving the mouse over text changes the text's color, " - "you can click\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 - "and type \\[apropos-follow] to get full documentation.\n\n")) + (insert (substitute-command-keys "Type \\[apropos-follow] on ") + (if apropos-multi-type "a type label" "an entry") + " to view its full documentation.\n\n") (if text (insert text "\n\n")) (dolist (apropos-item p) (when (and spacing (not (bobp))) @@ -1082,30 +1094,49 @@ If non-nil TEXT is a string that will be printed as a heading." (defun apropos-print-doc (i type do-keys) - (when (stringp (setq i (nth i apropos-item))) - (if apropos-compact-layout - (insert (propertize "\t" 'display '(space :align-to 32)) " ") - (insert " ")) - (if (null apropos-multi-type) - ;; If the query is only for a single type, there's no point - ;; writing it over and over again. Insert a blank button, and - ;; put the 'apropos-label property there (needed by - ;; apropos-symbol-button-display-help). - (insert-text-button + (let ((doc (nth i apropos-item))) + (when (stringp doc) + (if apropos-compact-layout + (insert (propertize "\t" 'display '(space :align-to 32)) " ") + (insert " ")) + (if apropos-multi-type + (let ((button-face (button-type-get type 'face))) + (unless (consp button-face) + (setq button-face (list button-face))) + (insert-text-button + (if apropos-compact-layout + (format "<%s>" (button-type-get type 'apropos-short-label)) + (button-type-get type 'apropos-label)) + 'type type + ;; Can't use the default button face, since user may have changed the + ;; variable! Just say `no' to variables containing faces! + 'face (append button-face apropos-label-face) + 'apropos-symbol (car apropos-item)) + (insert (if apropos-compact-layout " " ": "))) + + ;; If the query is only for a single type, there's no point + ;; writing it over and over again. Insert a blank button, and + ;; put the 'apropos-label property there (needed by + ;; apropos-symbol-button-display-help). + (insert-text-button " " 'type type 'skip t - 'face 'default 'apropos-symbol (car apropos-item)) - (insert-text-button - (if apropos-compact-layout - (format "<%s>" (button-type-get type 'apropos-short-label)) - (button-type-get type 'apropos-label)) - 'type type - ;; Can't use the default button face, since user may have changed the - ;; variable! Just say `no' to variables containing faces! - 'face apropos-label-face - 'apropos-symbol (car apropos-item)) - (insert (if apropos-compact-layout " " ": "))) - (insert (if do-keys (substitute-command-keys i) i)) - (or (bolp) (terpri)))) + 'face 'default 'apropos-symbol (car apropos-item))) + + (let ((opoint (point)) + (ocol (current-column))) + (cond ((equal doc "") + (setq doc "(not documented)")) + (do-keys + (setq doc (substitute-command-keys doc)))) + (insert doc) + (if (equal doc "(not documented)") + (put-text-property opoint (point) 'font-lock-face 'shadow)) + ;; The labeling buttons might make the line too long, so fill it if + ;; necessary. + (let ((fill-column (+ 5 emacs-lisp-docstring-fill-column)) + (fill-prefix (make-string ocol ?\s))) + (fill-region opoint (point) nil t))) + (or (bolp) (terpri))))) (defun apropos-follow () "Invokes any button at point, otherwise invokes the nearest label button." diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 70befa11d8b..9886b30d122 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -117,7 +117,7 @@ Auto Revert Mode.") (defvar Buffer-menu--buffers nil "If non-nil, list of buffers shown in the current buffer-menu. This variable determines whether reverting the buffer lists only -this buffers. It affects both manual reverting and reverting by +these buffers. It affects both manual reverting and reverting by Auto Revert Mode.") (make-variable-buffer-local 'Buffer-menu--buffers) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index a93806b8876..b5ecfdd242f 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,11 @@ +2011-04-23 Juanma Barranquero <lekktu@gmail.com> + + * ede/pconf.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf): + * ede/proj-comp.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf): + * ede/proj-elisp.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf) + (ede-proj-tweak-autoconf, ede-proj-flush-autoconf): + * ede/proj-scheme.el (ede-proj-tweak-autoconf): Fix typos in docstrings. + 2011-03-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.3 released. diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 497806c71a3..08fc98728e1 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -159,7 +159,7 @@ don't do it. A value of nil means to just do it.") (ede-proj-configure-synchronize this)) (defmethod ede-proj-tweak-autoconf ((this ede-proj-target)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." ;; Check the compilers belonging to THIS, and call the autoconf ;; setup for those compilers. (mapc 'ede-proj-tweak-autoconf (ede-proj-compilers this)) @@ -167,7 +167,7 @@ don't do it. A value of nil means to just do it.") ) (defmethod ede-proj-flush-autoconf ((this ede-proj-target)) - "Flush the configure file (current buffer) to accomodate THIS. + "Flush the configure file (current buffer) to accommodate THIS. By flushing, remove any cruft that may be in the file. Subsequent calls to `ede-proj-tweak-autoconf' can restore items removed by flush." nil) diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 418e70fd5e9..401ea15d0d6 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -236,7 +236,7 @@ This will prevent rules from creating duplicate variables or rules." ;;; Methods: (defmethod ede-proj-tweak-autoconf ((this ede-compilation-program)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (mapcar (lambda (obj) (cond ((stringp obj) @@ -248,7 +248,7 @@ This will prevent rules from creating duplicate variables or rules." (oref this autoconf))) (defmethod ede-proj-flush-autoconf ((this ede-compilation-program)) - "Flush the configure file (current buffer) to accomodate THIS." + "Flush the configure file (current buffer) to accommodate THIS." nil) (defmacro proj-comp-insert-variable-once (varname &rest body) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 17185b19492..42a20cc4a1a 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -208,7 +208,7 @@ is found, such as a `-version' variable, or the standard header." (error "Don't know how to update load path")))) (defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (call-next-method) ;; Ok, now we have to tweak the autoconf provided `elisp-comp' program. (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))) @@ -232,7 +232,7 @@ is found, such as a `-version' variable, or the standard header." (save-buffer)) ))) (defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp)) - "Flush the configure file (current buffer) to accomodate THIS." + "Flush the configure file (current buffer) to accommodate THIS." ;; Remove crufty old paths from elisp-compile (let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) ) @@ -372,11 +372,11 @@ Argument THIS is the target which needs to insert an info file." ) (defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (error "Autoloads not supported in autoconf yet")) (defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads)) - "Flush the configure file (current buffer) to accomodate THIS." + "Flush the configure file (current buffer) to accommodate THIS." nil) (provide 'ede/proj-elisp) diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el index 2a3ea039a7a..6a08d4fadd1 100644 --- a/lisp/cedet/ede/proj-scheme.el +++ b/lisp/cedet/ede/proj-scheme.el @@ -41,7 +41,7 @@ "This target consists of scheme files.") (defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (autoconf-insert-new-macro "AM_INIT_GUILE_MODULE")) (provide 'ede/proj-scheme) diff --git a/lisp/comint.el b/lisp/comint.el index 64ed32dd2b3..8608c0d31e9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1,4 +1,4 @@ -;;; comint.el --- general command interpreter in a window stuff +;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1990, 1992-2011 Free Software Foundation, Inc. @@ -101,6 +101,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'ring) ;; Buffer Local Variables: @@ -366,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of `comint-use-prompt-regexp'.") (defvar comint-dynamic-complete-functions - '(comint-replace-by-expanded-history comint-dynamic-complete-filename) + '(comint-c-a-p-replace-by-expanded-history comint-filename-completion) "List of functions called to perform completion. Works like `completion-at-point-functions'. See also `comint-dynamic-complete'. @@ -492,7 +493,7 @@ executed once when the buffer is created." (define-key map [menu-bar completion complete-file] '("Complete File Name" . comint-dynamic-complete-filename)) (define-key map [menu-bar completion complete] - '("Complete Before Point" . comint-dynamic-complete)) + '("Complete at Point" . completion-at-point)) ;; Input history: (define-key map [menu-bar inout] (cons "In/Out" (make-sparse-keymap "In/Out"))) @@ -682,6 +683,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (setq font-lock-defaults '(nil t)) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t) + (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) ;; This behavior is not useful in comint buffers, and is annoying (set (make-local-variable 'next-line-add-newlines) nil)) @@ -1230,6 +1232,12 @@ See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'. Returns t if successful." (interactive) + (let ((f (comint-c-a-p-replace-by-expanded-history silent start))) + (if f (funcall f)))) + +(defun comint-c-a-p-replace-by-expanded-history (&optional silent start) + "Expand input command history at point. +For use on `completion-at-point-functions'." (if (and comint-input-autoexpand (if comint-use-prompt-regexp ;; Use comint-prompt-regexp @@ -1239,20 +1247,28 @@ Returns t if successful." ;; Use input fields. User input that hasn't been entered ;; yet, at the end of the buffer, has a nil `field' property. (and (null (get-char-property (point) 'field)) - (string-match "!\\|^\\^" (field-string))))) - ;; Looks like there might be history references in the command. - (let ((previous-modified-tick (buffer-modified-tick))) - (comint-replace-by-expanded-history-before-point silent start) - (/= previous-modified-tick (buffer-modified-tick))))) - - -(defun comint-replace-by-expanded-history-before-point (silent &optional start) + (string-match "!\\|^\\^" (field-string)))) + (catch 'dry-run + (comint-replace-by-expanded-history-before-point + silent start 'dry-run))) + (lambda () + ;; Looks like there might be history references in the command. + (let ((previous-modified-tick (buffer-modified-tick))) + (comint-replace-by-expanded-history-before-point silent start) + (/= previous-modified-tick (buffer-modified-tick)))))) + + +(defun comint-replace-by-expanded-history-before-point + (silent &optional start dry-run) "Expand directory stack reference before point. See `comint-replace-by-expanded-history'. Returns t if successful. If the optional argument START is non-nil, that specifies the start of the text to scan for history references, rather -than the logical beginning of line." +than the logical beginning of line. + +If DRY-RUN is non-nil, throw to DRY-RUN before performing any +actual side-effect." (save-excursion (let ((toend (- (line-end-position) (point))) (start (or start (comint-line-beginning-position)))) @@ -1273,10 +1289,12 @@ than the logical beginning of line." (goto-char (1+ (point)))) ((looking-at "![0-9]+\\($\\|[^-]\\)") ;; We cannot know the interpreter's idea of input line numbers. + (if dry-run (throw dry-run 'message)) (goto-char (match-end 0)) (message "Absolute reference cannot be expanded")) ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?") ;; Just a number of args from `number' lines backward. + (if dry-run (throw dry-run 'history)) (let ((number (1- (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))) @@ -1292,6 +1310,7 @@ than the logical beginning of line." (message "Relative reference exceeds input history size")))) ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!")) ;; Just a number of args from the previous input line. + (if dry-run (throw dry-run 'expand)) (replace-match (comint-args (comint-previous-input-string 0) (match-beginning 1) (match-end 1)) t t) @@ -1300,6 +1319,7 @@ than the logical beginning of line." "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?") ;; Most recent input starting with or containing (possibly ;; protected) string, maybe just a number of args. Phew. + (if dry-run (throw dry-run 'expand)) (let* ((mb1 (match-beginning 1)) (me1 (match-end 1)) (mb2 (match-beginning 2)) (me2 (match-end 2)) (exp (buffer-substring (or mb2 mb1) (or me2 me1))) @@ -1321,6 +1341,7 @@ than the logical beginning of line." (message "History item: %d" (1+ pos))))) ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?") ;; Quick substitution on the previous input line. + (if dry-run (throw dry-run 'expand)) (let ((old (buffer-substring (match-beginning 1) (match-end 1))) (new (buffer-substring (match-beginning 2) (match-end 2))) (pos nil)) @@ -1333,7 +1354,8 @@ than the logical beginning of line." (replace-match new t t) (message "History item: substituted")))) (t - (forward-char 1))))))) + (forward-char 1))))) + nil)) (defun comint-magic-space (arg) @@ -1739,9 +1761,9 @@ Similarly for Soar, Scheme, etc." (insert copy) copy))) (input (if (not (eq comint-input-autoexpand 'input)) - ;; Just whatever's already there + ;; Just whatever's already there. intxt - ;; Expand and leave it visible in buffer + ;; Expand and leave it visible in buffer. (comint-replace-by-expanded-history t pmark) (buffer-substring pmark (point)))) (history (if (not (eq comint-input-autoexpand 'history)) @@ -2831,10 +2853,9 @@ its response can be seen." ;; comint-dynamic-list-filename-completions List completions in help buffer. ;; comint-replace-by-expanded-filename Expand and complete filename at point; ;; replace with expanded/completed name. -;; comint-dynamic-simple-complete Complete stub given candidates. -;; These are not installed in the comint-mode keymap. But they are -;; available for people who want them. Shell-mode installs them: +;; These are not installed in the comint-mode keymap. But they are +;; available for people who want them. Shell-mode installs them: ;; (define-key shell-mode-map "\t" 'comint-dynamic-complete) ;; (define-key shell-mode-map "\M-?" ;; 'comint-dynamic-list-filename-completions))) @@ -2849,14 +2870,16 @@ This mirrors the optional behavior of tcsh." :group 'comint-completion) (defcustom comint-completion-addsuffix t - "If non-nil, add a `/' to completed directories, ` ' to file names. -If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where -DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion. + "If non-nil, add ` ' to file names. +It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX) +where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous +or exact completion. This mirrors the optional behavior of tcsh." :type '(choice (const :tag "None" nil) - (const :tag "Add /" t) - (cons :tag "Suffix pair" - (string :tag "Directory suffix") + (const :tag "Add SPC" t) + (string :tag "File suffix") + (cons :tag "Obsolete suffix pair" + (string :tag "Ignored") (string :tag "File suffix"))) :group 'comint-completion) @@ -2988,16 +3011,12 @@ Magic characters are those in `comint-file-name-quote-list'." (setq i (+ 1 (match-beginning 0))))) filename))) +(defun comint-completion-at-point () + (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) -(defun comint-dynamic-complete () - "Dynamically perform completion at point. -Calls the functions in `comint-dynamic-complete-functions' to perform -completion until a function returns non-nil, at which point completion is -assumed to have occurred." - (interactive) - (let ((completion-at-point-functions comint-dynamic-complete-functions)) - (completion-at-point))) - +(define-obsolete-function-alias + 'comint-dynamic-complete + 'completion-at-point "24.1") (defun comint-dynamic-complete-filename () "Dynamically complete the filename at point. @@ -3016,73 +3035,125 @@ Returns t if successful." (when (comint--match-partial-filename) (unless (window-minibuffer-p (selected-window)) (message "Completing file name...")) - (comint-dynamic-complete-as-filename))) + (apply #'completion-in-region (comint--complete-file-name-data)))) -(defun comint-dynamic-complete-as-filename () - "Dynamically complete at point as a filename. -See `comint-dynamic-complete-filename'. Returns t if successful." - (let* ((completion-ignore-case read-file-name-completion-ignore-case) - (completion-ignored-extensions comint-completion-fignore) - ;; If we bind this, it breaks remote directory tracking in rlogin.el. - ;; I think it was originally bound to solve file completion problems, - ;; but subsequent changes may have made this unnecessary. sm. - ;;(file-name-handler-alist nil) - (minibuffer-p (window-minibuffer-p (selected-window))) - (success t) - (dirsuffix (cond ((not comint-completion-addsuffix) "") - ((not (consp comint-completion-addsuffix)) "/") - (t (car comint-completion-addsuffix)))) - (filesuffix (cond ((not comint-completion-addsuffix) "") +(defun comint-filename-completion () + "Return completion data for filename at point, if any." + (when (comint--match-partial-filename) + (comint--complete-file-name-data))) + +;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and +;; comint--table-subvert copied from pcomplete. And they don't fully solve +;; the problem, since selecting a file from *Completions* won't quote it. + +(defun comint--common-suffix (s1 s2) + (assert (not (or (string-match "\n" s1) (string-match "\n" s2)))) + ;; Since S2 is expected to be the "unquoted/expanded" version of S1, + ;; there shouldn't be any case difference, even if the completion is + ;; case-insensitive. + (let ((case-fold-search nil)) + (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2)) + (- (match-end 1) (match-beginning 1)))) + +(defun comint--common-quoted-suffix (s1 s2) + "Find the common suffix between S1 and S2 where S1 is the expanded S2. +S1 is expected to be the unquoted and expanded version of S1. +Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that +S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and +SS1 = (unquote SS2)." + (let* ((cs (comint--common-suffix s1 s2)) + (ss1 (substring s1 (- (length s1) cs))) + (qss1 (comint-quote-filename ss1)) + qc) + (if (and (not (equal ss1 qss1)) + (setq qc (comint-quote-filename (substring ss1 0 1))) + (eq t (compare-strings s2 (- (length s2) cs (length qc) -1) + (- (length s2) cs -1) + qc nil nil))) + ;; The difference found is just that one char is quoted in S2 + ;; but not in S1, keep looking before this difference. + (comint--common-quoted-suffix + (substring s1 0 (- (length s1) cs)) + (substring s2 0 (- (length s2) cs (length qc) -1))) + (cons (substring s1 0 (- (length s1) cs)) + (substring s2 0 (- (length s2) cs)))))) + +(defun comint--table-subvert (table s1 s2 string pred action) + "Completion table that replaces the prefix S1 with S2 in STRING. +When TABLE, S1 and S2 are provided by `apply-partially', the result +is a completion table which completes strings of the form (concat S1 S) +in the same way as TABLE completes strings of the form (concat S2 S)." + (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil + completion-ignore-case)) + (concat s2 (comint-unquote-filename + (substring string (length s1)))))) + (res (if str (complete-with-action action table str pred)))) + (when res + (cond + ((and (eq (car-safe action) 'boundaries)) + (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) + (list* 'boundaries + (max (length s1) + ;; FIXME: Adjust because of quoting/unquoting. + (+ beg (- (length s1) (length s2)))) + (and (eq (car-safe res) 'boundaries) (cddr res))))) + ((stringp res) + (if (eq t (compare-strings res 0 (length s2) s2 nil nil + completion-ignore-case)) + (concat s1 (comint-quote-filename + (substring res (length s2)))))) + ((eq action t) + (let ((bounds (completion-boundaries str table pred ""))) + (if (>= (car bounds) (length s2)) + res + (let ((re (concat "\\`" + (regexp-quote (substring s2 (car bounds)))))) + (delq nil + (mapcar (lambda (c) + (if (string-match re c) + (substring c (match-end 0)))) + res)))))) + ;; E.g. action=nil and it's the only completion. + (res))))) + +(defun comint--complete-file-name-data () + "Return the completion data for file name at point." + (let* ((filesuffix (cond ((not comint-completion-addsuffix) "") + ((stringp comint-completion-addsuffix) + comint-completion-addsuffix) ((not (consp comint-completion-addsuffix)) " ") (t (cdr comint-completion-addsuffix)))) - (filename (comint-match-partial-filename)) + (filename (comint--match-partial-filename)) (filename-beg (if filename (match-beginning 0) (point))) (filename-end (if filename (match-end 0) (point))) - (filename (or filename "")) - (filedir (file-name-directory filename)) - (filenondir (file-name-nondirectory filename)) - (directory (if filedir (comint-directory filedir) default-directory)) - (completion (file-name-completion filenondir directory))) - (cond ((null completion) - (if minibuffer-p - (minibuffer-message "No completions of %s" filename) - (message "No completions of %s" filename)) - (setq success nil)) - ((eq completion t) ; Means already completed "file". - (insert filesuffix) - (unless minibuffer-p - (message "Sole completion"))) - ((string-equal completion "") ; Means completion on "directory/". - (comint-dynamic-list-filename-completions)) - (t ; Completion string returned. - (let ((file (concat (file-name-as-directory directory) completion))) - ;; Insert completion. Note that the completion string - ;; may have a different case than what's in the prompt, - ;; if read-file-name-completion-ignore-case is non-nil, - (delete-region filename-beg filename-end) - (if filedir (insert (comint-quote-filename filedir))) - (insert (comint-quote-filename (directory-file-name completion))) - (cond ((symbolp (file-name-completion completion directory)) - ;; We inserted a unique completion. - (insert (if (file-directory-p file) dirsuffix filesuffix)) - (unless minibuffer-p - (message "Completed"))) - ((and comint-completion-recexact comint-completion-addsuffix - (string-equal filenondir completion) - (file-exists-p file)) - ;; It's not unique, but user wants shortest match. - (insert (if (file-directory-p file) dirsuffix filesuffix)) - (unless minibuffer-p - (message "Completed shortest"))) - ((or comint-completion-autolist - (string-equal filenondir completion)) - ;; It's not unique, list possible completions. - (comint-dynamic-list-filename-completions)) - (t - (unless minibuffer-p - (message "Partially completed"))))))) - success)) + (unquoted (if filename (comint--unquote&expand-filename filename) "")) + (table + (let ((prefixes (comint--common-quoted-suffix + unquoted filename))) + (apply-partially + #'comint--table-subvert + #'completion-file-name-table + (cdr prefixes) (car prefixes))))) + (list + filename-beg filename-end + (lambda (string pred action) + (let ((completion-ignore-case read-file-name-completion-ignore-case) + (completion-ignored-extensions comint-completion-fignore)) + (if (zerop (length filesuffix)) + (complete-with-action action table string pred) + ;; Add a space at the end of completion. Use a terminator-regexp + ;; that never matches since the terminator cannot appear + ;; within the completion field anyway. + (completion-table-with-terminator + (cons filesuffix "\\`a\\`") + table string pred action))))))) +(defun comint-dynamic-complete-as-filename () + "Dynamically complete at point as a filename. +See `comint-dynamic-complete-filename'. Returns t if successful." + (apply #'completion-in-region (comint--complete-file-name-data))) +(make-obsolete 'comint-dynamic-complete-as-filename + 'comint-filename-completion "24.1") (defun comint-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. @@ -3155,28 +3226,20 @@ See also `comint-dynamic-complete-filename'." (unless minibuffer-p (message "Partially completed")) 'partial))))))) +(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1") (defun comint-dynamic-list-filename-completions () "Display a list of possible completions for the filename at point." (interactive) - (let* ((completion-ignore-case read-file-name-completion-ignore-case) - ;; If we bind this, it breaks remote directory tracking in rlogin.el. - ;; I think it was originally bound to solve file completion problems, - ;; but subsequent changes may have made this unnecessary. sm. - ;;(file-name-handler-alist nil) - (filename (or (comint-match-partial-filename) "")) - (filedir (file-name-directory filename)) - (filenondir (file-name-nondirectory filename)) - (directory (if filedir (comint-directory filedir) default-directory)) - (completions (file-name-all-completions filenondir directory))) - (if (not completions) - (if (window-minibuffer-p (selected-window)) - (minibuffer-message "No completions of %s" filename) - (message "No completions of %s" filename)) - (comint-dynamic-list-completions - (mapcar 'comint-quote-filename completions) - (comint-quote-filename filenondir))))) + (let* ((data (comint--complete-file-name-data)) + (minibuffer-completion-table (nth 2 data)) + (minibuffer-completion-predicate nil) + (ol (make-overlay (nth 0 data) (nth 1 data) nil nil t))) + (overlay-put ol 'field 'completion) + (unwind-protect + (call-interactively 'minibuffer-completion-help) + (delete-overlay ol)))) ;; This is bound locally in a *Completions* buffer to the list of @@ -3244,7 +3307,6 @@ Typing SPC flushes the completions buffer." (if (eq first ?\s) (set-window-configuration comint-dynamic-list-completions-config) (setq unread-command-events (listify-key-sequence key))))))) - (defun comint-get-next-from-history () "After fetching a line from input history, this fetches the following line. @@ -3742,9 +3804,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; ;; For modes that use comint-mode, comint-dynamic-complete-functions is the ;; hook to add completion functions to. Functions on this list should return -;; non-nil if completion occurs (i.e., further completion should not occur). -;; You could use comint-dynamic-simple-complete to do the bulk of the -;; completion job. +;; the completion data according to the documentation of +;; `completion-at-point-functions' (provide 'comint) diff --git a/lisp/custom.el b/lisp/custom.el index 9673db47ea8..8295777f1f1 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -313,11 +313,19 @@ for more information." ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. - (nconc (list 'custom-declare-variable - (list 'quote symbol) - (list 'quote value) - doc) - args)) + `(custom-declare-variable + ',symbol + ,(if lexical-binding ;FIXME: This is not reliable, but is all we have. + ;; The `default' arg should be an expression that evaluates to + ;; the value to use. The use of `eval' for it is spread over + ;; many different places and hence difficult to eliminate, yet + ;; we want to make sure that the `value' expression is checked by the + ;; byte-compiler, and that lexical-binding is obeyed, so quote the + ;; expression with `lambda' rather than with `quote'. + `(list (lambda () ,value)) + `',value) + ,doc + ,@args)) ;;; The `defface' Macro. diff --git a/lisp/dired.el b/lisp/dired.el index 73a716d0bff..c581597494c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3629,7 +3629,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; 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" "0488aa71a7abdb8dcc9ce90201114ebc") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "e34e1bbdb701078d52466c319d8e0cda") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4089,7 +4089,7 @@ true then the type of the file linked to by FILE is printed instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "87fd4ae2fdade7e0f11c4a0b1cfdeda2") +;;;;;; "dired-x" "dired-x.el" "94bd5ca0bd260e43402e3cd9f114970c") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 548fcd133df..7b98ade2422 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1364,8 +1364,7 @@ (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) (let ((length (length bytes)) (bytedecomp-ptr 0) optr tags bytedecomp-op offset - lap tmp - endtag) + lap tmp) (while (not (= bytedecomp-ptr length)) (or make-spliceable (push bytedecomp-ptr lap)) @@ -1373,7 +1372,9 @@ optr bytedecomp-ptr ;; This uses dynamic-scope magic. offset (disassemble-offset bytes)) - (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) + (let ((opcode (aref byte-code-vector bytedecomp-op))) + (assert opcode) + (setq bytedecomp-op opcode)) (cond ((memq bytedecomp-op byte-goto-ops) ;; It's a pc. (setq offset @@ -1417,8 +1418,6 @@ (setq rest (cdr rest)))) (setq rest (cdr rest)))) (if tags (error "optimizer error: missed tags %s" tags)) - (if endtag - (setq lap (cons (cons nil endtag) lap))) ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) (mapcar (function (lambda (elt) (if (numberp elt) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4ce71b29d70..e42103a7a01 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -84,10 +84,6 @@ ;; can see what packages are available. This will automatically ;; fetch the latest list of packages from ELPA. ;; -;; M-x package-list-packages-no-fetch -;; Like package-list-packages, but does not automatically fetch the -;; new list of packages. -;; ;; M-x package-install-from-buffer ;; Install a package consisting of a single .el file that appears ;; in the current buffer. This only works for packages which @@ -290,9 +286,11 @@ function `package-built-in-p'. Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION REQS DOCSTRING]. - VERSION is a version list. - REQS is a list of packages (symbols) required by the package. +The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. + VERSION-LIST is a version list. + REQS is a list of packages required by the package, each + requirement having the form (NAME VL), where NAME is a string + and VL is a version list. DOCSTRING is a brief description of the package.") (put 'package--builtins 'risky-local-variable t) @@ -301,9 +299,11 @@ The vector DESC has the form [VERSION REQS DOCSTRING]. Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION REQS DOCSTRING]. - VERSION is a version list. - REQS is a list of packages (symbols) required by the package. +The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. + VERSION-LIST is a version list. + REQS is a list of packages required by the package, each + requirement having the form (NAME VL) where NAME is a string + and VL is a version list. DOCSTRING is a brief description of the package. This variable is set automatically by `package-load-descriptor', @@ -358,8 +358,8 @@ E.g., if given \"quux-23.0\", will return \"quux\"" (defun package-load-descriptor (dir package) "Load the description file in directory DIR for package PACKAGE. -Here, PACKAGE is a string of the form NAME-VER, where NAME is the -package name and VER is its version." +Here, PACKAGE is a string of the form NAME-VERSION, where NAME is +the package name and VERSION is its version." (let* ((pkg-dir (expand-file-name package dir)) (pkg-file (expand-file-name (concat (package-strip-version package) "-pkg") @@ -452,18 +452,21 @@ NAME and VERSION are both strings." ;; Don't return nil. t)) -(defun package-built-in-p (package &optional version) - "Return true if PACKAGE, of VERSION or newer, is built-in to Emacs." +(defun package-built-in-p (package &optional min-version) + "Return true if PACKAGE is built-in to Emacs. +Optional arg MIN-VERSION, if non-nil, should be a version list +specifying the minimum acceptable version." (require 'finder-inf nil t) ; For `package--builtins'. (let ((elt (assq package package--builtins))) - (and elt (version-list-<= version (package-desc-vers (cdr elt)))))) + (and elt (version-list-<= min-version (package-desc-vers (cdr elt)))))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at ;; least need to check to see if the package has actually been loaded, ;; and not merely activated. -(defun package-activate (package version) - "Activate package PACKAGE, of version VERSION or newer. +(defun package-activate (package min-version) + "Activate package PACKAGE, of version MIN-VERSION or newer. +MIN-VERSION should be a version list. If PACKAGE has any dependencies, recursively activate them. Return nil if the package could not be activated." (let ((pkg-vec (cdr (assq package package-alist))) @@ -471,11 +474,11 @@ Return nil if the package could not be activated." ;; Check if PACKAGE is available in `package-alist'. (when pkg-vec (setq available-version (package-desc-vers pkg-vec) - found (version-list-<= version available-version))) + found (version-list-<= min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. ((null found) - (package-built-in-p package version)) + (package-built-in-p package min-version)) ;; If the package is already activated, just return t. ((memq package package-activated-list) t) @@ -512,11 +515,11 @@ Required package `%s-%s' is unavailable" &rest extra-properties) "Define a new package. NAME-STRING is the name of the package, as a string. -VERSION-STRING is the version of the package, as a list of -integers of the form produced by `version-to-list'. +VERSION-STRING is the version of the package, as a string. DOCSTRING is a short description of the package, a string. REQUIREMENTS is a list of dependencies on other packages. -Each requirement is of the form (OTHER-PACKAGE \"VERSION\"). + Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION), + where OTHER-VERSION is a string. EXTRA-PROPERTIES is currently unused." (let* ((name (intern name-string)) @@ -703,8 +706,8 @@ It will move point to somewhere in the headers." (package-unpack name version)))) (defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of VERSION or newer, is installed. -Built-in packages also qualify." + "Return true if PACKAGE, of MIN-VERSION or newer, is installed. +MIN-VERSION should be a version list." (let ((pkg-desc (assq package package-alist))) (if pkg-desc (version-list-<= min-version @@ -717,9 +720,9 @@ Built-in packages also qualify." PACKAGE-LIST should be a list of package names (symbols). REQUIREMENTS should be a list of additional requirements; each -element in this list should have the form (PACKAGE VERSION), -where PACKAGE is a package name and VERSION is the required -version of that package (as a list). +element in this list should have the form (PACKAGE VERSION-LIST), +where PACKAGE is a package name and VERSION-LIST is the required +version of that package. This function recursively computes the requirements of the packages in REQUIREMENTS, and returns a list of all the packages @@ -890,7 +893,8 @@ The vector has the form [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a requires list, or nil. +REQUIRES is a list of requirements, each requirement having the + form (NAME VER); NAME is a string and VER is a version list. DESCRIPTION is the package description, a string. VERSION is the version, a string. COMMENTARY is the commentary section, a string, or nil if none. @@ -1329,45 +1333,52 @@ Letters do not insert themselves; instead, they are commands. "Convenience macro for `package-menu--generate'. If the alist stored in the symbol LISTNAME lacks an entry for a package PACKAGE with descriptor DESC, add one. The alist is -keyed with cons cells (PACKAGE . VERSION), where PACKAGE is a -symbol and VERSION is a version list." +keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is +a symbol and VERSION-LIST is a version list." `(let* ((version (package-desc-vers ,desc)) (key (cons ,package version))) (unless (assoc key ,listname) (push (list key ,status (package-desc-doc ,desc)) ,listname)))) -(defun package-menu--generate (&optional remember-pos) +(defun package-menu--generate (remember-pos packages) "Populate the Package Menu. -Optional argument REMEMBER-POS, if non-nil, means to move point -to the entry as before." +If REMEMBER-POS is non-nil, keep point on the same entry. +PACKAGES should be t, which means to display all known packages, +or a list of package names (symbols) to display." ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION). (let (info-list name builtin) ;; Installed packages: (dolist (elt package-alist) (setq name (car elt)) - (package--push name (cdr elt) - (if (stringp (cadr (assq name package-load-list))) - "held" "installed") - info-list)) + (when (or (eq packages t) (memq name packages)) + (package--push name (cdr elt) + (if (stringp (cadr (assq name package-load-list))) + "held" "installed") + info-list))) ;; Built-in packages: (dolist (elt package--builtins) (setq name (car elt)) - (unless (eq name 'emacs) ; Hide the `emacs' package. + (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or (eq packages t) (memq name packages))) (package--push name (cdr elt) "built-in" info-list))) ;; Available and disabled packages: (dolist (elt package-archive-contents) (setq name (car elt)) - (let ((hold (assq name package-load-list))) - (package--push name (cdr elt) - (if (and hold (null (cadr hold))) "disabled" "available") - info-list))) + (when (or (eq packages t) (memq name packages)) + (let ((hold (assq name package-load-list))) + (package--push name (cdr elt) + (if (and hold (null (cadr hold))) + "disabled" + "available") + info-list)))) ;; Obsolete packages: (dolist (elt package-obsolete-alist) (dolist (inner-elt (cdr elt)) - (package--push (car elt) (cdr inner-elt) "obsolete" info-list))) + (when (or (eq packages t) (memq (car elt) packages)) + (package--push (car elt) (cdr inner-elt) "obsolete" info-list)))) ;; Print the result. (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list)) @@ -1408,7 +1419,7 @@ This fetches the contents of each archive specified in (unless (eq major-mode 'package-menu-mode) (error "The current buffer is not a Package Menu")) (package-refresh-contents) - (package-menu--generate t)) + (package-menu--generate t t)) (defun package-menu-describe-package (&optional button) "Describe the current package. @@ -1523,7 +1534,7 @@ packages marked for deletion are removed." (and delete-list (null install-list) (package-initialize)) (if (or delete-list install-list) - (package-menu--generate t) + (package-menu--generate t t) (message "No operations specified.")))) (defun package-menu--version-predicate (A B) @@ -1577,7 +1588,7 @@ The list is displayed in a buffer named `*Packages*'." (let ((buf (get-buffer-create "*Packages*"))) (with-current-buffer buf (package-menu-mode) - (package-menu--generate)) + (package-menu--generate nil t)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. (switch-to-buffer buf))) @@ -1585,6 +1596,19 @@ The list is displayed in a buffer named `*Packages*'." ;;;###autoload (defalias 'package-list-packages 'list-packages) +;; Used in finder.el +(defun package-show-package-list (packages) + "Display PACKAGES in a *Packages* buffer. +This is similar to `list-packages', but it does not fetch the +updated list of packages, and it only displays packages with +names in PACKAGES (which should be a list of symbols)." + (require 'finder-inf nil t) + (let ((buf (get-buffer-create "*Packages*"))) + (with-current-buffer buf + (package-menu-mode) + (package-menu--generate nil packages)) + (switch-to-buffer buf))) + (defun package-list-packages-no-fetch () "Display a list of packages. Does not fetch the updated list of packages before displaying. diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 0df9e7b16aa..b643d521ad6 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1627,7 +1627,11 @@ shifted movement key, set `cua-highlight-region-shift-only'." "Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings." (interactive "P") (setq-default cua-enable-cua-keys nil) - (cua-mode arg)) + (if (not (called-interactively-p 'any)) + (cua-mode arg) + ;; Use call-interactive to turn a nil prefix arg into `toggle'. + (call-interactively 'cua-mode) + (customize-mark-as-set 'cua-enable-cua-keys))) (defun cua-debug () diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 10623dba8e3..9abb0c8ecc0 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -497,6 +497,8 @@ and the hook `eshell-exit-hook'." (if intercept (setq this-command 'eshell-self-insert-command))))) +(declare-function find-tag-interactive "etags" (prompt &optional no-default)) + (defun eshell-find-tag (&optional tagname next-p regexp-p) "A special version of `find-tag' that ignores read-onlyness." (interactive) @@ -504,8 +506,7 @@ and the hook `eshell-exit-hook'." (let ((inhibit-read-only t) (no-default (eobp)) (find-tag-default-function 'ignore)) - (with-no-warnings - (setq tagname (car (find-tag-interactive "Find tag: ")))) + (setq tagname (car (find-tag-interactive "Find tag: " no-default))) (find-tag tagname next-p regexp-p))) (defun eshell-move-argument (limit func property arg) diff --git a/lisp/files.el b/lisp/files.el index 8cd5699eb9a..72cfc89ef8c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2386,6 +2386,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) ("\\.js\\'" . js-mode) ; javascript-mode would be better + ("\\.json\\'" . js-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix, MSDOG or VMS syntax. diff --git a/lisp/finder.el b/lisp/finder.el index 784de0a4d4c..ae2afba5bbb 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -316,7 +316,7 @@ not `finder-known-keywords'." (packages (gethash id finder-keywords-hash))) (unless packages (error "No packages matching key `%s'" key)) - (package--list-packages packages))) + (package-show-package-list packages))) (define-button-type 'finder-xref 'action #'finder-goto-xref) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 35531df0ad2..99a08de633b 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,68 @@ +2011-04-25 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-ignore-group-p): Don't call + `gnus-parameter-registry-ignore' if the *Group* buffer doesn't exist. + +2011-04-23 Glenn Morris <rgm@gnu.org> + + * gnus-sum.el (gnus-extra-headers): Bump :version. + +2011-04-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-sup): New function. + (shr-tag-sub): Ditto. + +2011-04-22 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-ignore-group-p): Test specifically + for the case where `gnus-registry-ignored-groups' is a list of lists, + and don't call `gnus-parameter-registry-ignore' otherwise. + +2011-04-21 Teodor Zlatanov <tzz@lifelogs.com> + + * nnimap.el (nnimap-user): New backend variable. + (nnimap-open-connection-1): Use it. + (nnimap-credentials): Accept user parameter so it's explicit what user + name is desired. + + * gnus-sum.el (gnus-extra-headers): Add Keywords, Cc, and Gcc to + default. + + * gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el, + not gnus-registry.el. + + * gnus-registry.el: Mention in comments how to modify + `gnus-extra-headers' for proper recipient tracking and that it may + already have To and Cc recently, which it does as of this commit. + (gnus-registry-ignored-groups): Remove defcustom. + Explain why in comments. + (gnus-registry-action): Fix data-header reference to use the extra + headers. Explain in package commentary how to add To and Cc headers to + the gnus-extra-headers. + (gnus-registry-ignored-groups): Adjust defaults to match the parameter. + (gnus-registry-ignore-group-p): Adjust to take either a group/topic + parameter list or a string list in `gnus-registry-ignored-groups'. Fix + logic error. + +2011-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-expand-url): Protect against null urls. + +2011-04-20 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-base): New binding. + (shr-tag-base): Keep track of <base>. + (shr-expand-url): New function used throughout. + +2011-04-20 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el + (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs. + (gnus-registry-ignored-groups): New variable. + (gnus-registry-ignore-group-p): Use it. + (gnus-registry-handle-action): Use `gnus-registry-ignore-group-p' and + set the destination group to nil (same as delete) if it's ignored. + 2011-04-20 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-registry.el (gnus-registry-action) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 009786dec80..e6c96ab2b19 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -31,7 +31,17 @@ ;; gnus-registry.el intercepts article respooling, moving, deleting, ;; and copying for all backends. If it doesn't work correctly for ;; you, submit a bug report and I'll be glad to fix it. It needs -;; documentation in the manual (also on my to-do list). +;; better documentation in the manual (also on my to-do list). + +;; If you want to track recipients (and you should to make the +;; gnus-registry splitting work better), you need the To and Cc +;; headers collected by Gnus. Note that in more recent Gnus versions +;; this is already the case: look at `gnus-extra-headers' to be sure. + +;; ;;; you may also want Gcc Newsgroups Keywords X-Face +;; (add-to-list 'gnus-extra-headers 'To) +;; (add-to-list 'gnus-extra-headers 'Cc) +;; (setq nnmail-extra-headers gnus-extra-headers) ;; Put this in your startup file (~/.gnus.el for instance) or use Customize: @@ -303,9 +313,10 @@ This is not required after changing `gnus-registry-cache-file'." (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (mail-header-subject data-header)) + (extra (mail-header-extra data-header)) (recipients (gnus-registry-sort-addresses - (or (cdr (assq "Cc" data-header)) "") - (or (cdr (assq "To" data-header)) ""))) + (or (cdr-safe (assq 'Cc extra)) "") + (or (cdr-safe (assq 'To extra)) ""))) (sender (nth 0 (gnus-registry-extract-addresses (mail-header-from data-header)))) (from (gnus-group-guess-full-name-from-command-method from)) @@ -323,9 +334,9 @@ This is not required after changing `gnus-registry-cache-file'." (defun gnus-registry-spool-action (id group &optional subject sender recipients) (let ((to (gnus-group-guess-full-name-from-command-method group)) (recipients (or recipients - (gnus-registry-sort-addresses - (or (message-fetch-field "cc") "") - (or (message-fetch-field "to") "")))) + (gnus-registry-sort-addresses + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") "")))) (subject (or subject (message-fetch-field "subject"))) (sender (or sender (message-fetch-field "from")))) (when (and (stringp id) (string-match "\r$" id)) @@ -341,6 +352,8 @@ This is not required after changing `gnus-registry-cache-file'." 10 "gnus-registry-handle-action %S" (list id from to subject sender recipients)) (let ((db gnus-registry-db) + ;; if the group is ignored, set the destination to nil (same as delete) + (to (if (gnus-registry-ignore-group-p to) nil to)) ;; safe if not found (entry (gnus-registry-get-or-make-entry id)) (subject (gnus-string-remove-all-properties @@ -402,8 +415,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (sender (gnus-string-remove-all-properties (message-fetch-field "from"))) (recipients (gnus-registry-sort-addresses - (or (message-fetch-field "cc") "") - (or (message-fetch-field "to") ""))) + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") ""))) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject (message-fetch-field "subject")))) @@ -442,8 +455,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (gnus-message 9 "%s is looking up %s" log-agent reference) (loop for group in (gnus-registry-get-id-key reference 'group) when (gnus-registry-follow-group-p group) - do (gnus-message 7 "%s traced %s to %s" log-agent reference group) - do (push group found))) + do + (progn + (gnus-message 7 "%s traced %s to %s" log-agent reference group) + (push group found)))) ;; filter the found groups and return them ;; the found groups are the full groups (setq found (gnus-registry-post-process-groups @@ -468,7 +483,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if gnus-registry-track-extra 7 9) "%s (extra tracking) traced subject '%s' to %s" log-agent subject group) - collect group)) + and collect group)) ;; filter the found groups and return them ;; the found groups are NOT the full groups (setq found (gnus-registry-post-process-groups @@ -495,7 +510,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if gnus-registry-track-extra 7 9) "%s (extra tracking) traced sender '%s' to %s" log-agent sender group) - collect group))) + and collect group))) ;; filter the found groups and return them ;; the found groups are NOT the full groups @@ -525,7 +540,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if gnus-registry-track-extra 7 9) "%s (extra tracking) traced recipient '%s' to %s" log-agent recp group) - collect group))))) + and collect group))))) ;; filter the found groups and return them ;; the found groups are NOT the full groups @@ -641,6 +656,34 @@ Consults `gnus-registry-unfollowed-groups' and group nnmail-split-fancy-with-parent-ignore-groups))))) +;; note that gnus-registry-ignored-groups is defined in gnus.el as a +;; group/topic parameter and an associated variable! + +;; we do special logic for ignoring to accept regular expressions and +;; nnmail-split-fancy-with-parent-ignore-groups as well +(defun gnus-registry-ignore-group-p (group) + "Determines if a group name should be ignored. +Consults `gnus-registry-ignored-groups' and +`nnmail-split-fancy-with-parent-ignore-groups'." + (and group + (or (gnus-grep-in-list + group + (delq nil (mapcar (lambda (g) + (cond + ((stringp g) g) + ((and (listp g) (nth 1 g)) + (nth 0 g)) + (t nil))) gnus-registry-ignored-groups))) + ;; only use `gnus-parameter-registry-ignore' if + ;; `gnus-registry-ignored-groups' is a list of lists + ;; (it can be a list of regexes) + (and (listp (nth 0 gnus-registry-ignored-groups)) + (get-buffer "*Group*") ; in automatic tests this is false + (gnus-parameter-registry-ignore group)) + (gnus-grep-in-list + group + nnmail-split-fancy-with-parent-ignore-groups)))) + (defun gnus-registry-wash-for-keywords (&optional force) "Get the keywords of the current article. Overrides existing keywords with FORCE set non-nil." @@ -712,7 +755,7 @@ Addresses without a name will say \"noname\"." (defun gnus-registry-sort-addresses (&rest addresses) "Return a normalized and sorted list of ADDRESSES." (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses)) - 'string-lessp)) + 'string-lessp)) (defun gnus-registry-simplify-subject (subject) (if (stringp subject) @@ -743,7 +786,7 @@ Addresses without a name will say \"noname\"." (assoc article (gnus-data-list nil))) (gnus-string-remove-all-properties (cdr (assq header (gnus-data-header - (assoc article (gnus-data-list nil)))))) + (assoc article (gnus-data-list nil)))))) nil)) ;; registry marks glue @@ -972,7 +1015,7 @@ only the last one's marks are returned." extra-cell key val) ;; remove all the strings from the entry (dolist (elem rest) - (if (stringp elem) (setq rest (delq elem rest)))) + (if (stringp elem) (setq rest (delq elem rest)))) (gnus-registry-set-id-key id 'group groups) ;; just use the first extra element (setq rest (car-safe rest)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d023bc5bb63..807f133e481 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1128,9 +1128,9 @@ which it may alter in any way." 'mail-decode-encoded-address-string "Function used to decode addresses with encoded words.") -(defcustom gnus-extra-headers '(To Newsgroups) +(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) "*Extra headers to parse." - :version "21.1" + :version "24.1" ; added Cc Keywords Gcc :group 'gnus-summary :type '(repeat symbol)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f68ea41e6bd..5ff03572832 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1875,7 +1875,10 @@ total number of articles in the group.") :function-document "Whether this group should be ignored by the registry." :variable gnus-registry-ignored-groups - :variable-default nil + :variable-default (mapcar + (lambda (g) (list g t)) + '("delayed$" "drafts$" "queue$" "INBOX$" + "^nnmairix:" "archive")) :variable-document "*Groups in which the registry should be turned off." :variable-group gnus-registry diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index afdea185dd3..f819c17afe8 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -58,6 +58,9 @@ (defvoo nnimap-address nil "The address of the IMAP server.") +(defvoo nnimap-user nil + "Username to use for authentication to the IMAP server.") + (defvoo nnimap-server-port nil "The IMAP port used. If nnimap-stream is `ssl', this will default to `imaps'. If not, @@ -283,13 +286,14 @@ textual parts.") (push (current-buffer) nnimap-process-buffers) (current-buffer))) -(defun nnimap-credentials (address ports) +(defun nnimap-credentials (address ports user) (let* ((auth-source-creation-prompts '((user . "IMAP user at %h: ") (secret . "IMAP password for %u@%h: "))) (found (nth 0 (auth-source-search :max 1 :host address :port ports + :user user :require '(:user :secret) :create t)))) (if found @@ -408,7 +412,8 @@ textual parts.") (list nnimap-address (nnoo-current-server 'nnimap))) - ports)))) + ports + nnimap-user)))) (setq nnimap-object nil) (let ((nnimap-inhibit-logging t)) (setq login-result diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 113137a0046..1f6cb528c5d 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -99,6 +99,7 @@ cid: URL as the argument.") (defvar shr-kinsoku-shorten nil) (defvar shr-table-depth 0) (defvar shr-stylesheet nil) +(defvar shr-base nil) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -127,6 +128,7 @@ cid: URL as the argument.") (setq shr-content-cache nil) (let ((shr-state nil) (shr-start nil) + (shr-base nil) (shr-width (or shr-width (window-width)))) (shr-descend (shr-transform-dom dom)))) @@ -392,6 +394,19 @@ redirects somewhere else." (forward-char 1)))) (not failed))) +(defun shr-expand-url (url) + (cond + ;; Absolute URL. + ((or (not url) + (string-match "\\`[a-z]*:" url) + (not shr-base)) + url) + ((and (not (string-match "/\\'" shr-base)) + (not (string-match "\\`/" url))) + (concat shr-base "/" url)) + (t + (concat shr-base url)))) + (defun shr-ensure-newline () (unless (zerop (current-column)) (insert "\n"))) @@ -719,6 +734,16 @@ ones, in case fg and bg are nil." (defun shr-tag-script (cont) ) +(defun shr-tag-sup (cont) + (let ((start (point))) + (shr-generic cont) + (put-text-property start (point) 'display '(raise 0.5)))) + +(defun shr-tag-sub (cont) + (let ((start (point))) + (shr-generic cont) + (put-text-property start (point) 'display '(raise -0.5)))) + (defun shr-tag-label (cont) (shr-generic cont) (shr-ensure-paragraph)) @@ -773,13 +798,16 @@ ones, in case fg and bg are nil." plist))))) plist))) +(defun shr-tag-base (cont) + (setq shr-base (cdr (assq :href cont)))) + (defun shr-tag-a (cont) (let ((url (cdr (assq :href cont))) (title (cdr (assq :title cont))) (start (point)) shr-start) (shr-generic cont) - (shr-urlify (or shr-start start) url title))) + (shr-urlify (or shr-start start) (shr-expand-url url) title))) (defun shr-tag-object (cont) (let ((start (point)) @@ -792,7 +820,7 @@ ones, in case fg and bg are nil." (setq url (or url (cdr (assq :value (cdr elem))))))) (when url (shr-insert " [multimedia] ") - (shr-urlify start url)) + (shr-urlify start (shr-expand-url url))) (shr-generic cont))) (defun shr-tag-video (cont) @@ -800,7 +828,7 @@ ones, in case fg and bg are nil." (url (cdr (assq :src cont))) (start (point))) (shr-tag-img nil image) - (shr-urlify start url))) + (shr-urlify start (shr-expand-url url)))) (defun shr-tag-img (cont &optional url) (when (or url @@ -810,7 +838,7 @@ ones, in case fg and bg are nil." (not (eq shr-state 'image))) (insert "\n")) (let ((alt (cdr (assq :alt cont))) - (url (or url (cdr (assq :src cont))))) + (url (shr-expand-url (or url (cdr (assq :src cont)))))) (let ((start (point-marker))) (when (zerop (length alt)) (setq alt "*")) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index c99689f33ad..17f006e81a1 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -296,8 +296,7 @@ This function assumes the current frame has only one window." ;;; Image Mode setup (defvar image-type nil - "Current image type. -This variable is used to display the current image type in the mode line.") + "The image type for the current Image mode buffer.") (make-variable-buffer-local 'image-type) (defvar image-mode-previous-major-mode nil @@ -324,13 +323,13 @@ This variable is used to display the current image type in the mode line.") (define-key map [remap beginning-of-buffer] 'image-bob) (define-key map [remap end-of-buffer] 'image-eob) map) - "Major mode keymap for viewing images in Image mode.") + "Mode keymap for `image-mode'.") (defvar image-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'image-toggle-display) map) - "Minor mode keymap for viewing images as text in Image mode.") + "Mode keymap for `image-minor-mode'.") (defvar bookmark-make-record-function) @@ -520,9 +519,10 @@ was inserted." (message "Repeat this command to go back to displaying the file as text")))) (defun image-toggle-display () - "Start or stop displaying an image file as the actual image. -This command toggles between `image-mode-as-text' showing the text of -the image file and `image-mode' showing the image as an image." + "Toggle between image and text display. +If the current buffer is displaying an image file as an image, +call `image-mode-as-text' to switch to text. Otherwise, display +the image by calling `image-mode'." (interactive) (if (image-get-display-property) (image-mode-as-text) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0d26d6bdcf6..4bf06a45238 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -58,6 +58,8 @@ ;;; Todo: +;; - Make things like icomplete-mode or lightning-completion work with +;; completion-in-region-mode. ;; - completion-insert-complete-hook (called after inserting a complete ;; completion), typically used for "complete-abbrev" where it would expand ;; the abbrev. Tho we'd probably want to provide it from the @@ -245,7 +247,9 @@ TERMINATOR can also be a cons cell (TERMINATOR . TERMINATOR-REGEXP) in which case TERMINATOR-REGEXP is a regular expression whose submatch number 1 should match TERMINATOR. This is used when there is a need to distinguish occurrences of the TERMINATOR strings which are really terminators -from others (e.g. escaped)." +from others (e.g. escaped). In this form, the car of TERMINATOR can also be, +instead of a string, a function that takes the completion and returns the +\"terminated\" string." ;; FIXME: This implementation is not right since it only adds the terminator ;; in try-completion, so any completion-style that builds the completion via ;; all-completions won't get the terminator, and selecting an entry in @@ -256,22 +260,28 @@ from others (e.g. escaped)." (bounds (completion-boundaries string table pred suffix)) (terminator-regexp (if (consp terminator) (cdr terminator) (regexp-quote terminator))) - (max (string-match terminator-regexp suffix))) + (max (and terminator-regexp + (string-match terminator-regexp suffix)))) (list* 'boundaries (car bounds) (min (cdr bounds) (or max (length suffix)))))) ((eq action nil) (let ((comp (try-completion string table pred))) (if (consp terminator) (setq terminator (car terminator))) (if (eq comp t) - (concat string terminator) - (if (and (stringp comp) - ;; FIXME: Try to avoid this second call, especially since + (if (functionp terminator) + (funcall terminator string) + (concat string terminator)) + (if (and (stringp comp) (not (zerop (length comp))) + ;; Try to avoid the second call to try-completion, since ;; it may be very inefficient (because `comp' made us ;; jump to a new boundary, so we complete in that ;; boundary with an empty start string). - ;; completion-boundaries might help. + (let ((newbounds (completion-boundaries comp table pred ""))) + (< (car newbounds) (length comp))) (eq (try-completion comp table pred) t)) - (concat comp terminator) + (if (functionp terminator) + (funcall terminator comp) + (concat comp terminator)) comp)))) ((eq action t) ;; FIXME: We generally want the `try' and `all' behaviors to be @@ -647,7 +657,8 @@ E = after completion we now have an Exact match. (minibuffer-hide-completions)) ;; Show the completion table, if requested. ((not exact) - (if (cond ((null completion-show-inline-help) t) + (if (cond (icomplete-mode t) + ((null completion-show-inline-help) t) ((eq completion-auto-help 'lazy) (eq this-command last-command)) (t completion-auto-help)) @@ -1292,6 +1303,8 @@ Point needs to be somewhere between START and END." (defvar completion-in-region-mode-map (let ((map (make-sparse-keymap))) + ;; FIXME: Only works if completion-in-region-mode was activated via + ;; completion-at-point called directly. (define-key map "?" 'completion-help-at-point) (define-key map "\t" 'completion-at-point) map) @@ -1314,8 +1327,7 @@ Point needs to be somewhere between START and END." (save-excursion (goto-char (nth 2 completion-in-region--data)) (line-end-position))) - (when completion-in-region-mode--predicate - (funcall completion-in-region-mode--predicate)))) + (funcall completion-in-region-mode--predicate))) (completion-in-region-mode -1))) ;; (defalias 'completion-in-region--prech 'completion-in-region--postch) @@ -1330,12 +1342,12 @@ Point needs to be somewhere between START and END." (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist) minor-mode-overriding-map-alist)) (if (null completion-in-region-mode) - (unless (or (equal "*Completions*" (buffer-name (window-buffer))) - (null completion-in-region-mode--predicate)) + (unless (equal "*Completions*" (buffer-name (window-buffer))) (minibuffer-hide-completions)) ;; (add-hook 'pre-command-hook #'completion-in-region--prech) - (set (make-local-variable 'completion-in-region-mode--predicate) - completion-in-region-mode-predicate) + (assert completion-in-region-mode-predicate) + (setq completion-in-region-mode--predicate + completion-in-region-mode-predicate) (add-hook 'post-command-hook #'completion-in-region--postch) (push `(completion-in-region-mode . ,completion-in-region-mode-map) minor-mode-overriding-map-alist))) diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index 1f16b9935c8..fb6c8b7470f 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -194,7 +194,7 @@ from the original mouse click to the current mouse location. Try it; you'll like it. It's easier to observe than to explain. If the mouse is clicked and released in the same place of time we -assume that the user didn't want to scdebugroll but wanted to whatever +assume that the user didn't want to scroll but wanted to whatever mouse-2 used to do, so we pass it through. Throw scrolling was inspired (but is not identical to) the \"hand\" diff --git a/lisp/mouse.el b/lisp/mouse.el index 87f9be6bf57..124f84d7d73 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -541,6 +541,9 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." ;; a `drag-mouse-1'. In any case `on-link' would have been nulled ;; above if there had been any significant mouse movement. (when (and on-link (eq 'mouse-1 (car-safe event))) + ;; If mouse-2 has never been done by the user, it doesn't + ;; have the necessary property to be interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click) (push (cons 'mouse-2 (cdr event)) unread-command-events)))))) (defun mouse-drag-mode-line (start-event) diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 0929c31b6c4..8b662795665 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -25,7 +25,8 @@ ;;; Commentary: ;; This package provides language bindings for the GnuTLS library -;; using the corresponding core functions in gnutls.c. +;; using the corresponding core functions in gnutls.c. It should NOT +;; be used directly, only through open-protocol-stream. ;; Simple test: ;; @@ -59,26 +60,77 @@ Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. +Usage example: + + \(with-temp-buffer + \(open-gnutls-stream \"tls\" + \(current-buffer) + \"your server goes here\" + \"imaps\")) + This is a very simple wrapper around `gnutls-negotiate'. See its documentation for the specific parameters you can use to open a GnuTLS connection, including specifying the credential type, trust and key files, and priority string." - (let ((proc (open-network-stream name buffer host service))) - (gnutls-negotiate proc 'gnutls-x509pki))) + (gnutls-negotiate (open-network-stream name buffer host service) + 'gnutls-x509pki + host)) + +(put 'gnutls-error + 'error-conditions + '(error gnutls-error)) +(put 'gnutls-error + 'error-message "GnuTLS error") (declare-function gnutls-boot "gnutls.c" (proc type proplist)) +(declare-function gnutls-errorp "gnutls.c" (error)) -(defun gnutls-negotiate (proc type &optional priority-string - trustfiles keyfiles) - "Negotiate a SSL/TLS connection. +(defun gnutls-negotiate (proc type hostname &optional priority-string + trustfiles keyfiles verify-flags + verify-error verify-hostname-error) + "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. PROC is a process returned by `open-network-stream'. +HOSTNAME is the remote hostname. It must be a valid string. PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". TRUSTFILES is a list of CA bundles. -KEYFILES is a list of client keys." +KEYFILES is a list of client keys. + +When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised +when the hostname does not match the presented certificate's host +name. The exact verification algorithm is a basic implementation +of the matching described in RFC2818 (HTTPS), which takes into +account wildcards, and the DNSName/IPAddress subject alternative +name PKIX extension. See GnuTLS' gnutls_x509_crt_check_hostname +for details. When VERIFY-HOSTNAME-ERROR is nil, only a warning +will be issued. + +When VERIFY-ERROR is not nil, an error will be raised when the +peer certificate verification fails as per GnuTLS' +gnutls_certificate_verify_peers2. Otherwise, only warnings will +be shown about the verification failure. + +VERIFY-FLAGS is a numeric OR of verification flags only for +`gnutls-x509pki' connections. See GnuTLS' x509.h for details; +here's a recent version of the list. + + GNUTLS_VERIFY_DISABLE_CA_SIGN = 1, + GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2, + GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4, + GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8, + GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16, + GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32, + GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64, + GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128, + GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256 + +It must be omitted, a number, or nil; if omitted or nil it +defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." (let* ((type (or type 'gnutls-x509pki)) + (default-trustfile "/etc/ssl/certs/ca-certificates.crt") (trustfiles (or trustfiles - '("/etc/ssl/certs/ca-certificates.crt"))) + (when (file-exists-p default-trustfile) + (list default-trustfile)))) (priority-string (or priority-string (cond ((eq type 'gnutls-anon) @@ -86,19 +138,26 @@ KEYFILES is a list of client keys." ((eq type 'gnutls-x509pki) "NORMAL")))) (params `(:priority ,priority-string + :hostname ,hostname :loglevel ,gnutls-log-level :trustfiles ,trustfiles :keyfiles ,keyfiles + :verify-flags ,verify-flags + :verify-error ,verify-error + :verify-hostname-error ,verify-hostname-error :callbacks nil)) ret) (gnutls-message-maybe (setq ret (gnutls-boot proc type params)) - "boot: %s") + "boot: %s" params) + + (when (gnutls-errorp ret) + ;; This is a error from the underlying C code. + (signal 'gnutls-error (list proc ret))) proc)) -(declare-function gnutls-errorp "gnutls.c" (error)) (declare-function gnutls-error-string "gnutls.c" (error)) (defun gnutls-message-maybe (doit format &rest params) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 67bb7eae68e..09519e14870 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -46,7 +46,8 @@ (require 'starttls) (declare-function gnutls-negotiate "gnutls" - (proc type &optional priority-string trustfiles keyfiles)) + (proc type host &optional priority-string trustfiles keyfiles + verify-flags verify-error verify-hostname-error)) ;;;###autoload (defun open-network-stream (name buffer host service &rest parameters) @@ -197,7 +198,7 @@ values: (network-stream-command stream starttls-command eoc)) ;; The server said it was OK to begin STARTTLS negotiations. (if (fboundp 'open-gnutls-stream) - (gnutls-negotiate stream nil) + (gnutls-negotiate stream nil host) (unless (starttls-negotiate stream) (delete-process stream))) (if (memq (process-status stream) '(open run)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index cb4aca12edb..81e955ebbf8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2336,7 +2336,8 @@ The method used must be an out-of-band method." orig-vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-compat-set-process-query-on-exit-flag p nil) - (tramp-process-actions p v tramp-actions-copy-out-of-band))) + (tramp-process-actions + p v nil tramp-actions-copy-out-of-band))) ;; Reset the transfer process properties. (tramp-message orig-vec 6 "%s" (buffer-string)) @@ -4212,7 +4213,8 @@ connection if a previous connection has died for some reason." (catch 'uname-changed (let ((p (tramp-get-connection-process vec)) (process-name (tramp-get-connection-property vec "process-name" nil)) - (process-environment (copy-sequence process-environment))) + (process-environment (copy-sequence process-environment)) + (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))) ;; If too much time has passed since last command was sent, look ;; whether process is still alive. If it isn't, kill it. When @@ -4366,7 +4368,7 @@ connection if a previous connection has died for some reason." ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-send-command vec command t t) - (tramp-process-actions p vec tramp-actions-before-shell 60) + (tramp-process-actions p vec pos tramp-actions-before-shell 60) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) ;; Next hop. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 36477f7b439..5a62b71bda1 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1314,7 +1314,7 @@ connection if a previous connection has died for some reason." ;; Play login scenario. (tramp-process-actions - p vec + p vec nil (if share tramp-smb-actions-with-share tramp-smb-actions-without-share)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fc167d6e62e..693e082ecc8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3098,8 +3098,11 @@ The terminal type can be configured with `tramp-terminal-type'." (setq found (funcall action proc vec))))) found)) -(defun tramp-process-actions (proc vec actions &optional timeout) - "Perform actions until success or TIMEOUT." +(defun tramp-process-actions (proc vec pos actions &optional timeout) + "Perform ACTIONS until success or TIMEOUT. +PROC and VEC indicate the remote connection to be used. POS, if +set, is the starting point of the region to be deleted in the +connection buffer." ;; Preserve message for `progress-reporter'. (tramp-compat-with-temp-message "" ;; Enable auth-source and password-cache. @@ -3124,7 +3127,10 @@ The terminal type can be configured with `tramp-terminal-type'." (cond ((eq exit 'permission-denied) "Permission denied") ((eq exit 'process-died) "Process died") - (t "Login failed")))))))) + (t "Login failed")))) + (when (numberp pos) + (with-current-buffer (tramp-get-connection-buffer vec) + (let (buffer-read-only) (delete-region pos (point))))))))) :;; Utility functions: diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 462b8f11397..7b4c6fd75b1 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.1" +(defconst tramp-version "2.2.2-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.1 is not fit for %s" + (format "Tramp 2.2.2-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el index d09ff1dd892..1a6d08c08ef 100644 --- a/lisp/obsolete/awk-mode.el +++ b/lisp/obsolete/awk-mode.el @@ -4,6 +4,7 @@ ;; Maintainer: FSF ;; Keywords: unix, languages +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -22,8 +23,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Sets up C-mode with support for awk-style #-comments and a lightly ;; hacked syntax table. diff --git a/lisp/erc/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el index 530c586d24f..67f51d690b2 100644 --- a/lisp/erc/erc-hecomplete.el +++ b/lisp/obsolete/erc-hecomplete.el @@ -4,6 +4,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion +;; Obsolete-since: 24.1 ;; This file is part of GNU Emacs. @@ -108,16 +109,14 @@ add this string when a unique expansion was found." This is a function to put on `hippie-expand-try-functions-list'. Then use \\[hippie-expand] to expand nicks. The type of completion depends on `erc-nick-completion'." - (cond ((eq erc-nick-completion 'pals) - (try-complete-erc-nick old erc-pals)) - ((eq erc-nick-completion 'all) - (try-complete-erc-nick old (append + (try-complete-erc-nick old (cond ((eq erc-nick-completion 'pals) erc-pals) + ((eq erc-nick-completion 'all) + (append (erc-get-channel-nickname-list) - (erc-command-list)))) - ((functionp erc-nick-completion) - (try-complete-erc-nick old (funcall erc-nick-completion))) - (t - (try-complete-erc-nick old erc-nick-completion)))) + (erc-command-list))) + ((functionp erc-nick-completion) + (funcall erc-nick-completion)) + (t erc-nick-completion)))) (defvar try-complete-erc-nick-window-configuration nil "The window configuration for `try-complete-erc-nick'. diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index a59e7871458..9c750ca5e89 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: faces files ;; Version: 3.14 +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -24,8 +25,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Fast Lock mode is a Font Lock support mode. ;; It makes visiting a file in Font Lock mode faster by restoring its face text ;; properties from automatically saved associated Font Lock cache files. diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el index 14b6a202012..cb06091dfcf 100644 --- a/lisp/obsolete/iso-acc.el +++ b/lisp/obsolete/iso-acc.el @@ -5,6 +5,7 @@ ;; Author: Johan Vromans ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Function `iso-accents-mode' activates a minor mode in which ;; typewriter "dead keys" are emulated. The purpose of this emulation ;; is to provide a simple means for inserting accented characters diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el index 3f3b6d4abb3..c223d096730 100644 --- a/lisp/obsolete/iso-insert.el +++ b/lisp/obsolete/iso-insert.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Provides keys for inserting ISO Latin-1 characters. They use the ;; prefix key C-x 8. Type C-x 8 C-h for a list. diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el index d197f0d5b67..43686283e89 100644 --- a/lisp/obsolete/iso-swed.el +++ b/lisp/obsolete/iso-swed.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Written by Howard Gayle. See case-table.el for details. ;;; Code: diff --git a/lisp/obsolete/keyswap.el b/lisp/obsolete/keyswap.el index f95b8f5bdb5..ec1263e5189 100644 --- a/lisp/obsolete/keyswap.el +++ b/lisp/obsolete/keyswap.el @@ -4,6 +4,7 @@ ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> ;; Keywords: terminals +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -22,8 +23,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; This package is meant to be called by other terminal packages. ;;; Code: diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el index f922a5c30b6..a04db4a0c72 100644 --- a/lisp/obsolete/lazy-lock.el +++ b/lisp/obsolete/lazy-lock.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: faces files ;; Version: 2.11 +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -24,8 +25,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Purpose: ;; ;; Lazy Lock mode is a Font Lock support mode. diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index be967938bc9..c33794f668d 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -4,6 +4,7 @@ ;; Author: Rajesh Vaidheeswarran <rv@gnu.org> ;; Keywords: convenience +;; Obsolete-since: 23.1 ;; This file is part of GNU Emacs. @@ -22,8 +23,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 23.1. - ;; URL: http://www.dsmit.com/lisp/ ;; ;; The whitespace library is intended to find and help fix five different types diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el index 1b475e9e98b..7c1c3552e2d 100644 --- a/lisp/obsolete/options.el +++ b/lisp/obsolete/options.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -21,8 +22,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; This code provides functions to list and edit the values of all global ;; option variables known to loaded Emacs Lisp code. There are two entry ;; points, `list-options' and `edit' options'. The latter enters a major diff --git a/lisp/obsolete/resume.el b/lisp/obsolete/resume.el index 6b52ef28784..c9df1184d90 100644 --- a/lisp/obsolete/resume.el +++ b/lisp/obsolete/resume.el @@ -5,6 +5,7 @@ ;; Author: Joe Wells <jbw@bucsf.bu.edu> ;; Adapted-By: ESR ;; Keywords: processes +;; Obsolete-since: 23.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 23.1. - ;; The purpose of this library is to handle command line arguments ;; when you resume an existing Emacs job. diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el index 3f543b38e44..1fbc9bc4158 100644 --- a/lisp/obsolete/scribe.el +++ b/lisp/obsolete/scribe.el @@ -6,6 +6,7 @@ ;; (according to ack.texi) ;; Maintainer: FSF ;; Keywords: wp +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -24,8 +25,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; A major mode for editing source in written for the Scribe text formatter. ;; Knows about Scribe syntax and standard layout rules. The command to ;; run Scribe on a buffer is bogus; someone interested should fix it. diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el index 4b82a74bce7..c31af8697ef 100644 --- a/lisp/obsolete/swedish.el +++ b/lisp/obsolete/swedish.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Fixme: Is this actually used? if so, it should be in language, ;; possibly as a feature property of Swedish, probably defining a ;; `swascii' coding system. diff --git a/lisp/obsolete/vc-mcvs.el b/lisp/obsolete/vc-mcvs.el index 06ce7f41c65..980cdbfd71b 100644 --- a/lisp/obsolete/vc-mcvs.el +++ b/lisp/obsolete/vc-mcvs.el @@ -4,6 +4,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: None +;; Obsolete-since: 23.1 ;; This file is part of GNU Emacs. @@ -30,9 +31,6 @@ ;; ;; ********** READ THIS! ********** -;; This file has been obsolete and unsupported since Emacs 23.1. - - ;; The home page of the Meta-CVS version control system is at ;; ;; http://users.footprints.net/~kaz/mcvs.html diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 364ea35af3c..46c3c867304 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -368,15 +368,15 @@ should return a grid vector array that is the new solution." (5x5-copy-grid best-solution))))) (setq 5x5-cracking nil)) -(defun 5x5-make-random-solution (&rest ignore) +(defun 5x5-make-random-solution (&rest _ignore) "Make a random solution." (5x5-make-random-grid)) -(defun 5x5-make-mutate-current (current best) +(defun 5x5-make-mutate-current (current _best) "Mutate the current solution." (5x5-mutate-solution current)) -(defun 5x5-make-mutate-best (current best) +(defun 5x5-make-mutate-best (_current best) "Mutate the best solution." (5x5-mutate-solution best)) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 0dc556007ba..f2b7294e2d0 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1,4 +1,4 @@ -;;; bubbles.el --- Puzzle game for Emacs. +;;; bubbles.el --- Puzzle game for Emacs ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. @@ -921,7 +921,8 @@ static char * dot3d_xpm[] = { (define-derived-mode bubbles-mode nil "Bubbles" "Major mode for playing bubbles. \\{bubbles-mode-map}" - (setq buffer-read-only t) + (setq buffer-read-only t + show-trailing-whitespace nil) (buffer-disable-undo) (force-mode-line-update) (redisplay) @@ -1317,8 +1318,7 @@ Use optional parameter POS instead of point if given." Return t if new char is non-empty." (save-excursion (when (bubbles--goto row col) - (let ((char-org (char-after (point))) - (char-new (bubbles--empty-char)) + (let ((char-new (bubbles--empty-char)) (removed nil) (trow row) (tcol col) @@ -1416,9 +1416,8 @@ Return t if new char is non-empty." (dotimes (i (bubbles--grid-height)) (dotimes (j (bubbles--grid-width)) (bubbles--goto i j) - (let* ((index (get-text-property (point) 'index)) - (face (nth index bubbles--faces)) - (fg-col (face-foreground face))) + (let ((face (nth (get-text-property (point) 'index) + bubbles--faces))) (when (get-text-property (point) 'active) (set-face-foreground 'bubbles--highlight-face "#ff0000") (setq face 'bubbles--highlight-face)) @@ -1434,8 +1433,7 @@ Return t if new char is non-empty." (save-excursion (goto-char (point-min)) (forward-line 1) - (let ((inhibit-read-only t) - char) + (let ((inhibit-read-only t)) (dotimes (i (bubbles--grid-height)) (dotimes (j (bubbles--grid-width)) (forward-char 1) diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 3de8ca3d4fd..b9ce669533a 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -353,7 +353,7 @@ The most useful commands are: (let ((char-a (following-char)) (char-b (decipher-last-command-char))) (or (and (not (= ?w (char-syntax char-a))) - (= char-b ?\ )) ;Spacebar just advances on non-letters + (= char-b ?\s)) ;Spacebar just advances on non-letters (funcall decipher-function char-a char-b))))) (forward-char)) @@ -366,10 +366,10 @@ The most useful commands are: (decipher-set-map a b)) ((and (>= a ?a) (<= a ?z)) ;; If A is lowercase, then it is in the plaintext alphabet: - (if (= b ?\ ) + (if (= b ?\s) ;; We are clearing the association (if any): - (if (/= ?\ (setq b (cdr (assoc a decipher-alphabet)))) - (decipher-set-map b ?\ )) + (if (/= ?\s (setq b (cdr (assoc a decipher-alphabet)))) + (decipher-set-map b ?\s)) ;; Associate the plaintext char with the char pressed: (decipher-set-map b a))) (t @@ -432,12 +432,12 @@ The most useful commands are: ;; modified using setcdr. (let ((cipher-map (decipher-copy-cons (rassoc cipher-char decipher-alphabet))) (plain-map (decipher-copy-cons (assoc plain-char decipher-alphabet)))) - (cond ((equal ?\ plain-char) + (cond ((equal ?\s plain-char) cipher-map) ((equal cipher-char (cdr plain-map)) nil) ;We aren't changing anything - ((equal ?\ (cdr plain-map)) - (or cipher-map (cons ?\ cipher-char))) + ((equal ?\s (cdr plain-map)) + (or cipher-map (cons ?\s cipher-char))) (cipher-map (list plain-map cipher-map)) (t @@ -466,15 +466,15 @@ The most useful commands are: (goto-char (point-min)) (if (setq mapping (rassoc cipher-char decipher-alphabet)) (progn - (setcdr mapping ?\ ) + (setcdr mapping ?\s) (search-forward-regexp (concat "^([a-z]*" (char-to-string (car mapping)))) - (decipher-insert ?\ ) + (decipher-insert ?\s) (beginning-of-line))) (if (setq mapping (assoc plain-char decipher-alphabet)) (progn - (if (/= ?\ (cdr mapping)) - (decipher-set-map (cdr mapping) ?\ t)) + (if (/= ?\s (cdr mapping)) + (decipher-set-map (cdr mapping) ?\s t)) (setcdr mapping cipher-char) (search-forward-regexp (concat "^([a-z]*" plain-string)) (decipher-insert cipher-char) @@ -527,8 +527,7 @@ Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." (or (stringp desc) (setq desc "")) (let (alphabet - buffer-read-only ;Make buffer writable - mapping) + buffer-read-only) ;Make buffer writable (goto-char (point-min)) (re-search-forward "^)") (move-to-column 27 t) @@ -585,12 +584,12 @@ you have determined the keyword." buffer-read-only ;Make buffer writable plain-map undo-rec) (while (setq plain-map (pop ptr)) - (if (equal ?\ (cdr plain-map)) + (if (equal ?\s (cdr plain-map)) (progn (while (rassoc cipher-char decipher-alphabet) ;; Find the next unused letter (incf cipher-char)) - (push (cons ?\ cipher-char) undo-rec) + (push (cons ?\s cipher-char) undo-rec) (decipher-set-map cipher-char (car plain-map) t)))) (decipher-add-undo undo-rec))) @@ -624,7 +623,7 @@ You should use this if you edit the ciphertext." (replace-match ">" nil nil)) (decipher-read-alphabet) (while (setq mapping (pop alphabet)) - (or (equal ?\ (cdr mapping)) + (or (equal ?\s (cdr mapping)) (decipher-set-map (cdr mapping) (car mapping)))))) (setq decipher-undo-list nil decipher-undo-list-size 0) @@ -751,8 +750,8 @@ FUNC is called exactly once between words, with `decipher-char' set to a space. See `decipher-loop-no-breaks' if you do not care about word divisions." - (let ((decipher-char ?\ ) - (decipher--loop-prev-char ?\ )) + (let ((decipher-char ?\s) + (decipher--loop-prev-char ?\s)) (save-excursion (goto-char (point-min)) (funcall func) ;Space marks beginning of first word @@ -760,16 +759,16 @@ See `decipher-loop-no-breaks' if you do not care about word divisions." (while (not (eolp)) (setq decipher-char (upcase (following-char))) (or (and (>= decipher-char ?A) (<= decipher-char ?Z)) - (setq decipher-char ?\ )) - (or (and (equal decipher-char ?\ ) - (equal decipher--loop-prev-char ?\ )) + (setq decipher-char ?\s)) + (or (and (equal decipher-char ?\s) + (equal decipher--loop-prev-char ?\s)) (funcall func)) (setq decipher--loop-prev-char decipher-char) (forward-char)) - (or (equal decipher-char ?\ ) + (or (equal decipher-char ?\s) (progn (setq decipher-char ?\s - decipher--loop-prev-char ?\ ) + decipher--loop-prev-char ?\s) (funcall func))))))) (defun decipher-loop-no-breaks (func) @@ -844,13 +843,13 @@ TOTAL is the total number of letters in the ciphertext." decipher--digram-list))))) (and (>= decipher--prev-char ?A) (incf (aref (aref decipher--before (- decipher--prev-char ?A)) - (if (equal decipher-char ?\ ) + (if (equal decipher-char ?\s) 26 (- decipher-char ?A))))) (and (>= decipher-char ?A) (incf (aref decipher--freqs (- decipher-char ?A))) (incf (aref (aref decipher--after (- decipher-char ?A)) - (if (equal decipher--prev-char ?\ ) + (if (equal decipher--prev-char ?\s) 26 (- decipher--prev-char ?A))))) (setq decipher--prev-char decipher-char)) @@ -883,7 +882,7 @@ TOTAL is the total number of letters in the ciphertext." (defun decipher-analyze-buffer () "Perform frequency analysis and store results in statistics buffer. Creates the statistics buffer if it doesn't exist." - (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*)) + (let ((decipher--prev-char (if decipher-ignore-spaces ?\s ?\*)) (decipher--before (make-vector 26 nil)) (decipher--after (make-vector 26 nil)) (decipher--freqs (make-vector 26 0)) @@ -1057,7 +1056,7 @@ if it can't, it signals an error." ;; (setq undo-rec (list undo-rec))) ;; (insert ?\() ;; (while (setq undo-map (pop undo-rec)) -;; (insert (cdr undo-map) (car undo-map) ?\ )) +;; (insert (cdr undo-map) (car undo-map) ?\s)) ;; (delete-char -1) ;; (insert ")\n")))))) diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index c60472e9386..54a5a4ef6c9 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -115,11 +115,11 @@ (defun doc// (x) x) (defmacro doc$ (what) - "quoted arg form of doctor-$" + "Quoted arg form of doctor-$." `(doctor-$ ',what)) (defun doctor-$ (what) - "Return the car of a list, rotating the list each time" + "Return the car of a list, rotating the list each time." (let* ((vv (symbol-value what)) (first (car vv)) (ww (append (cdr vv) (list first)))) @@ -268,7 +268,7 @@ reads the sentence before point, and prints the Doctor's answer." (you seem to dwell on (doc// doctor-owner) family \.) ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?))) (set (make-local-variable 'doctor--huhlst) - '(((doc$ doctor--whysay)(doc// doctor-sent) \?) + '(((doc$ doctor--whysay) (doc// doctor-sent) \?) (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?))) (set (make-local-variable 'doctor--longhuhlst) '(((doc$ doctor--whysay) that \?) @@ -371,8 +371,8 @@ reads the sentence before point, and prints the Doctor's answer." (did you watch a lot of crime and violence on television as a child \?))) (set (make-local-variable 'doctor--sexlst) '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?) - ((doc$ doctor--describe)(doc$ doctor--something) about your sexual history \.) - ((doc$ doctor--please)(doc$ doctor--describe) your sex life \.\.\.) + ((doc$ doctor--describe) (doc$ doctor--something) about your sexual history \.) + ((doc$ doctor--please) (doc$ doctor--describe) your sex life \.\.\.) ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.) ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.) ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?))) @@ -384,11 +384,11 @@ reads the sentence before point, and prints the Doctor's answer." ((doc$ doctor--bother) i ask that \?))) (set (make-local-variable 'doctor--beclst) '((is it because (doc// doctor-sent) that you came to me \?) - ((doc$ doctor--bother)(doc// doctor-sent) \?) + ((doc$ doctor--bother) (doc// doctor-sent) \?) (when did you first know that (doc// doctor-sent) \?) (is the fact that (doc// doctor-sent) the real reason \?) (does the fact that (doc// doctor-sent) explain anything else \?) - ((doc$ doctor--areyou)(doc$ doctor--sure)(doc// doctor-sent) \? ))) + ((doc$ doctor--areyou) (doc$ doctor--sure) (doc// doctor-sent) \? ))) (set (make-local-variable 'doctor--shortbeclst) '(((doc$ doctor--bother) i ask you that \?) (that\'s not much of an answer!) @@ -398,15 +398,15 @@ reads the sentence before point, and prints the Doctor's answer." (don\'t be (doc$ doctor--afraidof) elaborating \.) ((doc$ doctor--please) go into more detail \.))) (set (make-local-variable 'doctor--thlst) - '(((doc$ doctor--maybe)(doc$ doctor--thing)(doc$ doctor--isrelated) this \.) - ((doc$ doctor--maybe)(doc$ doctor--things)(doc$ doctor--arerelated) this \.) + '(((doc$ doctor--maybe) (doc$ doctor--thing) (doc$ doctor--isrelated) this \.) + ((doc$ doctor--maybe) (doc$ doctor--things) (doc$ doctor--arerelated) this \.) (is it because of (doc$ doctor--things) that you are going through all this \?) (how do you reconcile (doc$ doctor--things) \? ) - ((doc$ doctor--maybe) this (doc$ doctor--isrelated)(doc$ doctor--things) \?))) + ((doc$ doctor--maybe) this (doc$ doctor--isrelated) (doc$ doctor--things) \?))) (set (make-local-variable 'doctor--remlst) '((earlier you said (doc$ doctor--history) \?) (you mentioned that (doc$ doctor--history) \?) - ((doc$ doctor--whysay)(doc$ doctor--history) \? ))) + ((doc$ doctor--whysay) (doc$ doctor--history) \? ))) (set (make-local-variable 'doctor--toklst) '((is this how you relax \?) (how long have you been smoking grass \?) @@ -415,7 +415,7 @@ reads the sentence before point, and prints the Doctor's answer." '((do you get (doc// doctor-found) often \?) (do you enjoy being (doc// doctor-found) \?) (what makes you (doc// doctor-found) \?) - (how often (doc$ doctor--areyou)(doc// doctor-found) \?) + (how often (doc$ doctor--areyou) (doc// doctor-found) \?) (when were you last (doc// doctor-found) \?))) (set (make-local-variable 'doctor--replist) '((i . (you)) (my . (your)) @@ -832,7 +832,7 @@ Otherwise call the Doctor to parse preceding sentence." (newline arg))) (defun doctor-read-print nil - "top level loop" + "Top level loop." (interactive) (let ((sent (doctor-readin))) (insert "\n") @@ -850,7 +850,7 @@ Otherwise call the Doctor to parse preceding sentence." sentence)) (defun doctor-read-token () - "read one word from buffer" + "Read one word from buffer." (prog1 (intern (downcase (buffer-substring (point) (progn (forward-word 1) @@ -859,25 +859,25 @@ Otherwise call the Doctor to parse preceding sentence." ;; Main processing function for sentences that have been read. -(defun doctor-doc (doctor-sent) +(defun doctor-doc (sent) (cond - ((equal doctor-sent '(foo)) - (doctor-type '(bar! (doc$ doctor--please)(doc$ doctor--continue) \.))) - ((member doctor-sent doctor--howareyoulst) + ((equal sent '(foo)) + (doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.))) + ((member sent doctor--howareyoulst) (doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.))) - ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long) + ((or (member sent '((good bye) (see you later) (i quit) (so long) (go away) (get lost))) - (memq (car doctor-sent) + (memq (car sent) '(bye halt break quit done exit goodbye bye\, stop pause goodbye\, stop pause))) (doctor-type (doc$ doctor--bye))) - ((and (eq (car doctor-sent) 'you) - (memq (cadr doctor-sent) doctor--abusewords)) - (setq doctor-found (cadr doctor-sent)) + ((and (eq (car sent) 'you) + (memq (cadr sent) doctor--abusewords)) + (setq doctor-found (cadr sent)) (doctor-type (doc$ doctor--abuselst))) - ((eq (car doctor-sent) 'whatmeans) - (doctor-def (cadr doctor-sent))) - ((equal doctor-sent '(parse)) + ((eq (car sent) 'whatmeans) + (doctor-def (cadr sent))) + ((equal sent '(parse)) (doctor-type (list 'subj '= doctor-subj ", " 'verb '= doctor-verb "\n" 'object 'phrase '= doctor-obj "," @@ -889,29 +889,29 @@ Otherwise call the Doctor to parse preceding sentence." 'sentence 'used 'was "..." '(doc// doctor--bak)))) - ((memq (car doctor-sent) '(are is do has have how when where who why)) + ((memq (car sent) '(are is do has have how when where who why)) (doctor-type (doc$ doctor--qlist))) - ;; ((eq (car doctor-sent) 'forget) - ;; (set (cadr doctor-sent) nil) - ;; (doctor-type '((doc$ doctor--isee)(doc$ doctor--please) + ;; ((eq (car sent) 'forget) + ;; (set (cadr sent) nil) + ;; (doctor-type '((doc$ doctor--isee) (doc$ doctor--please) ;; (doc$ doctor--continue)\.))) (t - (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found)) - (if (> (length doctor-sent) 12)(setq doctor-sent (doctor-shorten doctor-sent))) - (setq doctor-sent (doctor-correct-spelling (doctor-replace doctor-sent doctor--replist))) - (cond ((and (not (memq 'me doctor-sent))(not (memq 'i doctor-sent)) - (memq 'am doctor-sent)) - (setq doctor-sent (doctor-replace doctor-sent '((am . (are))))))) - (cond ((equal (car doctor-sent) 'yow) (doctor-zippy)) - ((< (length doctor-sent) 2) - (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy) + (if (doctor-defq sent) (doctor-define sent doctor-found)) + (if (> (length sent) 12) (setq sent (doctor-shorten sent))) + (setq sent (doctor-correct-spelling (doctor-replace sent doctor--replist))) + (cond ((and (not (memq 'me sent)) (not (memq 'i sent)) + (memq 'am sent)) + (setq sent (doctor-replace sent '((am . (are))))))) + (cond ((equal (car sent) 'yow) (doctor-zippy)) + ((< (length sent) 2) + (cond ((eq (doctor-meaning (car sent)) 'howdy) (doctor-howdy)) (t (doctor-short)))) (t - (if (memq 'am doctor-sent) - (setq doctor-sent (doctor-replace doctor-sent '((me . (i)))))) - (setq doctor-sent (doctor-fixup doctor-sent)) - (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not)) + (if (memq 'am sent) + (setq sent (doctor-replace sent '((me . (i)))))) + (setq sent (doctor-fixup sent)) + (if (and (eq (car sent) 'do) (eq (cadr sent) 'not)) (cond ((zerop (random 3)) (doctor-type '(are you (doc$ doctor--afraidof) that \?))) ((zerop (random 2)) @@ -920,9 +920,9 @@ Otherwise call the Doctor to parse preceding sentence." (doctor-rthing)) (t (doctor-type '((doc$ doctor--whysay) that i shouldn\'t - (cddr doctor-sent) + (cddr sent) \?)))) - (doctor-go (doctor-wherego doctor-sent)))))))) + (doctor-go (doctor-wherego sent)))))))) ;; Things done to process sentences once read. @@ -1020,7 +1020,7 @@ the subject noun, and return the portion of the sentence following it." nil)))) (defun doctor-nounp (x) - "Returns t if the symbol argument is a noun." + "Return t if the symbol argument is a noun." (or (doctor-pronounp x) (not (or (doctor-verbp x) (equal x 'not) @@ -1028,7 +1028,7 @@ the subject noun, and return the portion of the sentence following it." (doctor-modifierp x) )) )) (defun doctor-pronounp (x) - "Returns t if the symbol argument is a pronoun." + "Return t if the symbol argument is a pronoun." (memq x '( i me mine myself we us ours ourselves ourself @@ -1130,8 +1130,8 @@ the subject noun, and return the portion of the sentence following it." (t 'something)))) (defun doctor-getnoun (x) - (cond ((null x)(setq doctor-object 'something)) - ((atom x)(setq doctor-object x)) + (cond ((null x) (setq doctor-object 'something)) + ((atom x) (setq doctor-object x)) ((eq (length x) 1) (setq doctor-object (cond ((doctor-nounp (setq doctor-object (car x))) doctor-object) @@ -1304,7 +1304,7 @@ element pair in RLIST." sent))) (defun doctor-wherego (sent) - (cond ((null sent)(doc$ doctor--whereoutp)) + (cond ((null sent) (doc$ doctor--whereoutp)) ((null (doctor-meaning (car sent))) (doctor-wherego (cond ((zerop (random 2)) (reverse (cdr sent))) @@ -1327,8 +1327,8 @@ and DOCTOR-OBJ." (setq foo (cdr foo))) (setq doctor-verb (car foo)) (setq doctor-obj (doctor-getnoun (cdr foo))) - (cond ((eq doctor-object 'i)(setq doctor-object 'me)) - ((eq doctor-subj 'me)(setq doctor-subj 'i))) + (cond ((eq doctor-object 'i) (setq doctor-object 'me)) + ((eq doctor-subj 'me) (setq doctor-subj 'i))) (cond (mem (doctor-remember (list doctor-subj doctor-verb doctor-obj)))))) (defun doctor-possess (sent key) @@ -1414,7 +1414,7 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (defun doctor-rthing () (doctor-type (doc$ doctor--thlst))) -(defun doctor-remem () (cond ((null doctor--history)(doctor-huh)) +(defun doctor-remem () (cond ((null doctor--history) (doctor-huh)) ((doctor-type (doc$ doctor--remlst))))) (defun doctor-howdy () @@ -1426,14 +1426,14 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-type '((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--things) \.))))) (defun doctor-when () - (cond ((< (length (memq doctor-found doctor-sent)) 3)(doctor-short)) + (cond ((< (length (memq doctor-found doctor-sent)) 3) (doctor-short)) (t (setq doctor-sent (cdr (memq doctor-found doctor-sent))) (setq doctor-sent (doctor-fixup doctor-sent)) - (doctor-type '((doc$ doctor--whatwhen)(doc// doctor-sent) \?))))) + (doctor-type '((doc$ doctor--whatwhen) (doc// doctor-sent) \?))))) (defun doctor-conj () - (cond ((< (length (memq doctor-found doctor-sent)) 4)(doctor-short)) + (cond ((< (length (memq doctor-found doctor-sent)) 4) (doctor-short)) (t (setq doctor-sent (cdr (memq doctor-found doctor-sent))) (setq doctor-sent (doctor-fixup doctor-sent)) @@ -1497,10 +1497,10 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-type (doc$ doctor--toklst))) (defun doctor-state () - (doctor-type (doc$ doctor--states))(doctor-remember (list 'you 'were doctor-found))) + (doctor-type (doc$ doctor--states)) (doctor-remember (list 'you 'were doctor-found))) (defun doctor-mood () - (doctor-type (doc$ doctor--moods))(doctor-remember (list 'you 'felt doctor-found))) + (doctor-type (doc$ doctor--moods)) (doctor-remember (list 'you 'felt doctor-found))) (defun doctor-fear () (setq doctor--feared (doctor-setprep doctor-sent doctor-found)) @@ -1511,8 +1511,8 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-svo doctor-sent doctor-found 1 t) (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh)) ((equal doctor-subj 'you) - (doctor-type '(why do you (doc// doctor-verb)(doc// doctor-obj) \?))) - (t (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj)))))) + (doctor-type '(why do you (doc// doctor-verb) (doc// doctor-obj) \?))) + (t (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj)))))) (defun doctor-symptoms () (doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\; @@ -1523,14 +1523,14 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-hates1)) (defun doctor-hates1 () - (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj) \?))) + (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj) \?))) (defun doctor-loves () (doctor-svo doctor-sent doctor-found 1 t) (doctor-qloves)) (defun doctor-qloves () - (doctor-type '((doc$ doctor--bother)(list doctor-subj doctor-verb doctor-obj) \?))) + (doctor-type '((doc$ doctor--bother) (list doctor-subj doctor-verb doctor-obj) \?))) (defun doctor-love () (doctor-svo doctor-sent doctor-found 1 t) @@ -1564,7 +1564,7 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (defun doctor-sexnoun () (doctor-sexverb)) (defun doctor-sexverb () - (if (or (memq 'me doctor-sent)(memq 'myself doctor-sent)(memq 'i doctor-sent)) + (if (or (memq 'me doctor-sent) (memq 'myself doctor-sent) (memq 'i doctor-sent)) (doctor-foul) (doctor-type (doc$ doctor--sexlst)))) diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index 05775c8a85e..a61b52f4ad1 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -282,7 +282,7 @@ and choose the directory as the fortune-file." ;;; ************** ;;; Display fortune -(defun fortune-in-buffer (interactive &optional file) +(defun fortune-in-buffer (_interactive &optional file) "Put a fortune cookie in the *fortune* buffer. INTERACTIVE is ignored. Optional argument FILE, when supplied, specifies the file to choose the fortune from." diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 99e3b487437..e245e70a55c 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -485,12 +485,11 @@ FILE is created there." (defvar gamegrid-shared-game-dir) (defun gamegrid-add-score-with-update-game-score (file score) - (let* ((result nil) ;; What is this good for? -- os - (gamegrid-shared-game-dir - (not (zerop (logand (file-modes - (expand-file-name "update-game-score" - exec-directory)) - #o4000))))) + (let ((gamegrid-shared-game-dir + (not (zerop (logand (file-modes + (expand-file-name "update-game-score" + exec-directory)) + #o4000))))) (cond ((file-name-absolute-p file) (gamegrid-add-score-insecure file score)) ((and gamegrid-shared-game-dir diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index cd353d27f07..4d514d2d0aa 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -258,23 +258,20 @@ This value is simply the outline heading level of the current line." (defun gametree-children-shown-p () (save-excursion - (condition-case nil + (ignore-errors (let ((depth (gametree-current-branch-depth))) (outline-next-visible-heading 1) - (< depth (gametree-current-branch-depth))) - (error nil)))) + (< depth (gametree-current-branch-depth)))))) -(defun gametree-current-layout (depth &optional top-level) +(defun gametree-current-layout (depth &optional from-top-level) (let ((layout nil) (first-time t)) (while (save-excursion - (condition-case nil - (progn - (or (and first-time top-level - (bolp) (looking-at outline-regexp)) - (setq first-time nil) - (outline-next-visible-heading 1)) - (< depth (gametree-current-branch-depth))) - (error nil))) + (ignore-errors + (or (and first-time from-top-level + (bolp) (looking-at outline-regexp)) + (setq first-time nil) + (outline-next-visible-heading 1)) + (< depth (gametree-current-branch-depth)))) (if (not first-time) (outline-next-visible-heading 1)) (setq first-time nil) @@ -297,18 +294,16 @@ This value is simply the outline heading level of the current line." (goto-char (point-min)) (setq gametree-local-layout (gametree-current-layout 0 t)))) -(defun gametree-apply-layout (layout depth &optional top-level) +(defun gametree-apply-layout (layout depth &optional from-top-level) (let ((first-time t)) (while (and layout (save-excursion - (condition-case nil - (progn - (or (and first-time top-level - (bolp) (looking-at outline-regexp)) - (setq first-time nil) - (outline-next-visible-heading 1)) - (< depth (gametree-current-branch-depth))) - (error nil)))) + (ignore-errors + (or (and first-time from-top-level + (bolp) (looking-at outline-regexp)) + (setq first-time nil) + (outline-next-visible-heading 1)) + (< depth (gametree-current-branch-depth))))) (if (not first-time) (outline-next-visible-heading 1)) (setq first-time nil) @@ -375,9 +370,7 @@ Subnodes which have been manually scored are honored." (while (not done) ;handle subheadings (setq running (funcall minmax running (gametree-compute-reduced-score))) - (setq done (condition-case nil - (outline-forward-same-level 1) - (error nil))))) + (setq done (ignore-errors (outline-forward-same-level 1))))) running))))) ;;;; Commands diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index f9d5594cd0b..33fcf451ebb 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -1043,11 +1043,11 @@ If the game is finished, this command requests for another game." (insert-char ?\n gomoku-square-height)) (or (eq (char-after 1) ?.) (put-text-property 1 2 'point-entered - (lambda (x y) (if (bobp) (forward-char))))) + (lambda (_x _y) (if (bobp) (forward-char))))) (or intangible (put-text-property point (point) 'intangible 2)) (put-text-property point (point) 'point-entered - (lambda (x y) (if (eobp) (backward-char)))) + (lambda (_x _y) (if (eobp) (backward-char)))) (put-text-property (point-min) (point) 'category 'gomoku-mode)) (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 601232e4321..70c10da5405 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -67,8 +67,10 @@ ;;; Code: +;; From ps-print.el (defvar ps-printer-name) (defvar ps-lpr-command) +(defvar ps-lpr-switches) ;; Variables @@ -157,8 +159,7 @@ Variables: `handwrite-linespace' (default 12) `handwrite-pagenumbering' (default nil)" (interactive) (let - ((pmin) ; thanks, Havard - (lastp) + (;(pmin) ; thanks, Havard (cur-buf (current-buffer)) (tpoint (point)) (ps-ypos 63) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 767792babb3..ac78a86757c 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -355,7 +355,6 @@ BITS must be of length nrings. Start at START-TIME." (fly-steps (abs (/ (- (cdr to) (cdr from)) fly-step))) (directed-fly-step (/ (- (cdr to) (cdr from)) fly-steps)) (baseward-steps (/ (- (car to) (cdr to)) baseward-step)) - (total-steps (+ flyward-steps fly-steps baseward-steps)) ;; A step is a character cell. A tick is a time-unit. To ;; make horizontal and vertical motion appear roughly the ;; same speed, we allow one tick per horizontal step and two diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index dd32fd790d3..f0e6670fe58 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -943,11 +943,11 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (insert-char ?\n landmark-square-height)) (or (eq (char-after 1) ?.) (put-text-property 1 2 'point-entered - (lambda (x y) (if (bobp) (forward-char))))) + (lambda (_x _y) (if (bobp) (forward-char))))) (or intangible (put-text-property point (point) 'intangible 2)) (put-text-property point (point) 'point-entered - (lambda (x y) (if (eobp) (backward-char)))) + (lambda (_x _y) (if (eobp) (backward-char)))) (put-text-property (point-min) (point) 'category 'landmark-mode)) (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW @@ -1377,11 +1377,11 @@ After this limit is reached, landmark-random-move is called to push him out of i (t x))) (defun landmark-y (direction) - (let ((noise (put direction 'noise (landmark-noise)))) - (put direction 'y_t - (if (> (get direction 's) 0.0) - 1.0 - 0.0)))) + (put direction 'noise (landmark-noise)) + (put direction 'y_t + (if (> (get direction 's) 0.0) + 1.0 + 0.0))) (defun landmark-update-normal-weights (direction) (mapc (lambda (target-direction) @@ -1395,7 +1395,7 @@ After this limit is reached, landmark-random-move is called to push him out of i landmark-directions)) (defun landmark-update-naught-weights (direction) - (mapc (lambda (target-direction) + (mapc (lambda (_target-direction) (put direction 'w0 (landmark-f (+ @@ -1513,7 +1513,7 @@ If the game is finished, this command requests for another game." ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square score) + (let (square) (setq square (landmark-point-square)) (cond ((null square) (error "Your point is not on a square. Retry!")) diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index 269da0a061c..3e1659628f4 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -39,7 +39,7 @@ (defcustom mpuz-silent 'error "Set this to nil if you want dings on inputs. -t means never ding, and `error' means only ding on wrong input." +The value t means never ding, and `error' means only ding on wrong input." :type '(choice (const :tag "No" nil) (const :tag "Yes" t) (const :tag "If correct" error)) @@ -88,33 +88,14 @@ t means never ding, and `error' means only ding on wrong input." (defvar mpuz-mode-map (let ((map (make-sparse-keymap))) - (define-key map "a" 'mpuz-try-letter) - (define-key map "b" 'mpuz-try-letter) - (define-key map "c" 'mpuz-try-letter) - (define-key map "d" 'mpuz-try-letter) - (define-key map "e" 'mpuz-try-letter) - (define-key map "f" 'mpuz-try-letter) - (define-key map "g" 'mpuz-try-letter) - (define-key map "h" 'mpuz-try-letter) - (define-key map "i" 'mpuz-try-letter) - (define-key map "j" 'mpuz-try-letter) - (define-key map "A" 'mpuz-try-letter) - (define-key map "B" 'mpuz-try-letter) - (define-key map "C" 'mpuz-try-letter) - (define-key map "D" 'mpuz-try-letter) - (define-key map "E" 'mpuz-try-letter) - (define-key map "F" 'mpuz-try-letter) - (define-key map "G" 'mpuz-try-letter) - (define-key map "H" 'mpuz-try-letter) - (define-key map "I" 'mpuz-try-letter) - (define-key map "J" 'mpuz-try-letter) + (mapc (lambda (ch) + (define-key map (char-to-string ch) 'mpuz-try-letter)) + "abcdefghijABCDEFGHIJ") (define-key map "\C-g" 'mpuz-offer-abort) (define-key map "?" 'describe-mode) map) "Local keymap to use in Mult Puzzle.") - - (defun mpuz-mode () "Multiplication puzzle mode. @@ -171,7 +152,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." "A permutation from [0..9] to [0..9].") (defvar mpuz-letter-to-digit (make-vector 10 0) - "The inverse of mpuz-digit-to-letter.") + "The inverse of `mpuz-digit-to-letter'.") (defmacro mpuz-to-digit (letter) (list 'aref 'mpuz-letter-to-digit letter)) @@ -198,17 +179,16 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." (defvar mpuz-board (make-vector 10 nil) "The board associates to any digit the list of squares where it appears.") -(defun mpuz-put-number-on-board (number row &rest l) +(defun mpuz-put-number-on-board (number row &rest columns) "Put (last digit of) NUMBER on ROW and COLUMNS of the puzzle board." (let (digit) - (while l + (dolist (column columns) (setq digit (% number 10) - number (/ number 10)) - (aset mpuz-board digit `((,row . ,(car l)) ,@(aref mpuz-board digit))) - (setq l (cdr l))))) + number (/ number 10)) + (aset mpuz-board digit `((,row . ,column) ,@(aref mpuz-board digit)))))) (defun mpuz-check-all-solved (&optional row col) - "Check whether all digits have been solved. Return t if yes." + "Check whether all digits have been solved. Return t if yes." (catch 'solved (let (A B1 B2 C D E squares) (and mpuz-solve-when-trivial @@ -294,7 +274,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." "The general picture of the puzzle screen, as a string.") (defun mpuz-create-buffer () - "Create (or recreate) the puzzle buffer. Return it." + "Create (or recreate) the puzzle buffer. Return it." (let ((buf (get-buffer-create "*Mult Puzzle*")) (face '(face mpuz-text)) buffer-read-only) @@ -425,7 +405,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." "Propose a digit for a letter in puzzle." (interactive) (if mpuz-in-progress - (let (letter-char digit digit-char message) + (let (letter-char digit digit-char) (setq letter-char (upcase last-command-event) digit (mpuz-to-digit (- letter-char ?A))) (cond ((mpuz-digit-solved-p digit) @@ -454,8 +434,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]." "Propose LETTER-CHAR as code for DIGIT-CHAR." (let* ((letter (- letter-char ?A)) (digit (- digit-char ?0)) - (correct-digit (mpuz-to-digit letter)) - (game mpuz-nb-completed-games)) + (correct-digit (mpuz-to-digit letter))) (cond ((mpuz-digit-solved-p correct-digit) (message "%c has already been found." (+ correct-digit ?0))) ((mpuz-digit-solved-p digit) diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index 2fe62ed0e60..722c3b43033 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -126,7 +126,7 @@ the game is over, or off, if you are working on a slow machine." '(solitaire-left solitaire-right solitaire-up solitaire-down)) ;;;###autoload -(defun solitaire (arg) +(defun solitaire (_arg) "Play Solitaire. To play Solitaire, type \\[solitaire]. @@ -393,7 +393,7 @@ which a stone will be taken away) and target." solitaire-valid-directions))) count)))) -(defun solitaire-do-check (&optional arg) +(defun solitaire-do-check (&optional _arg) "Check for any possible moves in Solitaire." (interactive "P") (let ((moves (solitaire-check))) diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 2935ff04c96..053b07adfc7 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -193,32 +193,32 @@ If the return value is a number, it is used as the timer period." ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst tetris-shapes - [[[[0 0] [1 0] [0 1] [1 1]]] - - [[[0 0] [1 0] [2 0] [2 1]] - [[1 -1] [1 0] [1 1] [0 1]] - [[0 -1] [0 0] [1 0] [2 0]] - [[1 -1] [2 -1] [1 0] [1 1]]] - - [[[0 0] [1 0] [2 0] [0 1]] - [[0 -1] [1 -1] [1 0] [1 1]] - [[2 -1] [0 0] [1 0] [2 0]] - [[1 -1] [1 0] [1 1] [2 1]]] - - [[[0 0] [1 0] [1 1] [2 1]] + [[[[0 0] [1 0] [0 1] [1 1]]] + + [[[0 0] [1 0] [2 0] [2 1]] + [[1 -1] [1 0] [1 1] [0 1]] + [[0 -1] [0 0] [1 0] [2 0]] + [[1 -1] [2 -1] [1 0] [1 1]]] + + [[[0 0] [1 0] [2 0] [0 1]] + [[0 -1] [1 -1] [1 0] [1 1]] + [[2 -1] [0 0] [1 0] [2 0]] + [[1 -1] [1 0] [1 1] [2 1]]] + + [[[0 0] [1 0] [1 1] [2 1]] [[1 0] [0 1] [1 1] [0 2]]] - - [[[1 0] [2 0] [0 1] [1 1]] - [[0 0] [0 1] [1 1] [1 2]]] - - [[[1 0] [0 1] [1 1] [2 1]] - [[1 0] [1 1] [2 1] [1 2]] - [[0 1] [1 1] [2 1] [1 2]] + + [[[1 0] [2 0] [0 1] [1 1]] + [[0 0] [0 1] [1 1] [1 2]]] + + [[[1 0] [0 1] [1 1] [2 1]] + [[1 0] [1 1] [2 1] [1 2]] + [[0 1] [1 1] [2 1] [1 2]] [[1 0] [0 1] [1 1] [1 2]]] - + [[[0 0] [1 0] [2 0] [3 0]] [[1 -1] [1 0] [1 1] [1 2]]]] - "Each shape is described by a vector that contains the coordinates of + "Each shape is described by a vector that contains the coordinates of each one of its four blocks.") ;;the scoring rules were taken from "xtetris". Blocks score differently @@ -236,7 +236,7 @@ each one of its four blocks.") (defconst tetris-space 9) -(defun tetris-default-update-speed-function (shapes rows) +(defun tetris-default-update-speed-function (_shapes rows) (/ 20.0 (+ 50.0 rows))) ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -380,10 +380,10 @@ each one of its four blocks.") (loop for i from 0 to 3 do (let ((c (tetris-get-shape-cell i))) (gamegrid-set-cell (+ tetris-top-left-x - tetris-pos-x + tetris-pos-x (aref c 0)) (+ tetris-top-left-y - tetris-pos-y + tetris-pos-y (aref c 1)) tetris-blank)))) @@ -393,14 +393,14 @@ each one of its four blocks.") (unless hit (setq hit (let* ((c (tetris-get-shape-cell i)) - (xx (+ tetris-pos-x + (xx (+ tetris-pos-x (aref c 0))) - (yy (+ tetris-pos-y + (yy (+ tetris-pos-y (aref c 1)))) (or (>= xx tetris-width) (>= yy tetris-height) - (/= (gamegrid-get-cell - (+ xx tetris-top-left-x) + (/= (gamegrid-get-cell + (+ xx tetris-top-left-x) (+ yy tetris-top-left-y)) tetris-blank)))))) hit)) @@ -537,10 +537,10 @@ Drops the shape one square, testing for collision." (interactive) (unless tetris-paused (tetris-erase-shape) - (setq tetris-rot (% (+ 1 tetris-rot) + (setq tetris-rot (% (+ 1 tetris-rot) (tetris-shape-rotations))) (if (tetris-test-shape) - (setq tetris-rot (% (+ 3 tetris-rot) + (setq tetris-rot (% (+ 3 tetris-rot) (tetris-shape-rotations)))) (tetris-draw-shape))) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 75c3b6fbc7d..d194a8af919 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -626,6 +626,8 @@ If the element is a function or a list of a function and a number, "*Seconds to wait between successive `life' generations. If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).") +(defvar life-patterns) ; from life.el + (defun zone-pgm-random-life () (require 'life) (zone-fill-out-screen (1- (window-width)) (1- (window-height))) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index beb737ba613..89a37307506 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -966,7 +966,7 @@ are treated as numbers instead of gnatprep comments." (unless modified (restore-buffer-modified-p nil)))) -(defun ada-after-change-function (beg end old-len) +(defun ada-after-change-function (beg end _old-len) "Called when the region between BEG and END was changed in the buffer. OLD-LEN indicates what the length of the replaced text was." (save-excursion @@ -1675,7 +1675,7 @@ ARG is the prefix the user entered with \\[universal-argument]." '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) -(defun ada-loose-case-word (&optional arg) +(defun ada-loose-case-word (&optional _arg) "Upcase first letter and letters following `_' in the following word. No other letter is modified. ARG is ignored, and is there for compatibility with `capitalize-word' only." @@ -1691,7 +1691,7 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only." (insert-char (upcase (following-char)) 1) (delete-char 1))))) -(defun ada-no-auto-case (&optional arg) +(defun ada-no-auto-case (&optional _arg) "Do nothing. ARG is ignored. This function can be used for the auto-casing variables in Ada mode, to adapt to unusal auto-casing schemes. Since it does nothing, you can for @@ -1700,7 +1700,7 @@ auto-casing for identifiers, whereas keywords have to be lower-cased. See also `ada-auto-case' to disable auto casing altogether." nil) -(defun ada-capitalize-word (&optional arg) +(defun ada-capitalize-word (&optional _arg) "Upcase first letter and letters following '_', lower case other letters. ARG is ignored, and is there for compatibility with `capitalize-word' only." (interactive) @@ -4219,7 +4219,7 @@ of the region. Otherwise, operate only on the current line." ((eq ada-tab-policy 'always-tab) (error "Not implemented")) )) -(defun ada-untab (arg) +(defun ada-untab (_arg) "Delete leading indenting according to `ada-tab-policy'." ;; FIXME: ARG is ignored (interactive "P") @@ -5250,7 +5250,7 @@ Return nil if no body was found." ;; Support for narrow-to-region ;; --------------------------------------------------------- -(defun ada-narrow-to-defun (&optional arg) +(defun ada-narrow-to-defun (&optional _arg) "Make text outside current subprogram invisible. The subprogram visible is the one that contains or follow point. Optional ARG is ignored. diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index dd05ab8f310..a32e22828fc 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -92,7 +92,7 @@ If there is none, opens a new project file." (ada-customize) (ada-prj-new))) -(defun ada-prj-initialize-values (symbol ada-buffer filename) +(defun ada-prj-initialize-values (symbol _ada-buffer filename) "Set SYMBOL to the property list of the project file FILENAME. If FILENAME is null, read the file associated with ADA-BUFFER. If no project file is found, return the default values." @@ -257,19 +257,19 @@ The current buffer must be the project editing buffer." (widget-insert "\n Project configuration.\n ___________ ____________ ____________ ____________ ____________\n / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 1)) "General") + (lambda (&rest _dummy) (ada-prj-display-page 1)) "General") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths") + (lambda (&rest _dummy) (ada-prj-display-page 2)) "Paths") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches") + (lambda (&rest _dummy) (ada-prj-display-page 3)) "Switches") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu") + (lambda (&rest _dummy) (ada-prj-display-page 4)) "Ada Menu") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 5)) "Debugger") + (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger") (widget-insert " \\\n") ;; Display the currently selected page @@ -458,15 +458,15 @@ connect to the target when working with cross-environments" t) (widget-insert "______________________________________________________________________\n\n ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (setq ada-prj-current-values (ada-default-prj-properties)) (ada-prj-display-page 1)) "Reset to Default Values") (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil)) + (widget-create 'push-button :notify (lambda (&rest _ignore) (kill-buffer nil)) "Cancel") (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save)) + (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save)) "Save") (widget-insert "\n\n") @@ -546,7 +546,7 @@ converted to a directory name." ada-list "\n")) -(defun ada-prj-field-modified (widget &rest dummy) +(defun ada-prj-field-modified (widget &rest _dummy) "Callback for modification of WIDGET. Remaining args DUMMY are ignored. Save the change in `ada-prj-current-values' so that selecting @@ -556,7 +556,7 @@ another page and coming back keeps the new value." (widget-get widget ':prj-field) (widget-value widget)))) -(defun ada-prj-display-help (widget widget-modified event) +(defun ada-prj-display-help (widget _widget-modified event) "Callback for help button in WIDGET. Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (let ((text (widget-get widget 'prj-help))) @@ -572,7 +572,7 @@ Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (concat "*****Help*****\n" text "\n**************\n") (point-at-bol 2))))) -(defun ada-prj-show-value (widget widget-modified event) +(defun ada-prj-show-value (widget _widget-modified event) "Show the current field value in WIDGET. Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (let* ((field (widget-get widget ':prj-field)) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 85659cafd95..7751f3e98fc 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1043,7 +1043,7 @@ existing buffer `*gnatfind*', if there is one." (setq old-contents (buffer-string)))) (let ((compilation-error "reference")) - (compilation-start command 'compilation-mode (lambda (mode) ada-gnatfind-buffer-name))) + (compilation-start command 'compilation-mode (lambda (_mode) ada-gnatfind-buffer-name))) ;; Hide the "Compilation" menu (with-current-buffer ada-gnatfind-buffer-name @@ -1384,7 +1384,7 @@ project file." ;; Do not add -fullname, since we can have a 'rsh' command in front. ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef - (fset 'gud-gdb-massage-args (lambda (file args) args)) + (fset 'gud-gdb-massage-args (lambda (_file args) args)) (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) (if (not (equal pre-cmd "")) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index c5207139014..d1ff1aead10 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -82,7 +82,7 @@ ;;; Code: -(eval-when-compile +(eval-when-compile (require 'cl)) (require 'easymenu) @@ -93,7 +93,7 @@ (declare-function cond-emacs-xemacs-macfn "antlr-mode" (args &optional msg)) ;; General Emacs/XEmacs-compatibility compile-time macros -(eval-when-compile +(eval-when-compile (defmacro cond-emacs-xemacs (&rest args) (cond-emacs-xemacs-macfn args "`cond-emacs-xemacs' must return exactly one element")) @@ -1073,7 +1073,7 @@ Used for `antlr-slow-syntactic-context'.") (read-from-minibuffer prompt initial-input nil nil (or history 'shell-command-history))) -(defunx antlr-with-displaying-help-buffer (thunk &optional name) +(defunx antlr-with-displaying-help-buffer (thunk &optional _name) :xemacs-and-try with-displaying-help-buffer "Make a help buffer and call `thunk' there." (with-output-to-temp-buffer "*Help*" @@ -1092,7 +1092,7 @@ Used for `antlr-slow-syntactic-context'.") ;;;(defvar antlr-statistics-cache 0) ;;;(defvar antlr-statistics-inval 0) -(defunx antlr-invalidate-context-cache (&rest dummies) +(defunx antlr-invalidate-context-cache (&rest _dummies) ;; checkdoc-params: (dummies) "Invalidate context cache for syntactical context information." :XEMACS ; XEmacs bug workaround @@ -1670,7 +1670,7 @@ Return \(LEVEL OPTION LOCATION)." table))) (list level input (cdr kind)))))) -(defun antlr-options-menu-filter (level menu-items) +(defun antlr-options-menu-filter (level _menu-items) "Return items for options submenu of level LEVEL." ;; checkdoc-params: (menu-items) (let ((active (if buffer-read-only @@ -2072,7 +2072,7 @@ Used inside `antlr-options-alists'." nil table '(("false") ("true")))) -(defun antlr-language-option-extra (phase &rest dummies) +(defun antlr-language-option-extra (phase &rest _dummies) ;; checkdoc-params: (dummies) "Change language according to the new value of the \"language\" option. Call `antlr-mode' if the new language would be different from the value @@ -2088,7 +2088,7 @@ Called in PHASE `after-insertion', see `antlr-options-alists'." (antlr-mode) (and font-lock (null font-lock-mode) (font-lock-mode 1))))))) -(defun antlr-c++-mode-extra (phase option &rest dummies) +(defun antlr-c++-mode-extra (phase option &rest _dummies) ;; checkdoc-params: (option dummies) "Warn if C++ option is used with the wrong language. Ask user \(\"y or n\"), if a C++ only option is going to be inserted but @@ -2260,7 +2260,7 @@ called interactively, the buffers are always saved, see also variable (or saved (save-some-buffers (not antlr-ask-about-save))) (let ((default-directory (file-name-directory file))) (compilation-start (concat command " " (file-name-nondirectory file)) - nil #'(lambda (mode-name) "*Antlr-Run*")))) + nil (lambda (_mode-name) "*Antlr-Run*")))) (defun antlr-run-tool-interactive () ;; code in `interactive' is not compiled @@ -2592,7 +2592,7 @@ the default language." ;; FIXME: Since it uses cc-mode, it bumps into c-update-modeline's ;; limitation to mode-name being a string. ;; '("Antlr." (:eval (cadr (assq antlr-language antlr-language-alist)))) - "Antlr" + "Antlr" "Major mode for editing ANTLR grammar files." :abbrev-table antlr-mode-abbrev-table (c-initialize-cc-mode) ; cc-mode is required diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 9d79d22d42e..3ac8b119fe1 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -90,7 +90,7 @@ "Keymap for Asm mode.") (defconst asm-font-lock-keywords - (append + (append '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\(\\.\\sw+\\)*\\)?" (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t)) ;; label started from ".". diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 4d78047268f..8ec379afab2 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -109,7 +109,7 @@ so that it is considered safe, see `enable-local-variables'.") (funcall bug-reference-url-format)))))))))) ;; Taken from button.el. -(defun bug-reference-push-button (&optional pos use-mouse-action) +(defun bug-reference-push-button (&optional pos _use-mouse-action) "Open URL corresponding to the bug reference at POS." (interactive (list (if (integerp last-command-event) (point) last-command-event))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 5ef12300195..0eec54fab6f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6475,7 +6475,7 @@ comment at the start of cc-engine.el for more info." ;; `c-font-lock-declarators'.) (while (and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) - (match-beginning 2)) + (match-beginning 3)) ;; If the second submatch matches in C++ then ;; we're looking at an identifier that's a ;; prefix only if it specifies a member pointer. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 40383c6bc31..ec0830b3b1b 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -833,7 +833,7 @@ returned RES, i.e. there is no change of `compilation-directory' between POS and RES.") (make-variable-buffer-local 'compilation--previous-directory-cache) -(defun compilation--flush-directory-cache (start end) +(defun compilation--flush-directory-cache (start _end) (cond ((or (not compilation--previous-directory-cache) (<= (car compilation--previous-directory-cache) start))) @@ -1307,7 +1307,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (compilation--parse-region (point) compilation--parsed))))) nil) -(defun compilation--flush-parse (start end) +(defun compilation--flush-parse (start _end) "Mark the region between START and END for re-parsing." (if (markerp compilation--parsed) (move-marker compilation--parsed (min start compilation--parsed)))) @@ -1399,31 +1399,31 @@ point on its location in the *compilation* buffer." :group 'compilation) -(defun compilation-buffer-name (mode-name mode-command name-function) +(defun compilation-buffer-name (name-of-mode mode-command name-function) "Return the name of a compilation buffer to use. -If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME +If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE to determine the buffer name. Likewise if `compilation-buffer-name-function' is non-nil. If current buffer has the major mode MODE-COMMAND, return the name of the current buffer, so that it gets reused. -Otherwise, construct a buffer name from MODE-NAME." +Otherwise, construct a buffer name from NAME-OF-MODE." (cond (name-function - (funcall name-function mode-name)) + (funcall name-function name-of-mode)) (compilation-buffer-name-function - (funcall compilation-buffer-name-function mode-name)) + (funcall compilation-buffer-name-function name-of-mode)) ((eq mode-command major-mode) (buffer-name)) (t - (concat "*" (downcase mode-name) "*")))) + (concat "*" (downcase name-of-mode) "*")))) ;; This is a rough emulation of the old hack, until the transition to new ;; compile is complete. (defun compile-internal (command error-message - &optional name-of-mode parser + &optional _name-of-mode parser error-regexp-alist name-function - enter-regexp-alist leave-regexp-alist - file-regexp-alist nomessage-regexp-alist - no-async highlight-regexp local-map) + _enter-regexp-alist _leave-regexp-alist + file-regexp-alist _nomessage-regexp-alist + _no-async highlight-regexp _local-map) (if parser (error "Compile now works very differently, see `compilation-error-regexp-alist'")) (let ((compilation-error-regexp-alist @@ -2229,7 +2229,7 @@ This is the value of `next-error-function' in Compilation buffers." (when reset (setq compilation-current-error nil)) (let* ((columns compilation-error-screen-columns) ; buffer's local value - (last 1) timestamp + (last 1) (msg (compilation-next-error (or n 1) nil (or compilation-current-error compilation-messages-start diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index d7b8b0e8748..a8f01705e2d 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -308,7 +308,6 @@ A prefix arg suppresses display of that buffer." ;; Pop top of cpp-state-stack and create overlay. (let ((entry (assoc (nth 1 (car cpp-state-stack)) cpp-edit-list)) (branch (nth 0 (car cpp-state-stack))) - (begin (nth 2 (car cpp-state-stack))) (end (nth 3 (car cpp-state-stack)))) (setq cpp-state-stack (cdr cpp-state-stack)) (if entry @@ -398,7 +397,7 @@ A prefix arg suppresses display of that buffer." (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay)) (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay))) -(defun cpp-signal-read-only (overlay after start end &optional len) +(defun cpp-signal-read-only (overlay after start end &optional _len) ;; Only allow deleting the whole overlay. ;; Trying to change a read-only overlay. (if (and (not after) @@ -406,7 +405,7 @@ A prefix arg suppresses display of that buffer." (> (overlay-end overlay) end))) (error "This text is read only"))) -(defun cpp-grow-overlay (overlay after start end &optional len) +(defun cpp-grow-overlay (overlay after start end &optional _len) ;; Make OVERLAY grow to contain range START to END. (if after (move-overlay overlay diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 902848ef007..b4094914d61 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -662,8 +662,7 @@ There is some minimal font-lock support (see vars (defun dcl-end-of-command () "Move point to end of current command or next command if not on a command." (interactive) - (let ((type (dcl-get-line-type)) - (start (point))) + (let ((type (dcl-get-line-type))) (if (or (eq type '$) (eq type '-)) (progn @@ -941,7 +940,7 @@ Returns one of the following symbols: ;;;--------------------------------------------------------------------------- (defun dcl-calc-command-indent-multiple - (indent-type cur-indent extra-indent last-point this-point) + (indent-type cur-indent extra-indent _last-point _this-point) "Indent lines to a multiple of dcl-basic-offset. Set dcl-calc-command-indent-function to this function to customize @@ -1185,7 +1184,7 @@ The indent-type classification could probably be expanded upon. ;;;--------------------------------------------------------------------------- -(defun dcl-calc-cont-indent-relative (cur-indent extra-indent) +(defun dcl-calc-cont-indent-relative (_cur-indent _extra-indent) "Indent continuation lines to align with words on previous line. Indent continuation lines to a position relative to preceding @@ -1540,7 +1539,7 @@ Also remove the continuation mark if easily detected." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-basic (option-assoc) +(defun dcl-option-value-basic (_option-assoc) "Guess a value for basic-offset." (save-excursion (dcl-beginning-of-command) @@ -1575,7 +1574,7 @@ Also remove the continuation mark if easily detected." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-offset (option-assoc) +(defun dcl-option-value-offset (_option-assoc) "Guess a value for an offset. Find the column of the first non-blank character on the line. Returns the column offset." @@ -1586,7 +1585,7 @@ Returns the column offset." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-margin-offset (option-assoc) +(defun dcl-option-value-margin-offset (_option-assoc) "Guess a value for margin offset. Find the column of the first non-blank character on the line, not counting labels. @@ -1598,7 +1597,7 @@ Returns a number as a string." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-comment-line (option-assoc) +(defun dcl-option-value-comment-line (_option-assoc) "Guess a value for `dcl-comment-line-regexp'. Must return a string." ;; Should we set comment-start and comment-start-skip as well? @@ -1789,8 +1788,7 @@ Set or update the value of VAR in the current buffers (if (eolp) (error "Missing colon in local variables entry")) (skip-chars-backward " \t") (let* ((str (buffer-substring beg (point))) - (found-var (read str)) - val) + (found-var (read str))) ;; Setting variable named "end" means end of list. (if (string-equal (downcase str) "end") (progn @@ -1895,6 +1893,10 @@ section at the end of the current buffer." ;;;------------------------------------------------------------------------- +(with-no-warnings + ;; Dynamically bound in `dcl-save-mode'. + (defvar mode)) + (defun dcl-save-mode () "Save the current mode for this buffer. Save the current mode in a `Local Variables:' @@ -1902,7 +1904,7 @@ section at the end of the current buffer." (interactive) (let ((mode (prin1-to-string major-mode))) (if (string-match "-mode$" mode) - (let ((mode (intern (substring mode 0 (match-beginning 0))))) + (let ((mode (intern (substring mode 0 (match-beginning 0))))) (dcl-save-option 'mode)) (message "Strange mode: %s" mode)))) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 0f823c806e0..c809079381f 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -328,7 +328,7 @@ routine.") (after-change-functions nil) (modified (buffer-modified-p))) ;; Disable any queries about editing obsolete files. - (fset 'ask-user-about-supersession-threat (lambda (fn))) + (fset 'ask-user-about-supersession-threat (lambda (_fn))) (unwind-protect (progn ,@forms) (set-buffer-modified-p modified) @@ -444,6 +444,12 @@ routine.") (goto-char curr-point) next)) +(defvar delphi-ignore-changes t + "Internal flag to control if the Delphi mode responds to buffer changes. +Defaults to t in case the `delphi-after-change' function is called on a +non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: + (let ((delphi-ignore-changes t)) ...)") + (defun delphi-set-text-properties (from to properties) ;; Like `set-text-properties', except we do not consider this to be a buffer ;; modification. @@ -590,7 +596,6 @@ routine.") ;; character set. (let ((currp (point)) (end nil) - (start nil) (token nil)) (goto-char p) (when (> (skip-chars-forward charset) 0) @@ -720,13 +725,7 @@ routine.") (delphi-step-progress p "Fontifying" delphi-fontifying-progress-step)) (delphi-progress-done))))) -(defvar delphi-ignore-changes t - "Internal flag to control if the Delphi mode responds to buffer changes. -Defaults to t in case the `delphi-after-change' function is called on a -non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: - (let ((delphi-ignore-changes t)) ...)") - -(defun delphi-after-change (change-start change-end old-length) +(defun delphi-after-change (change-start change-end _old-length) ;; Called when the buffer has changed. Reparses the changed region. (unless delphi-ignore-changes (let ((delphi-ignore-changes t)) ; Prevent recursive calls. @@ -922,8 +921,7 @@ non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: ;; Returns the token of the if or case statement. (let ((token (delphi-previous-token from-else)) (token-kind nil) - (semicolon-count 0) - (if-count 0)) + (semicolon-count 0)) (catch 'done (while token (setq token-kind (delphi-token-kind token)) @@ -971,8 +969,7 @@ non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: comment ;; Scan until we run out of // comments. (let ((prev-comment comment) - (start-comment comment) - (kind nil)) + (start-comment comment)) (while (let ((kind (delphi-token-kind prev-comment))) (cond ((eq kind 'space)) ((eq kind 'comment-single-line) @@ -989,8 +986,7 @@ non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: comment ;; Scan until we run out of // comments. (let ((next-comment comment) - (end-comment comment) - (kind nil)) + (end-comment comment)) (while (let ((kind (delphi-token-kind next-comment))) (cond ((eq kind 'space)) ((eq kind 'comment-single-line) @@ -1527,7 +1523,6 @@ If before the indent, the point is moved to the indent." (interactive) (delphi-save-match-data (let ((marked-point (point-marker)) ; Maintain our position reliably. - (new-point nil) (line-start nil) (old-indent 0) (new-indent 0)) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 87e5875c943..d31a46cc308 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -736,7 +736,7 @@ MARKED-ONLY non-nil means include marked classes only." "Return a list containing all files mentioned in a tree. MARKED-ONLY non-nil means include marked classes only." (let (list) - (maphash #'(lambda (file dummy) (setq list (cons file list))) + (maphash (lambda (file _dummy) (setq list (cons file list))) (ebrowse-files-table marked-only)) list)) @@ -784,9 +784,9 @@ The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." (defun ebrowse-sort-tree-list (list) "Sort a LIST of `ebrowse-ts' structures by qualified class names." (sort list - #'(lambda (a b) - (string< (ebrowse-qualified-class-name (ebrowse-ts-class a)) - (ebrowse-qualified-class-name (ebrowse-ts-class b)))))) + (lambda (a b) + (string< (ebrowse-qualified-class-name (ebrowse-ts-class a)) + (ebrowse-qualified-class-name (ebrowse-ts-class b)))))) (defun ebrowse-class-in-tree (class tree) @@ -923,7 +923,7 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree." (list header tree))) -(defun ebrowse-revert-tree-buffer-from-file (ignore-auto-save noconfirm) +(defun ebrowse-revert-tree-buffer-from-file (_ignore-auto-save noconfirm) "Function installed as `revert-buffer-function' in tree buffers. See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and NOCONFIRM." @@ -937,11 +937,11 @@ NOCONFIRM." (current-buffer))) -(defun ebrowse-create-tree-buffer (tree tags-file header obarray pop) +(defun ebrowse-create-tree-buffer (tree tags-file header classes pop) "Create a new tree buffer for tree TREE. The tree was loaded from file TAGS-FILE. HEADER is the header structure of the file. -OBARRAY is an obarray with a symbol for each class in the tree. +CLASSES is an obarray with a symbol for each class in the tree. POP non-nil means popup the buffer up at the end. Return the buffer created." (let ((name ebrowse-tree-buffer-name)) @@ -949,7 +949,7 @@ Return the buffer created." (ebrowse-tree-mode) (setq ebrowse--tree tree ebrowse--tags-file-name tags-file - ebrowse--tree-obarray obarray + ebrowse--tree-obarray classes ebrowse--header header ebrowse--frozen-flag nil) (ebrowse-redraw-tree) @@ -1215,17 +1215,16 @@ Do not ask for confirmation if FORCED is non-nil." "Toggle mark for class cursor is on. If given a numeric N-TIMES argument, mark that many classes." (interactive "p") - (let (to-change pnt) + (let (to-change) ;; Get the classes whose mark must be toggled. Note that ;; ebrowse-tree-at-point might issue an error. - (condition-case error - (loop repeat (or n-times 1) - as tree = (ebrowse-tree-at-point) - do (progn - (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) - (forward-line 1) - (push tree to-change))) - (error nil)) + (ignore-errors + (loop repeat (or n-times 1) + as tree = (ebrowse-tree-at-point) + do (progn + (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) + (forward-line 1) + (push tree to-change)))) (save-excursion ;; For all these classes, reverse the mark char in the display ;; by a regexp replace over the whole buffer. The reason for this @@ -1376,9 +1375,9 @@ one buffer. Prefer tree buffers over member buffers." (defun ebrowse-same-tree-member-buffer-list () "Return a list of members buffers with same tree as current buffer." (ebrowse-delete-if-not - #'(lambda (buffer) - (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) - ebrowse--tree)) + (lambda (buffer) + (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) + ebrowse--tree)) (ebrowse-member-buffer-list))) @@ -1417,9 +1416,9 @@ If no member buffer exists, make one." when (eq class tree) do (kill-buffer buffer))) -(defun ebrowse-frozen-tree-buffer-name (tags-file-name) - "Return the buffer name of a tree which is associated TAGS-FILE-NAME." - (concat ebrowse-tree-buffer-name " (" tags-file-name ")")) +(defun ebrowse-frozen-tree-buffer-name (tags-file) + "Return the buffer name of a tree which is associated TAGS-FILE." + (concat ebrowse-tree-buffer-name " (" tags-file ")")) (defun ebrowse-pop-to-browser-buffer (arg) @@ -1545,41 +1544,41 @@ VIEW non-nil means view it. WHERE is additional position info." where))) -(defun ebrowse-find-class-declaration (prefix-arg) +(defun ebrowse-find-class-declaration (prefix) "Find a class declaration and position cursor on it. -PREFIX-ARG 4 means find it in another window. -PREFIX-ARG 5 means find it in another frame." +PREFIX 4 means find it in another window. +PREFIX 5 means find it in another frame." (interactive "p") (ebrowse-view/find-class-declaration :view nil - :where (cond ((= prefix-arg 4) 'other-window) - ((= prefix-arg 5) 'other-frame) - (t 'this-window)))) + :where (cond ((= prefix 4) 'other-window) + ((= prefix 5) 'other-frame) + (t 'this-window)))) -(defun ebrowse-view-class-declaration (prefix-arg) +(defun ebrowse-view-class-declaration (prefix) "View class declaration and position cursor on it. -PREFIX-ARG 4 means view it in another window. -PREFIX-ARG 5 means view it in another frame." +PREFIX 4 means view it in another window. +PREFIX 5 means view it in another frame." (interactive "p") (ebrowse-view/find-class-declaration :view 'view - :where (cond ((= prefix-arg 4) 'other-window) - ((= prefix-arg 5) 'other-frame) - (t 'this-window)))) + :where (cond ((= prefix 4) 'other-window) + ((= prefix 5) 'other-frame) + (t 'this-window)))) ;;; The FIND engine -(defun ebrowse-find-source-file (file tags-file-name) +(defun ebrowse-find-source-file (file tags-file) "Find source file FILE. -Source files are searched for (a) relative to TAGS-FILE-NAME +Source files are searched for (a) relative to TAGS-FILE which is the path of the BROWSE file from which the class tree was loaded, and (b) in the directories named in `ebrowse-search-path'." (let (file-name (try-file (expand-file-name file - (file-name-directory tags-file-name)))) + (file-name-directory tags-file)))) (if (file-readable-p try-file) (setq file-name try-file) (let ((search-in ebrowse-search-path)) @@ -1629,7 +1628,7 @@ The new frame is deleted when you quit viewing the file in that frame." 'ebrowse-view-exit-fn))) (defun ebrowse-view/find-file-and-search-pattern - (struc info file tags-file-name &optional view where) + (struc info file tags-file &optional view where) "Find or view a member or class. STRUC is an `ebrowse-bs' structure (or a structure including that) describing what to search. @@ -1641,7 +1640,7 @@ if MEMBER-OR-CLASS is an `ebrowse-ms'. FILE is the file to search the member in. FILE is not taken out of STRUC here because the filename in STRUC may be nil in which case the filename of the class description is used. -TAGS-FILE-NAME is the name of the BROWSE file from which the +TAGS-FILE is the name of the BROWSE file from which the tree was loaded. If VIEW is non-nil, view file else find the file. WHERE is either `other-window', `other-frame' or `this-window' and @@ -1650,7 +1649,7 @@ specifies where to find/view the result." (error "Sorry, no file information available for %s" (ebrowse-bs-name struc))) ;; Get the source file to view or find. - (setf file (ebrowse-find-source-file file tags-file-name)) + (setf file (ebrowse-find-source-file file tags-file)) ;; If current window is dedicated, use another frame. (when (window-dedicated-p (selected-window)) (setf where 'other-window)) @@ -2538,7 +2537,7 @@ find file in another frame." (defun* ebrowse-view/find-member-declaration/definition - (prefix view &optional definition info header tags-file-name) + (prefix view &optional definition info header tags-file) "Find or view a member declaration or definition. With PREFIX 4. find file in another window, with prefix 5 find file in another frame. @@ -2546,11 +2545,11 @@ DEFINITION non-nil means find the definition, otherwise find the declaration. INFO is a list (TREE ACCESSOR MEMBER) describing the member to search. -TAGS-FILE-NAME is the file name of the BROWSE file." +TAGS-FILE is the file name of the BROWSE file." (unless header (setq header ebrowse--header)) - (unless tags-file-name - (setq tags-file-name ebrowse--tags-file-name)) + (unless tags-file + (setq tags-file ebrowse--tags-file-name)) (let (tree member accessor file on-class (where (if (= prefix 4) 'other-window (if (= prefix 5) 'other-frame 'this-window)))) @@ -2570,7 +2569,7 @@ TAGS-FILE-NAME is the file name of the BROWSE file." (ebrowse-ts-class tree) (list ebrowse--header (ebrowse-ts-class tree) nil) (ebrowse-cs-file (ebrowse-ts-class tree)) - tags-file-name view where))) + tags-file view where))) ;; For some member lists, it doesn't make sense to search for ;; a definition. If this is requested, silently search for the ;; declaration. @@ -2607,7 +2606,7 @@ TAGS-FILE-NAME is the file name of the BROWSE file." (message nil) ;; Recurse with new info. (ebrowse-view/find-member-declaration/definition - prefix view (not definition) info header tags-file-name)) + prefix view (not definition) info header tags-file)) (error "Search canceled")) ;; Find that thing. (ebrowse-view/find-file-and-search-pattern @@ -2618,7 +2617,7 @@ TAGS-FILE-NAME is the file name of the BROWSE file." :point (ebrowse-ms-point member)) (list header member accessor) file - tags-file-name + tags-file view where)))) @@ -2677,7 +2676,7 @@ LIST is the member list to display. STAND-ALONE non-nil means the member buffer is standalone. CLASS is its class." (let* ((classes ebrowse--tree-obarray) (tree ebrowse--tree) - (tags-file-name ebrowse--tags-file-name) + (tags-file ebrowse--tags-file-name) (header ebrowse--header) temp-buffer-setup-hook (temp-buffer (get-buffer ebrowse-member-buffer-name))) @@ -2697,7 +2696,7 @@ means the member buffer is standalone. CLASS is its class." ebrowse--accessor list ebrowse--tree-obarray classes ebrowse--frozen-flag stand-alone - ebrowse--tags-file-name tags-file-name + ebrowse--tags-file-name tags-file ebrowse--header header ebrowse--tree tree buffer-read-only t) @@ -2849,7 +2848,7 @@ is nil." ;;; Switching member buffer to display a selected member -(defun ebrowse-goto-visible-member/all-member-lists (prefix) +(defun ebrowse-goto-visible-member/all-member-lists (_prefix) "Position cursor on a member read from the minibuffer. With PREFIX, search all members in the tree. Otherwise consider only members visible in the buffer." @@ -3279,7 +3278,7 @@ HEADER is the `ebrowse-hs' structure of the class tree. Prompt with PROMPT. Insert into the minibuffer a C++ identifier read from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." (save-excursion - (let* (start member-info (members (ebrowse-member-table header))) + (let ((members (ebrowse-member-table header))) (multiple-value-bind (class-name member-name) (values-list (ebrowse-tags-read-member+class-name)) (unless member-name @@ -3290,7 +3289,7 @@ from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." (completion-result (try-completion name members))) ;; Cannot rely on `try-completion' returning t for exact ;; matches! It returns the name as a string. - (unless (setq member-info (gethash name members)) + (unless (gethash name members) (if (y-or-n-p "No exact match found. Try substrings? ") (setq name (or (first (ebrowse-list-of-matching-members @@ -3316,7 +3315,7 @@ MEMBER-NAME is the name of the member found." (list class name)))) -(defun ebrowse-tags-choose-class (tree header name initial-class-name) +(defun ebrowse-tags-choose-class (_tree header name initial-class-name) "Read a class name for a member from the minibuffer. TREE is the class tree we operate on. HEADER is its header structure. @@ -3354,7 +3353,7 @@ definition." info) (unless name (multiple-value-setq (class-name name) - (values-list + (values-list (ebrowse-tags-read-name header (concat (if view "View" "Find") " member " @@ -3481,7 +3480,7 @@ Otherwise read a member name from point." (let* ((marker (point-marker)) class-name (name fix-name) info) (unless name (multiple-value-setq (class-name name) - (values-list + (values-list (ebrowse-tags-read-name header (concat "Find member list of: "))))) (setq info (ebrowse-tags-choose-class tree header name class-name)) @@ -3495,10 +3494,10 @@ Both NAME and REGEXP may be nil in which case exact or regexp matches are not performed." (let (list) (when (or name regexp) - (maphash #'(lambda (member-name info) - (when (or (and name (string= name member-name)) - (and regexp (string-match regexp member-name))) - (setq list (cons member-name list)))) + (maphash (lambda (member-name _info) + (when (or (and name (string= name member-name)) + (and regexp (string-match regexp member-name))) + (setq list (cons member-name list)))) members)) list)) @@ -3535,18 +3534,18 @@ The file name is read from the minibuffer." (with-output-to-temp-buffer (concat "*Members in file " file "*") (set-buffer standard-output) (maphash - #'(lambda (member-name list) - (loop for info in list - as member = (third info) - as class = (ebrowse-ts-class (first info)) - when (or (and (null (ebrowse-ms-file member)) - (string= (ebrowse-cs-file class) file)) - (string= file (ebrowse-ms-file member))) - do (ebrowse-draw-file-member-info info "decl.") - when (or (and (null (ebrowse-ms-definition-file member)) - (string= (ebrowse-cs-source-file class) file)) - (string= file (ebrowse-ms-definition-file member))) - do (ebrowse-draw-file-member-info info "defn."))) + (lambda (_member-name list) + (loop for info in list + as member = (third info) + as class = (ebrowse-ts-class (first info)) + when (or (and (null (ebrowse-ms-file member)) + (string= (ebrowse-cs-file class) file)) + (string= file (ebrowse-ms-file member))) + do (ebrowse-draw-file-member-info info "decl.") + when (or (and (null (ebrowse-ms-definition-file member)) + (string= (ebrowse-cs-source-file class) file)) + (string= file (ebrowse-ms-definition-file member))) + do (ebrowse-draw-file-member-info info "defn."))) members)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d22d03fbe96..6bd2de992cb 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -263,7 +263,7 @@ One argument, the tag info returned by `snarf-tag-function'.") (defun initialize-new-tags-table () "Initialize the tags table in the current buffer. Return non-nil if it is a valid tags table, and -in that case, also make the tags table state variables +in that case, also make the tags table state variables buffer-local and set them to nil." (set (make-local-variable 'tags-table-files) nil) (set (make-local-variable 'tags-completion-table) nil) @@ -853,6 +853,7 @@ The functions using this are `find-tag-noselect', ;; Dynamic bondage: (defvar etags-case-fold-search) (defvar etags-syntax-table) +(defvar local-find-tag-hook) ;;;###autoload (defun find-tag-noselect (tagname &optional next-p regexp-p) @@ -1656,7 +1657,7 @@ Point should be just after a string that matches TAG." ;; partial file name match, i.e. searched tag must match a substring ;; of the file name (potentially including a directory separator). -(defun tag-partial-file-name-match-p (tag) +(defun tag-partial-file-name-match-p (_tag) "Return non-nil if current tag matches file name. This is a substring match, and it can include directory separators. Point should be just after a string that matches TAG." @@ -1666,7 +1667,7 @@ Point should be just after a string that matches TAG." (looking-at "\f\n")))) ;; t if point is in a tag line with a tag containing TAG as a substring. -(defun tag-any-match-p (tag) +(defun tag-any-match-p (_tag) "Return non-nil if current tag line contains TAG as a substring." (looking-at ".*\177")) @@ -1755,9 +1756,9 @@ if the file was newly read in, the value is the filename." (with-current-buffer buffer (revert-buffer t t))) (if (not (and new novisit)) - (set-buffer (find-file-noselect next novisit)) + (find-file next novisit) ;; Like find-file, but avoids random warning messages. - (set-buffer (get-buffer-create " *next-file*")) + (switch-to-buffer (get-buffer-create " *next-file*")) (kill-all-local-variables) (erase-buffer) (setq new next) @@ -1906,7 +1907,7 @@ See also the documentation of the variable `tags-file-name'." (try-completion string (tags-table-files) predicate)))) ;;;###autoload -(defun list-tags (file &optional next-match) +(defun list-tags (file &optional _next-match) "Display list of tags in file FILE. This searches only the first table in the list, and no included tables. FILE should be as it appeared in the `etags' command, usually without a diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index 9313df9f587..d8133cb6b90 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -173,6 +173,8 @@ non-executable files." (file-modes buffer-file-name))))))) +(defvar compilation-error-regexp-alist) ; from compile.el + ;;;###autoload (defun executable-interpret (command) "Run script with user-specified args, and collect output in a buffer. @@ -186,7 +188,7 @@ command to find the next error. The buffer is also in `comint-mode' and (save-some-buffers (not compilation-ask-about-save)) (set (make-local-variable 'executable-command) command) (let ((compilation-error-regexp-alist executable-error-regexp-alist)) - (compilation-start command t (lambda (x) "*interpretation*")))) + (compilation-start command t (lambda (_x) "*interpretation*")))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4461ec27456..6200591fbbb 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -596,7 +596,7 @@ It's flymake process filter." (with-current-buffer source-buffer (flymake-parse-output-and-residual output))))) -(defun flymake-process-sentinel (process event) +(defun flymake-process-sentinel (process _event) "Sentinel for syntax check buffers." (when (memq (process-status process) '(signal exit)) (let* ((exit-status (process-exit-status process)) @@ -1110,7 +1110,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (flymake-log 1 "deleted file %s" file-name))) (defun flymake-safe-delete-directory (dir-name) - (condition-case err + (condition-case nil (progn (delete-directory dir-name) (flymake-log 1 "deleted dir %s" dir-name)) @@ -1152,35 +1152,34 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-start-syntax-check-process (cmd args dir) "Start syntax check process." - (let* ((process nil)) - (condition-case err - (progn - (when dir - (let ((default-directory dir)) - (flymake-log 3 "starting process on dir %s" default-directory))) - (setq process (apply 'start-file-process - "flymake-proc" (current-buffer) cmd args)) - (set-process-sentinel process 'flymake-process-sentinel) - (set-process-filter process 'flymake-process-filter) - (push process flymake-processes) - - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (flymake-float-time)) - - (flymake-report-status nil "*") - (flymake-log 2 "started process %d, command=%s, dir=%s" - (process-id process) (process-command process) - default-directory) - process) - (error - (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" - cmd args (error-message-string err))) - (source-file-name buffer-file-name) - (cleanup-f (flymake-get-cleanup-function source-file-name))) - (flymake-log 0 err-str) - (funcall cleanup-f) - (flymake-report-fatal-status "PROCERR" err-str)))))) + (condition-case err + (let* ((process + (let ((default-directory (or dir default-directory))) + (when dir + (flymake-log 3 "starting process on dir %s" dir)) + (apply 'start-file-process + "flymake-proc" (current-buffer) cmd args)))) + (set-process-sentinel process 'flymake-process-sentinel) + (set-process-filter process 'flymake-process-filter) + (push process flymake-processes) + + (setq flymake-is-running t) + (setq flymake-last-change-time nil) + (setq flymake-check-start-time (flymake-float-time)) + + (flymake-report-status nil "*") + (flymake-log 2 "started process %d, command=%s, dir=%s" + (process-id process) (process-command process) + default-directory) + process) + (error + (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" + cmd args (error-message-string err))) + (source-file-name buffer-file-name) + (cleanup-f (flymake-get-cleanup-function source-file-name))) + (flymake-log 0 err-str) + (funcall cleanup-f) + (flymake-report-fatal-status "PROCERR" err-str))))) (defun flymake-kill-process (proc) "Kill process PROC." @@ -1387,7 +1386,7 @@ With arg, turn Flymake mode on if and only if arg is positive." :group 'flymake :type 'boolean) -(defun flymake-after-change-function (start stop len) +(defun flymake-after-change-function (start stop _len) "Start syntax check for current buffer if it isn't already running." ;;+(flymake-log 0 "setting change time to %s" (flymake-float-time)) (let((new-text (buffer-substring start stop))) @@ -1497,7 +1496,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) temp-name)) -(defun flymake-create-temp-with-folder-structure (file-name prefix) +(defun flymake-create-temp-with-folder-structure (file-name _prefix) (unless (stringp file-name) (error "Invalid file-name")) @@ -1764,7 +1763,7 @@ Use CREATE-TEMP-F for creating temp copy." (when temp-master-file-name (flymake-get-tex-args temp-master-file-name)))) -(defun flymake-get-include-dirs-dot (base-dir) +(defun flymake-get-include-dirs-dot (_base-dir) '(".")) ;;;; xml-specific init-cleanup routines diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 67a214977b1..7c305ec3f6e 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -291,7 +291,7 @@ buffer). This corresponds to the g77 compiler option :type 'integer :safe 'integerp :initialize 'custom-initialize-default - :set (lambda (symbol value) + :set (lambda (_symbol value) ;; Do all fortran buffers, and the default. (fortran-line-length value t)) :version "23.1" diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 6aece579d5d..c2ee1a93389 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -104,6 +104,13 @@ (require 'bindat) (eval-when-compile (require 'cl)) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) +(declare-function speedbar-timer-fn "speedbar" ()) +(declare-function speedbar-line-text "speedbar" (&optional p)) +(declare-function speedbar-change-expand-button-char "speedbar" (char)) +(declare-function speedbar-delete-subblock "speedbar" (indent)) +(declare-function speedbar-center-buffer-smartly "speedbar" ()) + (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) (defvar speedbar-frame) @@ -544,7 +551,7 @@ the list) is deleted every time a new one is added (at the front)." (defun gdb-find-watch-expression () (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) - (varnum (car var)) expr array) + (varnum (car var)) expr) (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum) (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet (component-list (split-string (match-string 2 varnum) "\\." t))) @@ -1151,7 +1158,7 @@ With arg, enter name of variable to be watched in the minibuffer." (gdb-input (list (concat "-var-delete -c " varnum) 'ignore))) -(defun gdb-edit-value (text token indent) +(defun gdb-edit-value (_text _token _indent) "Assign a value to a variable displayed in the speedbar." (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) (varnum (car var)) (value)) @@ -1820,7 +1827,7 @@ is running." ;; Start accumulating output for the GUD buffer (setq gdb-filter-output "") - (let ((output-record) (output-record-list)) + (let (output-record-list) ;; Process all the complete markers in this chunk. (dolist (gdbmi-record gdbmi-record-list) @@ -1860,17 +1867,17 @@ is running." gdb-filter-output)) -(defun gdb-gdb (output-field)) +(defun gdb-gdb (_output-field)) (defun gdb-shell (output-field) (let ((gdb-output-sink gdb-output-sink)) (setq gdb-filter-output (concat output-field gdb-filter-output)))) -(defun gdb-ignored-notification (output-field)) +(defun gdb-ignored-notification (_output-field)) ;; gdb-invalidate-threads is defined to accept 'update-threads signal -(defun gdb-thread-created (output-field)) +(defun gdb-thread-created (_output-field)) (defun gdb-thread-exited (output-field) "Handle =thread-exited async record: unset `gdb-thread-number' if current thread exited and update threads list." @@ -1918,7 +1925,7 @@ Sets `gdb-thread-number' to new id." (setq gdb-active-process t) (gdb-emit-signal gdb-buf-publisher 'update-threads)) -(defun gdb-starting (output-field) +(defun gdb-starting (_output-field) ;; CLI commands don't emit ^running at the moment so use gdb-running too. (setq gdb-inferior-status "running") (gdb-force-mode-line-update @@ -2219,8 +2226,7 @@ calling `gdb-table-string'." (defun gdb-table-string (table &optional sep) "Return TABLE as a string with columns separated with SEP." - (let ((column-sizes (gdb-table-column-sizes table)) - (res "")) + (let ((column-sizes (gdb-table-column-sizes table))) (mapconcat 'identity (gdb-mapcar* @@ -2375,38 +2381,37 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). (defun gdb-place-breakpoints () - (let ((flag) (bptno)) - ;; Remove all breakpoint-icons in source buffers but not assembler buffer. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (if (and (eq gud-minor-mode 'gdbmi) - (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) - (gdb-remove-breakpoint-icons (point-min) (point-max))))) - (dolist (breakpoint gdb-breakpoints-list) - (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is - ; an associative list - (line (bindat-get-field breakpoint 'line))) - (when line - (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 - (not (string-equal file "File not found"))) - (with-current-buffer - (find-file-noselect file 'nowarn) - (gdb-init-buffer) - ;; Only want one breakpoint icon at each location. - (gdb-put-breakpoint-icon (string-equal flag "y") bptno - (string-to-number line))) - (gdb-input - (list (concat "list " file ":1") - 'ignore)) - (gdb-input - (list "-file-list-exec-source-file" - `(lambda () (gdb-get-location - ,bptno ,line ,flag))))))))))) + ;; Remove all breakpoint-icons in source buffers but not assembler buffer. + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (if (and (eq gud-minor-mode 'gdbmi) + (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) + (gdb-remove-breakpoint-icons (point-min) (point-max))))) + (dolist (breakpoint gdb-breakpoints-list) + (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is + ; an associative list + (line (bindat-get-field breakpoint 'line))) + (when line + (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 + (not (string-equal file "File not found"))) + (with-current-buffer + (find-file-noselect file 'nowarn) + (gdb-init-buffer) + ;; Only want one breakpoint icon at each location. + (gdb-put-breakpoint-icon (string-equal flag "y") bptno + (string-to-number line))) + (gdb-input + (list (concat "list " file ":1") + 'ignore)) + (gdb-input + (list "-file-list-exec-source-file" + `(lambda () (gdb-get-location + ,bptno ,line ,flag)))))))))) (defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") @@ -3276,7 +3281,6 @@ DOC is an optional documentation string." (defun gdb-disassembly-handler-custom () (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) @@ -3806,8 +3810,7 @@ already, in which case that window is splitted first." (let ((window (get-lru-window))) (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window)) 'gdbmi) - (let* ((largest (get-largest-window)) - (cur-size (window-height largest))) + (let ((largest (get-largest-window))) (setq answer (split-window largest)) (set-window-buffer answer buf) (set-window-dedicated-p answer dedicated) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index a1dc19da1ed..0d9359caa77 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -290,7 +290,7 @@ recognized according to the current value of the variable `glasses-separator'." nil) -(defun glasses-change (beg end &optional old-len) +(defun glasses-change (beg end &optional _old-len) "After-change function updating glass overlays." (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position))) (end-line (save-excursion (goto-char end) (line-end-position)))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e81f4ca949b..74bdc980e8b 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -379,13 +379,13 @@ step (if we're in the GUD buffer). source file) or the source line number at the last break or step (if we're in the GUD buffer)." `(progn - (defun ,func (arg) + (defalias ',func (lambda (arg) ,@(if doc (list doc)) (interactive "p") (if (not gud-running) ,(if (stringp cmd) `(gud-call ,cmd arg) - cmd))) + cmd)))) ,(if key `(local-set-key ,(concat "\C-c" key) ',func)) ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) @@ -491,7 +491,7 @@ The value t means that there is no stack, and we are in display-file mode.") (gud-install-speedbar-variables) (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) -(defun gud-expansion-speedbar-buttons (directory zero) +(defun gud-expansion-speedbar-buttons (_directory _zero) "Wrapper for call to `speedbar-add-expansion-list'. DIRECTORY and ZERO are not used, but are required by the caller." (gud-speedbar-buttons gud-comint-buffer)) @@ -657,17 +657,15 @@ The option \"--fullname\" must be included in this value." gud-marker-acc (substring gud-marker-acc (match-end 0)))) (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) - (let ((match (match-string 1 gud-marker-acc))) - - (setq - ;; Append any text before the marker to the output we're going - ;; to return - we don't include the marker in this text. - output (concat output - (substring gud-marker-acc 0 (match-beginning 0))) + (setq + ;; Append any text before the marker to the output we're going + ;; to return - we don't include the marker in this text. + output (concat output + (substring gud-marker-acc 0 (match-beginning 0))) - ;; Set the accumulator to the remaining text. + ;; Set the accumulator to the remaining text. - gud-marker-acc (substring gud-marker-acc (match-end 0))))) + gud-marker-acc (substring gud-marker-acc (match-end 0)))) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in @@ -884,7 +882,7 @@ It is passed through FILTER before we look at it." ;; gdb speedbar functions -(defun gud-gdb-goto-stackframe (text token indent) +(defun gud-gdb-goto-stackframe (_text token _indent) "Goto the stackframe described by TEXT, TOKEN, and INDENT." (speedbar-with-attached-buffer (gud-basic-call (concat "server frame " (nth 1 token))) @@ -1074,7 +1072,7 @@ containing the executable being debugged." directory)) :group 'gud) -(defun gud-dbx-massage-args (file args) +(defun gud-dbx-massage-args (_file args) (nconc (let ((directories gud-dbx-directories) (result nil)) (while directories @@ -1386,7 +1384,7 @@ containing the executable being debugged." directory)) :group 'gud) -(defun gud-xdb-massage-args (file args) +(defun gud-xdb-massage-args (_file args) (nconc (let ((directories gud-xdb-directories) (result nil)) (while directories @@ -1450,7 +1448,7 @@ directories if your program contains sources from more than one directory." ;; History of argument lists passed to perldb. (defvar gud-perldb-history nil) -(defun gud-perldb-massage-args (file args) +(defun gud-perldb-massage-args (_file args) "Convert a command line as would be typed normally to run perldb into one that invokes an Emacs-enabled debugging session. \"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)." @@ -2072,7 +2070,7 @@ extension EXTN. Normally EXTN is given as the regular expression ;; Change what was given in the minibuffer to something that can be used to ;; invoke the debugger. -(defun gud-jdb-massage-args (file args) +(defun gud-jdb-massage-args (_file args) ;; The jdb executable must have whitespace between "-classpath" and ;; its value while gud-common-init expects all switch values to ;; follow the switch keyword without intervening whitespace. We @@ -2151,7 +2149,7 @@ relative to a classpath directory." (setq cplist (cdr cplist))) (if found-file (concat (car cplist) "/" filename))))) -(defun gud-jdb-find-source (string) +(defun gud-jdb-find-source (_string) "Alias for function used to locate source files. Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file' during jdb initialization depending on the value of @@ -3047,7 +3045,7 @@ Link exprs of the form: (declare-function syntax-symbol "gud" (x)) (declare-function syntax-point "gud" (x)) -(defun gud-find-class (f line) +(defun gud-find-class (f _line) "Find fully qualified class in file F at line LINE. This function uses the `gud-jdb-classpath' (and optional `gud-jdb-sourcepath') list(s) to derive a file @@ -3063,13 +3061,13 @@ class of the file (using s to separate nested class ids)." (save-match-data (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) (fbuffer (get-file-buffer f)) - syntax-symbol syntax-point class-found) + class-found + ;; Syntax-symbol returns the symbol of the *first* element + ;; in the syntactical analysis result list, syntax-point + ;; returns the buffer position of same + (syntax-symbol (lambda (x) (c-langelem-sym (car x)))) + (syntax-point (lambda (x) (c-langelem-pos (car x))))) (setq f (file-name-sans-extension (file-truename f))) - ;; Syntax-symbol returns the symbol of the *first* element - ;; in the syntactical analysis result list, syntax-point - ;; returns the buffer position of same - (fset 'syntax-symbol (lambda (x) (c-langelem-sym (car x)))) - (fset 'syntax-point (lambda (x) (c-langelem-pos (car x)))) ;; Search through classpath list for an entry that is ;; contained in f (while (and cplist (not class-found)) @@ -3092,17 +3090,17 @@ class of the file (using s to separate nested class ids)." ;; with the 'topmost-intro symbol, there may be ;; nested classes... (while (not (eq 'topmost-intro - (syntax-symbol (c-guess-basic-syntax)))) + (funcall syntax-symbol (c-guess-basic-syntax)))) ;; Check if the current position c-syntactic ;; analysis has 'inclass (setq syntax (c-guess-basic-syntax)) (while - (and (not (eq 'inclass (syntax-symbol syntax))) + (and (not (eq 'inclass (funcall syntax-symbol syntax))) (cdr syntax)) (setq syntax (cdr syntax))) - (if (eq 'inclass (syntax-symbol syntax)) + (if (eq 'inclass (funcall syntax-symbol syntax)) (progn - (goto-char (syntax-point syntax)) + (goto-char (funcall syntax-point syntax)) ;; Now we're at the beginning of a class ;; definition. Find class name (looking-at @@ -3111,9 +3109,9 @@ class of the file (using s to separate nested class ids)." (append (list (match-string-no-properties 1)) nclass))) (setq syntax (c-guess-basic-syntax)) - (while (and (not (syntax-point syntax)) (cdr syntax)) + (while (and (not (funcall syntax-point syntax)) (cdr syntax)) (setq syntax (cdr syntax))) - (goto-char (syntax-point syntax)) + (goto-char (funcall syntax-point syntax)) )) (string-match (concat (car nclass) "$") class-found) (setq class-found diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 76a91c4b000..48d1ac4b85e 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -412,13 +412,14 @@ that form should be displayed.") "Pop the next token from token-list into the let variable \"hif-token\"." (setq hif-token (pop hif-token-list))) -(defun hif-parse-if-exp (hif-token-list) +(defun hif-parse-if-exp (token-list) "Parse the TOKEN-LIST. Return translated list in prefix form." - (hif-nexttoken) - (prog1 - (hif-expr) - (if hif-token ; is there still a token? - (error "Error: unexpected token: %s" hif-token)))) + (let ((hif-token-list token-list)) + (hif-nexttoken) + (prog1 + (hif-expr) + (if hif-token ; is there still a token? + (error "Error: unexpected token: %s" hif-token))))) (defun hif-expr () "Parse an expression as found in #if. @@ -507,7 +508,7 @@ that form should be displayed.") ;; Unary plus/minus. ((memq hif-token '(hif-minus hif-plus)) (list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor))) - + (t ; identifier (let ((ident hif-token)) (if (memq ident '(or and)) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 9468d7b463e..d07edd5de2f 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -565,10 +565,9 @@ and then further adjusted to be at the end of the line." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) (when (looking-at hs-block-start-regexp) - (let* ((mdata (match-data t)) - (header-beg (match-beginning 0)) - (header-end (match-end 0)) - p q ov) + (let ((mdata (match-data t)) + (header-end (match-end 0)) + p q ov) ;; `p' is the point at the end of the block beginning, which ;; may need to be adjusted (save-excursion diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 9a8b8064be7..5382ce1386d 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -484,9 +484,9 @@ Returns nil if line starts inside a string, t if in a comment." (let ((indent-stack (list nil)) (contain-stack (list (point))) (case-fold-search nil) - restart outer-loop-done inner-loop-done state ostate - this-indent last-sexp last-depth - at-else at-brace at-do + outer-loop-done inner-loop-done state ostate + this-indent last-depth + at-else at-brace (opoint (point)) (next-depth 0)) (save-excursion @@ -506,9 +506,6 @@ Returns nil if line starts inside a string, t if in a comment." (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) - (if (and (car (cdr (cdr state))) - (>= (car (cdr (cdr state))) 0)) - (setq last-sexp (car (cdr (cdr state))))) (if (or (nth 4 ostate)) (icon-indent-line)) (if (or (nth 3 state)) @@ -518,8 +515,6 @@ Returns nil if line starts inside a string, t if in a comment." (setq outer-loop-done t)) (if outer-loop-done nil - (if (/= last-depth next-depth) - (setq last-sexp nil)) (while (> last-depth next-depth) (setq indent-stack (cdr indent-stack) contain-stack (cdr contain-stack) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f495e35dc89..cd382d4e78d 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -934,7 +934,7 @@ BEG defaults to `point-min', meaning to flush the entire cache." (setq beg (or beg (save-restriction (widen) (point-min)))) (setq js--cache-end (min js--cache-end beg))) -(defmacro js--debug (&rest arguments) +(defmacro js--debug (&rest _arguments) ;; `(message ,@arguments) ) @@ -1591,10 +1591,9 @@ will be returned." (save-restriction (widen) (js--ensure-cache) - (let* ((bound (if (eobp) (point) (1+ (point)))) - (pstate (or (save-excursion - (js--backward-pstate)) - (list js--initial-pitem)))) + (let ((pstate (or (save-excursion + (js--backward-pstate)) + (list js--initial-pitem)))) ;; Loop until we either hit a pitem at BOB or pitem ends after ;; point (or at point if we're at eob) @@ -1921,7 +1920,7 @@ the broken-down class name of the item to insert." (let ((top-name (car name-parts)) (item-ptr items) - new-items last-new-item new-cons item) + new-items last-new-item new-cons) (js--debug "js--splice-into-items: name-parts: %S items:%S" name-parts @@ -2147,8 +2146,8 @@ initial input INITIAL-INPUT. Return a cons of (SYMBOL-NAME . LOCATION), where SYMBOL-NAME is a string and LOCATION is a marker." (unless ido-mode - (ido-mode t) - (ido-mode nil)) + (ido-mode 1) + (ido-mode -1)) (let ((choice (ido-completing-read prompt @@ -2955,8 +2954,8 @@ browser, respectively." ;; Prime IDO (unless ido-mode - (ido-mode t) - (ido-mode nil)) + (ido-mode 1) + (ido-mode -1)) (with-js (lexical-let ((tabs (js--get-tabs)) selected-tab-cname diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index fd9a576002a..22e5d2f7c5c 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -343,7 +343,7 @@ not be enclosed in { } or ( )." (defun makefile-make-font-lock-keywords (var keywords space &optional negation - &rest font-lock-keywords) + &rest fl-keywords) `(;; Do macro assignments. These get the "variable-name" face. (,makefile-macroassign-regex (1 font-lock-variable-name-face) @@ -393,7 +393,7 @@ not be enclosed in { } or ( )." ;; They can make a tab fail to be effective. ("^\\( +\\)\t" 1 makefile-space))) - ,@font-lock-keywords + ,@fl-keywords ;; Do dependencies. (makefile-match-dependency @@ -491,7 +491,7 @@ not be enclosed in { } or ( )." '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face))) (defconst makefile-imake-font-lock-keywords - (append + (append (makefile-make-font-lock-keywords makefile-var-use-regex makefile-statements @@ -1155,7 +1155,6 @@ The context determines which are considered." (let* ((beg (save-excursion (skip-chars-backward "^$(){}:#= \t\n") (point))) - (try (buffer-substring beg (point))) (paren nil) (do-macros (save-excursion @@ -1262,7 +1261,7 @@ definition and conveniently use this command." ;; Filling -(defun makefile-fill-paragraph (arg) +(defun makefile-fill-paragraph (_arg) ;; Fill comments, backslashed lines, and variable definitions ;; specially. (save-excursion @@ -1680,7 +1679,7 @@ Then prompts for all required parameters." ;;; Utility functions ;;; ------------------------------------------------------------ -(defun makefile-match-function-end (end) +(defun makefile-match-function-end (_end) "To be called as an anchored matcher by font-lock. The anchor must have matched the opening parens in the first group." (let ((s (match-string-no-properties 1))) diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index e1d41c2ebd6..803a542563c 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -73,10 +73,7 @@ mode, set this to (\"-q\" \"--traditional\")." "Keymap used in Inferior Octave mode.") (defvar inferior-octave-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\` "w" table) - (modify-syntax-entry ?\# "<" table) - (modify-syntax-entry ?\n ">" table) + (let ((table (make-syntax-table octave-mode-syntax-table))) table) "Syntax table in use in inferior-octave-mode buffers.") @@ -115,11 +112,13 @@ the regular expression `comint-prompt-regexp', a buffer local variable." "Non-nil means that Octave has built-in variables.") (defvar inferior-octave-dynamic-complete-functions - '(inferior-octave-complete comint-dynamic-complete-filename) + '(inferior-octave-completion-at-point comint-filename-completion) "List of functions called to perform completion for inferior Octave. This variable is used to initialize `comint-dynamic-complete-functions' in the Inferior Octave buffer.") +(defvar info-lookup-mode) + (define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" "Major mode for interacting with an inferior Octave process. Runs Octave as a subprocess of Emacs, with Octave I/O through an Emacs @@ -139,6 +138,8 @@ Entry to this mode successively runs the hooks `comint-mode-hook' and (set (make-local-variable 'font-lock-defaults) '(inferior-octave-font-lock-keywords nil nil)) + (set (make-local-variable 'info-lookup-mode) 'octave-mode) + (setq comint-input-ring-file-name (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024)) @@ -259,40 +260,38 @@ startup file, `~/.emacs-octave'." (inferior-octave-resync-dirs))) +(defun inferior-octave-completion-at-point () + "Return the data to complete the Octave symbol at point." + (let* ((end (point)) + (start + (save-excursion + (skip-syntax-backward "w_" (comint-line-beginning-position)) + (point)))) + (cond (inferior-octave-complete-impossible nil) + ((eq start end) nil) + (t + (list + start end + (completion-table-dynamic + (lambda (command) + (inferior-octave-send-list-and-digest + (list (concat "completion_matches (\"" command "\");\n"))) + (sort (delete-dups inferior-octave-output-list) + 'string-lessp)))))))) + (defun inferior-octave-complete () "Perform completion on the Octave symbol preceding point. This is implemented using the Octave command `completion_matches' which is NOT available with versions of Octave prior to 2.0." (interactive) - (let* ((end (point)) - (command - (save-excursion - (skip-syntax-backward "w_" (comint-line-beginning-position)) - (buffer-substring-no-properties (point) end))) - (proc (get-buffer-process inferior-octave-buffer))) - (cond (inferior-octave-complete-impossible - (error (concat - "Your Octave does not have `completion_matches'. " - "Please upgrade to version 2.X."))) - ((string-equal command "") - (message "Cannot complete an empty string")) - (t - (inferior-octave-send-list-and-digest - (list (concat "completion_matches (\"" command "\");\n"))) - ;; Sort the list - (setq inferior-octave-output-list - (sort inferior-octave-output-list 'string-lessp)) - ;; Remove duplicates - (let* ((x inferior-octave-output-list) - (y (cdr x))) - (while y - (if (string-equal (car x) (car y)) - (setcdr x (setq y (cdr y))) - (setq x y - y (cdr y))))) - ;; And let comint handle the rest - (comint-dynamic-simple-complete - command inferior-octave-output-list))))) + (if inferior-octave-complete-impossible + (error (concat + "Your Octave does not have `completion_matches'. " + "Please upgrade to version 2.X.")) + (let ((data (inferior-octave-completion-at-point))) + (if (null data) + (message "Cannot complete an empty string") + (apply #'completion-in-region data))))) (defun inferior-octave-dynamic-list-input-ring () "List the buffer's input history in a help buffer." @@ -336,7 +335,7 @@ Ring Emacs bell if process output starts with an ASCII bell, and pass the rest to `comint-output-filter'." (comint-output-filter proc (inferior-octave-strip-ctrl-g string))) -(defun inferior-octave-output-digest (proc string) +(defun inferior-octave-output-digest (_proc string) "Special output filter for the inferior Octave process. Save all output between newlines into `inferior-octave-output-list', and the rest to `inferior-octave-output-string'." diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 8bf9ff299d0..39d997e1d5e 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -150,8 +150,8 @@ All Octave abbrevs start with a grave accent (`)." "Builtin variables in Octave.") (defvar octave-function-header-regexp - (concat "^\\s-*\\<\\(function\\)\\>" - "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\w+\\)\\>") + (concat "^\\s-*\\_<\\(function\\)\\_>" + "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") "Regexp to match an Octave function header. The string `function' and its name are given by the first and third parenthetical grouping.") @@ -159,10 +159,10 @@ parenthetical grouping.") (defvar octave-font-lock-keywords (list ;; Fontify all builtin keywords. - (cons (concat "\\<\\(" + (cons (concat "\\_<\\(" (regexp-opt (append octave-reserved-words octave-text-functions)) - "\\)\\>") + "\\)\\_>") 'font-lock-keyword-face) ;; Fontify all builtin operators. (cons "\\(&\\||\\|<=\\|>=\\|==\\|<\\|>\\|!=\\|!\\)" @@ -170,7 +170,7 @@ parenthetical grouping.") 'font-lock-builtin-face 'font-lock-preprocessor-face)) ;; Fontify all builtin variables. - (cons (concat "\\<" (regexp-opt octave-variables) "\\>") + (cons (concat "\\_<" (regexp-opt octave-variables) "\\_>") 'font-lock-variable-name-face) ;; Fontify all function declarations. (list octave-function-header-regexp @@ -223,7 +223,7 @@ parenthetical grouping.") (define-key map "\C-c]" 'smie-close-block) (define-key map "\C-c/" 'smie-close-block) (define-key map "\C-c\C-f" 'octave-insert-defun) - (define-key map "\C-c\C-h" 'octave-help) + (define-key map "\C-c\C-h" 'info-lookup-symbol) (define-key map "\C-c\C-il" 'octave-send-line) (define-key map "\C-c\C-ib" 'octave-send-block) (define-key map "\C-c\C-if" 'octave-send-defun) @@ -299,8 +299,8 @@ parenthetical grouping.") ;; Was "w" for abbrevs, but now that it's not necessary any more, (modify-syntax-entry ?\` "." table) (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?. "w" table) - (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?. "_" table) + (modify-syntax-entry ?_ "_" table) ;; The "b" flag only applies to the second letter of the comstart ;; and the first letter of the comend, i.e. the "4b" below is ineffective. ;; If we try to put `b' on the single-line comments, we get a similar @@ -818,11 +818,11 @@ Returns t unless search stops at the beginning or end of the buffer." (found nil) (case-fold-search nil)) (and (not (eobp)) - (not (and (> arg 0) (looking-at "\\<function\\>"))) + (not (and (> arg 0) (looking-at "\\_<function\\_>"))) (skip-syntax-forward "w")) (while (and (/= arg 0) (setq found - (re-search-backward "\\<function\\>" inc))) + (re-search-backward "\\_<function\\_>" inc))) (if (octave-not-in-string-or-comment-p) (setq arg (- arg inc)))) (if found @@ -893,7 +893,7 @@ otherwise." (setq give-up t)))) (not give-up)))) -(defun octave-fill-paragraph (&optional arg) +(defun octave-fill-paragraph (&optional _arg) "Fill paragraph of Octave code, handling Octave comments." ;; FIXME: difference with generic fill-paragraph: ;; - code lines are only split, never joined. @@ -975,12 +975,12 @@ otherwise." (defun octave-completion-at-point-function () "Find the text to complete and the corresponding table." - (let* ((beg (save-excursion (backward-sexp 1) (point))) + (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) (end (point))) (if (< beg (point)) ;; Extend region past point, if applicable. - (save-excursion (goto-char beg) (forward-sexp 1) - (setq end (max end (point))))) + (save-excursion (skip-syntax-forward "w_") + (setq end (point)))) (list beg end octave-completion-alist))) (defun octave-complete-symbol () diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 9b446e49b5c..ed628730fc1 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -862,7 +862,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." ;; ); (progn (skip-syntax-backward "(") - (condition-case err + (condition-case nil (while (save-excursion (skip-syntax-backward " ") (not (bolp))) (forward-sexp -1)) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 62472edfbe4..283919c131e 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1010,7 +1010,7 @@ VERSION is of the format (Major . Minor)" (define-key map "\C-c\C-l" 'prolog-consult-file) (define-key map "\C-c\C-z" 'switch-to-prolog)) -(defun prolog-mode-keybindings-inferior (map) +(defun prolog-mode-keybindings-inferior (_map) "Define keybindings for inferior Prolog mode in MAP." ;; No inferior mode specific keybindings now. ) @@ -2012,15 +2012,14 @@ Argument BOUND is a buffer position limiting searching." ;; NB: This function *MUST* have this optional argument since XEmacs ;; assumes it. This does not mean we have to use it... -(defun prolog-indent-line (&optional whole-exp) +(defun prolog-indent-line (&optional _whole-exp) "Indent current line as Prolog code. With argument, indent any additional lines of the same clause rigidly along with this one (not yet)." (interactive "p") (let ((indent (prolog-indent-level)) - (pos (- (point-max) (point))) beg) + (pos (- (point-max) (point)))) (beginning-of-line) - (setq beg (point)) (skip-chars-forward " \t") (indent-line-to indent) (if (> (- (point-max) pos) (point)) diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index f3418a60729..cade56a194c 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -541,6 +541,10 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number (interactive) (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version)) +;; From reporter.el +(defvar reporter-prompt-for-summary-p) +(defvar reporter-dont-compact-list) + (defun ps-mode-submit-bug-report () "Submit via mail a bug report on PostScript mode." (interactive) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 0cbb8c186cc..a7851c54356 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2495,7 +2495,7 @@ with skeleton expansions for compound statement templates. ;; doesn't seem to work properly. (add-to-list 'hs-special-modes-alist `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" - ,(lambda (arg) + ,(lambda (_arg) (python-end-of-defun) (skip-chars-backward " \t\n")) nil)) @@ -2554,7 +2554,7 @@ Runs `jython-mode-hook' after `python-mode-hook'." (setq overlay-arrow-position nil python-pdbtrack-is-tracking-p nil))) -(defun python-pdbtrack-track-stack-file (text) +(defun python-pdbtrack-track-stack-file (_text) "Show the file indicated by the pdb stack entry line, in a separate window. Activity is disabled if the buffer-local variable @@ -2666,8 +2666,8 @@ problem." ) ) -(defun python-pdbtrack-grub-for-buffer (funcname lineno) - "Find recent python-mode buffer named, or having function named funcname." +(defun python-pdbtrack-grub-for-buffer (funcname _lineno) + "Find recent Python mode buffer named, or having function named FUNCNAME." (let ((buffers (buffer-list)) buf got) @@ -2725,7 +2725,7 @@ comint believe the user typed this string so that (interactive) (python-pdbtrack-toggle-stack-tracking 0)) -(defun python-sentinel (proc msg) +(defun python-sentinel (_proc _msg) (setq overlay-arrow-position nil)) (provide 'python) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 7b84cc89d08..258f9be9237 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -987,8 +987,7 @@ subshells can nest." ;; rather flakey. (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote. ;; bingo we have a $( or a ` inside a "" - (let ((char (char-after (point))) - ;; `state' can be: double-quote, backquote, code. + (let (;; `state' can be: double-quote, backquote, code. (state (if (eq (char-before) ?`) 'backquote 'code)) ;; Stacked states in the context. (states '(double-quote))) @@ -1212,7 +1211,7 @@ a number means align to that column, e.g. 0 means first column." ;; "For debugging: display message ARGS if variable SH-DEBUG is non-nil." ;; (if sh-debug ;; (apply 'message args))) -(defmacro sh-debug (&rest args)) +(defmacro sh-debug (&rest _args)) (defconst sh-symbol-list '((const :tag "+ " :value + @@ -2138,7 +2137,6 @@ STRING This is ignored for the purposes of calculating (save-excursion (let ((have-result nil) this-kw - start val (result nil) (align-point nil) @@ -2209,7 +2207,6 @@ STRING This is ignored for the purposes of calculating ;; We start off at beginning of this line. ;; Scan previous statements while this is <= ;; start of previous line. - (setq start (point)) ;; for debug only (goto-char prev-line-end) (setq x t) (while (and x (setq x (sh-prev-thing))) @@ -2614,7 +2611,7 @@ can be represented by a symbol then do so." If INFO is supplied it is used, else it is calculated from current line." (let ((ofs 0) (base-value 0) - elt a b var val) + elt a b val) (or info (setq info (sh-get-indent-info))) (when info diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 976ec202483..dc2773a9efe 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -324,7 +324,7 @@ for SIMULA mode to function correctly." "Keymap used in `simula-mode'.") ;; menus for Lucid -(defun simula-popup-menu (e) +(defun simula-popup-menu (_e) "Pops up the SIMULA menu." (interactive "@e") (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))) @@ -1202,9 +1202,8 @@ If COUNT is negative, move backward instead." ((eq simula-abbrev-keyword 'downcase) (downcase-word -1)) ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))) (let ((pos (- (point-max) (point))) - (case-fold-search t) - null) - (condition-case null + (case-fold-search t)) + (condition-case nil (progn ;; check if the expanded word is on the beginning of the line. (if (and (eq (char-syntax (preceding-char)) ?w) @@ -1244,8 +1243,9 @@ An optional second argument BOUND bounds the search, it is a buffer position. The match found must not extend after that position. Optional third argument NOERROR, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil." - (let (begin end context (comb-regexp (concat regexp "\\|\\<end\\>")) - match (start-point (point))) + (let ((comb-regexp (concat regexp "\\|\\<end\\>")) + (start-point (point)) + context match) (catch 'simula-backward (while (re-search-backward comb-regexp bound 1) ;; We have a match, check SIMULA context at match-beginning @@ -1306,8 +1306,9 @@ An optional second argument BOUND bounds the search, it is a buffer position. The match found must not extend after that position. Optional third argument NOERROR, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil." - (let (begin end context (comb-regexp (concat regexp "\\|\\<begin\\>")) - match (start-point (point))) + (let ((comb-regexp (concat regexp "\\|\\<begin\\>")) + (start-point (point)) + context match) (catch 'simula-forward (while (re-search-forward comb-regexp bound 1) ;; We have a match, check SIMULA context at match-beginning diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 1c1ffc41624..facbba60057 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3540,7 +3540,7 @@ optionally is saved to the user's init file." (append (list name) (sql-for-each-login `(product ,@login) - (lambda (token plist) + (lambda (token _plist) (cond ((eq token 'product) `(sql-product ',sql-product)) ((eq token 'user) `(sql-user ,sql-user)) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index eb254676469..f18ec5abe81 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -660,7 +660,7 @@ already exist." -(defun tcl-indent-command (&optional arg) +(defun tcl-indent-command (&optional _arg) "Indent current line as Tcl code, or in some cases insert a tab character. If `tcl-tab-always-indent' is t (the default), always indent current line. If `tcl-tab-always-indent' is nil and point is not in the indentation @@ -1506,7 +1506,7 @@ The first line is assumed to look like \"#!.../program ...\"." ;; loading the XEmacs menu emulation code. ;; -(defun tcl-popup-menu (e) +(defun tcl-popup-menu (_e) (interactive "@e") (popup-menu tcl-mode-menu)) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index f2842721f21..1f33f5f3aaf 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1,4 +1,4 @@ -;;; vera-mode.el --- major mode for editing Vera files. +;;; vera-mode.el --- major mode for editing Vera files ;; Copyright (C) 1997-2011 Free Software Foundation, Inc. @@ -1077,7 +1077,7 @@ try to increase performance by using this macro." (save-excursion (beginning-of-line) (let ((indent-point (point)) - syntax state placeholder pos) + syntax state placeholder) ;; determine syntax state (setq state (parse-partial-sexp (point-min) (point))) (cond @@ -1240,7 +1240,7 @@ Calls `indent-region' for whole buffer." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; electrifications -(defun vera-electric-tab (&optional prefix-arg) +(defun vera-electric-tab (&optional prefix) "Do what I mean (indent, expand, tab, change indent, etc..). If preceding character is part of a word or a paren then `hippie-expand', else if right of non whitespace on line then `tab-to-tab-stop', @@ -1260,7 +1260,7 @@ If `vera-intelligent-tab' is nil, always indent line." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vera-mode)))) - (vera-expand-abbrev prefix-arg))) + (vera-expand-abbrev prefix))) ((> (current-column) (current-indentation)) (tab-to-tab-stop)) ((and (or (eq last-command 'vera-electric-tab) @@ -1402,7 +1402,7 @@ If `vera-intelligent-tab' is nil, always indent line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Comments -(defun vera-comment-uncomment-region (beg end &optional arg) +(defun vera-comment-uncomment-region (beg end &optional _arg) "Comment region if not commented, uncomment region if already commented." (interactive "r\nP") (goto-char beg) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index cd50174f8cd..dfa91b3fe30 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -511,7 +511,7 @@ Commands: (interactive) (xscheme-send-char last-command-event)) -(defun xscheme-enter-debugger-mode (prompt-string) +(defun xscheme-enter-debugger-mode (_prompt-string) (with-current-buffer (xscheme-process-buffer) (if (not (derived-mode-p 'scheme-debugger-mode)) (progn @@ -1024,8 +1024,7 @@ the remaining input.") (xscheme-goto-output-point) (let ((old-point (point))) (while (string-match "\\(\007\\|\f\\)" string) - (let ((start (match-beginning 0)) - (end (match-end 0))) + (let ((start (match-beginning 0))) (insert-before-markers (substring string 0 start)) (if (= ?\f (aref string start)) (progn diff --git a/lisp/shell.el b/lisp/shell.el index 57187b6d7f9..d6bc685618c 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1,4 +1,4 @@ -;;; shell.el --- specialized comint.el for running the shell +;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1993-1997, 2000-2011 Free Software Foundation, Inc. @@ -79,7 +79,7 @@ ;; Shell Mode Commands: ;; shell Fires up the shell process -;; tab comint-dynamic-complete Complete filename/command/history +;; tab completion-at-point Complete filename/command/history ;; m-? comint-dynamic-list-filename-completions ;; List completions in help buffer ;; m-c-f shell-forward-command Forward a shell command @@ -96,6 +96,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'comint) ;;; Customization and Buffer Variables @@ -181,12 +182,12 @@ shell buffer. The value may depend on the operating system or shell. This is a fine thing to set in your `.emacs' file.") (defvar shell-dynamic-complete-functions - '(comint-replace-by-expanded-history - shell-dynamic-complete-environment-variable - shell-dynamic-complete-command - shell-replace-by-expanded-directory - shell-dynamic-complete-filename - comint-dynamic-complete-filename) + '(comint-c-a-p-replace-by-expanded-history + shell-environment-variable-completion + shell-command-completion + shell-c-a-p-replace-by-expanded-directory + shell-filename-completion + comint-filename-completion) "List of functions called to perform completion. This variable is used to initialize `comint-dynamic-complete-functions' in the shell buffer. @@ -312,7 +313,7 @@ This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and -`comint-dynamic-complete'. +`comint-dynamic-complete-functions'. This variable supplies a default for `comint-input-autoexpand', for Shell mode only." @@ -339,7 +340,7 @@ Thus, this does not include the shell's current directory.") (let ((map (nconc (make-sparse-keymap) comint-mode-map))) (define-key map "\C-c\C-f" 'shell-forward-command) (define-key map "\C-c\C-b" 'shell-backward-command) - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) (define-key map (kbd "M-RET") 'shell-resync-dirs) (define-key map "\M-?" 'comint-dynamic-list-filename-completions) (define-key map [menu-bar completion] @@ -486,7 +487,7 @@ buffer." (t "dirs"))) ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") - (add-hook 'comint-output-filter-functions + (add-hook 'comint-preoutput-filter-functions 'shell-filter-ctrl-a-ctrl-b nil t))) (when shell-dir-cookie-re ;; Watch for magic cookies in the output to track the current dir. @@ -494,7 +495,7 @@ buffer." 'shell-dir-cookie-watcher nil t)) (comint-read-input-ring t))) -(defun shell-filter-ctrl-a-ctrl-b (_string) +(defun shell-filter-ctrl-a-ctrl-b (string) "Remove `^A' and `^B' characters from comint output. Bash uses these characters as internal quoting characters in its @@ -504,15 +505,10 @@ started with the `--noediting' option and Select Graphic Rendition (SGR) control sequences (formerly known as ANSI escape sequences) are used to color the prompt. -This function can be put on `comint-output-filter-functions'. -The argument STRING is ignored." - (let ((pmark (process-mark (get-buffer-process (current-buffer))))) - (save-excursion - (goto-char (or (and (markerp comint-last-output-start) - (marker-position comint-last-output-start)) - (point-min))) - (while (re-search-forward "[\C-a\C-b]" pmark t) - (replace-match ""))))) +This function can be put on `comint-preoutput-filter-functions'." + (if (string-match "[\C-a\C-b]" string) + (replace-regexp-in-string "[\C-a\C-b]" "" string t t) + string)) (defun shell-write-history-on-exit (process event) "Called when the shell process is stopped. @@ -1011,30 +1007,36 @@ candidates. Note that this may not be the same as the shell's idea of the path. Completion is dependent on the value of `shell-completion-execonly', plus -those that effect file completion. See `shell-dynamic-complete-as-command'. +those that effect file completion. Returns t if successful." (interactive) + (let ((data (shell-command-completion))) + (if data + (prog2 (unless (window-minibuffer-p (selected-window)) + (message "Completing command name...")) + (apply #'completion-in-region data))))) + +(defun shell-command-completion () + "Return the completion data for the command at point, if any." (let ((filename (comint-match-partial-filename))) (if (and filename (save-match-data (not (string-match "[~/]" filename))) (eq (match-beginning 0) (save-excursion (shell-backward-command 1) (point)))) - (prog2 (unless (window-minibuffer-p (selected-window)) - (message "Completing command name...")) - (shell-dynamic-complete-as-command))))) + (shell--command-completion-data)))) - -(defun shell-dynamic-complete-as-command () - "Dynamically complete at point as a command. -See `shell-dynamic-complete-filename'. Returns t if successful." +(defun shell--command-completion-data () + "Return the completion data for the command at point." (let* ((filename (or (comint-match-partial-filename) "")) + (start (if (zerop (length filename)) (point) (match-beginning 0))) + (end (if (zerop (length filename)) (point) (match-end 0))) (filenondir (file-name-nondirectory filename)) - (path-dirs (cdr (reverse exec-path))) + (path-dirs (cdr (reverse exec-path))) ;FIXME: Why `cdr'? (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore - (mapconcat (function (lambda (x) (concat (regexp-quote x) "$"))) + (mapconcat (function (lambda (x) (concat (regexp-quote x) "\\'"))) comint-completion-fignore "\\|"))) (dir "") (comps-in-dir ()) (file "") (abs-file-name "") (completions ())) @@ -1058,18 +1060,31 @@ See `shell-dynamic-complete-filename'. Returns t if successful." (setq comps-in-dir (cdr comps-in-dir))) (setq path-dirs (cdr path-dirs))) ;; OK, we've got a list of completions. - (let ((success (let ((comint-completion-addsuffix nil)) - (comint-dynamic-simple-complete filenondir completions)))) - (if (and (memq success '(sole shortest)) comint-completion-addsuffix - (not (file-directory-p (comint-match-partial-filename)))) - (insert " ")) - success))) + (list + start end + (lambda (string pred action) + (completion-table-with-terminator + " " (lambda (string pred action) + (if (string-match "/" string) + (completion-file-name-table string pred action) + (complete-with-action action completions string pred))) + string pred action))))) + +;; (defun shell-dynamic-complete-as-command () +;; "Dynamically complete at point as a command. +;; See `shell-dynamic-complete-filename'. Returns t if successful." +;; (apply #'completion-in-region shell--command-completion-data)) (defun shell-dynamic-complete-filename () "Dynamically complete the filename at point. This completes only if point is at a suitable position for a filename argument." (interactive) + (let ((data (shell-filename-completion))) + (if data (apply #'completion-in-region data)))) + +(defun shell-filename-completion () + "Return the completion data for file name at point, if any." (let ((opoint (point)) (beg (comint-line-beginning-position))) (when (save-excursion @@ -1077,24 +1092,21 @@ filename argument." (match-end 0) beg)) (re-search-forward "[^ \t][ \t]" opoint t)) - (comint-dynamic-complete-as-filename)))) + (comint-filename-completion)))) (defun shell-match-partial-variable () "Return the shell variable at point, or nil if none is found." (save-excursion - (let ((limit (point))) - (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move) - (or (looking-at "\\$") (forward-char 1))) - ;; Anchor the search forwards. - (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]")) - nil - (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit) - (buffer-substring (match-beginning 0) (match-end 0)))))) + (if (re-search-backward "[^A-Za-z0-9_{(]" nil 'move) + (or (looking-at "\\$") (forward-char 1))) + (if (or (eolp) (looking-at "[^A-Za-z0-9_{($]")) + nil + (looking-at "\\$?[{(]?[A-Za-z0-9_]*[})]?") + (buffer-substring (match-beginning 0) (match-end 0))))) (defun shell-dynamic-complete-environment-variable () "Dynamically complete the environment variable at point. Completes if after a variable, i.e., if it starts with a \"$\". -See `shell-dynamic-complete-as-environment-variable'. This function is similar to `comint-dynamic-complete-filename', except that it searches `process-environment' for completion candidates. Note that this may @@ -1106,38 +1118,69 @@ called `shell-dynamic-complete-process-environment-variable'. Returns non-nil if successful." (interactive) - (let ((variable (shell-match-partial-variable))) - (if (and variable (string-match "^\\$" variable)) + (let ((data (shell-environment-variable-completion))) + (if data (prog2 (unless (window-minibuffer-p (selected-window)) (message "Completing variable name...")) - (shell-dynamic-complete-as-environment-variable))))) - - -(defun shell-dynamic-complete-as-environment-variable () - "Dynamically complete at point as an environment variable. -Used by `shell-dynamic-complete-environment-variable'. -Uses `comint-dynamic-simple-complete'." - (let* ((var (or (shell-match-partial-variable) "")) - (variable (substring var (or (string-match "[^$({]\\|$" var) 0))) - (variables (mapcar (function (lambda (x) - (substring x 0 (string-match "=" x)))) - process-environment)) - (addsuffix comint-completion-addsuffix) - (comint-completion-addsuffix nil) - (success (comint-dynamic-simple-complete variable variables))) - (if (memq success '(sole shortest)) - (let* ((var (shell-match-partial-variable)) - (variable (substring var (string-match "[^$({]" var))) - (protection (cond ((string-match "{" var) "}") - ((string-match "(" var) ")") - (t ""))) - (suffix (cond ((null addsuffix) "") - ((file-directory-p - (comint-directory (getenv variable))) "/") - (t " ")))) - (insert protection suffix))) - success)) - + (apply #'completion-in-region data))))) + + +(defun shell-environment-variable-completion () + "Completion data for an environment variable at point, if any." + (let* ((var (shell-match-partial-variable)) + (end (match-end 0))) + (when (and (not (zerop (length var))) (eq (aref var 0) ?$)) + (let* ((start + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "\\$?[({]*") + (match-end 0))) + (variables (mapcar (lambda (x) + (substring x 0 (string-match "=" x))) + process-environment)) + (suffix (case (char-before start) (?\{ "}") (?\( ")") (t "")))) + (list + start end + (apply-partially + #'completion-table-with-terminator + (cons (lambda (comp) + (concat comp + suffix + (if (file-directory-p + (comint-directory (getenv comp))) + "/"))) + "\\`a\\`") + variables)))))) + + +(defun shell-c-a-p-replace-by-expanded-directory () + "Expand directory stack reference before point. +For use on `completion-at-point-functions'." + (when (comint-match-partial-filename) + (save-excursion + (goto-char (match-beginning 0)) + (let ((stack (cons default-directory shell-dirstack)) + (index (cond ((looking-at "=-/?") + (length shell-dirstack)) + ((looking-at "=\\([0-9]+\\)/?") + (string-to-number + (buffer-substring + (match-beginning 1) (match-end 1))))))) + (when index + (let ((start (match-beginning 0)) + (end (match-end 0)) + (replacement (file-name-as-directory (nth index stack)))) + (lambda () + (cond + ((>= index (length stack)) + (error "Directory stack not that deep")) + (t + (save-excursion + (goto-char start) + (insert replacement) + (delete-char (- end start))) + (message "Directory item: %d" index) + t))))))))) (defun shell-replace-by-expanded-directory () "Expand directory stack reference before point. @@ -1146,24 +1189,8 @@ See `default-directory' and `shell-dirstack'. Returns t if successful." (interactive) - (if (comint-match-partial-filename) - (save-excursion - (goto-char (match-beginning 0)) - (let ((stack (cons default-directory shell-dirstack)) - (index (cond ((looking-at "=-/?") - (length shell-dirstack)) - ((looking-at "=\\([0-9]+\\)/?") - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1))))))) - (cond ((null index) - nil) - ((>= index (length stack)) - (error "Directory stack not that deep")) - (t - (replace-match (file-name-as-directory (nth index stack)) t t) - (message "Directory item: %d" index) - t)))))) + (let ((f (shell-c-a-p-replace-by-expanded-directory))) + (if f (funcall f)))) (provide 'shell) diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 1de67615252..95ba7ebd86f 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -156,9 +156,9 @@ thus showing a page other than the one point was originally in." (if (= (match-beginning 0) (match-end 0)) (forward-char 1)) (setq count (1+ count))) - (message "Page %d, line %d" - count - (1+ (count-lines (point) opoint))))))) + (message "Page %d, line %d" count (line-number-at-pos opoint)))))) + + ;;; Place `provide' at end of file. (provide 'page) diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 271fce12429..abd3806d02f 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -128,6 +128,8 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'." (define-key m "p" 'vc-annotate-prev-revision) (define-key m "w" 'vc-annotate-working-revision) (define-key m "v" 'vc-annotate-toggle-annotation-visibility) + (define-key m "v" 'vc-annotate-toggle-annotation-visibility) + (define-key m "\C-m" 'vc-annotate-goto-line) m) "Local keymap used for VC-Annotate mode.") @@ -673,6 +675,36 @@ The annotations are relative to the current time, unless overridden by OFFSET." ;; Pretend to font-lock there were no matches. nil) +(defun vc-annotate-goto-line () + "Go to the line corresponding to the current VC Annotate line." + (interactive) + (unless (eq major-mode 'vc-annotate-mode) + (error "Not in a VC-Annotate buffer")) + (let ((line (save-restriction + (widen) + (line-number-at-pos))) + (rev vc-annotate-parent-rev)) + (pop-to-buffer + (or (and (buffer-live-p vc-parent-buffer) + vc-parent-buffer) + (and (file-exists-p vc-annotate-parent-file) + (find-file-noselect vc-annotate-parent-file)) + (error "File not found: %s" vc-annotate-parent-file))) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (recenter)) + ;; Issue a warning if the lines might be incorrect. + (cond + ((buffer-modified-p) + (message "Buffer modified; annotated line numbers may be incorrect")) + ((not (eq (vc-state buffer-file-name) 'up-to-date)) + (message "File is not up-to-date; annotated line numbers may be incorrect")) + ((not (equal rev (vc-working-revision buffer-file-name))) + (message "Annotations were for revision %s; line numbers may be incorrect" + rev))))) + (provide 'vc-annotate) ;;; vc-annotate.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7f55ffdbdad..3809b5b4293 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -653,6 +653,7 @@ (require 'vc-hooks) (require 'vc-dispatcher) +(require 'ediff) (eval-when-compile (require 'cl) @@ -1617,45 +1618,48 @@ returns t if the buffer had changes, nil otherwise." nil nil initial-input nil default) (read-string prompt initial-input nil default)))) +(defun vc-diff-build-argument-list-internal () + "Build argument list for calling internal diff functions." + (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef + (files (cadr vc-fileset)) + (backend (car vc-fileset)) + (first (car files)) + (rev1-default nil) + (rev2-default nil)) + (cond + ;; someday we may be able to do revision completion on non-singleton + ;; filesets, but not yet. + ((/= (length files) 1) + nil) + ;; if it's a directory, don't supply any revision default + ((file-directory-p first) + nil) + ;; if the file is not up-to-date, use working revision as older revision + ((not (vc-up-to-date-p first)) + (setq rev1-default (vc-working-revision first))) + ;; if the file is not locked, use last and previous revisions as defaults + (t + (setq rev1-default (vc-call-backend backend 'previous-revision first + (vc-working-revision first))) + (when (string= rev1-default "") (setq rev1-default nil)) + (setq rev2-default (vc-working-revision first)))) + ;; construct argument list + (let* ((rev1-prompt (if rev1-default + (concat "Older revision (default " + rev1-default "): ") + "Older revision: ")) + (rev2-prompt (concat "Newer revision (default " + (or rev2-default "current source") "): ")) + (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)))) + ;;;###autoload (defun vc-version-diff (files rev1 rev2) "Report diffs between revisions of the fileset in the repository history." - (interactive - (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef - (files (cadr vc-fileset)) - (backend (car vc-fileset)) - (first (car files)) - (rev1-default nil) - (rev2-default nil)) - (cond - ;; someday we may be able to do revision completion on non-singleton - ;; filesets, but not yet. - ((/= (length files) 1) - nil) - ;; if it's a directory, don't supply any revision default - ((file-directory-p first) - nil) - ;; if the file is not up-to-date, use working revision as older revision - ((not (vc-up-to-date-p first)) - (setq rev1-default (vc-working-revision first))) - ;; if the file is not locked, use last and previous revisions as defaults - (t - (setq rev1-default (vc-call-backend backend 'previous-revision first - (vc-working-revision first))) - (when (string= rev1-default "") (setq rev1-default nil)) - (setq rev2-default (vc-working-revision first)))) - ;; construct argument list - (let* ((rev1-prompt (if rev1-default - (concat "Older revision (default " - rev1-default "): ") - "Older revision: ")) - (rev2-prompt (concat "Newer revision (default " - (or rev2-default "current source") "): ")) - (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)))) + (interactive (vc-diff-build-argument-list-internal)) ;; All that was just so we could do argument completion! (when (and (not rev1) rev2) (error "Not a valid revision range")) @@ -1680,6 +1684,48 @@ saving the buffer." (vc-diff-internal t (vc-deduce-fileset t) nil nil (called-interactively-p 'interactive)))) +(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks)) + +;;;###autoload +(defun vc-version-ediff (files rev1 rev2) + "Show differences between revisions of the fileset in the +repository history using ediff." + (interactive (vc-diff-build-argument-list-internal)) + ;; All that was just so we could do argument completion! + (when (and (not rev1) rev2) + (error "Not a valid revision range")) + + (message "%s" (format "Finding changes in %s..." (vc-delistify files))) + + ;; Functions ediff-(vc|rcs)-internal use "" instead of nil. + (when (null rev1) (setq rev1 "")) + (when (null rev2) (setq rev2 "")) + + (cond + ;; FIXME We only support running ediff on one file for now. + ;; We could spin off an ediff session per file in the file set. + ((= (length files) 1) + (ediff-load-version-control) + (find-file (car files)) ;FIXME: find-file from Elisp is bad. + (ediff-vc-internal rev1 rev2 nil)) + (t + (error "More than one file is not supported")))) + +;;;###autoload +(defun vc-ediff (historic &optional not-urgent) + "Display diffs between file revisions using ediff. +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 + (call-interactively 'vc-version-ediff) + (when buffer-file-name (vc-buffer-sync not-urgent)) + (vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil))) + ;;;###autoload (defun vc-root-diff (historic &optional not-urgent) "Display diffs between VC-controlled whole tree revisions. |