diff options
Diffstat (limited to 'lisp')
149 files changed, 3123 insertions, 1382 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 351b6ea6cb8..255b8924784 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,484 @@ +2012-09-30 Juanma Barranquero <lekktu@gmail.com> + + * ido.el (ido-max-directory-size): Default to nil; the current + default is small for POSIX systems, and impractical on Windows 7 + now that lstat returns directory sizes for NTFS. + +2012-09-30 Martin Rudalics <rudalics@gmx.at> + + In buffer display functions handle window-height/window-width + alist entries. Suggested by Juri Linkov as fix for Bug#1806. + * window.el (window--display-buffer): New argument ALIST. Obey + window-height and window-width alist entries. + (window--try-to-split-window): New argument ALIST. Bind + window-combination-limit to t when the window's size shall be + changed and window-combination-limit equals `window-size'. + (display-buffer-in-atom-window) + (display-buffer-in-major-side-window) + (display-buffer-in-side-window, display-buffer-same-window) + (display-buffer-reuse-window, display-buffer-pop-up-frame) + (display-buffer-pop-up-window, display-buffer-below-selected) + (display-buffer-at-bottom, display-buffer-in-previous-window) + (display-buffer-use-some-window): Adjust all callers of + window--display-buffer and window--try-to-split-window. + (fit-frame-to-buffer): New option. + (fit-window-to-buffer): Can resize frames if fit-frame-to-buffer + is non-nil. + (display-buffer-in-major-side-window): Evaluate window-height / + window-width alist entries. + + * help.el (temp-buffer-resize-frames) + (temp-buffer-resize-regexps): Remove options. + (temp-buffer-resize-mode): Adjust doc-string. + (resize-temp-buffer-window): Don't consult + temp-buffer-resize-regexps. Use fit-frame-to-buffer instead of + temp-buffer-resize-frames. + + * dired.el (dired-mark-pop-up): Call + display-buffer-below-selected with a fit-window-to-buffer alist + entry. + +2012-09-30 Chong Yidong <cyd@gnu.org> + + * server.el (server-host): Document the security implications. + (server-auth-key): Doc fix. + + * startup.el (initial-buffer-choice): Doc fix. + + * minibuffer.el (minibuffer-local-filename-syntax): Doc fix. + + * simple.el (delete-trailing-whitespace): Avoid an unnecessary + restriction change. + + * bindings.el (goto-map): Bind M-g TAB to move-to-column. + + * help-fns.el (help-fns--obsolete): Fix last change. + +2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * winner.el (winner-mode-map): Obey winner-dont-bind-my-keys here. + (minor-mode-map-alist): Remove redundant code. + + * vc/pcvs.el (cvs-cleanup-collection): Keep entries that are currently + visited in a buffer. + (cvs-insert-visited-file): New function. + (find-file-hook): Use it. + + * vc/pcvs-info.el (cvs-fileinfo-pp): Don't use non-existent faces. + + * vc/log-edit.el (log-edit-font-lock-keywords): Ignore case to + chose face. + (log-edit-empty-buffer-p): Don't require a space after a header. + + * vc/ediff-util.el (ediff-diff-at-point): Don't assume point-min==1. + + * tutorial.el (help-with-tutorial): Use minibuffer-with-setup-hook. + + * textmodes/text-mode.el (paragraph-indent-minor-mode): Make it + a proper minor-mode. + + * textmodes/tex-mode.el (tex-mode-map): Don't bind paren keys. + +2012-09-29 Glenn Morris <rgm@gnu.org> + + * winner.el (winner-mode): Remove variable (let define-minor-mode + handle it). + (winner-dont-bind-my-keys, winner-boring-buffers, winner-mode-hook): + Doc fixes. + (winner-mode-leave-hook): Rename to winner-mode-off-hook. + (winner-mode): Use define-minor-mode. + + * vc/vc-sccs.el (vc-sccs-registered): Use the progn trick to get + the full definition in loaddefs, rather than duplicating it. + + * help-macro.el (three-step-help): No need to autoload defcustom. + + * progmodes/inf-lisp.el (inferior-lisp-filter-regexp) + (inferior-lisp-program, inferior-lisp-load-command) + (inferior-lisp-prompt, inferior-lisp-mode-hook): + No need to autoload defcustoms. + + * hippie-exp.el (hippie-expand-try-functions-list) + (hippie-expand-verbose, hippie-expand-dabbrev-skip-space) + (hippie-expand-dabbrev-as-symbol, hippie-expand-no-restriction) + (hippie-expand-max-buffers, hippie-expand-ignore-buffers) + (hippie-expand-only-buffers): No need to autoload defcustoms. + * progmodes/vhdl-mode.el (vhdl-line-expand): + Explicitly load hippie-exp, so it does not get autoloaded + while hippie-expand-try-functions-list is let-bound. + +2012-09-28 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl.el (flet): Fix case of obsolescence message. + + * emacs-lisp/bytecomp.el (byte-compile-cl-file-p): + Only "cl.el" counts as cl these days. + +2012-09-28 Juri Linkov <juri@jurta.org> + + Display archive errors in the echo area instead of inserting + to the file buffer. + + * arc-mode.el (archive-extract-by-stdout): Change arg STDERR-FILE + to STDERR-TEST that can be a regexp matching a successful output. + Create a temporary file and redirect stderr to it. Search for + STDERR-TEST in the stderr output and display it in the echo area + if no match is found. + (archive-extract-by-file): New function like + `archive-extract-by-stdout' but extracting archives to files + and looking for successful matches in stdout. Function body is + mostly copied from `archive-rar-extract'. + (archive-rar-extract): Use `archive-extract-by-file'. + (archive-7z-extract): Use `archive-extract-by-stdout'. (Bug#10347) + +2012-09-28 Leo Liu <sdl.web@gmail.com> + + * pcomplete.el (pcomplete-show-completions): Use + minibuffer-message to make pcomplete usable in minibuffer. + + * ido.el (ido-set-matches-1): Fix 2012-09-11 change. + +2012-09-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * type-break.el: Use lexical-binding. + (type-break-mode): Use define-minor-mode. + + * emacs-lisp/pcase.el (pcase--mark-used): New. + (pcase--u1): Use it (bug#12512). + + * custom.el (load-theme): Set buffer-file-name so the load is recorded + in load-history with the right file name. + +2012-09-28 Tassilo Horn <tsdh@gnu.org> + + * doc-view.el (doc-view-current-cache-doc-pdf): New function. + (doc-view-doc->txt, doc-view-convert-current-doc): Use it. + (doc-view-get-bounding-box): Make bounding box slicing work for + ODF and DVI documents. + +2012-09-28 Glenn Morris <rgm@gnu.org> + + * type-break.el (type-break-mode, type-break-interval) + (type-break-good-rest-interval, type-break-keystroke-threshold): + No need to autoload. + (type-break-good-rest-interval, type-break-keystroke-threshold): + Add :set-after. + +2012-09-28 Chong Yidong <cyd@gnu.org> + + * progmodes/verilog-mode.el (verilog-auto-inst-interfaced-ports): + Add :version tag. + +2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * json.el (json-encode-char): Codes 127-160 aren't "ASCII printable". + +2012-09-27 Glenn Morris <rgm@gnu.org> + + * faces.el (x-display-name): Declare (for without-x builds). + + * linum.el (linum-format): Don't autoload it. Improve :type. + + * progmodes/tcl.el: Don't require outline when compiling. + (outline-regexp, outline-level): Declare. + * textmodes/sgml-mode.el: Don't require outline when compiling. + (outline-regexp, outline-heading-end-regexp, outline-level): Declare. + + * term.el (term-ansi-reset): + Try setting term-ansi-face-already-done to nil. (Bug#11785) + + * vc/vc.el (vc-next-action): Only gripe about committing read-only + files for RCS and SCCS. (Bug#9781) + +2012-09-27 Chong Yidong <cyd@gnu.org> + + * progmodes/verilog-mode.el (verilog-mode-release-emacs): Fix last + change; value should be t. + +2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * image-mode.el: Use lexical-binding. + (image-mode-winprops): Use t to stand for the window of + a buffer that's not displayed. + * doc-view.el (doc-view-new-window-function): Handle the new + t in winprops. + (doc-view-enlarge): Make it a real nop if the size is not changed. + (doc-view-display): Handle the case where the buffer is not (yet?) + displayed in any window. + (doc-view-saved-settings): New var. + (doc-view-mode): Use it. + (doc-view-fallback-mode): Set it. + + * minibuf-eldef.el: Make it possible to replace (default ...) with [...]. + Set lexical-binding. + (minibuffer-eldef-shorten-default): New var. + (minibuffer-default-in-prompt-regexps): Use it for new default. + (minibuf-eldef-setup-minibuffer): Add replacement functionality. + +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * international/uni-bidi.el: + * international/uni-category.el: + * international/uni-name.el: + * international/uni-numeric.el: Regenerate. + +2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org> + Stefan Monnier <monnier@iro.umontreal.ca> + + * profiler.el: New file. + +2012-09-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/testcover.el (testcover-after): Add gv-expander. + (testcover-reinstrument): Simplify with CSE. + +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * window.el (temp-buffer-window-setup): Fix typo in docstring. + +2012-09-25 Wilson Snyder <wsnyder@wsnyder.org> + + * verilog-mode.el (verilog-auto-ascii-enum, verilog-auto-inout) + (verilog-auto-input, verilog-auto-insert-lisp) + (verilog-auto-output, verilog-auto-output-every, verilog-auto-reg) + (verilog-auto-reg-input, verilog-auto-tieoff, verilog-auto-undef) + (verilog-auto-unused, verilog-auto-wire) + (verilog-forward-or-insert-line): Fix AUTOs with no trailing + newline. Reported by Andrew Jones. + (verilog-auto-inst) Support expanding $clog2 in AUTOINST. + Reported by Brad Dobbie. + (verilog-batch-delete-trailing-whitespace): + Create verilog-batch-delete-trailing-whitespace. + Reported by Brad Dobbie. + (verilog-auto-inout-param): Support AUTOINOUTPARAM for copying + parameters from another module. Reported by Dan Katz. + (verilog-auto, verilog-auto-assign-modport) + (verilog-auto-inout-modport): Add AUTOASSIGNMODPORT and + AUTOINOUTMODPORT for UVM interface module shell generation. + Reported by Brad Dobbie. + (verilog-auto-inst-interfaced-ports): Make default nil, as more + standard behavior. + (verilog-auto): Fix AUTO parameters with parenthesis arguments. + Reported by Matt Martin. + +2012-09-25 Martin Rudalics <rudalics@gmx.at> + + * window.el (window--resize-child-windows): When resizing child + windows proportionally, process them in reverse order to + preserve the "when splitting a window the new one gets the odd + line" behavior. + (window--resize-root-window-vertically): When resizing the + minibuffer window try to affect only windows at the bottom of the + frame. (Bug#12419) + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * subr.el (declare): Doc fix. + + * help-fns.el (help-fns--obsolete): Handle macros properly. + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * bookmark.el (bookmark-jump-noselect): Use a declare form to mark + this function obsolete. + + * calendar/cal-x.el (calendar-two-frame-setup) + (calendar-only-one-frame-setup, calendar-one-frame-setup): + * calendar/calendar.el (american-calendar, european-calendar) + (calendar-for-loop): + * comint.el (comint-dynamic-simple-complete) + (comint-dynamic-complete-as-filename, comint-unquote-filename): + * desktop.el (desktop-load-default): + * dired-x.el (dired-omit-here-always) + (dired-hack-local-variables, dired-default-directory): + * emacs-lisp/derived.el (derived-mode-class): + * emacs-lisp/timer.el (timer-set-time-with-usecs): + * emacs-lock.el (toggle-emacs-lock): + * epa.el (epa-display-verify-result): + * epg.el (epg-sign-keys, epg-start-sign-keys) + (epg-passphrase-callback-function): + * eshell/esh-util.el (eshell-for): + * eshell/eshell.el (eshell-remove-from-window-buffer-names) + (eshell-add-to-window-buffer-names): + * files.el (locate-file-completion): + * imenu.el (imenu-example--create-c-index) + (imenu-example--create-lisp-index) + (imenu-example--lisp-extract-index-name) + (imenu-example--name-and-position): + * international/mule-cmds.el (princ-list): + * international/mule-diag.el (decode-codepage-char): + * international/mule-util.el (detect-coding-with-priority): + * iswitchb.el (iswitchb-read-buffer): + * mail/mailalias.el (mail-complete): + * mail/sendmail.el (mail-sent-via): + * mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar) + (mouse-major-mode-menu): + * password-cache.el (password-read-and-add): + * pcomplete.el (pcomplete-parse-comint-arguments): + * progmodes/sh-script.el (sh-maybe-here-document): + * replace.el (query-replace-regexp-eval): + * savehist.el (savehist-load): + * simple.el (choose-completion-delete-max-match): + * term.el (term-dynamic-simple-complete): + * vc/ediff-init.el (ediff-check-version): + * vc/ediff-wind.el (ediff-choose-window-setup-function-automatically): + * vc/vc.el (vc-diff-switches-list): + * view.el (view-return-to-alist-update): Likewise. + + * subr.el (eval-next-after-load, makehash, insert-string) + (assoc-ignore-representation, assoc-ignore-case): Use declare to + mark obsolete. + (mode-line-inverse-video): Variable deleted. + + * international/mule-util.el (string-to-sequence): Remove. + + * calendar/calendar.el (calendar-version): + * calendar/icalendar.el (icalendar-extract-ical-from-buffer) + (icalendar-convert-diary-to-ical): + * cus-edit.el (custom-mode): + * ansi-color.el (ansi-color-unfontify-region): + * international/latin1-disp.el (latin1-char-displayable-p): + * progmodes/cwarn.el (turn-on-cwarn-mode): + * progmodes/which-func.el (which-func-update-1): + Use define-obsolete-function-alias. + + * net/newst-backend.el (newsticker-cache-filename): + * net/newst-treeview.el (newsticker-groups-filename): + Fix incorrect obsolescence declaration. + + * allout.el (allout-passphrase-hint-string): Likewise. + (allout-init): Use a declare form to mark obsolete. + + * emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that + this applies to functions. + + * iswitchb.el (iswitchb-read-buffer): Move code of + iswitchb-define-mode-map here, and delete that obsolete function. + + * net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete + font-lock-reference-face. + +2012-09-25 Glenn Morris <rgm@gnu.org> + + * buff-menu.el (Buffer-menu-name-width, Buffer-menu-size-width): + Doc fixes. + + * eshell/em-term.el (eshell-term-name): + Default to term-term-name. (Bug#12485) + +2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-shell-send-buffer): Better handling + of "if __name__ == '__main__':" conditionals when sending the buffer. + +2012-09-24 Glenn Morris <rgm@gnu.org> + + * eshell/esh-cmd.el (eshell-find-alias-function): + Tighten up file-name regexp. (Bug#12499) + +2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca> + + Enhancements for triple-quote string syntax. + * progmodes/python.el (python-quote-syntax): Remove. + (python-syntax-propertize-function): New value. + (python-syntax-count-quotes, python-syntax-stringify): + New functions. + +2012-09-24 Chong Yidong <cyd@gnu.org> + + * mail/supercite.el (sc-version): Remove obsolete function. + (sc-describe): Don't mark as obsolete, since it is bound. + (sc-submit-bug-report): Remove. + + * vc/log-edit.el (cvs-changelog-full-paragraphs) + (cvs-commit-buffer-require-final-newline): Remove. + (log-edit-require-final-newline) + (log-edit-changelog-full-paragraphs): Default to t. + + * vc/pcvs-defs.el (cvs-diff-buffer-name, cvs-diff-ignore-marks) + * vc/vc-hooks.el (vc-ignore-vc-files, vc-master-templates) + * vc/vc.el (vc-checkout-carefully): Likewise. + + * vc/emerge.el (emerge-mode): Make it an obsolete alias. + (emerge-version): Remove. + + * progmodes/compile.el (compile-internal): Remove. + (compilation-parse-errors-function): Fix typo. + + * international/mule.el (set-char-table-default): Remove. + (set-coding-priority, make-coding-system, generic-char-p) + (charset-list, charset-bytes, charset-id): Use declare to mark + functions as obsolete. + + * vc/pcvs-defs.el (cvs-buffer-name-alist) + (cvs-invert-ignore-marks): Remove references to obsolete vars. + * vc/vc-hooks.el (vc-default-registered): Don't use + vc-master-templates. + + * font-lock.el (font-lock-reference-face): + Use define-obsolete-variable-alias. + + * generic-x.el (rul-generic-mode): Use font-lock-constant-face. + * calendar/calendar.el (calendar-font-lock-keywords): + * calendar/diary-lib.el (diary-font-lock-keywords) + (diary-fancy-font-lock-keywords): + * textmodes/reftex-sel.el (reftex-insert-docstruct): + * textmodes/reftex-index.el (reftex-insert-index): + * textmodes/reftex-cite.el (reftex-format-bib-entry): + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + * progmodes/ps-mode.el (ps-mode-font-lock-keywords-1): + * progmodes/prolog.el (prolog-font-lock-keywords): + * progmodes/idlwave.el (idlwave-idl-keywords): + * progmodes/ada-mode.el (ada-font-lock-keywords): + * net/snmp-mode.el (snmp-font-lock-keywords-3): Likewise. + +2012-09-24 Glenn Morris <rgm@gnu.org> + + * mail/emacsbug.el (report-emacs-bug): Include `lsb_release -d'. + +2012-09-23 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-indent-line): More consistent cursor + movement behavior. + +2012-09-23 Stefan Merten <smerten@oekonux.de> + + * textmodes/rst.el: Fix compiler warning. + +2012-09-23 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-autokey-transcriptions): + Transcribe also LaTeX hyphenation. + (bibtex-reformat): Bug fix. Do not quote twice the elements of + bibtex-reformat-previous-options. + +2012-09-23 Roland Winkler <winkler@gnu.org> + + * proced.el (proced-renice-command): New variable. + (proced-marked-processes): New function. + (proced-with-processes-buffer): New macro. + (proced-send-signal): Use them. + (proced-renice): New command bound to r. + +2012-09-23 Roland Winkler <winkler@gnu.org> + + * ibuf-ext.el (ibuffer-switch-to-saved-filter-groups): If list + ibuffer-saved-filter-groups has one element, shortcut the call of + completing-read. (Bug#12331) + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * bindings.el (mode-line-toggle-read-only): + * bs.el (bs-toggle-readonly): + * buff-menu.el (Buffer-menu-toggle-read-only): + * dired.el (dired-toggle-read-only): + * ibuffer.el (ibuffer-do-toggle-read-only): Use read-only-mode. + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * image.el (image-type-available-p): Adapt to init-image-library + argument changes. + 2012-09-22 Juri Linkov <juri@jurta.org> * dired.el (dired-mode-map): Add [remap read-only-mode] for @@ -45,7 +526,7 @@ 2012-09-22 Stefan Merten <smerten@oekonux.de> - * rst.el: Revamp section title faces. + * textmodes/rst.el: Revamp section title faces. (rst-official-version) (rst-package-emacs-version-alist): Sync with official version V1.4.0. @@ -120,15 +601,15 @@ 2012-09-20 Stefan Merten <smerten@oekonux.de> - * rst.el: Integrate support for `imenu' and `which-function'. + * textmodes/rst.el: Integrate support for `imenu' and `which-function'. Fixes feature request bug#11711. (rst-mode): Create `imenu-create-index-function'. (rst-get-stripped-line): Delete after refactoring. (rst-section-tree, rst-section-tree-rec) (rst-section-tree-point): Refactor and document properly. (rst-imenu-find-adornments-for-position) - (rst-imenu-convert-cell, rst-imenu-create-index): New - function. + (rst-imenu-convert-cell, rst-imenu-create-index): + New function. 2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca> @@ -260,7 +741,7 @@ 2012-09-17 Stefan Merten <smerten@oekonux.de> - * rst.el: Add support for `testcover'. + * textmodes/rst.el: Add support for `testcover'. (rst-defcustom-testcover, rst-testcover-add-compose) (rst-testcover-add-1value): New functions. (rst-portable-mark-active-p): Replace by `use-region-p'. @@ -2096,7 +2577,7 @@ 2012-07-30 Stefan Merten <smerten@oekonux.de> - * rst.el: Silence `checkdoc-ispell'. + * textmodes/rst.el: Silence `checkdoc-ispell'. (rst-cvs-header, rst-svn-rev, rst-svn-timestamp) (rst-official-version, rst-official-cvs-rev) (rst-package-emacs-version-alist): Update to upstream V1.3.1. @@ -9488,7 +9969,7 @@ Declare as obsolete. (ns-get-pasteboard, ns-paste-secondary): Use ns-get-selection-internal. - (ns-set-pasteboard, ns-copy-including-secondary): + (ns-set-pasteboard, ns-copy-including-secondary): Use ns-store-selection-internal. 2011-12-17 Chong Yidong <cyd@gnu.org> diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 0380fb117db..db5c2f84511 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -2372,7 +2372,7 @@ (sh-mode-map): Added new bindings. (sh-mode): Updated mode doc-string for new commands, added make-local-variable calls, initialize mode-specific variables. - (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line + (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line is now a different function. (sh-header-marker): Changed docstring. (sh-set-shell): Initialize mode-specific variables. diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index 5c01f872994..5c71fb860ec 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -569,7 +569,7 @@ Don't bind mouse events or tab/backtab. (help-function, help-variable, help-face, help-coding-system) (help-input-method, help-character-set, help-back, help-info) - (help-customize-variable, help-function-def, help-variable-def): + (help-customize-variable, help-function-def, help-variable-def): New button types. (help-button-action): New function. (describe-function-1): Pass help button-types to @@ -20671,7 +20671,7 @@ * term/tty-colors.el (tty-defined-color-alist): Renamed from tty-color-alist. (tty-color-alist, tty-modify-color-alist): New functions. - (tty-color-define, tty-color-clear, tty-color-approximate) + (tty-color-define, tty-color-clear, tty-color-approximate) (tty-color-translate, tty-color-by-index, tty-color-desc): Accept an optional parameter FRAME. diff --git a/lisp/allout.el b/lisp/allout.el index acf0b7d75b6..04de853ebe0 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1522,8 +1522,8 @@ The verifier string is retained as an Emacs file variable, as well as in the Emacs buffer state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-verifier-string) -(make-obsolete 'allout-passphrase-verifier-string - 'allout-passphrase-verifier-string "23.3") +(make-obsolete-variable 'allout-passphrase-verifier-string + 'allout-passphrase-verifier-string "23.3") ;;;###autoload (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) ;;;_ = allout-passphrase-hint-string @@ -1538,8 +1538,8 @@ state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-hint-string) (setq-default allout-passphrase-hint-string "") -(make-obsolete 'allout-passphrase-hint-string - 'allout-passphrase-hint-string "23.3") +(make-obsolete-variable 'allout-passphrase-hint-string + 'allout-passphrase-hint-string "23.3") ;;;###autoload (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) ;;;_ = allout-after-save-decrypt @@ -1688,11 +1688,10 @@ from what it did before, for backwards compatibility. MODE is the activation mode - see `allout-auto-activation' for valid values." - + (declare (obsolete allout-auto-activation "23.3")) (custom-set-variables (list 'allout-auto-activation (format "%s" mode))) (format "%s" mode)) -(make-obsolete 'allout-init - "customize 'allout-auto-activation' instead." "23.3") + ;;;_ > allout-setup-menubar () (defun allout-setup-menubar () "Populate the current buffer's menubar with `allout-mode' stuff." diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 8305aaf1199..047b4b944b9 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -230,8 +230,8 @@ This is a good function to put in `comint-output-filter-functions'." (t (ansi-color-apply-on-region start-marker end-marker))))) -(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region) -(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1") +(define-obsolete-function-alias 'ansi-color-unfontify-region + 'font-lock-default-unfontify-region "24.1") ;; Working with strings (defvar ansi-color-context nil diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index c776a3f8b5c..a97a052dc08 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1117,13 +1117,54 @@ using `make-temp-file', and the generated name is returned." (archive-delete-local tmpfile) success)) -(defun archive-extract-by-stdout (archive name command &optional stderr-file) - (apply 'call-process - (car command) - nil - (if stderr-file (list t stderr-file) t) - nil - (append (cdr command) (list archive name)))) +(defun archive-extract-by-stdout (archive name command &optional stderr-test) + (let ((stderr-file (make-temp-file "arc-stderr"))) + (unwind-protect + (prog1 + (apply 'call-process + (car command) + nil + (if stderr-file (list t stderr-file) t) + nil + (append (cdr command) (list archive name))) + (with-temp-buffer + (insert-file-contents stderr-file) + (goto-char (point-min)) + (when (if (stringp stderr-test) + (not (re-search-forward stderr-test nil t)) + (> (buffer-size) 0)) + (message "%s" (buffer-string))))) + (if (file-exists-p stderr-file) + (delete-file stderr-file))))) + +(defun archive-extract-by-file (archive name command &optional stdout-test) + (let ((dest (make-temp-file "arc-dir" 'dir)) + (stdout-file (make-temp-file "arc-stdout"))) + (unwind-protect + (prog1 + (apply 'call-process + (car command) + nil + `(:file ,stdout-file) + nil + (append (cdr command) (list archive name dest))) + (with-temp-buffer + (insert-file-contents stdout-file) + (goto-char (point-min)) + (when (if (stringp stdout-test) + (not (re-search-forward stdout-test nil t)) + (> (buffer-size) 0)) + (message "%s" (buffer-string)))) + (if (file-exists-p (expand-file-name name dest)) + (insert-file-contents-literally (expand-file-name name dest)))) + (if (file-exists-p stdout-file) + (delete-file stdout-file)) + (if (file-exists-p (expand-file-name name dest)) + (delete-file (expand-file-name name dest))) + (while (file-name-directory name) + (setq name (directory-file-name (file-name-directory name))) + (delete-directory (expand-file-name name dest))) + (delete-directory dest)))) (defun archive-extract-other-window () "In archive mode, find this member in another window." @@ -2006,17 +2047,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; The code below assumes the name is relative and may do undesirable ;; things otherwise. (error "Can't extract files with non-relative names") - (let ((dest (make-temp-file "arc-rar" 'dir))) - (unwind-protect - (progn - (call-process "unrar-free" nil nil nil - "--extract" archive name dest) - (insert-file-contents-literally (expand-file-name name dest))) - (delete-file (expand-file-name name dest)) - (while (file-name-directory name) - (setq name (directory-file-name (file-name-directory name))) - (delete-directory (expand-file-name name dest))) - (delete-directory dest))))) + (archive-extract-by-file archive name '("unrar-free" "--extract") "All OK"))) ;;; Section: Rar self-extracting .exe archives. @@ -2099,17 +2130,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (apply 'vector files)))) (defun archive-7z-extract (archive name) - (let ((tmpfile (make-temp-file "7z-stderr"))) - ;; 7z doesn't provide a `quiet' option to suppress non-essential - ;; stderr messages. So redirect stderr to a temp file and display it - ;; in the echo area when it contains error messages. - (prog1 (archive-extract-by-stdout - archive name archive-7z-extract tmpfile) - (with-temp-buffer - (insert-file-contents tmpfile) - (unless (search-forward "Everything is Ok" nil t) - (message "%s" (buffer-string))) - (delete-file tmpfile))))) + ;; 7z doesn't provide a `quiet' option to suppress non-essential + ;; stderr messages. So redirect stderr to a temp file and display it + ;; in the echo area when it contains no message indicating success. + (archive-extract-by-stdout + archive name archive-7z-extract "Everything is Ok")) (defun archive-7z-write-file-member (archive descr) (archive-*-write-file-member diff --git a/lisp/bindings.el b/lisp/bindings.el index c20a7f30eea..b4f9d29fe52 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -40,7 +40,7 @@ corresponding to the mode line clicked." (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (call-interactively 'toggle-read-only))) + (read-only-mode 'toggle))) (defun mode-line-toggle-modified (event) "Toggle the buffer-modified flag from the mode-line." @@ -898,6 +898,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key goto-map "\M-n" 'next-error) (define-key goto-map "p" 'previous-error) (define-key goto-map "\M-p" 'previous-error) +(define-key goto-map "\t" 'move-to-column) (defvar search-map (make-sparse-keymap) "Keymap for search related commands.") diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 31bbc13acf9..26ba1dec00f 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1048,12 +1048,11 @@ The return value has the form (BUFFER . POINT). Note: this function is deprecated and is present for Emacs 22 compatibility only." + (declare (obsolete bookmark-handle-bookmark "23.1")) (save-excursion (bookmark-handle-bookmark bookmark) (cons (current-buffer) (point)))) -(make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1") - (defun bookmark-handle-bookmark (bookmark-name-or-record) "Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler' if it has none. This changes current buffer and point and returns nil, diff --git a/lisp/bs.el b/lisp/bs.el index 09aefee416e..a84c951acfe 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -962,7 +962,7 @@ Default is `bs--current-sort-function'." Uses function `toggle-read-only'." (interactive) (with-current-buffer (bs--current-buffer) - (call-interactively 'toggle-read-only)) + (read-only-mode 'toggle)) (bs--update-current-line)) (defun bs-clear-modified () diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 589b6ebc47a..6ab6e548ab5 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -64,13 +64,13 @@ minus `Buffer-menu-size-width'. This use is deprecated." "24.3") (defcustom Buffer-menu-name-width 19 - "Width of buffer size column in the Buffer Menu." + "Width of buffer name column in the Buffer Menu." :type 'number :group 'Buffer-menu :version "24.3") (defcustom Buffer-menu-size-width 7 - "Width of buffer name column in the Buffer Menu." + "Width of buffer size column in the Buffer Menu." :type 'number :group 'Buffer-menu :version "24.3") @@ -520,7 +520,7 @@ This behaves like invoking \\[toggle-read-only] in that buffer." (interactive) (let ((read-only (with-current-buffer (Buffer-menu-buffer t) - (call-interactively 'toggle-read-only) + (read-only-mode 'toggle) buffer-read-only))) (tabulated-list-set-col 1 (if read-only "%" " ") t))) diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 9c01ab40c0c..325ac3e8146 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1097,7 +1097,7 @@ shown are hard-coded to 8-12, 13-17." (cal-tex-longday "leftday" "2.75in")) (cal-tex-b-document) (cal-tex-cmd "\\pagestyle" "empty") - ;; Let's assume this is something to with twopage documents. + ;; Let's assume this is something to do with twopage documents. ;; It has the downside that we start with a blank page. ;; It doesn't make obvious sense when oddside and evenside margins ;; are the same (non-filofax), but consider the left and right diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 0f2d43b2237..6fba7fb7423 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -155,29 +155,23 @@ If PROMPT is non-nil, prompt for the month and year to use." (defun calendar-one-frame-setup (&optional prompt) "Display calendar and diary in a single dedicated frame. See `calendar-frame-setup' for more information." + (declare (obsolete calendar-frame-setup "23.1")) (calendar-frame-setup 'one-frame prompt)) -(make-obsolete 'calendar-one-frame-setup 'calendar-frame-setup "23.1") - - ;;;###cal-autoload (defun calendar-only-one-frame-setup (&optional prompt) "Display calendar in a dedicated frame. See `calendar-frame-setup' for more information." + (declare (obsolete calendar-frame-setup "23.1")) (calendar-frame-setup 'calendar-only prompt)) -(make-obsolete 'calendar-only-one-frame-setup 'calendar-frame-setup "23.1") - - ;;;###cal-autoload (defun calendar-two-frame-setup (&optional prompt) "Display calendar and diary in separate, dedicated frames. See `calendar-frame-setup' for more information." + (declare (obsolete calendar-frame-setup "23.1")) (calendar-frame-setup 'two-frames prompt)) -(make-obsolete 'calendar-two-frame-setup 'calendar-frame-setup "23.1") - - ;; Undocumented and probably useless. (defvar cal-x-load-hook nil "Hook run on loading of the `cal-x' package.") diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 93ef440541e..6f8311f4c55 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1001,18 +1001,16 @@ The valid styles are described in the documentation of `calendar-date-style'." (defun european-calendar () "Set the interpretation and display of dates to the European style." + (declare (obsolete calendar-set-date-style "23.1")) (interactive) (calendar-set-date-style 'european)) -(make-obsolete 'european-calendar 'calendar-set-date-style "23.1") - (defun american-calendar () "Set the interpretation and display of dates to the American style." + (declare (obsolete calendar-set-date-style "23.1")) (interactive) (calendar-set-date-style 'american)) -(make-obsolete 'american-calendar 'calendar-set-date-style "23.1") - (define-obsolete-variable-alias 'holidays-in-diary-buffer 'diary-show-holidays-flag "23.1") @@ -1148,14 +1146,13 @@ MON defaults to `displayed-month'. YR defaults to `displayed-year'." "Execute a for loop. Evaluate BODY with VAR bound to successive integers from INIT to FINAL, inclusive. The standard macro `dotimes' is preferable in most cases." - (declare (debug (symbolp "from" form "to" form "do" body)) + (declare (obsolete "use `dotimes' or `while' instead." "23.1") + (debug (symbolp "from" form "to" form "do" body)) (indent defun)) `(let ((,var (1- ,init))) (while (>= ,final (setq ,var (1+ ,var))) ,@body))) -(make-obsolete 'calendar-for-loop "use `dotimes' or `while' instead." "23.1") - (defmacro calendar-sum (index initial condition expression) "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION." (declare (debug (symbolp form form form))) @@ -2298,7 +2295,7 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on." ;; First two chars of each day are used in the calendar. (,(regexp-opt (mapcar (lambda (x) (substring x 0 calendar-day-header-width)) calendar-day-name-array)) - . font-lock-reference-face)) + . font-lock-constant-face)) "Default keywords to highlight in Calendar mode.") (defun calendar-day-name (date &optional abbrev absolute) @@ -2655,13 +2652,7 @@ If called by a mouse-event, pops up a menu with the result." "---") (calendar-string-spread (list str) ?- width))))) -(defun calendar-version () - "Display the Calendar version." - (interactive) - (message "GNU Emacs %s" emacs-version)) - -(make-obsolete 'calendar-version 'emacs-version "23.1") - +(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1") (run-hooks 'calendar-load-hook) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 4bce8ec0927..27c6f76581c 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -2400,10 +2400,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (cons (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol) (regexp-quote diary-sexp-entry-symbol)) - '(1 font-lock-reference-face)) + '(1 font-lock-constant-face)) (cons (format "^%s" (regexp-quote diary-nonmarking-symbol)) - 'font-lock-reference-face) + 'font-lock-constant-face) (cons (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) (regexp-opt (mapcar 'regexp-quote @@ -2411,7 +2411,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." diary-islamic-entry-symbol diary-bahai-entry-symbol)) t)) - '(1 font-lock-reference-face)) + '(1 font-lock-constant-face)) '(diary-font-lock-sexps . font-lock-keyword-face) ;; Don't need to worry about space around "-" because the first ;; match takes care of that. It does mean the "-" itself may or @@ -2482,7 +2482,7 @@ This depends on the calendar date style." (defvar diary-fancy-font-lock-keywords `((diary-fancy-date-matcher . diary-face) ("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) - ("^.*Yahrzeit.*$" . font-lock-reference-face) + ("^.*Yahrzeit.*$" . font-lock-constant-face) ("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) ("^Day.*omer.*$" . font-lock-builtin-face) ("^Parashat.*$" . font-lock-comment-face) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 7326aa530ad..39b83d4c831 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -931,8 +931,8 @@ Finto iCalendar file: ") (set-buffer (find-file diary-filename)) (icalendar-export-region (point-min) (point-max) ical-filename))) -(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) -(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1") +(define-obsolete-function-alias 'icalendar-convert-diary-to-ical + 'icalendar-export-file "22.1") (defvar icalendar--uid-count 0 "Auxiliary counter for creating unique ids.") @@ -1881,8 +1881,8 @@ buffer `*icalendar-errors*'." ;; return nil, i.e. import did not work nil))) -(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) -(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1") +(define-obsolete-function-alias 'icalendar-extract-ical-from-buffer + 'icalendar-import-buffer "22.1") (defun icalendar--format-ical-event (event) "Create a string representation of an iCalendar EVENT." diff --git a/lisp/comint.el b/lisp/comint.el index 994d81a375a..fea9cecfa03 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3069,11 +3069,11 @@ Magic characters are those in `comint-file-name-quote-list'." (defun comint-unquote-filename (filename) "Return FILENAME with quoted characters unquoted." + (declare (obsolete nil "24.3")) (if (null comint-file-name-quote-list) filename (save-match-data (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t)))) -(make-obsolete 'comint-unquote-filename nil "24.3") (defun comint--requote-argument (upos qstr) ;; See `completion-table-with-quoting'. @@ -3170,10 +3170,9 @@ See `completion-table-with-quoting' and `comint-unquote-function'.") (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." + (declare (obsolete comint-filename-completion "24.1")) (let ((data (comint--complete-file-name-data))) (completion-in-region (nth 0 data) (nth 1 data) (nth 2 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. @@ -3204,6 +3203,7 @@ Return `partial' if completed as far as possible. Return `listed' if a completion listing was shown. See also `comint-dynamic-complete-filename'." + (declare (obsolete completion-in-region "24.1")) (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) (minibuffer-p (window-minibuffer-p (selected-window))) (suffix (cond ((not comint-completion-addsuffix) "") @@ -3246,8 +3246,6 @@ 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." diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 2e6f2b14625..8e06b16bd12 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2228,9 +2228,9 @@ and `face'." (setq widget nil))))) (widget-setup)) -(make-obsolete 'custom-show "this widget type is no longer supported." "24.1") (defun custom-show (widget value) "Non-nil if WIDGET should be shown with VALUE by default." + (declare (obsolete "this widget type is no longer supported." "24.1")) (let ((show (widget-get widget :custom-show))) (if (functionp show) (funcall show widget value) @@ -4823,12 +4823,7 @@ if that value is non-nil." (put 'Custom-mode 'mode-class 'special) -;; backward-compatibility -(defun custom-mode () - "Non-interactive variant of `Custom-mode'." - (Custom-mode)) -(make-obsolete 'custom-mode 'Custom-mode "23.1") -(put 'custom-mode 'mode-class 'special) +(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1") (add-to-list 'debug-ignored-errors "^Invalid face:? ") diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a91a479b054..28c1d3e3026 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -443,7 +443,6 @@ since it could result in memory overflow and make Emacs crash." (hscroll-step windows number "22.1") (truncate-partial-width-windows display boolean "23.1") (make-cursor-line-fully-visible windows boolean) - (mode-line-inverse-video mode-line boolean) (mode-line-in-non-selected-windows mode-line boolean "22.1") (line-number-display-limit display (choice integer diff --git a/lisp/custom.el b/lisp/custom.el index dfc8e631152..dc810e3c97d 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1193,7 +1193,8 @@ Return t if THEME was successfully loaded, nil otherwise." (expand-file-name "themes/" data-directory))) (member hash custom-safe-themes) (custom-theme-load-confirm hash)) - (let ((custom--inhibit-theme-enable t)) + (let ((custom--inhibit-theme-enable t) + (buffer-file-name fn)) ;For load-history. (eval-buffer)) ;; Optimization: if the theme changes the `default' face, put that ;; entry first. This avoids some `frame-set-background-mode' rigmarole diff --git a/lisp/desktop.el b/lisp/desktop.el index 75deb58b4d8..c8023bb43ed 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1045,11 +1045,10 @@ Using it may cause conflicts. Use it anyway? " owner))))) (defun desktop-load-default () "Load the `default' start-up library manually. Also inhibit further loading of it." + (declare (obsolete desktop-save-mode "22.1")) (unless inhibit-default-init ; safety check (load "default" t t) (setq inhibit-default-init t))) -(make-obsolete 'desktop-load-default - 'desktop-save-mode "22.1") ;; ---------------------------------------------------------------------------- ;;;###autoload diff --git a/lisp/dired-x.el b/lisp/dired-x.el index f176cf7dbe0..1237eef86cf 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -723,15 +723,13 @@ determine a default directory.") (defun dired-default-directory () "Return the `dired-default-directory-alist' entry for the current major-mode. If none, return `default-directory'." + ;; It looks like this was intended to be something of a "general" + ;; feature, but it only ever seems to have been used in + ;; dired-smart-shell-command, and doesn't seem worth keeping around. + (declare (obsolete nil "24.1")) (or (eval (cdr (assq major-mode dired-default-directory-alist))) default-directory)) -;; It looks like this was intended to be something of a "general" feature, -;; but it only ever seems to have been used in dired-smart-shell-command, -;; and does not seem worth keeping around (?). -(make-obsolete 'dired-default-directory - "this feature is due to be removed." "24.1") - (defun dired-smart-shell-command (command &optional output-buffer error-buffer) "Like function `shell-command', but in the current Virtual Dired directory." (interactive @@ -782,6 +780,7 @@ See also `dired-enable-local-variables'." (defun dired-hack-local-variables () "Evaluate local variables in `dired-local-variables-file' for dired buffer." + (declare (obsolete hack-dir-local-variables-non-file-buffer "24.1")) (and (stringp dired-local-variables-file) (file-exists-p dired-local-variables-file) (let ((opoint (point-max)) @@ -803,14 +802,12 @@ See also `dired-enable-local-variables'." ;; Make sure that the mode line shows the proper information. (dired-sort-set-mode-line)))) -(make-obsolete 'dired-hack-local-variables - 'hack-dir-local-variables-non-file-buffer "24.1") - ;; Does not seem worth a dedicated command. ;; See the more general features in files-x.el. (defun dired-omit-here-always () "Create `dir-locals-file' setting `dired-omit-mode' to t in `dired-mode'. If in a Dired buffer, reverts it." + (declare (obsolete add-dir-local-variable "24.1")) (interactive) (if (file-exists-p dired-local-variables-file) (error "Old-style dired-local-variables-file `./%s' found; @@ -830,8 +827,6 @@ replace it with a dir-locals-file `./%s'" (dired-extra-startup) (dired-revert)))) -(make-obsolete 'dired-omit-here-always 'add-dir-local-variable "24.1") - ;;; GUESS SHELL COMMAND. diff --git a/lisp/dired.el b/lisp/dired.el index 6defd6c4877..8cb3902161a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1964,7 +1964,7 @@ Otherwise, call `toggle-read-only'." (interactive) (if (derived-mode-p 'dired-mode) (wdired-change-to-wdired-mode) - (call-interactively 'toggle-read-only))) + (read-only-mode 'toggle))) (defun dired-next-line (arg) "Move down lines then position at filename. @@ -2997,7 +2997,8 @@ argument or confirmation)." (let ((split-height-threshold 0)) (with-temp-buffer-window buffer - (cons 'display-buffer-below-selected nil) + (cons 'display-buffer-below-selected + '((window-height . fit-window-to-buffer))) #'(lambda (window _value) (with-selected-window window (unwind-protect @@ -4268,7 +4269,7 @@ instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "d2461aa6efb8c1d7de8f245728ab448e") +;;;;;; "dired-x" "dired-x.el" "a4e6844421c2c5e6fde90e959fbcc26f") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 158d447a1d4..f8975a57b7b 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -255,20 +255,23 @@ of the page moves to the previous page." ;;;; Internal Variables (defun doc-view-new-window-function (winprops) + ;; (message "New window %s for buf %s" (car winprops) (current-buffer)) + (cl-assert (or (eq t (car winprops)) + (eq (window-buffer (car winprops)) (current-buffer)))) (let ((ol (image-mode-window-get 'overlay winprops))) - (when (and ol (not (overlay-buffer ol))) - ;; I've seen `ol' be a dead overlay. I do not yet know how this - ;; happened, so maybe the bug is elsewhere, but in the mean time, - ;; this seems like a safe approach. - (setq ol nil)) (if ol (progn - (cl-assert (eq (overlay-buffer ol) (current-buffer))) - (setq ol (copy-overlay ol))) - (cl-assert (not (get-char-property (point-min) 'display))) + (setq ol (copy-overlay ol)) + ;; `ol' might actually be dead. + (move-overlay ol (point-min) (point-max))) (setq ol (make-overlay (point-min) (point-max) nil t)) (overlay-put ol 'doc-view t)) (overlay-put ol 'window (car winprops)) + (unless (windowp (car winprops)) + ;; It's a pseudo entry. Let's make sure it's not displayed (the + ;; `window' property is only effective if its value is a window). + (cl-assert (eq t (car winprops))) + (delete-overlay ol)) (image-mode-window-put 'overlay ol winprops))) (defvar doc-view-current-files nil @@ -560,7 +563,8 @@ at the top edge of the page moves to the previous page." "Kill the current converter process(es)." (interactive) (while (consp doc-view-current-converter-processes) - (ignore-errors ;; Maybe it's dead already? + (ignore-errors ;; Some entries might not be processes, and maybe + ;; some are dead already? (kill-process (pop doc-view-current-converter-processes)))) (when doc-view-current-timer (cancel-timer doc-view-current-timer) @@ -663,19 +667,21 @@ OpenDocument format)." (defvar doc-view-shrink-factor 1.125) (defun doc-view-enlarge (factor) - "Enlarge the document." + "Enlarge the document by FACTOR." (interactive (list doc-view-shrink-factor)) (if (eq (plist-get (cdr (doc-view-current-image)) :type) 'imagemagick) - ;; ImageMagick supports on-the-fly-rescaling - (progn - (set (make-local-variable 'doc-view-image-width) - (ceiling (* factor doc-view-image-width))) - (doc-view-insert-image (plist-get (cdr (doc-view-current-image)) :file) - :width doc-view-image-width)) - (set (make-local-variable 'doc-view-resolution) - (ceiling (* factor doc-view-resolution))) - (doc-view-reconvert-doc))) + ;; ImageMagick supports on-the-fly-rescaling. + (let ((new (ceiling (* factor doc-view-image-width)))) + (unless (equal new doc-view-image-width) + (set (make-local-variable 'doc-view-image-width) new) + (doc-view-insert-image + (plist-get (cdr (doc-view-current-image)) :file) + :width doc-view-image-width))) + (let ((new (ceiling (* factor doc-view-resolution)))) + (unless (equal new doc-view-resolution) + (set (make-local-variable 'doc-view-resolution) new) + (doc-view-reconvert-doc))))) (defun doc-view-shrink (factor) "Shrink the document." @@ -743,12 +749,14 @@ min {(window-width / image-width), (window-height / image-height)} times." (img-height (cdr (image-display-size (image-get-display-property) t)))) (doc-view-enlarge (min (/ (float win-width) (float img-width)) - (/ (float (- win-height 1)) (float img-height))))) + (/ (float (- win-height 1)) + (float img-height))))) ;; If slice is set (let* ((slice-width (nth 2 slice)) (slice-height (nth 3 slice)) (scale-factor (min (/ (float win-width) (float slice-width)) - (/ (float (- win-height 1)) (float slice-height)))) + (/ (float (- win-height 1)) + (float slice-height)))) (new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice))) (doc-view-enlarge scale-factor) (setf (doc-view-current-slice) new-slice) @@ -762,6 +770,7 @@ Should be invoked when the cached images aren't up-to-date." ;; Clear the old cached files (when (file-exists-p (doc-view-current-cache-dir)) (delete-directory (doc-view-current-cache-dir) 'recursive)) + (kill-local-variable 'doc-view-last-page-number) (doc-view-initiate-display)) (defun doc-view-sentinel (proc event) @@ -895,6 +904,11 @@ Start by converting PAGES, and then the rest." (list "-raw" pdf txt) callback)) +(defun doc-view-current-cache-doc-pdf () + "Return the name of the doc.pdf in the current cache dir. + This file exists only if the current document isn't a PDF or PS file already." + (expand-file-name "doc.pdf" (doc-view-current-cache-dir))) + (defun doc-view-doc->txt (txt callback) "Convert the current document to text and call CALLBACK when done." (make-directory (doc-view-current-cache-dir) t) @@ -905,22 +919,17 @@ Start by converting PAGES, and then the rest." (`ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). - (let ((pdf (expand-file-name "doc.pdf" - (doc-view-current-cache-dir)))) + (let ((pdf (doc-view-current-cache-doc-pdf))) (doc-view-ps->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) (`dvi ;; Doc is a DVI. This means that a doc.pdf already exists in its ;; cache subdirectory. - (doc-view-pdf->txt (expand-file-name "doc.pdf" - (doc-view-current-cache-dir)) - txt callback)) + (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback)) (`odf ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf ;; already exists in its cache subdirectory. - (doc-view-pdf->txt (expand-file-name "doc.pdf" - (doc-view-current-cache-dir)) - txt callback)) + (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback)) (_ (error "DocView doesn't know what to do")))) (defun doc-view-ps->pdf (ps pdf callback) @@ -960,13 +969,13 @@ Those files are saved in the directory given by the function (`dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. - (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))) + (let ((pdf (doc-view-current-cache-doc-pdf))) (doc-view-dvi->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) (`odf ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. - (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)) + (let ((pdf (doc-view-current-cache-doc-pdf)) (opdf (expand-file-name (concat (file-name-base doc-view-buffer-file-name) ".pdf") doc-view-current-cache-dir)) @@ -1033,12 +1042,15 @@ dragging it to its bottom-right corner. See also (defun doc-view-get-bounding-box () "Get the BoundingBox information of the current page." (let* ((page (doc-view-current-page)) + (doc (let ((cache-doc (doc-view-current-cache-doc-pdf))) + (if (file-exists-p cache-doc) + cache-doc + doc-view-buffer-file-name))) (o (shell-command-to-string (concat doc-view-ghostscript-program " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox " (format "-dFirstPage=%s -dLastPage=%s %s" - page page - doc-view-buffer-file-name))))) + page page doc))))) (save-match-data (when (string-match (concat "%%BoundingBox: " "\\([[:digit:]]+\\) \\([[:digit:]]+\\) " @@ -1169,24 +1181,23 @@ Predicate for sorting `doc-view-current-files'." If FORCE is non-nil, start viewing even if the document does not have the page we want to view." (with-current-buffer buffer - (let ((prev-pages doc-view-current-files) - (windows (get-buffer-window-list buffer nil t))) + (let ((prev-pages doc-view-current-files)) (setq doc-view-current-files (sort (directory-files (doc-view-current-cache-dir) t "page-[0-9]+\\.png" t) 'doc-view-sort)) - (unless windows - (switch-to-buffer buffer) - (setq windows (get-buffer-window-list buffer nil t))) - (dolist (win windows) + (dolist (win (or (get-buffer-window-list buffer nil t) + (list t))) (let* ((page (doc-view-current-page win)) (pagefile (expand-file-name (format "page-%d.png" page) (doc-view-current-cache-dir)))) (when (or force (and (not (member pagefile prev-pages)) (member pagefile doc-view-current-files))) - (with-selected-window win - (cl-assert (eq (current-buffer) buffer) t) + (if (windowp win) + (with-selected-window win + (cl-assert (eq (current-buffer) buffer) t) + (doc-view-goto-page page)) (doc-view-goto-page page)))))))) (defun doc-view-buffer-message () @@ -1231,6 +1242,10 @@ For now these keys are useful: ;;;;; Toggle between editing and viewing +(defvar-local doc-view-saved-settings nil + "Doc-view settings saved while in some other mode.") +(put 'doc-view-saved-settings 'permanent-local t) + (defun doc-view-toggle-display () "Toggle between editing a document as text or viewing it." (interactive) @@ -1483,13 +1498,16 @@ toggle between displaying the document or editing it as text. ;; returns nil for tar members. (doc-view-fallback-mode) - (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) + (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode) doc-view-previous-major-mode - (when (not (memq major-mode - '(doc-view-mode fundamental-mode))) + (unless (eq major-mode 'fundamental-mode) major-mode)))) (kill-all-local-variables) - (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) + (set (make-local-variable 'doc-view-previous-major-mode) + prev-major-mode)) + + (dolist (var doc-view-saved-settings) + (set (make-local-variable (car var)) (cdr var))) ;; Figure out the document type. (unless doc-view-doc-type @@ -1563,13 +1581,20 @@ toggle between displaying the document or editing it as text. (defun doc-view-fallback-mode () "Fallback to the previous or next best major mode." - (if doc-view-previous-major-mode - (funcall doc-view-previous-major-mode) - (let ((auto-mode-alist (rassq-delete-all - 'doc-view-mode-maybe - (rassq-delete-all 'doc-view-mode - (copy-alist auto-mode-alist))))) - (normal-mode)))) + (let ((vars (if (derived-mode-p 'doc-view-mode) + (mapcar (lambda (var) (cons var (symbol-value var))) + '(doc-view-resolution + image-mode-winprops-alist))))) + (if doc-view-previous-major-mode + (funcall doc-view-previous-major-mode) + (let ((auto-mode-alist + (rassq-delete-all + 'doc-view-mode-maybe + (rassq-delete-all 'doc-view-mode + (copy-alist auto-mode-alist))))) + (normal-mode))) + (when vars + (setq-local doc-view-saved-settings vars)))) ;;;###autoload (defun doc-view-mode-maybe () diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 93e890a20c9..d740574f1e4 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -253,7 +253,9 @@ convention was modified." advertised-signature-table)) (defun make-obsolete (obsolete-name current-name &optional when) - "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. + "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete. +OBSOLETE-NAME should be a function name or macro name (a symbol). + The warning will say that CURRENT-NAME should be used instead. If CURRENT-NAME is a string, that is the `use instead' message \(it should end with a period, and not start with a capital). diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7a229750178..d49e56bd2ba 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -846,7 +846,7 @@ CONST2 may be evaluated multiple times." (defun byte-compile-cl-file-p (file) "Return non-nil if FILE is one of the CL files." (and (stringp file) - (string-match "^cl\\>" (file-name-nondirectory file)))) + (string-match "^cl\\.el" (file-name-nondirectory file)))) (defun byte-compile-eval (form) "Eval FORM and mark the functions defined therein. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index ea5e1cf9beb..913ebf2015f 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -689,7 +689,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 5749ff91b40..2eda628e262 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -745,7 +745,6 @@ If ALIST is non-nil, the new pairs are prepended to it." ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; End: ;;; cl-lib.el ends here diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index c12e8ccacb1..922c9856208 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -11,7 +11,7 @@ ;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively ;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan ;;;;;; cl-mapl cl-maplist cl-map cl--mapcar-many cl-equalp cl-coerce) -;;;;;; "cl-extra" "cl-extra.el" "535a24c1cff55a16e3d51219498a7858") +;;;;;; "cl-extra" "cl-extra.el" "1572ae52fa4fbd9c4bf89b49a068a865") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461") +;;;;;; "cl-macs" "cl-macs.el" "da92f58f688ff6fb4d0098eb0f3acf0b") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -748,7 +748,7 @@ surrounded by (cl-block NAME ...). ;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if ;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not ;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove -;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "b444601641dcbd14a23ca5182bc80ffa") +;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "4c1e1191e82dc8d5449a5ec4d59efc10") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 16ac14f8fe9..56e698bec0a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2686,7 +2686,6 @@ surrounded by (cl-block NAME ...). ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index b55f1df5ba5..1fa562e328a 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -1010,7 +1010,6 @@ Atoms are compared by `eql'; cons cells are compared recursively. ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index ae0852d6c87..34beed0d9ef 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -452,7 +452,7 @@ definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet) - (obsolete "Use either `cl-flet' or `cl-letf'." "24.3")) + (obsolete "use either `cl-flet' or `cl-letf'." "24.3")) `(letf ,(mapcar (lambda (x) (if (or (and (fboundp (car x)) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index ea72e9492f0..8c8d37b2194 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -276,10 +276,10 @@ A mode's class is the first ancestor which is NOT a derived mode. Use the `derived-mode-parent' property of the symbol to trace backwards. Since major-modes might all derive from `fundamental-mode', this function is not very useful." + (declare (obsolete derived-mode-p "22.1")) (while (get mode 'derived-mode-parent) (setq mode (get mode 'derived-mode-parent))) mode) -(make-obsolete 'derived-mode-class 'derived-mode-p "22.1") ;;; PRIVATE diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index a7916354c91..c3b8e5e10d4 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -7,18 +7,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index ad5e20cb8a4..ff00be7a237 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -7,18 +7,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 4caa0a73866..7858c183e4b 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -1,22 +1,25 @@ -;;; gv.el --- Generalized variables -*- lexical-binding: t -*- +;;; gv.el --- generalized variables -*- lexical-binding: t -*- ;; Copyright (C) 2012 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: extensions +;; Package: emacs -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -266,7 +269,7 @@ The return value is the last VAL in the list. ;;;###autoload (put 'gv-place 'edebug-form-spec 'edebug-match-form) ;; CL did the equivalent of: -;;(gv-define-expand edebug-after (lambda (before index place) place)) +;;(gv-define-macroexpand edebug-after (lambda (before index place) place)) (put 'edebug-after 'gv-expander (lambda (do before index place) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 761d27a2e28..0b6fd277ae2 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -10,10 +10,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,9 +21,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b01cdbc7b8e..28d166271fb 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Change Log: diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 09e47b69b91..1312fc3731d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -517,6 +517,10 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--self-quoting-p (upat) (or (keywordp upat) (numberp upat) (stringp upat))) +(defsubst pcase--mark-used (sym) + ;; Exceptionally, `sym' may be a constant expression rather than a symbol. + (if (symbolp sym) (put sym 'pcase-used t))) + ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. (defun pcase--u1 (matches code vars rest) @@ -581,7 +585,7 @@ Otherwise, it defers to REST which is a list of branches of the form ((memq upat '(t _)) (pcase--u1 matches code vars rest)) ((eq upat 'pcase--dontcare) :pcase--dontcare) ((memq (car-safe upat) '(guard pred)) - (if (eq (car upat) 'pred) (put sym 'pcase-used t)) + (if (eq (car upat) 'pred) (pcase--mark-used sym)) (let* ((splitrest (pcase--split-rest sym (lambda (pat) (pcase--split-pred upat pat)) rest)) @@ -614,10 +618,10 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) ((pcase--self-quoting-p upat) - (put sym 'pcase-used t) + (pcase--mark-used sym) (pcase--q1 sym upat matches code vars rest)) ((symbolp upat) - (put sym 'pcase-used t) + (pcase--mark-used sym) (if (not (assq upat vars)) (pcase--u1 matches code (cons (cons upat sym) vars) rest) ;; Non-linear pattern. Turn it into an `eq' test. @@ -640,7 +644,7 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches) code vars rest))) ((eq (car-safe upat) '\`) - (put sym 'pcase-used t) + (pcase--mark-used sym) (pcase--q1 sym (cadr upat) matches code vars rest)) ((eq (car-safe upat) 'or) (let ((all (> (length (cdr upat)) 1)) @@ -662,7 +666,7 @@ Otherwise, it defers to REST which is a list of branches of the form sym (lambda (pat) (pcase--split-member elems pat)) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) - (put sym 'pcase-used t) + (pcase--mark-used sym) (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) (pcase--u1 matches code vars then-rest) (pcase--u else-rest))) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index a56a7619ea9..8aa722521eb 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -7,10 +7,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 3999529f7ac..5fdc8c55a85 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -270,9 +270,9 @@ value, 'maybe if either is acceptable." (setq id (nth 2 form)) (setcdr form (nthcdr 2 form)) (setq val (testcover-reinstrument (nth 2 form))) - (if (eq val t) - (setcar form 'testcover-1value) - (setcar form 'testcover-after)) + (setcar form (if (eq val t) + 'testcover-1value + 'testcover-after)) (when val ;;1-valued or potentially 1-valued (aset testcover-vector id '1value)) @@ -359,9 +359,9 @@ value, 'maybe if either is acceptable." ,(nth 3 (cadr form)))) t) (t - (if (eq (car (cadr form)) 'edebug-after) - (setq id (car (nth 3 (cadr form)))) - (setq id (car (cadr form)))) + (setq id (car (if (eq (car (cadr form)) 'edebug-after) + (nth 3 (cadr form)) + (cadr form)))) (let ((testcover-1value-functions (cons id testcover-1value-functions))) (testcover-reinstrument (cadr form)))))) @@ -379,9 +379,9 @@ value, 'maybe if either is acceptable." ,(nth 3 (cadr form)))) 'maybe) (t - (if (eq (car (cadr form)) 'edebug-after) - (setq id (car (nth 3 (cadr form)))) - (setq id (car (cadr form)))) + (setq id (car (if (eq (car (cadr form)) 'edebug-after) + (nth 3 (cadr form)) + (cadr form)))) (let ((testcover-noreturn-functions (cons id testcover-noreturn-functions))) (testcover-reinstrument (cadr form)))))) @@ -447,6 +447,12 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM (defun testcover-after (idx val) "Internal function for coverage testing. Returns VAL after installing it in `testcover-vector' at offset IDX." + (declare (gv-expander (lambda (do) + (gv-letplace (getter setter) val + (funcall do getter + (lambda (store) + `(progn (testcover-after ,idx ,getter) + ,(funcall setter store)))))))) (cond ((eq (aref testcover-vector idx) 'unknown) (aset testcover-vector idx val)) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index bcd582a6f88..494d8a87e0e 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -146,14 +146,13 @@ TIME must be in the internal format returned by, e.g., `current-time'. The microsecond count from TIME is ignored, and USECS is used instead. If optional fourth argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." + (declare (obsolete "use `timer-set-time' and `timer-inc-time' instead." + "22.1")) (setf (timer--time timer) time) (setf (timer--usecs timer) usecs) (setf (timer--psecs timer) 0) (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) timer) -(make-obsolete 'timer-set-time-with-usecs - "use `timer-set-time' and `timer-inc-time' instead." - "22.1") (defun timer-set-function (timer function &optional args) "Make TIMER call FUNCTION with optional ARGS when triggering." diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 5343d499efb..b20ec13fa81 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -249,9 +249,9 @@ Other values are interpreted as usual." (defun toggle-emacs-lock () "Toggle `emacs-lock-from-exiting' for the current buffer." + (declare (obsolete emacs-lock-mode "24.1")) (interactive) (call-interactively 'emacs-lock-mode)) -(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1") (provide 'emacs-lock) diff --git a/lisp/epa.el b/lisp/epa.el index b796f5fa77c..ecc27c4d299 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -585,8 +585,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (message "%s" info))) (defun epa-display-verify-result (verify-result) + (declare (obsolete epa-display-info "23.1")) (epa-display-info (epg-verify-result-to-string verify-result))) -(make-obsolete 'epa-display-verify-result 'epa-display-info "23.1") (defun epa-passphrase-callback-function (context key-id handback) (if (eq key-id 'SYM) diff --git a/lisp/epg.el b/lisp/epg.el index 6529afb2d3c..b0e01bc3721 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1779,6 +1779,7 @@ This function is for internal use only." (epg-context-set-result-for context 'import-status nil))) (defun epg-passphrase-callback-function (context key-id _handback) + (declare (obsolete epa-passphrase-callback-function "23.1")) (if (eq key-id 'SYM) (read-passwd "Passphrase for symmetric encryption: " (eq (epg-context-operation context) 'encrypt)) @@ -1790,9 +1791,6 @@ This function is for internal use only." (format "Passphrase for %s %s: " key-id (cdr entry)) (format "Passphrase for %s: " key-id))))))) -(make-obsolete 'epg-passphrase-callback-function - 'epa-passphrase-callback-function "23.1") - (defun epg--list-keys-1 (context name mode) (let ((args (append (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) @@ -2562,6 +2560,7 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-sign-keys' instead." + (declare (obsolete nil "23.1")) (epg-context-set-operation context 'sign-keys) (epg-context-set-result context nil) (epg--start context (cons (if local @@ -2572,10 +2571,10 @@ If you are unsure, use synchronous version of this function (epg-sub-key-id (car (epg-key-sub-key-list key)))) keys)))) -(make-obsolete 'epg-start-sign-keys "do not use." "23.1") (defun epg-sign-keys (context keys &optional local) "Sign KEYS from the key ring." + (declare (obsolete nil "23.1")) (unwind-protect (progn (epg-start-sign-keys context keys local) @@ -2586,7 +2585,6 @@ If you are unsure, use synchronous version of this function (list "Sign keys failed" (epg-errors-to-string errors)))))) (epg-reset context))) -(make-obsolete 'epg-sign-keys "do not use." "23.1") (defun epg-start-generate-key (context parameters) "Initiate a key generation. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 674a6c97eec..348765036ea 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2012-09-25 Chong Yidong <cyd@gnu.org> + + * erc.el (erc-send-command): Use define-obsolete-function-alias. + 2012-09-17 Chong Yidong <cyd@gnu.org> * erc-page.el (erc-page-function): diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index feef75940f3..7feadc50aca 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -139,8 +139,8 @@ (message (concat "ERC: The function `defvaralias' is not bound. See the " "NEWS file for variable name changes since ERC 5.0.4."))) -(defalias 'erc-send-command 'erc-server-send) -(erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1") +(define-obsolete-function-alias 'erc-send-command + 'erc-server-send "ERC 5.1") ;; tunable connection and authentication parameters diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 37fa939cc10..ef59f6d1d35 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -63,10 +63,13 @@ which commands are considered visual in nature." :type '(repeat string) :group 'eshell-term) -(defcustom eshell-term-name "eterm" +;; If you change this from term-term-name, you need to ensure that the +;; value you choose exists in the system's terminfo database. (Bug#12485) +(defcustom eshell-term-name term-term-name "Name to use for the TERM variable when running visual commands. See `term-term-name' in term.el for more information on how this is used." + :version "24.3" ; eterm -> term-term-name = eterm-color :type 'string :group 'eshell-term) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 515a23f81d7..5a10721387b 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1216,11 +1216,12 @@ COMMAND may result in an alias being executed, or a plain command." (let* ((sym (intern-soft (concat "eshell/" name))) (file (symbol-file sym 'defun))) ;; If the function exists, but is defined in an eshell module - ;; that's not currently enabled, don't report it as found + ;; that's not currently enabled, don't report it as found. (if (and file - (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file)) + (setq file (file-name-base file)) + (string-match "\\`\\(em\\|esh\\)-\\([[:alnum:]]+\\)\\'" file)) (let ((module-sym - (intern (file-name-base (concat "eshell-" (match-string 2 file)))))) + (intern (concat "eshell-" (match-string 2 file))))) (if (and (functionp sym) (or (null module-sym) (eshell-using-module module-sym) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index fa0336232f9..01df5fced62 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -275,6 +275,7 @@ Prepend remote identification of `default-directory', if any." (defmacro eshell-for (for-var for-list &rest forms) "Iterate through a list." + (declare (obsolete dolist "24.1")) (declare (indent 2)) `(let ((list-iter ,for-list)) (while list-iter @@ -282,9 +283,6 @@ Prepend remote identification of `default-directory', if any." ,@forms) (setq list-iter (cdr list-iter))))) - -(make-obsolete 'eshell-for 'dolist "24.1") - (defun eshell-flatten-list (args) "Flatten any lists within ARGS, so that there are no sublists." (let ((new-list (list t))) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index c663de3f40d..a9a854221a4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -243,16 +243,14 @@ shells such as bash, zsh, rc, 4dos." (defun eshell-add-to-window-buffer-names () "Add `eshell-buffer-name' to `same-window-buffer-names'." + (declare (obsolete nil "24.3")) (add-to-list 'same-window-buffer-names eshell-buffer-name)) -(make-obsolete 'eshell-add-to-window-buffer-names - "no longer needed." "24.3") (defun eshell-remove-from-window-buffer-names () "Remove `eshell-buffer-name' from `same-window-buffer-names'." + (declare (obsolete nil "24.3")) (setq same-window-buffer-names (delete eshell-buffer-name same-window-buffer-names))) -(make-obsolete 'eshell-remove-from-window-buffer-names - "no longer needed." "24.3") (defcustom eshell-load-hook nil "A hook run once Eshell has been loaded." diff --git a/lisp/faces.el b/lisp/faces.el index 6a477e172e1..3ee859305a5 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1867,6 +1867,7 @@ Return nil if it has no specified face." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare-function x-parse-geometry "frame.c" (string)) +(defvar x-display-name) (defun x-handle-named-frame-geometry (parameters) "Add geometry parameters for a named frame to parameter list PARAMETERS. diff --git a/lisp/files.el b/lisp/files.el index 66c526266e6..76a13f6cefd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -821,10 +821,10 @@ one or more of those symbols." (defun locate-file-completion (string path-and-suffixes action) "Do completion for file names passed to `locate-file'. PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." + (declare (obsolete locate-file-completion-table "23.1")) (locate-file-completion-table (car path-and-suffixes) (cdr path-and-suffixes) string nil action)) -(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1") (defvar locate-dominating-stop-dir-regexp (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'") diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 6404af7703a..78760c015ff 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -340,8 +340,8 @@ This can be an \"!\" or the \"n\" in \"ifndef\".") (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face "Face name to use for preprocessor directives.") -(defvar font-lock-reference-face 'font-lock-constant-face) -(make-obsolete-variable 'font-lock-reference-face 'font-lock-constant-face "20.3") +(define-obsolete-variable-alias + 'font-lock-reference-face 'font-lock-constant-face "20.3") ;; Fontification variables: diff --git a/lisp/generic-x.el b/lisp/generic-x.el index a97c5649c95..ce1599b9010 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1531,15 +1531,15 @@ like an INI file. You can add this hook to `find-file-hook'." '("#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) '("#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-reference-face) + (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)) ;; indirect string constants '("\\(@[A-Za-z][A-Za-z0-9_]+\\)" 1 font-lock-builtin-face) ;; gotos - '("[ \t]*\\(\\sw+:\\)" 1 font-lock-reference-face) + '("[ \t]*\\(\\sw+:\\)" 1 font-lock-constant-face) '("\\<\\(goto\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) - (2 font-lock-reference-face nil t)) + (2 font-lock-constant-face nil t)) ;; system variables (generic-make-keywords-list installshield-system-variables-list diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 45f23a6d99c..983d09e2589 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2012-09-25 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-delete-temp-files): Never ask again + a user about whether to delete temp files if once a user answered as n. + 2012-09-17 Richard Stallman <rms@gnu.org> * message.el (message-in-body-p): Don't set mark or modify buffer. diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 5a3612c4d1c..e75506956bb 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -11974,7 +11974,7 @@ 2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el: + * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el: * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el: * mml1991.el, nnultimate.el: Add `coding'. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7dcbd61316f..6c827e070cb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2760,11 +2760,12 @@ summary buffer." (or how (setq how gnus-article-browse-delete-temp)) (if (eq how 'ask) (let ((files (length gnus-article-browse-html-temp-list))) - (gnus-y-or-n-p - (if (= files 1) - "Delete the temporary HTML file? " - (format "Delete all %s temporary HTML files? " - files)))) + (or (gnus-y-or-n-p + (if (= files 1) + "Delete the temporary HTML file? " + (format "Delete all %s temporary HTML files? " + files))) + (setq gnus-article-browse-html-temp-list nil))) how))) (dolist (file gnus-article-browse-html-temp-list) (cond ((file-directory-p file) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index fa0484ff4e5..ef482f8f0e9 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -488,13 +488,16 @@ suitable file is found, return nil." (insert "'.\n")))) (defun help-fns--obsolete (function) - (let* ((obsolete (and - ;; `function' might be a lambda construct. - (symbolp function) - (get function 'byte-obsolete-info))) + ;; Ignore lambda constructs, keyboard macros, etc. + (let* ((obsolete (and (symbolp function) + (get function 'byte-obsolete-info))) (use (car obsolete))) (when obsolete - (insert "\nThis function is obsolete") + (insert "\nThis " + (if (eq (car-safe (symbol-function function)) 'macro) + "macro" + "function") + " is obsolete") (when (nth 2 obsolete) (insert (format " since %s" (nth 2 obsolete)))) (insert (cond ((stringp use) (concat ";\n" use)) @@ -611,7 +614,7 @@ FILE is the file where FUNCTION was probably defined." (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) (point))) (terpri)(terpri) - + (let* ((doc-raw (condition-case err (documentation function t) (error (format "No Doc! %S" err)))) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 112c72778bc..0600484b6df 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -69,7 +69,6 @@ (require 'backquote) -;;;###autoload (defcustom three-step-help nil "Non-nil means give more info about Help command in three steps. The three steps are simple prompt, prompt with all options, and diff --git a/lisp/help.el b/lisp/help.el index 707c8e3c84f..0df9c607f69 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -981,26 +981,6 @@ function is called, the window to be resized is selected." :group 'help :version "24.2") -(defcustom temp-buffer-resize-frames nil - "Non-nil means `temp-buffer-resize-mode' can resize frames. -A frame can be resized if and only if its root window is a live -window. The height of the root window is subject to the values of -`temp-buffer-max-height' and `window-min-height'." - :type 'boolean - :version "24.2" - :group 'help) - -(defcustom temp-buffer-resize-regexps nil - "List of regexps that inhibit Temp Buffer Resize mode. -Any window of a buffer whose name matches one of these regular -expressions is left alone by Temp Buffer Resize mode." - :type '(repeat - :tag "Buffer" - :value "" - (regexp :format "%v")) - :version "24.3" - :group 'help) - (define-minor-mode temp-buffer-resize-mode "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode). With a prefix argument ARG, enable Temp Buffer Resize mode if ARG @@ -1014,9 +994,8 @@ fit the buffer's contents, but never more than A window is resized only if it has been specially created for the buffer. Windows that have shown another buffer before are not -resized. A window showing a buffer whose name matches any of the -expressions in `temp-buffer-resize-regexps' is not resized. A -frame is resized only if `temp-buffer-resize-frames' is non-nil. +resized. A frame is resized only if `fit-frame-to-buffer' is +non-nil. This mode is used by `help', `apropos' and `completion' buffers, and some others." @@ -1034,33 +1013,28 @@ WINDOW can be any live window and defaults to the selected one. Do not make WINDOW higher than `temp-buffer-max-height' nor smaller than `window-min-height'. Do nothing if WINDOW is not vertically combined or some of its contents are scrolled out of -view. Do nothing if the name of WINDOW's buffer matches an -expression in `temp-buffer-resize-regexps'." +view." (setq window (window-normalize-window window t)) (let ((buffer-name (buffer-name (window-buffer window)))) - (unless (catch 'found - (dolist (regexp temp-buffer-resize-regexps) - (when (string-match regexp buffer-name) - (throw 'found t)))) - (let ((height (if (functionp temp-buffer-max-height) - (with-selected-window window - (funcall temp-buffer-max-height (window-buffer))) - temp-buffer-max-height)) - (quit-cadr (cadr (window-parameter window 'quit-restore)))) - (cond - ;; Don't resize WINDOW if it showed another buffer before. - ((and (eq quit-cadr 'window) - (pos-visible-in-window-p (point-min) window) - (window-combined-p window)) - (fit-window-to-buffer window height)) - ((and temp-buffer-resize-frames - (eq quit-cadr 'frame) - (eq window (frame-root-window window))) - (let ((frame (window-frame window))) - (fit-frame-to-buffer - frame (+ (frame-height frame) - (- (window-total-size window)) - height))))))))) + (let ((height (if (functionp temp-buffer-max-height) + (with-selected-window window + (funcall temp-buffer-max-height (window-buffer))) + temp-buffer-max-height)) + (quit-cadr (cadr (window-parameter window 'quit-restore)))) + (cond + ;; Don't resize WINDOW if it showed another buffer before. + ((and (eq quit-cadr 'window) + (pos-visible-in-window-p (point-min) window) + (window-combined-p window)) + (fit-window-to-buffer window height)) + ((and fit-frame-to-buffer + (eq quit-cadr 'frame) + (eq window (frame-root-window window))) + (let ((frame (window-frame window))) + (fit-frame-to-buffer + frame (+ (frame-height frame) + (- (window-total-size window)) + height)))))))) ;;; Help windows. (defcustom help-window-select 'other diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index f787319fb0c..2f0a6e3af59 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -199,7 +199,6 @@ (defvar he-search-window ()) -;;;###autoload (defcustom hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name @@ -217,31 +216,26 @@ or insert functions in this list." :type '(repeat function) :group 'hippie-expand) -;;;###autoload (defcustom hippie-expand-verbose t "Non-nil makes `hippie-expand' output which function it is trying." :type 'boolean :group 'hippie-expand) -;;;###autoload (defcustom hippie-expand-dabbrev-skip-space nil "Non-nil means tolerate trailing spaces in the abbreviation to expand." :group 'hippie-expand :type 'boolean) -;;;###autoload (defcustom hippie-expand-dabbrev-as-symbol t "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter." :group 'hippie-expand :type 'boolean) -;;;###autoload (defcustom hippie-expand-no-restriction t "Non-nil means that narrowed buffers are widened during search." :group 'hippie-expand :type 'boolean) -;;;###autoload (defcustom hippie-expand-max-buffers () "The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched." @@ -249,15 +243,13 @@ If nil, all buffers are searched." integer) :group 'hippie-expand) -;;;###autoload -(defcustom hippie-expand-ignore-buffers (list (purecopy "^ \\*.*\\*$") 'dired-mode) +(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) "A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms)" :type '(repeat (choice regexp (symbol :tag "Major Mode"))) :group 'hippie-expand) -;;;###autoload (defcustom hippie-expand-only-buffers () "A list specifying the only buffers to search (in addition to current). Can contain both regexps matching buffer names (as strings) and major modes diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index fbf7a672ff6..b0bc5b6b3b3 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1052,8 +1052,6 @@ haven't encountered them yet. Returns a `hfy-style-assoc'." (hfy-face-attr-for-class fn hfy-display-class)) ((and (symbolp fn) (facep (symbol-value fn))) - ;; Obsolete faces like `font-lock-reference-face' are defined as - ;; aliases for another face. (hfy-face-attr-for-class (symbol-value fn) hfy-display-class)) (t nil))) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 97df90a65af..ee5bd0f357a 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -755,10 +755,16 @@ They are removed from `ibuffer-saved-filter-groups'." The value from `ibuffer-saved-filter-groups' is used." (interactive (list - (if (null ibuffer-saved-filter-groups) - (error "No saved filters") - (completing-read "Switch to saved filter group: " - ibuffer-saved-filter-groups nil t)))) + (cond ((null ibuffer-saved-filter-groups) + (error "No saved filters")) + ;; `ibuffer-saved-filter-groups' is a user variable that defaults + ;; to nil. We assume that with one element in this list the user + ;; knows what she wants. See bug#12331. + ((null (cdr ibuffer-saved-filter-groups)) + (caar ibuffer-saved-filter-groups)) + (t + (completing-read "Switch to saved filter group: " + ibuffer-saved-filter-groups nil t))))) (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups)) ibuffer-hidden-filter-groups nil) (ibuffer-update nil t)) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 77461469044..c9dcff41618 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1283,7 +1283,7 @@ With optional ARG, make read-only only if ARG is not negative." (:opstring "toggled read only status in" :interactive "P" :modifier-p t) - (call-interactively 'toggle-read-only)) + (read-only-mode 'toggle)) (define-ibuffer-op ibuffer-do-delete () "Kill marked buffers as with `kill-this-buffer'." @@ -2641,7 +2641,7 @@ will be inserted before the group at point." ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "c255d1ebe80ccabd8385f40bdd0b5451") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f03bae226325c7320d41ddb78896665a") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/ido.el b/lisp/ido.el index d48e7ba858b..94818fe57b0 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -714,7 +714,7 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'." :type 'integer :group 'ido) -(defcustom ido-max-directory-size 30000 +(defcustom ido-max-directory-size nil "Maximum size (in bytes) for directories to use ido completion. If you enter a directory with a size larger than this size, ido will not provide the normal completion. To show the completions, use C-a." @@ -3701,14 +3701,14 @@ This is to make them appear as if they were \"virtual buffers\"." (rexq (concat rex0 (if slash ".*/" ""))) (re (if ido-enable-prefix (concat "\\`" rexq) rexq)) (full-re (and do-full - (and (eq ido-cur-item 'buffer) - (not ido-buffer-disable-smart-matches)) + (not (and (eq ido-cur-item 'buffer) + ido-buffer-disable-smart-matches)) (not ido-enable-regexp) (not (string-match "\$\\'" rex0)) (concat "\\`" rex0 (if slash "/" "") "\\'"))) (suffix-re (and do-full slash - (and (eq ido-cur-item 'buffer) - (not ido-buffer-disable-smart-matches)) + (not (and (eq ido-cur-item 'buffer) + ido-buffer-disable-smart-matches)) (not ido-enable-regexp) (not (string-match "\$\\'" rex0)) (concat rex0 "/\\'"))) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index fabc12c0219..4ac62fbb6fc 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1,4 +1,4 @@ -;;; image-mode.el --- support for visiting image files +;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*- ;; ;; Copyright (C) 2005-2012 Free Software Foundation, Inc. ;; @@ -31,6 +31,11 @@ ;; resulting buffer file is saved to another name it will correctly save ;; the image data to the new file. +;; Todo: + +;; Consolidate with doc-view to make them work on directories of images or on +;; image files containing various "pages". + ;;; Code: (require 'image) @@ -38,8 +43,7 @@ ;;; Image mode window-info management. -(defvar image-mode-winprops-alist t) -(make-variable-buffer-local 'image-mode-winprops-alist) +(defvar-local image-mode-winprops-alist t) (defvar image-mode-new-window-functions nil "Special hook run when image data is requested in a new window. @@ -47,9 +51,13 @@ It is called with one argument, the initial WINPROPS.") (defun image-mode-winprops (&optional window cleanup) "Return winprops of WINDOW. -A winprops object has the shape (WINDOW . ALIST)." +A winprops object has the shape (WINDOW . ALIST). +WINDOW defaults to `selected-window' if it displays the current buffer, and +otherwise it defaults to t, used for times when the buffer is not displayed." (cond ((null window) - (setq window (selected-window))) + (setq window + (if (eq (current-buffer) (window-buffer)) (selected-window) t))) + ((eq window t)) ((not (windowp window)) (error "Not a window: %s" window))) (when cleanup diff --git a/lisp/image.el b/lisp/image.el index 99c0a74a512..72dc654757a 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -346,7 +346,7 @@ Optional DATA-P non-nil means SOURCE is a string containing image data." "Return non-nil if image type TYPE is available. Image types are symbols like `xbm' or `jpeg'." (and (fboundp 'init-image-library) - (init-image-library type dynamic-library-alist))) + (init-image-library type))) ;;;###autoload diff --git a/lisp/imenu.el b/lisp/imenu.el index c2a80d69675..47a2f1e3b40 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -326,6 +326,7 @@ PREVPOS is the variable in which we store the last position displayed." (defun imenu-example--name-and-position () "Return the current/previous sexp and its (beginning) location. Don't move point." + (declare (obsolete "use your own function instead." "23.2")) (save-excursion (forward-sexp -1) ;; [ydi] modified for imenu-use-markers @@ -333,8 +334,6 @@ Don't move point." (end (progn (forward-sexp) (point)))) (cons (buffer-substring beg end) beg)))) -(make-obsolete 'imenu-example--name-and-position - "use your own function instead." "23.2") ;;; ;;; Lisp @@ -343,6 +342,7 @@ Don't move point." (defun imenu-example--lisp-extract-index-name () ;; Example of a candidate for `imenu-extract-index-name-function'. ;; This will generate a flat index of definitions in a lisp file. + (declare (obsolete nil "23.2")) (save-match-data (and (looking-at "(def") (condition-case nil @@ -353,11 +353,11 @@ Don't move point." (end (progn (forward-sexp -1) (point)))) (buffer-substring beg end))) (error nil))))) -(make-obsolete 'imenu-example--lisp-extract-index-name "your own" "23.2") (defun imenu-example--create-lisp-index () ;; Example of a candidate for `imenu-create-index-function'. ;; It will generate a nested index of definitions. + (declare (obsolete nil "23.2")) (let ((index-alist '()) (index-var-alist '()) (index-type-alist '()) @@ -401,7 +401,6 @@ Don't move point." (push (cons "Syntax-unknown" index-unknown-alist) index-alist)) index-alist)) -(make-obsolete 'imenu-example--create-lisp-index "your own" "23.2") ;; Regular expression to find C functions (defvar imenu-example--function-name-regexp-c @@ -414,6 +413,7 @@ Don't move point." )) (defun imenu-example--create-c-index (&optional regexp) + (declare (obsolete nil "23.2")) (let ((index-alist '()) char) (goto-char (point-min)) @@ -430,7 +430,6 @@ Don't move point." (if (not (eq char ?\;)) (push (imenu-example--name-and-position) index-alist)))) (nreverse index-alist))) -(make-obsolete 'imenu-example--create-c-index "your own" "23.2") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index 964f01c982c..5041f45ba97 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -202,8 +202,8 @@ character set: `latin-2', `hebrew' etc." (and char (char-displayable-p char)))) ;; Backwards compatibility. -(defalias 'latin1-char-displayable-p 'char-displayable-p) -(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "22.1") +(define-obsolete-function-alias 'latin1-char-displayable-p + 'char-displayable-p "22.1") (defun latin1-display-setup (set &optional force) "Set up Latin-1 display for characters in the given SET. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 2fc9759972e..a32c69a691e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2058,9 +2058,9 @@ See `set-language-info-alist' for use in programs." (defun princ-list (&rest args) "Print all arguments with `princ', then print \"\\n\"." + (declare (obsolete "use mapc and princ instead." "23.3")) (mapc #'princ args) (princ "\n")) -(make-obsolete 'princ-list "use mapc and princ instead" "23.3") (put 'describe-specified-language-support 'apropos-inhibit t) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index bd7257bbc0f..43af785cc2f 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -208,8 +208,8 @@ Character sets for defining other charsets, or for backward compatibility "Decode a character that has code CODE in CODEPAGE. Return a decoded character string. Each CODEPAGE corresponds to a coding system cpCODEPAGE." + (declare (obsolete decode-char "23.1")) (decode-char (intern (format "cp%d" codepage)) code)) -(make-obsolete 'decode-codepage-char 'decode-char "23.1") ;; A variable to hold charset input history. (defvar charset-history nil) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 7b152a47727..3dc0b54421a 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -34,39 +34,6 @@ ;;; characters. ;;;###autoload -(defun string-to-sequence (string type) - "Convert STRING to a sequence of TYPE which contains characters in STRING. -TYPE should be `list' or `vector'." -;;; (let ((len (length string)) -;;; (i 0) -;;; val) - (cond ((eq type 'list) - ;; Applicable post-Emacs 20.2 and asymptotically ~10 times - ;; faster than the code below: - (append string nil)) -;;; (setq val (make-list len 0)) -;;; (let ((l val)) -;;; (while (< i len) -;;; (setcar l (aref string i)) -;;; (setq l (cdr l) i (1+ i)))))) - ((eq type 'vector) - ;; As above. - (vconcat string)) -;;; (setq val (make-vector len 0)) -;;; (while (< i len) -;;; (aset val i (aref string i)) -;;; (setq i (1+ i)))) - (t - (error "Invalid type: %s" type))) -;;; val) -) - -;;;###autoload -(make-obsolete 'string-to-sequence - "use `string-to-list' or `string-to-vector'." - "22.1") - -;;;###autoload (defsubst string-to-list (string) "Return a list of characters in STRING." (append string nil)) @@ -330,10 +297,9 @@ operations such as `find-coding-systems-region'." "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. PRIORITY-LIST is an alist of coding categories vs the corresponding coding systems ordered by priority." + (declare (obsolete with-coding-priority "23.1")) `(with-coding-priority (mapcar #'cdr ,priority-list) (detect-coding-region ,from ,to))) -(make-obsolete 'detect-coding-with-priority - "use `with-coding-priority' and `detect-coding-region'." "23.1") ;;;###autoload (defun detect-coding-with-language-environment (from to lang-env) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 4d567a6e9d8..e6e3f045a9e 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -409,13 +409,13 @@ PLIST (property list) may contain any type of information a user (defun charset-id (charset) "Always return 0. This is provided for backward compatibility." + (declare (obsolete nil "23.1")) 0) -(make-obsolete 'charset-id "do not use it." "23.1") (defmacro charset-bytes (charset) "Always return 0. This is provided for backward compatibility." + (declare (obsolete nil "23.1")) 0) -(make-obsolete 'charset-bytes "do not use it." "23.1") (defun get-charset-property (charset propname) "Return the value of CHARSET's PROPNAME property. @@ -464,8 +464,8 @@ Return -1 if charset isn't an ISO 2022 one." (defun charset-list () "Return list of all charsets ever defined." + (declare (obsolete charset-list "23.1")) charset-list) -(make-obsolete 'charset-list "use variable `charset-list'." "23.1") ;;; CHARACTER @@ -473,8 +473,8 @@ Return -1 if charset isn't an ISO 2022 one." (defun generic-char-p (char) "Always return nil. This is provided for backward compatibility." + (declare (obsolete nil "23.1")) nil) -(make-obsolete 'generic-char-p "generic characters no longer exist." "23.1") (defun make-char-internal (charset-id &optional code1 code2) (let ((charset (aref emacs-mule-charset-table charset-id))) @@ -1012,6 +1012,7 @@ Value is a list of transformed arguments." eol-type) "Define a new coding system CODING-SYSTEM (symbol). This function is provided for backward compatibility." + (declare (obsolete define-coding-system "23.1")) ;; For compatibility with XEmacs, we check the type of TYPE. If it ;; is a symbol, perhaps, this function is called with XEmacs-style ;; arguments. Here, try to transform that kind of arguments to @@ -1104,8 +1105,6 @@ This function is provided for backward compatibility." (apply 'define-coding-system coding-system doc-string properties)) -(make-obsolete 'make-coding-system 'define-coding-system "23.1") - (defun merge-coding-systems (first second) "Fill in any unspecified aspects of coding system FIRST from SECOND. Return the resulting coding system." @@ -1449,9 +1448,9 @@ This setting is effective for the next communication only." ARG is a list of coding categories ordered by priority. This function is provided for backward compatibility." + (declare (obsolete set-coding-system-priority "23.1")) (apply 'set-coding-system-priority (mapcar #'(lambda (x) (symbol-value x)) arg))) -(make-obsolete 'set-coding-priority 'set-coding-system-priority "23.1") ;;; X selections @@ -2356,9 +2355,6 @@ Analogous to `define-translation-table', but updates (setq ignore-relative-composition (make-char-table 'ignore-relative-composition)) -(make-obsolete 'set-char-table-default - "generic characters no longer exist." "23.1") - ;;; Built-in auto-coding-functions: (defun sgml-xml-auto-coding-function (size) diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el index 0dfabdd65da..ba1bd436b23 100644 --- a/lisp/international/uni-bidi.el +++ b/lisp/international/uni-bidi.el @@ -5,7 +5,7 @@ (define-char-code-property 'bidi-class #^[1 nil char-code-property-table #^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] #^^[1 0 #^^[2 0 #^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] "
" 1 1 1 "¹
" "ð" "î" 1 "ö" 1 "¸" "
°" "Ö" "³" "¦«" "
«¤" " ·" "·" "º" "¹" "¹
" "º" "½¥
" "¾
" "¼" "Á" "Ê©" "±±" "±²" "³" "
¤¹"] #^^[2 4096 "" "â" 1 1 1 1 "Ý " "æ" "ÿ" 1 1 1 1 "ã" "" "´" "ñ" "©Ö" " º" "Þ¢" "½" 1 "°
¨" " º" "¬È" "Ð" 1 "À§" 1 1 1 "½"] #^^[2 8192 " -
" "
¡" "
" "ð" "
ì" 19 "¶Å
" "Þ" "§ " "Î" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "ͦ" 1 1 "å" "ÿ" "à " "¼Ä" "Ù" 19 "Ö"] #^^[2 12288 "
À" "Ú" 1 "À¤" "±" "±°" "÷
" "Þ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +
" "
¡" "
" "ð" "
ì" 19 "¶Å
" "Þ" "§ " "Î" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "ͦ" 1 1 "å" "ÿ" "à " "¼Ä" "Ù" 19 "Ö"] #^^[2 12288 "
À" "Ú" 1 "À¤" "±" "±°" "÷
" "Þ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 "·¹" 1 1 "ß" "Ð" "¢Þ" "÷" "º" "Ä" "¦®" "°Ã" "©³" "°
ª" 1 "å" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "
¦°" 7 7 7 "¾À" "ý" "
" "ÿ" "
" "à
"]] #^^[1 65536 #^^[2 65536 1 1 "¾À" "
á" 1 1 1 1 1 1 1 1 1 1 1 1 2 2 "à" 2 "
¨À" 2 "¹À" 2 2 2 2 2 "à" 2 2 2] #^^[2 69632 "¶" "±Å" "¤
Ë" "´Á" 1 1 1 1 1 1 1 1 1 "«È" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "í"] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "ç
" "Ò" "º" 1 "ש" 1 1 1 1 1 1 "Û¤" "¹°" "¹²" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 "" "
´" 2 2] #^^[2 126976 "¬Ð" " " "ß" 1 1 1 "¡Æ" "¥
" "¿¾" "ø" "¾" "û
" "Á°" "ƺ" "ô" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el index f0ccde477cc..75ebc04c98f 100644 --- a/lisp/international/uni-category.el +++ b/lisp/international/uni-category.el @@ -5,7 +5,7 @@ (define-char-code-property 'general-category #^[30 nil char-code-property-table #^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] #^^[1 0 #^^[2 0 #^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] " " "" "" "±" "
" "ð " " £
" "°°" "
" " ¦ " "
" "
" "Ô " " ³" "¦ ¡
" "
¡" " · " "¶ " " " " " "
" "
" "
" "
" "
" " © " " " " ° ¤" "
" " ¤ " "
¤
¥"] #^^[2 4096 "« " " ¦
«" 5 5 "É " " ¡ ¨" " Ã " " Õ " "
ÿ" 5 5 5 "í" " Ë - " " " "´ " "
£´ " "©
Æ " "
" "¬ ¢" " µ " " Ò" "¯
" " ¬ " "¤
" " À " "¬¿" "¥§ " "" "" " " "
"] #^^[2 8192 "
" " " "
+ " " " "´ " "
£´ " "©
Æ " "
" "¬ ¢" " µ " " Ò" "¯
" " ¬ " "¤
" " À " "¬¿" "¥§ " "" "" " " "
"] #^^[2 8192 "
" " " "
" "
" 19 19 "Ñ" "¨ " "§ " " Î " 22 "·¶" "ï" 22 " ç " " ¬
" 22 22 19 "¿ " 19 19 "° ¦" 30 "¯ ¯ " "
" "¦
¸ " " " "
Ä" " Ù " 22 "Ö "] #^^[2 12288 " diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el Binary files differindex 458957ef366..cf37db39b48 100644 --- a/lisp/international/uni-name.el +++ b/lisp/international/uni-name.el diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el Binary files differindex 9f0d3079259..7c0be5b438a 100644 --- a/lisp/international/uni-numeric.el +++ b/lisp/international/uni-numeric.el diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 624c3500939..13ab41cf83a 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -527,33 +527,6 @@ selected.") ;;; FUNCTIONS -;;; ISWITCHB KEYMAP -(defun iswitchb-define-mode-map () - "Set up the keymap for `iswitchb-buffer'." - (interactive) - (let (map) - ;; generated every time so that it can inherit new functions. - ;;(or iswitchb-mode-map - - (setq map (copy-keymap minibuffer-local-map)) - (define-key map "?" 'iswitchb-completion-help) - (define-key map "\C-s" 'iswitchb-next-match) - (define-key map "\C-r" 'iswitchb-prev-match) - (define-key map "\t" 'iswitchb-complete) - (define-key map "\C-j" 'iswitchb-select-buffer-text) - (define-key map "\C-t" 'iswitchb-toggle-regexp) - (define-key map "\C-x\C-f" 'iswitchb-find-file) - (define-key map "\C-n" 'iswitchb-toggle-ignore) - (define-key map "\C-c" 'iswitchb-toggle-case) - (define-key map "\C-k" 'iswitchb-kill-buffer) - (define-key map "\C-m" 'iswitchb-exit-minibuffer) - (setq iswitchb-mode-map map) - (run-hooks 'iswitchb-define-mode-map-hook))) - -(make-obsolete 'iswitchb-define-mode-map - "use M-x iswitchb-mode or customize the variable `iswitchb-mode'." - "21.1") - ;;; MAIN FUNCTION (defun iswitchb () "Switch to buffer matching a substring. @@ -619,14 +592,25 @@ If START is a string, the selection process is started with that string. If MATCHES-SET is non-nil, the buflist is not updated before the selection process begins. Used by isearchb.el." - (let - ( - buf-sel - iswitchb-final-text - (icomplete-mode nil) ;; prevent icomplete starting up - ) - - (iswitchb-define-mode-map) + ;; The map is generated every time so that it can inherit new + ;; functions. + (let ((map (copy-keymap minibuffer-local-map)) + buf-sel iswitchb-final-text map + icomplete-mode) ; prevent icomplete starting up + (define-key map "?" 'iswitchb-completion-help) + (define-key map "\C-s" 'iswitchb-next-match) + (define-key map "\C-r" 'iswitchb-prev-match) + (define-key map "\t" 'iswitchb-complete) + (define-key map "\C-j" 'iswitchb-select-buffer-text) + (define-key map "\C-t" 'iswitchb-toggle-regexp) + (define-key map "\C-x\C-f" 'iswitchb-find-file) + (define-key map "\C-n" 'iswitchb-toggle-ignore) + (define-key map "\C-c" 'iswitchb-toggle-case) + (define-key map "\C-k" 'iswitchb-kill-buffer) + (define-key map "\C-m" 'iswitchb-exit-minibuffer) + (setq iswitchb-mode-map map) + (run-hooks 'iswitchb-define-mode-map-hook) + (setq iswitchb-exit nil) (setq iswitchb-default (if (bufferp default) diff --git a/lisp/json.el b/lisp/json.el index f1ee3a52032..8167bfe93f2 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -311,13 +311,13 @@ representation will be parsed correctly." (setq char (json-encode-char0 char 'ucs)) (let ((control-char (car (rassoc char json-special-chars)))) (cond - ;; Special JSON character (\n, \r, etc.) + ;; Special JSON character (\n, \r, etc.). (control-char (format "\\%c" control-char)) - ;; ASCIIish printable character - ((and (> char 31) (< char 161)) + ;; ASCIIish printable character. + ((and (> char 31) (< char 127)) (format "%c" char)) - ;; Fallback: UCS code point in \uNNNN form + ;; Fallback: UCS code point in \uNNNN form. (t (format "\\u%04x" char))))) diff --git a/lisp/linum.el b/lisp/linum.el index 162dc19f437..3c278dbbf3b 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -44,7 +44,6 @@ "Show line numbers in the left margin." :group 'convenience) -;;;###autoload (defcustom linum-format 'dynamic "Format used to display line numbers. Either a format string like \"%7d\", `dynamic' to adapt the width @@ -52,7 +51,9 @@ as needed, or a function that is called with a line number as its argument and should evaluate to a string to be shown on that line. See also `linum-before-numbering-hook'." :group 'linum - :type 'sexp) + :type '(choice (string :tag "Format string") + (const :tag "Dynamic width" dynamic) + (function :tag "Function"))) (defface linum '((t :inherit (shadow default))) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index ca9bc6b8676..0066847e995 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -248,6 +248,13 @@ usually do not have translators for other languages.\n\n"))) "', version " (mapconcat 'number-to-string (x-server-version) ".") "\n") (error t))) + (let ((lsb (with-temp-buffer + (if (eq 0 (ignore-errors + (call-process "lsb_release" nil '(t nil) + nil "-d"))) + (buffer-string))))) + (if (stringp lsb) + (insert "System " lsb "\n"))) (when (and system-configuration-options (not (equal system-configuration-options ""))) (insert "Configured using:\n `configure " diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 0b55fe42e42..c7943fe40c8 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -427,6 +427,7 @@ For use on `completion-at-point-functions'." "Perform completion on header field or word preceding point. Completable headers are according to `mail-complete-alist'. If none matches current header, calls `mail-complete-function' and passes prefix ARG if any." + (declare (obsolete mail-completion-at-point-function "24.1")) (interactive "P") ;; Read the defaults first, if we have not done so. (sendmail-sync-aliases) @@ -439,7 +440,6 @@ current header, calls `mail-complete-function' and passes prefix ARG if any." (if data (apply #'completion-in-region data) (funcall mail-complete-function arg)))) -(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1") (defun mail-completion-expand (table) "Build new completion table that expands aliases. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index b75841489c9..331754fb1b5 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1414,6 +1414,7 @@ just append to the file, in Babyl format if necessary." (defun mail-sent-via () "Make a Sent-via header line from each To or CC header line." + (declare (obsolete "nobody can remember what it is for." "24.1")) (interactive) (save-excursion ;; put a marker at the end of the header @@ -1433,9 +1434,6 @@ just append to the file, in Babyl format if necessary." (point))))) ;; Insert a copy, with altered header field name. (insert-before-markers "Sent-via:" to-line)))))) - -(make-obsolete 'mail-sent-via "nobody can remember what it is for." "24.1") - (defun mail-to () "Move point to end of To field, creating it if necessary." diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index d10b073eb12..99e5df82bef 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -506,8 +506,6 @@ string." ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user configuration variables -(define-obsolete-variable-alias 'sc-version 'emacs-version "23.1") - (defvar sc-mail-info nil "Alist of mail header information gleaned from reply buffer.") (defvar sc-attributions nil @@ -559,10 +557,8 @@ string." (define-key map "r" 'sc-recite-region) (define-key map "\C-p" 'sc-raw-mode-toggle) (define-key map "u" 'sc-uncite-region) - (define-key map "v" 'sc-version) (define-key map "w" 'sc-insert-reference) (define-key map "\C-t" sc-T-keymap) - (define-key map "\C-b" 'sc-submit-bug-report) (define-key map "?" 'sc-describe) map) "Keymap for Supercite quasi-mode.") @@ -1969,29 +1965,11 @@ cited." (insert (sc-mail-field "sc-citation")) (error "Line is already cited")))) -;; The argument logic here is crazy. -(defun sc-version (message) - "Return the current Supercite version. -If MESSAGE is non-nil (interactively, with no prefix argument), -echoes the version in the minibuffer. Otherwise, inserts the -version at point." - (interactive (list (not current-prefix-arg))) - (let ((verstr (format "Using Supercite.el %s" emacs-version))) - (if message - (message verstr) - (insert "`sc-version' says: " verstr)))) - -(make-obsolete 'sc-version 'emacs-version "23.1") - (defun sc-describe () "Read the Supercite info node." (interactive) (info "(SC)top")) -(make-obsolete 'sc-describe "read the SC manual using `info'." "23.1") - -(define-obsolete-function-alias 'sc-submit-bug-report 'report-emacs-bug "23.1") - ;; useful stuff (provide 'supercite) diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 15b7380b737..eb60392c32c 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -10930,7 +10930,7 @@ * mh-utils.el (mh-prompt-for-folder): Exit with error if no folder specified, otherwise mh-refile-msg may try to create a folder with - empty name, and this creates problems; even mh-undo can't handle + empty name, and this creates problems; even mh-undo can't handle it (Closes SF #476824). * mh-comp.el (mh-letter-tool-bar-map): Info button needed to diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index 4387fc625c6..92d5ec821b0 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -1,4 +1,4 @@ -;;; minibuf-eldef.el --- Only show defaults in prompts when applicable +;;; minibuf-eldef.el --- Only show defaults in prompts when applicable -*- lexical-binding: t -*- ;; ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; @@ -33,16 +33,22 @@ ;;; Code: +(defvar minibuffer-eldef-shorten-default nil + "If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts.") + (defvar minibuffer-default-in-prompt-regexps - '(("\\( (default\\>.*)\\):? \\'" . 1) ("\\( \\[.*\\]\\):? *\\'" . 1)) + `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'" + 1 ,(if minibuffer-eldef-shorten-default " [\\2]")) + ("\\( \\[.*\\]\\):? *\\'" 1)) "A list of regexps matching the parts of minibuffer prompts showing defaults. When `minibuffer-electric-default-mode' is active, these regexps are used to identify the portions of prompts to elide. -Each entry is either a string, which should be a regexp matching the -default portion of the prompt, or a cons cell, who's car is a regexp -matching the default part of the prompt, and who's cdr indicates the -regexp subexpression that matched.") +Each entry is of the form (REGEXP MATCH-NUM &optional REWRITE), +where REGEXP should match the default part of the prompt, +MATCH-NUM is the subgroup that matched the actual default indicator, +and REWRITE, if present, is a string to pass to `replace-match' that +should be displayed in its place.") ;;; Internal variables @@ -79,21 +85,42 @@ The prompt and initial input should already have been inserted." (inhibit-point-motion-hooks t)) (save-excursion (save-restriction - ;; Narrow to only the prompt + ;; Narrow to only the prompt. (goto-char (point-min)) (narrow-to-region (point) (minibuffer-prompt-end)) - ;; See the prompt contains a default input indicator + ;; See if the prompt contains a default input indicator. (while regexps (setq match (pop regexps)) - (if (re-search-forward (if (stringp match) match (car match)) nil t) - (setq regexps nil) - (setq match nil))))) + (cond + ((not (re-search-forward (if (stringp match) match (car match)) + nil t)) + ;; No match yet, try the next rule. + (setq match nil)) + ((and (consp (cdr-safe match)) (nth 2 match)) + ;; Matched a replacement rule. + (let* ((inhibit-read-only t) + (buffer-undo-list t) + (submatch (nth 1 match)) + (replacement (nth 2 match)) + (props (text-properties-at (match-beginning submatch)))) + (replace-match replacement nil nil nil submatch) + (set-text-properties (match-beginning submatch) + (match-end submatch) + props) + ;; Replacement done, now keep trying with subsequent rules. + (setq match nil) + (goto-char (point-min)))) + ;; Matched a non-replacement (i.e. electric hide) rule, no need to + ;; keep trying. + (t (setq regexps nil)))))) (if (not match) - ;; Nope, so just make sure our post-command-hook isn't left around. + ;; No match for electric hiding, so just make sure our + ;; post-command-hook isn't left around. (remove-hook 'post-command-hook #'minibuf-eldef-update-minibuffer t) ;; Yup; set things up so we can frob the prompt as the state of ;; the input string changes. (setq match (if (consp match) (cdr match) 0)) + (setq match (if (consp match) (car match) match)) (setq minibuf-eldef-overlay (make-overlay (match-beginning match) (match-end match))) (setq minibuf-eldef-showing-default-in-prompt t) @@ -124,10 +151,6 @@ been set up by `minibuf-eldef-setup-minibuffer'." (overlay-put minibuf-eldef-overlay 'intangible t))))) -;;; Note this definition must be at the end of the file, because -;;; `define-minor-mode' actually calls the mode-function if the -;;; associated variable is non-nil, which requires that all needed -;;; functions be already defined. [This is arguably a bug in d-m-m] ;;;###autoload (define-minor-mode minibuffer-electric-default-mode "Toggle Minibuffer Electric Default mode. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 27c53744d54..cf990019abc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2332,7 +2332,7 @@ and `read-file-name-function'." (modify-syntax-entry c "." table)) '(?/ ?: ?\\)) table) - "Syntax table to be used in minibuffer for reading file name.") + "Syntax table used when reading a file name in the minibuffer.") ;; minibuffer-completing-file-name is a variable used internally in minibuf.c ;; to determine whether to use minibuffer-local-filename-completion-map or diff --git a/lisp/mouse.el b/lisp/mouse.el index 4ea84288f69..74bb97b3086 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -284,23 +284,24 @@ not it is actually displayed." (defun mouse-major-mode-menu (event &optional prefix) "Pop up a mode-specific menu of mouse commands. Default to the Edit menu if the major mode doesn't define a menu." + (declare (obsolete mouse-menu-major-mode-map "23.1")) (interactive "@e\nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu (mouse-menu-major-mode-map) event prefix)) -(make-obsolete 'mouse-major-mode-menu 'mouse-menu-major-mode-map "23.1") (defun mouse-popup-menubar (event prefix) "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX. The contents are the items that would be in the menu bar whether or not it is actually displayed." + (declare (obsolete mouse-menu-bar-map "23.1")) (interactive "@e \nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix)) -(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1") (defun mouse-popup-menubar-stuff (event prefix) "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'. Use the former if the menu bar is showing, otherwise the latter." + (declare (obsolete nil "23.1")) (interactive "@e\nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu @@ -308,7 +309,6 @@ Use the former if the menu bar is showing, otherwise the latter." (mouse-menu-bar-map) (mouse-menu-major-mode-map)) event prefix)) -(make-obsolete 'mouse-popup-menubar-stuff nil "23.1") ;; Commands that operate on windows. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index c78249ced0f..bc6fd38f713 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -421,7 +421,7 @@ headline after it has been retrieved for the first time." "Name of the newsticker cache file." :type 'string :group 'newsticker-miscellaneous) -(make-obsolete 'newsticker-cache-filename 'newsticker-dir "23.1") +(make-obsolete-variable 'newsticker-cache-filename 'newsticker-dir "23.1") (defcustom newsticker-dir (locate-user-emacs-file "newsticker/" ".newsticker/") diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index b44f1f9c86d..fc356a303e2 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -128,7 +128,7 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\") "Name of the newsticker groups settings file." :type 'string :group 'newsticker-treeview) -(make-obsolete 'newsticker-groups-filename 'newsticker-dir "23.1") +(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1") ;; ====================================================================== ;;; internal variables diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index c155d53b6d0..217f9dc8b30 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -175,9 +175,9 @@ This is used during Tempo template completion." (defvar snmp-font-lock-keywords-3 (append '(("\\([^\n]+\\)[ \t]+::=[ \t]+\\(SEQUENCE\\)[ \t]+{" - (1 font-lock-reference-face) (2 font-lock-keyword-face)) + (1 font-lock-constant-face) (2 font-lock-keyword-face)) ("::=[ \t]*{[ \t]*\\([a-z0-9].*[ \t]+\\)?\\([0-9]+\\)[ \t]*}" - (1 font-lock-reference-face nil t) (2 font-lock-variable-name-face))) + (1 font-lock-constant-face nil t) (2 font-lock-variable-name-face))) snmp-font-lock-keywords-2) "Gaudy SNMP MIB mode expression highlighting.") diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index 491dde3e070..fe38edbce1e 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -7,20 +7,20 @@ ;; Keywords: literate programming, reproducible research, fortran ;; Homepage: http://orgmode.org -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 9f5c18f3415..83815a6a270 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -102,13 +102,12 @@ Warning: the password is cached without checking that it is correct. It is better to check the password before caching. If you must use this function, take care to check passwords and remove incorrect ones from the cache." + (declare (obsolete password-read "23.1")) (let ((password (password-read prompt key))) (when (and password key) (password-cache-add key password)) password)) -(make-obsolete 'password-read-and-add 'password-read "23.1") - (defun password-cache-remove (key) "Remove password indexed by KEY from password cache. This is typically run by a timer setup from `password-cache-add', diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 3f120961486..9e55976a8bd 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -724,6 +724,7 @@ this is `comint-dynamic-complete-functions'." (defun pcomplete-parse-comint-arguments () "Parse whitespace separated arguments in the current region." + (declare (obsolete comint-parse-pcomplete-arguments "24.1")) (let ((begin (save-excursion (comint-bol nil) (point))) (end (point)) begins args) @@ -743,8 +744,6 @@ this is `comint-dynamic-complete-functions'." (push (buffer-substring-no-properties (car begins) (point)) args)) (cons (nreverse args) (nreverse begins))))) -(make-obsolete 'pcomplete-parse-comint-arguments - 'comint-parse-pcomplete-arguments "24.1") (defun pcomplete-parse-arguments (&optional expand-p) "Parse the command line arguments. Most completions need this info." @@ -1090,7 +1089,7 @@ Typing SPC flushes the help buffer." (setq pcomplete-last-window-config (current-window-configuration))) (with-output-to-temp-buffer "*Completions*" (display-completion-list completions)) - (message "Hit space to flush") + (minibuffer-message "Hit space to flush") (let (event) (prog1 (catch 'done diff --git a/lisp/proced.el b/lisp/proced.el index d98bf7d2c5b..be6cae2ef08 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -28,8 +28,11 @@ ;; listed. See `proced-mode' for getting started. ;; ;; To do: -;; - interactive temporary customizability of flags in `proced-grammar-alist' -;; - allow "sudo kill PID", "renice PID" +;; - Interactive temporary customizability of flags in `proced-grammar-alist' +;; - Allow "sudo kill PID", "sudo renice PID" +;; `proced-send-signal' operates on multiple processes one by one. +;; With "sudo" we want to execute one "kill" or "renice" command +;; for all marked processes. Is there a `sudo-call-process'? ;; ;; Thoughts and Ideas ;; - Currently, `process-attributes' returns the list of @@ -62,6 +65,11 @@ the external command (usually \"kill\")." :type '(choice (function :tag "function") (string :tag "command"))) +(defcustom proced-renice-command "renice" + "Name of renice command." + :group 'proced + :type '(string :tag "command")) + (defcustom proced-signal-list '( ;; signals supported on all POSIX compliant systems ("HUP" . " (1. Hangup)") @@ -491,6 +499,7 @@ Important: the match ends just after the marker.") (define-key km "o" 'proced-omit-processes) (define-key km "x" 'proced-send-signal) ; Dired compatibility (define-key km "k" 'proced-send-signal) ; kill processes + (define-key km "r" 'proced-renice) ; renice processes ;; misc (define-key km "h" 'describe-mode) (define-key km "?" 'proced-help) @@ -561,8 +570,11 @@ Important: the match ends just after the marker.") :style toggle :selected (eval proced-auto-update-flag) :help "Auto Update of Proced Buffer"] + "--" ["Send signal" proced-send-signal - :help "Send Signal to Marked Processes"])) + :help "Send Signal to Marked Processes"] + ["Renice" proced-renice + :help "Renice Marked Processes"])) ;; helper functions (defun proced-marker-regexp () @@ -1686,14 +1698,11 @@ After updating a displayed Proced buffer run the normal hook Preserves point and marks." (proced-update t)) -(defun proced-send-signal (&optional signal) - "Send a SIGNAL to the marked processes. -If no process is marked, operate on current process. -SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. -If SIGNAL is nil display marked processes and query interactively for SIGNAL. -After sending the signal, this command runs the normal hook -`proced-after-send-signal-hook'." - (interactive) +(defun proced-marked-processes () + "Return marked processes as alist of PIDs. +If no process is marked return alist with the PID of the process point is on. +The cdrs of the alist are the text strings displayed by Proced for these +processes. They are used for error messages." (let ((regexp (proced-marker-regexp)) process-alist) ;; collect marked processes @@ -1706,102 +1715,183 @@ After sending the signal, this command runs the normal hook (+ 2 (line-beginning-position)) (line-end-position))) process-alist))) - (setq process-alist - (if process-alist - (nreverse process-alist) - ;; take current process - (list (cons (proced-pid-at-point) + (if process-alist + (nreverse process-alist) + ;; take current process + (let ((pid (proced-pid-at-point))) + (if pid + (list (cons pid (buffer-substring-no-properties (+ 2 (line-beginning-position)) - (line-end-position)))))) + (line-end-position))))))))) + +(defmacro proced-with-processes-buffer (process-alist &rest body) + "Execute the forms in BODY in a temporary buffer displaying PROCESS-ALIST. +PROCESS-ALIST is an alist of process PIDs as in `proced-process-alist'. +The value returned is the value of the last form in BODY." + (declare (indent 1) (debug t)) + ;; Use leading space in buffer name to make this buffer ephemeral + `(let ((bufname " *Marked Processes*") + (header-line (substring-no-properties proced-header-line))) + (with-current-buffer (get-buffer-create bufname) + (setq truncate-lines t + proced-header-line header-line ; inherit header line + header-line-format '(:eval (proced-header-line))) + (add-hook 'post-command-hook 'force-mode-line-update nil t) + (let ((inhibit-read-only t)) + (erase-buffer) + (buffer-disable-undo) + (setq buffer-read-only t) + (dolist (process ,process-alist) + (insert " " (cdr process) "\n")) + (delete-char -1) + (goto-char (point-min))) + (save-window-excursion + ;; Analogous to `dired-pop-to-buffer' + ;; Don't split window horizontally. (Bug#1806) + (let (split-width-threshold) + (pop-to-buffer (current-buffer))) + (fit-window-to-buffer (get-buffer-window) nil 1) + ,@body)))) + +(defun proced-send-signal (&optional signal process-alist) + "Send a SIGNAL to processes in PROCESS-ALIST. +PROCESS-ALIST is an alist as returned by `proced-marked-processes'. +Interactively, PROCESS-ALIST contains the marked processes. +If no process is marked, it contains the process point is on, +SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. +After sending SIGNAL to all processes in PROCESS-ALIST, this command +runs the normal hook `proced-after-send-signal-hook'. + +For backward compatibility SIGNAL and PROCESS-ALIST may be nil. +Then PROCESS-ALIST contains the marked processes or the process point is on +and SIGNAL is queried interactively. This noninteractive usage is still +supported but discouraged. It will be removed in a future version of Emacs." + (interactive + (let* ((process-alist (proced-marked-processes)) + (pnum (if (= 1 (length process-alist)) + "1 process" + (format "%d processes" (length process-alist)))) + (completion-ignore-case t) + (completion-extra-properties + '(:annotation-function + (lambda (s) (cdr (assoc s proced-signal-list)))))) + (proced-with-processes-buffer process-alist + (list (completing-read (concat "Send signal [" pnum + "] (default TERM): ") + proced-signal-list + nil nil nil nil "TERM") + process-alist)))) + + (unless (and signal process-alist) + ;; Discouraged usge (supported for backward compatibility): + ;; The new calling sequence separates more cleanly between the parts + ;; of the code required for interactive and noninteractive calls so that + ;; the command can be used more flexibly in noninteractive ways, too. + (unless (get 'proced-send-signal 'proced-outdated) + (put 'proced-send-signal 'proced-outdated t) + (message "Outdated usage of `proced-send-signal'") + (sit-for 2)) + (setq process-alist (proced-marked-processes)) (unless signal - ;; Display marked processes (code taken from `dired-mark-pop-up'). - (let ((bufname " *Marked Processes*") ; use leading space in buffer name - ; to make this buffer ephemeral - (header-line (substring-no-properties proced-header-line))) - (with-current-buffer (get-buffer-create bufname) - (setq truncate-lines t - proced-header-line header-line ; inherit header line - header-line-format '(:eval (proced-header-line))) - (add-hook 'post-command-hook 'force-mode-line-update nil t) - (let ((inhibit-read-only t)) - (erase-buffer) - (buffer-disable-undo) - (setq buffer-read-only t) - (dolist (process process-alist) - (insert " " (cdr process) "\n")) - (delete-char -1) - (goto-char (point-min))) - (save-window-excursion - ;; Analogous to `dired-pop-to-buffer' - ;; Don't split window horizontally. (Bug#1806) - (let (split-width-threshold) - (pop-to-buffer (current-buffer))) - (fit-window-to-buffer (get-buffer-window) nil 1) - (let* ((completion-ignore-case t) - (pnum (if (= 1 (length process-alist)) - "1 process" - (format "%d processes" (length process-alist)))) - (completion-extra-properties - '(:annotation-function - (lambda (s) (cdr (assoc s proced-signal-list)))))) - (setq signal - (completing-read (concat "Send signal [" pnum - "] (default TERM): ") - proced-signal-list - nil nil nil nil "TERM"))))))) - ;; send signal - (let ((count 0) - failures) - ;; Why not always use `signal-process'? See - ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html - (if (functionp proced-signal-function) - ;; use built-in `signal-process' - (let ((signal (if (stringp signal) - (if (string-match "\\`[0-9]+\\'" signal) - (string-to-number signal) - (make-symbol signal)) - signal))) ; number - (dolist (process process-alist) - (condition-case err - (if (zerop (funcall - proced-signal-function (car process) signal)) - (setq count (1+ count)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures)) - (error ; catch errors from failed signals - (proced-log "%s\n" err) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures))))) - ;; use external system call - (let ((signal (concat "-" (if (numberp signal) - (number-to-string signal) signal)))) + (let ((pnum (if (= 1 (length process-alist)) + "1 process" + (format "%d processes" (length process-alist)))) + (completion-ignore-case t) + (completion-extra-properties + '(:annotation-function + (lambda (s) (cdr (assoc s proced-signal-list)))))) + (proced-with-processes-buffer process-alist + (setq signal (completing-read (concat "Send signal [" pnum + "] (default TERM): ") + proced-signal-list + nil nil nil nil "TERM")))))) + + (let (failures) + ;; Why not always use `signal-process'? See + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html + (if (functionp proced-signal-function) + ;; use built-in `signal-process' + (let ((signal (if (stringp signal) + (if (string-match "\\`[0-9]+\\'" signal) + (string-to-number signal) + (make-symbol signal)) + signal))) ; number (dolist (process process-alist) - (with-temp-buffer - (condition-case nil - (if (zerop (call-process - proced-signal-function nil t nil - signal (number-to-string (car process)))) - (setq count (1+ count)) - (proced-log (current-buffer)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures)) - (error ; catch errors from failed signals - (proced-log (current-buffer)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures))))))) - (if failures - ;; Proced error message are not always very precise. - ;; Can we issue a useful one-line summary in the - ;; message area (using FAILURES) if only one signal failed? - (proced-log-summary - signal - (format "%d of %d signal%s failed" - (length failures) (length process-alist) - (if (= 1 (length process-alist)) "" "s"))) - (proced-success-message "Sent signal to" count))) - ;; final clean-up - (run-hooks 'proced-after-send-signal-hook))) + (condition-case err + (unless (zerop (funcall + proced-signal-function (car process) signal)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed signals + (proced-log "%s\n" err) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))) + ;; use external system call + (let ((signal (format "-%s" signal))) + (dolist (process process-alist) + (with-temp-buffer + (condition-case nil + (unless (zerop (call-process + proced-signal-function nil t nil + signal (number-to-string (car process)))) + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed signals + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))))) + (if failures + ;; Proced error message are not always very precise. + ;; Can we issue a useful one-line summary in the + ;; message area (using FAILURES) if only one signal failed? + (proced-log-summary + (format "Signal %s" signal) + (format "%d of %d signal%s failed" + (length failures) (length process-alist) + (if (= 1 (length process-alist)) "" "s"))) + (proced-success-message "Sent signal to" (length process-alist)))) + ;; final clean-up + (run-hooks 'proced-after-send-signal-hook)) + +(defun proced-renice (priority process-alist) + "Renice the processes in PROCESS-ALIST to PRIORITY. +PROCESS-ALIST is an alist as returned by `proced-marked-processes'. +Interactively, PROCESS-ALIST contains the marked processes. +If no process is marked, it contains the process point is on, +After renicing all processes in PROCESS-ALIST, this command runs +the normal hook `proced-after-send-signal-hook'." + (interactive + (let ((process-alist (proced-marked-processes))) + (proced-with-processes-buffer process-alist + (list (read-number "New priority: ") + process-alist)))) + (if (numberp priority) + (setq priority (number-to-string priority))) + (let (failures) + (dolist (process process-alist) + (with-temp-buffer + (condition-case nil + (unless (zerop (call-process + proced-renice-command nil t nil + priority (number-to-string (car process)))) + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed renice + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))) + (if failures + (proced-log-summary + (format "Renice %s" priority) + (format "%d of %d renice%s failed" + (length failures) (length process-alist) + (if (= 1 (length process-alist)) "" "s"))) + (proced-success-message "Reniced" (length process-alist)))) + ;; final clean-up + (run-hooks 'proced-after-send-signal-hook)) ;; similar to `dired-why' (defun proced-why () diff --git a/lisp/profiler.el b/lisp/profiler.el new file mode 100644 index 00000000000..5fc74573262 --- /dev/null +++ b/lisp/profiler.el @@ -0,0 +1,665 @@ +;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*- + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Tomohiro Matsuyama <tomo@cx4a.org> +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(eval-when-compile + (require 'cl-lib)) + +(defgroup profiler nil + "Emacs profiler." + :group 'lisp + :prefix "profiler-") + +(defcustom profiler-sample-interval 1 + "Default sample interval in millisecond." + :type 'integer + :group 'profiler) + +;;; Utilities + +(defun profiler-ensure-string (object) + (cond ((stringp object) + object) + ((symbolp object) + (symbol-name object)) + ((numberp object) + (number-to-string object)) + (t + (format "%s" object)))) + +(defun profiler-format (fmt &rest args) + (cl-loop for (width align subfmt) in fmt + for arg in args + for str = (cond + ((consp subfmt) + (apply 'profiler-format subfmt arg)) + ((stringp subfmt) + (format subfmt arg)) + ((and (symbolp subfmt) + (fboundp subfmt)) + (funcall subfmt arg)) + (t + (profiler-ensure-string arg))) + for len = (length str) + if (< width len) + collect (substring str 0 width) into frags + else + collect + (let ((padding (make-string (- width len) ?\s))) + (cl-ecase align + (left (concat str padding)) + (right (concat padding str)))) + into frags + finally return (apply #'concat frags))) + +(defun profiler-format-percent (number divisor) + (concat (number-to-string (/ (* number 100) divisor)) "%")) + +(defun profiler-format-nbytes (nbytes) + "Format NBYTES in humarn readable string." + (if (and (integerp nbytes) (> nbytes 0)) + (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3) + for c in (append (number-to-string nbytes) nil) + if (= i 0) + collect ?, into s + and do (setq i 3) + collect c into s + do (cl-decf i) + finally return + (apply 'string (if (eq (car s) ?,) (cdr s) s))) + (profiler-ensure-string nbytes))) + + +;;; Entries + +(defun profiler-entry-format (entry) + "Format ENTRY in human readable string. ENTRY would be a +function name of a function itself." + (cond ((memq (car-safe entry) '(closure lambda)) + (format "#<lambda 0x%x>" (sxhash entry))) + ((byte-code-function-p entry) + (format "#<compiled 0x%x>" (sxhash entry))) + ((or (subrp entry) (symbolp entry) (stringp entry)) + (format "%s" entry)) + (t + (format "#<unknown 0x%x>" (sxhash entry))))) + +;;; Log data structure + +;; The C code returns the log in the form of a hash-table where the keys are +;; vectors (of size profiler-max-stack-depth, holding truncated +;; backtraces, where the first element is the top of the stack) and +;; the values are integers (which count how many times this backtrace +;; has been seen, multiplied by a "weight factor" which is either the +;; sample-interval or the memory being allocated). +;; We extend it by adding a few other entries to the hash-table, most notably: +;; - Key `type' has a value indicating the kind of log (`memory' or `cpu'). +;; - Key `timestamp' has a value giving the time when the log was obtained. +;; - Key `diff-p' indicates if this log represents a diff between two logs. + +(defun profiler-log-timestamp (log) (gethash 'timestamp log)) +(defun profiler-log-type (log) (gethash 'type log)) +(defun profiler-log-diff-p (log) (gethash 'diff-p log)) + +(defun profiler-log-diff (log1 log2) + "Compare LOG1 with LOG2 and return a diff log. Both logs must +be same type." + (unless (eq (profiler-log-type log1) + (profiler-log-type log2)) + (error "Can't compare different type of logs")) + (let ((newlog (make-hash-table :test 'equal))) + ;; Make a copy of `log1' into `newlog'. + (maphash (lambda (backtrace count) (puthash backtrace count newlog)) + log1) + (puthash 'diff-p t newlog) + (maphash (lambda (backtrace count) + (when (vectorp backtrace) + (puthash backtrace (- (gethash backtrace log1 0) count) + newlog))) + log2) + newlog)) + +(defun profiler-log-fixup-entry (entry) + (if (symbolp entry) + entry + (profiler-entry-format entry))) + +(defun profiler-log-fixup-backtrace (backtrace) + (mapcar 'profiler-log-fixup-entry backtrace)) + +(defun profiler-log-fixup (log) + "Fixup LOG so that the log could be serialized into file." + (let ((newlog (make-hash-table :test 'equal))) + (maphash (lambda (backtrace count) + (puthash (if (not (vectorp backtrace)) + backtrace + (profiler-log-fixup-backtrace backtrace)) + count newlog)) + log) + newlog)) + +(defun profiler-log-write-file (log filename &optional confirm) + "Write LOG into FILENAME." + (with-temp-buffer + (let (print-level print-length) + (print (profiler-log-fixup log) (current-buffer))) + (write-file filename confirm))) + +(defun profiler-log-read-file (filename) + "Read log from FILENAME." + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (read (current-buffer)))) + + +;;; Calltree data structure + +(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) + entry + (count 0) (count-percent "") + parent children) + +(defun profiler-calltree-leaf-p (tree) + (null (profiler-calltree-children tree))) + +(defun profiler-calltree-count< (a b) + (cond ((eq (profiler-calltree-entry a) t) t) + ((eq (profiler-calltree-entry b) t) nil) + (t (< (profiler-calltree-count a) + (profiler-calltree-count b))))) + +(defun profiler-calltree-count> (a b) + (not (profiler-calltree-count< a b))) + +(defun profiler-calltree-depth (tree) + (let ((parent (profiler-calltree-parent tree))) + (if (null parent) + 0 + (1+ (profiler-calltree-depth parent))))) + +(defun profiler-calltree-find (tree entry) + "Return a child tree of ENTRY under TREE." + ;; OPTIMIZED + (let (result (children (profiler-calltree-children tree))) + ;; FIXME: Use `assoc'. + (while (and children (null result)) + (let ((child (car children))) + (when (equal (profiler-calltree-entry child) entry) + (setq result child)) + (setq children (cdr children)))) + result)) + +(defun profiler-calltree-walk (calltree function) + (funcall function calltree) + (dolist (child (profiler-calltree-children calltree)) + (profiler-calltree-walk child function))) + +(defun profiler-calltree-build-1 (tree log &optional reverse) + ;; FIXME: Do a better job of reconstructing a complete call-tree + ;; when the backtraces have been truncated. Ideally, we should be + ;; able to reduce profiler-max-stack-depth to 3 or 4 and still + ;; get a meaningful call-tree. + (maphash + (lambda (backtrace count) + (when (vectorp backtrace) + (let ((node tree) + (max (length backtrace))) + (dotimes (i max) + (let ((entry (aref backtrace (if reverse i (- max i 1))))) + (when entry + (let ((child (profiler-calltree-find node entry))) + (unless child + (setq child (profiler-make-calltree + :entry entry :parent node)) + (push child (profiler-calltree-children node))) + (cl-incf (profiler-calltree-count child) count) + (setq node child)))))))) + log)) + +(defun profiler-calltree-compute-percentages (tree) + (let ((total-count 0)) + ;; FIXME: the memory profiler's total wraps around all too easily! + (dolist (child (profiler-calltree-children tree)) + (cl-incf total-count (profiler-calltree-count child))) + (unless (zerop total-count) + (profiler-calltree-walk + tree (lambda (node) + (setf (profiler-calltree-count-percent node) + (profiler-format-percent (profiler-calltree-count node) + total-count))))))) + +(cl-defun profiler-calltree-build (log &key reverse) + (let ((tree (profiler-make-calltree))) + (profiler-calltree-build-1 tree log reverse) + (profiler-calltree-compute-percentages tree) + tree)) + +(defun profiler-calltree-sort (tree predicate) + (let ((children (profiler-calltree-children tree))) + (setf (profiler-calltree-children tree) (sort children predicate)) + (dolist (child (profiler-calltree-children tree)) + (profiler-calltree-sort child predicate)))) + + +;;; Report rendering + +(defcustom profiler-report-closed-mark "+" + "An indicator of closed calltrees." + :type 'string + :group 'profiler) + +(defcustom profiler-report-open-mark "-" + "An indicator of open calltrees." + :type 'string + :group 'profiler) + +(defcustom profiler-report-leaf-mark " " + "An indicator of calltree leaves." + :type 'string + :group 'profiler) + +(defvar profiler-report-sample-line-format + '((60 left) + (14 right ((9 right) + (5 right))))) + +(defvar profiler-report-memory-line-format + '((55 left) + (19 right ((14 right profiler-format-nbytes) + (5 right))))) + +(defvar-local profiler-report-log nil + "The current profiler log.") + +(defvar-local profiler-report-reversed nil + "True if calltree is rendered in bottom-up. Do not touch this +variable directly.") + +(defvar-local profiler-report-order nil + "The value can be `ascending' or `descending'. Do not touch +this variable directly.") + +(defun profiler-report-make-entry-part (entry) + (let ((string (cond + ((eq entry t) + "Others") + ((and (symbolp entry) + (fboundp entry)) + (propertize (symbol-name entry) + 'face 'link + 'mouse-face 'highlight + 'help-echo "mouse-2 or RET jumps to definition")) + (t + (profiler-entry-format entry))))) + (propertize string 'profiler-entry entry))) + +(defun profiler-report-make-name-part (tree) + (let* ((entry (profiler-calltree-entry tree)) + (depth (profiler-calltree-depth tree)) + (indent (make-string (* (1- depth) 2) ?\s)) + (mark (if (profiler-calltree-leaf-p tree) + profiler-report-leaf-mark + profiler-report-closed-mark)) + (entry (profiler-report-make-entry-part entry))) + (format "%s%s %s" indent mark entry))) + +(defun profiler-report-header-line-format (fmt &rest args) + (let* ((header (apply 'profiler-format fmt args)) + (escaped (replace-regexp-in-string "%" "%%" header))) + (concat " " escaped))) + +(defun profiler-report-line-format (tree) + (let ((diff-p (profiler-log-diff-p profiler-report-log)) + (name-part (profiler-report-make-name-part tree)) + (count (profiler-calltree-count tree)) + (count-percent (profiler-calltree-count-percent tree))) + (profiler-format (cl-ecase (profiler-log-type profiler-report-log) + (cpu profiler-report-sample-line-format) + (memory profiler-report-memory-line-format)) + name-part + (if diff-p + (list (if (> count 0) + (format "+%s" count) + count) + "") + (list count count-percent))))) + +(defun profiler-report-insert-calltree (tree) + (let ((line (profiler-report-line-format tree))) + (insert (propertize (concat line "\n") 'calltree tree)))) + +(defun profiler-report-insert-calltree-children (tree) + (mapc 'profiler-report-insert-calltree + (profiler-calltree-children tree))) + + +;;; Report mode + +(defvar profiler-report-mode-map + (let ((map (make-sparse-keymap))) + ;; FIXME: Add menu. + (define-key map "n" 'profiler-report-next-entry) + (define-key map "p" 'profiler-report-previous-entry) + ;; I find it annoying more than helpful to not be able to navigate + ;; normally with the cursor keys. --Stef + ;; (define-key map [down] 'profiler-report-next-entry) + ;; (define-key map [up] 'profiler-report-previous-entry) + (define-key map "\r" 'profiler-report-toggle-entry) + (define-key map "\t" 'profiler-report-toggle-entry) + (define-key map "i" 'profiler-report-toggle-entry) + (define-key map "f" 'profiler-report-find-entry) + (define-key map "j" 'profiler-report-find-entry) + (define-key map [mouse-2] 'profiler-report-find-entry) + (define-key map "d" 'profiler-report-describe-entry) + (define-key map "C" 'profiler-report-render-calltree) + (define-key map "B" 'profiler-report-render-reversed-calltree) + (define-key map "A" 'profiler-report-ascending-sort) + (define-key map "D" 'profiler-report-descending-sort) + (define-key map "=" 'profiler-report-compare-log) + (define-key map (kbd "C-x C-w") 'profiler-report-write-log) + (define-key map "q" 'quit-window) + map)) + +(defun profiler-report-make-buffer-name (log) + (format "*%s-Profiler-Report %s*" + (cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory)) + (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log)))) + +(defun profiler-report-setup-buffer (log) + "Make a buffer for LOG and return it." + (let* ((buf-name (profiler-report-make-buffer-name log)) + (buffer (get-buffer-create buf-name))) + (with-current-buffer buffer + (profiler-report-mode) + (setq profiler-report-log log + profiler-report-reversed nil + profiler-report-order 'descending)) + buffer)) + +(define-derived-mode profiler-report-mode special-mode "Profiler-Report" + "Profiler Report Mode." + (setq buffer-read-only t + buffer-undo-list t + truncate-lines t)) + + +;;; Report commands + +(defun profiler-report-calltree-at-point () + (get-text-property (point) 'calltree)) + +(defun profiler-report-move-to-entry () + (let ((point (next-single-property-change (line-beginning-position) + 'profiler-entry))) + (if point + (goto-char point) + (back-to-indentation)))) + +(defun profiler-report-next-entry () + "Move cursor to next entry." + (interactive) + (forward-line) + (profiler-report-move-to-entry)) + +(defun profiler-report-previous-entry () + "Move cursor to previous entry." + (interactive) + (forward-line -1) + (profiler-report-move-to-entry)) + +(defun profiler-report-expand-entry () + "Expand entry at point." + (interactive) + (save-excursion + (beginning-of-line) + (when (search-forward (concat profiler-report-closed-mark " ") + (line-end-position) t) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((inhibit-read-only t)) + (replace-match (concat profiler-report-open-mark " ")) + (forward-line) + (profiler-report-insert-calltree-children tree) + t)))))) + +(defun profiler-report-collapse-entry () + "Collpase entry at point." + (interactive) + (save-excursion + (beginning-of-line) + (when (search-forward (concat profiler-report-open-mark " ") + (line-end-position) t) + (let* ((tree (profiler-report-calltree-at-point)) + (depth (profiler-calltree-depth tree)) + (start (line-beginning-position 2)) + d) + (when tree + (let ((inhibit-read-only t)) + (replace-match (concat profiler-report-closed-mark " ")) + (while (and (eq (forward-line) 0) + (let ((child (get-text-property (point) 'calltree))) + (and child + (numberp (setq d (profiler-calltree-depth child))))) + (> d depth))) + (delete-region start (line-beginning-position))))) + t))) + +(defun profiler-report-toggle-entry () + "Expand entry at point if the tree is collapsed, +otherwise collapse." + (interactive) + (or (profiler-report-expand-entry) + (profiler-report-collapse-entry))) + +(defun profiler-report-find-entry (&optional event) + "Find entry at point." + (interactive (list last-nonmenu-event)) + (if event (posn-set-point (event-end event))) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((entry (profiler-calltree-entry tree))) + (find-function entry))))) + +(defun profiler-report-describe-entry () + "Describe entry at point." + (interactive) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((entry (profiler-calltree-entry tree))) + (require 'help-fns) + (describe-function entry))))) + +(cl-defun profiler-report-render-calltree-1 + (log &key reverse (order 'descending)) + (let ((calltree (profiler-calltree-build profiler-report-log + :reverse reverse))) + (setq header-line-format + (cl-ecase (profiler-log-type log) + (cpu + (profiler-report-header-line-format + profiler-report-sample-line-format + "Function" (list "Time (ms)" "%"))) + (memory + (profiler-report-header-line-format + profiler-report-memory-line-format + "Function" (list "Bytes" "%"))))) + (let ((predicate (cl-ecase order + (ascending #'profiler-calltree-count<) + (descending #'profiler-calltree-count>)))) + (profiler-calltree-sort calltree predicate)) + (let ((inhibit-read-only t)) + (erase-buffer) + (profiler-report-insert-calltree-children calltree) + (goto-char (point-min)) + (profiler-report-move-to-entry)))) + +(defun profiler-report-rerender-calltree () + (profiler-report-render-calltree-1 profiler-report-log + :reverse profiler-report-reversed + :order profiler-report-order)) + +(defun profiler-report-render-calltree () + "Render calltree view." + (interactive) + (setq profiler-report-reversed nil) + (profiler-report-rerender-calltree)) + +(defun profiler-report-render-reversed-calltree () + "Render reversed calltree view." + (interactive) + (setq profiler-report-reversed t) + (profiler-report-rerender-calltree)) + +(defun profiler-report-ascending-sort () + "Sort calltree view in ascending order." + (interactive) + (setq profiler-report-order 'ascending) + (profiler-report-rerender-calltree)) + +(defun profiler-report-descending-sort () + "Sort calltree view in descending order." + (interactive) + (setq profiler-report-order 'descending) + (profiler-report-rerender-calltree)) + +(defun profiler-report-log (log) + (let ((buffer (profiler-report-setup-buffer log))) + (with-current-buffer buffer + (profiler-report-render-calltree)) + (pop-to-buffer buffer))) + +(defun profiler-report-compare-log (buffer) + "Compare the current profiler log with another." + (interactive (list (read-buffer "Compare to: "))) + (let* ((log1 (with-current-buffer buffer profiler-report-log)) + (log2 profiler-report-log) + (diff-log (profiler-log-diff log1 log2))) + (profiler-report-log diff-log))) + +(defun profiler-report-write-log (filename &optional confirm) + "Write the current profiler log into FILENAME." + (interactive + (list (read-file-name "Write log: " default-directory) + (not current-prefix-arg))) + (profiler-log-write-file profiler-report-log + filename + confirm)) + + +;;; Profiler commands + +;;;###autoload +(defun profiler-start (mode) + "Start/restart profilers. +MODE can be one of `cpu', `mem', or `cpu+mem'. +If MODE is `cpu' or `cpu+mem', time-based profiler will be started. +Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." + (interactive + (list (if (not (fboundp 'profiler-cpu-start)) 'mem + (intern (completing-read "Mode (default cpu): " + '("cpu" "mem" "cpu+mem") + nil t nil nil "cpu"))))) + (cl-ecase mode + (cpu + (profiler-cpu-start profiler-sample-interval) + (message "CPU profiler started")) + (mem + (profiler-memory-start) + (message "Memory profiler started")) + (cpu+mem + (profiler-cpu-start profiler-sample-interval) + (profiler-memory-start) + (message "CPU and memory profiler started")))) + +(defun profiler-stop () + "Stop started profilers. Profiler logs will be kept." + (interactive) + (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop))) + (mem (profiler-memory-stop))) + (message "%s profiler stopped" + (cond ((and mem cpu) "CPU and memory") + (mem "Memory") + (cpu "CPU") + (t "No"))))) + +(defun profiler-reset () + "Reset profiler log." + (interactive) + (when (fboundp 'profiler-cpu-log) + (ignore (profiler-cpu-log))) + (ignore (profiler-memory-log)) + t) + +(defun profiler--report-cpu () + (let ((log (if (fboundp 'profiler-cpu-log) (profiler-cpu-log)))) + (when log + (puthash 'type 'cpu log) + (puthash 'timestamp (current-time) log) + (profiler-report-log log)))) + +(defun profiler--report-memory () + (let ((log (profiler-memory-log))) + (when log + (puthash 'type 'memory log) + (puthash 'timestamp (current-time) log) + (profiler-report-log log)))) + +(defun profiler-report () + "Report profiling results." + (interactive) + (profiler--report-cpu) + (profiler--report-memory)) + +;;;###autoload +(defun profiler-find-log (filename) + "Read a profiler log from FILENAME and report it." + (interactive + (list (read-file-name "Find log: " default-directory))) + (profiler-report-log (profiler-log-read-file filename))) + + +;;; Profiling helpers + +;; (cl-defmacro with-sample-profiling ((&key interval) &rest body) +;; `(unwind-protect +;; (progn +;; (ignore (profiler-cpu-log)) +;; (profiler-cpu-start ,interval) +;; ,@body) +;; (profiler-cpu-stop) +;; (profiler--report-cpu))) + +;; (defmacro with-memory-profiling (&rest body) +;; `(unwind-protect +;; (progn +;; (ignore (profiler-memory-log)) +;; (profiler-memory-start) +;; ,@body) +;; (profiler-memory-stop) +;; (profiler--report-memory))) + +(provide 'profiler) +;;; profiler.el ends here diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 1825098a55e..745320b6eb2 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -5218,11 +5218,11 @@ Return nil if no body was found." ;; correctly highlight a with_clause that spans multiple lines. (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)" "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W") - '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t)) + '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t)) ;; ;; Goto tags. - '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face) + '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face) ;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>) (list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 95b8758ba80..09fba380f15 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -748,12 +748,10 @@ Faces `compilation-error-face', `compilation-warning-face', (defvar compilation-leave-directory-face 'font-lock-builtin-face "Face name to use for leaving directory messages.") - - ;; Used for compatibility with the old compile.el. (defvar compilation-parse-errors-function nil) -(make-obsolete 'compilation-parse-errors-function - 'compilation-error-regexp-alist "24.1") +(make-obsolete-variable 'compilation-parse-errors-function + 'compilation-error-regexp-alist "24.1") (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." @@ -1499,24 +1497,6 @@ Otherwise, construct a buffer name from NAME-OF-MODE." (t (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 - error-regexp-alist name-function - _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 - (append file-regexp-alist (or error-regexp-alist - compilation-error-regexp-alist))) - (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?" - "\\1" error-message))) - (compilation-start command nil name-function highlight-regexp))) -(make-obsolete 'compile-internal 'compilation-start "22.1") - (defcustom compilation-always-kill nil "If t, always kill a running compilation process before starting a new one. If nil, ask to kill it." diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 9ea71ad36f5..becbcb7a3de 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -191,13 +191,7 @@ if ARG is omitted or nil." (if font-lock-mode (font-lock-fontify-buffer))) ;;;###autoload -(defun turn-on-cwarn-mode () - "Turn on CWarn mode. - -This function is designed to be added to hooks, for example: - (add-hook 'c-mode-hook 'turn-on-cwarn-mode)" - (cwarn-mode 1)) -(make-obsolete 'turn-on-cwarn-mode 'cwarn-mode "24.1") +(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") ;;}}} ;;{{{ Help functions diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 9b634328fa7..e58fb2b3eab 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1151,7 +1151,7 @@ As a user, you should not set this to t.") (common-blocks '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" (1 font-lock-keyword-face) ; "common" - (2 font-lock-reference-face nil t) ; block name + (2 font-lock-constant-face nil t) ; block name ("[ \t]*\\(\\sw+\\)[ ,]*" ;; Start with point after block name and comma (goto-char (match-end 0)) ; needed for XEmacs, could be nil @@ -1169,20 +1169,20 @@ As a user, you should not set this to t.") ;; Labels (label - '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face))) + '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) ;; The goto statement and its label (goto '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" (1 font-lock-keyword-face) - (2 font-lock-reference-face))) + (2 font-lock-constant-face))) ;; Tags in structure definitions. Note that this definition ;; actually collides with labels, so we have to use the same ;; face. It also matches named subscript ranges, ;; e.g. vec{bottom:top]. No good way around this. (structtag - '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face))) + '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face))) ;; Structure names (structname @@ -1195,7 +1195,7 @@ As a user, you should not set this to t.") ;; fontification. Slow, use it only in fancy fontification. (keyword-parameters '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)" - (6 font-lock-reference-face))) + (6 font-lock-constant-face))) ;; System variables start with a bang. (system-variables diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 401970b2ce8..f2578c14066 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -69,9 +69,8 @@ :group 'lisp :version "22.1") -;;;###autoload (defcustom inferior-lisp-filter-regexp - (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") + "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "What not to save on inferior Lisp's input history. Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword @@ -137,14 +136,12 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (define-key inferior-lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)) -;;;###autoload -(defcustom inferior-lisp-program (purecopy "lisp") +(defcustom inferior-lisp-program "lisp" "Program name for invoking an inferior Lisp in Inferior Lisp mode." :type 'string :group 'inferior-lisp) -;;;###autoload -(defcustom inferior-lisp-load-command (purecopy "(load \"%s\")\n") +(defcustom inferior-lisp-load-command "(load \"%s\")\n" "Format-string for building a Lisp expression to load a file. This format string should use `%s' to substitute a file name and should result in a Lisp expression that will command the inferior Lisp @@ -155,8 +152,7 @@ but it works only in Common Lisp." :type 'string :group 'inferior-lisp) -;;;###autoload -(defcustom inferior-lisp-prompt (purecopy "^[^> \n]*>+:? *") +(defcustom inferior-lisp-prompt "^[^> \n]*>+:? *" "Regexp to recognize prompts in the Inferior Lisp mode. Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, and franz. This variable is used to initialize `comint-prompt-regexp' in the @@ -207,7 +203,6 @@ one process, this does the right thing. If you run multiple processes, you can change `inferior-lisp-buffer' to another process buffer with \\[set-variable].") -;;;###autoload (defvar inferior-lisp-mode-hook '() "Hook for customizing Inferior Lisp mode.") diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 33d43cb3d5a..99df94d3805 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2110,7 +2110,7 @@ Argument BOUND is a buffer position limiting searching." (if (eq prolog-system 'mercury) (list (prolog-make-keywords-regexp prolog-mode-specificators-i t) - 0 'font-lock-reference-face))) + 0 'font-lock-constant-face))) (directives (if (eq prolog-system 'mercury) (list diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index bf52eff8f9a..a8fc11f71c0 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -213,9 +213,9 @@ If nil, use `temporary-file-directory'." ;; - 8bit characters (warning face) ;; Multiline strings are not supported. Strings with nested brackets are. (defconst ps-mode-font-lock-keywords-1 - '(("\\`%!PS.*" . font-lock-reference-face) + '(("\\`%!PS.*" . font-lock-constant-face) ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" - . font-lock-reference-face) + . font-lock-constant-face) (ps-mode-match-string-or-comment (1 font-lock-comment-face nil t) (2 font-lock-string-face nil t)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index ffc6c1ac885..e99e6bda4b8 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -497,52 +497,68 @@ The type returned can be `comment', `string' or `paren'." (1 font-lock-variable-name-face nil nil)))) (defconst python-syntax-propertize-function - ;; Make outer chars of matching triple-quote sequences into generic - ;; string delimiters. Fixme: Is there a better way? - ;; First avoid a sequence preceded by an odd number of backslashes. (syntax-propertize-rules - (;; ¡Backrefs don't work in syntax-propertize-rules! - (concat "\\(?:\\([RUru]\\)[Rr]?\\|^\\|[^\\]\\(?:\\\\.\\)*\\)" ;Prefix. - "\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)") - (3 (ignore (python-quote-syntax)))))) - -(defun python-quote-syntax () - "Put `syntax-table' property correctly on triple quote. -Used for syntactic keywords. N is the match number (1, 2 or 3)." - ;; Given a triple quote, we have to check the context to know - ;; whether this is an opening or closing triple or whether it's - ;; quoted anyhow, and should be ignored. (For that we need to do - ;; the same job as `syntax-ppss' to be correct and it seems to be OK - ;; to use it here despite initial worries.) We also have to sort - ;; out a possible prefix -- well, we don't _have_ to, but I think it - ;; should be treated as part of the string. - - ;; Test cases: - ;; ur"""ar""" x='"' # """ - ;; x = ''' """ ' a - ;; ''' - ;; x '"""' x """ \"""" x - (save-excursion - (goto-char (match-beginning 0)) - (let ((syntax (save-match-data (syntax-ppss)))) - (cond - ((eq t (nth 3 syntax)) ; after unclosed fence - ;; Consider property for the last char if in a fenced string. - (goto-char (nth 8 syntax)) ; fence position - (skip-chars-forward "uUrR") ; skip any prefix - ;; Is it a matching sequence? - (if (eq (char-after) (char-after (match-beginning 2))) - (put-text-property (match-beginning 3) (match-end 3) - 'syntax-table (string-to-syntax "|")))) - ((match-end 1) - ;; Consider property for initial char, accounting for prefixes. - (put-text-property (match-beginning 1) (match-end 1) - 'syntax-table (string-to-syntax "|"))) - (t - ;; Consider property for initial char, accounting for prefixes. - (put-text-property (match-beginning 2) (match-end 2) - 'syntax-table (string-to-syntax "|")))) - ))) + ((rx + ;; Match even number of backslashes. + (or (not (any ?\\ ?\' ?\")) point) (* ?\\ ?\\) + ;; Match single or triple quotes of any kind. + (group (or "\"" "\"\"\"" "'" "'''"))) + (1 (ignore (python-syntax-stringify)))) + ((rx + ;; Match odd number of backslashes. + (or (not (any ?\\)) point) ?\\ (* ?\\ ?\\) + ;; Followed by even number of equal quotes. + (group (or "\"\"" "\"\"\"\"" "''" "''''"))) + (1 (ignore (python-syntax-stringify)))))) + +(defsubst python-syntax-count-quotes (quote-char &optional point limit) + "Count number of quotes around point (max is 3). +QUOTE-CHAR is the quote char to count. Optional argument POINT is +the point where scan starts (defaults to current point) and LIMIT +is used to limit the scan." + (let ((i 0)) + (while (and (< i 3) + (or (not limit) (< (+ point i) limit)) + (eq (char-after (+ point i)) quote-char)) + (incf i)) + i)) + +(defun python-syntax-stringify () + "Put `syntax-table' property correctly on single/triple quotes." + (let* ((num-quotes + (let ((n (length (match-string-no-properties 1)))) + ;; This corrects the quote count when matching odd number + ;; of backslashes followed by even number of quotes. + (or (and (= 1 (logand n 1)) n) (1- n)))) + (ppss (prog2 + (backward-char num-quotes) + (syntax-ppss) + (forward-char num-quotes))) + (string-start (and (not (nth 4 ppss)) (nth 8 ppss))) + (quote-starting-pos (- (point) num-quotes)) + (quote-ending-pos (point)) + (num-closing-quotes + (and string-start + (python-syntax-count-quotes + (char-before) string-start quote-starting-pos)))) + (cond ((and string-start (= num-closing-quotes 0)) + ;; This set of quotes doesn't match the string starting + ;; kind. Do nothing. + nil) + ((not string-start) + ;; This set of quotes delimit the start of a string. + (put-text-property quote-starting-pos (1+ quote-starting-pos) + 'syntax-table (string-to-syntax "|"))) + ((= num-quotes num-closing-quotes) + ;; This set of quotes delimit the end of a string. + (put-text-property (1- quote-ending-pos) quote-ending-pos + 'syntax-table (string-to-syntax "|"))) + ((> num-quotes num-closing-quotes) + ;; This may only happen whenever a triple quote is closing + ;; a single quoted string. Add string delimiter syntax to + ;; all three quotes. + (put-text-property quote-starting-pos quote-ending-pos + 'syntax-table (string-to-syntax "|")))))) (defvar python-mode-syntax-table (let ((table (make-syntax-table))) @@ -897,16 +913,27 @@ possible indentation levels and saves it in the variable `python-indent-levels'. Afterwards it sets the variable `python-indent-current-level' correctly so offset is equal to (`nth' `python-indent-current-level' `python-indent-levels')" - (if (or (and (eq this-command 'indent-for-tab-command) - (eq last-command this-command)) - force-toggle) - (if (not (equal python-indent-levels '(0))) - (python-indent-toggle-levels) - (python-indent-calculate-levels)) - (python-indent-calculate-levels)) - (beginning-of-line) - (delete-horizontal-space) - (indent-to (nth python-indent-current-level python-indent-levels)) + (or + (and (or (and (eq this-command 'indent-for-tab-command) + (eq last-command this-command)) + force-toggle) + (not (equal python-indent-levels '(0))) + (or (python-indent-toggle-levels) t)) + (python-indent-calculate-levels)) + (let* ((starting-pos (point-marker)) + (indent-ending-position + (+ (line-beginning-position) (current-indentation))) + (follow-indentation-p + (or (bolp) + (and (<= (line-beginning-position) starting-pos) + (>= indent-ending-position starting-pos)))) + (next-indent (nth python-indent-current-level python-indent-levels))) + (unless (= next-indent (current-indentation)) + (beginning-of-line) + (delete-horizontal-space) + (indent-to next-indent) + (goto-char starting-pos)) + (and follow-indentation-p (back-to-indentation))) (python-info-closing-block-message)) (defun python-indent-line-function () @@ -1892,19 +1919,18 @@ Returns the output. See `python-shell-send-string-no-output'." (defun python-shell-send-buffer (&optional arg) "Send the entire buffer to inferior Python process. - -With prefix ARG include lines surrounded by \"if __name__ == '__main__':\"" +With prefix ARG allow execution of code inside blocks delimited +by \"if __name__== '__main__':\"" (interactive "P") (save-restriction (widen) - (python-shell-send-region - (point-min) - (or (and - (not arg) - (save-excursion - (re-search-forward (python-rx if-name-main) nil t)) - (match-beginning 0)) - (point-max))))) + (let ((str (buffer-substring (point-min) (point-max)))) + (and + (not arg) + (setq str (replace-regexp-in-string + (python-rx if-name-main) + "if __name__ == '__main__ ':" str))) + (python-shell-send-string str)))) (defun python-shell-send-defun (arg) "Send the current defun to inferior Python process. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 0f02e81cbad..84cf7308d75 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1567,7 +1567,7 @@ See `font-lock-syntax-table'.") 2 font-lock-variable-name-face) ;; symbols '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" - 2 font-lock-reference-face) + 2 font-lock-constant-face) ;; variables '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" 1 font-lock-variable-name-face) @@ -1576,7 +1576,7 @@ See `font-lock-syntax-table'.") ;; constants '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)" 2 font-lock-type-face) - '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face) + '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) ;; expression expansion '(ruby-match-expression-expansion 0 font-lock-variable-name-face t) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index b4d550bcee0..e94919ee2a9 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -4079,11 +4079,10 @@ option followed by a colon `:' if the option accepts an argument." (defun sh-maybe-here-document (arg) "Insert self. Without prefix, following unquoted `<' inserts here document. The document is bounded by `sh-here-document-word'." + (declare (obsolete sh-electric-here-document-mode "24.3")) (interactive "*P") (self-insert-command (prefix-numeric-value arg)) (or arg (sh--maybe-here-document))) -(make-obsolete 'sh--maybe-here-document - 'sh-electric-here-document-mode "24.3") (defun sh--maybe-here-document () (or (not (looking-back "[^<]<<")) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index f1ab01fd07f..c82566ca5b6 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -104,7 +104,6 @@ (eval-when-compile (require 'imenu) - (require 'outline) (require 'dabbrev) (require 'add-log)) @@ -544,6 +543,9 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." ;; The mode itself. ;; +(defvar outline-regexp) +(defvar outline-level) + ;;;###autoload (define-derived-mode tcl-mode prog-mode "Tcl" "Major mode for editing Tcl code. diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 31f2fc1fe31..a2f71ff2ab8 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -587,12 +587,6 @@ Key bindings: ;;; Font locking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; XEmacs compatibility -(when (featurep 'xemacs) - (require 'font-lock) - (copy-face 'font-lock-reference-face 'font-lock-constant-face) - (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face)) - (defun vera-font-lock-match-item (limit) "Match, and move over, any declaration item after point. Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 835d548c19f..86ffdf535a0 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,9 +123,9 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "800" +(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3) "Version of this Verilog mode.") -(defconst verilog-mode-release-date "2012-04-23-GNU" +(defconst verilog-mode-release-date (substring "$$Date: 2012-09-17 20:43:10 -0400 (Mon, 17 Sep 2012) $$" 8 -3) "Release date of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1127,10 +1127,11 @@ won't merge conflict." :type 'integer) (put 'verilog-auto-inst-column 'safe-local-variable 'integerp) -(defcustom verilog-auto-inst-interfaced-ports t +(defcustom verilog-auto-inst-interfaced-ports nil "Non-nil means include interfaced ports in AUTOINST expansions." :group 'verilog-mode-auto - :type 'boolean) + :type 'boolean + :version "24.3") (put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-input-ignore-regexp nil @@ -1431,12 +1432,18 @@ If set will become buffer local.") :help "Help on AUTOARG - declaring module port list"] ["AUTOASCIIENUM" (describe-function 'verilog-auto-ascii-enum) :help "Help on AUTOASCIIENUM - creating ASCII for enumerations"] + ["AUTOASSIGNMODPORT" (describe-function 'verilog-auto-assign-modport) + :help "Help on AUTOASSIGNMODPORT - creating assignments to/from modports"] ["AUTOINOUTCOMP" (describe-function 'verilog-auto-inout-comp) :help "Help on AUTOINOUTCOMP - copying complemented i/o from another file"] ["AUTOINOUTIN" (describe-function 'verilog-auto-inout-in) - :help "Help on AUTOINOUTCOMP - copying i/o from another file as all inputs"] + :help "Help on AUTOINOUTIN - copying i/o from another file as all inputs"] + ["AUTOINOUTMODPORT" (describe-function 'verilog-auto-inout-modport) + :help "Help on AUTOINOUTMODPORT - copying i/o from an interface modport"] ["AUTOINOUTMODULE" (describe-function 'verilog-auto-inout-module) :help "Help on AUTOINOUTMODULE - copying i/o from another file"] + ["AUTOINOUTPARAM" (describe-function 'verilog-auto-inout-param) + :help "Help on AUTOINOUTPARAM - copying parameters from another file"] ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp) :help "Help on AUTOINSERTLISP - insert text from a lisp function"] ["AUTOINOUT" (describe-function 'verilog-auto-inout) @@ -1706,12 +1713,19 @@ This speeds up complicated regexp matches." ;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ;;-end (test bait) (defun verilog-delete-trailing-whitespace () - "Delete trailing spaces or tabs, but not newlines nor linefeeds." + "Delete trailing spaces or tabs, but not newlines nor linefeeds. +Also add missing final newline. + +To call this from the command line, see \\[verilog-batch-diff-auto]. + +To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'." ;; Similar to `delete-trailing-whitespace' but that's not present in XEmacs (save-excursion (goto-char (point-min)) (while (re-search-forward "[ \t]+$" nil t) ;; Not syntactic WS as no formfeed - (replace-match "" nil nil)))) + (replace-match "" nil nil)) + (goto-char (point-max)) + (unless (bolp) (insert "\n")))) (defvar compile-command) @@ -5128,6 +5142,15 @@ with \\[verilog-delete-auto] on all command-line files, and saves the buffers." (error "Use verilog-batch-delete-auto only with --batch")) ;; Otherwise we'd mess up buffer modes (verilog-batch-execute-func `verilog-delete-auto)) +(defun verilog-batch-delete-trailing-whitespace () + "For use with --batch, perform whitespace deletion as a stand-alone tool. +This sets up the appropriate Verilog mode environment, removes +whitespace with \\[verilog-delete-trailing-whitespace] on all +command-line files, and saves the buffers." + (unless noninteractive + (error "Use verilog-batch-delete-trailing-whitepace only with --batch")) ;; Otherwise we'd mess up buffer modes + (verilog-batch-execute-func `verilog-delete-trailing-whitespace)) + (defun verilog-batch-diff-auto () "For use with --batch, perform automatic differences as a stand-alone tool. This sets up the appropriate Verilog mode environment, expand automatics @@ -7479,6 +7502,19 @@ See also `verilog-sk-header' for an alternative format." (defsubst verilog-alw-get-uses-delayed (sigs) (aref sigs 0)) +(defsubst verilog-modport-new (name clockings decls) + (list name clockings decls)) +(defsubst verilog-modport-name (sig) + (car sig)) +(defsubst verilog-modport-clockings (sig) + (nth 1 sig)) ;; Returns list of names +(defsubst verilog-modport-clockings-add (sig val) + (setcar (nthcdr 1 sig) (cons val (nth 1 sig)))) +(defsubst verilog-modport-decls (sig) + (nth 2 sig)) ;; Returns verilog-decls-* structure +(defsubst verilog-modport-decls-set (sig val) + (setcar (nthcdr 2 sig) val)) + (defsubst verilog-modi-new (name fob pt type) (vector name fob pt type)) (defsubst verilog-modi-name (modi) @@ -7496,8 +7532,15 @@ See also `verilog-sk-header' for an alternative format." ;; Signal reading for given module ;; Note these all take modi's - as returned from verilog-modi-current -(defsubst verilog-decls-new (out inout in vars unuseds assigns consts gparams interfaces) - (vector out inout in vars unuseds assigns consts gparams interfaces)) +(defsubst verilog-decls-new (out inout in vars modports assigns consts gparams interfaces) + (vector out inout in vars modports assigns consts gparams interfaces)) +(defsubst verilog-decls-append (a b) + (cond ((not a) b) ((not b) a) + (t (vector (append (aref a 0) (aref b 0)) (append (aref a 1) (aref b 1)) + (append (aref a 2) (aref b 2)) (append (aref a 3) (aref b 3)) + (append (aref a 4) (aref b 4)) (append (aref a 5) (aref b 5)) + (append (aref a 6) (aref b 6)) (append (aref a 7) (aref b 7)) + (append (aref a 8) (aref b 8)))))) (defsubst verilog-decls-get-outputs (decls) (aref decls 0)) (defsubst verilog-decls-get-inouts (decls) @@ -7506,8 +7549,8 @@ See also `verilog-sk-header' for an alternative format." (aref decls 2)) (defsubst verilog-decls-get-vars (decls) (aref decls 3)) -;;(defsubst verilog-decls-get-unused (decls) -;; (aref decls 4)) +(defsubst verilog-decls-get-modports (decls) ;; Also for clocking blocks; contains another verilog-decls struct + (aref decls 4)) ;; Returns verilog-modport* structure (defsubst verilog-decls-get-assigns (decls) (aref decls 5)) (defsubst verilog-decls-get-consts (decls) @@ -7517,6 +7560,7 @@ See also `verilog-sk-header' for an alternative format." (defsubst verilog-decls-get-interfaces (decls) (aref decls 8)) + (defsubst verilog-subdecls-new (out inout in intf intfd) (vector out inout in intf intfd)) (defsubst verilog-subdecls-get-outputs (subdecls) @@ -7535,6 +7579,36 @@ See also `verilog-sk-header' for an alternative format." (mapcar (lambda (name) (verilog-sig-new name nil nil nil nil nil nil nil nil)) signame-list)) +(defun verilog-signals-in (in-list not-list) + "Return list of signals in IN-LIST that are also in NOT-LIST. +Also remove any duplicates in IN-LIST. +Signals must be in standard (base vector) form." + ;; This function is hot, so implemented as O(1) + (cond ((eval-when-compile (fboundp 'make-hash-table)) + (let ((ht (make-hash-table :test 'equal :rehash-size 4.0)) + (ht-not (make-hash-table :test 'equal :rehash-size 4.0)) + out-list) + (while not-list + (puthash (car (car not-list)) t ht-not) + (setq not-list (cdr not-list))) + (while in-list + (when (and (gethash (verilog-sig-name (car in-list)) ht-not) + (not (gethash (verilog-sig-name (car in-list)) ht))) + (setq out-list (cons (car in-list) out-list)) + (puthash (verilog-sig-name (car in-list)) t ht)) + (setq in-list (cdr in-list))) + (nreverse out-list))) + ;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4) + (t + (let (out-list) + (while in-list + (if (and (assoc (verilog-sig-name (car in-list)) not-list) + (not (assoc (verilog-sig-name (car in-list)) out-list))) + (setq out-list (cons (car in-list) out-list))) + (setq in-list (cdr in-list))) + (nreverse out-list))))) +;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("C" ""))) + (defun verilog-signals-not-in (in-list not-list) "Return list of signals in IN-LIST that aren't also in NOT-LIST. Also remove any duplicates in IN-LIST. @@ -7556,8 +7630,8 @@ Signals must be in standard (base vector) form." (t (let (out-list) (while in-list - (if (not (or (assoc (verilog-sig-name (car in-list)) not-list) - (assoc (verilog-sig-name (car in-list)) out-list))) + (if (and (not (assoc (verilog-sig-name (car in-list)) not-list)) + (not (assoc (verilog-sig-name (car in-list)) out-list))) (setq out-list (cons (car in-list) out-list))) (setq in-list (cdr in-list))) (nreverse out-list))))) @@ -7702,30 +7776,35 @@ Tieoff value uses `verilog-active-low-regexp' and ;; Dumping ;; -(defun verilog-decls-princ (decls) +(defun verilog-decls-princ (decls &optional header prefix) "For debug, dump the `verilog-read-decls' structure DECLS." - (verilog-signals-princ (verilog-decls-get-outputs decls) - "Outputs:\n" " ") - (verilog-signals-princ (verilog-decls-get-inouts decls) - "Inout:\n" " ") - (verilog-signals-princ (verilog-decls-get-inputs decls) - "Inputs:\n" " ") - (verilog-signals-princ (verilog-decls-get-vars decls) - "Vars:\n" " ") - (verilog-signals-princ (verilog-decls-get-assigns decls) - "Assigns:\n" " ") - (verilog-signals-princ (verilog-decls-get-consts decls) - "Consts:\n" " ") - (verilog-signals-princ (verilog-decls-get-gparams decls) - "Gparams:\n" " ") - (verilog-signals-princ (verilog-decls-get-interfaces decls) - "Interfaces:\n" " ") - (princ "\n")) + (when decls + (if header (princ header)) + (setq prefix (or prefix "")) + (verilog-signals-princ (verilog-decls-get-outputs decls) + (concat prefix "Outputs:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-inouts decls) + (concat prefix "Inout:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-inputs decls) + (concat prefix "Inputs:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-vars decls) + (concat prefix "Vars:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-assigns decls) + (concat prefix "Assigns:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-consts decls) + (concat prefix "Consts:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-gparams decls) + (concat prefix "Gparams:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-interfaces decls) + (concat prefix "Interfaces:\n") (concat prefix " ")) + (verilog-modport-princ (verilog-decls-get-modports decls) + (concat prefix "Modports:\n") (concat prefix " ")) + (princ "\n"))) (defun verilog-signals-princ (signals &optional header prefix) "For debug, dump internal SIGNALS structures, with HEADER and PREFIX." (when signals - (princ header) + (if header (princ header)) (while signals (let ((sig (car signals))) (setq signals (cdr signals)) @@ -7741,6 +7820,21 @@ Tieoff value uses `verilog-active-low-regexp' and (princ " modp=") (princ (verilog-sig-modport sig)) (princ "\n"))))) +(defun verilog-modport-princ (modports &optional header prefix) + "For debug, dump internal MODPORT structures, with HEADER and PREFIX." + (when modports + (if header (princ header)) + (while modports + (let ((sig (car modports))) + (setq modports (cdr modports)) + (princ prefix) + (princ "\"") (princ (verilog-modport-name sig)) (princ "\"") + (princ " clockings=") (princ (verilog-modport-clockings sig)) + (princ "\n") + (verilog-decls-princ (verilog-modport-decls sig) + (concat prefix " syms:\n") + (concat prefix " ")))))) + ;; ;; Port/Wire/Etc Reading ;; @@ -7851,11 +7945,12 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." Return an array of [outputs inouts inputs wire reg assign const]." (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) - in-modport ptype ign-prop + in-modport in-clocking ptype ign-prop sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const - sigs-gparam sigs-intf + sigs-gparam sigs-intf sigs-modports vec expect-signal keywd newsig rvalue enum io signed typedefed multidim - modport) + modport + varstack tmp) (save-excursion (verilog-beg-of-defun-quick) (setq sigs-const (verilog-read-auto-constants (point) end-mod-point)) @@ -7881,6 +7976,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point)))) ((eq ?\; (following-char)) + (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration + (verilog-modport-decls-set + in-modport + (verilog-decls-new sigs-out sigs-inout sigs-in + nil nil nil nil nil nil)) + ;; Pop from varstack to restore state to pre-clocking + (setq tmp (car varstack) + varstack (cdr varstack) + sigs-out (aref tmp 0) + sigs-inout (aref tmp 1) + sigs-in (aref tmp 2))) (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil v2kargs-ok nil in-modport nil ign-prop nil) (forward-char 1)) @@ -7974,15 +8080,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq signed keywd)) ((member keywd '("assert" "assume" "cover" "expect" "restrict")) (setq ign-prop t)) - ((member keywd '("class" "clocking" "covergroup" "function" + ((member keywd '("class" "covergroup" "function" "property" "randsequence" "sequence" "task")) (unless ign-prop (setq functask (1+ functask)))) - ((member keywd '("endclass" "endclocking" "endgroup" "endfunction" + ((member keywd '("endclass" "endgroup" "endfunction" "endproperty" "endsequence" "endtask")) (setq functask (1- functask))) ((equal keywd "modport") (setq in-modport t)) + ((equal keywd "clocking") + (setq in-clocking t)) ((equal keywd "type") (setq ptype t)) ;; Ifdef? Ignore name of define @@ -8008,11 +8116,47 @@ Return an array of [outputs inouts inputs wire reg assign const]." (goto-char (match-end 0)) (when (not rvalue) (setq expect-signal nil))) + ;; "modport <keywd>" + ((and (eq in-modport t) + (not (member keywd verilog-keywords))) + (setq in-modport (verilog-modport-new keywd nil nil)) + (setq sigs-modports (cons in-modport sigs-modports)) + ;; Push old sig values to stack and point to new signal list + (setq varstack (cons (vector sigs-out sigs-inout sigs-in) + varstack)) + (setq sigs-in nil sigs-inout nil sigs-out nil)) + ;; "modport x (clocking <keywd>)" + ((and in-modport in-clocking) + (verilog-modport-clockings-add in-modport keywd) + (setq in-clocking nil)) + ;; endclocking + ((and in-clocking + (equal keywd "endclocking")) + (unless (eq in-clocking t) + (verilog-modport-decls-set + in-clocking + (verilog-decls-new sigs-out sigs-inout sigs-in + nil nil nil nil nil nil)) + ;; Pop from varstack to restore state to pre-clocking + (setq tmp (car varstack) + varstack (cdr varstack) + sigs-out (aref tmp 0) + sigs-inout (aref tmp 1) + sigs-in (aref tmp 2))) + (setq in-clocking nil)) + ;; "clocking <keywd>" + ((and (eq in-clocking t) + (not (member keywd verilog-keywords))) + (setq in-clocking (verilog-modport-new keywd nil nil)) + (setq sigs-modports (cons in-clocking sigs-modports)) + ;; Push old sig values to stack and point to new signal list + (setq varstack (cons (vector sigs-out sigs-inout sigs-in) + varstack)) + (setq sigs-in nil sigs-inout nil sigs-out nil)) ;; New signal, maybe? ((and expect-signal (not rvalue) (eq functask 0) - (not in-modport) (not (member keywd verilog-keywords))) ;; Add new signal to expect-signal's variable (setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport)) @@ -8022,15 +8166,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (forward-char 1))) (skip-syntax-forward " ")) ;; Return arguments - (verilog-decls-new (nreverse sigs-out) - (nreverse sigs-inout) - (nreverse sigs-in) - (nreverse sigs-var) - nil - (nreverse sigs-assign) - (nreverse sigs-const) - (nreverse sigs-gparam) - (nreverse sigs-intf))))) + (setq tmp (verilog-decls-new (nreverse sigs-out) + (nreverse sigs-inout) + (nreverse sigs-in) + (nreverse sigs-var) + (nreverse sigs-modports) + (nreverse sigs-assign) + (nreverse sigs-const) + (nreverse sigs-gparam) + (nreverse sigs-intf))) + ;;(if dbg (verilog-decls-princ tmp)) + tmp))) (defvar verilog-read-sub-decls-in-interfaced nil "For `verilog-read-sub-decls', process next signal as under interfaced block.") @@ -9352,12 +9498,12 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." ;;(message "verilog-modi-lookup: HIT %S" modi) modi) ;; Miss - (t (let* ((realmod (verilog-symbol-detick module t)) - (orig-filenames (verilog-module-filenames realmod current)) + (t (let* ((realname (verilog-symbol-detick module t)) + (orig-filenames (verilog-module-filenames realname current)) (filenames orig-filenames) mif) (while (and filenames (not mif)) - (if (not (setq mif (verilog-module-inside-filename-p realmod (car filenames)))) + (if (not (setq mif (verilog-module-inside-filename-p realname (car filenames)))) (setq filenames (cdr filenames)))) ;; mif has correct form to become later elements of modi (cond (mif (setq modi mif)) @@ -9365,8 +9511,8 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (or ignore-error (error (concat (verilog-point-text) ": Can't locate " module " module definition" - (if (not (equal module realmod)) - (concat " (Expanded macro to " realmod ")") + (if (not (equal module realname)) + (concat " (Expanded macro to " realname ")") "") "\n Check the verilog-library-directories variable." "\n I looked in (if not listed, doesn't exist):\n\t" @@ -9465,6 +9611,45 @@ and invalidating the cache." (progn ,@body))) +(defun verilog-modi-modport-lookup-one (modi name &optional ignore-error) + "Given a MODI, return the declarations related to the given modport NAME." + ;; Recursive routine - see below + (let* ((realname (verilog-symbol-detick name t)) + (modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi))))) + (or modport ignore-error + (error (concat (verilog-point-text) + ": Can't locate " name " modport definition" + (if (not (equal name realname)) + (concat " (Expanded macro to " realname ")") + "")))) + (let* ((decls (verilog-modport-decls modport)) + (clks (verilog-modport-clockings modport))) + ;; Now expand any clocking's + (while clks + (setq decls (verilog-decls-append + decls + (verilog-modi-modport-lookup-one modi (car clks) ignore-error))) + (setq clks (cdr clks))) + decls))) + +(defun verilog-modi-modport-lookup (modi name-re &optional ignore-error) + "Given a MODI, return the declarations related to the given modport NAME-RE. +If the modport points to any clocking blocks, expand the signals to include +those clocking block's signals." + ;; Recursive routine - see below + (let* ((mod-decls (verilog-modi-get-decls modi)) + (clks (verilog-decls-get-modports mod-decls)) + (name-re (concat "^" name-re "$")) + (decls (verilog-decls-new nil nil nil nil nil nil nil nil nil))) + ;; Pull in all modports + (while clks + (when (string-match name-re (verilog-modport-name (car clks))) + (setq decls (verilog-decls-append + decls + (verilog-modi-modport-lookup-one modi (verilog-modport-name (car clks)) ignore-error)))) + (setq clks (cdr clks))) + decls)) + (defun verilog-signals-matching-enum (in-list enum) "Return all signals in IN-LIST matching the given ENUM." (let (out-list) @@ -9544,6 +9729,13 @@ if non-nil." (verilog-decls-get-inouts decls) (verilog-decls-get-inputs decls))) +(defun verilog-decls-get-iovars (decls) + (append + (verilog-decls-get-vars decls) + (verilog-decls-get-outputs decls) + (verilog-decls-get-inouts decls) + (verilog-decls-get-inputs decls))) + (defsubst verilog-modi-cache-add-outputs (modi sig-list) (verilog-modi-cache-add modi 'verilog-read-decls 0 sig-list)) (defsubst verilog-modi-cache-add-inouts (modi sig-list) @@ -9552,6 +9744,8 @@ if non-nil." (verilog-modi-cache-add modi 'verilog-read-decls 2 sig-list)) (defsubst verilog-modi-cache-add-vars (modi sig-list) (verilog-modi-cache-add modi 'verilog-read-decls 3 sig-list)) +(defsubst verilog-modi-cache-add-gparams (modi sig-list) + (verilog-modi-cache-add modi 'verilog-read-decls 7 sig-list)) ;; @@ -9608,6 +9802,8 @@ When MODI is non-null, also add to modi-cache, for tracking." (when verilog-auto-declare-nettype (verilog-modi-cache-add-vars modi sigs))) ((equal direction "interface")) + ((equal direction "parameter") + (verilog-modi-cache-add-gparams modi sigs)) (t (error "Unsupported verilog-insert-definition direction: %s" direction)))) (or dont-sort @@ -9654,6 +9850,11 @@ Presumes that any newlines end a list element." stuff (cdr stuff))))) ;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n")) +(defun verilog-forward-or-insert-line () + "Move forward a line, unless at EOB, then insert a newline." + (if (eobp) (insert "\n") + (forward-line))) + (defun verilog-repair-open-comma () "Insert comma if previous argument is other than an open parenthesis or endif." ;; We can't just search backward for ) as it might be inside another expression. @@ -9741,6 +9942,17 @@ This repairs those mis-inserted by an AUTOARG." "\\([])}:*+-]\\)") out) (setq out (replace-match "\\1\\2\\3" nil nil out))) + (while (string-match + (concat "\\([[({:*+-]\\)" ; - must be last + "\\$clog2\\s *(\\<\\([0-9]+\\))" + "\\([])}:*+-]\\)") + out) + (setq out (replace-match + (concat + (match-string 1 out) + (int-to-string (verilog-clog2 (string-to-number (match-string 2 out)))) + (match-string 3 out)) + nil nil out))) ;; For precedence do * before +/- (while (string-match (concat "\\([[({:*+-]\\)" @@ -9777,6 +9989,7 @@ This repairs those mis-inserted by an AUTOARG." post) nil nil out)) ))) out))) + ;;(verilog-simplify-range-expression "[1:3]") ;; 1 ;;(verilog-simplify-range-expression "[(1):3]") ;; 1 ;;(verilog-simplify-range-expression "[(((16)+1)+1+(1+1))]") ;;20 @@ -9785,6 +9998,14 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[(FOO*4+1-1)]") ;; FOO*4+0 ;;(verilog-simplify-range-expression "[(func(BAR))]") ;; func(BAR) ;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ;; FOO-0 +;;(verilog-simplify-range-expression "[$clog2(2)]") ;; 1 +;;(verilog-simplify-range-expression "[$clog2(7)]") ;; 3 + +(defun verilog-clog2 (value) + "Compute $clog2 - ceiling log2 of VALUE." + (if (< value 1) + 0 + (ceiling (/ (log value) (log 2))))) (defun verilog-typedef-name-p (variable-name) "Return true if the VARIABLE-NAME is a type definition." @@ -10348,6 +10569,86 @@ Avoid declaring ports manually, as it makes code harder to maintain." (insert "\n")) (indent-to verilog-indent-level-declaration)))) +(defun verilog-auto-assign-modport () + "Expand AUTOASSIGNMODPORT statements, as part of \\[verilog-auto]. +Take input/output/inout statements from the specified interface +and modport and use to build assignments into the modport, for +making verification modules that connect to UVM interfaces. + + The first parameter is the name of an interface. + + The second parameter is a regexp of modports to read from in + that interface. + + The third parameter is the instance name to use to dot reference into. + + The optional fourth parameter is a regular expression, and only + signals matching the regular expression will be included. + +Limitations: + + Interface names must be resolvable to filenames. See `verilog-auto-inst'. + + Inouts are not supported, as assignments must be unidirectional. + + If a signal is part of the interface header and in both a + modport and the interface itself, it will not be listed. (As + this would result in a syntax error when the connections are + made.) + +See the example in `verilog-auto-inout-modport'." + (save-excursion + (let* ((params (verilog-read-auto-params 3 4)) + (submod (nth 0 params)) + (modport-re (nth 1 params)) + (inst-name (nth 2 params)) + (regexp (nth 3 params)) + direction-re submodi) ;; direction argument not supported until requested + ;; Lookup position, etc of co-module + ;; Note this may raise an error + (when (setq submodi (verilog-modi-lookup submod t)) + (let* ((indent-pt (current-indentation)) + (modi (verilog-modi-current)) + (submoddecls (verilog-modi-get-decls submodi)) + (submodportdecls (verilog-modi-modport-lookup submodi modport-re)) + (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-inputs submodportdecls) + (verilog-decls-get-ports submoddecls)))) + (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-outputs submodportdecls) + (verilog-decls-get-ports submoddecls))))) + (forward-line 1) + (setq sig-list-i (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-i regexp) + "input" direction-re)) + sig-list-o (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-o regexp) + "output" direction-re))) + (setq sig-list-i (sort (copy-alist sig-list-i) `verilog-signals-sort-compare)) + (setq sig-list-o (sort (copy-alist sig-list-o) `verilog-signals-sort-compare)) + (when (or sig-list-i sig-list-o) + (verilog-insert-indent "// Beginning of automatic assignments from modport\n") + ;; Don't sort them so an upper AUTOINST will match the main module + (let ((sigs sig-list-o)) + (while sigs + (verilog-insert-indent "assign " (verilog-sig-name (car sigs)) + " = " inst-name + "." (verilog-sig-name (car sigs)) ";\n") + (setq sigs (cdr sigs)))) + (let ((sigs sig-list-i)) + (while sigs + (verilog-insert-indent "assign " inst-name + "." (verilog-sig-name (car sigs)) + " = " (verilog-sig-name (car sigs)) ";\n") + (setq sigs (cdr sigs)))) + (verilog-insert-indent "// End of automatics\n"))))))) + (defun verilog-auto-inst-port-map (port-st) nil) @@ -11067,8 +11368,8 @@ Typing \\[verilog-auto] will make this into: (verilog-subdecls-get-interfaced modsubdecls) (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls))))) - (forward-line 1) (when sig-list + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n") (verilog-insert-definition modi sig-list "reg" indent-pt nil) (verilog-insert-indent "// End of automatics\n"))))) @@ -11122,8 +11423,8 @@ Typing \\[verilog-auto] will make this into: (verilog-subdecls-get-inouts modsubdecls)) (append (verilog-decls-get-signals moddecls) (verilog-decls-get-assigns moddecls)))))) - (forward-line 1) (when sig-list + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n") (verilog-insert-definition modi sig-list "reg" indent-pt nil) (verilog-insert-indent "// End of automatics\n"))))) @@ -11210,8 +11511,8 @@ Typing \\[verilog-auto] will make this into: (append (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls)) (verilog-decls-get-signals moddecls))))) - (forward-line 1) (when sig-list + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n") (verilog-insert-definition modi sig-list "wire" indent-pt nil) (verilog-insert-indent "// End of automatics\n") @@ -11221,7 +11522,7 @@ Typing \\[verilog-auto] will make this into: ;; syntax-ppss which is broken when change hooks are disabled. )))) -(defun verilog-auto-output (&optional with-params) +(defun verilog-auto-output () "Expand AUTOOUTPUT statements, as part of \\[verilog-auto]. Make output statements for any output signal from an /*AUTOINST*/ that isn't an input to another AUTOINST. This is useful for modules which @@ -11273,8 +11574,8 @@ same expansion will result from only extracting outputs starting with ov: (save-excursion ;; Point must be at insertion point. (let* ((indent-pt (current-indentation)) - (regexp (and with-params - (nth 0 (verilog-read-auto-params 1)))) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11290,7 +11591,7 @@ same expansion will result from only extracting outputs starting with ov: sig-list regexp))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-output-ignore-regexp)) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic outputs (from unused autoinst outputs)\n") @@ -11340,7 +11641,7 @@ Typing \\[verilog-auto] will make this into: (verilog-signals-not-in (verilog-decls-get-signals moddecls) (verilog-decls-get-ports moddecls))))) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic outputs (every signal)\n") @@ -11348,7 +11649,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-indent "// End of automatics\n")) (when v2k (verilog-repair-close-comma))))) -(defun verilog-auto-input (&optional with-params) +(defun verilog-auto-input () "Expand AUTOINPUT statements, as part of \\[verilog-auto]. Make input statements for any input signal into an /*AUTOINST*/ that isn't declared elsewhere inside the module. This is useful for modules which @@ -11399,8 +11700,8 @@ same expansion will result from only extracting inputs starting with i: /*AUTOINPUT(\"^i\")*/" (save-excursion (let* ((indent-pt (current-indentation)) - (regexp (and with-params - (nth 0 (verilog-read-auto-params 1)))) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11420,7 +11721,7 @@ same expansion will result from only extracting inputs starting with i: sig-list regexp))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-input-ignore-regexp)) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic inputs (from unused autoinst inputs)\n") @@ -11428,7 +11729,7 @@ same expansion will result from only extracting inputs starting with i: (verilog-insert-indent "// End of automatics\n")) (when v2k (verilog-repair-close-comma))))) -(defun verilog-auto-inout (&optional with-params) +(defun verilog-auto-inout () "Expand AUTOINOUT statements, as part of \\[verilog-auto]. Make inout statements for any inout signal in an /*AUTOINST*/ that isn't declared elsewhere inside the module. @@ -11479,8 +11780,8 @@ same expansion will result from only extracting inouts starting with i: (save-excursion ;; Point must be at insertion point. (let* ((indent-pt (current-indentation)) - (regexp (and with-params - (nth 0 (verilog-read-auto-params 1)))) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11497,7 +11798,7 @@ same expansion will result from only extracting inouts starting with i: sig-list regexp))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-inout-ignore-regexp)) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n") @@ -11739,6 +12040,225 @@ same expansion will result from only extracting signals starting with i: /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/" (verilog-auto-inout-module nil t)) +(defun verilog-auto-inout-param () + "Expand AUTOINOUTPARAM statements, as part of \\[verilog-auto]. +Take input/output/inout statements from the specified module and insert +into the current module. This is useful for making null templates and +shell modules which need to have identical I/O with another module. +Any I/O which are already defined in this module will not be redefined. +For the complement of this function, see `verilog-auto-inout-comp', +and to make monitors with all inputs, see `verilog-auto-inout-in'. + +Limitations: + If placed inside the parenthesis of a module declaration, it creates + Verilog 2001 style, else uses Verilog 1995 style. + + Concatenation and outputting partial buses is not supported. + + Module names must be resolvable to filenames. See `verilog-auto-inst'. + + Signals are not inserted in the same order as in the original module, + though they will appear to be in the same order to an AUTOINST + instantiating either module. + + Signals declared as \"output reg\" or \"output wire\" etc will + lose the wire/reg declaration so that shell modules may + generate those outputs differently. However, \"output logic\" + is propagated. + +An example: + + module ExampShell (/*AUTOARG*/); + /*AUTOINOUTMODULE(\"ExampMain\")*/ + endmodule + + module ExampMain (i,o,io); + input i; + output o; + inout io; + endmodule + +Typing \\[verilog-auto] will make this into: + + module ExampShell (/*AUTOARG*/i,o,io); + /*AUTOINOUTMODULE(\"ExampMain\")*/ + // Beginning of automatic in/out/inouts (from specific module) + output o; + inout io; + input i; + // End of automatics + endmodule + +You may also provide an optional regular expression, in which case only +signals matching the regular expression will be included. For example the +same expansion will result from only extracting signals starting with i: + + /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/ + +You may also provide an optional second regular expression, in +which case only signals which have that pin direction and data +type will be included. This matches against everything before +the signal name in the declaration, for example against +\"input\" (single bit), \"output logic\" (direction and type) or +\"output [1:0]\" (direction and implicit type). You also +probably want to skip spaces in your regexp. + +For example, the below will result in matching the output \"o\" +against the previous example's module: + + /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/ + +You may also provide an optional third regular expression, in +which case any parameter names that match the given regexp will +be included. Including parameters is off by default. To include +all signals and parameters, use: + + /*AUTOINOUTMODULE(\"ExampMain\",\".*\",\".*\",\".*\")*/" + (save-excursion + (let* ((params (verilog-read-auto-params 1 2)) + (submod (nth 0 params)) + (regexp (nth 1 params)) + submodi) + ;; Lookup position, etc of co-module + ;; Note this may raise an error + (when (setq submodi (verilog-modi-lookup submod t)) + (let* ((indent-pt (current-indentation)) + (v2k (verilog-in-paren-quick)) + (modi (verilog-modi-current)) + (moddecls (verilog-modi-get-decls modi)) + (submoddecls (verilog-modi-get-decls submodi)) + (sig-list-p (verilog-signals-not-in + (verilog-decls-get-gparams submoddecls) + (append (verilog-decls-get-gparams moddecls))))) + (forward-line 1) + (setq sig-list-p (verilog-signals-matching-regexp sig-list-p regexp)) + (when v2k (verilog-repair-open-comma)) + (when sig-list-p + (verilog-insert-indent "// Beginning of automatic parameters (from specific module)\n") + ;; Don't sort them so an upper AUTOINST will match the main module + (verilog-insert-definition modi sig-list-p "parameter" indent-pt v2k t) + (verilog-insert-indent "// End of automatics\n")) + (when v2k (verilog-repair-close-comma))))))) + +(defun verilog-auto-inout-modport () + "Expand AUTOINOUTMODPORT statements, as part of \\[verilog-auto]. +Take input/output/inout statements from the specified interface +and modport and insert into the current module. This is useful +for making verification modules that connect to UVM interfaces. + + The first parameter is the name of an interface. + + The second parameter is a regexp of modports to read from in + that interface. + + The optional third parameter is a regular expression, and only + signals matching the regular expression will be included. + +Limitations: + If placed inside the parenthesis of a module declaration, it creates + Verilog 2001 style, else uses Verilog 1995 style. + + Interface names must be resolvable to filenames. See `verilog-auto-inst'. + +As with other autos, any inputs/outputs declared in the module +will suppress the AUTO from redeclarating an inputs/outputs by +the same name. + +An example: + + interface ExampIf + ( input logic clk ); + logic req_val; + logic [7:0] req_dat; + clocking mon_clkblk @(posedge clk); + input req_val; + input req_dat; + endclocking + modport mp(clocking mon_clkblk); + endinterface + + module ExampMain + ( input clk, + /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/ + // Beginning of automatic in/out/inouts (from modport) + input [7:0] req_dat, + input req_val + // End of automatics + ); + /*AUTOASSIGNMODPORT(\"ExampIf\" \"mp\")*/ + endmodule + +Typing \\[verilog-auto] will make this into: + + ... + module ExampMain + ( input clk, + /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/ + // Beginning of automatic in/out/inouts (from modport) + input req_dat, + input req_val + // End of automatics + ); + +If the modport is part of a UVM monitor/driver class, this +creates a wrapper module that may be used to instantiate the +driver/monitor using AUTOINST in the testbench." + (save-excursion + (let* ((params (verilog-read-auto-params 2 3)) + (submod (nth 0 params)) + (modport-re (nth 1 params)) + (regexp (nth 2 params)) + direction-re submodi) ;; direction argument not supported until requested + ;; Lookup position, etc of co-module + ;; Note this may raise an error + (when (setq submodi (verilog-modi-lookup submod t)) + (let* ((indent-pt (current-indentation)) + (v2k (verilog-in-paren-quick)) + (modi (verilog-modi-current)) + (moddecls (verilog-modi-get-decls modi)) + (submoddecls (verilog-modi-get-decls submodi)) + (submodportdecls (verilog-modi-modport-lookup submodi modport-re)) + (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-inputs submodportdecls) + (append (verilog-decls-get-ports submoddecls) + (verilog-decls-get-ports moddecls))))) + (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-outputs submodportdecls) + (append (verilog-decls-get-ports submoddecls) + (verilog-decls-get-ports moddecls))))) + (sig-list-io (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-inouts submodportdecls) + (append (verilog-decls-get-ports submoddecls) + (verilog-decls-get-ports moddecls)))))) + (forward-line 1) + (setq sig-list-i (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-i regexp) + "input" direction-re)) + sig-list-o (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-o regexp) + "output" direction-re)) + sig-list-io (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-io regexp) + "inout" direction-re))) + (when v2k (verilog-repair-open-comma)) + (when (or sig-list-i sig-list-o sig-list-io) + (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n") + ;; Don't sort them so an upper AUTOINST will match the main module + (verilog-insert-definition modi sig-list-o "output" indent-pt v2k t) + (verilog-insert-definition modi sig-list-io "inout" indent-pt v2k t) + (verilog-insert-definition modi sig-list-i "input" indent-pt v2k t) + (verilog-insert-indent "// End of automatics\n")) + (when v2k (verilog-repair-close-comma))))))) + (defun verilog-auto-insert-lisp () "Expand AUTOINSERTLISP statements, as part of \\[verilog-auto]. The Lisp code provided is called, and the Lisp code calls @@ -11789,7 +12309,7 @@ text: (backward-sexp 1) ;; Inside comment (point))) ;; Beginning paren (cmd (buffer-substring-no-properties cmd-beg-pt cmd-end-pt))) - (forward-line 1) + (verilog-forward-or-insert-line) ;; Some commands don't move point (like insert-file) so we always ;; add the begin/end comments, then delete it if not needed (verilog-insert-indent "// Beginning of automatic insert lisp\n") @@ -12042,6 +12562,7 @@ value's width is generated. An example of making a stub for another module: module ExampStub (/*AUTOINST*/); + /*AUTOINOUTPARAM(\"Foo\")*/ /*AUTOINOUTMODULE(\"Foo\")*/ /*AUTOTIEOFF*/ // verilator lint_off UNUSED @@ -12054,6 +12575,7 @@ An example of making a stub for another module: Typing \\[verilog-auto] will make this into: module ExampStub (/*AUTOINST*/...); + /*AUTOINOUTPARAM(\"Foo\")*/ /*AUTOINOUTMODULE(\"Foo\")*/ // Beginning of autotieoff output [2:0] foo; @@ -12084,7 +12606,7 @@ Typing \\[verilog-auto] will make this into: (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-tieoff-ignore-regexp)) (when sig-list - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)) (verilog-modi-cache-add-vars modi sig-list) ; Before we trash list @@ -12161,7 +12683,7 @@ defines the regular expression will be undefed." ;; Insert (setq defs (sort defs 'string<)) (when defs - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic undefs\n") (while defs (verilog-insert-indent "`undef " (car defs) "\n") @@ -12198,6 +12720,7 @@ You can add signals you do not want included in AUTOUNUSED with An example of making a stub for another module: module ExampStub (/*AUTOINST*/); + /*AUTOINOUTPARAM(\"Examp\")*/ /*AUTOINOUTMODULE(\"Examp\")*/ /*AUTOTIEOFF*/ // verilator lint_off UNUSED @@ -12236,7 +12759,7 @@ Typing \\[verilog-auto] will make this into: (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-unused-ignore-regexp)) (when sig-list - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic unused inputs\n") (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)) (while sig-list @@ -12335,10 +12858,7 @@ Typing \\[verilog-auto] will make this into: ;; (sig-list-consts (append (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls))) - (sig-list-all (append (verilog-decls-get-vars moddecls) - (verilog-decls-get-outputs moddecls) - (verilog-decls-get-inouts moddecls) - (verilog-decls-get-inputs moddecls))) + (sig-list-all (verilog-decls-get-iovars moddecls)) ;; (undecode-sig (or (assoc undecode-name sig-list-all) (error "%s: Signal %s not found in design" (verilog-point-text) undecode-name))) @@ -12371,7 +12891,7 @@ Typing \\[verilog-auto] will make this into: elim-regexp))) tmp-sigs (cdr tmp-sigs)))) ;; - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic ASCII enum decoding\n") (let ((decode-sig-list (list (list ascii-name (format "[%d:0]" (- (* ascii-chars 8) 1)) (concat "Decode of " undecode-name) nil nil)))) @@ -12506,9 +13026,12 @@ Or check if AUTOs have the same expansion Using \\[describe-function], see also: `verilog-auto-arg' for AUTOARG module instantiations `verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding + `verilog-auto-assign-modport' for AUTOASSIGNMODPORT assignment to/from modport `verilog-auto-inout-comp' for AUTOINOUTCOMP copy complemented i/o `verilog-auto-inout-in' for AUTOINOUTIN inputs for all i/o + `verilog-auto-inout-modport' for AUTOINOUTMODPORT i/o from an interface modport `verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere + `verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere `verilog-auto-inout' for AUTOINOUT making hierarchy inouts `verilog-auto-input' for AUTOINPUT making hierarchy inputs `verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function @@ -12598,27 +13121,24 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) ;; Must be done before autoin/out as creates a reg - (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum) + (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) ;; ;; first in/outs from other files - (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module) - (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp) - (verilog-auto-re-search-do "/\\*AUTOINOUTIN([^)]*)\\*/" 'verilog-auto-inout-in) + (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport) + (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module) + (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp) + (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in) + (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param) ;; next in/outs which need previous sucked inputs first - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/" - (lambda () (verilog-auto-output t))) - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\*/" 'verilog-auto-output) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\((\"[^\"]*\")\\)\\*/" - (lambda () (verilog-auto-input t))) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\*/" 'verilog-auto-input) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\((\"[^\"]*\")\\)\\*/" - (lambda () (verilog-auto-inout t))) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout) + (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output) + (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input) + (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout) ;; Then tie off those in/outs (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) ;; These can be anywhere after AUTOINSERTLISP - (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((\"[^\"]*\")\\)?\\*/" 'verilog-auto-undef) + (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef) ;; Wires/regs must be after inputs/outputs + (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport) (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic) (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) @@ -12696,7 +13216,7 @@ Wilson Snyder (wsnyder@wsnyder.org)." ;; ;; Place the templates into Verilog Mode. They may be inserted under any key. ;; C-c C-t will be the default. If you use templates a lot, you -;; may want to consider moving the binding to another key in your .emacs +;; may want to consider moving the binding to another key in your init ;; file. ;; ;; Note \C-c and letter are reserved for users diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 0ca3439dd60..52757b9eede 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -12522,6 +12522,7 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." (defun vhdl-line-expand (&optional prefix-arg) "Hippie-expand current line." (interactive "P") + (require 'hippie-exp) (let ((case-fold-search t) (case-replace nil) (hippie-expand-try-functions-list '(try-expand-line try-expand-line-all-buffers))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 02340425dfa..4819149bdf6 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -234,9 +234,7 @@ It creates the Imenu index for the buffer, if necessary." (error "Error in which-func-update: %S" info)))))) ;;;###autoload -(defun which-func-mode (&optional arg) - (which-function-mode arg)) -(make-obsolete 'which-func-mode 'which-function-mode "24.1") +(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1") (defvar which-func-update-timer nil) diff --git a/lisp/replace.el b/lisp/replace.el index f192574a7e2..82edb0037fb 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -378,35 +378,33 @@ regexp in `search-whitespace-regexp'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches that are surrounded by word boundaries. Fourth and fifth arg START and END specify the region to operate on." + (declare (obsolete "use the `\\,' feature of `query-replace-regexp' +for interactive calls, and `search-forward-regexp'/`replace-match' +for Lisp calls." "22.1")) (interactive (progn - (barf-if-buffer-read-only) - (let* ((from - ;; Let-bind the history var to disable the "foo -> bar" default. - ;; Maybe we shouldn't disable this default, but for now I'll - ;; leave it off. --Stef - (let ((query-replace-to-history-variable nil)) - (query-replace-read-from "Query replace regexp" t))) - (to (list (read-from-minibuffer - (format "Query replace regexp %s with eval: " - (query-replace-descr from)) - nil nil t query-replace-to-history-variable from t)))) - ;; We make TO a list because replace-match-string-symbols requires one, - ;; and the user might enter a single token. - (replace-match-string-symbols to) - (list from (car to) current-prefix-arg - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)))))) + (barf-if-buffer-read-only) + (let* ((from + ;; Let-bind the history var to disable the "foo -> bar" + ;; default. Maybe we shouldn't disable this default, but + ;; for now I'll leave it off. --Stef + (let ((query-replace-to-history-variable nil)) + (query-replace-read-from "Query replace regexp" t))) + (to (list (read-from-minibuffer + (format "Query replace regexp %s with eval: " + (query-replace-descr from)) + nil nil t query-replace-to-history-variable from t)))) + ;; We make TO a list because replace-match-string-symbols requires one, + ;; and the user might enter a single token. + (replace-match-string-symbols to) + (list from (car to) current-prefix-arg + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end)))))) (perform-replace regexp (cons 'replace-eval-replacement to-expr) t 'literal delimited nil nil start end)) -(make-obsolete 'query-replace-regexp-eval - "for interactive use, use the special `\\,' feature of -`query-replace-regexp' instead. Non-interactively, a loop -using `search-forward-regexp' and `replace-match' is preferred." "22.1") - (defun map-query-replace-regexp (regexp to-strings &optional n start end) "Replace some matches for REGEXP with various strings, in rotation. The second argument TO-STRINGS contains the replacement strings, separated diff --git a/lisp/savehist.el b/lisp/savehist.el index 215314d7053..cca958ff0a1 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -209,6 +209,7 @@ histories, which is probably undesirable." If `savehist-file' is in the old format that doesn't record the value of `savehist-minibuffer-history-variables', that value is deducted from the contents of the file." + (declare (obsolete savehist-mode "22.1")) (savehist-mode 1) ;; Old versions of savehist distributed with XEmacs didn't save ;; savehist-minibuffer-history-variables. If that variable is nil @@ -225,7 +226,6 @@ value is deducted from the contents of the file." ;; Collect VAR, i.e. (nth form 1). (push (nth 1 form) vars)) vars))))) -(make-obsolete 'savehist-load 'savehist-mode "22.1") (defun savehist-install () "Hook savehist into Emacs. diff --git a/lisp/server.el b/lisp/server.el index 4fd55bcf6d1..73c253a87a6 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -101,7 +101,12 @@ (defcustom server-host nil "The name or IP address to use as host address of the server process. -If set, the server accepts remote connections; otherwise it is local." +If set, the server accepts remote connections; otherwise it is local. + +DO NOT give this a non-nil value unless you know what you are +doing! On unsecured networks, accepting remote connections is +very dangerous, because server-client communication (including +session authentication) is not encrypted." :group 'server :type '(choice (string :tag "Name or IP address") @@ -140,12 +145,12 @@ directory residing in a NTFS partition instead." (defcustom server-auth-key nil "Server authentication key. +This is only used if `server-use-tcp' is non-nil. Normally, the authentication key is randomly generated when the -server starts, which guarantees some level of security. It is -recommended to leave it that way. Using a long-lived shared key -will decrease security (especially since the key is transmitted as -plain text). +server starts. It is recommended to leave it that way. Using a +long-lived shared key will decrease security (especially since +the key is transmitted as plain-text). In some situations however, it can be difficult to share randomly generated passwords with remote hosts (eg. no shared directory), @@ -153,11 +158,13 @@ so you can set the key with this variable and then copy the server file to the remote host (with possible changes to IP address and/or port if that applies). -The key must consist of 64 ASCII printable characters except for -space (this means characters from ! to ~; or from code 33 to 126). +Note that the usual security risks of using the server over +remote TCP, arising from the fact that client-server +communications are unencrypted, still apply. -You can use \\[server-generate-key] to get a random authentication -key." +The key must consist of 64 ASCII printable characters except for +space (this means characters from ! to ~; or from code 33 to +126). You can use \\[server-generate-key] to get a random key." :group 'server :type '(choice (const :tag "Random" nil) diff --git a/lisp/simple.el b/lisp/simple.el index e1b8f37e46c..616a4d7b1ea 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -606,7 +606,7 @@ buffer if the variable `delete-trailing-lines' is non-nil." (when (and (not end) delete-trailing-lines ;; Really the end of buffer. - (save-restriction (widen) (eobp)) + (= (point-max) (1+ (buffer-size))) (<= (skip-chars-backward "\n") -2)) (delete-region (1+ (point)) end-marker)) (set-marker end-marker nil)))) @@ -6380,9 +6380,8 @@ With prefix argument N, move N items (negative N means move backward)." (point)))) (defun choose-completion-delete-max-match (string) + (declare (obsolete choose-completion-guess-base-position "23.2")) (delete-region (choose-completion-guess-base-position string) (point))) -(make-obsolete 'choose-completion-delete-max-match - 'choose-completion-guess-base-position "23.2") (defvar choose-completion-string-functions nil "Functions that may override the normal insertion of a completion choice. diff --git a/lisp/startup.el b/lisp/startup.el index 243c9621752..6658e16683b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -43,7 +43,10 @@ If the value is nil and `inhibit-startup-screen' is nil, show the startup screen. If the value is a string, visit the specified file or directory using `find-file'. If t, open the `*scratch*' -buffer." +buffer. + +A string value also causes emacsclient to open the specified file +or directory when no target file is specified." :type '(choice (const :tag "Startup screen" nil) (directory :tag "Directory" :value "~/") diff --git a/lisp/subr.el b/lisp/subr.el index b9b8e627672..8dfe78d8c75 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -271,9 +271,14 @@ the return value (nil if RESULT is omitted). ,@(cdr (cdr spec)))))) (defmacro declare (&rest _specs) - "Do not evaluate any arguments and return nil. -Treated as a declaration when used at the right place in a -`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" + "Do not evaluate any arguments, and return nil. +If a `declare' form appears as the first form in the body of a +`defun' or `defmacro' form, SPECS specifies various additional +information about the function or macro; these go into effect +during the evaluation of the `defun' or `defmacro' form. + +The possible values of SPECS are specified by +`defun-declarations-alist' and `macro-declarations-alist'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) )) @@ -461,18 +466,18 @@ If TEST is omitted or nil, `equal' is used." (setq tail (cdr tail))) value)) -(make-obsolete 'assoc-ignore-case 'assoc-string "22.1") (defun assoc-ignore-case (key alist) "Like `assoc', but ignores differences in case and text representation. KEY must be a string. Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison." + (declare (obsolete assoc-string "22.1")) (assoc-string key alist t)) -(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1") (defun assoc-ignore-representation (key alist) "Like `assoc', but ignores differences in text representation. KEY must be a string. Unibyte strings are converted to multibyte for comparison." + (declare (obsolete assoc-string "22.1")) (assoc-string key alist nil)) (defun member-ignore-case (elt list) @@ -1179,12 +1184,13 @@ be a list of the form returned by `event-start' and `event-end'." "Mocklisp-compatibility insert function. Like the function `insert' except that any argument that is a number is converted into a string by expressing it in decimal." + (declare (obsolete insert "22.1")) (dolist (el args) (insert (if (integerp el) (number-to-string el) el)))) -(make-obsolete 'insert-string 'insert "22.1") -(defun makehash (&optional test) (make-hash-table :test (or test 'eql))) -(make-obsolete 'makehash 'make-hash-table "22.1") +(defun makehash (&optional test) + (declare (obsolete make-hash-table "22.1")) + (make-hash-table :test (or test 'eql))) ;; These are used by VM and some old programs (defalias 'focus-frame 'ignore "") @@ -1250,11 +1256,6 @@ is converted into a string by expressing it in decimal." (make-obsolete 'process-filter-multibyte-p nil "23.1") (make-obsolete 'set-process-filter-multibyte nil "23.1") -(make-obsolete-variable - 'mode-line-inverse-video - "use the appropriate faces instead." - "21.1") - ;; Lisp manual only updated in 22.1. (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro "before 19.34") @@ -1911,8 +1912,8 @@ This function is called directly from the C code." "Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name." + (declare (obsolete eval-after-load "23.2")) (eval-after-load file (read))) -(make-obsolete 'eval-next-after-load `eval-after-load "23.2") (defun display-delayed-warnings () "Display delayed warnings from `delayed-warnings-list'. diff --git a/lisp/term.el b/lisp/term.el index d5f35006357..7567bd38f5a 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -994,7 +994,10 @@ is buffer-local." (setq term-ansi-current-reverse nil) (setq term-ansi-current-color 0) (setq term-ansi-current-invisible nil) - (setq term-ansi-face-already-done t) + ;; Stefan thought this should be t, but could not remember why. + ;; Setting it to t seems to cause bug#11785. Setting it to nil + ;; again to see if there are other consequences... + (setq term-ansi-face-already-done nil) (setq term-ansi-current-bg-color 0)) (define-derived-mode term-mode fundamental-mode "Term" @@ -4048,6 +4051,7 @@ Returns `partial' if completed as far as possible with the completion matches. Returns `listed' if a completion listing was shown. See also `term-dynamic-complete-filename'." + (declare (obsolete completion-in-region "23.2")) (let* ((completion-ignore-case nil) (candidates (mapcar (function (lambda (x) (list x))) candidates)) (completions (all-completions stub candidates))) @@ -4081,8 +4085,6 @@ See also `term-dynamic-complete-filename'." (t (message "Partially completed") 'partial))))))) -(make-obsolete 'term-dynamic-simple-complete 'completion-in-region "23.2") - (defun term-dynamic-list-filename-completions () "List in help buffer possible completions of the filename at point." diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 31656918fad..e0d93b68056 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1002,6 +1002,7 @@ See `bibtex-generate-autokey' for details." ("\\\\`\\|\\\\'\\|\\\\\\^\\|\\\\~\\|\\\\=\\|\\\\\\.\\|\\\\u\\|\\\\v\\|\\\\H\\|\\\\t\\|\\\\c\\|\\\\d\\|\\\\b" . "") ;; braces, quotes, concatenation. ("[`'\"{}#]" . "") + ("\\\\-" . "") ; \- -> ;; spaces ("\\\\?[ \t\n]+\\|~" . " ")) "Alist of (OLD-REGEXP . NEW-STRING) pairs. @@ -4893,21 +4894,22 @@ If mark is active reformat entries in region, if not in whole buffer." (if use-previous-options bibtex-reformat-previous-options (setq bibtex-reformat-previous-options - (mapcar (lambda (option) - (if (y-or-n-p (car option)) (cdr option))) - `(("Realign entries (recommended)? " . 'realign) - ("Remove empty optional and alternative fields? " . 'opts-or-alts) - ("Remove delimiters around pure numerical fields? " . 'numerical-fields) - (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ") . 'last-comma) - ("Replace double page dashes by single ones? " . 'page-dashes) - ("Delete whitespace at the beginning and end of fields? " . 'whitespace) - ("Inherit booktitle? " . 'inherit-booktitle) - ("Force delimiters? " . 'delimiters) - ("Unify case of entry types and field names? " . 'unify-case) - ("Enclose parts of field entries by braces? " . 'braces) - ("Replace parts of field entries by string constants? " . 'strings) - ("Sort fields? " . 'sort-fields)))))) + (delq nil + (mapcar (lambda (option) + (if (y-or-n-p (car option)) (cdr option))) + `(("Realign entries (recommended)? " . realign) + ("Remove empty optional and alternative fields? " . opts-or-alts) + ("Remove delimiters around pure numerical fields? " . numerical-fields) + (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") + " comma at end of entry? ") . last-comma) + ("Replace double page dashes by single ones? " . page-dashes) + ("Delete whitespace at the beginning and end of fields? " . whitespace) + ("Inherit booktitle? " . inherit-booktitle) + ("Force delimiters? " . delimiters) + ("Unify case of entry types and field names? " . unify-case) + ("Enclose parts of field entries by braces? " . braces) + ("Replace parts of field entries by string constants? " . strings) + ("Sort fields? " . sort-fields))))))) ;; Do not include required-fields because `bibtex-reformat' ;; cannot handle the error messages of `bibtex-format-entry'. ;; Use `bibtex-validate' to check for required fields. diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 31001c78e54..229d12b2906 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -542,10 +542,7 @@ (t "")))) (setq authors (reftex-truncate authors 30 t t)) (when (reftex-use-fonts) - (put-text-property 0 (length key) 'face - (reftex-verified-face reftex-label-face - 'font-lock-constant-face - 'font-lock-reference-face) + (put-text-property 0 (length key) 'face reftex-label-face key) (put-text-property 0 (length authors) 'face reftex-bib-author-face authors) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 2d395fe3df2..1d15dfbed7e 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -585,9 +585,7 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help (if (memq reftex-highlight-selection '(mouse both)) reftex-mouse-selected-face nil)) - (index-face (reftex-verified-face reftex-label-face - 'font-lock-constant-face - 'font-lock-reference-face)) + (index-face reftex-label-face) sublist cell from to first-char) ;; Make the sublist and sort it diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index 627dfba0071..1a400436311 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -245,12 +245,8 @@ During a selection process, these are the local bindings. (if (memq reftex-highlight-selection '(mouse both)) reftex-mouse-selected-face nil)) - (label-face (reftex-verified-face reftex-label-face - 'font-lock-constant-face - 'font-lock-reference-face)) - (index-face (reftex-verified-face reftex-index-face - 'font-lock-constant-face - 'font-lock-reference-face)) + (label-face reftex-label-face) + (index-face reftex-index-face) all cell text label typekey note comment master-dir-re prev-inserted offset from to index-tag docstruct-symbol) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 8584c496a97..8318dc0d5f3 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -2311,9 +2311,7 @@ IGNORE-WORDS List of words which should be removed from the string." ;; Return the first valid face in FACES, or nil if none is valid. ;; Also, when finding a nil element in FACES, return nil. This ;; function is just a safety net to catch name changes of builtin - ;; fonts. Currently it is only used for reftex-label-face, which has - ;; as default font-lock-reference-face, which was recently renamed - ;; to font-lock-constant-face. + ;; fonts. Currently it is only used for reftex-label-face. (let (face) (catch 'exit (while (setq face (pop faces)) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index eeafe586c27..869da63064a 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -118,7 +118,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' -(when (boundp 'testcover-1value-functions) +(when (and (boundp 'testcover-1value-functions) + (boundp 'testcover-compose-functions)) ;; Below `lambda' is used in a loop with varying parameters and is thus not ;; 1valued. (setq testcover-1value-functions @@ -217,7 +218,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use CVSHeader to really get information from CVS and not other version ;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.1 2012-09-22 09:06:56 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.2 2012-09-23 14:44:25 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -246,7 +247,7 @@ SVN revision is the upstream (docutils) revision.") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "$Revision: 1.327.2.1 $") + "$Revision: 1.327.2.2 $") "CVS revision of this file in the official version.") (defconst rst-version diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 67d7f8c01f9..46c65b25b37 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -34,7 +34,6 @@ (eval-when-compile (require 'skeleton) - (require 'outline) (require 'cl-lib)) (defgroup sgml nil @@ -1938,6 +1937,10 @@ This takes effect when first loading the library.") ("wbr" . "Enable <br> within <nobr>")) "Value of `sgml-tag-help' for HTML mode.") +(defvar outline-regexp) +(defvar outline-heading-end-regexp) +(defvar outline-level) + ;;;###autoload (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 620a1da633e..a324daa9283 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -860,10 +860,6 @@ START is the position of the \\ and DELIM is the delimiter char." (set-keymap-parent map text-mode-map) (tex-define-common-keys map) (define-key map "\"" 'tex-insert-quote) - (define-key map "(" 'skeleton-pair-insert-maybe) - (define-key map "{" 'skeleton-pair-insert-maybe) - (define-key map "[" 'skeleton-pair-insert-maybe) - (define-key map "$" 'skeleton-pair-insert-maybe) (define-key map "\n" 'tex-terminate-paragraph) (define-key map "\M-\r" 'latex-insert-item) (define-key map "\C-c}" 'up-list) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 30e5390a3e1..301f69f45be 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -80,18 +80,29 @@ Turning on Paragraph-Indent Text mode runs the normal hooks :abbrev-table nil :syntax-table nil (paragraph-indent-minor-mode)) -(defun paragraph-indent-minor-mode () +(define-minor-mode paragraph-indent-minor-mode "Minor mode for editing text, with leading spaces starting a paragraph. In this mode, you do not need blank lines between paragraphs when the first line of the following paragraph starts with whitespace, as with `paragraph-indent-text-mode'. Turning on Paragraph-Indent minor mode runs the normal hook `paragraph-indent-text-mode-hook'." - (interactive) - (set (make-local-variable 'paragraph-start) - (concat "[ \t\n\f]\\|" paragraph-start)) - (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) - (run-hooks 'paragraph-indent-text-mode-hook)) + :initial-value nil + ;; Change the definition of a paragraph start. + (let ((ps-re "[ \t\n\f]\\|")) + (if (eq t (compare-strings ps-re nil nil + paragraph-start nil (length ps-re))) + (if (not paragraph-indent-minor-mode) + (set (make-local-variable 'paragraph-start) + (substring paragraph-start (length ps-re)))) + (if paragraph-indent-minor-mode + (set (make-local-variable 'paragraph-start) + (concat ps-re paragraph-start))))) + ;; Change the indentation function. + (if paragraph-indent-minor-mode + (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) + (if (eq indent-line-function 'indent-to-left-margin) + (set (make-local-variable 'indent-line-function) 'indent-region)))) (defalias 'indented-text-mode 'text-mode) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 64879e5cfd5..6f76068ea9d 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -765,14 +765,13 @@ Run the Viper tutorial? ")) (funcall 'viper-tutorial 0)) (message "Tutorial aborted by user")) (message prompt1))) - (let* ((lang (if arg - (let ((minibuffer-setup-hook minibuffer-setup-hook)) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help) - (read-language-name 'tutorial "Language: " "English")) - (if (get-language-info current-language-environment 'tutorial) - current-language-environment - "English"))) + (let* ((lang (cond + (arg + (minibuffer-with-setup-hook #'minibuffer-completion-help + (read-language-name 'tutorial "Language: " "English"))) + ((get-language-info current-language-environment 'tutorial) + current-language-environment) + (t "English"))) (filename (get-language-info lang 'tutorial)) (tut-buf-name filename) (old-tut-buf (get-buffer tut-buf-name)) diff --git a/lisp/type-break.el b/lisp/type-break.el index 8a95508d939..949b3b720a0 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1,4 +1,4 @@ -;;; type-break.el --- encourage rests from typing at appropriate intervals +;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*- ;; Copyright (C) 1994-1995, 1997, 2000-2012 Free Software Foundation, Inc. @@ -69,26 +69,11 @@ :prefix "type-break" :group 'keyboard) -;;;###autoload -(defcustom type-break-mode nil - "Toggle typing break mode. -See the docstring for the `type-break-mode' command for more information. -Setting this variable directly does not take effect; -use either \\[customize] or the function `type-break-mode'." - :set (lambda (_symbol value) - (type-break-mode (if value 1 -1))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'type-break - :require 'type-break) - -;;;###autoload (defcustom type-break-interval (* 60 60) "Number of seconds between scheduled typing breaks." :type 'integer :group 'type-break) -;;;###autoload (defcustom type-break-good-rest-interval (/ type-break-interval 6) "Number of seconds of idle time considered to be an adequate typing rest. @@ -98,10 +83,10 @@ rest from typing, then the next typing break is simply rescheduled for later. If a break is interrupted before this much time elapses, the user will be asked whether or not really to interrupt the break." + :set-after '(type-break-interval) :type 'integer :group 'type-break) -;;;###autoload (defcustom type-break-good-break-interval nil "Number of seconds considered to be an adequate explicit typing rest. @@ -112,7 +97,6 @@ break interruptions when `type-break-good-rest-interval' is nil." :type 'integer :group 'type-break) -;;;###autoload (defcustom type-break-keystroke-threshold ;; Assuming typing speed is 35wpm (on the average, do you really ;; type more than that in a minute? I spend a lot of time reading mail @@ -147,6 +131,7 @@ keystroke even though they really require multiple keys to generate them. The command `type-break-guesstimate-keystroke-threshold' can be used to guess a reasonably good pair of values for this variable." + :set-after '(type-break-interval) :type 'sexp :group 'type-break) @@ -288,7 +273,7 @@ It will be either \"seconds\" or \"keystrokes\".") ;;;###autoload -(defun type-break-mode (&optional prefix) +(define-minor-mode type-break-mode "Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. @@ -361,74 +346,61 @@ Finally, a file (named `type-break-file-name') is used to store information across Emacs sessions. This provides recovery of the break status between sessions and after a crash. Manual changes to the file may result in problems." - (interactive "P") - (type-break-check-post-command-hook) + :lighter type-break-mode-line-format + :global t - (let ((already-enabled type-break-mode)) - (setq type-break-mode (>= (prefix-numeric-value prefix) 0)) + (type-break-check-post-command-hook) - (cond - ((and already-enabled type-break-mode) - (and (called-interactively-p 'interactive) - (message "Type Break mode is already enabled"))) - (type-break-mode - (when type-break-file-name - (with-current-buffer (find-file-noselect type-break-file-name 'nowarn) - (setq buffer-save-without-query t))) - - (or global-mode-string - (setq global-mode-string '(""))) - (or (assq 'type-break-mode-line-message-mode - minor-mode-alist) - (setq minor-mode-alist - (cons type-break-mode-line-format - minor-mode-alist))) - (type-break-keystroke-reset) - (type-break-mode-line-countdown-or-break nil) - - (setq type-break-time-last-break - (or (type-break-get-previous-time) - (current-time))) - - ;; schedule according to break time from session file - (type-break-schedule - (let (diff) - (if (and type-break-time-last-break - (< (setq diff (type-break-time-difference - type-break-time-last-break - (current-time))) - type-break-interval)) - ;; use the file's value - (progn - (setq type-break-keystroke-count - (type-break-get-previous-count)) - ;; file the time, in case it was read from the auto-save file - (type-break-file-time type-break-interval-start) - (setq type-break-interval-start type-break-time-last-break) - (- type-break-interval diff)) - ;; schedule from now - (setq type-break-interval-start (current-time)) - (type-break-file-time type-break-interval-start) - type-break-interval)) - type-break-interval-start - type-break-interval) - - (and (called-interactively-p 'interactive) - (message "Type Break mode is enabled and set"))) - (t - (type-break-keystroke-reset) - (type-break-mode-line-countdown-or-break nil) - (type-break-cancel-schedule) - (do-auto-save) - (when type-break-file-name - (with-current-buffer (find-file-noselect type-break-file-name - 'nowarn) - (set-buffer-modified-p nil) - (unlock-buffer) - (kill-this-buffer))) - (and (called-interactively-p 'interactive) - (message "Type Break mode is disabled"))))) - type-break-mode) + (cond + ;; ((and already-enabled type-break-mode) + ;; (and (called-interactively-p 'interactive) + ;; (message "Type Break mode is already enabled"))) + (type-break-mode + (when type-break-file-name + (with-current-buffer (find-file-noselect type-break-file-name 'nowarn) + (setq buffer-save-without-query t))) + + (or global-mode-string (setq global-mode-string '(""))) ;FIXME: Why? + (type-break-keystroke-reset) + (type-break-mode-line-countdown-or-break nil) + + (setq type-break-time-last-break + (or (type-break-get-previous-time) + (current-time))) + + ;; Schedule according to break time from session file. + (type-break-schedule + (let (diff) + (if (and type-break-time-last-break + (< (setq diff (type-break-time-difference + type-break-time-last-break + (current-time))) + type-break-interval)) + ;; Use the file's value. + (progn + (setq type-break-keystroke-count + (type-break-get-previous-count)) + ;; File the time, in case it was read from the auto-save file. + (type-break-file-time type-break-interval-start) + (setq type-break-interval-start type-break-time-last-break) + (- type-break-interval diff)) + ;; Schedule from now. + (setq type-break-interval-start (current-time)) + (type-break-file-time type-break-interval-start) + type-break-interval)) + type-break-interval-start + type-break-interval)) + (t + (type-break-keystroke-reset) + (type-break-mode-line-countdown-or-break nil) + (type-break-cancel-schedule) + (do-auto-save) + (when type-break-file-name + (with-current-buffer (find-file-noselect type-break-file-name + 'nowarn) + (set-buffer-modified-p nil) + (unlock-buffer) + (kill-this-buffer)))))) (define-minor-mode type-break-mode-line-message-mode "Toggle warnings about typing breaks in the mode line. @@ -997,10 +969,11 @@ FRAC should be the inverse of the fractional value; for example, a value of ;; "low" bits and format the time incorrectly. (defun type-break-time-sum (&rest tmlist) (let ((sum '(0 0 0))) - (dolist (tem tmlist sum) + (dolist (tem tmlist) (setq sum (time-add sum (if (integerp tem) (list (floor tem 65536) (mod tem 65536)) - tem)))))) + tem)))) + sum)) (defun type-break-time-stamp (&optional when) (if (fboundp 'format-time-string) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index a72f12ccb9b..a00d748a4a4 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,22 @@ +2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-handlers.el (url-file-handler): Don't assume any url-FOO function + is a good handler for FOO. + (url-copy-file, url-file-local-copy, url-insert-file-contents) + (url-file-name-completion, url-file-name-all-completions) + (url-handlers-create-wrapper): Explicitly register as handler. + +2012-09-29 Bastien Guerry <bzg@gnu.org> + + * url-util.el (url-insert-entities-in-string) + (url-build-query-string): Fix docstrings. + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * url-parse.el (url-recreate-url-attributes): + * url-util.el (url-generate-unique-filename): Use declare to mark + obsolete. + 2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca> * url-http.el (url-http-parse-headers): Re-enable file-name-handlers diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index f731f614d13..796980afbd5 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -137,11 +137,13 @@ like URLs \(Gnus is particularly bad at this\)." "Function called from the `file-name-handler-alist' routines. OPERATION is what needs to be done (`file-exists-p', etc). ARGS are the arguments that would have been passed to OPERATION." - (let ((fn (or (get operation 'url-file-handlers) - (intern-soft (format "url-%s" operation)))) + (let ((fn (get operation 'url-file-handlers)) (val nil) (hooked nil)) - (if (and fn (fboundp fn)) + (if (and (not fn) (intern-soft (format "url-%s" operation)) + (fboundp (intern-soft (format "url-%s" operation)))) + (error "Missing URL handler mapping for %s" operation)) + (if fn (setq hooked t val (save-match-data (apply fn args))) (setq hooked nil @@ -249,6 +251,7 @@ A prefix arg makes KEEP-TIME non-nil." (mm-save-part-to-file handle newname) (kill-buffer buffer) (mm-destroy-parts handle))) +(put 'copy-file 'url-file-handlers 'url-copy-file) ;;;###autoload (defun url-file-local-copy (url &rest ignored) @@ -258,6 +261,7 @@ accessible." (let ((filename (make-temp-file "url"))) (url-copy-file url filename 'ok-if-already-exists) filename)) +(put 'file-local-copy 'url-file-handlers 'url-file-local-copy) (defun url-insert (buffer &optional beg end) "Insert the body of a URL object. @@ -300,22 +304,29 @@ They count bytes from the beginning of the body." ;; usual heuristic/rules that we apply to files. (decode-coding-inserted-region start (point) url visit beg end replace)) (list url (car size-and-charset)))))) +(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) (defun url-file-name-completion (url directory &optional predicate) (error "Unimplemented")) +(put 'file-name-completion 'url-file-handlers 'url-file-name-completion) (defun url-file-name-all-completions (file directory) (error "Unimplemented")) +(put 'file-name-all-completions + 'url-file-handlers 'url-file-name-all-completions) ;; All other handlers map onto their respective backends. (defmacro url-handlers-create-wrapper (method args) - `(defun ,(intern (format "url-%s" method)) ,args - ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method - (or (documentation method t) "No original documentation.")) - (setq url (url-generic-parse-url url)) - (when (url-type url) - (funcall (url-scheme-get-property (url-type url) (quote ,method)) - ,@(remove '&rest (remove '&optional args)))))) + `(progn + (defun ,(intern (format "url-%s" method)) ,args + ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method + (or (documentation method t) "No original documentation.")) + (setq url (url-generic-parse-url url)) + (when (url-type url) + (funcall (url-scheme-get-property (url-type url) (quote ,method)) + ,@(remove '&rest (remove '&optional args))))) + (unless (get ',method 'url-file-handlers) + (put ',method 'url-file-handlers ',(intern (format "url-%s" method)))))) (url-handlers-create-wrapper file-exists-p (url)) (url-handlers-create-wrapper file-attributes (url &optional id-format)) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 4007d1f35b3..cb61a021251 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -98,6 +98,7 @@ If the specified port number is the default, return nil." (defun url-recreate-url-attributes (urlobj) "Recreate the attributes of an URL string from the parsed URLOBJ." + (declare (obsolete nil "24.3")) (when (url-attributes urlobj) (concat ";" (mapconcat (lambda (x) @@ -105,7 +106,6 @@ If the specified port number is the default, return nil." (concat (car x) "=" (cdr x)) (car x))) (url-attributes urlobj) ";")))) -(make-obsolete 'url-recreate-url-attributes nil "24.3") ;;;###autoload (defun url-generic-parse-url (url) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index f654830e387..038b7fcf7fe 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -132,8 +132,8 @@ If a list, it is a list of the types of messages to be logged." (defun url-insert-entities-in-string (string) "Convert HTML markup-start characters to entity references in STRING. Also replaces the \" character, so that the result may be safely used as - an attribute value in a tag. Returns a new string with the result of the - conversion. Replaces these characters as follows: +an attribute value in a tag. Returns a new string with the result of the +conversion. Replaces these characters as follows: & ==> & < ==> < > ==> > @@ -294,7 +294,7 @@ Given a QUERY in the form: (key2 val2) (key3 val1 val2) (key4) - (key5 "")) + (key5 \"\")) \(This is the same format as produced by `url-parse-query-string') @@ -593,6 +593,7 @@ Has a preference for looking backward when not directly on a symbol." (defun url-generate-unique-filename (&optional fmt) "Generate a unique filename in `url-temporary-directory'." + (declare (obsolete make-temp-file "23.1")) ;; This variable is obsolete, but so is this function. (let ((tempdir (with-no-warnings url-temporary-directory))) (if (not fmt) @@ -614,7 +615,6 @@ Has a preference for looking backward when not directly on a symbol." (setq x (1+ x) fname (format fmt (concat base (int-to-string x))))) (expand-file-name fname tempdir))))) -(make-obsolete 'url-generate-unique-filename 'make-temp-file "23.1") (defun url-extract-mime-headers () "Set `url-current-mime-headers' in current buffer." diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 674688df1c2..2c41ce8c457 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -753,6 +753,7 @@ to temp files in buffer jobs and when Ediff needs to find fine differences." "Check the current version against MAJOR and MINOR version numbers. The comparison uses operator OP, which may be any of: =, >, >=, <, <=. TYPE-OF-EMACS is either 'xemacs or 'emacs." + (declare (obsolete version< "23.1")) (and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs)) ((eq type-of-emacs 'emacs) (featurep 'emacs)) (t)) @@ -767,9 +768,6 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs." (t (error "%S: Invalid op in ediff-check-version" op))))) -;; ediff-check-version seems to be totally unused anyway. -(make-obsolete 'ediff-check-version 'version< "23.1") - (defun ediff-color-display-p () (condition-case nil (if (featurep 'xemacs) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 78a2163f653..86293ade580 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1907,8 +1907,8 @@ in the specified buffer." (cond ((eq which-diff 'after) (1+ diff-no)) ((eq which-diff 'before) diff-no) - ((< (abs (count-lines pos (max 1 prev-end))) - (abs (count-lines pos (max 1 beg)))) + ((< (abs (count-lines pos (max (point-min) prev-end))) + (abs (count-lines pos (max (point-min) beg)))) diff-no) ; choose prev difference (t (1+ diff-no))) ; choose next difference diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index eee3f40fd96..d7118ad7970 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -63,13 +63,11 @@ ;; Determine which window setup function to use based on current window system. (defun ediff-choose-window-setup-function-automatically () + (declare (obsolete ediff-setup-windows-default "24.3")) (if (ediff-window-display-p) 'ediff-setup-windows-multiframe 'ediff-setup-windows-plain)) -(make-obsolete 'ediff-choose-window-setup-function-automatically - 'ediff-setup-windows-default "24.3") - (defcustom ediff-window-setup-function 'ediff-setup-windows-default "Function called to set up windows. Ediff provides a choice of three functions: diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index f6942bc538d..0a1bd044125 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -76,18 +76,6 @@ Commands: Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode, but can be invoked directly in `fast' mode.") -(define-obsolete-variable-alias 'emerge-version 'emacs-version "23.2") - -(defun emerge-version () - "Return string describing the version of Emerge. -When called interactively, displays the version." - (interactive) - (if (called-interactively-p 'interactive) - (message "Emerge version %s" emacs-version) - emacs-version)) - -(make-obsolete 'emerge-version 'emacs-version "23.2") - ;;; Emerge configuration variables (defgroup emerge nil diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 7ee000a8aea..932abb9818c 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -104,13 +104,7 @@ If 'changed, only request confirmation if the list of files has :group 'log-edit :type 'boolean) -(defvar cvs-commit-buffer-require-final-newline t) -(make-obsolete-variable 'cvs-commit-buffer-require-final-newline - 'log-edit-require-final-newline - "21.1") - -(defcustom log-edit-require-final-newline - cvs-commit-buffer-require-final-newline +(defcustom log-edit-require-final-newline t "Enforce a newline at the end of commit log messages. Enforce it silently if t, query if non-nil and don't do anything if nil." :group 'log-edit @@ -154,12 +148,7 @@ can be obtained from `log-edit-files'." :group 'log-edit :version "24.1") -(defvar cvs-changelog-full-paragraphs t) -(make-obsolete-variable 'cvs-changelog-full-paragraphs - 'log-edit-changelog-full-paragraphs - "21.1") - -(defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs +(defvar log-edit-changelog-full-paragraphs t "If non-nil, include full ChangeLog paragraphs in the log. This may be set in the ``local variables'' section of a ChangeLog, to indicate the policy for that ChangeLog. @@ -354,14 +343,17 @@ automatically." `((log-edit-match-to-eoh (,(concat "^\\(\\([[:alpha:]]+\\):\\)" log-edit-header-contents-regexp) (progn (goto-char (match-beginning 0)) (match-end 0)) nil - (1 (if (assoc (match-string 2) log-edit-headers-alist) + (1 (if (assoc-string (match-string 2) log-edit-headers-alist t) 'log-edit-header 'log-edit-unknown-header) nil lax) ;; From `log-edit-header-contents-regexp': - (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) + (3 (or (cdr (assoc-string (match-string 2) log-edit-headers-alist t)) 'log-edit-header) - nil lax))))) + nil lax)) + ("^\n" + (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil + (0 '(:height 0.1 :inverse-video t)))))) (defvar log-edit-font-lock-gnu-style nil "If non-nil, highlight common failures to follow the GNU coding standards.") @@ -585,7 +577,7 @@ If you want to abort the commit, simply delete the buffer." (or (= (point-min) (point-max)) (save-excursion (goto-char (point-min)) - (while (and (looking-at "^\\([a-zA-Z]+: \\)?$") + (while (and (looking-at "^\\([a-zA-Z]+: ?\\)?$") (zerop (forward-line 1)))) (eobp)))) @@ -818,7 +810,7 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each change-log-default-name) ;; `find-change-log' uses `change-log-default-name' if set ;; and sets it before exiting, so we need to work around - ;; that memoizing which is undesired here + ;; that memoizing which is undesired here. (setq change-log-default-name nil) (find-change-log))))) (with-current-buffer (find-file-noselect changelog-file-name) diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index fc65d62c67d..b3c1f8c1343 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -133,14 +133,9 @@ current line. See also `cvs-invert-ignore-marks'" :group 'pcl-cvs :type '(boolean)) -(defvar cvs-diff-ignore-marks t) -(make-obsolete-variable 'cvs-diff-ignore-marks - 'cvs-invert-ignore-marks - "21.1") - (defcustom cvs-invert-ignore-marks (let ((l ())) - (unless (equal cvs-diff-ignore-marks cvs-default-ignore-marks) + (unless (equal cvs-default-ignore-marks t) (push "diff" l)) (when (and cvs-force-dir-tag (not cvs-default-ignore-marks)) (push "tag" l)) @@ -171,11 +166,6 @@ If set to nil, `cvs-mode-add' will always prompt for a message." :type '(choice (const :tag "Prompt" nil) (string))) -(defvar cvs-diff-buffer-name "*cvs-diff*") -(make-obsolete-variable 'cvs-diff-buffer-name - 'cvs-buffer-name-alist - "21.1") - (defcustom cvs-find-file-and-jump nil "Jump to the modified area when finding a file. If non-nil, `cvs-mode-find-file' will place the cursor at the beginning of @@ -185,7 +175,7 @@ have no effect." :type '(boolean)) (defcustom cvs-buffer-name-alist - '(("diff" cvs-diff-buffer-name diff-mode) + '(("diff" "*cvs-diff*" diff-mode) ("status" "*cvs-info*" cvs-status-mode) ("tree" "*cvs-info*" cvs-status-mode) ("message" "*cvs-commit*" nil log-edit) diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 36572640cfc..e863096d587 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -124,7 +124,7 @@ to confuse some users sometimes." (define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1") (defface cvs-msg - '((t (:slant italic))) + '((t :slant italic)) "PCL-CVS face used to highlight CVS messages." :group 'pcl-cvs) (define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1") @@ -358,7 +358,7 @@ For use by the cookie package." ;;(MOD-CONFLICT "Not Removed") (`DEAD "") (_ (capitalize (symbol-name type))))) - (face (let ((sym (intern + (face (let ((sym (intern-soft (concat "cvs-fi-" (downcase (symbol-name type)) "-face")))) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 659151a31e9..4bc3eaf8c2c 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -60,8 +60,6 @@ ;; - rework the displaying of error messages. ;; - allow to flush messages only ;; - allow to protect files like ChangeLog from flushing -;; - automatically cvs-mode-insert files from find-file-hook -;; (and don't flush them as long as they are visited) ;; - query the user for cvs-get-marked (for some cmds or if nothing's selected) ;; - don't return the first (resp last) FI if the cursor is before ;; (resp after) it. @@ -877,7 +875,10 @@ RM-MSGS if non-nil means remove messages." ;; remove entries (`DEAD nil) ;; handled also? - (`UP-TO-DATE (not rm-handled)) + (`UP-TO-DATE + (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) + t + (not rm-handled))) ;; keep the rest (_ (not (run-hook-with-args-until-success 'cvs-cleanup-functions fi)))))) @@ -1617,7 +1618,8 @@ With prefix argument, prompt for cvs flags." (defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags) "Diff the selected files against the repository. This command compares the files in your working area against the -revision which they are based upon." +revision which they are based upon. +See also `cvs-diff-ignore-marks'." (interactive (list (cvs-add-branch-prefix (cvs-add-secondary-branch-prefix @@ -2435,6 +2437,21 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (add-hook 'after-save-hook 'cvs-mark-buffer-changed) +(defun cvs-insert-visited-file () + (let* ((file (expand-file-name buffer-file-name)) + (version (and (fboundp 'vc-backend) + (eq (vc-backend file) 'CVS) + (vc-working-revision file)))) + (when version + (save-current-buffer + (dolist (cvs-buf (buffer-list)) + (set-buffer cvs-buf) + ;; look for a corresponding pcl-cvs buffer + (when (and (eq major-mode 'cvs-mode) + (string-prefix-p default-directory file)) + (cvs-insert-file file))))))) + +(add-hook 'find-file-hook 'cvs-insert-visited-file 'append) (provide 'pcvs) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 1eb33776f6a..74a61548d8b 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -150,12 +150,6 @@ Use the current Bzr root directory as the ROOT argument to (defconst vc-bzr-admin-branchconf (concat vc-bzr-admin-dirname "/branch/branch.conf")) -;;;###autoload (defun vc-bzr-registered (file) -;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file) -;;;###autoload (progn -;;;###autoload (load "vc-bzr") -;;;###autoload (vc-bzr-registered file)))) - (defun vc-bzr-root (file) "Return the root directory of the bzr repository containing FILE." ;; Cache technique copied from vc-arch.el. @@ -291,6 +285,14 @@ in the repository root directory of FILE." (message "Falling back on \"slow\" status detection (%S)" err) (vc-bzr-state file)))))) +;; This is a cheap approximation that is autoloaded. If it finds a +;; possible match it loads this file and runs the real function. +;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too. +;;;###autoload (defun vc-bzr-registered (file) +;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file) +;;;###autoload (progn +;;;###autoload (load "vc-bzr") +;;;###autoload (vc-bzr-registered file)))) (defun vc-bzr-registered (file) "Return non-nil if FILE is registered with bzr." diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 54c33769267..cac3eb559a1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -34,18 +34,6 @@ ;; Customization Variables (the rest is in vc.el) -(defvar vc-ignore-vc-files nil) -(make-obsolete-variable 'vc-ignore-vc-files - "set `vc-handled-backends' to nil to disable VC." - "21.1") - -(defvar vc-master-templates ()) -(make-obsolete-variable 'vc-master-templates - "to define master templates for a given BACKEND, use -vc-BACKEND-master-templates. To enable or disable VC for a given -BACKEND, use `vc-handled-backends'." - "21.1") - (defcustom vc-ignore-dir-regexp ;; Stop SMB, automounter, AFS, and DFS host lookups. locate-dominating-stop-dir-regexp @@ -586,16 +574,7 @@ If FILE is not registered, this function always returns nil." "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." (let ((sym (vc-make-backend-sym backend 'master-templates))) (unless (get backend 'vc-templates-grabbed) - (put backend 'vc-templates-grabbed t) - (set sym (append (delq nil - (mapcar - (lambda (template) - (and (consp template) - (eq (cdr template) backend) - (car template))) - (with-no-warnings - vc-master-templates))) - (symbol-value sym)))) + (put backend 'vc-templates-grabbed t)) (let ((result (vc-check-master-templates file (symbol-value sym)))) (if (stringp result) (vc-file-setprop file 'vc-name result) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index ecd7b826437..baaf0c3a926 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -89,6 +89,9 @@ to use --brief and sets this variable to remember whether it worked." :type '(choice (const :tag "Work out" nil) (const yes) (const no)) :group 'vc-rcs) +;; This needs to be autoloaded because vc-rcs-registered uses it (via +;; vc-default-registered), and vc-hooks needs to be able to check +;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index a34222f7236..c4f6fd10bdb 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -74,6 +74,9 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :version "24.1" ; no longer consult the obsolete vc-header-alist :group 'vc-sccs) +;; This needs to be autoloaded because vc-sccs-registered uses it (via +;; vc-default-registered), and vc-hooks needs to be able to check +;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) @@ -106,11 +109,10 @@ For a description of possible values, see `vc-check-master-templates'." ;; The autoload cookie below places vc-sccs-registered directly into ;; loaddefs.el, so that vc-sccs.el does not need to be loaded for -;; every file that is visited. The definition is repeated below -;; so that Help and etags can find it. - -;;;###autoload (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f)) -(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)) +;; every file that is visited. +;;;###autoload +(progn +(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))) (defun vc-sccs-state (file) "SCCS-specific function to compute the version control state." diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 47800bd4aac..2da721b41d8 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -808,16 +808,6 @@ is sensitive to blank lines." (string :tag "Comment End"))) :group 'vc) -(defcustom vc-checkout-carefully (= (user-uid) 0) - "Non-nil means be extra-careful in checkout. -Verify that the file really is not locked -and that its contents match what the repository version says." - :type 'boolean - :group 'vc) -(make-obsolete-variable 'vc-checkout-carefully - "the corresponding checks are always done now." - "21.1") - ;; Variables users don't need to see @@ -1115,24 +1105,27 @@ For old-style locking-based version control systems, like RCS: ;; Files have local changes ((vc-compatible-state state 'edited) (let ((ready-for-commit files)) - ;; If files are edited but read-only, give user a chance to correct. - (dolist (file files) - ;; If committing a mix of removed and edited files, the - ;; fileset has state = 'edited. Rather than checking the - ;; state of each individual file in the fileset, it seems - ;; simplest to just check if the file exists. Bug#9781. - (when (and (file-exists-p file) (not (file-writable-p file))) - ;; Make the file+buffer read-write. - (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) - (error "Aborted")) - ;; Maybe we somehow lost permissions on the directory. - (condition-case nil - (set-file-modes file (logior (file-modes file) 128)) - (error (error "Unable to make file writable"))) - (let ((visited (get-file-buffer file))) - (when visited - (with-current-buffer visited - (read-only-mode -1)))))) + ;; CVS, SVN and bzr don't care about read-only (bug#9781). + ;; RCS does, SCCS might (someone should check...). + (when (memq backend '(RCS SCCS)) + ;; If files are edited but read-only, give user a chance to correct. + (dolist (file files) + ;; If committing a mix of removed and edited files, the + ;; fileset has state = 'edited. Rather than checking the + ;; state of each individual file in the fileset, it seems + ;; simplest to just check if the file exists. Bug#9781. + (when (and (file-exists-p file) (not (file-writable-p file))) + ;; Make the file+buffer read-write. + (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) + (error "Aborted")) + ;; Maybe we somehow lost permissions on the directory. + (condition-case nil + (set-file-modes file (logior (file-modes file) 128)) + (error (error "Unable to make file writable"))) + (let ((visited (get-file-buffer file))) + (when visited + (with-current-buffer visited + (read-only-mode -1))))))) ;; Allow user to revert files with no changes (save-excursion (dolist (file files) @@ -1516,8 +1509,9 @@ to override the value of `vc-diff-switches' and `diff-switches'." (when (listp switches) switches)))) ;; Old def for compatibility with Emacs-21.[123]. -(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) -(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") +(defmacro vc-diff-switches-list (backend) + (declare (obsolete vc-switches "22.1")) + `(vc-switches ',backend 'diff)) (defun vc-diff-finish (buffer messages) ;; The empty sync output case has already been handled, so the only diff --git a/lisp/view.el b/lisp/view.el index 41cb9752288..7ed42bf7ddc 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -513,6 +513,7 @@ that can be added see the RETURN-TO-ALIST argument of the function `view-mode-exit'. If `view-return-to-alist' contains an entry for the selected window, purge that entry from `view-return-to-alist' before adding ITEM." + (declare (obsolete "this function has no effect." "24.1")) (with-current-buffer buffer (when view-return-to-alist (let* ((list view-return-to-alist) @@ -535,7 +536,6 @@ entry for the selected window, purge that entry from (when item (setq view-return-to-alist (cons item view-return-to-alist))))) -(make-obsolete 'view-return-to-alist-update "this function has no effect." "24.1") ;;;###autoload (defun view-mode-enter (&optional quit-restore exit-action) diff --git a/lisp/window.el b/lisp/window.el index 87817fb8773..811b1781b4c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -84,7 +84,7 @@ This hook is run by `with-temp-buffer-window' with the buffer displayed and current and its window selected.") (defun temp-buffer-window-setup (buffer-or-name) - "Set up temporary buffer specified by BUFFER-OR-NAME + "Set up temporary buffer specified by BUFFER-OR-NAME. Return the buffer." (let ((old-dir default-directory) (buffer (get-buffer-create buffer-or-name))) @@ -508,7 +508,7 @@ failed." (window-make-atom (window-parent window)) ;; Display BUFFER in NEW and return NEW. (window--display-buffer - buffer new 'window display-buffer-mark-dedicated)))) + buffer new 'window alist display-buffer-mark-dedicated)))) (defun window--atom-check-1 (window) "Subroutine of `window--atom-check'." @@ -677,12 +677,6 @@ The new window automatically becomes the \"major\" side window on SIDE. Return the new window, nil if its creation window failed." (let* ((root (frame-root-window)) (left-or-right (memq side '(left right))) - (size (or (assq 'size alist) - (/ (window-total-size (frame-root-window) left-or-right) - ;; By default use a fourth of the size of the - ;; frame's root window. This has to be made - ;; customizable via ALIST. - 4))) (major (window--major-side-window side)) (selected-window (selected-window)) (on-side (cond @@ -694,7 +688,7 @@ SIDE. Return the new window, nil if its creation window failed." ;; parent window unless needed. (window-combination-resize 'side) (window-combination-limit nil) - (new (split-window major (- size) on-side)) + (new (split-window major nil on-side)) fun) (when new ;; Initialize `window-side' parameter of new window to SIDE. @@ -705,8 +699,22 @@ SIDE. Return the new window, nil if its creation window failed." ;; the new window is deleted, a side window on the opposite side ;; does not get resized. (set-window-parameter new 'delete-window 'delete-side-window) + ;; Auto-adjust height/width of new window unless a size has been + ;; explicitly requested. + (unless (if left-or-right + (cdr (assq 'window-width alist)) + (cdr (assq 'window-height alist))) + (setq alist + (cons + (cons + (if left-or-right 'window-width 'window-height) + (/ (window-total-size (frame-root-window) left-or-right) + ;; By default use a fourth of the size of the + ;; frame's root window. + 4)) + alist))) ;; Install BUFFER in new window and return NEW. - (window--display-buffer buffer new 'window 'side)))) + (window--display-buffer buffer new 'window alist 'side)))) (defun delete-side-window (window) "Delete side window WINDOW." @@ -814,7 +822,7 @@ following symbols can be used: ;; ALIST (or, better, avoided in the "other" functions). (or (and this-window ;; Reuse `this-window'. - (window--display-buffer buffer this-window 'reuse 'side)) + (window--display-buffer buffer this-window 'reuse alist 'side)) (and (or (not max-slots) (< slots max-slots)) (or (and next-window ;; Make new window before `next-window'. @@ -839,13 +847,14 @@ following symbols can be used: window 'delete-window 'delete-side-window) window))) (set-window-parameter window 'window-slot slot) - (window--display-buffer buffer window 'window 'side)) + (window--display-buffer buffer window 'window alist 'side)) (and best-window ;; Reuse `best-window'. (progn ;; Give best-window the new slot value. (set-window-parameter best-window 'window-slot slot) - (window--display-buffer buffer best-window 'reuse 'side))))))))) + (window--display-buffer + buffer best-window 'reuse alist 'side))))))))) (defun window--side-check (&optional frame) "Check the side window configuration of FRAME. @@ -903,7 +912,7 @@ of all windows on FRAME to nil." (if right (throw 'reset t) (setq right t))) ((eq side 'bottom) (if bottom (throw 'reset t) (setq bottom t))) - (t + (t (throw 'reset t)))) frame t)) ;; If there's a side window, there must be at least one @@ -2079,9 +2088,9 @@ preferably only resize windows adjacent to EDGE. Return the symbol `normalized' if new normal sizes have been already set by this routine." (let* ((first (window-child parent)) - (sub first) + (last (window-last-child parent)) (parent-total (+ (window-total-size parent horizontal) delta)) - best-window best-value) + sub best-window best-value) (if (and edge (memq trail '(before after)) (progn @@ -2125,7 +2134,7 @@ already set by this routine." ;; normal sizes have been already set. 'normalized) ;; Resize all windows proportionally. - (setq sub first) + (setq sub last) (while sub (cond ((or (window--resize-child-windows-skip-p sub) @@ -2154,14 +2163,14 @@ already set by this routine." parent-total) (window-normal-size sub horizontal))))) - (setq sub (window-right sub))) + (setq sub (window-left sub))) (cond ((< delta 0) ;; Shrink windows by delta. (setq best-window t) (while (and best-window (not (zerop delta))) - (setq sub first) + (setq sub last) (setq best-window nil) (setq best-value most-negative-fixnum) (while sub @@ -2171,7 +2180,7 @@ already set by this routine." (setq best-window sub) (setq best-value (cdr (window-new-normal sub)))) - (setq sub (window-right sub))) + (setq sub (window-left sub))) (when best-window (setq delta (1+ delta))) @@ -2188,7 +2197,7 @@ already set by this routine." ;; Enlarge windows by delta. (setq best-window t) (while (and best-window (not (zerop delta))) - (setq sub first) + (setq sub last) (setq best-window nil) (setq best-value most-positive-fixnum) (while sub @@ -2197,7 +2206,7 @@ already set by this routine." (setq best-window sub) (setq best-value (window-new-normal sub))) - (setq sub (window-right sub))) + (setq sub (window-left sub))) (when best-window (setq delta (1- delta))) @@ -2209,7 +2218,7 @@ already set by this routine." (window-normal-size best-window horizontal)))))) (when best-window - (setq sub first) + (setq sub last) (while sub (when (or (consp (window-new-normal sub)) (numberp (window-new-normal sub))) @@ -2227,7 +2236,7 @@ already set by this routine." ;; recursively even if it's size does not change. (window--resize-this-window sub delta horizontal ignore nil trail edge)))) - (setq sub (window-right sub))))))) + (setq sub (window-left sub))))))) (defun window--resize-siblings (window delta &optional horizontal ignore trail edge) "Resize other windows when WINDOW is resized vertically by DELTA lines. @@ -2406,27 +2415,33 @@ Return the number of lines that were recovered. This function is only called by the minibuffer window resizing routines. It resizes windows proportionally and never deletes any windows." - (when (numberp delta) - (let (ignore) - (cond - ((< delta 0) - (setq delta (window-sizable window delta))) - ((> delta 0) - (unless (window-sizable window delta) - (setq ignore t)))) - - (window--resize-reset (window-frame window)) - ;; Ideally, we would resize just the last window in a combination - ;; but that's not feasible for the following reason: If we grow - ;; the minibuffer window and the last window cannot be shrunk any - ;; more, we shrink another window instead. But if we then shrink - ;; the minibuffer window again, the last window might get enlarged - ;; and the state after shrinking is not the state before growing. - ;; So, in practice, we'd need a history variable to record how to - ;; proceed. But I'm not sure how such a variable could work with - ;; repeated minibuffer window growing steps. - (window--resize-this-window window delta nil ignore t) - delta))) + (let ((frame (window-frame window)) + ignore) + (cond + ((not (numberp delta)) + (setq delta 0)) + ((zerop delta)) + ((< delta 0) + (setq delta (window-sizable window delta)) + (window--resize-reset frame) + ;; When shrinking the root window, emulate an edge drag in order + ;; to not resize other windows if we can avoid it (Bug#12419). + (window--resize-this-window + window delta nil ignore t 'before + (+ (window-top-line window) (window-total-size window))) + ;; Don't record new normal sizes to make sure that shrinking back + ;; proportionally works as intended. + (walk-window-tree + (lambda (window) (set-window-new-normal window 'ignore)) frame t)) + ((> delta 0) + (window--resize-reset frame) + (unless (window-sizable window delta) + (setq ignore t)) + ;; When growing the root window, resize proportionally. This + ;; should give windows back their original sizes (hopefully). + (window--resize-this-window window delta nil ignore t))) + ;; Return the possibly adjusted DELTA. + delta)) (defun adjust-window-trailing-edge (window delta &optional horizontal) "Move WINDOW's bottom edge by DELTA lines. @@ -5071,7 +5086,7 @@ split." (with-selected-window window (split-window-below)))))))) -(defun window--try-to-split-window (window) +(defun window--try-to-split-window (window &optional alist) "Try to split WINDOW. Return value returned by `split-window-preferred-function' if it represents a live window, nil otherwise." @@ -5079,9 +5094,14 @@ represents a live window, nil otherwise." (not (frame-parameter (window-frame window) 'unsplittable)) (let* ((window-combination-limit ;; When `window-combination-limit' equals - ;; `display-buffer' bind it to t so resizing steals - ;; space preferably from the window that was split. - (if (eq window-combination-limit 'display-buffer) + ;; `display-buffer' or equals `resize-window' and a + ;; `window-height' or `window-width' alist entry are + ;; present, bind it to t so resizing steals space + ;; preferably from the window that was split. + (if (or (eq window-combination-limit 'display-buffer) + (and (eq window-combination-limit 'window-size) + (or (cdr (assq 'window-height alist)) + (cdr (assq 'window-width alist))))) t window-combination-limit)) (new-window @@ -5138,7 +5158,7 @@ is higher than WINDOW." (/ (- (window-total-height window) (window-total-height)) 2)) (error nil)))) -(defun window--display-buffer (buffer window type &optional dedicated) +(defun window--display-buffer (buffer window type &optional alist dedicated) "Display BUFFER in WINDOW and make its frame visible. TYPE must be one of the symbols `reuse', `window' or `frame' and is passed unaltered to `display-buffer-record-window'. Set @@ -5153,6 +5173,58 @@ BUFFER and WINDOW are live." (set-window-dedicated-p window dedicated)) (when (memq type '(window frame)) (set-window-prev-buffers window nil))) + (let ((parameter (window-parameter window 'quit-restore)) + (height (cdr (assq 'window-height alist))) + (width (cdr (assq 'window-width alist)))) + (when (or (memq type '(window frame)) + (and (eq (car parameter) 'same) + (memq (nth 1 parameter) '(window frame)))) + ;; Adjust height of new window or frame. + (cond + ((not height)) + ((numberp height) + (let* ((new-height + (if (integerp height) + height + (round + (* (window-total-size (frame-root-window window)) + height)))) + (delta (- new-height (window-total-size window)))) + (cond + ((and (window--resizable-p window delta nil 'safe) + (window-combined-p window)) + (window-resize window delta nil 'safe)) + ((or (eq type 'frame) + (and (eq (car parameter) 'same) + (eq (nth 1 parameter) 'frame))) + (set-frame-height + (window-frame window) + (+ (frame-height (window-frame window)) delta)))))) + ((functionp height) + (ignore-errors (funcall height window)))) + ;; Adjust width of a window or frame. + (cond + ((not width)) + ((numberp width) + (let* ((new-width + (if (integerp width) + width + (round + (* (window-total-size (frame-root-window window) t) + width)))) + (delta (- new-width (window-total-size window t)))) + (cond + ((and (window--resizable-p window delta t 'safe) + (window-combined-p window t)) + (window-resize window delta t 'safe)) + ((or (eq type 'frame) + (and (eq (car parameter) 'same) + (eq (nth 1 parameter) 'frame))) + (set-frame-width + (window-frame window) + (+ (frame-width (window-frame window)) delta)))))) + ((functionp width) + (ignore-errors (funcall width window)))))) window)) (defun window--maybe-raise-frame (frame) @@ -5394,7 +5466,7 @@ selected window." (unless (or (cdr (assq 'inhibit-same-window alist)) (window-minibuffer-p) (window-dedicated-p)) - (window--display-buffer buffer (selected-window) 'reuse))) + (window--display-buffer buffer (selected-window) 'reuse alist))) (defun display-buffer--maybe-same-window (buffer alist) "Conditionally display BUFFER in the selected window. @@ -5442,7 +5514,7 @@ that frame." (get-buffer-window-list buffer 'nomini frames)))))) (when (window-live-p window) - (prog1 (window--display-buffer buffer window 'reuse) + (prog1 (window--display-buffer buffer window 'reuse alist) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -5479,8 +5551,8 @@ new frame." (when (and fun (setq frame (funcall fun)) (setq window (frame-selected-window frame))) - (prog1 (window--display-buffer buffer window - 'frame display-buffer-mark-dedicated) + (prog1 (window--display-buffer + buffer window 'frame alist display-buffer-mark-dedicated) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame frame)))))) @@ -5505,11 +5577,11 @@ raising the frame." (not (frame-parameter frame 'unsplittable)))) ;; Attempt to split largest or least recently used window. (setq window (or (window--try-to-split-window - (get-largest-window frame t)) + (get-largest-window frame t) alist) (window--try-to-split-window - (get-lru-window frame t))))) - (prog1 (window--display-buffer buffer window - 'window display-buffer-mark-dedicated) + (get-lru-window frame t) alist)))) + (prog1 (window--display-buffer + buffer window 'window alist display-buffer-mark-dedicated) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -5528,21 +5600,21 @@ again with `display-buffer-pop-up-window'." (and pop-up-windows (display-buffer-pop-up-window buffer alist)))) -(defun display-buffer-below-selected (buffer _alist) +(defun display-buffer-below-selected (buffer alist) "Try displaying BUFFER in a window below the selected window. This either splits the selected window or reuses the window below the selected one." (let (window) (or (and (not (frame-parameter nil 'unsplittable)) - (setq window (window--try-to-split-window (selected-window))) + (setq window (window--try-to-split-window (selected-window) alist)) (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)) + buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window (window-in-direction 'below)) (not (window-dedicated-p window)) (window--display-buffer - buffer window 'reuse display-buffer-mark-dedicated))))) + buffer window 'reuse alist display-buffer-mark-dedicated))))) -(defun display-buffer-at-bottom (buffer _alist) +(defun display-buffer-at-bottom (buffer alist) "Try displaying BUFFER in a window at the botom of the selected frame. This either splits the window at the bottom of the frame or the frame's root window, or reuses an existing window at the bottom @@ -5550,20 +5622,20 @@ of the selected frame." (let (bottom-window window) (walk-window-tree (lambda (window) (setq bottom-window window))) (or (and (not (frame-parameter nil 'unsplittable)) - (setq window (window--try-to-split-window bottom-window)) + (setq window (window--try-to-split-window bottom-window alist)) (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)) + buffer window 'window alist display-buffer-mark-dedicated)) (and (not (frame-parameter nil 'unsplittable)) (setq window (condition-case nil (split-window (frame-root-window)) (error nil))) (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)) + buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window bottom-window) (not (window-dedicated-p window)) (window--display-buffer - buffer window 'reuse display-buffer-mark-dedicated))))) + buffer window 'reuse alist display-buffer-mark-dedicated))))) (defun display-buffer-in-previous-window (buffer alist) "Display BUFFER in a window previously showing it. @@ -5619,7 +5691,7 @@ above, even if that window never showed BUFFER before." (setq best-window window))) ;; Return best or second best window found. (when (setq window (or best-window second-best-window)) - (window--display-buffer buffer window 'reuse)))) + (window--display-buffer buffer window 'reuse alist)))) (defun display-buffer-use-some-window (buffer alist) "Display BUFFER in an existing window. @@ -5647,7 +5719,7 @@ that frame." (get-largest-window 0 not-this-window)))) (when (window-live-p window) (prog1 - (window--display-buffer buffer window 'reuse) + (window--display-buffer buffer window 'reuse alist) (window--even-window-heights window) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -5917,6 +5989,97 @@ WINDOW must be a live window and defaults to the selected one." window)))) ;;; Resizing buffers to fit their contents exactly. +(defcustom fit-frame-to-buffer nil + "Non-nil means `fit-window-to-buffer' can resize frames. +A frame can be resized if and only if its root window is a live +window. The height of the root window is subject to the values +of `fit-frame-to-buffer-max-height' and `window-min-height'." + :type 'boolean + :version "24.2" + :group 'help) + +(defcustom fit-frame-to-buffer-bottom-margin 4 + "Bottom margin for `fit-frame-to-buffer'. +This is the number of lines `fit-frame-to-buffer' leaves free at the +bottom of the display in order to not obscure the system task bar." + :type 'integer + :version "24.2" + :group 'windows) + +(defun fit-frame-to-buffer (&optional frame max-height min-height) + "Adjust height of FRAME to display its buffer's contents exactly. +FRAME can be any live frame and defaults to the selected one. + +Optional argument MAX-HEIGHT specifies the maximum height of +FRAME and defaults to the height of the display below the current +top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. +Optional argument MIN-HEIGHT specifies the minimum height of +FRAME." + (interactive) + (setq frame (window-normalize-frame frame)) + (let* ((root (frame-root-window frame)) + (frame-min-height + (+ (- (frame-height frame) (window-total-size root)) + window-min-height)) + (frame-top (frame-parameter frame 'top)) + (top (if (consp frame-top) + (funcall (car frame-top) (cadr frame-top)) + frame-top)) + (frame-max-height + (- (/ (- (x-display-pixel-height frame) top) + (frame-char-height frame)) + fit-frame-to-buffer-bottom-margin)) + (compensate 0) + delta) + (when (and (window-live-p root) (not (window-size-fixed-p root))) + (with-selected-window root + (cond + ((not max-height) + (setq max-height frame-max-height)) + ((numberp max-height) + (setq max-height (min max-height frame-max-height))) + (t + (error "%s is an invalid maximum height" max-height))) + (cond + ((not min-height) + (setq min-height frame-min-height)) + ((numberp min-height) + (setq min-height (min min-height frame-min-height))) + (t + (error "%s is an invalid minimum height" min-height))) + ;; When tool-bar-mode is enabled and we have just created a new + ;; frame, reserve lines for toolbar resizing. This is needed + ;; because for reasons unknown to me Emacs (1) reserves one line + ;; for the toolbar when making the initial frame and toolbars + ;; are enabled, and (2) later adds the remaining lines needed. + ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a + ;; system that behaves differently. + (let ((quit-restore (window-parameter root 'quit-restore)) + (lines (tool-bar-lines-needed frame))) + (when (and quit-restore (eq (car quit-restore) 'frame) + (not (zerop lines))) + (setq compensate (1- lines)))) + (message "%s" compensate) + (setq delta + ;; Always count a final newline - we don't do any + ;; post-processing, so let's play safe. + (+ (count-screen-lines nil nil t) + (- (window-body-size)) + compensate))) + ;; Move away from final newline. + (when (and (eobp) (bolp) (not (bobp))) + (set-window-point root (line-beginning-position 0))) + (set-window-start root (point-min)) + (set-window-vscroll root 0) + (condition-case nil + (set-frame-height + frame + (min (max (+ (frame-height frame) delta) + min-height) + max-height)) + (error (setq delta nil)))) + delta)) + (defun fit-window-to-buffer (&optional window max-height min-height) "Adjust height of WINDOW to display its buffer's contents exactly. WINDOW must be a live window and defaults to the selected one. @@ -5937,9 +6100,12 @@ _all_ lines of its buffer you might not see the first lines when WINDOW was scrolled." (interactive) (setq window (window-normalize-window window t)) - ;; Can't resize a full height or fixed-size window. - (unless (or (window-size-fixed-p window) - (window-full-height-p window)) + (cond + ((window-size-fixed-p window)) + ((window-full-height-p window) + (when fit-frame-to-buffer + (fit-frame-to-buffer (window-frame window)))) + (t (with-selected-window window (let* ((height (window-total-size)) (min-height @@ -5955,7 +6121,7 @@ WINDOW was scrolled." ;; Can't get larger than height of frame. (min max-height (window-total-size (frame-root-window window))) - ;, Don't delete other windows. + ;; Don't delete other windows. (+ height (window-max-delta nil nil window)))) ;; Make `desired-height' the height necessary to show ;; all of WINDOW's buffer, constrained by MIN-HEIGHT @@ -6018,89 +6184,7 @@ WINDOW was scrolled." (window-resize window 1 nil window) (setq desired-height (1+ desired-height))))) (error (setq delta nil))) - delta)))) - -(defcustom fit-frame-to-buffer-bottom-margin 4 - "Bottom margin for `fit-frame-to-buffer'. -This is the number of lines `fit-frame-to-buffer' leaves free at the -bottom of the display in order to not obscure the system task bar." - :type 'integer - :version "24.2" - :group 'windows) - -(defun fit-frame-to-buffer (&optional frame max-height min-height) - "Adjust height of FRAME to display its buffer's contents exactly. -FRAME can be any live frame and defaults to the selected one. - -Optional argument MAX-HEIGHT specifies the maximum height of -FRAME and defaults to the height of the display below the current -top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. -Optional argument MIN-HEIGHT specifies the minimum height of -FRAME." - (interactive) - (setq frame (window-normalize-frame frame)) - (let* ((root (frame-root-window frame)) - (frame-min-height - (+ (- (frame-height frame) (window-total-size root)) - window-min-height)) - (frame-top (frame-parameter frame 'top)) - (top (if (consp frame-top) - (funcall (car frame-top) (cadr frame-top)) - frame-top)) - (frame-max-height - (- (/ (- (x-display-pixel-height frame) top) - (frame-char-height frame)) - fit-frame-to-buffer-bottom-margin)) - (compensate 0) - delta) - (when (and (window-live-p root) (not (window-size-fixed-p root))) - (with-selected-window root - (cond - ((not max-height) - (setq max-height frame-max-height)) - ((numberp max-height) - (setq max-height (min max-height frame-max-height))) - (t - (error "%s is an invalid maximum height" max-height))) - (cond - ((not min-height) - (setq min-height frame-min-height)) - ((numberp min-height) - (setq min-height (min min-height frame-min-height))) - (t - (error "%s is an invalid minimum height" min-height))) - ;; When tool-bar-mode is enabled and we have just created a new - ;; frame, reserve lines for toolbar resizing. This is needed - ;; because for reasons unknown to me Emacs (1) reserves one line - ;; for the toolbar when making the initial frame and toolbars - ;; are enabled, and (2) later adds the remaining lines needed. - ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a - ;; system that behaves differently. - (let ((quit-restore (window-parameter root 'quit-restore)) - (lines (tool-bar-lines-needed frame))) - (when (and quit-restore (eq (car quit-restore) 'frame) - (not (zerop lines))) - (setq compensate (1- lines)))) - (message "%s" compensate) - (setq delta - ;; Always count a final newline - we don't do any - ;; post-processing, so let's play safe. - (+ (count-screen-lines nil nil t) - (- (window-body-size)) - compensate))) - ;; Move away from final newline. - (when (and (eobp) (bolp) (not (bobp))) - (set-window-point root (line-beginning-position 0))) - (set-window-start root (point-min)) - (set-window-vscroll root 0) - (condition-case nil - (set-frame-height - frame - (min (max (+ (frame-height frame) delta) - min-height) - max-height)) - (error (setq delta nil)))) - delta)) + delta))))) (defun window-safely-shrinkable-p (&optional window) "Return t if WINDOW can be shrunk without shrinking other windows. diff --git a/lisp/winner.el b/lisp/winner.el index d808a54a10e..65b3d30a80c 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -63,19 +63,8 @@ "Restoring window configurations." :group 'windows) -;;;###autoload -(defcustom winner-mode nil - "Toggle Winner mode. -Setting this variable directly does not take effect; -use either \\[customize] or the function `winner-mode'." - :set #'(lambda (symbol value) (funcall symbol (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'winner - :require 'winner) - (defcustom winner-dont-bind-my-keys nil - "If non-nil: Do not use `winner-mode-map' in Winner mode." + "Non-nil means do not bind keys in Winner mode." :type 'boolean :group 'winner) @@ -85,15 +74,13 @@ use either \\[customize] or the function `winner-mode'." :group 'winner) (defcustom winner-boring-buffers '("*Completions*") - "`winner-undo' will not restore windows displaying any of these buffers. + "List of buffer names whose windows `winner-undo' will not restore. You may want to include buffer names such as *Help*, *Apropos*, *Buffer List*, *info* and *Compile-Log*." :type '(repeat string) :group 'winner) - - ;;;; Saving old configurations (internal variables and subroutines) @@ -337,19 +324,23 @@ You may want to include buffer names such as *Help*, *Apropos*, ;;;; Winner mode (a minor mode) (defcustom winner-mode-hook nil - "Functions to run whenever Winner mode is turned on." + "Functions to run whenever Winner mode is turned on or off." :type 'hook :group 'winner) -(defcustom winner-mode-leave-hook nil +(define-obsolete-variable-alias 'winner-mode-leave-hook + 'winner-mode-off-hook "24.3") + +(defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." :type 'hook :group 'winner) (defvar winner-mode-map (let ((map (make-sparse-keymap))) - (define-key map [(control c) left] 'winner-undo) - (define-key map [(control c) right] 'winner-redo) + (unless winner-dont-bind-my-keys + (define-key map [(control c) left] 'winner-undo) + (define-key map [(control c) right] 'winner-redo)) map) "Keymap for Winner mode.") @@ -364,37 +355,21 @@ You may want to include buffer names such as *Help*, *Apropos*, ;;;###autoload -(defun winner-mode (&optional arg) - "Toggle Winner mode. -With arg, turn Winner mode on if and only if arg is positive." - (interactive "P") - (let ((on-p (if arg (> (prefix-numeric-value arg) 0) - (not winner-mode)))) - (cond - ;; Turn mode on - (on-p - (setq winner-mode t) - (cond - ((winner-hook-installed-p) - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-old-configurations)) - (t (add-hook 'post-command-hook 'winner-save-conditionally))) - (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) - (setq winner-modified-list (frame-list)) - (winner-save-old-configurations) - (run-hooks 'winner-mode-hook) - (when (called-interactively-p 'interactive) - (message "Winner mode enabled"))) - ;; Turn mode off - (winner-mode - (setq winner-mode nil) - (remove-hook 'window-configuration-change-hook 'winner-change-fun) - (remove-hook 'post-command-hook 'winner-save-old-configurations) - (remove-hook 'post-command-hook 'winner-save-conditionally) - (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally) - (run-hooks 'winner-mode-leave-hook) - (when (called-interactively-p 'interactive) - (message "Winner mode disabled")))))) +(define-minor-mode winner-mode nil :global t ; let d-m-m make the doc + (if winner-mode + (progn + (if (winner-hook-installed-p) + (progn + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-old-configurations)) + (add-hook 'post-command-hook 'winner-save-conditionally)) + (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) + (setq winner-modified-list (frame-list)) + (winner-save-old-configurations)) + (remove-hook 'window-configuration-change-hook 'winner-change-fun) + (remove-hook 'post-command-hook 'winner-save-old-configurations) + (remove-hook 'post-command-hook 'winner-save-conditionally) + (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally))) ;; Inspired by undo (simple.el) @@ -461,12 +436,5 @@ In other words, \"undo\" changes in window configuration." (message "Winner undid undo"))) (t (error "Previous command was not a `winner-undo'")))) -;;; To be evaluated when the package is loaded: - -(unless (or (assq 'winner-mode minor-mode-map-alist) - winner-dont-bind-my-keys) - (push (cons 'winner-mode winner-mode-map) - minor-mode-map-alist)) - (provide 'winner) ;;; winner.el ends here |