commit 5e1416fd0a41c4b7d13d3cd6ecedab48ae7b55b5 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Mon Dec 28 07:51:05 2020 +0100 Minor cleanups in tetris.el * lisp/play/tetris.el: Remove redundant :group args. (tetris-get-tick-period): Drop unnecessary check. (tetris): Stylistic doc fixes. diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index e25cacbb72..6e68633831 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. ;; Author: Glynn Clements -;; Version: 2.01 +;; Old-Version: 2.01 ;; Created: 1997-08-13 ;; Keywords: games @@ -39,22 +39,18 @@ (defcustom tetris-use-glyphs t "Non-nil means use glyphs when available." - :group 'tetris :type 'boolean) (defcustom tetris-use-color t "Non-nil means use color when available." - :group 'tetris :type 'boolean) (defcustom tetris-draw-border-with-glyphs t "Non-nil means draw a border even when using glyphs." - :group 'tetris :type 'boolean) (defcustom tetris-default-tick-period 0.3 "The default time taken for a shape to drop one row." - :group 'tetris :type 'number) (defcustom tetris-update-speed-function @@ -65,18 +61,15 @@ SHAPES is the number of shapes which have been dropped. ROWS is the number of rows which have been completed. If the return value is a number, it is used as the timer period." - :group 'tetris :type 'function) (defcustom tetris-mode-hook nil "Hook run upon starting Tetris." - :group 'tetris :type 'hook) (defcustom tetris-tty-colors ["blue" "white" "yellow" "magenta" "cyan" "green" "red"] "Vector of colors of the various shapes in text mode." - :group 'tetris :type '(vector (color :tag "Shape 1") (color :tag "Shape 2") (color :tag "Shape 3") @@ -88,7 +81,6 @@ If the return value is a number, it is used as the timer period." (defcustom tetris-x-colors [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] "Vector of RGB colors of the various shapes." - :group 'tetris :type '(vector (vector :tag "Shape 1" number number number) (vector :tag "Shape 2" number number number) (vector :tag "Shape 3" number number number) @@ -99,37 +91,30 @@ If the return value is a number, it is used as the timer period." (defcustom tetris-buffer-name "*Tetris*" "Name used for Tetris buffer." - :group 'tetris :type 'string) (defcustom tetris-buffer-width 30 "Width of used portion of buffer." - :group 'tetris :type 'number) (defcustom tetris-buffer-height 22 "Height of used portion of buffer." - :group 'tetris :type 'number) (defcustom tetris-width 10 "Width of playing area." - :group 'tetris :type 'number) (defcustom tetris-height 20 "Height of playing area." - :group 'tetris :type 'number) (defcustom tetris-top-left-x 3 "X position of top left of playing area." - :group 'tetris :type 'number) (defcustom tetris-top-left-y 1 "Y position of top left of playing area." - :group 'tetris :type 'number) (defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width) @@ -335,11 +320,10 @@ each one of its four blocks.") options)) (defun tetris-get-tick-period () - (if (boundp 'tetris-update-speed-function) - (let ((period (apply tetris-update-speed-function - tetris-n-shapes - tetris-n-rows nil))) - (and (numberp period) period)))) + (let ((period (apply tetris-update-speed-function + tetris-n-shapes + tetris-n-rows nil))) + (and (numberp period) period))) (defun tetris-get-shape-cell (block) (aref (aref (aref tetris-shapes @@ -646,17 +630,15 @@ rotate the shape to fit in with those at the bottom of the screen so as to form complete rows. tetris-mode keybindings: - \\ -\\[tetris-start-game] Starts a new game of Tetris -\\[tetris-end-game] Terminates the current game -\\[tetris-pause-game] Pauses (or resumes) the current game -\\[tetris-move-left] Moves the shape one square to the left -\\[tetris-move-right] Moves the shape one square to the right -\\[tetris-rotate-prev] Rotates the shape clockwise -\\[tetris-rotate-next] Rotates the shape anticlockwise -\\[tetris-move-bottom] Drops the shape to the bottom of the playing area - -" +\\ +\\[tetris-start-game] Start a new game of Tetris +\\[tetris-end-game] Terminate the current game +\\[tetris-pause-game] Pause (or resume) the current game +\\[tetris-move-left] Move the shape one square to the left +\\[tetris-move-right] Move the shape one square to the right +\\[tetris-rotate-prev] Rotate the shape clockwise +\\[tetris-rotate-next] Rotate the shape anticlockwise +\\[tetris-move-bottom] Drop the shape to the bottom of the playing area" (interactive) (select-window (or (get-buffer-window tetris-buffer-name) commit 9d60ce1762b64a734c0a931eaad4c59605527d3a Author: Stefan Kangas Date: Mon Dec 28 07:47:59 2020 +0100 * lisp/ps-print.el (ps-message-log-max): Remove XEmacs compat code. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 351c489f48..bb4970cdab 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -4114,7 +4114,6 @@ If EXTENSION is any other symbol, it is ignored." (defun ps-message-log-max () (and (not (string= (buffer-name) "*Messages*")) - (boundp 'message-log-max) message-log-max)) commit 62761d423e5b5e5b004ef1ca907ee66935a6f93f Author: Stefan Kangas Date: Mon Dec 28 07:31:44 2020 +0100 Remove redundant 'function's around lambda in vhdl-mode.el * lisp/progmodes/vhdl-mode.el (fboundp, vhdl-sort-alist, lambda) (vhdl-create-mode-menu, vhdl-set-offset, vhdl-set-style) (vhdl-regress-line, vhdl-align-inline-comment-region-1) (vhdl-resolve-paths, vhdl-generate-makefile-1) (vhdl-submit-bug-report): Remove redundant 'function's around lambda. diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 489092f58e..375ac9eb5f 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -2286,7 +2286,7 @@ Ignore byte-compiler warnings you might see." (setq contents (nconc (if (and (car dirs) (not full)) - (mapcar (function (lambda (name) (concat (car dirs) name))) + (mapcar (lambda (name) (concat (car dirs) name)) this-dir-contents) this-dir-contents) contents)))) @@ -2563,7 +2563,7 @@ conversion." (defun vhdl-sort-alist (alist) "Sort ALIST." - (sort alist (function (lambda (a b) (string< (car a) (car b)))))) + (sort alist (lambda (a b) (string< (car a) (car b))))) (defun vhdl-get-subdirs (directory) "Recursively get subdirectories of DIRECTORY." @@ -2941,10 +2941,9 @@ STRING are replaced by `-' and substrings are converted to lower case." ;; set up electric character functions to work with ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) (mapc - (function - (lambda (sym) - (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) - (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs) + (lambda (sym) + (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) + (put sym 'pending-delete t)) ; for `pending-delete-mode' (XEmacs) '(vhdl-electric-space vhdl-electric-tab vhdl-electric-return @@ -3317,7 +3316,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (setq menu-list (if vhdl-project-sort (sort menu-list - (function (lambda (a b) (string< (elt a 0) (elt b 0))))) + (lambda (a b) (string< (elt a 0) (elt b 0)))) (nreverse menu-list))) (vhdl-menu-split menu-list "Project")) '("--" "--" @@ -5566,9 +5565,8 @@ offset for that syntactic element. Optional ADD-P says to add SYMBOL to (if current-prefix-arg " or add" "") ": ") (mapcar - (function - (lambda (langelem) - (cons (format "%s" (car langelem)) nil))) + (lambda (langelem) + (cons (format "%s" (car langelem)) nil)) vhdl-offsets-alist) nil (not current-prefix-arg) ;; initial contents tries to be the last element @@ -5615,26 +5613,24 @@ argument. The styles are chosen from the `vhdl-style-alist' variable." (error "ERROR: Invalid VHDL indentation style `%s'" style)) ;; set all the variables (mapc - (function - (lambda (varentry) - (let ((var (car varentry)) - (val (cdr varentry))) - ;; special case for vhdl-offsets-alist - (if (not (eq var 'vhdl-offsets-alist)) - (set (if local (make-local-variable var) var) val) - ;; reset vhdl-offsets-alist to the default value first - (set (if local (make-local-variable var) var) - (copy-alist vhdl-offsets-alist-default)) - ;; now set the langelems that are different - (mapcar - (function - (lambda (langentry) - (let ((langelem (car langentry)) - (offset (cdr langentry))) - (vhdl-set-offset langelem offset) - ))) - val)) - ))) + (lambda (varentry) + (let ((var (car varentry)) + (val (cdr varentry))) + ;; special case for vhdl-offsets-alist + (if (not (eq var 'vhdl-offsets-alist)) + (set (if local (make-local-variable var) var) val) + ;; reset vhdl-offsets-alist to the default value first + (set (if local (make-local-variable var) var) + (copy-alist vhdl-offsets-alist-default)) + ;; now set the langelems that are different + (mapcar + (lambda (langentry) + (let ((langelem (car langentry)) + (offset (cdr langentry))) + (vhdl-set-offset langelem offset) + )) + val)) + )) vars)) (vhdl-keep-region-active)) @@ -7578,12 +7574,11 @@ ENDPOS is encountered." (expurgated)) ;; remove the library unit symbols (mapc - (function - (lambda (elt) - (if (memq (car elt) '(entity configuration context package - package-body architecture)) - nil - (setq expurgated (append expurgated (list elt)))))) + (lambda (elt) + (if (memq (car elt) '(entity configuration context package + package-body architecture)) + nil + (setq expurgated (append expurgated (list elt))))) actual) (if (and (not arg) expected (listp expected)) (if (not (equal expected expurgated)) @@ -7950,7 +7945,7 @@ the token in MATCH." (push (cons start length) comment-list)) (beginning-of-line 2)) (setq comment-list - (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) + (sort comment-list (lambda (a b) (> (car a) (car b))))) ;; reduce start positions (setq start-list (list (caar comment-list))) (setq comment-list (cdr comment-list)) @@ -15886,8 +15881,7 @@ NO-POSITION non-nil means do not re-position cursor." (setq path-list-1 (append (mapcar - (function - (lambda (var) (concat path-beg var path-end))) + (lambda (var) (concat path-beg var path-end)) (let ((all-list (vhdl-directory-files (match-string 2 dir) t (concat "\\<" (wildcard-to-regexp @@ -17440,8 +17434,8 @@ specified by a target." (setq tmp-list (cdr tmp-list))) (setq rule-alist ; sort by first rule target (sort rule-alist - (function (lambda (a b) - (string< (car (cadr a)) (car (cadr b))))))) + (lambda (a b) + (string< (car (cadr a)) (car (cadr b)))))) ;; open and clear Makefile (set-buffer (find-file-noselect makefile-path-name t t)) (erase-buffer) @@ -17752,16 +17746,15 @@ specified by a target." 'vhdl-word-completion-in-minibuffer 'vhdl-underscore-is-part-of-word 'vhdl-mode-hook) - (function - (lambda () - (insert - (if vhdl-special-indent-hook - (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" - "vhdl-special-indent-hook is set to '" - (format "%s" vhdl-special-indent-hook) - ".\nPerhaps this is your problem?\n" - "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") - "\n")))) + (lambda () + (insert + (if vhdl-special-indent-hook + (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" + "vhdl-special-indent-hook is set to '" + (format "%s" vhdl-special-indent-hook) + ".\nPerhaps this is your problem?\n" + "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") + "\n"))) nil "Hi Reto,")))) commit f4fe4e500d709bef84fd500f41a3dbef62538fe5 Author: Lars Ingebrigtsen Date: Mon Dec 28 06:42:06 2020 +0100 Fix too-long feedmail-sendmail-f-doesnt-sell-me-out doc string * lisp/mail/feedmail.el (feedmail-sendmail-f-doesnt-sell-me-out): Fold the example SMTP header using continuation folding. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 2907093ea7..ce5a57e228 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -628,16 +628,19 @@ address via a command line option, \"-f\". Unfortunately, it also has a widely disliked default behavior of selling you out if you do that by inserting an unattractive warning in the headers. It looks something like this: - X-Authentication-Warning: u1.example.com: niceguy set sender to niceguy@example.com using -f - -It is possible to configure sendmail to not do this, but such a reconfiguration -is not an option for many users. As this is the default behavior of most -sendmail installations, one can mostly only wish it were otherwise. If feedmail -believes the sendmail program will sell you out this way, it won't use the \"-f\" -option when calling sendmail. If it doesn't think sendmail will sell you out, -it will use the \"-f\" \(since it is a handy feature). You control what -feedmail thinks with this variable. The default is nil, meaning that feedmail -will believe that sendmail will sell you out." + X-Authentication-Warning: u1.example.com: niceguy set + sender to niceguy@example.com using -f + +It is possible to configure sendmail to not do this, but such a +reconfiguration is not an option for many users. As this is the +default behavior of most sendmail installations, one can mostly +only wish it were otherwise. If feedmail believes the sendmail +program will sell you out this way, it won't use the \"-f\" +option when calling sendmail. If it doesn't think sendmail will +sell you out, it will use the \"-f\" \(since it is a handy +feature). You control what feedmail thinks with this variable. +The default is nil, meaning that feedmail will believe that +sendmail will sell you out." :version "24.1" :group 'feedmail-headers :type 'boolean commit 6b8bb47ac085700740feaad24a591a8bbec3a71c Author: Stefan Kangas Date: Thu Dec 10 22:36:18 2020 +0100 Fill some auto-generated docstrings * lisp/emacs-lisp/easy-mmode.el (define-minor-mode) (define-globalized-minor-mode): Fill auto-generated documentation strings. (Bug#44858) * lisp/subr.el (internal--fill-string-single-line) (internal--format-docstring-line): New functions. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 6a11f1c394..dee507269b 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -306,11 +306,13 @@ No problems result if this variable is not bound. ;; Use a default docstring. (setq docstring (if (null parent) - ;; FIXME filling. - (format "Major-mode.\nUses keymap `%s'%s%s." map - (if abbrev (format "%s abbrev table `%s'" - (if syntax "," " and") abbrev) "") - (if syntax (format " and syntax-table `%s'" syntax) "")) + (concat + "Major-mode.\n" + (internal--format-docstring-line + "Uses keymap `%s'%s%s." map + (if abbrev (format "%s abbrev table `%s'" + (if syntax "," " and") abbrev) "") + (if syntax (format " and syntax-table `%s'" syntax) ""))) (format "Major mode derived from `%s' by `define-derived-mode'. It inherits all of the parent's attributes, but has its own keymap%s: @@ -336,20 +338,22 @@ which more-or-less shadow%s %s's corresponding table%s." (unless (string-match (regexp-quote (symbol-name hook)) docstring) ;; Make sure the docstring mentions the mode's hook. (setq docstring - (concat docstring - (if (null parent) - "\n\nThis mode " - (concat - "\n\nIn addition to any hooks its parent mode " - (if (string-match (format "[`‘]%s['’]" - (regexp-quote - (symbol-name parent))) - docstring) - nil - (format "`%s' " parent)) - "might have run,\nthis mode ")) - (format "runs the hook `%s'" hook) - ", as the final or penultimate step\nduring initialization."))) + (concat docstring "\n\n" + (internal--format-docstring-line + "%s%s%s" + (if (null parent) + "This mode " + (concat + "In addition to any hooks its parent mode " + (if (string-match (format "[`‘]%s['’]" + (regexp-quote + (symbol-name parent))) + docstring) + nil + (format "`%s' " parent)) + "might have run, this mode ")) + (format "runs the hook `%s'" hook) + ", as the final or penultimate step during initialization.")))) (unless (string-match "\\\\[{[]" docstring) ;; And don't forget to put the mode's keymap. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 261f2508af..1344c3391b 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -278,8 +278,10 @@ For example, you could write ((not globalp) `(progn :autoload-end - (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled. -Use the command `%s' to change this variable." pretty-name mode)) + (defvar ,mode ,init-value + ,(concat (format "Non-nil if %s is enabled.\n" pretty-name) + (internal--format-docstring-line + "Use the command `%s' to change this variable." mode))) (make-variable-buffer-local ',mode))) (t (let ((base-doc-string @@ -455,24 +457,23 @@ on if the hook has explicitly disabled it. (make-variable-buffer-local ',MODE-major-mode)) ;; The actual global minor-mode (define-minor-mode ,global-mode - ;; Very short lines to avoid too long lines in the generated - ;; doc string. - ,(format "Toggle %s in all buffers. -With prefix ARG, enable %s if ARG is positive; -otherwise, disable it. If called from Lisp, enable the mode if -ARG is omitted or nil. - -%s is enabled in all buffers where -`%s' would do it. - -See `%s' for more information on -%s.%s" - pretty-name pretty-global-name - pretty-name turn-on mode pretty-name + ,(concat (format "Toggle %s in all buffers.\n" pretty-name) + (internal--format-docstring-line + "With prefix ARG, enable %s if ARG is positive; otherwise, \ +disable it. If called from Lisp, enable the mode if ARG is omitted or nil.\n\n" + pretty-global-name) + (internal--format-docstring-line + "%s is enabled in all buffers where `%s' would do it.\n\n" + pretty-name turn-on) + (internal--format-docstring-line + "See `%s' for more information on %s." + mode pretty-name) (if predicate - (format "\n\n`%s' is used to control which modes -this minor mode is used in." - MODE-predicate) + (concat + "\n\n" + (internal--format-docstring-line + "`%s' is used to control which modes this minor mode is used in." + MODE-predicate)) "")) :global t ,@group ,@(nreverse extra-keywords) diff --git a/lisp/subr.el b/lisp/subr.el index 725722cbee..384dbb25cf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5973,4 +5973,22 @@ seconds." ;; Continue running. nil))) +(defun internal--fill-string-single-line (str) + "Fill string STR to `fill-column'. +This is intended for very simple filling while bootstrapping +Emacs itself, and does not support all the customization options +of fill.el (for example `fill-region')." + (if (< (string-width str) fill-column) + str + (let ((fst (substring str 0 fill-column)) + (lst (substring str fill-column))) + (if (string-match ".*\\( \\(.+\\)\\)$" fst) + (setq fst (replace-match "\n\\2" nil nil fst 1))) + (concat fst (internal--fill-string-single-line lst))))) + +(defun internal--format-docstring-line (string &rest objects) + "Format a documentation string out of STRING and OBJECTS. +This is intended for internal use only." + (internal--fill-string-single-line (apply #'format string objects))) + ;;; subr.el ends here commit 0ebea8ffbfb7b9b1bd92f30011df0875b54eb663 Author: Stefan Kangas Date: Sun Dec 6 12:44:19 2020 +0100 Make byte-compiler warn about wide docstrings * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): (byte-compile-docstring-length-warn): New defuns. (byte-compile-docstring-max-column): New defcustom. (byte-compile--wide-docstring-substitution-len): New variable. (byte-compile-warning-types, byte-compile-warnings): New value 'docstrings'. (byte-compile-file-form-autoload, byte-compile-file-form-defvar): (byte-compile-file-form-defvar-function, byte-compile-lambda): (byte-compile-defvar, byte-compile-file-form-defalias): Warn about too wide docstrings. (Bug#44858) * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-warn-wide-docstring/defconst) (bytecomp-warn-wide-docstring/defvar): New tests. (bytecomp--define-warning-file-test): New macro. (bytecomp/warn-wide-docstring-autoload\.el) (bytecomp/warn-wide-docstring-custom-declare-variable\.el) (bytecomp/warn-wide-docstring-defalias\.el) (bytecomp/warn-wide-docstring-defconst\.el) (bytecomp/warn-wide-docstring-define-abbrev-table\.el) (bytecomp/warn-wide-docstring-define-obsolete-function-alias\.el) (bytecomp/warn-wide-docstring-define-obsolete-variable-alias\.el) (bytecomp/warn-wide-docstring-defun\.el) (bytecomp/warn-wide-docstring-defvar\.el) (bytecomp/warn-wide-docstring-defvaralias\.el) (bytecomp/warn-wide-docstring-ignore-fill-column\.el) (bytecomp/warn-wide-docstring-ignore-override\.el) (bytecomp/warn-wide-docstring-ignore\.el) (bytecomp/warn-wide-docstring-multiline-first\.el) (bytecomp/warn-wide-docstring-multiline\.el): New tests. * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el: * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el: New files. diff --git a/etc/NEWS b/etc/NEWS index 131931052a..f8282696e4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2200,17 +2200,24 @@ menu handling. +++ ** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. +** Byte compiler + +++ -** New byte-compiler check for missing dynamic variable declarations. +*** New byte-compiler check for missing dynamic variable declarations. It is meant as an (experimental) aid for converting Emacs Lisp code to lexical binding, where dynamic (special) variables bound in one file can affect code in another. For details, see the manual section "(Elisp) Converting to Lexical Binding". +++ -** 'byte-recompile-directory' can now compile symlinked ".el" files. +*** 'byte-recompile-directory' can now compile symlinked ".el" files. This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter. +*** The byte-compiler now warns about too wide documentation strings. +By default, it will warn if a documentation string is wider than the +largest of 80 characters or 'fill-column'. This is controlled by the +new user option 'byte-compile-docstring-max-column'. + --- ** 'unload-feature' now also tries to undo additions to buffer-local hooks. diff --git a/etc/TODO b/etc/TODO index 2a9fd8869e..d7bcfd4d97 100644 --- a/etc/TODO +++ b/etc/TODO @@ -638,8 +638,6 @@ Do this for some or all errors associated with using subprocesses. ** Maybe reinterpret 'parse-error' as a category of errors Put some other errors under it. -** Make byte-compiler warn when a doc string is too wide - ** Make byte-optimization warnings issue accurate line numbers ** Record the sxhash of the default value for customized variables diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7e1a3304cc..f14ad93d2e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -299,7 +299,8 @@ The information is logged to `byte-compile-log-buffer'." (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved obsolete noruntime interactive-only - make-local mapcar constants suspicious lexical lexical-dynamic) + make-local mapcar constants suspicious lexical lexical-dynamic + docstrings) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for all). @@ -322,6 +323,8 @@ Elements of the list may be: make-local calls to make-variable-buffer-local that may be incorrect. mapcar mapcar called for effect. constants let-binding of, or assignment to, constants/nonvariables. + docstrings docstrings that are too wide (longer than 80 characters, + or `fill-column', whichever is bigger) suspicious constructs that usually don't do what the coder wanted. If the list begins with `not', then the remaining elements specify warnings to @@ -1563,6 +1566,81 @@ extra args." (if (equal sig1 '(1 . 1)) "argument" "arguments") (byte-compile-arglist-signature-string sig2))))))) +(defvar byte-compile--wide-docstring-substitution-len 3 + "Substitution width used in `byte-compile--wide-docstring-p'. +This is a heuristic for guessing the width of a documentation +string: `byte-compile--wide-docstring-p' assumes that any +`substitute-command-keys' command substitutions are this long.") + +(defun byte-compile--wide-docstring-p (docstring col) + "Return t if string DOCSTRING is wider than COL. +Ignore all `substitute-command-keys' substitutions, except for +the `\\\\=[command]' ones that are assumed to be of length +`byte-compile--wide-docstring-substitution-len'. Also ignore +URLs." + (string-match + (format "^.\\{%s,\\}$" (int-to-string (1+ col))) + (replace-regexp-in-string + (rx (or + ;; Ignore some URLs. + (seq "http" (? "s") "://" (* anychar)) + ;; Ignore these `substitute-command-keys' substitutions. + (seq "\\" (or "=" + (seq "<" (* (not ">")) ">") + (seq "{" (* (not "}")) "}"))))) + "" + ;; Heuristic: assume these substitutions are of some length N. + (replace-regexp-in-string + (rx "\\" (or (seq "[" (* (not "]")) "]"))) + (make-string byte-compile--wide-docstring-substitution-len ?x) + docstring)))) + +(defcustom byte-compile-docstring-max-column 80 + "Recommended maximum width of doc string lines. +The byte-compiler will emit a warning for documentation strings +containing lines wider than this. If `fill-column' has a larger +value, it will override this variable." + :group 'bytecomp + :type 'integer + :safe #'integerp + :version "28.1") + +(defun byte-compile-docstring-length-warn (form) + "Warn if documentation string of FORM is too wide. +It is too wide if it has any lines longer than the largest of +`fill-column' and `byte-compile-docstring-max-column'." + ;; This has some limitations that it would be nice to fix: + ;; 1. We don't try to handle defuns. It is somewhat tricky to get + ;; it right since `defun' is a macro. Also, some macros + ;; themselves produce defuns (e.g. `define-derived-mode'). + ;; 2. We assume that any `subsititute-command-keys' command replacement has a + ;; given length. We can't reliably do these replacements, since the value + ;; of the keymaps in general can't be known at compile time. + (when (byte-compile-warning-enabled-p 'docstrings) + (let ((col (max byte-compile-docstring-max-column fill-column)) + kind name docs) + (pcase (car form) + ((or 'autoload 'custom-declare-variable 'defalias + 'defconst 'define-abbrev-table + 'defvar 'defvaralias) + (setq kind (nth 0 form)) + (setq name (nth 1 form)) + (setq docs (nth 3 form))) + ;; Here is how one could add lambda's here: + ;; ('lambda + ;; (setq kind "") ; can't be "function", unfortunately + ;; (setq docs (and (stringp (nth 2 form)) + ;; (nth 2 form)))) + ) + (when (and (consp name) (eq (car name) 'quote)) + (setq name (cadr name))) + (setq name (if name (format " `%s'" name) "")) + (when (and kind docs (stringp docs) + (byte-compile--wide-docstring-p docs col)) + (byte-compile-warn "%s%s docstring wider than %s characters" + kind name col)))) + form) + (defun byte-compile-print-syms (str1 strn syms) (when syms (byte-compile-set-symbol-position (car syms) t)) @@ -2410,7 +2488,8 @@ list that represents a doc string reference. (delq (assq funsym byte-compile-unresolved-functions) byte-compile-unresolved-functions))))) (if (stringp (nth 3 form)) - form + (prog1 form + (byte-compile-docstring-length-warn form)) ;; No doc string, so we can compile this as a normal form. (byte-compile-keep-pending form 'byte-compile-normal-call))) @@ -2438,6 +2517,7 @@ list that represents a doc string reference. (if (and (null (cddr form)) ;No `value' provided. (eq (car form) 'defvar)) ;Just a declaration. nil + (byte-compile-docstring-length-warn form) (cond ((consp (nth 2 form)) (setq form (copy-sequence form)) (setcar (cdr (cdr form)) @@ -2461,6 +2541,7 @@ list that represents a doc string reference. (if (byte-compile-warning-enabled-p 'suspicious) (byte-compile-warn "Alias for `%S' should be declared before its referent" newname))))) + (byte-compile-docstring-length-warn form) (byte-compile-keep-pending form)) (put 'custom-declare-variable 'byte-hunk-handler @@ -2844,6 +2925,7 @@ for symbols generated by the byte compiler itself." (unless (eq 'lambda (car-safe fun)) (error "Not a lambda list: %S" fun)) (byte-compile-set-symbol-position 'lambda)) + (byte-compile-docstring-length-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) (arglistvars (byte-compile-arglist-vars arglist)) @@ -4624,6 +4706,7 @@ binding slots have been popped." (byte-compile-warning-enabled-p 'lexical (nth 1 form))) (byte-compile-warn "global/dynamic var `%s' lacks a prefix" (nth 1 form))) + (byte-compile-docstring-length-warn form) (let ((fun (nth 0 form)) (var (nth 1 form)) (value (nth 2 form)) @@ -4698,6 +4781,7 @@ binding slots have been popped." ;; - `arg' is the expression to which it is defined. ;; - `rest' is the rest of the arguments. (`(,_ ',name ,arg . ,rest) + (byte-compile-docstring-length-warn form) (pcase-let* ;; `macro' is non-nil if it defines a macro. ;; `fun' is the function part of `arg' (defaults to `arg'). diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el new file mode 100644 index 0000000000..96deb1bbb0 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(autoload 'foox "foo" + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el new file mode 100644 index 0000000000..2a4700bfda --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t -*- +(custom-declare-variable + 'foo t + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el new file mode 100644 index 0000000000..a4235d22bd --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defalias 'foo #'ignore + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el new file mode 100644 index 0000000000..946f01989a --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defconst foo-bar nil + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el new file mode 100644 index 0000000000..3da9ccd48c --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(define-abbrev-table 'foo () + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el new file mode 100644 index 0000000000..fea841b12e --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(define-obsolete-function-alias 'foo #'ignore "99.1" + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el new file mode 100644 index 0000000000..2d5f201cb6 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(define-obsolete-variable-alias 'foo 'ignore "99.1" + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el new file mode 100644 index 0000000000..94b0e80c97 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defun foo () + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el new file mode 100644 index 0000000000..99aacd09cb --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el @@ -0,0 +1,6 @@ +;;; -*- lexical-binding: t -*- +(defvar foo-bar nil + "multiline +foo +xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +bar") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el new file mode 100644 index 0000000000..52fdc17f5b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el @@ -0,0 +1,3 @@ +;;; -*- lexical-binding: t -*- +(defvaralias 'foo-bar #'ignore + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el new file mode 100644 index 0000000000..1ff554f370 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el @@ -0,0 +1,7 @@ +;;; -*- lexical-binding: t -*- +(defvar foo-bar nil + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") + +;; Local Variables: +;; fill-column: 100 +;; End: diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el new file mode 100644 index 0000000000..0bcf7b1d63 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el @@ -0,0 +1,8 @@ +;;; -*- lexical-binding: t -*- +(defvar foo-bar nil + "123456789012345") + +;; Local Variables: +;; byte-compile-docstring-max-column: 10 +;; fill-column: 20 +;; End: diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el new file mode 100644 index 0000000000..c80ddd180d --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el @@ -0,0 +1,7 @@ +;;; -*- lexical-binding: t -*- +(defvar foo-bar nil + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") + +;; Local Variables: +;; byte-compile-docstring-max-column: 100 +;; End: diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el new file mode 100644 index 0000000000..2563dbbb3b --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el @@ -0,0 +1,5 @@ +;;; -*- lexical-binding: t -*- +(defvar foo-bar nil + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +This is a multiline docstring where the first line is long. +foobar") diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el new file mode 100644 index 0000000000..9ae7bc9b9f --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el @@ -0,0 +1,6 @@ +;;; -*- lexical-binding: t -*- +(defvar foo-bar nil + "This is a multiline docstring. +But it's not the first line that is long. +xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +foobar") diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 4a6e28f7c7..47aab563f6 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -540,6 +540,16 @@ Subtests signal errors if something goes wrong." (bytecomp--with-warning-test "foo.*lacks a prefix" '(defvar foo nil))) +(defvar bytecomp-tests--docstring (make-string 100 ?x)) + +(ert-deftest bytecomp-warn-wide-docstring/defconst () + (bytecomp--with-warning-test "defconst.*foo.*wider than.*characters" + `(defconst foo t ,bytecomp-tests--docstring))) + +(ert-deftest bytecomp-warn-wide-docstring/defvar () + (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters" + `(defvar foo t ,bytecomp-tests--docstring))) + (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () :expected-result ,(if reverse :failed :passed) @@ -639,6 +649,67 @@ Subtests signal errors if something goes wrong." (bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el" "variable reference to nonvariable") +(bytecomp--define-warning-file-test + "warn-wide-docstring-autoload.el" + "autoload.*foox.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-custom-declare-variable.el" + "custom-declare-variable.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-defalias.el" + "defalias.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-defconst.el" + "defconst.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-define-abbrev-table.el" + "define-abbrev.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-define-obsolete-function-alias.el" + "defalias.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-define-obsolete-variable-alias.el" + "defvaralias.*foo.*wider than.*characters") + +;; TODO: We don't yet issue warnings for defuns. +(bytecomp--define-warning-file-test + "warn-wide-docstring-defun.el" + "wider than.*characters" 'reverse) + +(bytecomp--define-warning-file-test + "warn-wide-docstring-defvar.el" + "defvar.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-defvaralias.el" + "defvaralias.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-ignore-fill-column.el" + "defvar.*foo.*wider than.*characters" 'reverse) + +(bytecomp--define-warning-file-test + "warn-wide-docstring-ignore-override.el" + "defvar.*foo.*wider than.*characters" 'reverse) + +(bytecomp--define-warning-file-test + "warn-wide-docstring-ignore.el" + "defvar.*foo.*wider than.*characters" 'reverse) + +(bytecomp--define-warning-file-test + "warn-wide-docstring-multiline-first.el" + "defvar.*foo.*wider than.*characters") + +(bytecomp--define-warning-file-test + "warn-wide-docstring-multiline.el" + "defvar.*foo.*wider than.*characters") + ;;;; Macro expansion. commit ed30956099fff5025698c8ffdd9e876f207ed2af Author: Lars Ingebrigtsen Date: Mon Dec 28 04:24:01 2020 +0100 Make octave-send-region be asynchronous * lisp/progmodes/octave.el (octave-send-region): Send things asynchronously to the inferior process (bug#24492). diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index bda4e60c55..f295917c0a 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1512,28 +1512,12 @@ current buffer file unless called with a prefix arg \\[universal-argument]." (interactive "r") (inferior-octave t) (let ((proc inferior-octave-process) - (string (buffer-substring-no-properties beg end)) - line) + (string (buffer-substring-no-properties beg end))) (with-current-buffer inferior-octave-buffer ;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html (compilation-forget-errors) - (setq inferior-octave-output-list nil) - (while (not (string-equal string "")) - (if (string-match "\n" string) - (setq line (substring string 0 (match-beginning 0)) - string (substring string (match-end 0))) - (setq line string string "")) - (setq inferior-octave-receive-in-progress t) - (inferior-octave-send-list-and-digest (list (concat line "\n"))) - (while inferior-octave-receive-in-progress - (accept-process-output proc)) - (insert-before-markers - (mapconcat 'identity - (append - (if octave-send-echo-input (list line) (list "")) - inferior-octave-output-list - (list inferior-octave-output-string)) - "\n"))))) + (insert-before-markers string "\n") + (comint-send-string proc (concat string "\n")))) (if octave-send-show-buffer (display-buffer inferior-octave-buffer))) commit 2a64de5e982fb8b868b76626ac2e92ddfafc9ca5 Author: Yichao Yu Date: Mon Dec 28 04:17:43 2020 +0100 Make XIM to work with non-CJK locales * src/xfns.c (best_xim_style): Don't rely on supported_xim_styles (bug#10867). * src/xterm.c (x_draw_window_cursor): Adjust to modern input styles. (xim_instantiate_callback): Ditto. diff --git a/src/xfns.c b/src/xfns.c index abe293e903..333385da62 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2321,24 +2321,6 @@ hack_wm_protocols (struct frame *f, Widget widget) static XFontSet xic_create_xfontset (struct frame *); static XIMStyle best_xim_style (XIMStyles *); - -/* Supported XIM styles, ordered by preference. */ - -static const XIMStyle supported_xim_styles[] = -{ - XIMPreeditPosition | XIMStatusArea, - XIMPreeditPosition | XIMStatusNothing, - XIMPreeditPosition | XIMStatusNone, - XIMPreeditNothing | XIMStatusArea, - XIMPreeditNothing | XIMStatusNothing, - XIMPreeditNothing | XIMStatusNone, - XIMPreeditNone | XIMStatusArea, - XIMPreeditNone | XIMStatusNothing, - XIMPreeditNone | XIMStatusNone, - 0, -}; - - #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT /* Create an X fontset on frame F with base font name BASE_FONTNAME. */ @@ -2622,15 +2604,8 @@ xic_free_xfontset (struct frame *f) static XIMStyle best_xim_style (XIMStyles *xim) { - int i, j; - int nr_supported = ARRAYELTS (supported_xim_styles); - - for (i = 0; i < nr_supported; ++i) - for (j = 0; j < xim->count_styles; ++j) - if (supported_xim_styles[i] == xim->supported_styles[j]) - return supported_xim_styles[i]; - - /* Return the default style. */ + /* Return the default style. This is what GTK3 uses and + should work fine with all modern input methods. */ return XIMPreeditNothing | XIMStatusNothing; } diff --git a/src/xterm.c b/src/xterm.c index 7f8728e47c..b3632a375a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9706,7 +9706,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, #ifdef HAVE_X_I18N if (w == XWINDOW (f->selected_window)) - if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMPreeditPosition)) + if (FRAME_XIC (f)) xic_set_preeditarea (w, x, y); #endif } @@ -10389,11 +10389,8 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_ create_frame_xic (f); if (FRAME_XIC_STYLE (f) & XIMStatusArea) xic_set_statusarea (f); - if (FRAME_XIC_STYLE (f) & XIMPreeditPosition) - { - struct window *w = XWINDOW (f->selected_window); - xic_set_preeditarea (w, w->cursor.x, w->cursor.y); - } + struct window *w = XWINDOW (f->selected_window); + xic_set_preeditarea (w, w->cursor.x, w->cursor.y); } } commit 40e9cec7d2b81d1dd1c7254acfdd5075f52040b5 Author: Lars Ingebrigtsen Date: Mon Dec 28 04:09:51 2020 +0100 Fix background mode on Gnome 3.38 terminals * lisp/term/xterm.el (xterm--version-handler): Adjust to Gnome 3.38 (bug#43891). diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 709410064b..b3f240aa2e 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -710,15 +710,18 @@ Return the pasted text as a string." (while (and (setq chr (xterm--read-event-for-query)) (not (equal chr ?c))) (setq str (concat str (string chr)))) ;; Since xterm-280, the terminal type (NUMBER1) is now 41 instead of 0. - (when (string-match "\\([0-9]+\\);\\([0-9]+\\);0" str) + (when (string-match "\\([0-9]+\\);\\([0-9]+\\);[01]" str) (let ((version (string-to-number (match-string 2 str)))) - (when (and (> version 2000) (equal (match-string 1 str) "1")) + (when (and (> version 2000) + (or (equal (match-string 1 str) "1") + (equal (match-string 1 str) "65"))) ;; Hack attack! bug#16988: gnome-terminal reports "1;NNNN;0" ;; with a large NNNN but is based on a rather old xterm code. ;; Gnome terminal 2.32.1 reports 1;2802;0 ;; Gnome terminal 3.6.1 reports 1;3406;0 ;; Gnome terminal 3.22.2 reports 1;4601;0 and *does* support ;; background color querying (Bug#29716). + ;; Gnome terminal 3.38.0 reports 65;6200;1. (when (> version 4000) (xterm--query "\e]11;?\e\\" '(("\e]11;" . xterm--report-background-handler)))) commit 66274210687a911e7a9e61e96db908ec9782039e Author: Lars Ingebrigtsen Date: Mon Dec 28 02:47:25 2020 +0100 Fix alignment of Java String[] and the like * lisp/align.el (align-rules-list): Allow aligning Java String[] etc (bug#19385). Test case: class X { String field1; String[] field2; int field3; int[] field4; X field5; X[] field6; } diff --git a/lisp/align.el b/lisp/align.el index a11d834b82..905328b662 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -411,7 +411,7 @@ The possible settings for `align-region-separate' are: (modes . align-c++-modes)) (c-variable-declaration - (regexp . ,(concat "[*&0-9A-Za-z_]>?[&*]*\\(\\s-+[*&]*\\)" + (regexp . ,(concat "[*&0-9A-Za-z_]>?[][&*]*\\(\\s-+[*&]*\\)" "[A-Za-z_][][0-9A-Za-z:_]*\\s-*\\(\\()\\|" "=[^=\n].*\\|(.*)\\|\\(\\[.*\\]\\)*\\)" "\\s-*[;,]\\|)\\s-*$\\)")) commit b825131041e2c9294ca662125ea6b70ba9242a8e Author: Lars Ingebrigtsen Date: Mon Dec 28 02:18:16 2020 +0100 Document the text property limitations in mode lines * doc/lispref/modes.texi (Properties in Mode, Mode Line Basics): Mention the special text property limitations. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 98aa94e90d..675aeec8a5 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1982,9 +1982,15 @@ variables without prompting the user.) @item (@var{string} @var{rest}@dots{}) @itemx (@var{list} @var{rest}@dots{}) -A list whose first element is a string or list means to process all the -elements recursively and concatenate the results. This is the most -common form of mode line construct. +A list whose first element is a string or list means to process all +the elements recursively and concatenate the results. This is the +most common form of mode line construct. (Note that text properties +are handled specially (for reasons of efficiency) when displaying +strings in the mode line: Only the text property on the first +character of the string are considered, and they are then used over +the entire string. If you need a string with different text +properties, you have to use the special @code{:propertize} mode line +construct.) @item (:eval @var{form}) A list whose first element is the symbol @code{:eval} says to evaluate @@ -2439,7 +2445,7 @@ line: @enumerate @item Put a string with a text property directly into the mode line data -structure. +structure, but see @ref{Mode Line Data} for caveats for that. @item Put a text property on a mode line %-construct such as @samp{%12b}; then commit 4ffb2ec357a75867a123b3571d622be184945dc5 Author: Lars Ingebrigtsen Date: Mon Dec 28 02:03:56 2020 +0100 Allow remember-notes to use the *scratch* buffer * lisp/textmodes/remember.el (remember-notes): Allow the remember-notes buffer to use the *scratch* buffer (as documented) (bug#20740). diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 7bc7dc1762..599e8f69ba 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -638,9 +638,14 @@ to turn the *scratch* buffer into your notes buffer." (interactive "p") (let ((buf (or (find-buffer-visiting remember-data-file) (with-current-buffer (find-file-noselect remember-data-file) - (and remember-notes-buffer-name - (not (get-buffer remember-notes-buffer-name)) - (rename-buffer remember-notes-buffer-name)) + (when remember-notes-buffer-name + (when (and (get-buffer remember-notes-buffer-name) + (equal remember-notes-buffer-name "*scratch*")) + (kill-buffer remember-notes-buffer-name)) + ;; Rename the buffer to the requested name (if + ;; it's not already in use). + (unless (get-buffer remember-notes-buffer-name) + (rename-buffer remember-notes-buffer-name))) (funcall (or remember-notes-initial-major-mode initial-major-mode)) (remember-notes-mode 1) commit 8c383456291185b029b469061338b5b797a49747 Author: Dmitry Gutov Date: Mon Dec 28 02:30:09 2020 +0200 Rename and document the built-in xref-show-definitions-function's * lisp/progmodes/xref.el (xref-show-definitions-buffer): Rename from 'xref--show-defs-buffer'. (xref-show-definitions-buffer-at-bottom): Rename from 'xref--show-defs-buffer-at-bottom'. diff --git a/etc/NEWS b/etc/NEWS index 328c666da3..131931052a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1293,6 +1293,14 @@ searches. These commands are bound respectively to 'P' and 'N', and navigate to the first item of the previous or next group in the "*xref*" buffer. +*** New alternative value for 'xref-show-definitions-function': +'xref-show-definitions-completing-read'. + +*** The two existing alternatives for 'xref-show-definitions-function' +have been renamed to have "proper" public names and documented +('xref-show-definitions-buffer' and +'xref-show-definitions-buffer-at-bottom'). + ** json.el --- diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 181f94b0bc..b8a5d48119 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -941,7 +941,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." 'face 'error)))) (goto-char (point-min))))) -(defun xref--show-defs-buffer (fetcher alist) +(defun xref-show-definitions-buffer (fetcher alist) + "Show the definitions list in a regular window. + +When only one definition found, jump to it right away instead." (let ((xrefs (funcall fetcher))) (cond ((not (cdr xrefs)) @@ -952,8 +955,12 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (cons (cons 'fetched-xrefs xrefs) alist)))))) -(defun xref--show-defs-buffer-at-bottom (fetcher alist) - "Show definitions list in a window at the bottom. +(define-obsolete-function-alias + 'xref--show-defs-buffer #'xref-show-definitions-buffer "28.1") + +(defun xref-show-definitions-buffer-at-bottom (fetcher alist) + "Show the definitions list in a window at the bottom. + When there is more than one definition, split the selected window and show the list in a small window at the bottom. And use a local keymap that binds `RET' to `xref-quit-and-goto-xref'." @@ -970,7 +977,14 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." '(display-buffer-in-direction . ((direction . below)))) (current-buffer)))))) -(defun xref--show-defs-minibuffer (fetcher alist) +(define-obsolete-function-alias + 'xref--show-defs-buffer-at-bottom #'xref-show-definitions-buffer-at-bottom) + +(defun xref-show-definitions-completing-read (fetcher alist) + "Let the user choose the target definition with completion. + +When there is more than one definition, let the user choose +between them by typing in the minibuffer with completion." (let* ((xrefs (funcall fetcher)) (xref-alist (xref--analyze xrefs)) xref-alist-with-line-info @@ -1010,6 +1024,10 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (xref-pop-to-location xref (assoc-default 'display-action alist)))) +;; TODO: Can delete this alias before Emacs 28's release. +(define-obsolete-function-alias + 'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1") + (defcustom xref-show-xrefs-function 'xref--show-xref-buffer "Function to display a list of search results. @@ -1030,11 +1048,22 @@ displayed. The possible values are nil, `window' meaning the other window, or `frame' meaning the other frame." :type 'function) -(defcustom xref-show-definitions-function 'xref--show-defs-buffer - "Function to display a list of definitions. - -Accepts the same arguments as `xref-show-xrefs-function'." - :type 'function) +(defcustom xref-show-definitions-function 'xref-show-definitions-buffer + "Function to handle the definition search results. + +Accepts the same arguments as `xref-show-xrefs-function'. + +Generally, it is expected to jump to the definition if there's +only one, and otherwise provide some way to choose among the +definitions." + :type '(choice + (const :tag "Show a regular list of locations" + xref-show-definitions-buffer) + (const :tag "Show a \"transient\" list at the bottom of the window" + xref-show-definitions-buffer-at-bottom) + (const :tag "Choose the definition with completion" + xref-show-definitions-completing-read) + (function :tag "Custom function"))) (defvar xref--read-identifier-history nil) commit 8914fb2227b51851ab734513938c38de7d01902e Author: Tim Landscheidt Date: Mon Dec 28 00:37:51 2020 +0100 Do not output two spaces for non-autoloaded ieieo constructor functions * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): Amend format to avoid two spaces for non-autoloaded object constructor functions (bug#45454). Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 59af7e12d2..3b222b9312 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -136,9 +136,9 @@ are not abstract." (def (symbol-function ctr))) (goto-char (point-min)) (prin1 ctr) - (insert (format " is an %s object constructor function" + (insert (format " is an %sobject constructor function" (if (autoloadp def) - "autoloaded" + "autoloaded " ""))) (when (and (autoloadp def) (null location)) commit 8d5a6c9ef5272b2a98c2faa0a9308ab69f011570 Author: Stefan Monnier Date: Sun Dec 27 17:31:07 2020 -0500 * lisp/emacs-lisp/package.el (package-archives): Add NonGNU ELPA diff --git a/etc/NEWS b/etc/NEWS index 4f072df31c..328c666da3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,6 +85,8 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA + ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bc450b09d0..8f77f66af1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -203,6 +203,9 @@ If VERSION is nil, the package is not made available (it is \"disabled\")." (defcustom package-archives `(("gnu" . ,(format "http%s://elpa.gnu.org/packages/" + (if (gnutls-available-p) "s" ""))) + ("nongnu" . + ,(format "http%s://elpa.nongnu.org/nongnu/" (if (gnutls-available-p) "s" "")))) "An alist of archives from which to fetch. The default value points to the GNU Emacs package repository. commit 03808272eeaaf65a257f69ad91c3a3bebe186439 Author: Stefan Monnier Date: Sun Dec 27 17:16:54 2020 -0500 * lisp/textmodes/rst.el (rst-mode): Don't touch global hook (rst-re): η-reduce. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 435de2683e..6090cea0cb 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -568,9 +568,7 @@ After interpretation of ARGS the results are concatenated as for (regexp-quote (char-to-string re))) ((listp re) (let ((nested - (mapcar (lambda (elt) - (rst-re elt)) - (cdr re)))) + (mapcar #'rst-re (cdr re)))) (cond ((eq (car re) :seq) (mapconcat #'identity nested "")) @@ -1398,7 +1396,8 @@ highlighting. t nil nil nil (font-lock-multiline . t) (font-lock-mark-block-function . mark-paragraph))) - (add-hook 'font-lock-extend-region-functions #'rst-font-lock-extend-region t) + (add-hook 'font-lock-extend-region-functions + #'rst-font-lock-extend-region nil t) ;; Text after a changed line may need new fontification. (setq-local jit-lock-contextually t) commit c9b37634b131f3617314bd5a38090e96d0b465cf Author: Alan Third Date: Wed Dec 23 20:12:02 2020 +0000 Remove NS menu synthesized events (bug#44333) Remove the frame tracking stuff as it's not used for anything, and move the update tracking into the EmacsMenu class. * src/nsmenu.m (ns_update_menubar): Copy the parsing code from xmenu.c and rework the NS specific code around to update the existing menus instead of rebuilding them completely. (ns_activate_menubar): ([EmacsMenu trackingNotification:]): ([EmacsMenu menuWillOpen:]): ([EmacsMenu menuDidClose:]): Remove unused functions. ([EmacsMenu menuNeedsUpdate:]): Remove menu tracking code and add code to check whether an update is required. ([EmacsMenu fillWithWidgetValue:]): ([EmacsMenu addSubmenuWithTitle:]): ([EmacsMenu initWithTitle:]): Remove references to frame. ([EmacsMenu setFrame:]): Remove method. ([EmacsMenu clear]): Rename to removeAllItems. ([EmacsMenu removeAllItems]): Use built-in removeAllItems, if available. (syms_of_nsmenu): Remove tracking code. * src/nsterm.m (ns_check_menu_open): (ns_check_pending_open_menu): (ns_create_terminal): Remove unused functions. (ns_term_init): Get rid of menu tracking. * src/nsterm.h (EmacsMenu): Remove frame, add needsUpdate and update method definitions. diff --git a/src/nsmenu.m b/src/nsmenu.m index efad978316..3f0cd0c6ed 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -47,21 +47,11 @@ #endif -#if 0 -/* Include lisp -> C common menu parsing code. */ -#define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str) -#include "nsmenu_common.c" -#endif - extern long context_menu_value; EmacsMenu *svcsMenu; /* Nonzero means a menu is currently active. */ static int popup_activated_flag; -/* Nonzero means we are tracking and updating menus. */ -static int trackingMenu; - - /* NOTE: toolbar implementation is at end, following complete menu implementation. */ @@ -98,16 +88,18 @@ 3) deep_p, submenu = non-nil: Update contents of a single submenu. -------------------------------------------------------------------------- */ static void -ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) +ns_update_menubar (struct frame *f, bool deep_p) { NSAutoreleasePool *pool; - id menu = [NSApp mainMenu]; - static EmacsMenu *last_submenu = nil; BOOL needsSet = NO; - bool owfi; + id menu = [NSApp mainMenu]; + Lisp_Object items; widget_value *wv, *first_wv, *prev_wv = 0; int i; + int *submenu_start, *submenu_end; + bool *submenu_top_level_items; + int *submenu_n_panes; #if NSMENUPROFILE struct timeb tb; @@ -141,115 +133,94 @@ t = -(1000*tb.time+tb.millitm); #endif -#ifdef NS_IMPL_GNUSTEP - deep_p = 1; /* until GNUstep NSMenu implements the Panther delegation model */ -#endif - if (deep_p) { - /* Fully parse one or more of the submenus. */ - int n = 0; - int *submenu_start, *submenu_end; - bool *submenu_top_level_items; - int *submenu_n_panes; + /* Make a widget-value tree representing the entire menu trees. */ + struct buffer *prev = current_buffer; Lisp_Object buffer; ptrdiff_t specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); + int subitems; - /* lisp preliminaries */ buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents; specbind (Qinhibit_quit, Qt); + /* Don't let the debugger step into this code + because it is not reentrant. */ specbind (Qdebug_on_next_call, Qnil); + record_unwind_save_match_data (); if (NILP (Voverriding_local_map_menu_flag)) { specbind (Qoverriding_terminal_local_map, Qnil); specbind (Qoverriding_local_map, Qnil); } - set_buffer_internal_1 (XBUFFER (buffer)); - /* TODO: for some reason this is not needed in other terms, - but some menu updates call Info-extract-pointer which causes - abort-on-error if waiting-for-input. Needs further investigation. */ - owfi = waiting_for_input; - waiting_for_input = 0; + set_buffer_internal_1 (XBUFFER (buffer)); - /* lucid hook and possible reset */ + /* Run the Lucid hook. */ safe_run_hooks (Qactivate_menubar_hook); + + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ if (! NILP (Vlucid_menu_bar_dirty_flag)) call0 (Qrecompute_lucid_menubar); safe_run_hooks (Qmenu_bar_update_hook); fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); - /* Now ready to go */ items = FRAME_MENU_BAR_ITEMS (f); - /* Save the frame's previous menu bar contents data */ + /* Save the frame's previous menu bar contents data. */ if (previous_menu_items_used) - memcpy (previous_items, aref_addr (f->menu_bar_vector, 0), - previous_menu_items_used * sizeof (Lisp_Object)); + memcpy (previous_items, xvector_contents (f->menu_bar_vector), + previous_menu_items_used * word_size); - /* parse stage 1: extract from lisp */ + /* Fill in menu_items with the current menu bar contents. + This can evaluate Lisp code. */ save_menu_items (); menu_items = f->menu_bar_vector; menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; - submenu_start = alloca (ASIZE (items) * sizeof *submenu_start); - submenu_end = alloca (ASIZE (items) * sizeof *submenu_end); - submenu_n_panes = alloca (ASIZE (items) * sizeof *submenu_n_panes); - submenu_top_level_items = alloca (ASIZE (items) + subitems = ASIZE (items) / 4; + submenu_start = alloca ((subitems + 1) * sizeof *submenu_start); + submenu_end = alloca (subitems * sizeof *submenu_end); + submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes); + submenu_top_level_items = alloca (subitems * sizeof *submenu_top_level_items); init_menu_items (); - for (i = 0; i < ASIZE (items); i += 4) + for (i = 0; i < subitems; i++) { Lisp_Object key, string, maps; - key = AREF (items, i); - string = AREF (items, i + 1); - maps = AREF (items, i + 2); + key = AREF (items, 4 * i); + string = AREF (items, 4 * i + 1); + maps = AREF (items, 4 * i + 2); if (NILP (string)) break; - /* FIXME: we'd like to only parse the needed submenu, but this - was causing crashes in the _common parsing code: need to make - sure proper initialization done. */ - /* if (submenu && strcmp ([[submenu title] UTF8String], SSDATA (string))) - continue; */ - submenu_start[i] = menu_items_used; menu_items_n_panes = 0; - submenu_top_level_items[i] = parse_single_submenu (key, string, maps); + submenu_top_level_items[i] + = parse_single_submenu (key, string, maps); submenu_n_panes[i] = menu_items_n_panes; + submenu_end[i] = menu_items_used; - n++; } + submenu_start[i] = -1; finish_menu_items (); - waiting_for_input = owfi; + /* Convert menu_items into widget_value trees + to display the menu. This cannot evaluate Lisp code. */ - if (submenu && n == 0) - { - /* should have found a menu for this one but didn't */ - fprintf (stderr, "ERROR: did not find lisp menu for submenu '%s'.\n", - [[submenu title] UTF8String]); - discard_menu_items (); - unbind_to (specpdl_count, Qnil); - unblock_input (); - return; - } - - /* parse stage 2: insert into lucid 'widget_value' structures - [comments in other terms say not to evaluate lisp code here] */ wv = make_widget_value ("menubar", NULL, true, Qnil); wv->button_type = BUTTON_TYPE_NONE; first_wv = wv; - for (i = 0; i < 4*n; i += 4) + for (i = 0; submenu_start[i] >= 0; i++) { menu_items_n_panes = submenu_n_panes[i]; wv = digest_single_submenu (submenu_start[i], submenu_end[i], @@ -259,169 +230,79 @@ else first_wv->contents = wv; /* Don't set wv->name here; GC during the loop might relocate it. */ - wv->enabled = 1; + wv->enabled = true; wv->button_type = BUTTON_TYPE_NONE; prev_wv = wv; } set_buffer_internal_1 (prev); - /* Compare the new menu items with previous, and leave off if no change. */ - /* FIXME: following other terms here, but seems like this should be - done before parse stage 2 above, since its results aren't used. */ - if (previous_menu_items_used - && (!submenu || (submenu && submenu == last_submenu)) - && menu_items_used == previous_menu_items_used) - { - for (i = 0; i < previous_menu_items_used; i++) - /* FIXME: this ALWAYS fails on Buffers menu items.. something - about their strings causes them to change every time, so we - double-check failures. */ - if (!EQ (previous_items[i], AREF (menu_items, i))) - if (!(STRINGP (previous_items[i]) - && STRINGP (AREF (menu_items, i)) - && !strcmp (SSDATA (previous_items[i]), - SSDATA (AREF (menu_items, i))))) - break; - if (i == previous_menu_items_used) - { - /* No change. */ + /* If there has been no change in the Lisp-level contents + of the menu bar, skip redisplaying it. Just exit. */ -#if NSMENUPROFILE - ftime (&tb); - t += 1000*tb.time+tb.millitm; - fprintf (stderr, "NO CHANGE! CUTTING OUT after %ld msec.\n", t); -#endif + /* Compare the new menu items with the ones computed last time. */ + for (i = 0; i < previous_menu_items_used; i++) + if (menu_items_used == i + || (!EQ (previous_items[i], AREF (menu_items, i)))) + break; + if (i == menu_items_used && i == previous_menu_items_used && i != 0) + { + /* The menu items have not changed. Don't bother updating + the menus in any form, since it would be a no-op. */ + free_menubar_widget_value_tree (first_wv); + discard_menu_items (); + unbind_to (specpdl_count, Qnil); + return; + } - free_menubar_widget_value_tree (first_wv); - discard_menu_items (); - unbind_to (specpdl_count, Qnil); - unblock_input (); - return; - } - } /* The menu items are different, so store them in the frame. */ - /* FIXME: this is not correct for single-submenu case. */ fset_menu_bar_vector (f, menu_items); f->menu_bar_items_used = menu_items_used; - /* Calls restore_menu_items, etc., as they were outside. */ + /* This undoes save_menu_items. */ unbind_to (specpdl_count, Qnil); - /* Parse stage 2a: now GC cannot happen during the lifetime of the - widget_value, so it's safe to store data from a Lisp_String. */ + /* Now GC cannot happen during the lifetime of the widget_value, + so it's safe to store data from a Lisp_String. */ wv = first_wv->contents; for (i = 0; i < ASIZE (items); i += 4) { Lisp_Object string; string = AREF (items, i + 1); if (NILP (string)) - break; - - wv->name = SSDATA (string); + break; + wv->name = SSDATA (string); update_submenu_strings (wv->contents); - wv = wv->next; + wv = wv->next; } - /* Now, update the NS menu; if we have a submenu, use that, otherwise - create a new menu for each sub and fill it. */ - if (submenu) - { - const char *submenuTitle = [[submenu title] UTF8String]; - for (wv = first_wv->contents; wv; wv = wv->next) - { - if (!strcmp (submenuTitle, wv->name)) - { - [submenu fillWithWidgetValue: wv->contents]; - last_submenu = submenu; - break; - } - } - } - else - { - [menu fillWithWidgetValue: first_wv->contents frame: f]; - } - } else { - static int n_previous_strings = 0; - static char previous_strings[100][10]; - static struct frame *last_f = NULL; - int n; - Lisp_Object string; + /* Make a widget-value tree containing + just the top level menu bar strings. */ wv = make_widget_value ("menubar", NULL, true, Qnil); wv->button_type = BUTTON_TYPE_NONE; first_wv = wv; - /* Make widget-value tree with just the top level menu bar strings. */ items = FRAME_MENU_BAR_ITEMS (f); - if (NILP (items)) - { - free_menubar_widget_value_tree (first_wv); - unblock_input (); - return; - } - - - /* Check if no change: this mechanism is a bit rough, but ready. */ - n = ASIZE (items) / 4; - if (f == last_f && n_previous_strings == n) - { - for (i = 0; ibutton_type = BUTTON_TYPE_NONE; + /* This prevents lwlib from assuming this + menu item is really supposed to be empty. */ + /* The intptr_t cast avoids a warning. + This value just has to be different from small integers. */ wv->call_data = (void *) (intptr_t) (-1); -#ifdef NS_IMPL_COCOA - /* We'll update the real copy under app menu when time comes. */ - if (!strcmp ("Services", wv->name)) - { - /* But we need to make sure it will update on demand. */ - [svcsMenu setFrame: f]; - } - else -#endif - [menu addSubmenuWithTitle: wv->name forFrame: f]; - if (prev_wv) prev_wv->next = wv; else @@ -429,15 +310,68 @@ prev_wv = wv; } - last_f = f; - if (n < 100) - n_previous_strings = n; - else - n_previous_strings = 0; + /* Forget what we thought we knew about what is in the + detailed contents of the menu bar menus. + Changing the top level always destroys the contents. */ + f->menu_bar_items_used = 0; + } + + /* Now, update the NS menu. */ + if (deep_p) + { + /* This path is typically used when a menu has been clicked. I + think Apple expect us to only update that one menu, however + to update one we need to do the hard work of parsing the + whole tree, so we may as well update them all. */ +#ifdef NS_IMPL_COCOA + int i = 1; +#else + int i = 0; +#endif + for (wv = first_wv->contents; wv; wv = wv->next) + { + /* The contents of wv should match the top level menu. */ + EmacsMenu *submenu = (EmacsMenu*)[[menu itemAtIndex:i++] submenu]; + [submenu fillWithWidgetValue: wv->contents]; + } } - free_menubar_widget_value_tree (first_wv); + else + { + /* Make sure we skip the "application" menu, which is always the + first entry in our top-level menu. */ +#ifdef NS_IMPL_COCOA + int i = 1; +#else + int i = 0; +#endif + for (wv = first_wv->contents; wv; wv = wv->next) + { + if (i < [menu numberOfItems]) + { + NSString *titleStr = [NSString stringWithUTF8String: wv->name]; + NSMenuItem *item = [menu itemAtIndex:i]; + EmacsMenu *submenu = (EmacsMenu*)[item submenu]; + [item setTitle:titleStr]; + [submenu setTitle:titleStr]; + [submenu removeAllItems]; + } + else + [menu addSubmenuWithTitle: wv->name]; + + i += 1; + } + + while (i < [menu numberOfItems]) + { + /* Remove any extra items. */ + [menu removeItemAtIndex:i]; + } + } + + + free_menubar_widget_value_tree (first_wv); #if NSMENUPROFILE ftime (&tb); @@ -460,21 +394,10 @@ void set_frame_menubar (struct frame *f, bool first_time, bool deep_p) { - ns_update_menubar (f, deep_p, nil); -} - -void -ns_activate_menubar (struct frame *f) -{ -#ifdef NS_IMPL_COCOA - ns_update_menubar (f, true, nil); - ns_check_pending_open_menu (); -#endif + ns_update_menubar (f, deep_p); } - - /* ========================================================================== Menu: class implementation @@ -490,97 +413,31 @@ @implementation EmacsMenu /* override designated initializer */ - (instancetype)initWithTitle: (NSString *)title { - frame = 0; if ((self = [super initWithTitle: title])) [self setAutoenablesItems: NO]; - return self; -} - - -/* used for top-level */ -- (instancetype)initWithTitle: (NSString *)title frame: (struct frame *)f -{ - [self initWithTitle: title]; - frame = f; -#ifdef NS_IMPL_COCOA [self setDelegate: self]; -#endif - return self; -} - - -- (void)setFrame: (struct frame *)f -{ - frame = f; -} - -#ifdef NS_IMPL_COCOA --(void)trackingNotification:(NSNotification *)notification -{ - /* Update menu in menuNeedsUpdate only while tracking menus. */ - trackingMenu = ([notification name] == NSMenuDidBeginTrackingNotification - ? 1 : 0); - if (! trackingMenu) ns_check_menu_open (nil); -} - -- (void)menuWillOpen:(NSMenu *)menu -{ - ++trackingMenu; - -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - // On 10.6 we get repeated calls, only the one for NSSystemDefined is "real". - if ( -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - NSAppKitVersionNumber < NSAppKitVersionNumber10_7 && -#endif - [[NSApp currentEvent] type] != NSEventTypeSystemDefined) - return; -#endif - /* When dragging from one menu to another, we get willOpen followed by didClose, - i.e. trackingMenu == 3 in willOpen and then 2 after didClose. - We have updated all menus, so avoid doing it when trackingMenu == 3. */ - if (trackingMenu == 2) - ns_check_menu_open (menu); -} + needsUpdate = YES; -- (void)menuDidClose:(NSMenu *)menu -{ - --trackingMenu; + return self; } -#endif /* NS_IMPL_COCOA */ /* Delegate method called when a submenu is being opened: run a 'deep' call to set_frame_menubar. */ + +/* TODO: GNUstep calls this method when the menu is still being built + which throws it into an infinite loop. One possible solution is to + use menuWillOpen instead, but the Apple docs explicitly warn + against changing the contents of the menu in it. I don't know what + the right thing to do for GNUstep is. */ - (void)menuNeedsUpdate: (NSMenu *)menu { - if (!FRAME_LIVE_P (frame)) + if (!FRAME_LIVE_P (SELECTED_FRAME ())) return; - /* Cocoa/Carbon will request update on every keystroke - via IsMenuKeyEvent -> CheckMenusForKeyEvent. These are not needed - since key equivalents are handled through emacs. - On Leopard, even keystroke events generate SystemDefined event. - Third-party applications that enhance mouse / trackpad - interaction, or also VNC/Remote Desktop will send events - of type AppDefined rather than SysDefined. - Menus will fail to show up if they haven't been initialized. - AppDefined events may lack timing data. - - Thus, we rely on the didBeginTrackingNotification notification - as above to indicate the need for updates. - From 10.6 on, we could also use -[NSMenu propertiesToUpdate]: In the - key press case, NSMenuPropertyItemImage (e.g.) won't be set. - */ - if (trackingMenu == 0) - return; -/*fprintf (stderr, "Updating menu '%s'\n", [[self title] UTF8String]); NSLog (@"%@\n", event); */ -#ifdef NS_IMPL_GNUSTEP - /* Don't know how to do this for anything other than Mac OS X 10.5 and later. - This is wrong, as it might run Lisp code in the event loop. */ - ns_update_menubar (frame, true, self); -#endif + if (needsUpdate) + ns_update_menubar (SELECTED_FRAME (), true); } @@ -674,8 +531,13 @@ - (NSMenuItem *)addItemWithWidgetValue: (void *)wvptr /* convenience */ --(void)clear +-(void)removeAllItems { +#ifdef NS_IMPL_COCOA + [super removeAllItems]; +#else + /* GNUstep doesn't have removeAllItems yet, so do it + manually. */ int n; for (n = [self numberOfItems]-1; n >= 0; n--) @@ -687,20 +549,18 @@ -(void)clear continue; [self removeItemAtIndex: n]; } +#endif + + needsUpdate = YES; } - (void)fillWithWidgetValue: (void *)wvptr -{ - [self fillWithWidgetValue: wvptr frame: (struct frame *)nil]; -} - -- (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f { widget_value *wv = (widget_value *)wvptr; /* clear existing contents */ - [self clear]; + [self removeAllItems]; /* add new contents */ for (; wv != NULL; wv = wv->next) @@ -711,10 +571,7 @@ - (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f { EmacsMenu *submenu; - if (f) - submenu = [[EmacsMenu alloc] initWithTitle: [item title] frame:f]; - else - submenu = [[EmacsMenu alloc] initWithTitle: [item title]]; + submenu = [[EmacsMenu alloc] initWithTitle: [item title]]; [self setSubmenu: submenu forItem: item]; [submenu fillWithWidgetValue: wv->contents]; @@ -723,6 +580,8 @@ - (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f } } + needsUpdate = NO; + #ifdef NS_IMPL_GNUSTEP if ([[self window] isVisible]) [self sizeToFit]; @@ -731,13 +590,13 @@ - (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f /* Adds an empty submenu and returns it. */ -- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f +- (EmacsMenu *)addSubmenuWithTitle: (const char *)title { NSString *titleStr = [NSString stringWithUTF8String: title]; NSMenuItem *item = [self addItemWithTitle: titleStr action: (SEL)nil /*@selector (menuDown:) */ keyEquivalent: @""]; - EmacsMenu *submenu = [[EmacsMenu alloc] initWithTitle: titleStr frame: f]; + EmacsMenu *submenu = [[EmacsMenu alloc] initWithTitle: titleStr]; [self setSubmenu: submenu forItem: item]; [submenu release]; return submenu; @@ -1881,12 +1740,6 @@ - (Lisp_Object)runDialogAt: (NSPoint)p void syms_of_nsmenu (void) { -#ifndef NS_IMPL_COCOA - /* Don't know how to keep track of this in Next/Open/GNUstep. Always - update menus there. */ - trackingMenu = 1; - PDUMPER_REMEMBER_SCALAR (trackingMenu); -#endif defsubr (&Sns_reset_menu); defsubr (&Smenu_or_popup_active_p); diff --git a/src/nsterm.h b/src/nsterm.h index 94472ec107..b7b4d3b047 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -513,25 +513,18 @@ typedef id instancetype; ========================================================================== */ -#ifdef NS_IMPL_COCOA @interface EmacsMenu : NSMenu -#else -@interface EmacsMenu : NSMenu -#endif { - struct frame *frame; unsigned long keyEquivModMask; + BOOL needsUpdate; } -- (instancetype)initWithTitle: (NSString *)title frame: (struct frame *)f; -- (void)setFrame: (struct frame *)f; - (void)menuNeedsUpdate: (NSMenu *)menu; /* (delegate method) */ - (NSString *)parseKeyEquiv: (const char *)key; - (NSMenuItem *)addItemWithWidgetValue: (void *)wvptr; - (void)fillWithWidgetValue: (void *)wvptr; -- (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f; -- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f; -- (void) clear; +- (EmacsMenu *)addSubmenuWithTitle: (const char *)title; +- (void) removeAllItems; - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f keymaps: (bool)keymaps; @end @@ -1130,8 +1123,6 @@ extern int ns_lisp_to_color (Lisp_Object color, NSColor **col); extern NSColor *ns_lookup_indexed_color (unsigned long idx, struct frame *f); extern unsigned long ns_index_color (NSColor *color, struct frame *f); extern const char *ns_get_pending_menu_title (void); -extern void ns_check_menu_open (NSMenu *menu); -extern void ns_check_pending_open_menu (void); #endif /* Implemented in nsfns, published in nsterm. */ diff --git a/src/nsterm.m b/src/nsterm.m index 2a117a0780..161677484f 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -310,24 +310,6 @@ - (NSColor *)colorUsingDefaultColorSpace NULL, 0, 0 }; -#ifdef NS_IMPL_COCOA -/* - * State for pending menu activation: - * MENU_NONE Normal state - * MENU_PENDING A menu has been clicked on, but has been canceled so we can - * run lisp to update the menu. - * MENU_OPENING Menu is up to date, and the click event is redone so the menu - * will open. - */ -#define MENU_NONE 0 -#define MENU_PENDING 1 -#define MENU_OPENING 2 -static int menu_will_open_state = MENU_NONE; - -/* Saved position for menu click. */ -static CGPoint menu_mouse_point; -#endif - /* Convert modifiers in a NeXTstep event to emacs style modifiers. */ #define NS_FUNCTION_KEY_MASK 0x800000 #define NSLeftControlKeyMask (0x000001 | NSEventModifierFlagControl) @@ -4607,79 +4589,6 @@ in certain situations (rapid incoming events). } #endif -/* GNUstep does not have cancelTracking. */ -#ifdef NS_IMPL_COCOA -/* Check if menu open should be canceled or continued as normal. */ -void -ns_check_menu_open (NSMenu *menu) -{ - /* Click in menu bar? */ - NSArray *a = [[NSApp mainMenu] itemArray]; - int i; - BOOL found = NO; - - if (menu == nil) // Menu tracking ended. - { - if (menu_will_open_state == MENU_OPENING) - menu_will_open_state = MENU_NONE; - return; - } - - for (i = 0; ! found && i < [a count]; i++) - found = menu == [[a objectAtIndex:i] submenu]; - if (found) - { - if (menu_will_open_state == MENU_NONE && emacs_event) - { - NSEvent *theEvent = [NSApp currentEvent]; - struct frame *emacsframe = SELECTED_FRAME (); - - /* On macOS, the following can cause an event loop when the - Spotlight for Help search field is populated. Avoid this by - not postponing mouse drag and non-user-generated mouse down - events (Bug#31371). */ - if (([theEvent type] == NSEventTypeLeftMouseDown) - && [theEvent eventNumber]) - { - [menu cancelTracking]; - menu_will_open_state = MENU_PENDING; - emacs_event->kind = MENU_BAR_ACTIVATE_EVENT; - EV_TRAILER (theEvent); - - CGEventRef ourEvent = CGEventCreate (NULL); - menu_mouse_point = CGEventGetLocation (ourEvent); - CFRelease (ourEvent); - } - } - else if (menu_will_open_state == MENU_OPENING) - { - menu_will_open_state = MENU_NONE; - } - } -} - -/* Redo saved menu click if state is MENU_PENDING. */ -void -ns_check_pending_open_menu () -{ - if (menu_will_open_state == MENU_PENDING) - { - CGEventSourceRef source - = CGEventSourceCreate (kCGEventSourceStateHIDSystemState); - - CGEventRef event = CGEventCreateMouseEvent (source, - kCGEventLeftMouseDown, - menu_mouse_point, - kCGMouseButtonLeft); - CGEventSetType (event, kCGEventLeftMouseDown); - CGEventPost (kCGHIDEventTap, event); - CFRelease (event); - CFRelease (source); - - menu_will_open_state = MENU_OPENING; - } -} -#endif /* NS_IMPL_COCOA */ static int ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) @@ -5416,7 +5325,6 @@ static Lisp_Object ns_new_font (struct frame *f, Lisp_Object font_object, terminal->set_new_font_hook = ns_new_font; terminal->implicit_set_name_hook = ns_implicitly_set_name; terminal->menu_show_hook = ns_menu_show; - terminal->activate_menubar_hook = ns_activate_menubar; terminal->popup_dialog_hook = ns_popup_dialog; terminal->set_vertical_scroll_bar_hook = ns_set_vertical_scroll_bar; terminal->set_horizontal_scroll_bar_hook = ns_set_horizontal_scroll_bar; @@ -5661,15 +5569,6 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. [NSApp setServicesMenu: svcsMenu]; /* Needed at least on Cocoa, to get dock menu to show windows */ [NSApp setWindowsMenu: [[NSMenu alloc] init]]; - - [[NSNotificationCenter defaultCenter] - addObserver: mainMenu - selector: @selector (trackingNotification:) - name: NSMenuDidBeginTrackingNotification object: mainMenu]; - [[NSNotificationCenter defaultCenter] - addObserver: mainMenu - selector: @selector (trackingNotification:) - name: NSMenuDidEndTrackingNotification object: mainMenu]; } #endif /* macOS menu setup */ commit df882c9701755e2ae063f05d3381de14ae09951e Author: Basil L. Contovounesios Date: Sun Dec 27 13:14:30 2020 +0000 ; Fix recent shortdoc.el and fns.c additions * lisp/emacs-lisp/shortdoc.el (list): Fix typos. * src/fns.c (Flength_equal): Fix docstring. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index c6259f8971..7fb1a88b86 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -619,11 +619,11 @@ There can be any number of :example/:result elements." (length :eval (length '(a b c))) (length< - :eval (lenth< '(a b c) 1)) + :eval (length< '(a b c) 1)) (length> - :eval (lenth> '(a b c) 1)) + :eval (length> '(a b c) 1)) (length= - :eval (lenth> '(a b c) 3)) + :eval (length> '(a b c) 3)) (safe-length :eval (safe-length '(a b c)))) diff --git a/src/fns.c b/src/fns.c index 217e3b62cc..2de1d26dd3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -202,7 +202,7 @@ counted. */) } DEFUN ("length=", Flength_equal, Slength_equal, 2, 2, 0, - doc: /* Return non-nil if SEQUENCE is equal to LENGTH. + doc: /* Return non-nil if SEQUENCE has length equal to LENGTH. See `length' for allowed values of SEQUENCE and how elements are counted. */) (Lisp_Object sequence, Lisp_Object length) commit 8bc727d0b4e46554ee4e92c1d1db7d3b3e672068 Author: Štěpán Němec Date: Sun Dec 27 11:43:19 2020 +0100 ; Fix the recent `length' doc string addition diff --git a/src/fns.c b/src/fns.c index 6aad119d1f..217e3b62cc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -111,7 +111,7 @@ the number of bytes in the string; it is the number of characters. To get the number of bytes, use `string-bytes'. If the length of a list is being computed to compare to a (small) -number, the `string<', `string>' and `string=' functions may be more +number, the `length<', `length>' and `length=' functions may be more efficient. */) (Lisp_Object sequence) {