commit 90b6ba0a1697c07a668be1776f22246470682724 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Fri Mar 27 14:17:44 2020 -0700 Use ATTRIBUTE_CONST for some bignum functions * src/bignum.h (mpz_get_d_rounded): * src/lisp.h (bignum_to_double, bignum_to_intmax) (bignum_to_uintmax, bignum_bufsize): Declare as ATTRIBUTE_CONST. diff --git a/src/bignum.h b/src/bignum.h index 0c2541a9dc..ad9021f15f 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -55,7 +55,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT) ARG_NONNULL ((1, 2)); extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) ARG_NONNULL ((1, 2)); -extern double mpz_get_d_rounded (mpz_t const); +extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST; INLINE_HEADER_BEGIN diff --git a/src/lisp.h b/src/lisp.h index d3b1c39c8f..f223814d8f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -585,7 +585,7 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); /* Defined in bignum.c. */ -extern double bignum_to_double (Lisp_Object); +extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST; extern Lisp_Object make_bigint (intmax_t); extern Lisp_Object make_biguint (uintmax_t); @@ -3484,9 +3484,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) /* Defined in bignum.c. This part of bignum.c's API does not require the caller to access bignum internals; see bignum.h for that. */ -extern intmax_t bignum_to_intmax (Lisp_Object); -extern uintmax_t bignum_to_uintmax (Lisp_Object); -extern ptrdiff_t bignum_bufsize (Lisp_Object, int); +extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST; +extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST; +extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST; extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); commit 09d67716e5492306c0bf704e6538d22a5bc76405 Author: Stefan Monnier Date: Fri Mar 27 17:14:34 2020 -0400 * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Declare the type immediately diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 954731b06b..7f5d197b53 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2868,7 +2868,9 @@ Supported keywords for slots are: (append pred-form '(t)) `(and ,pred-form t))) forms) - (push `(put ',name 'cl-deftype-satisfies ',predicate) forms)) + (push `(eval-and-compile + (put ',name 'cl-deftype-satisfies ',predicate)) + forms)) (let ((pos 0) (descp descs)) (while descp (let* ((desc (pop descp)) @@ -3138,6 +3140,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." ;; "Obvious" mappings. (string . stringp) (list . listp) + (cons . consp) (symbol . symbolp) (function . functionp) (integer . integerp) commit 3fdb53b13ac06af91763410925ca71158bcff6da Author: Stefan Monnier Date: Fri Mar 27 16:38:52 2020 -0400 * lisp/gnus/gnus-registry.el: Use lexical-binding (gnus-registry-install-shortcuts): Use a closure (with dynamic :documentation) (gnus-registry-user-format-function-M): Use define-obsolete-function-alias. (gnus-registry-article-marks-to-names): η-reduce. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index fd2b44f742..480ed80ef8 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1,4 +1,4 @@ -;;; gnus-registry.el --- article registry for Gnus +;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. @@ -62,10 +62,10 @@ ;; show the marks as single characters (see the :char property in ;; `gnus-registry-marks'): -;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) +;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) ;; show the marks by name (see `gnus-registry-marks'): -;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) +;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names) ;; TODO: @@ -588,7 +588,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." subject (< gnus-registry-minimum-subject-length (length subject))) (let ((groups (apply - 'append + #'append (mapcar (lambda (reference) (gnus-registry-get-id-key reference 'group)) @@ -615,7 +615,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." sender gnus-registry-unfollowed-addresses))) (let ((groups (apply - 'append + #'append (mapcar (lambda (reference) (gnus-registry-get-id-key reference 'group)) @@ -644,7 +644,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (not (gnus-grep-in-list recp gnus-registry-unfollowed-addresses))) - (let ((groups (apply 'append + (let ((groups (apply #'append (mapcar (lambda (reference) (gnus-registry-get-id-key reference 'group)) @@ -663,7 +663,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; filter the found groups and return them ;; the found groups are NOT the full groups (setq found (gnus-registry-post-process-groups - "recipients" (mapconcat 'identity recipients ", ") found))) + "recipients" (mapconcat #'identity recipients ", ") found))) ;; after the (cond) we extract the actual value safely (car-safe found))) @@ -791,7 +791,8 @@ Consults `gnus-registry-ignored-groups' and ((stringp g) g) ((and (listp g) (nth 1 g)) (nth 0 g)) - (t nil))) gnus-registry-ignored-groups))) + (t nil))) + gnus-registry-ignored-groups))) ;; only use `gnus-parameter-registry-ignore' if ;; `gnus-registry-ignored-groups' is a list of lists ;; (it can be a list of regexes) @@ -871,7 +872,7 @@ Addresses without a name will say \"noname\"." (defun gnus-registry-sort-addresses (&rest addresses) "Return a normalized and sorted list of ADDRESSES." - (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp)) + (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp)) (defun gnus-registry-simplify-subject (subject) (if (stringp subject) @@ -961,16 +962,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (intern (format function-format variant-name))) (shortcut (format "%c" (if remove (upcase data) data)))) (defalias function-name - ;; If it weren't for the function's docstring, we could - ;; use a closure, with lexical-let :-( - `(lambda (&rest articles) - ,(format - "%s the %s mark over process-marked ARTICLES." - (upcase-initials variant-name) - mark) - (interactive - (gnus-summary-work-articles current-prefix-arg)) - (gnus-registry--set/remove-mark ',mark ',remove articles))) + (lambda (&rest articles) + (:documentation + (format + "%s the %s mark over process-marked ARTICLES." + (upcase-initials variant-name) + mark)) + (interactive + (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry--set/remove-mark mark remove articles))) (push function-name keys-plist) (push shortcut keys-plist) (push (vector (format "%s %s" @@ -990,14 +990,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install." nil (cons "Registry Marks" gnus-registry-misc-menus)))))) -(make-obsolete 'gnus-registry-user-format-function-M - 'gnus-registry-article-marks-to-chars "24.1") ? - -(defalias 'gnus-registry-user-format-function-M - 'gnus-registry-article-marks-to-chars) +(define-obsolete-function-alias 'gnus-registry-user-format-function-M + #'gnus-registry-article-marks-to-chars "24.1") ;; use like this: -;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) +;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) (defun gnus-registry-article-marks-to-chars (headers) "Show the marks for an article by the :char property." (if gnus-registry-enabled @@ -1013,20 +1010,20 @@ Uses `gnus-registry-marks' to find what shortcuts to install." "")) ;; use like this: -;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) +;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names) (defun gnus-registry-article-marks-to-names (headers) "Show the marks for an article by name." (if gnus-registry-enabled (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) - (mapconcat (lambda (mark) (symbol-name mark)) marks ",")) + (mapconcat #'symbol-name marks ",")) "")) (defun gnus-registry-read-mark () "Read a mark name from the user with completion." (let ((mark (gnus-completing-read "Label" - (mapcar 'symbol-name (mapcar 'car gnus-registry-marks)) + (mapcar #'symbol-name (mapcar #'car gnus-registry-marks)) nil nil nil (symbol-name gnus-registry-default-mark)))) (when (stringp mark) @@ -1050,7 +1047,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install." show-message) "Apply or remove MARK across a list of ARTICLES." (let ((article-id-list - (mapcar 'gnus-registry-fetch-message-id-fast articles))) + (mapcar #'gnus-registry-fetch-message-id-fast articles))) (dolist (id article-id-list) (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark))) (marks (if remove marks (cons mark marks)))) @@ -1173,34 +1170,34 @@ only the last one's marks are returned." (gnus-registry-install-shortcuts) (if (gnus-alive-p) (gnus-registry-load) - (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load))) + (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load))) (defun gnus-registry-install-hooks () "Install the registry hooks." (setq gnus-registry-enabled t) - (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) - (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) - (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) - (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) + (add-hook 'gnus-summary-article-move-hook #'gnus-registry-action) + (add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action) + (add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action) + (add-hook 'nnmail-spool-hook #'gnus-registry-spool-action) - (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) + (add-hook 'gnus-save-newsrc-hook #'gnus-registry-save) - (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) + (add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)) (defun gnus-registry-unload-hook () "Uninstall the registry hooks." - (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) - (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) - (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) - (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) + (remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action) + (remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action) + (remove-hook 'gnus-summary-article-expire-hook #'gnus-registry-action) + (remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action) - (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) + (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save) + (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load) - (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids) + (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids) (setq gnus-registry-enabled nil)) -(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) +(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook) (defun gnus-registry-install-p () "Return non-nil if the registry is enabled (and maybe enable it first). @@ -1234,7 +1231,7 @@ data stored in the registry." (seen-groups (list (gnus-group-group-name)))) (catch 'found - (dolist (group (mapcar 'gnus-simplify-group-name groups)) + (dolist (group (mapcar #'gnus-simplify-group-name groups)) ;; skip over any groups we really don't want to warp to. (unless (or (member group seen-groups) @@ -1270,7 +1267,7 @@ EXTRA is a list of symbols. Valid symbols are those contained in the docs of `gnus-registry-track-extra'. This command is useful when you stop tracking some extra data and now want to purge it from your existing entries." - (interactive (list (mapcar 'intern + (interactive (list (mapcar #'intern (completing-read-multiple "Extra data: " '("subject" "sender" "recipient"))))) commit 6075a7c5ae3fa456cd099946f6e042b57e925263 Author: Stefan Monnier Date: Fri Mar 27 12:54:52 2020 -0400 * lisp/textmodes/tex-mode.el: Replace double-definition hack with an advice (tex-verbatim-environments): Add "Verbatim". (tex--guess-mode): Rename from tex-guess-mode and return the mode rather than calling it. (tex-mode): Replace second definition with an advice. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index f95979e2fc..1b302e34a7 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -224,7 +224,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on." :group 'tex-view) ;;;###autoload -(defcustom tex-default-mode 'latex-mode +(defcustom tex-default-mode #'latex-mode "Mode to enter for a new file that might be either TeX or LaTeX. This variable is used when it can't be determined whether the file is plain TeX or LaTeX or what because the file contains no commands. @@ -668,7 +668,9 @@ An alternative value is \" . \", if you use a font with a narrow period." "Default expressions to highlight in TeX modes.") (defvar tex-verbatim-environments - '("verbatim" "verbatim*")) + '("verbatim" "verbatim*" + "Verbatim" ;; From "fancyvrb" + )) (put 'tex-verbatim-environments 'safe-local-variable (lambda (x) (not (memq nil (mapcar #'stringp x))))) @@ -966,7 +968,7 @@ Inherits `shell-mode-map' with a few additions.") ;; This would be a lot simpler if we just used a regexp search, ;; but then it would be too slow. -(defun tex-guess-mode () +(defun tex--guess-mode () (let ((mode tex-default-mode) slash comment) (save-excursion (goto-char (point-min)) @@ -983,52 +985,40 @@ Inherits `shell-mode-map' with a few additions.") (regexp-opt '("documentstyle" "documentclass" "begin" "subsection" "section" "part" "chapter" "newcommand" - "renewcommand" "RequirePackage") 'words) + "renewcommand" "RequirePackage") + 'words) "\\|NeedsTeXFormat{LaTeX"))) (if (and (looking-at "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}") ;; SliTeX is almost never used any more nowadays. (tex-executable-exists-p slitex-run-command)) - 'slitex-mode - 'latex-mode) - 'plain-tex-mode)))) - (funcall mode))) + #'slitex-mode + #'latex-mode) + #'plain-tex-mode)))) + mode)) ;; `tex-mode' plays two roles: it's the parent of several sub-modes ;; but it's also the function that chooses between those submodes. ;; To tell the difference between those two cases where the function ;; might be called, we check `delay-mode-hooks'. -(define-derived-mode tex-mode text-mode "generic-TeX" - (tex-common-initialization)) -;; We now move the function and define it again. This gives a warning -;; in the byte-compiler :-( but it's difficult to avoid because -;; `define-derived-mode' will necessarily define the function once -;; and we need to define it a second time for `autoload' to get the -;; proper docstring. -(defalias 'tex-mode-internal (symbol-function 'tex-mode)) - -;; Suppress the byte-compiler warning about multiple definitions. -;; This is a) ugly, and b) cheating, but this was the last -;; remaining warning from byte-compiling all of Emacs... -(eval-when-compile - (if (boundp 'byte-compile-function-environment) - (setq byte-compile-function-environment - (delq (assq 'tex-mode byte-compile-function-environment) - byte-compile-function-environment)))) - ;;;###autoload -(defun tex-mode () +(define-derived-mode tex-mode text-mode "generic-TeX" "Major mode for editing files of input for TeX, LaTeX, or SliTeX. +This is the shared parent mode of several submodes. Tries to determine (by looking at the beginning of the file) whether this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', -`latex-mode', or `slitex-mode', respectively. If it cannot be determined, +`latex-mode', or `slitex-mode', accordingly. If it cannot be determined, such as if there are no commands in the file, the value of `tex-default-mode' says which mode to use." - (interactive) - (if delay-mode-hooks - ;; We're called from one of the children already. - (tex-mode-internal) - (tex-guess-mode))) + (tex-common-initialization)) + +(advice-add 'tex-mode :around #'tex--redirect-to-submode) +(defun tex--redirect-to-submode (orig-fun) + "Redirect to one of the submodes when called directly." + (funcall (if delay-mode-hooks + ;; We're called from one of the children already. + orig-fun + (tex--guess-mode)))) ;; The following three autoloaded aliases appear to conflict with ;; AUCTeX. However, even though AUCTeX uses the mixed case variants @@ -1037,6 +1027,10 @@ says which mode to use." ;; AUCTeX to provide a fully functional user-level replacement. So ;; these aliases should remain as they are, in particular since AUCTeX ;; users are likely to use them. +;; Note from Stef: I don't understand the above explanation, the only +;; justification I can find to keep those confusing aliases is for those +;; users who may have files annotated with -*- LaTeX -*- (e.g. because they +;; received them from someone using AUCTeX). ;;;###autoload (defalias 'TeX-mode 'tex-mode) commit 4710f28010e47e613d08ff46b788b6b0c8eb317f Author: Stefan Monnier Date: Fri Mar 27 12:24:19 2020 -0400 * lisp/progmodes/ebrowse.el: Prefer hash-tables to obarrays Remove redundant :group args. Use `defvar-local` and `setq-local` where possible. (ebrowse-some): Use seq-some instead. (ebrowse-every): Use seq-every-p instead. (ebrowse-position): Use seq-position. (ebrowse--tree-table): Rename from `ebrowse--tree-obarray`. Change all users to use a hash-table rather than an obarray. (ebrowse-for-all-trees): Adjust to the table being a hash-table. (ebrowse-tree-table-as-alist): Rename from `ebrowse-tree-obarray-as-alist`. (ebrowse-build-tree-obarray): Rename from `ebrowse-build-tree-obarray`. (ebrowse-tree-mode): Remove redundant setting of `ebrowse--tree-obarray`. (ebrowse-set-tree-indentation, ebrowse-view-file-other-frame) (ebrowse-last-completion-table): Rename from ebrowse-last-completion-obarray. (ebrowse-position): Make it a proper struct. diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index bb78025933..c02703fc59 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -34,6 +34,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) (require 'easymenu) (require 'view) (require 'ebuff-menu) @@ -52,32 +53,27 @@ "List of directories to search for source files in a class tree. Elements should be directory names; nil as an element means to try to find source files relative to the location of the BROWSE file loaded." - :group 'ebrowse :type '(repeat (choice (const :tag "Default" nil) (string :tag "Directory")))) (defcustom ebrowse-view/find-hook nil "Hooks run after finding or viewing a member or class." - :group 'ebrowse :type 'hook) (defcustom ebrowse-not-found-hook nil "Hooks run when finding or viewing a member or class was not successful." - :group 'ebrowse :type 'hook) (defcustom ebrowse-electric-list-mode-hook nil "Hook called by `ebrowse-electric-position-mode'." - :group 'ebrowse :type 'hook) (defcustom ebrowse-max-positions 50 "Number of markers saved on electric position stack." - :group 'ebrowse :type 'integer) @@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded." (defcustom ebrowse-tree-mode-hook nil "Hook run in each new tree buffer." - :group 'ebrowse-tree :type 'hook) (defcustom ebrowse-tree-buffer-name "*Tree*" "The default name of class tree buffers." - :group 'ebrowse-tree :type 'string) (defcustom ebrowse--indentation 4 "The amount by which subclasses are indented in the tree." - :group 'ebrowse-tree :type 'integer) (defcustom ebrowse-source-file-column 40 "The column in which source file names are displayed in the tree." - :group 'ebrowse-tree :type 'integer) (defcustom ebrowse-tree-left-margin 2 "Amount of space left at the left side of the tree display. This space is used to display markers." - :group 'ebrowse-tree :type 'integer) @@ -126,25 +117,21 @@ This space is used to display markers." (defcustom ebrowse-default-declaration-column 25 "The column in which member declarations are displayed in member buffers." - :group 'ebrowse-member :type 'integer) (defcustom ebrowse-default-column-width 25 "The width of the columns in member buffers (short display form)." - :group 'ebrowse-member :type 'integer) (defcustom ebrowse-member-buffer-name "*Members*" "The name of the buffer for member display." - :group 'ebrowse-member :type 'string) (defcustom ebrowse-member-mode-hook nil "Run in each new member buffer." - :group 'ebrowse-member :type 'hook) @@ -156,81 +143,47 @@ This space is used to display markers." (defface ebrowse-tree-mark '((((min-colors 88)) :foreground "red1") (t :foreground "red")) - "Face for the mark character in the Ebrowse tree." - :group 'ebrowse-faces) + "Face for the mark character in the Ebrowse tree.") (defface ebrowse-root-class '((((min-colors 88)) :weight bold :foreground "blue1") (t :weight bold :foreground "blue")) - "Face for root classes in the Ebrowse tree." - :group 'ebrowse-faces) + "Face for root classes in the Ebrowse tree.") (defface ebrowse-file-name '((t :slant italic)) - "Face for filenames in the Ebrowse tree." - :group 'ebrowse-faces) + "Face for filenames in the Ebrowse tree.") (defface ebrowse-default '((t)) - "Face for items in the Ebrowse tree which do not have other faces." - :group 'ebrowse-faces) + "Face for items in the Ebrowse tree which do not have other faces.") (defface ebrowse-member-attribute '((((min-colors 88)) :foreground "red1") (t :foreground "red")) - "Face for member attributes." - :group 'ebrowse-faces) + "Face for member attributes.") (defface ebrowse-member-class '((t :foreground "purple")) - "Face used to display the class title in member buffers." - :group 'ebrowse-faces) + "Face used to display the class title in member buffers.") (defface ebrowse-progress '((((min-colors 88)) :background "blue1") (t :background "blue")) - "Face for progress indicator." - :group 'ebrowse-faces) + "Face for progress indicator.") ;;; Utilities. -(defun ebrowse-some (predicate vector) - "Return true if PREDICATE is true of some element of VECTOR. -If so, return the value returned by PREDICATE." - (let ((length (length vector)) - (i 0) - result) - (while (and (< i length) (not result)) - (setq result (funcall predicate (aref vector i)) - i (1+ i))) - result)) +(define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1") -(defun ebrowse-every (predicate vector) - "Return true if PREDICATE is true of every element of VECTOR." - (let ((length (length vector)) - (i 0) - (result t)) - (while (and (< i length) result) - (setq result (funcall predicate (aref vector i)) - i (1+ i))) - result)) +(define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1") (defun ebrowse-position (item list &optional test) "Return the position of ITEM in LIST or nil if not found. Compare items with `eq' or TEST if specified." - (let ((i 0) found) - (cond (test - (while list - (when (funcall test item (car list)) - (setq found i list nil)) - (setq list (cdr list) i (1+ i)))) - (t - (while list - (when (eq item (car list)) - (setq found i list nil)) - (setq list (cdr list) i (1+ i))))) - found)) + (declare (obsolete seq-position "28.1")) + (seq-position list item (or test #'eql))) (defmacro ebrowse-ignoring-completion-case (&rest body) @@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified." (defmacro ebrowse-for-all-trees (spec &rest body) "For all trees in SPEC, eval BODY." (declare (indent 1) (debug ((sexp form) body))) - (let ((var (make-symbol "var")) - (spec-var (car spec)) + (let ((spec-var (car spec)) (array (cadr spec))) - `(cl-loop for ,var being the symbols of ,array - as ,spec-var = (get ,var 'ebrowse-root) do - (when (vectorp ,spec-var) - ,@body)))) - -;;; Set indentation for macros above. - - + `(maphash (lambda (_k ,spec-var) + (when ,spec-var + (cl-assert (cl-typep ,spec-var 'ebrowse-ts)) + ,@body)) + ,array))) (defsubst ebrowse-set-face (start end face) "Set face of a region START END to FACE." @@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified." Case is ignored in completions. PROMPT is a string to prompt with; normally it ends in a colon and a space. -TABLE is an alist whose elements' cars are strings, or an obarray. -TABLE can also be a function to do the completion itself. +TABLE is a completion table. If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string." @@ -304,6 +252,9 @@ otherwise use the current frame's width." ;;; Structure definitions +;; Note: These use `(:type vector) :named' in order to match the +;; format used in src/BROWSE. + (cl-defstruct (ebrowse-hs (:type vector) :named) "Header structure found at the head of BROWSE files." ;; A version string that is compared against the version number of @@ -457,19 +408,17 @@ members." This must be the same that `ebrowse' uses.") -(defvar ebrowse--last-regexp nil +(defvar-local ebrowse--last-regexp nil "Last regular expression searched for in tree and member buffers. Each tree and member buffer maintains its own search history.") -(make-variable-buffer-local 'ebrowse--last-regexp) - (defconst ebrowse-member-list-accessors - '(ebrowse-ts-member-variables - ebrowse-ts-member-functions - ebrowse-ts-static-variables - ebrowse-ts-static-functions - ebrowse-ts-friends - ebrowse-ts-types) + (list #'ebrowse-ts-member-variables + #'ebrowse-ts-member-functions + #'ebrowse-ts-static-variables + #'ebrowse-ts-static-functions + #'ebrowse-ts-friends + #'ebrowse-ts-types) "List of accessors for member lists. Each element is the symbol of an accessor function. The nth element must be the accessor for the nth member list @@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.") ;;; FIXME: Add more doc strings for the buffer-local variables below. -(defvar ebrowse--tree-obarray nil - "Obarray holding all `ebrowse-ts' structures of a class tree. +(defvar ebrowse--tree-table nil + "Hash-table holding all `ebrowse-ts' structures of a class tree. Buffer-local in Ebrowse buffers.") @@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.") ;;; Operations on `ebrowse-ts' structures (defun ebrowse-files-table (&optional marked-only) - "Return an obarray containing all files mentioned in the current tree. -The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. + "Return a hash table containing all files mentioned in the current tree. +The tree is expected in the buffer-local variable `ebrowse--tree-table'. MARKED-ONLY non-nil means include marked classes only." (let ((files (make-hash-table :test 'equal)) (i -1)) - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (when (or (not marked-only) (ebrowse-ts-mark tree)) (let ((class (ebrowse-ts-class tree))) (when (zerop (% (cl-incf i) 20)) @@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only." (cl-defun ebrowse-marked-classes-p () "Value is non-nil if any class in the current class tree is marked." - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (when (ebrowse-ts-mark tree) (cl-return-from ebrowse-marked-classes-p tree)))) @@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only." (ebrowse-cs-name class))) -(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) +(defun ebrowse-tree-table-as-alist (&optional qualified-names-p) "Return an alist describing all classes in a tree. Each elements in the list has the form (CLASS-NAME . TREE). CLASS-NAME is the name of the class. TREE is the class tree whose root is QUALIFIED-CLASS-NAME. QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. -The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." +The class tree is found in the buffer-local variable `ebrowse--tree-table'." (let (alist) (if qualified-names-p - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (setq alist (cl-acons (ebrowse-qualified-class-name (ebrowse-ts-class tree)) tree alist))) - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (setq alist (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) tree alist)))) @@ -751,7 +700,7 @@ computes this information lazily." with result = nil as search = (pop to-search) while search finally return result - do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) + do (ebrowse-for-all-trees (ti ebrowse--tree-table) (when (memq search (ebrowse-ts-subclasses ti)) (unless (memq ti result) (setq result (nconc result (list ti)))) @@ -875,7 +824,7 @@ NOCONFIRM." "Create a new tree buffer for tree TREE. The tree was loaded from file TAGS-FILE. HEADER is the header structure of the file. -CLASSES is an obarray with a symbol for each class in the tree. +CLASSES is a hash-table with an entry for each class in the tree. POP non-nil means popup the buffer up at the end. Return the buffer created." (let ((name ebrowse-tree-buffer-name)) @@ -883,7 +832,7 @@ Return the buffer created." (ebrowse-tree-mode) (setq ebrowse--tree tree ebrowse--tags-file-name tags-file - ebrowse--tree-obarray classes + ebrowse--tree-table classes ebrowse--header header ebrowse--frozen-flag nil) (ebrowse-redraw-tree) @@ -895,13 +844,13 @@ Return the buffer created." -;;; Operations for member obarrays +;;; Operations for member tables (defun ebrowse-fill-member-table () - "Return an obarray holding all members of all classes in the current tree. + "Return a hash table holding all members of all classes in the current tree. -For each member, a symbol is added to the obarray. Members are -extracted from the buffer-local tree `ebrowse--tree-obarray'. +For each member, a symbol is added to the table. Members are +extracted from the buffer-local tree `ebrowse--tree-table'. Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST MEMBER) where TREE is the tree in which the member is defined, @@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member is found, and MEMBER is a MEMBER structure describing the member. The slot `member-table' of the buffer-local header structure of -type `ebrowse-hs' is set to the resulting obarray." +type `ebrowse-hs' is set to the resulting table." (let ((members (make-hash-table :test 'equal)) (i -1)) (setf (ebrowse-hs-member-table ebrowse--header) nil) (garbage-collect) ;; For all classes... - (ebrowse-for-all-trees (c ebrowse--tree-obarray) + (ebrowse-for-all-trees (c ebrowse--tree-table) (when (zerop (% (cl-incf i) 10)) (ebrowse-show-progress "Preparing member lookup" (zerop i))) (dolist (f ebrowse-member-list-accessors) (dolist (m (funcall f c)) - (let* ((member-name (ebrowse-ms-name m)) - (value (gethash member-name members))) - (push (list c f m) value) - (puthash member-name value members))))) + (push (list c f m) (gethash (ebrowse-ms-name m) members))))) (setf (ebrowse-hs-member-table ebrowse--header) members))) (defun ebrowse-member-table (header) - "Return the member obarray. Build it if it hasn't been set up yet. + "Return the member table. Build it if it hasn't been set up yet. HEADER is the tree header structure of the class tree." (when (null (ebrowse-hs-member-table header)) (cl-loop for buffer in (ebrowse-browser-buffer-list) @@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree." -;;; Operations on TREE obarrays +;;; Operations on TREE tables -(defun ebrowse-build-tree-obarray (tree) +(defun ebrowse-build-tree-table (tree) "Make sure every class in TREE is represented by a unique object. -Build obarray of all classes in TREE." - (let ((classes (make-vector 127 0))) +Build hash table of all classes in TREE." + (let ((classes (make-hash-table :test #'equal))) ;; Add root classes... (cl-loop for root in tree - as sym = - (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) - classes) - do (unless (get sym 'ebrowse-root) - (setf (get sym 'ebrowse-root) root))) + do (let ((name (ebrowse-qualified-class-name + (ebrowse-ts-class root)))) + (unless (gethash name classes) + (setf (gethash name classes) root)))) ;; Process subclasses (ebrowse-insert-supers tree classes) classes)) @@ -962,7 +907,7 @@ Build obarray of all classes in TREE." "Build base class lists in class tree TREE. CLASSES is an obarray used to collect classes. -Helper function for `ebrowse-build-tree-obarray'. Base classes should +Helper function for `ebrowse-build-tree-table'. Base classes should be ordered so that immediate base classes come first, then the base class of the immediate base class and so on. This means that we must construct the base-class list top down with adding each level at the @@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph." as subclasses = (ebrowse-ts-subclasses class) do ;; Make sure every class is represented by a unique object (cl-loop for subclass on subclasses - as sym = (intern - (ebrowse-qualified-class-name - (ebrowse-ts-class (car subclass))) - classes) do - ;; Replace the subclass tree with the one found in - ;; CLASSES if there is already an entry for that class - ;; in it. Otherwise make a new entry. - ;; - ;; CAVEAT: If by some means (e.g., use of the - ;; preprocessor in class declarations, a name is marked - ;; as a subclass of itself on some path, we would end up - ;; in an endless loop. We have to omit subclasses from - ;; the recursion that already have been processed. - (if (get sym 'ebrowse-root) - (setf (car subclass) (get sym 'ebrowse-root)) - (setf (get sym 'ebrowse-root) (car subclass)))) + (let ((name (ebrowse-qualified-class-name + (ebrowse-ts-class (car subclass))))) + ;; Replace the subclass tree with the one found in + ;; CLASSES if there is already an entry for that class + ;; in it. Otherwise make a new entry. + ;; + ;; CAVEAT: If by some means (e.g., use of the + ;; preprocessor in class declarations, a name is marked + ;; as a subclass of itself on some path, we would end up + ;; in an endless loop. We have to omit subclasses from + ;; the recursion that already have been processed. + (if (gethash name classes) + (setf (car subclass) (gethash name classes)) + (setf (gethash name classes) (car subclass))))) ;; Process subclasses (ebrowse-insert-supers subclasses classes))) @@ -1072,20 +1015,17 @@ Tree mode key bindings: (erase-buffer) (message nil)) - (set (make-local-variable 'ebrowse--show-file-names-flag) nil) - (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0)) - (set (make-local-variable 'ebrowse--frozen-flag) nil) + (setq-local ebrowse--show-file-names-flag nil) + (setq-local ebrowse--frozen-flag nil) (setq mode-line-buffer-identification ident) (setq buffer-read-only t) (add-to-invisibility-spec '(ebrowse . t)) - (set (make-local-variable 'revert-buffer-function) - #'ebrowse-revert-tree-buffer-from-file) - (set (make-local-variable 'ebrowse--header) header) - (set (make-local-variable 'ebrowse--tree) tree) - (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name) - (set (make-local-variable 'ebrowse--tree-obarray) - (and tree (ebrowse-build-tree-obarray tree))) - (set (make-local-variable 'ebrowse--frozen-flag) nil) + (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file) + (setq-local ebrowse--header header) + (setq-local ebrowse--tree tree) + (setq-local ebrowse--tags-file-name buffer-file-name) + (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree))) + (setq-local ebrowse--frozen-flag nil) (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t) (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) @@ -1110,18 +1050,18 @@ Tree mode key bindings: (defun ebrowse-remove-class-and-kill-member-buffers (tree class) "Remove from TREE class CLASS. Kill all member buffers still containing a reference to the class." - (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) - ebrowse--tree-obarray))) - (setf tree (delq class tree) - (get sym 'ebrowse-root) nil) - (dolist (root tree) - (setf (ebrowse-ts-subclasses root) - (delq class (ebrowse-ts-subclasses root)) - (ebrowse-ts-base-classes root) nil) - (ebrowse-remove-class-and-kill-member-buffers - (ebrowse-ts-subclasses root) class)) - (ebrowse-kill-member-buffers-displaying class) - tree)) + (setf tree (delq class tree) + (gethash (ebrowse-cs-name (ebrowse-ts-class class)) + ebrowse--tree-table) + nil) + (dolist (root tree) + (setf (ebrowse-ts-subclasses root) + (delq class (ebrowse-ts-subclasses root)) + (ebrowse-ts-base-classes root) nil) + (ebrowse-remove-class-and-kill-member-buffers + (ebrowse-ts-subclasses root) class)) + (ebrowse-kill-member-buffers-displaying class) + tree) (defun ebrowse-remove-class-at-point (forced) @@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes." (defun ebrowse-mark-all-classes (prefix) "Unmark, with PREFIX mark, all classes in the tree." (interactive "P") - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (setf (ebrowse-ts-mark tree) prefix)) (ebrowse-redraw-marks (point-min) (point-max))) @@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames." (defun ebrowse-browser-buffer-list () "Return a list of all tree or member buffers." - (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) + (cl-delete-if-not #'ebrowse-buffer-p (buffer-list))) (defun ebrowse-member-buffer-list () "Return a list of all member buffers." - (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list))) (defun ebrowse-tree-buffer-list () "Return a list of all tree buffers." - (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list))) (defun ebrowse-known-class-trees-buffer-list () @@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." "): ") nil nil ebrowse--indentation)))) (when (cl-plusp width) - (set (make-local-variable 'ebrowse--indentation) width) + (setq-local ebrowse--indentation width) (ebrowse-redraw-tree)))) @@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil." (unless class (setf class (completing-read "Goto class: " - (ebrowse-tree-obarray-as-alist) nil t))) + (ebrowse-tree-table-as-alist) nil t))) (goto-char (point-min)) (widen) (setq ebrowse--last-regexp (concat "\\b" class "\\b")) @@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil." (defun ebrowse-tree-command:show-member-variables (arg) "Display member variables; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg)) (defun ebrowse-tree-command:show-member-functions (&optional arg) "Display member functions; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg)) (defun ebrowse-tree-command:show-static-member-variables (arg) "Display static member variables; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg)) (defun ebrowse-tree-command:show-static-member-functions (arg) "Display static member functions; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg)) (defun ebrowse-tree-command:show-friends (arg) "Display friend functions; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-friends arg)) (defun ebrowse-tree-command:show-types (arg) "Display types defined in a class; with prefix ARG in frozen member buffer." (interactive "P") - (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) + (ebrowse-display-member-buffer #'ebrowse-ts-types arg)) @@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame." (had-a-buf (get-file-buffer file)) (buf-to-view (find-file-noselect file))) (switch-to-buffer-other-frame buf-to-view) - (set (make-local-variable 'ebrowse--frame-configuration) + (setq-local ebrowse--frame-configuration old-frame-configuration) - (set (make-local-variable 'ebrowse--view-exit-action) + (setq-local ebrowse--view-exit-action (and (not had-a-buf) (not (buffer-modified-p buf-to-view)) - 'kill-buffer)) + #'kill-buffer)) (view-mode-enter (cons (selected-window) (cons (selected-window) t)) 'ebrowse-view-exit-fn))) @@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch." (when (memq 'mode-name mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) - (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") + (setq-local Helper-return-blurb "return to buffer editing") (setq truncate-lines t buffer-read-only t)) @@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION." (define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" "Major mode for Ebrowse member buffers." (mapc #'make-local-variable - '(ebrowse--decl-column ;display column - ebrowse--n-columns ;number of short columns - ebrowse--column-width ;width of columns above - ebrowse--show-inherited-flag ;include inherited members? - ebrowse--filters ;public, protected, private + '(ebrowse--n-columns ;number of short columns ebrowse--accessor ;vars, functions, friends ebrowse--displayed-class ;class displayed - ebrowse--long-display-flag ;display with regexps? - ebrowse--source-regexp-flag ;show source regexp? - ebrowse--attributes-flag ;show `virtual' and `inline' ebrowse--member-list ;list of members displayed ebrowse--tree ;the class tree ebrowse--member-mode-strings ;part of mode line ebrowse--tags-file-name ; ebrowse--header - ebrowse--tree-obarray - ebrowse--virtual-display-flag - ebrowse--inline-display-flag - ebrowse--const-display-flag - ebrowse--pure-display-flag + ebrowse--tree-table ebrowse--frozen-flag)) ;buffer not automagically reused - (setq mode-line-buffer-identification - (propertized-buffer-identification "C++ Members") - buffer-read-only t - ebrowse--long-display-flag nil - ebrowse--attributes-flag t - ebrowse--show-inherited-flag t - ebrowse--source-regexp-flag nil - ebrowse--filters [0 1 2] - ebrowse--decl-column ebrowse-default-declaration-column - ebrowse--column-width ebrowse-default-column-width - ebrowse--virtual-display-flag nil - ebrowse--inline-display-flag nil - ebrowse--const-display-flag nil - ebrowse--pure-display-flag nil) + (setq-local + mode-line-buffer-identification + (propertized-buffer-identification "C++ Members") + buffer-read-only t + ebrowse--long-display-flag nil ;display with regexps? + ebrowse--attributes-flag t ;show `virtual' and `inline' + ebrowse--show-inherited-flag t ;include inherited members? + ebrowse--source-regexp-flag nil ;show source regexp? + ebrowse--filters [0 1 2] ;public, protected, private + ebrowse--decl-column ebrowse-default-declaration-column ;display column + ebrowse--column-width ebrowse-default-column-width ;width of columns above + ebrowse--virtual-display-flag nil + ebrowse--inline-display-flag nil + ebrowse--const-display-flag nil + ebrowse--pure-display-flag nil) (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) @@ -2257,10 +2187,10 @@ make one." (ebrowse-create-tree-buffer ebrowse--tree ebrowse--tags-file-name ebrowse--header - ebrowse--tree-obarray + ebrowse--tree-table 'pop)))) (and buf - (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) + (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf)) buf)) @@ -2276,8 +2206,9 @@ make one." (defun ebrowse-cyclic-display-next/previous-member-list (incr) "Switch buffer to INCR'th next/previous list of members." - (let ((index (ebrowse-position ebrowse--accessor - ebrowse-member-list-accessors))) + (let ((index (seq-position ebrowse-member-list-accessors + ebrowse--accessor + #'eql))) (setf ebrowse--accessor (cond ((cl-plusp incr) (or (nth (1+ index) @@ -2306,37 +2237,37 @@ make one." (defun ebrowse-display-function-member-list () "Display the list of member functions." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions)) (defun ebrowse-display-variables-member-list () "Display the list of member variables." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables)) (defun ebrowse-display-static-variables-member-list () "Display the list of static member variables." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables)) (defun ebrowse-display-static-functions-member-list () "Display the list of static member functions." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions)) (defun ebrowse-display-friends-member-list () "Display the list of friends." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends)) (defun ebrowse-display-types-member-list () "Display the list of types." (interactive) - (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) + (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types)) @@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file." "Force buffer redisplay." (interactive) (let ((display-fn (if ebrowse--long-display-flag - 'ebrowse-draw-member-long-fn - 'ebrowse-draw-member-short-fn))) + #'ebrowse-draw-member-long-fn + #'ebrowse-draw-member-short-fn))) (with-silent-modifications (erase-buffer) ;; Show this class @@ -2610,7 +2541,7 @@ the class cursor is on." "Start point for member buffer creation. LIST is the member list to display. STAND-ALONE non-nil means the member buffer is standalone. CLASS is its class." - (let* ((classes ebrowse--tree-obarray) + (let* ((classes ebrowse--tree-table) (tree ebrowse--tree) (tags-file ebrowse--tags-file-name) (header ebrowse--header) @@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class." (setq ebrowse--member-list (funcall list class) ebrowse--displayed-class class ebrowse--accessor list - ebrowse--tree-obarray classes + ebrowse--tree-table classes ebrowse--frozen-flag stand-alone ebrowse--tags-file-name tags-file ebrowse--header header @@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times." (cl-defun ebrowse-move-point-to-member (name &optional count &aux member) - "Set point on member NAME in the member buffer + "Set point on member NAME in the member buffer. COUNT, if specified, says search the COUNT'th member with the same name." (goto-char (point-min)) (widen) @@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use." (class (or (ebrowse-completing-read-value title compl-list initial) (error "Not found")))) (setf ebrowse--displayed-class class - ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + ebrowse--member-list (funcall ebrowse--accessor + ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer))) @@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use." "Switch member buffer to a class read from the minibuffer." (interactive) (ebrowse-switch-member-buffer-to-other-class - "Goto class: " (ebrowse-tree-obarray-as-alist))) + "Goto class: " + ;; FIXME: Why not use the hash-table as-is? + (ebrowse-tree-table-as-alist))) (defun ebrowse-switch-member-buffer-to-base-class (arg) @@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one." (cl-first supers)))) (unless tree (error "Not found")) (setq containing-list (ebrowse-ts-subclasses tree))))) - (setq index (+ inc (ebrowse-position ebrowse--displayed-class - containing-list))) + (setq index (+ inc (seq-position containing-list + ebrowse--displayed-class + #'eql))) (cond ((cl-minusp index) (message "No previous class")) ((null (nth index containing-list)) (message "No next class"))) (setq index (max 0 (min index (1- (length containing-list))))) @@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one." Prefix arg ARG says which class should be displayed. Default is the first derived class." (interactive "P") - (cl-flet ((ebrowse-tree-obarray-as-alist () + (cl-flet ((ebrowse-tree-table-as-alist () (cl-loop for s in (ebrowse-ts-subclasses ebrowse--displayed-class) - collect (cons (ebrowse-cs-name - (ebrowse-ts-class s)) s)))) + collect (cons (ebrowse-cs-name (ebrowse-ts-class s)) + s)))) (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) (error "No derived classes")))) (if (and arg (cl-second subs)) (ebrowse-switch-member-buffer-to-other-class - "Goto derived class: " (ebrowse-tree-obarray-as-alist)) + "Goto derived class: " (ebrowse-tree-table-as-alist)) (setq ebrowse--displayed-class (cl-first subs) ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) @@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)." (switch-to-buffer buffer) (setq ebrowse--displayed-class (cl-first info) ebrowse--accessor (cl-second info) - ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + ebrowse--member-list (funcall ebrowse--accessor + ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer))) (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) @@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer." (_ "unknown")) "\n"))) -(defvar ebrowse-last-completion nil +(defvar-local ebrowse-last-completion nil "Text inserted by the last completion operation.") -(defvar ebrowse-last-completion-start nil +(defvar-local ebrowse-last-completion-start nil "String which was the basis for the last completion operation.") -(defvar ebrowse-last-completion-location nil +(defvar-local ebrowse-last-completion-location nil "Buffer position at which the last completion operation was initiated.") -(defvar ebrowse-last-completion-obarray nil +(defvar-local ebrowse-last-completion-table nil "Member used in last completion operation.") - - -(make-variable-buffer-local 'ebrowse-last-completion-obarray) -(make-variable-buffer-local 'ebrowse-last-completion-location) -(make-variable-buffer-local 'ebrowse-last-completion) -(make-variable-buffer-local 'ebrowse-last-completion-start) - - (defun ebrowse-some-member-table () "Return a hash table containing all members of a tree. @@ -3552,7 +3480,7 @@ use choose a tree." (defun ebrowse-cyclic-successor-in-string-list (string list) "Return the item following STRING in LIST. If STRING is the last element, return the first element as successor." - (or (nth (1+ (ebrowse-position string list 'string=)) list) + (or (nth (1+ (seq-position list string #'string=)) list) (cl-first list))) @@ -3583,7 +3511,7 @@ completion." ;; expansion ended, insert the next expansion. ((eq (point) ebrowse-last-completion-location) (setf list (all-completions ebrowse-last-completion-start - ebrowse-last-completion-obarray) + ebrowse-last-completion-table) completion (ebrowse-cyclic-successor-in-string-list ebrowse-last-completion list)) (cond ((null completion) @@ -3599,7 +3527,7 @@ completion." ;; buffer: Start new completion. (t (let* ((members (ebrowse-some-member-table)) - (completion (cl-first (all-completions pattern members nil)))) + (completion (cl-first (all-completions pattern members)))) (cond ((eq completion t)) ((null completion) (error "Can't find completion for `%s'" pattern)) @@ -3610,7 +3538,7 @@ completion." (setf ebrowse-last-completion-location (point) ebrowse-last-completion-start pattern ebrowse-last-completion completion - ebrowse-last-completion-obarray members)))))))) + ebrowse-last-completion-table members)))))))) ;;; Tags query replace & search @@ -3746,7 +3674,7 @@ looks like a function call to the member." ;;; Structures of this kind are the elements of the position stack. -(cl-defstruct (ebrowse-position (:type vector) :named) +(cl-defstruct (ebrowse-position) file-name ; in which file point ; point in file target ; t if target of a jump @@ -3888,7 +3816,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'." (setq mode-line-format (copy-sequence mode-line-format)) ;; FIXME: Why not set `mode-name' to "Positions"? (setcar (memq 'mode-name mode-line-format) "Positions")) - (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") + (setq-local Helper-return-blurb "return to buffer editing") (setq truncate-lines t buffer-read-only t)) @@ -4101,7 +4029,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS NUMBER-OF-STATIC-VARIABLES:" (let ((classes 0) (member-functions 0) (member-variables 0) (static-functions 0) (static-variables 0)) - (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (ebrowse-for-all-trees (tree ebrowse--tree-table) (cl-incf classes) (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) @@ -4391,10 +4319,4 @@ EVENT is the mouse event." (provide 'ebrowse) - -;; Local variables: -;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) -;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) -;; End: - ;;; ebrowse.el ends here commit f98ee21c0e3d4e00569fdd9f2671fd8394ab8a65 Author: Eli Zaretskii Date: Fri Mar 27 15:43:20 2020 +0300 Port the 'module/async-pipe' test to MS-Windows These changes let the code compile and produce a valid DLL, but the test hangs. It looks like the hang is in Fdelete_process, when it closes one of the descriptors of the pipe process. In addition, this use of the pipe process cannot currently work on MS-Windows, since make-pipe-process doesn't set up the reader thread to read from the Emacs's side of the pipe, so the select emulation doesn't know there's stuff to read from that pipe. * test/data/emacs-module/mod-test.c [WINDOWSNT]: Include windows.h. (ALIGN_STACK) [!__x86_64__]: Define for 32-bit builds. (sleep_for_half_second): New function. (write_to_pipe): Declare return type differently for WINDOWSNT. Call sleep_for_half_second. (Fmod_test_async_pipe) [WINDOWSNT]: Use _beginthread as substitute for pthread_create. (invalid_finalizer): Replace non_ASCII character in a comment. * test/src/emacs-module-tests.el (module/async-pipe): Skip on MS-Windows, as the test fails and then hangs. diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 61733f1ef4..5e3112f447 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -30,8 +30,18 @@ along with GNU Emacs. If not, see . */ #include #include -#include -#include +#ifdef WINDOWSNT +/* Cannot include because of the local header by the same + name, sigh. */ +uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); +# if !defined __x86_64__ +# define ALIGN_STACK __attribute__((force_align_arg_pointer)) +# endif +# include /* for Sleep */ +#else /* !WINDOWSNT */ +# include +# include +#endif #ifdef HAVE_GMP #include @@ -302,7 +312,7 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args, } /* An invalid finalizer: Finalizers are run during garbage collection, - where Lisp code can’t be executed. -module-assertions tests for + where Lisp code can't be executed. -module-assertions tests for this case. */ static emacs_env *current_env; @@ -542,20 +552,39 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs, return env->funcall (env, Flist, 2, list_args); } +static void +sleep_for_half_second (void) +{ + /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */ +#ifdef WINDOWSNT + Sleep (500); +#else + const struct timespec sleep = {0, 500000000}; + if (nanosleep (&sleep, NULL) != 0) + perror ("nanosleep"); +#endif +} + +#ifdef WINDOWSNT +static void ALIGN_STACK +#else static void * +#endif write_to_pipe (void *arg) { /* We sleep a bit to test that writing to a pipe is indeed possible if no environment is active. */ - const struct timespec sleep = {0, 500000000}; - if (nanosleep (&sleep, NULL) != 0) - perror ("nanosleep"); + sleep_for_half_second (); FILE *stream = arg; + /* The string below should be identical to the one we compare with + in emacs-module-tests.el:module/async-pipe. */ if (fputs ("data from thread", stream) < 0) perror ("fputs"); if (fclose (stream) != 0) perror ("close"); +#ifndef WINDOWSNT return NULL; +#endif } static emacs_value @@ -572,12 +601,17 @@ Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args, signal_errno (env, "fdopen"); return NULL; } +#ifdef WINDOWSNT + uintptr_t thd = _beginthread (write_to_pipe, 0, stream); + int error = (thd == (uintptr_t)-1L) ? errno : 0; +#else /* !WINDOWSNT */ pthread_t thread; int error = pthread_create (&thread, NULL, write_to_pipe, stream); +#endif if (error != 0) { - signal_system_error (env, error, "pthread_create"); + signal_system_error (env, error, "thread create"); if (fclose (stream) != 0) perror ("fclose"); return NULL; diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 1f91795e1e..6851b89045 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -426,6 +426,7 @@ See Bug#36226." (ert-deftest module/async-pipe () "Check that writing data from another thread works." + (skip-unless (not (eq system-type 'windows-nt))) ; FIXME! (with-temp-buffer (let ((process (make-pipe-process :name "module/async-pipe" :buffer (current-buffer) @@ -435,6 +436,8 @@ See Bug#36226." (progn (mod-test-async-pipe process) (should (accept-process-output process 1)) + ;; The string below must be identical to what + ;; mod-test.c:write_to_pipe produces. (should (equal (buffer-string) "data from thread"))) (delete-process process))))) commit e4f8098b9e6e1a0b310cb64f73d39d2b0d3d9f2f Author: Michael Albinus Date: Fri Mar 27 11:02:32 2020 +0100 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index aafb208180..49b7fcd8c2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -38,7 +38,7 @@ when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz text shaping support, and 'ftcr' otherwise. You can determine this by checking 'system-configuration-features'. The 'ftcr' backend will still be available when HarfBuzz is supported, but will not be used by -default. We strongly recommend building with HarBuzz support. 'x' is +default. We strongly recommend building with HarBuzz support. 'x' is still a valid backend. --- @@ -64,9 +64,9 @@ It was declared obsolete in Emacs 27.1. * Changes in Emacs 28.1 -** Support for '(box . SIZE)' cursor-type. +** Support for '(box . SIZE)' 'cursor-type'. By default, 'box' cursor always has a filled box shape. But if you -specify cursor-type to be '(box . SIZE)', the cursor becomes a hollow +specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow box if the point is on an image larger than 'SIZE' pixels in any dimension. @@ -97,28 +97,29 @@ shows equivalent key bindings for all commands that have them. * Changes in Specialized Modes and Packages in Emacs 28.1 ** Emacs-Lisp mode + *** The mode-line now indicates whether we're using lexical or dynamic scoping. ** Dired -*** New option 'dired-mark-region' affects all Dired commands that mark files. -When non-nil and the region is active in Transient Mark mode, -then Dired commands operate only on files in the active region. -The values 'file' and 'line' of this option define the details of -marking the file at the end of the region. +*** New user option 'dired-mark-region' affects all Dired commands +that mark files. When non-nil and the region is active in Transient +Mark mode, then Dired commands operate only on files in the active +region. The values 'file' and 'line' of this user option define the +details of marking the file at the end of the region. -*** State changing VC operations are supported in dired-mode on files +*** State changing VC operations are supported in 'dired-mode' on files (but still not on directories). ** Gnus --- -*** Change to default value of 'message-draft-headers' option. -The Date header has been removed from the default value, meaning that -draft or delayed messages will get a Date reflecting when the message -was sent. To restore the original behavior of dating a message -from when it is first saved or delayed, add the symbol 'Date back to -this option. +*** Change to default value of 'message-draft-headers' user option. +The 'Date' symbol has been removed from the default value, meaning that +draft or delayed messages will get a date reflecting when the message +was sent. To restore the original behavior of dating a message +from when it is first saved or delayed, add the symbol 'Date' back to +this user option. ** Help @@ -152,8 +153,8 @@ doc string functions. This makes the results of all doc string functions accessible to the user through the existing single function hook 'eldoc-documentation-function'. -*** 'eldoc-documentation-function' is now a custom variable. -Modes should use the new hook instead of this variable to register +*** 'eldoc-documentation-function' is now a user option. +Modes should use the new hook instead of this user option to register their backends. ** Tramp @@ -175,6 +176,7 @@ effect. *** Pcase 'map' pattern added keyword symbols abbreviation. A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', equivalent to '(map (:sym sym))'. + ** Package +++ @@ -196,22 +198,22 @@ key binding *** gdb-mi can now store and restore window configurations. Use 'gdb-save-window-configuration' to save window configuration to a file and 'gdb-load-window-configuration' to load from a file. These -commands can also be accessed through the menu bar under Gud -- -GDB-Windows. 'gdb-default-window-configuration-file', when non-nil, +commands can also be accessed through the menu bar under 'Gud -- +GDB-Windows'. 'gdb-default-window-configuration-file', when non-nil, is loaded when GDB starts up. +++ *** gdb-mi can now restore window configuration after quit. Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs will remember the window configuration before GDB started and restore -it after GDB quits. A toggle button is also provided under Gud -- -GDB-Windows. +it after GDB quits. A toggle button is also provided under 'Gud -- +GDB-Windows'. ** Gravatar --- *** New user option 'gravatar-service' for host to query for gravatars. -Defaults to Libravatar, with Unicornify and Gravatar as options. +Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. ** Compilation mode @@ -225,11 +227,11 @@ for case-insensitive matching of messages. * Incompatible Editing Changes in Emacs 28.1 -** In nroff mode, 'center-line' is now bound to 'M-o M-s'. +** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'. The original key binding was 'M-s', which interfered with I-search, since the latter uses 'M-s' as a prefix key of the search prefix map. -** vc-print-branch-log shows the change log for BRANCH from its root +** 'vc-print-branch-log' shows the change log for BRANCH from its root directory instead of the default directory. @@ -261,7 +263,7 @@ This is no longer supported, and setting this variable has no effect. * Lisp Changes in Emacs 28.1 -** New macro 'dlet' to dynamically bind variables +** New macro 'dlet' to dynamically bind variables. ** The variable 'force-new-style-backquotes' has been removed. This removes the final remaining trace of old-style backquotes. commit ac242ed3843e127c1e2e506ecfd1a4552a2a8c44 Author: Yuan Fu Date: Fri Mar 27 09:43:49 2020 +0100 Add manual and NEWS entries for previous gdb-mi changes * etc/NEWS: Add entries for saving and restoring GDB window configurations. * doc/emacs/building.texi (GDB User Interface Layout): Add documentation for 'gdb-save-window-configuration', 'gdb-load-window-configuration', 'gdb-default-window-configuration-file', 'gdb-window-configuration-directory', 'gdb-restore-window-configuration-after-quit'. Change 'many-windows layout' to 'default layout'. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 38963f225c..8a05680c74 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -975,9 +975,27 @@ displays the following frame layout: @end group @end smallexample +@findex gdb-save-window-configuration +@findex gdb-load-window-configuration +@vindex gdb-default-window-configuration-file +@vindex gdb-window-configuration-directory + You can customize the window layout based on the one above and save +that layout to a file using @code{gdb-save-window-configuration}. +Then you can later load this layout back using +@code{gdb-load-window-configuration}. (Internally, Emacs uses the +term window configuration instead of window layout.) You can set your +custom layout as the default one used by @code{gdb-many-windows} by +customizing @code{gdb-default-window-configuration-file}. If it is +not an absolute file name, GDB looks under +@code{gdb-window-configuration-directory} for the file. +@code{gdb-window-configuration-directory} defaults to +@code{user-emacs-directory} (@pxref{Find Init}). + + @findex gdb-restore-windows @findex gdb-many-windows - If you ever change the window layout, you can restore the many-windows +@vindex gdb-restore-window-configuration-after-quit + If you ever change the window layout, you can restore the default layout by typing @kbd{M-x gdb-restore-windows}. To toggle between the many windows layout and a simple layout with just the GUD interaction buffer and a source file, type @kbd{M-x gdb-many-windows}. @@ -988,7 +1006,13 @@ interaction buffer and a source file, type @kbd{M-x gdb-many-windows}. of windows on your original frame will not be affected. A separate frame for GDB sessions can come in especially handy if you work on a text-mode terminal, where the screen estate for windows could be at a -premium. +premium. If you choose to start GDB in the same frame, consider +setting @code{gdb-restore-window-configuration-after-quit} to a +non-@code{nil} value. Your original layout will then be restored +after GDB quits. Use @code{t} to always restore; use +@code{if-gdb-many-windows} to restore only when +@code{gdb-many-windows} is non-@code{nil}; use @code{if-gdb-show-main} +to restore only when @code{gdb-show-main} is non-@code{nil}. You may also specify additional GDB-related buffers to display, either in the same frame or a different one. Select the buffers you diff --git a/etc/NEWS b/etc/NEWS index a2cb4b094e..aafb208180 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -190,6 +190,23 @@ key binding / v package-menu-filter-by-version / / package-menu-filter-clear +** gdb-mi + ++++ +*** gdb-mi can now store and restore window configurations. +Use 'gdb-save-window-configuration' to save window configuration to a +file and 'gdb-load-window-configuration' to load from a file. These +commands can also be accessed through the menu bar under Gud -- +GDB-Windows. 'gdb-default-window-configuration-file', when non-nil, +is loaded when GDB starts up. + ++++ +*** gdb-mi can now restore window configuration after quit. +Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs +will remember the window configuration before GDB started and restore +it after GDB quits. A toggle button is also provided under Gud -- +GDB-Windows. + ** Gravatar ---