commit 699e40caf634cea11350c59fc64ce5693d378cb4 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Sep 12 11:06:54 2020 +0300 Avoid unneeded recentering when header-line is used * src/xdisp.c (try_window): Account for header-line height only in the scroll-margin at the window's top, but not at its bottom. (Bug#42653) diff --git a/src/xdisp.c b/src/xdisp.c index 406b2d70d5..69e5a9e1cf 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19308,20 +19308,21 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) if ((flags & TRY_WINDOW_CHECK_MARGINS) && !MINI_WINDOW_P (w)) { - int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int bot_scroll_margin = top_scroll_margin; if (window_wants_header_line (w)) - this_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); + top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); start_display (&it, w, pos); if ((w->cursor.y >= 0 /* not vscrolled */ - && w->cursor.y < this_scroll_margin + && w->cursor.y < top_scroll_margin && CHARPOS (pos) > BEGV) /* rms: considering make_cursor_line_fully_visible_p here seems to give wrong results. We don't want to recenter when the last line is partly visible, we want to allow that case to be handled in the usual way. */ || w->cursor.y > (it.last_visible_y - partial_line_height (&it) - - this_scroll_margin - 1)) + - bot_scroll_margin - 1)) { w->cursor.vpos = -1; clear_glyph_matrix (w->desired_matrix); commit 7d30ca7f66b546a390b12719245f174aa4765c68 Author: Stefan Kangas Date: Sat Sep 12 03:42:37 2020 +0200 Move dired-jump from dired-x to dired (Bug#21981) * lisp/dired-x.el (dired-bind-jump): Change into defvar and make obsolete. (dired-extra-startup): Doc fix. (dired-jump, dired-jump-other-window): Move from here... * lisp/dired.el (dired-jump, dired-jump-other-window): ...to here. * lisp/bindings.el (ctl-x-map, ctl-x-4-map): Bind 'C-j' to 'dired-jump' and 'dired-jump-other-window'. * doc/misc/dired-x.texi (Features, Installation) (Miscellaneous Commands): Remove documentation of 'dired-jump'. * doc/emacs/dired.texi (Dired Enter): Document 'dired-jump' and dired-jump-other-window. * etc/NEWS: Announce the above changes. * test/lisp/dired-tests.el (dired-autoload): Adjust test. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 19aaca962d..24fd02aac1 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -109,6 +109,16 @@ the minibuffer (@pxref{Minibuffer History}). You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file}) a directory's name. +@findex dired-jump +@findex dired-jump-other-window +@kindex C-x C-j +@kindex C-x 4 C-j + Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a +Dired buffer and move point to the line corresponding to the current +file. In Dired, move up a level and go to the previous directory's +line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the +same effect but opens a new window for the Dired buffer. + The variable @code{dired-listing-switches} specifies the options to give to @command{ls} for listing the directory; this string @emph{must} contain @samp{-l}. If you use a prefix argument with the diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index d749780660..243b59b242 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -150,10 +150,8 @@ Commands using file marking @noindent @file{dired-x.el} binds some functions to keys in Dired Mode (@pxref{Key -Index}) and also binds @kbd{C-x C-j} and @kbd{C-x 4 C-j} @emph{globally} to -@code{dired-jump} (@pxref{Miscellaneous Commands}). Optionally, it -also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} to -@code{dired-x-find-file} and @code{dired-x-find-file-other-window}, +Index}). Optionally, it also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} +to @code{dired-x-find-file} and @code{dired-x-find-file-other-window}, respectively (@pxref{Find File At Point}). @node Technical Details @@ -204,32 +202,10 @@ when you first type @kbd{C-x d}). @ifnottex @menu -* Optional Installation Dired Jump:: * Optional Installation File At Point:: @end menu @end ifnottex -@node Optional Installation Dired Jump -@section Optional Installation Dired Jump - -@cindex autoloading @code{dired-jump} and @code{dired-jump-other-window} - -In order to have @code{dired-jump} and @code{dired-jump-other-window} -(@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and -@code{dired-x} have been properly loaded you should set-up an autoload -for these functions. In your @file{.emacs} file put - -@example -(autoload 'dired-jump "dired-x" - "Jump to Dired buffer corresponding to current buffer." t) - -(autoload 'dired-jump-other-window "dired-x" - "Like \\[dired-jump] (dired-jump) but in other window." t) - -(define-key global-map "\C-x\C-j" 'dired-jump) -(define-key global-map "\C-x4\C-j" 'dired-jump-other-window) -@end example - @node Optional Installation File At Point @section Optional Installation File At Point @@ -919,28 +895,6 @@ inserted subdirectories. @table @code -@item dired-jump -@findex dired-jump -@kindex C-x C-j -@cindex jumping to Dired listing containing file. -Bound to @kbd{C-x C-j}. Jump back to Dired: If in a file, edit the current -directory and move to file's line. If in Dired already, pop up a level and -go to old directory's line. In case the proper Dired file line cannot be -found, refresh the Dired buffer and try again. - -@item dired-jump-other-window -@findex dired-jump-other-window -@kindex C-x 4 C-j -Bound to @kbd{C-x 4 C-j}. Like @code{dired-jump}, but to other window. - -These functions can be autoloaded so they work even though @file{dired-x.el} -has not been loaded yet (@pxref{Optional Installation Dired Jump}). - -@vindex dired-bind-jump -If the variable @code{dired-bind-jump} is @code{nil}, @code{dired-jump} will not be -bound to @kbd{C-x C-j} and @code{dired-jump-other-window} will not be bound to -@kbd{C-x 4 C-j}. - @item dired-vm @cindex reading mail. @kindex V diff --git a/etc/NEWS b/etc/NEWS index 69dc261a54..50ba39cb44 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -290,6 +290,19 @@ details of marking the file at the end of the region. *** State changing VC operations are supported in Dired on files and directories with the help of new command 'dired-vc-next-action'. ++++ +*** 'dired-jump' and 'dired-jump-other-window' moved from dired-x to dired. +The 'dired-jump' and 'dired-jump-other-window' commands have been +moved from the 'dired-x' package to 'dired'. The user option +'dired-bind-jump' no longer has any effect and is now obsolete. +The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default. + +To get the old behavior of 'dired-bind-jump' back and unbind the above +keys, add the following to your Init file: + +(global-set-key "\C-x\C-j" nil) +(global-set-key "\C-x4\C-j" nil) + ** Change Logs and VC *** More VC commands can be used from non-file buffers. diff --git a/lisp/bindings.el b/lisp/bindings.el index e3fc5637fa..20342bc40a 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1383,6 +1383,9 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "'" 'expand-abbrev) (define-key ctl-x-map "\C-b" 'list-buffers) +(define-key ctl-x-map "\C-j" 'dired-jump) +(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window) + (define-key ctl-x-map "z" 'repeat) (define-key esc-map "\C-l" 'reposition-window) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 80a266f7dc..b09ef900c1 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -64,21 +64,8 @@ mbox format, and so cannot be distinguished in this way." :type 'boolean :group 'dired-keys) -(defcustom dired-bind-jump t - "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not. -Setting this variable directly after dired-x is loaded has no effect - -use \\[customize]." - :type 'boolean - :set (lambda (sym val) - (if (set sym val) - (progn - (define-key ctl-x-map "\C-j" 'dired-jump) - (define-key ctl-x-4-map "\C-j" 'dired-jump-other-window)) - (if (eq 'dired-jump (lookup-key ctl-x-map "\C-j")) - (define-key ctl-x-map "\C-j" nil)) - (if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j")) - (define-key ctl-x-4-map "\C-j" nil)))) - :group 'dired-keys) +(defvar dired-bind-jump t) +(make-obsolete-variable 'dired-bind-jump "not used." "28.1") (defcustom dired-bind-man t "Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not. @@ -308,7 +295,6 @@ To see the options you can set, use M-x customize-group RET dired-x RET. See also the functions: `dired-flag-extension' `dired-virtual' - `dired-jump' `dired-man' `dired-vm' `dired-rmail' @@ -446,68 +432,7 @@ See variables `dired-texinfo-unclean-extensions', dired-bibtex-unclean-extensions dired-tex-unclean-extensions (list ".dvi")))) - -(defvar archive-superior-buffer) -(defvar tar-superior-buffer) -;;; JUMP. -;;;###autoload -(defun dired-jump (&optional other-window file-name) - "Jump to Dired buffer corresponding to current buffer. -If in a file, Dired the current directory and move to file's line. -If in Dired already, pop up a level and goto old directory's line. -In case the proper Dired file line cannot be found, refresh the dired -buffer and try again. -When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. -When FILE-NAME is non-nil, jump to its line in Dired. -Interactively with prefix argument, read FILE-NAME." - (interactive - (list nil (and current-prefix-arg - (read-file-name "Jump to Dired file: ")))) - (cond - ((and (bound-and-true-p archive-subfile-mode) - (buffer-live-p archive-superior-buffer)) - (switch-to-buffer archive-superior-buffer)) - ((and (bound-and-true-p tar-subfile-mode) - (buffer-live-p tar-superior-buffer)) - (switch-to-buffer tar-superior-buffer)) - (t - ;; Expand file-name before `dired-goto-file' call: - ;; `dired-goto-file' requires its argument to be an absolute - ;; file name; the result of `read-file-name' could be - ;; an abbreviated file name (Bug#24409). - (let* ((file (or (and file-name (expand-file-name file-name)) - buffer-file-name)) - (dir (if file (file-name-directory file) default-directory))) - (if (and (eq major-mode 'dired-mode) (null file-name)) - (progn - (setq dir (dired-current-directory)) - (dired-up-directory other-window) - (unless (dired-goto-file dir) - ;; refresh and try again - (dired-insert-subdir (file-name-directory dir)) - (dired-goto-file dir))) - (if other-window - (dired-other-window dir) - (dired dir)) - (if file - (or (dired-goto-file file) - ;; refresh and try again - (progn - (dired-insert-subdir (file-name-directory file)) - (dired-goto-file file)) - ;; Toggle omitting, if it is on, and try again. - (when dired-omit-mode - (dired-omit-mode) - (dired-goto-file file))))))))) - -;;;###autoload -(defun dired-jump-other-window (&optional file-name) - "Like \\[dired-jump] (`dired-jump') but in other window." - (interactive - (list (and current-prefix-arg - (read-file-name "Jump to Dired file: ")))) - (dired-jump t file-name)) ;;; OMITTING. diff --git a/lisp/dired.el b/lisp/dired.el index 733d83e580..0d7ec2fa87 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4476,6 +4476,70 @@ Ask means pop up a menu for the user to select one of copy, move or link." (add-to-list 'desktop-buffer-mode-handlers '(dired-mode . dired-restore-desktop-buffer)) + +;;;; Jump to Dired + +(defvar archive-superior-buffer) +(defvar tar-superior-buffer) + +;;;###autoload +(defun dired-jump (&optional other-window file-name) + "Jump to Dired buffer corresponding to current buffer. +If in a file, Dired the current directory and move to file's line. +If in Dired already, pop up a level and goto old directory's line. +In case the proper Dired file line cannot be found, refresh the dired +buffer and try again. +When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. +When FILE-NAME is non-nil, jump to its line in Dired. +Interactively with prefix argument, read FILE-NAME." + (interactive + (list nil (and current-prefix-arg + (read-file-name "Jump to Dired file: ")))) + (cond + ((and (bound-and-true-p archive-subfile-mode) + (buffer-live-p archive-superior-buffer)) + (switch-to-buffer archive-superior-buffer)) + ((and (bound-and-true-p tar-subfile-mode) + (buffer-live-p tar-superior-buffer)) + (switch-to-buffer tar-superior-buffer)) + (t + ;; Expand file-name before `dired-goto-file' call: + ;; `dired-goto-file' requires its argument to be an absolute + ;; file name; the result of `read-file-name' could be + ;; an abbreviated file name (Bug#24409). + (let* ((file (or (and file-name (expand-file-name file-name)) + buffer-file-name)) + (dir (if file (file-name-directory file) default-directory))) + (if (and (eq major-mode 'dired-mode) (null file-name)) + (progn + (setq dir (dired-current-directory)) + (dired-up-directory other-window) + (unless (dired-goto-file dir) + ;; refresh and try again + (dired-insert-subdir (file-name-directory dir)) + (dired-goto-file dir))) + (if other-window + (dired-other-window dir) + (dired dir)) + (if file + (or (dired-goto-file file) + ;; refresh and try again + (progn + (dired-insert-subdir (file-name-directory file)) + (dired-goto-file file)) + ;; Toggle omitting, if it is on, and try again. + (when dired-omit-mode + (dired-omit-mode) + (dired-goto-file file))))))))) + +;;;###autoload +(defun dired-jump-other-window (&optional file-name) + "Like \\[dired-jump] (`dired-jump') but in other window." + (interactive + (list (and current-prefix-arg + (read-file-name "Jump to Dired file: ")))) + (dired-jump t file-name)) + (provide 'dired) (run-hooks 'dired-load-hook) ; for your customizations diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 5c6649cba4..cec533ddfa 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -24,11 +24,11 @@ (ert-deftest dired-autoload () "Tests to see whether dired-x has been autoloaded" (should - (fboundp 'dired-jump)) + (fboundp 'dired-do-relsymlink)) (should (autoloadp (symbol-function - 'dired-jump)))) + 'dired-do-relsymlink)))) (ert-deftest dired-test-bug22694 () "Test for https://debbugs.gnu.org/22694 ." commit f5d8cfff5a32361e8d561a66973a7de83f1275f6 Author: Stefan Kangas Date: Fri Sep 11 22:04:24 2020 +0200 Add some eshell completion patterns * lisp/eshell/em-cmpl.el (eshell-command-completions-alist): Add 'gunzip', 'bunzip2' and 'unxz'. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index dcf56af605..8a444c9100 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -116,6 +116,9 @@ is non-nil." (defcustom eshell-command-completions-alist '(("acroread" . "\\.pdf\\'") ("xpdf" . "\\.pdf\\'") + ("gunzip" . "\\.t?gz\\'") + ("bunzip2" . "\\.t?bz2\\'") + ("unxz" . "\\.t?xz\\'") ("ar" . "\\.[ao]\\'") ("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'") ("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'") commit 91a221b27980c795cddd019966205c61b66aa194 Author: Stefan Kangas Date: Fri Aug 14 13:40:29 2020 +0200 Remove cedet items obsolete since 23.2 * lisp/cedet/semantic.el (semantic-toplevel-bovine-table) (semantic-toplevel-bovine-cache) (semantic-before-toplevel-bovination-hook) (semantic-after-toplevel-bovinate-hook, semantic-init-hooks) (semantic-init-mode-hooks, semantic-init-db-hooks) (semantic-bovination-working-type, semantic-bovinate-toplevel) (semantic-bovinate-region-until-error) (semantic-bovinate-from-nonterminal-full): * lisp/cedet/semantic/db-mode.el (semanticdb-mode-hooks): * lisp/cedet/semantic/decorate/mode.el (semantic-decorate-pending-decoration-hooks): * lisp/cedet/semantic/edit.el (semantic-edits-incremental-reparse-failed-hooks): * lisp/cedet/semantic/fw.el (define-mode-overload-implementation): * lisp/cedet/semantic/idle.el (semantic-before-idle-scheduler-reparse-hooks) (semantic-after-idle-scheduler-reparse-hooks): (semantic-eldoc-current-symbol-info) * lisp/cedet/semantic/imenu.el (semantic-imenu-expand-type-parts) (semantic-imenu-bucketize-type-parts) (semantic-imenu-expandable-token): * lisp/cedet/semantic/java.el (semantic-java-prototype-nonterminal): * lisp/cedet/semantic/lex.el (semantic-flex-token-start) (semantic-flex-token-end, semantic-flex-token-text) (semantic-flex-make-keyword-table, semantic-flex-keyword-p) (semantic-flex-keyword-put, semantic-flex-keyword-get) (semantic-flex-map-keywords, semantic-flex-keywords) (semantic-flex-buffer, semantic-flex-list, semantic-flex): * lisp/cedet/semantic/tag-file.el (semantic-find-nonterminal) (semantic-find-dependency): * lisp/cedet/semantic/tag-ls.el (semantic-nonterminal-full-name) (semantic-nonterminal-protection, semantic-nonterminal-abstract) (semantic-nonterminal-leaf): * lisp/cedet/semantic/tag.el (semantic-token-type-parent) (semantic-tag-make-assoc-list, semantic-expand-nonterminal): * lisp/cedet/semantic/util.el (semantic-file-token-stream) (semantic-something-to-stream): * lisp/cedet/semantic/wisent.el (wisent-lex-make-token-table): Delete many items obsolete since Emacs 23.2. * lisp/cedet/semantic.el (semantic--set-buffer-cache) (semantic-fetch-tags): Don't run removed hooks 'semantic-after-toplevel-bovinate-hook' and 'semantic-before-toplevel-bovination-hook'. * lisp/cedet/semantic/bovine/el.el: Remove reference to obsolete variable 'define-mode-overload-implementation'. * lisp/cedet/semantic/doc.el (semantic-doc-snarf-comment-for-tag): Don't bind removed variable 'semantic-ignore-comments'. * lisp/cedet/semantic/fw.el (semantic-overload-symbol-from-function) (semantic-alias-obsolete, semantic-varalias-obsolete): Declare obsolete in favor of standard Emacs 'define-obsolete-*-alias'. * lisp/cedet/semantic/grammar.el (semantic-grammar-ASSOC): Don't use obsolete names. * lisp/cedet/semantic/tag-ls.el (semantic-tag-full-package) (semantic-tag-full-name): Doc fixes. * lisp/cedet/semantic/util.el (semantic-describe-buffer): Don't bind removed variable 'semantic-after-toplevel-bovinate-hook'. * lisp/cedet/semantic/lex.el (semantic-flex-tokens) (semantic-flex-unterminated-syntax-end-function) (semantic-flex-extensions, semantic-flex-syntax-modifications) (semantic-ignore-comments, semantic-flex-enable-newlines) (semantic-flex-enable-whitespace, semantic-flex-enable-bol) (semantic-number-expression, semantic-flex-depth): Make unused variables obsolete. ; * etc/NEWS: List removed items. diff --git a/etc/NEWS b/etc/NEWS index 73d3b7ffad..69dc261a54 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1212,8 +1212,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'completion-base-size', 'completion-common-substring', 'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit', 'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook', -'detect-coding-with-priority', 'dirtrack-debug', -'dirtrack-debug-toggle', 'dynamic-completion-table', +'define-mode-overload-implementation', 'detect-coding-with-priority', +'dirtrack-debug', 'dirtrack-debug-toggle', 'dynamic-completion-table', 'easy-menu-precalculate-equivalent-keybindings', 'epa-display-verify-result', 'epg-passphrase-callback-function', 'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark', @@ -1233,13 +1233,40 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message', 'process-filter-multibyte-p', 'read-file-name-predicate', 'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter', +'semantic-after-idle-scheduler-reparse-hooks', +'semantic-after-toplevel-bovinate-hook', +'semantic-before-idle-scheduler-reparse-hooks', +'semantic-before-toplevel-bovination-hook', +'semantic-bovinate-from-nonterminal-full', +'semantic-bovinate-region-until-error', 'semantic-bovinate-toplevel', +'semantic-bovination-working-type', +'semantic-decorate-pending-decoration-hooks', +'semantic-edits-incremental-reparse-failed-hooks', +'semantic-eldoc-current-symbol-info', 'semantic-expand-nonterminal', +'semantic-file-token-stream', 'semantic-find-dependency', +'semantic-find-nonterminal', 'semantic-flex', 'semantic-flex-buffer', +'semantic-flex-keyword-get', 'semantic-flex-keyword-p', +'semantic-flex-keyword-put', 'semantic-flex-keywords', +'semantic-flex-list', 'semantic-flex-make-keyword-table', +'semantic-flex-map-keywords', 'semantic-flex-token-end', +'semantic-flex-token-start', 'semantic-flex-token-text', +'semantic-imenu-bucketize-type-parts', +'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token', +'semantic-init-db-hooks)', 'semantic-init-hooks', +'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal', +'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name', +'semantic-nonterminal-leaf', 'semantic-nonterminal-protection', +'semantic-something-to-stream', 'semantic-tag-make-assoc-list', +'semantic-token-type-parent', 'semantic-toplevel-bovine-cache', +'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks', 'set-coding-priority', 'set-process-filter-multibyte', 'shadows-compare-text-p', 'shell-dirtrack-toggle', 't-mouse-mode', 'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell', 'url-generate-unique-filename', 'url-temporary-directory', 'vc-arch-command', 'vc-default-working-revision' (variable), 'vc-mtn-command', 'vc-revert-buffer', 'vc-workfile-version', -'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font'. +'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font', +'wisent-lex-make-token-table'. * Lisp Changes in Emacs 28.1 diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 58a35d7d8a..71321e12da 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -82,8 +82,6 @@ introduced." This variable is for internal use only, and its content depends on the external parser used.") (make-variable-buffer-local 'semantic--parse-table) -(semantic-varalias-obsolete 'semantic-toplevel-bovine-table - 'semantic--parse-table "23.2") (defvar semantic-symbol->name-assoc-list '((type . "Types") @@ -112,17 +110,6 @@ in classes, such as protection labels.") "Value for `case-fold-search' when parsing.") (make-variable-buffer-local 'semantic-case-fold) -(defvar semantic-expand-nonterminal nil - "Function to call for each nonterminal production. -Return a list of non-terminals derived from the first argument, or nil -if it does not need to be expanded. -Languages with compound definitions should use this function to expand -from one compound symbol into several. For example, in C the definition - int a, b; -is easily parsed into one tag. This function should take this -compound tag and turn it into two tags, one for A, and the other for B.") -(make-variable-buffer-local 'semantic-expand-nonterminal) - (defvar semantic--buffer-cache nil "A cache of the fully parsed buffer. If no significant changes have been made (based on the state) then @@ -134,8 +121,6 @@ If you need a tag list, use `semantic-fetch-tags'. If you need the cached values for some reason, chances are you can add a hook to `semantic-after-toplevel-cache-change-hook'.") (make-variable-buffer-local 'semantic--buffer-cache) -(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache - 'semantic--buffer-cache "23.2") (defvar semantic-unmatched-syntax-cache nil "A cached copy of unmatched syntax tokens.") @@ -171,18 +156,6 @@ It is called before any request for tags is made via the function `semantic-fetch-tags' by an application. If any hook returns a nil value, the cached value is returned immediately, even if it is empty.") -(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook - 'semantic--before-fetch-tags-hook "23.2") - -(defvar semantic-after-toplevel-bovinate-hook nil - "Hooks run after a toplevel parse. -It is not run if the toplevel parse command is called, and buffer does -not need to be fully reparsed. -For language specific hooks, make sure you define this as a local hook. - -This hook should not be used any more. -Use `semantic-after-toplevel-cache-change-hook' instead.") -(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil "23.2") (defvar semantic-after-toplevel-cache-change-hook nil "Hooks run after the buffer tag list has changed. @@ -305,13 +278,6 @@ This hook is for database functions which intend to swap in a tag table. This guarantees that the DB will go before other modes that require a parse of the buffer.") -(semantic-varalias-obsolete 'semantic-init-hooks - 'semantic-init-hook "23.2") -(semantic-varalias-obsolete 'semantic-init-mode-hooks - 'semantic-init-mode-hook "23.2") -(semantic-varalias-obsolete 'semantic-init-db-hooks - 'semantic-init-db-hook "23.2") - (defsubst semantic-error-if-unparsed () "Raise an error if current buffer was not parsed by Semantic." (unless semantic-new-buffer-fcn-was-run @@ -516,8 +482,6 @@ is requested." (semantic-parse-tree-set-needs-rebuild) ;; Remove this hook which tracks if a buffer is up to date or not. (remove-hook 'after-change-functions 'semantic-change-function t) - ;; Old model. Delete someday. - ;;(run-hooks 'semantic-after-toplevel-bovinate-hook) (run-hook-with-args 'semantic-after-toplevel-cache-change-hook semantic--buffer-cache) @@ -540,17 +504,12 @@ is requested." (setq semantic--completion-cache nil) ;; Refresh the display of unmatched syntax tokens if enabled (run-hook-with-args 'semantic-unmatched-syntax-hook - semantic-unmatched-syntax-cache) - ;; Old Semantic 1.3 hook API. Maybe useful forever? - (run-hooks 'semantic-after-toplevel-bovinate-hook) - ) + semantic-unmatched-syntax-cache)) (defvar semantic-working-type 'percent "The type of working message to use when parsing. 'percent means we are doing a linear parse through the buffer. 'dynamic means we are reparsing specific tags.") -(semantic-varalias-obsolete 'semantic-bovination-working-type - 'semantic-working-type "23.2") (defvar semantic-minimum-working-buffer-size (* 1024 5) "The minimum size of a buffer before working messages are displayed. @@ -585,8 +544,6 @@ was marked unparseable, then do nothing, and return the cache." ;; Is this a semantic enabled buffer? (semantic-active-p) ;; Application hooks say the buffer is safe for parsing - (run-hook-with-args-until-failure - 'semantic-before-toplevel-bovination-hook) (run-hook-with-args-until-failure 'semantic--before-fetch-tags-hook) ;; If the buffer was previously marked unparseable, @@ -690,11 +647,6 @@ Does nothing if the current buffer doesn't need reparsing." ;; Return if we are lexically safe lexically-safe)))) -(defun semantic-bovinate-toplevel (&optional ignored) - "Backward compatibility function." - (semantic-fetch-tags)) -(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags "23.2") - ;; Another approach is to let Emacs call the parser on idle time, when ;; needed, use `semantic-fetch-available-tags' to only retrieve ;; available tags, and setup the `semantic-after-*-hook' hooks to @@ -812,20 +764,6 @@ This function returns semantic tags without overlays." ;; Please move away from these functions, and try using semantic 2.x ;; interfaces instead. ;; -(defsubst semantic-bovinate-region-until-error - (start end nonterm &optional depth) - "NOTE: Use `semantic-parse-region' instead. - -Bovinate between START and END starting with NONTERM. -Optional DEPTH specifies how many levels of parenthesis to enter. -This command will parse until an error is encountered, and return -the list of everything found until that moment. -This is meant for finding variable definitions at the beginning of -code blocks in methods. If `bovine-inner-scope' can also support -commands, use `semantic-bovinate-from-nonterminal-full'." - (semantic-parse-region start end nonterm depth t)) -(make-obsolete 'semantic-bovinate-region-until-error - 'semantic-parse-region "23.2") (defsubst semantic-bovinate-from-nonterminal (start end nonterm &optional depth length) @@ -840,21 +778,6 @@ tokens." (semantic-lex start end (or depth 1) length) nonterm)))) -(defsubst semantic-bovinate-from-nonterminal-full - (start end nonterm &optional depth) - "NOTE: Use `semantic-parse-region' instead. - -Bovinate from within a nonterminal lambda from START to END. -Iterates until all the space between START and END is exhausted. -Argument NONTERM is the nonterminal symbol to start with. -If NONTERM is nil, use `bovine-block-toplevel'. -Optional argument DEPTH is the depth of lists to dive into. -When used in a `lambda' of a MATCH-LIST, there is no need to include -a START and END part." - (semantic-parse-region start end nonterm (or depth 1))) -(make-obsolete 'semantic-bovinate-from-nonterminal-full - 'semantic-parse-region "23.2") - ;;; User interface (defun semantic-force-refresh () diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 656c63b7ee..822ec176a3 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -420,7 +420,6 @@ Return a bovination list to use." :parent (symbol-name (nth 2 form)) :documentation (semantic-elisp-do-doc (nth 4 form)) ))) - define-mode-overload-implementation ;; obsoleted define-mode-local-override ) diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index 0ab03ef49e..16a30b6cfb 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -69,10 +69,6 @@ database, which can be saved for future Emacs sessions." (dolist (elt semanticdb-hooks) (remove-hook (cadr elt) (car elt))))) -(semantic-varalias-obsolete 'semanticdb-mode-hooks - 'global-semanticdb-minor-mode-hook "23.2") - - (defun semanticdb-toggle-global-mode () "Toggle use of the Semantic Database feature. Update the environment of Semantic enabled buffers accordingly." diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 8eb6a3bbd5..293692000d 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -204,9 +204,6 @@ Also make sure old decorations in the area are completely flushed." (defvar semantic-decorate-pending-decoration-hook nil "Normal hook run to perform pending decoration changes.") -(semantic-varalias-obsolete 'semantic-decorate-pending-decoration-hooks - 'semantic-decorate-pending-decoration-hook "23.2") - (defun semantic-decorate-add-pending-decoration (fcn &optional buffer) "Add a pending decoration change represented by FCN. Applies only to the current BUFFER. diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index 8b39e77578..896bc3bb42 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -93,8 +93,7 @@ just the lexical token and not the string." Attempt to strip out comment syntactic sugar. Argument NOSNARF means don't modify the found text. If NOSNARF is `lex', then return the lex token." - (let* ((semantic-ignore-comments nil) - (semantic-lex-analyzer #'semantic-comment-lexer)) + (let* ((semantic-lex-analyzer #'semantic-comment-lexer)) (if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility (car (semantic-lex (point) (1+ (point)))) (let ((ct (semantic-lex-token-text diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index a1225dfeee..e4319c7d1b 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -121,9 +121,6 @@ incremental reparse.") "Hook run after the incremental parser fails. When this happens, the buffer is marked as needing a full reparse.") -(semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks - 'semantic-edits-incremental-reparse-failed-hook "23.2") - (defcustom semantic-edits-verbose-flag nil "Non-nil means the incremental parser is verbose. If nil, errors are still displayed, but informative messages are not." diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index e347c99f19..c86cd3abf3 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -173,6 +173,7 @@ Remove self from `post-command-hook' if it is empty." ;; (defun semantic-overload-symbol-from-function (name) "Return the symbol for overload used by NAME, the defined symbol." + (declare (obsolete define-obsolete-function-alias "28.1")) (let ((sym-name (symbol-name name))) (if (string-match "^semantic-" sym-name) (intern (substring sym-name (match-end 0))) @@ -182,6 +183,7 @@ Remove self from `post-command-hook' if it is empty." "Make OLDFNALIAS an alias for NEWFN. Mark OLDFNALIAS as obsolete, such that the byte compiler will throw a warning when it encounters this symbol." + (declare (obsolete define-obsolete-function-alias "28.1")) (defalias oldfnalias newfn) (make-obsolete oldfnalias newfn when) (when (and (mode-local--function-overload-p newfn) @@ -196,13 +198,14 @@ will throw a warning when it encounters this symbol." "%s: `%s' obsoletes overload `%s'" byte-compile-current-file newfn - (semantic-overload-symbol-from-function oldfnalias)) - )) + (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) + (semantic-overload-symbol-from-function oldfnalias))))) (defun semantic-varalias-obsolete (oldvaralias newvar when) "Make OLDVARALIAS an alias for variable NEWVAR. Mark OLDVARALIAS as obsolete, such that the byte compiler will throw a warning when it encounters this symbol." + (declare (obsolete define-obsolete-variable-alias "28.1")) (make-obsolete-variable oldvaralias newvar when) (condition-case nil (defvaralias oldvaralias newvar) @@ -256,9 +259,6 @@ FUNCTION does not have arguments. When FUNCTION is entered (defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers) -(semantic-alias-obsolete 'define-mode-overload-implementation - 'define-mode-local-override "23.2") - (defun semantic-install-function-overrides (overrides &optional transient) "Install the function OVERRIDES in the specified environment. OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD @@ -396,13 +396,10 @@ into `mode-local-init-hook'." file filename) ;; "define-lex-regex-type-analyzer" ;; "define-lex-string-type-analyzer" ;; "define-lex-block-type-analyzer" -;; ;;"define-mode-overload-implementation" ;; ;;"define-semantic-child-mode" ;; "define-semantic-idle-service" ;; "define-semantic-decoration-style" ;; "define-wisent-lexer" -;; "semantic-alias-obsolete" -;; "semantic-varalias-obsolete" ;; "semantic-make-obsolete-overload" ;; "defcustom-mode-local-semantic-dependency-system-include-path" ;; )) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 6cd4832165..f71ac6c413 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -142,7 +142,7 @@ It ignores whitespaces, newlines and comments." "Return expansion of built-in ASSOC expression. ARGS are ASSOC's key value list." (let ((key t)) - `(semantic-tag-make-assoc-list + `(semantic-tag-make-plist ,@(mapcar #'(lambda (i) (prog1 (if key diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 76218249c5..8301b19530 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -472,11 +472,6 @@ This hook is not protected from lexical errors.") If any hook function throws an error, this variable is reset to nil. This hook is not protected from lexical errors.") -(semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks - 'semantic-before-idle-scheduler-reparse-hook "23.2") -(semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks - 'semantic-after-idle-scheduler-reparse-hook "23.2") - (defun semantic-idle-scheduler-refresh-tags () "Refreshes the current buffer's tags. This is called by `semantic-idle-scheduler-function' to update the @@ -734,10 +729,6 @@ specific to a major mode. For example, in jde mode: (define-overloadable-function semantic-idle-summary-current-symbol-info () "Return a string message describing the current context.") -(make-obsolete-overload 'semantic-eldoc-current-symbol-info - 'semantic-idle-summary-current-symbol-info - "23.2") - (defcustom semantic-idle-summary-mode-hook nil "Hook run at the end of `semantic-idle-summary'." :group 'semantic diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index cdf0a23fa0..25f7fdb842 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -88,8 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-expand-type-members) -(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts - 'semantic-imenu-expand-type-members "23.2") (defcustom semantic-imenu-bucketize-type-members t "Non-nil if members of a type should be grouped into buckets. @@ -98,8 +96,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-bucketize-type-members) -(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts - 'semantic-imenu-bucketize-type-members "23.2") (defcustom semantic-imenu-sort-bucket-function nil "Function to use when sorting tags in the buckets of functions. @@ -145,8 +141,6 @@ Tags of those classes will be given submenu with children. By default, a `type' has interesting children. In Texinfo, however, a `section' has interesting children.") (make-variable-buffer-local 'semantic-imenu-expandable-tag-classes) -(semantic-varalias-obsolete 'semantic-imenu-expandable-token - 'semantic-imenu-expandable-tag-classes "23.2") ;;; Code: (defun semantic-imenu-tag-overlay (tag) diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index 80d03dc629..2aa0ab0e3f 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -253,9 +253,6 @@ Optional argument COLOR indicates that color should be mixed in." 'semantic-format-tag-prototype-default) tag parent color))) -(semantic-alias-obsolete 'semantic-java-prototype-nonterminal - 'semantic-format-tag-prototype-java-mode "23.2") - ;; Include Tag Name ;; diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 500a09d492..3e090c004e 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1751,32 +1751,12 @@ If there is no error, then the last value of FORMS is returned." )) ;;; Compatibility with Semantic 1.x lexical analysis -;; -;; NOTE: DELETE THIS SOMEDAY SOON - -(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start "23.2") -(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end "23.2") -(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text "23.2") -(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table "23.2") -(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p "23.2") -(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put "23.2") -(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get "23.2") -(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords "23.2") -(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords "23.2") -(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer "23.2") -(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list "23.2") - -;; This simple scanner uses the syntax table to generate a stream of -;; simple tokens of the form: -;; -;; (SYMBOL START . END) -;; -;; Where symbol is the type of thing it is. START and END mark that -;; objects boundary. (defvar semantic-flex-tokens semantic-lex-tokens "An alist of semantic token types. See variable `semantic-lex-tokens'.") +(make-obsolete-variable 'semantic-flex-tokens + 'semantic-lex-tokens "28.1") (defvar semantic-flex-unterminated-syntax-end-function (lambda (_syntax _syntax-start flex-end) flex-end) @@ -1788,6 +1768,8 @@ FLEX-END is where the lexical analysis was asked to end. This function can be used for languages that can intelligently fix up broken syntax, or the exit lexical analysis via `throw' or `signal' when finding unterminated syntax.") +(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function + nil "28.1") (defvar semantic-flex-extensions nil "Buffer local extensions to the lexical analyzer. @@ -1799,6 +1781,7 @@ nil is also a valid return value. TYPE can be any type of symbol, as long as it doesn't occur as a nonterminal in the language definition.") (make-variable-buffer-local 'semantic-flex-extensions) +(make-obsolete-variable 'semantic-flex-extensions nil "28.1") (defvar semantic-flex-syntax-modifications nil "Changes to the syntax table for this buffer. @@ -1809,237 +1792,47 @@ CHAR is the char passed to `modify-syntax-entry', and CLASS is the string also passed to `modify-syntax-entry' to define what syntax class CHAR has.") (make-variable-buffer-local 'semantic-flex-syntax-modifications) +(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1") (defvar semantic-ignore-comments t "Default comment handling. The value t means to strip comments when flexing; nil means to keep comments as part of the token stream.") (make-variable-buffer-local 'semantic-ignore-comments) +(make-obsolete-variable 'semantic-ignore-comments nil "28.1") (defvar semantic-flex-enable-newlines nil "When flexing, report newlines as syntactic elements. Useful for languages where the newline is a special case terminator. Only set this on a per mode basis, not globally.") (make-variable-buffer-local 'semantic-flex-enable-newlines) +(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1") (defvar semantic-flex-enable-whitespace nil "When flexing, report whitespace as syntactic elements. Useful for languages where the syntax is whitespace dependent. Only set this on a per mode basis, not globally.") (make-variable-buffer-local 'semantic-flex-enable-whitespace) +(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1") (defvar semantic-flex-enable-bol nil "When flexing, report beginning of lines as syntactic elements. Useful for languages like python which are indentation sensitive. Only set this on a per mode basis, not globally.") (make-variable-buffer-local 'semantic-flex-enable-bol) +(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1") (defvar semantic-number-expression semantic-lex-number-expression "See variable `semantic-lex-number-expression'.") (make-variable-buffer-local 'semantic-number-expression) +(make-obsolete-variable 'semantic-number-expression + 'semantic-lex-number-expression "28.1") (defvar semantic-flex-depth 0 "Default flexing depth. This specifies how many lists to create tokens in.") (make-variable-buffer-local 'semantic-flex-depth) - -(defun semantic-flex (start end &optional depth length) - "Using the syntax table, do something roughly equivalent to flex. -Semantically check between START and END. Optional argument DEPTH -indicates at what level to scan over entire lists. -The return value is a token stream. Each element is a list, such of -the form (symbol start-expression . end-expression) where SYMBOL -denotes the token type. -See `semantic-flex-tokens' variable for details on token types. -END does not mark the end of the text scanned, only the end of the -beginning of text scanned. Thus, if a string extends past END, the -end of the return token will be larger than END. To truly restrict -scanning, use `narrow-to-region'. -The last argument, LENGTH specifies that `semantic-flex' should only -return LENGTH tokens." - (declare (obsolete define-lex "23.2")) - (if (not semantic-flex-keywords-obarray) - (setq semantic-flex-keywords-obarray [ nil ])) - (let ((ts nil) - (pos (point)) - (ep nil) - (curdepth 0) - (cs (if comment-start-skip - (concat "\\(\\s<\\|" comment-start-skip "\\)") - (concat "\\(\\s<\\)"))) - (newsyntax (copy-syntax-table (syntax-table))) - (mods semantic-flex-syntax-modifications) - ;; Use the default depth if it is not specified. - (depth (or depth semantic-flex-depth))) - ;; Update the syntax table - (while mods - (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax) - (setq mods (cdr mods))) - (with-syntax-table newsyntax - (goto-char start) - (while (and (< (point) end) (or (not length) (<= (length ts) length))) - (cond - ;; catch beginning of lines when needed. - ;; Must be done before catching any other tokens! - ((and semantic-flex-enable-bol - (bolp) - ;; Just insert a (bol N . N) token in the token stream, - ;; without moving the point. N is the point at the - ;; beginning of line. - (setq ts (cons (cons 'bol (cons (point) (point))) ts)) - nil)) ;; CONTINUE - ;; special extensions, includes whitespace, nl, etc. - ((and semantic-flex-extensions - (let ((fe semantic-flex-extensions) - (r nil)) - (while fe - (if (looking-at (car (car fe))) - (setq ts (cons (funcall (cdr (car fe))) ts) - r t - fe nil - ep (point))) - (setq fe (cdr fe))) - (if (and r (not (car ts))) (setq ts (cdr ts))) - r))) - ;; catch newlines when needed - ((looking-at "\\s-*\\(\n\\|\\s>\\)") - (if semantic-flex-enable-newlines - (setq ep (match-end 1) - ts (cons (cons 'newline - (cons (match-beginning 1) ep)) - ts)))) - ;; catch whitespace when needed - ((looking-at "\\s-+") - (if semantic-flex-enable-whitespace - ;; Language wants whitespaces, link them together. - (if (eq (car (car ts)) 'whitespace) - (setcdr (cdr (car ts)) (match-end 0)) - (setq ts (cons (cons 'whitespace - (cons (match-beginning 0) - (match-end 0))) - ts))))) - ;; numbers - ((and semantic-number-expression - (looking-at semantic-number-expression)) - (setq ts (cons (cons 'number - (cons (match-beginning 0) - (match-end 0))) - ts))) - ;; symbols - ((looking-at "\\(\\sw\\|\\s_\\)+") - (setq ts (cons (cons - ;; Get info on if this is a keyword or not - (or (semantic-lex-keyword-p (match-string 0)) - 'symbol) - (cons (match-beginning 0) (match-end 0))) - ts))) - ;; Character quoting characters (ie, \n as newline) - ((looking-at "\\s\\+") - (setq ts (cons (cons 'charquote - (cons (match-beginning 0) (match-end 0))) - ts))) - ;; Open parens, or semantic-lists. - ((looking-at "\\s(") - (if (or (not depth) (< curdepth depth)) - (progn - (setq curdepth (1+ curdepth)) - (setq ts (cons (cons 'open-paren - (cons (match-beginning 0) (match-end 0))) - ts))) - (setq ts (cons - (cons 'semantic-list - (cons (match-beginning 0) - (save-excursion - (condition-case nil - (forward-list 1) - ;; This case makes flex robust - ;; to broken lists. - (error - (goto-char - (funcall - semantic-flex-unterminated-syntax-end-function - 'semantic-list - start end)))) - (setq ep (point))))) - ts)))) - ;; Close parens - ((looking-at "\\s)") - (setq ts (cons (cons 'close-paren - (cons (match-beginning 0) (match-end 0))) - ts)) - (setq curdepth (1- curdepth))) - ;; String initiators - ((looking-at "\\s\"") - ;; Zing to the end of this string. - (setq ts (cons (cons 'string - (cons (match-beginning 0) - (save-excursion - (condition-case nil - (forward-sexp 1) - ;; This case makes flex - ;; robust to broken strings. - (error - (goto-char - (funcall - semantic-flex-unterminated-syntax-end-function - 'string - start end)))) - (setq ep (point))))) - ts))) - ;; comments - ((looking-at cs) - (if (and semantic-ignore-comments - (not semantic-flex-enable-whitespace)) - ;; If the language doesn't deal with comments nor - ;; whitespaces, ignore them here. - (let ((comment-start-point (point))) - (forward-comment 1) - (if (eq (point) comment-start-point) - ;; In this case our start-skip string failed - ;; to work properly. Lets try and move over - ;; whatever white space we matched to begin - ;; with. - (skip-syntax-forward "-.'" (point-at-eol)) - ;;(forward-comment 1) - ;; Generate newline token if enabled - (if (and semantic-flex-enable-newlines - (bolp)) - (backward-char 1))) - (if (eq (point) comment-start-point) - (error "Strange comment syntax prevents lexical analysis")) - (setq ep (point))) - (let ((tk (if semantic-ignore-comments 'whitespace 'comment))) - (save-excursion - (forward-comment 1) - ;; Generate newline token if enabled - (if (and semantic-flex-enable-newlines - (bolp)) - (backward-char 1)) - (setq ep (point))) - ;; Language wants comments or want them as whitespaces, - ;; link them together. - (if (eq (car (car ts)) tk) - (setcdr (cdr (car ts)) ep) - (setq ts (cons (cons tk (cons (match-beginning 0) ep)) - ts)))))) - ;; punctuation - ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)") - (setq ts (cons (cons 'punctuation - (cons (match-beginning 0) (match-end 0))) - ts))) - ;; unknown token - (t - (error "What is that?"))) - (goto-char (or ep (match-end 0))) - (setq ep nil))) - ;; maybe catch the last beginning of line when needed - (and semantic-flex-enable-bol - (= (point) end) - (bolp) - (setq ts (cons (cons 'bol (cons (point) (point))) ts))) - (goto-char pos) - ;;(message "Flexing muscles...done") - (nreverse ts))) +(make-obsolete-variable 'semantic-flex-depth nil "28.1") (provide 'semantic/lex) diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index 50d43fe934..23f4b29cbd 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -101,9 +101,6 @@ PARENT can also be a `semanticdb-table' object." ) ) -(make-obsolete-overload 'semantic-find-nonterminal - 'semantic-go-to-tag "23.2") - ;;; Dependencies ;; ;; A tag which is of type 'include specifies a dependency. @@ -175,9 +172,6 @@ Depends on `semantic-dependency-include-path' for searching. Always searches nil) ))) -(make-obsolete-overload 'semantic-find-dependency - 'semantic-dependency-tag-file "23.2") - ;;; PROTOTYPE FILE ;; ;; In C, a function in the .c file often has a representation in a @@ -199,13 +193,6 @@ file prototypes belong in." (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t) (match-string 1)))))) -(semantic-alias-obsolete 'semantic-find-nonterminal - 'semantic-go-to-tag "23.2") - -(semantic-alias-obsolete 'semantic-find-dependency - 'semantic-dependency-tag-file "23.2") - - (provide 'semantic/tag-file) ;; Local variables: diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 16179a53cd..3ee11df7d8 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -190,7 +190,7 @@ See `semantic-tag-similar-p' for details." ;; will contain the info needed to determine the full name. (define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer) "Return the fully qualified package name of TAG in a package hierarchy. -STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', +STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table', but must be a toplevel semantic tag stream that contains TAG. A Package Hierarchy is defined in UML by the way classes and methods are organized on disk. Some languages use this concept such that a @@ -213,7 +213,7 @@ Return the name of the first tag of class `package' in STREAM." (define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer) "Return the fully qualified name of TAG in the package hierarchy. -STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', +STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table', but must be a toplevel semantic tag stream that contains TAG. A Package Hierarchy is defined in UML by the way classes and methods are organized on disk. Some languages use this concept such that a @@ -233,9 +233,6 @@ resolve issues where a method in a class in a package is present." (or stream-or-buffer tag)))) (:override-with-args (tag stream)))) -(make-obsolete-overload 'semantic-nonterminal-full-name - 'semantic-tag-full-name "23.2") - (defun semantic-tag-full-name-default (tag stream) "Default method for `semantic-tag-full-name'. Return the name of TAG found in the toplevel STREAM." @@ -287,9 +284,6 @@ is to return a symbol based on type modifiers." (setq parent (semantic-tag-calculate-parent tag))) (:override)) -(make-obsolete-overload 'semantic-nonterminal-protection - 'semantic-tag-protection "23.2") - (defun semantic-tag-protection-default (tag &optional parent) "Return the protection of TAG as a child of PARENT default action. See `semantic-tag-protection'." @@ -377,9 +371,6 @@ in how methods are overridden. In UML, abstract methods are italicized. The default behavior (if not overridden with `tag-abstract-p' is to return true if `abstract' is in the type modifiers.") -(make-obsolete-overload 'semantic-nonterminal-abstract - 'semantic-tag-abstract-p "23.2") - (defun semantic-tag-abstract-p-default (tag &optional parent) "Return non-nil if TAG is abstract as a child of PARENT default action. See `semantic-tag-abstract-p'." @@ -400,9 +391,6 @@ In UML, leaf methods and classes have special meaning and behavior. The default behavior (if not overridden with `tag-leaf-p' is to return true if `leaf' is in the type modifiers.") -(make-obsolete-overload 'semantic-nonterminal-leaf - 'semantic-tag-leaf-p "23.2") - (defun semantic-tag-leaf-p-default (tag &optional parent) "Return non-nil if TAG is leaf as a child of PARENT default action. See `semantic-tag-leaf-p'." diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index ca5c068d34..e677264c5a 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1328,26 +1328,6 @@ This function is overridable with the symbol `insert-foreign-tag'." (defconst semantic-token-incompatible-version semantic-tag-incompatible-version) -(defsubst semantic-token-type-parent (tag) - "Return the parent of the type that TAG describes. -The return value is a list. A value of nil means no parents. -The `car' of the list is either the parent class, or a list -of parent classes. The `cdr' of the list is the list of -interfaces, or abstract classes which are parents of TAG." - (cons (semantic-tag-get-attribute tag :superclasses) - (semantic-tag-type-interfaces tag))) - -(make-obsolete 'semantic-token-type-parent - "\ -use `semantic-tag-type-superclass' \ -and `semantic-tag-type-interfaces' instead" "23.2") - -(semantic-alias-obsolete 'semantic-tag-make-assoc-list - 'semantic-tag-make-plist "23.2") - -(semantic-varalias-obsolete 'semantic-expand-nonterminal - 'semantic-tag-expand-function "23.2") - (provide 'semantic/tag) ;; Local variables: diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index c64d56b2e2..7df7dfcb75 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -79,9 +79,6 @@ If FILE is not loaded, and semanticdb is not available, find the file (with-current-buffer (find-file-noselect file) (semantic-fetch-tags)))))) -(semantic-alias-obsolete 'semantic-file-token-stream - 'semantic-file-tag-table "23.2") - (declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t) (declare-function semanticdb-refresh-table "semantic/db") (declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t) @@ -137,9 +134,6 @@ buffer, or a filename. If SOMETHING is nil return nil." ;; don't know what it is (t nil))) -(semantic-alias-obsolete 'semantic-something-to-stream - 'semantic-something-to-tag-table "23.2") - ;;; Completion APIs ;; ;; These functions provide minibuffer reading/completion for lists of @@ -307,7 +301,6 @@ If TAG is not specified, use the tag at point." semantic-init-db-hook semantic-unmatched-syntax-hook semantic--before-fetch-tags-hook - semantic-after-toplevel-bovinate-hook semantic-after-toplevel-cache-change-hook semantic-before-toplevel-cache-flush-hook semantic-dump-parse diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index 527a35c9ae..15d1313dfa 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -43,11 +43,6 @@ "Extra lookahead token. When non-nil it is directly returned by `wisent-lex-function'.") -;; Maintain this alias for compatibility until all WY grammars have -;; been translated again to Elisp code. -(semantic-alias-obsolete 'wisent-lex-make-token-table - 'semantic-lex-make-type-table "23.2") - (defmacro wisent-lex-eoi () "Return an End-Of-Input lexical token. The EOI token is like this: ($EOI \"\" POINT-MAX . POINT-MAX)." commit d608eb1c941aac65d0a1d02b0ac6279e42d8ca8b Author: Lars Ingebrigtsen Date: Fri Sep 11 16:45:12 2020 +0200 Guard against faulty flow-filled emails * lisp/mail/flow-fill.el (fill-flowed): Don't bug out if there's a space at the end of the buffer. This is probably not allowed in the flow-fill specification, but has been observed in the wild. diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el index f4b5503119..b357b3e256 100644 --- a/lisp/mail/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -157,7 +157,8 @@ lines." ;; Hack: Don't do the flowing on the signature line. (when (and (not (looking-at "-- $")) (eq (char-before (line-end-position)) ?\s)) - (while (eq (char-before (line-end-position)) ?\s) + (while (and (not (eobp)) + (eq (char-before (line-end-position)) ?\s)) (end-of-line) (when delete-space (delete-char -1)) commit b054393dd1b9146522d8aeb21cb9b1ad52210a33 Author: Alan Mackenzie Date: Fri Sep 11 14:18:43 2020 +0000 CC Mode: Fix minor bugs in the string handling functions These sometimes gave rise to the tail of a buffer being "stringed out". * lixp/progmodes/cc-defs.el (c-will-be-unescaped): New macro. * lisp/progmodes/cc-mode.el (c-before-change-check-unbalanced-strings) (c-after-change-mark-abnormal-strings): Fix bugs in the handling of string fence syntax-table text properties. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 9a3d7adf61..77e263f1aa 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -434,6 +434,15 @@ to it is returned. This function does not modify the point or the mark." (setq count (+ count (skip-chars-backward "\\\\")))) (not (zerop (logand count 1)))))) +(defmacro c-will-be-unescaped (beg end) + ;; Would the character after END be unescaped after the removal of (BEG END)? + ;; This is regardless of its current status. It is assumed that (>= POS END). + `(save-excursion + (let (count) + (goto-char ,beg) + (setq count (skip-chars-backward "\\\\")) + (zerop (logand count 1))))) + (defvar c-use-extents) (defmacro c-next-single-property-change (position prop &optional object limit) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 2ffbde99aa..73275cfa62 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1478,9 +1478,11 @@ Note that the style variables are always made local to the buffer." (c-will-be-escaped end beg end)) (c-remove-string-fences end) (goto-char (1+ end))) - ;; Are we unescaping a newline by inserting stuff between \ and \n? - ((and (eq end beg) - (c-is-escaped end)) + ;; Are we unescaping a newline ... + ((and + (c-is-escaped end) + (or (eq beg end) ; .... by inserting stuff between \ and \n? + (c-will-be-unescaped beg end))) ; ... by removing an odd number of \s? (goto-char (1+ end))) ; To after the NL which is being unescaped. (t (goto-char end))) @@ -1518,10 +1520,11 @@ Note that the style variables are always made local to the buffer." (not (c-characterp c-multiline-string-start-char)))) (when (and (eq end-literal-type 'string) (not (eq (char-before (cdr end-limits)) ?\()) - (memq (char-after (car end-limits)) c-string-delims) - (equal (c-get-char-property (car end-limits) 'syntax-table) - '(15))) - (c-remove-string-fences (car end-limits)) + (memq (char-after (car end-limits)) c-string-delims)) + (setq c-new-END (max c-new-END (cdr end-limits))) + (when (equal (c-get-char-property (car end-limits) 'syntax-table) + '(15)) + (c-remove-string-fences (car end-limits))) (setq c-new-END (max c-new-END (cdr end-limits)))) (when (and (eq beg-literal-type 'string) @@ -1594,8 +1597,12 @@ Note that the style variables are always made local to the buffer." ; insertion/deletion of string delimiters. (max (progn - (goto-char (min (1+ end) ; 1+, in case a NL has become escaped. - (point-max))) + (goto-char + (if (and (memq (char-after end) '(?\n ?\r)) + (c-is-escaped end)) + (min (1+ end) ; 1+, if we're inside an escaped NL. + (point-max)) + end)) (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t) (point)) commit 6dbef93048750a5c5402205b383652a0862562df Author: Eli Zaretskii Date: Fri Sep 11 17:13:44 2020 +0300 Improve help-echo of Undo and Redo menu items * lisp/menu-bar.el (undo-redo, undo): Improve the wording of help-echo strings. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 30d86c7f17..9a93fa60d7 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -540,7 +540,7 @@ '(menu-item "Redo" undo-redo :enable (and (not buffer-read-only) (undo--last-change-was-undo-p buffer-undo-list)) - :help "Undo last undo")) + :help "Redo last undone edits")) (bindings--define-key menu [undo] '(menu-item "Undo" undo @@ -549,7 +549,7 @@ (if (eq last-command 'undo) (listp pending-undo-list) (consp buffer-undo-list))) - :help "Undo last operation")) + :help "Undo last edits")) menu)) commit bde93182bf07251f66d571d9667a6c21b6af1930 Author: Lars Ingebrigtsen Date: Fri Sep 11 15:36:55 2020 +0200 Tweak previous mailcap patch (for external viewers) * lisp/net/mailcap.el (mailcap-view-mime): Delete contents of the buffer in the external case, too. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index e84fe5f2e0..94cd9e2156 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1138,6 +1138,7 @@ For instance, \"foo.png\" will result in \"image/png\"." (unwind-protect (let ((coding-system-for-write 'binary)) (write-region (point-min) (point-max) file nil 'silent) + (delete-region (point-min) (point-max)) (shell-command (format method file))) (when (file-exists-p file) (delete-file file)))) commit dbd8994e0daafc12153765315acefc3269b55b97 Author: Michael Albinus Date: Fri Sep 11 15:34:33 2020 +0200 D-Bus: Implement other compound types of properties * doc/misc/dbus.texi (Errors and Events): * etc/NEWS: Mention dbus-show-dbus-errors. * lisp/net/dbus.el (dbus-compound-types): New defconst. (dbus): New defgroup. (dbus-show-dbus-errors): New defcustom. (dbus-ignore-errors): Use it. (dbus-set-property): Simplify. (dbus-property-handler): Implement other compound types of properties. * test/lisp/net/dbus-tests.el (dbus--test-register-service) (dbus-test05-register-property): Extend tests. diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 2880b7f743..dcee55de45 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -2031,10 +2031,11 @@ This function returns the member name of the D-Bus object @var{event} is coming from. It is either a signal name or a method name. @end defun -D-Bus errors are not propagated during event handling, because it is -usually not desired. D-Bus errors in events can be made visible by -setting the variable @code{dbus-debug} to @code{t}. They can also be -handled by a hook function. +@vindex dbus-show-dbus-errors +D-Bus error messages are not propagated during event handling, because +it is usually not desired. D-Bus errors in events can be made visible +by setting the user option @code{dbus-show-dbus-errors} to +non-@code{nil}. They can also be handled by a hook function. @defvar dbus-event-error-functions This hook variable keeps a list of functions, which are called when a diff --git a/etc/NEWS b/etc/NEWS index 9d26620295..73d3b7ffad 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -959,14 +959,14 @@ window after starting). This variable defaults to nil. ** Miscellaneous +++ -*** New command 'submit-emacs-patch' +*** New command 'submit-emacs-patch'. This works along the lines of 'report-emacs-bug', but is more geared towards sending a patch to the Emacs issue tracker. +++ *** New minor mode 'button-mode'. This minor mode does nothing else than install 'button-buffer-map' as -a minor mode map (which binds the TAB/S-TAB key bindings to navigate +a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate to buttons), and can be used in any view-mode-like buffer that has buttons in it. @@ -1112,9 +1112,11 @@ type symbols. +++ *** In case of problems, handlers can emit proper D-Bus error messages now. ---- ++++ *** D-Bus errors, which have been converted from incoming D-Bus error -messages, contain the error name of that message now. +messages, contain the error name of that message now. They can be +made visible by setting user variable 'dbus-show-dbus-errors' to +non-nil, even if protected by 'dbus-ignore-errors' otherwise. * New Modes and Packages in Emacs 28.1 diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index b0151200ff..fddd6df963 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -55,6 +55,9 @@ ;;; D-Bus constants. +(defconst dbus-compound-types '(:array :variant :struct :dict-entry) + "D-Bus compound types, represented as list.") + (defconst dbus-service-dbus "org.freedesktop.DBus" "The bus name used to talk to the bus itself.") @@ -151,6 +154,17 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter ;;; Default D-Bus errors. +(defgroup dbus nil + "Elisp bindings for D-Bus." + :group 'comm + :link '(custom-manual "(dbus)Top") + :version "28.1") + +(defcustom dbus-show-dbus-errors nil + "Propagate incoming D-Bus error messages." + :version "28.1" + :type 'boolean) + (defconst dbus-error-dbus "org.freedesktop.DBus.Error" "The namespace for default error names. See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") @@ -183,6 +197,7 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.") ;;; Emacs defaults. + (defconst dbus-service-emacs "org.gnu.Emacs" "The well known service name of Emacs.") @@ -199,11 +214,17 @@ shall be subdirectories of this path.") (defmacro dbus-ignore-errors (&rest body) "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. -Otherwise, return result of last form in BODY, or all other errors." +Signals also D-Bus error when `dbus-show-dbus-errors' is non-nil +and a D-Bus error message has arrived. Otherwise, return result +of last form in BODY, or all other errors." (declare (indent 0) (debug t)) `(condition-case err (progn ,@body) - (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) + (dbus-error + (when (or dbus-debug + (and dbus-show-dbus-errors + (= dbus-message-type-error (nth 2 last-input-event)))) + (signal (car err) (cdr err)))))) (defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors) "Functions to be called when a D-Bus error happens in the event handler. @@ -1454,8 +1475,9 @@ valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read." (defun dbus-set-property (bus service path interface property &rest args) "Set value of PROPERTY of INTERFACE to VALUE. It will be checked at BUS, SERVICE, PATH. VALUE can be preceded -by a TYPE symbol. When the value is successfully set return -VALUE. Otherwise, return nil. +by a TYPE symbol. When the value is successfully set, and the +property's access type is not `:write', return VALUE. Otherwise, +return nil. \(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)" (dbus-ignore-errors @@ -1463,11 +1485,9 @@ VALUE. Otherwise, return nil. (dbus-call-method bus service path dbus-interface-properties "Set" :timeout 500 interface property (list :variant args)) - ;; Return VALUE. The property could have the `:write' access type, - ;; so we ignore errors in `dbus-get-property'. - (dbus-ignore-errors - (or (dbus-get-property bus service path interface property) - (if (symbolp (car args)) (cadr args) (car args)))))) + ;; Return VALUE. + (or (dbus-get-property bus service path interface property) + (if (symbolp (car args)) (cadr args) (car args))))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. @@ -1635,11 +1655,11 @@ It will be registered for all objects created by `dbus-register-property'." "Property \"%s\" at path \"%s\" is not readable" property path))) ;; Return the result. Since variant is a list, we must embed ;; it into another list. - (t (list (if (eq :array (car (nth 3 object))) + (t (list (if (memq (car (nth 3 object)) dbus-compound-types) (list :variant (nth 3 object)) (cons :variant (nth 3 object)))))))) - ;; "Set" expects the same type as registered. + ;; "Set" expects the same type as registered. FIXME: Implement! ((string-equal method "Set") (let* ((value (caar (nth 2 args))) (entry (dbus-get-this-registered-property @@ -1694,7 +1714,7 @@ It will be registered for all objects created by `dbus-register-property'." (push (list :dict-entry (car (last key)) - (if (eq :array (car (nth 3 object))) + (if (memq (car (nth 3 object)) dbus-compound-types) (list :variant (nth 3 object)) (cons :variant (nth 3 object)))) result)))))) @@ -1909,8 +1929,8 @@ this connection to those buses." ;;; TODO: -;; Support other compound properties but array. - +;; * Check property type in org.freedesktop.DBus.Properties.Set. +;; ;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and ;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved. ;; diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index a8e052efbe..73401a8c92 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -25,6 +25,8 @@ (defvar dbus-debug nil) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) +(setq dbus-show-dbus-errors nil) + (defconst dbus--test-enabled-session-bus (and (featurep 'dbusbind) (dbus-ignore-errors (dbus-get-unique-name :session))) @@ -109,8 +111,16 @@ (should-not (member dbus--test-service (dbus-list-known-names bus))) ;; `dbus-service-dbus' is reserved for the BUS itself. - (should-error (dbus-register-service bus dbus-service-dbus)) - (should-error (dbus-unregister-service bus dbus-service-dbus))) + (should + (equal + (butlast + (should-error (dbus-register-service bus dbus-service-dbus))) + `(dbus-error ,dbus-error-invalid-args))) + (should + (equal + (butlast + (should-error (dbus-unregister-service bus dbus-service-dbus))) + `(dbus-error ,dbus-error-invalid-args)))) (ert-deftest dbus-test02-register-service-session () "Check service registration at `:session' bus." @@ -258,13 +268,8 @@ This includes initialization and closing the bus." (unwind-protect (let ((property1 "Property1") (property2 "Property2") - (property3 "Property3")) - - ;; Not registered property. - (should-not - (dbus-get-property - :session dbus--test-service dbus--test-path - dbus--test-interface property1)) + (property3 "Property3") + (property4 "Property4")) ;; `:read' property. (should @@ -280,10 +285,22 @@ This includes initialization and closing the bus." :session dbus--test-service dbus--test-path dbus--test-interface property1) "foo")) - (should-not ;; Due to `:read' access type. + ;; Due to `:read' access type, we don't get a proper reply + ;; from `dbus-set-property'. + (should-not (dbus-set-property :session dbus--test-service dbus--test-path dbus--test-interface property1 "foofoo")) + (let ((dbus-show-dbus-errors t)) + (should + (equal + ;; We don't care the error message text. + (butlast + (should-error + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property1 "foofoo"))) + `(dbus-error ,dbus-error-property-read-only)))) (should (string-equal (dbus-get-property @@ -299,10 +316,22 @@ This includes initialization and closing the bus." dbus--test-interface property2 :write "bar") `((:property :session ,dbus--test-interface ,property2) (,dbus--test-service ,dbus--test-path)))) - (should-not ;; Due to `:write' access type. + ;; Due to `:write' access type, we don't get a proper reply + ;; from `dbus-get-property'. + (should-not (dbus-get-property :session dbus--test-service dbus--test-path dbus--test-interface property2)) + (let ((dbus-show-dbus-errors t)) + (should + (equal + ;; We don't care the error message text. + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property2))) + `(dbus-error ,dbus-error-access-denied)))) (should (string-equal (dbus-set-property @@ -341,6 +370,36 @@ This includes initialization and closing the bus." dbus--test-interface property3) "/baz/baz")) + ;; Not registered property. + (should-not + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4)) + (let ((dbus-show-dbus-errors t)) + (should + (equal + ;; We don't care the error message text. + (butlast + (should-error + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4))) + `(dbus-error ,dbus-error-unknown-property)))) + (should-not + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4 "foobarbaz")) + (let ((dbus-show-dbus-errors t)) + (should + (equal + ;; We don't care the error message text. + (butlast + (should-error + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface property4 "foobarbaz"))) + `(dbus-error ,dbus-error-unknown-property)))) + ;; `dbus-get-all-properties'. We cannot retrieve a value for ;; the property with `:write' access type. (let ((result commit 2862f6b2bf92c9469132283fd9d2abb72c1ae45e Author: Lars Ingebrigtsen Date: Fri Sep 11 14:52:25 2020 +0200 Fix up eldef shortening of the minibuffer * lisp/minibuf-eldef.el (minibuffer-default--in-prompt-regexps): Don't include the ": " bit in the portion to be replaced (bug#12443). diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index a32d21abb3..6cd858093c 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -48,7 +48,7 @@ (regexp-quote (substring minibuffer-default-prompt-format (match-end 0)))) (regexp-quote minibuffer-default-prompt-format)) - ": *\\)") + "\\): ") 1) `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'" 1 ,(if minibuffer-eldef-shorten-default " [\\2]")) commit 8d9133c6027512738f313d3342b7b6e9dc68ddd0 Author: Lars Ingebrigtsen Date: Fri Sep 11 14:26:15 2020 +0200 Improve diff-no-select doc string * lisp/vc/diff.el (diff-no-select): Improve the doc string somewhat. diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 2ed8573c07..edb231cf60 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -146,12 +146,15 @@ Possible values are: (defun diff-no-select (old new &optional switches no-async buf) ;; Noninteractive helper for creating and reverting diff buffers "Compare the OLD and NEW file/buffer. +If the optional SWITCHES is nil, the switches specified in the +variable ‘diff-switches’ are passed to the diff command, +otherwise SWITCHES is used. -If BUF is nil, the \"*Diff*\" buffer will be used as the diff -buffer. If non-nil, BUF will be used as the diff buffer. The -buffer used will be returned by this value. +If NO-ASYNC is non-nil, call diff synchronously. -See `diff' for the meaning of the SWITCHES and NO-ASYNC arguments." +By default, this function creates the diff in the \"*Diff*\" +buffer. If BUF is non-nil, BUF is used instead. This function +returns the buffer used." (unless (bufferp new) (setq new (expand-file-name new))) (unless (bufferp old) (setq old (expand-file-name old))) (or switches (setq switches diff-switches)) ; If not specified, use default. commit a34a80a878f37832cc5e59f2c26ea1779eca5cf8 Author: Lars Ingebrigtsen Date: Fri Sep 11 14:06:02 2020 +0200 Fix viewing PDFs from eww with external viewers * lisp/net/mailcap.el (mailcap-view-mime): Most MIME viewers can't take input on stdin (and in any case, "-" is not how many of them designate stdin) (bug#43318). So rewrite to put the data on a file and feed the file name to the viewer. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index f01a5deb7e..e84fe5f2e0 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1133,11 +1133,14 @@ For instance, \"foo.png\" will result in \"image/png\"." `mailcap--computed-mime-data' determines the method to use." (let ((method (mailcap-mime-info type))) (if (stringp method) - (shell-command-on-region (point-min) (point-max) - ;; Use stdin as the "%s". - (format method "-") - (current-buffer) - t) + (let ((file (make-temp-file "emacs-mailcap" nil + (cadr (split-string type "/"))))) + (unwind-protect + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) file nil 'silent) + (shell-command (format method file))) + (when (file-exists-p file) + (delete-file file)))) (funcall method)))) (provide 'mailcap) commit c0eee8cb2c1d2131520449d93d9327e3492e1144 Author: Mattias Engdegård Date: Fri Sep 11 13:11:43 2020 +0200 Calc: regularise test names * test/lisp/calc/calc-tests.el (calc-remove-units, calc-extract-units) (calc-convert-units, calc-bug-23889, calc-trig, calc-format-radix) (calc-calendar, calc-solve-linear-system): Use a uniform naming convention (calc- prefix) to simplify test running. diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index c8cb97a8bc..0909756468 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -63,22 +63,16 @@ An existing calc stack is reused, otherwise a new one is created." (calc-top-n 1)) (calc-pop 0))) -;; (ert-deftest test-math-bignum () -;; ;; bug#17556 -;; (let ((n (math-bignum most-negative-fixnum))) -;; (should (math-negp n)) -;; (should (cl-notany #'cl-minusp (cdr n))))) - -(ert-deftest test-calc-remove-units () +(ert-deftest calc-remove-units () (should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m") -1))) -(ert-deftest test-calc-extract-units () +(ert-deftest calc-extract-units () (should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m") '(var m var-m))) (should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm") '(* (float 1 -2) (^ (var m var-m) 2))))) -(ert-deftest test-calc-convert-units () +(ert-deftest calc-convert-units () ;; Used to ask for `(The expression is unitless when simplified) Old Units: '. (should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" nil "cm") '(* -100 (var cm var-cm)))) @@ -94,7 +88,7 @@ An existing calc stack is reused, otherwise a new one is created." (let ((var-i (calcFunc-sqrt -1))) (should (math-imaginary-i)))) -(ert-deftest test-calc-23889 () +(ert-deftest calc-bug-23889 () "Test for https://debbugs.gnu.org/23889 and 25652." (skip-unless t) ;; (>= math-bignum-digit-length 9)) (dolist (mode '(deg rad)) @@ -139,7 +133,7 @@ An existing calc stack is reused, otherwise a new one is created." (nth 1 (calcFunc-cos 1))) 0 4)))))) -(ert-deftest calc-test-trig () +(ert-deftest calc-trig () "Trigonometric simplification; bug#33052." (let ((calc-angle-mode 'rad)) (let ((calc-symbolic-mode t)) @@ -169,7 +163,7 @@ An existing calc stack is reused, otherwise a new one is created." (should (equal (math-simplify '(calcFunc-cot (/ (var pi var-pi) 3))) '(calcFunc-cot (/ (var pi var-pi) 3))))))) -(ert-deftest calc-test-format-radix () +(ert-deftest calc-format-radix () "Test integer formatting (bug#36689)." (let ((calc-group-digits nil)) (let ((calc-number-radix 10)) @@ -194,7 +188,7 @@ An existing calc stack is reused, otherwise a new one is created." (let ((calc-number-radix 36)) (should (equal (math-format-number 12345678901) "36#5,O6A,QT1"))))) -(ert-deftest calc-test-calendar () +(ert-deftest calc-calendar () "Test calendar conversions (bug#36822)." (should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692)) (should (equal (math-parse-date "2019-07-27") '(date 737267))) @@ -216,7 +210,7 @@ An existing calc stack is reused, otherwise a new one is created." (should (equal (math-absolute-from-julian-dt -101 3 1) -36832)) (should (equal (math-absolute-from-julian-dt -4713 1 1) -1721425))) -(ert-deftest calc-test-solve-linear-system () +(ert-deftest calc-solve-linear-system () "Test linear system solving (bug#35374)." ;; x + y = 3 ;; 2x - 3y = -4 commit 891bbec2e09986f6ef562f2172cd349e9f55cbe8 Author: Mattias Engdegård Date: Fri Sep 11 13:02:59 2020 +0200 Simplify big integer constants in Calc * lisp/calc/calc-comb.el (math-small-factorial-table): * lisp/calc/calc-funcs.el (math-bernoulli-b-cache): * lisp/calc/calc.el (math-2-word-size, math-half-2-word-size): No need for math-read-number-simple. diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index c5d4d0837e..2efeb7f0f2 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -292,15 +292,9 @@ (defconst math-small-factorial-table (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 - (math-read-number-simple "479001600") - (math-read-number-simple "6227020800") - (math-read-number-simple "87178291200") - (math-read-number-simple "1307674368000") - (math-read-number-simple "20922789888000") - (math-read-number-simple "355687428096000") - (math-read-number-simple "6402373705728000") - (math-read-number-simple "121645100408832000") - (math-read-number-simple "2432902008176640000"))) + 479001600 6227020800 87178291200 1307674368000 20922789888000 + 355687428096000 6402373705728000 121645100408832000 + 2432902008176640000)) (defun calcFunc-fact (n) ; [I I] [F F] [Public] (let (temp) diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index add39b6f8b..14f5e32108 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -816,25 +816,25 @@ (list (list 'frac -174611 - (math-read-number-simple "802857662698291200000")) + 802857662698291200000) (list 'frac 43867 - (math-read-number-simple "5109094217170944000")) + 5109094217170944000) (list 'frac -3617 - (math-read-number-simple "10670622842880000")) + 10670622842880000) (list 'frac 1 - (math-read-number-simple "74724249600")) + 74724249600) (list 'frac -691 - (math-read-number-simple "1307674368000")) + 1307674368000) (list 'frac 1 - (math-read-number-simple "47900160")) + 47900160) (list 'frac -1 - (math-read-number-simple "1209600")) + 1209600) (list 'frac 1 30240) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 90789a69cd..bf8b006d7c 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -3452,12 +3452,10 @@ See Info node `(calc)Defining Functions'." (defun calc-clear-unread-commands () (setq unread-command-events nil)) -(defcalcmodevar math-2-word-size - (math-read-number-simple "4294967296") +(defcalcmodevar math-2-word-size 4294967296 "Two to the power of `calc-word-size'.") -(defcalcmodevar math-half-2-word-size - (math-read-number-simple "2147483648") +(defcalcmodevar math-half-2-word-size 2147483648 "One-half of two to the power of `calc-word-size'.") (when calc-always-load-extensions commit b5fe4474804104f383b21b4dcb091d14adc9b610 Author: Mattias Engdegård Date: Fri Sep 11 12:54:00 2020 +0200 Fix calc tests when running noninteractively This error was introduced in 8e1376a39125c3ffc0484077b502444d853eca79. * lisp/calc/calc.el (calc--header-line): Prevent size from being negative. diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 9b95bc149a..90789a69cd 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1399,7 +1399,7 @@ border of the two cases." ;; fudge for trail is: -3 (added to len-long) ;; (width ) for trail (factor (if (> width (+ len-long fudge)) len-long len-short)) - (size (/ (- width factor) 2)) + (size (max (/ (- width factor) 2) 0)) (fill (make-string size ?-)) (pre (replace-regexp-in-string ".$" " " fill)) (post (replace-regexp-in-string "^." " " fill)))