commit 28592faa28cbc7e8696718f4be925094f7c401c1 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sun Oct 11 07:50:10 2020 +0200 Don't boldify the flyspell language indicator in the mode line * lisp/textmodes/flyspell.el (flyspell-mode): Don't boldify the language part -- it draws too much attention in the minor mode list. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 65702d081f..2757074f9f 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -539,7 +539,6 @@ in your init file. ispell-dictionary "--") 0 2))) - face bold help-echo "mouse-1: Change dictionary" local-map (keymap (mode-line keymap commit 50be6d9fe954bea6543025a6a7bfc2d606ac34eb Author: Stephen Berman Date: Sun Oct 11 06:05:49 2020 +0200 Allow killing files with C-k in wdired if -F is used * lisp/wdired.el (wdired-change-to-wdired-mode): Add hook to restore properties. (wdired-change-to-wdired-mode): Adjust check for symlinks. (wdired-preprocess-files): Fix parsing when using the -F flag. (wdired-get-filename): Fix parsing of symlinks when using the -F flag. (wdired--restore-properties): Renamed, and restore more properties (bug#18475). diff --git a/lisp/wdired.el b/lisp/wdired.el index 40f4cd9719..da162b7bb2 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -255,7 +255,7 @@ See `wdired-mode'." (setq buffer-read-only nil) (dired-unadvertise default-directory) (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t) - (add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t) + (add-hook 'after-change-functions 'wdired--restore-properties nil t) (setq major-mode 'wdired-mode) (setq mode-name "Editable Dired") (setq revert-buffer-function 'wdired-revert) @@ -266,7 +266,7 @@ See `wdired-mode'." (wdired-preprocess-files) (if wdired-allow-to-change-permissions (wdired-preprocess-perms)) - (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link)) + (if (fboundp 'make-symbolic-link) (wdired-preprocess-symlinks)) (buffer-enable-undo) ; Performance hack. See above. (set-buffer-modified-p nil) @@ -288,6 +288,7 @@ or \\[wdired-abort-changes] to abort changes"))) (save-excursion (goto-char (point-min)) (let ((b-protection (point)) + (used-F (dired-check-switches dired-actual-switches "F" "classify")) filename) (while (not (eobp)) (setq filename (dired-get-filename nil t)) @@ -299,8 +300,16 @@ or \\[wdired-abort-changes] to abort changes"))) (add-text-properties (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only))) (put-text-property b-protection (point) 'read-only t) - (setq b-protection (dired-move-to-end-of-filename t)) + (dired-move-to-end-of-filename t) (put-text-property (point) (1+ (point)) 'end-name t)) + (when (and used-F (looking-at "[*/@|=>]$")) (forward-char)) + (when (save-excursion + (and (re-search-backward + dired-permission-flags-regexp nil t) + (looking-at "l") + (search-forward " -> " (line-end-position) t))) + (goto-char (line-end-position))) + (setq b-protection (point)) (forward-line)) (put-text-property b-protection (point-max) 'read-only t)))) @@ -327,7 +336,8 @@ relies on WDired buffer's properties. Optional arg NO-DIR with value non-nil means don't include directory. Optional arg OLD with value non-nil means return old filename." ;; FIXME: Use dired-get-filename's new properties. - (let (beg end file) + (let ((used-F (dired-check-switches dired-actual-switches "F" "classify")) + beg end file) (save-excursion (setq end (line-end-position)) (beginning-of-line) @@ -339,7 +349,20 @@ non-nil means return old filename." ;; the filename end is found even when the filename is empty. ;; Fixes error and spurious newlines when marking files for ;; deletion. - (setq end (next-single-property-change beg 'end-name)) + (setq end (next-single-property-change beg 'end-name nil end)) + (when (save-excursion + (and (re-search-forward + dired-permission-flags-regexp nil t) + (goto-char (match-beginning 0)) + (looking-at "l") + (search-forward " -> " (line-end-position) t))) + (goto-char (match-beginning 0)) + (setq end (point))) + (when (and used-F + (save-excursion + (goto-char end) + (looking-back "[*/@|=>]$" (1- (point))))) + (setq end (1- end))) (setq file (buffer-substring-no-properties (1+ beg) end))) ;; Don't unquote the old name, it wasn't quoted in the first place (and file (setq file (wdired-normalize-filename file (not old))))) @@ -366,7 +389,7 @@ non-nil means return old filename." (setq mode-name "Dired") (dired-advertise) (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) - (remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t) + (remove-hook 'after-change-functions 'wdired--restore-properties t) (set (make-local-variable 'revert-buffer-function) 'dired-revert)) @@ -427,9 +450,9 @@ non-nil means return old filename." (when files-renamed (setq errors (+ errors (wdired-do-renames files-renamed)))) ;; We have to be in wdired-mode when wdired-do-renames is executed - ;; so that wdired--restore-dired-filename-prop runs, but we have - ;; to change back to dired-mode before reverting the buffer to - ;; avoid using wdired-revert, which changes back to wdired-mode. + ;; so that wdired--restore-properties runs, but we have to change + ;; back to dired-mode before reverting the buffer to avoid using + ;; wdired-revert, which changes back to wdired-mode. (wdired-change-to-dired-mode) (if changes (progn @@ -451,7 +474,11 @@ non-nil means return old filename." '(old-name nil end-name nil old-link nil end-link nil end-perm nil old-perm nil perm-changed nil)) - (message "(No changes to be performed)"))) + (message "(No changes to be performed)") + ;; Deleting file indicator characters or editing the symlink + ;; arrow in WDired are noops, so redisplay them immediately on + ;; returning to Dired. + (revert-buffer))) (when files-deleted (wdired-flag-for-deletion files-deleted)) (when (> errors 0) @@ -609,14 +636,24 @@ Optional arguments are ignored." ;; dired-filename text property, which allows functions that look for ;; this property (e.g. dired-isearch-filenames) to work in wdired-mode ;; and also avoids an error with non-nil wdired-use-interactive-rename -;; (bug#32173). -(defun wdired--restore-dired-filename-prop (beg end _len) +;; (bug#32173). Also prevents editing the symlink arrow (which is a +;; noop) from corrupting the link name (see bug#18475 for elaboration). +(defun wdired--restore-properties (beg end _len) (save-match-data (save-excursion (let ((lep (line-end-position)) (used-F (dired-check-switches dired-actual-switches "F" "classify"))) + ;; Deleting the space between the link name and the arrow (a + ;; noop) also deletes the end-name property, so restore it. + (when (and (save-excursion + (re-search-backward dired-permission-flags-regexp nil t) + (looking-at "l")) + (get-text-property (1- (point)) 'dired-filename) + (not (get-text-property (point) 'dired-filename)) + (not (get-text-property (point) 'end-name))) + (put-text-property (point) (1+ (point)) 'end-name t)) (beginning-of-line) (when (re-search-forward directory-listing-before-filename-regexp lep t) @@ -680,33 +717,36 @@ says how many lines to move; default is one line." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (if (looking-at dired-re-sym) - (progn - (re-search-forward " -> \\(.*\\)$") - (put-text-property (- (match-beginning 1) 2) - (1- (match-beginning 1)) 'old-link - (match-string-no-properties 1)) - (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t) - (put-text-property (1- (match-beginning 1)) - (match-beginning 1) - 'rear-nonsticky '(read-only)) - (put-text-property (match-beginning 1) - (match-end 1) 'read-only nil))) + (when (looking-at dired-re-sym) + (re-search-forward " -> \\(.*\\)$") + (put-text-property (1- (match-beginning 1)) + (match-beginning 1) 'old-link + (match-string-no-properties 1)) + (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t) + (unless wdired-allow-to-redirect-links + (put-text-property (match-beginning 0) + (match-end 1) 'read-only t))) (forward-line))))) - (defun wdired-get-previous-link (&optional old move) "Return the next symlink target. If OLD, return the old target. If MOVE, move point before it." (let (beg end target) (setq beg (previous-single-property-change (point) 'old-link nil)) - (if beg - (progn - (if old - (setq target (get-text-property (1- beg) 'old-link)) - (setq end (next-single-property-change beg 'end-link)) - (setq target (buffer-substring-no-properties (1+ beg) end))) - (if move (goto-char (1- beg))))) + (when beg + (when (save-excursion + (goto-char beg) + (and (looking-at " ") + (looking-back " ->" (line-beginning-position)))) + (setq beg (1+ beg))) + (if old + (setq target (get-text-property (1- beg) 'old-link)) + (setq end (save-excursion + (goto-char beg) + (next-single-property-change beg 'end-link nil + (line-end-position)))) + (setq target (buffer-substring-no-properties beg end))) + (if move (goto-char (1- beg)))) (and target (wdired-normalize-filename target t)))) (declare-function make-symbolic-link "fileio.c") commit 2a7488d42d873c0ab4c24abfeb7183953cccef34 Author: Lars Ingebrigtsen Date: Sun Oct 11 05:51:16 2020 +0200 Add support for displaying short documentation for function groups * doc/lispref/help.texi (Documentation Groups): Document it. * lisp/help-fns.el (help-fns--mention-shortdoc-groups): Output references to the shortdocs. * lisp/emacs-lisp/shortdoc.el: New file. diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index d4505d5c3f..f513a70949 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -37,6 +37,7 @@ Help, emacs, The GNU Emacs Manual}. * Describing Characters:: Making printable descriptions of non-printing characters and key sequences. * Help Functions:: Subroutines used by Emacs help facilities. +* Documentation Groups:: Listing functions by groups. @end menu @node Documentation Basics @@ -794,3 +795,154 @@ If this variable is non-@code{nil}, commands defined with echo area at first, and display the longer @var{help-text} strings only if the user types the help character again. @end defopt + + +@node Documentation Groups +@section Documentation Groups +@cindex documentation groups + +Emacs can list functions based on various groupings. For instance, +@code{string-trim} and @code{mapconcat} are ``string'' functions, so +@kbd{M-x shortdoc-display-group RET string RET} will give an overview +of functions that do things with strings. + +The documentation groups are created with the +@code{define-short-documentation-group} macro. Here's a very short +example: + +@lisp +(define-short-documentation-group string + "Creating Strings" + (substring + :eval (substring "foobar" 0 3) + :eval (substring "foobar" 3)) + (concat + :eval (concat "foo" "bar" "zot"))) +@end lisp + +The first argument is the name of the group to be defined, and then +follows any number of function descriptions. + +A function can belong to any number of documentation groups. + +In addition to function descriptions, the list can also have string +elements, which are used to divide a documentation group into +sections. + +In each function description, the first element is the name of the +function, and then the rest of the description is a plist, where the +first element in each pair is a type, and the second element is a +value. + +The following types are allowed: + +@table @code +@item :eval +The value should be a form that can be evaluated with no side +effects. The form will be used in the documentation as printed with +@code{prin1}, except if it's a string: Then it will be inserted as is, +and the string with then be @code{read} to return the form. In any +case, the form will then be evaluated, and the result used. For +instance: + +@example +:eval (concat "foo" "bar" "zot") +:eval "(make-string 5 ?x)" +@end example + +will be printed as + +@example +(concat "foo" "bar" "zot") +=> "foobarzot" +(make-string 5 ?x) +=> "xxxxx" +@end example + +The reason for allowing both Lisp forms and strings here is so that +printing can be controlled in the few cases where a certain +presentation of the form is wished for. In the example, @samp{?x} +would otherwise have been printed as @samp{120} if it hadn't been +included in a string. + +@item :no-eval + +This is like @code{eval}, except that the form will not be evaluated. +In these cases, a @code{:result} element of some kind should be +included. + +@example +:no-eval (file-symlink-p "/tmp/foo") +:eg-result t +@end example + +@item :no-eval* +Like @code{:no-eval}, but a result of @samp{[it depends]} will always +be inserted. + +@example +:no-eval* (buffer-string) +@end example + +will result in: + +@example +(buffer-string) +-> [it depends] +@end example + +@item :no-value +Like @code{:no-eval}, but is used when the function in question has no +well-defined return value, but is used for side effect only. + +@item :result +Used to output the result from non-evaluating example forms. + +@example +:no-eval (setcar list 'c) +:result c +@end example + +@item :eg-result +Used to output an example result from non-evaluating example forms. + +@example +:no-eval (looking-at "f[0-9]") +:eg-result t +@end example + +@item :result-string +@itemx :eg-result-string +These two are the same as @code{:result} and @code{:eg-result}, +respectively, but are inserted as is. This is useful when the result +is unreadable or should be on a particular form: + +@example +:no-eval (find-file "/tmp/foo") +:eg-result-string "#" +:no-eval (default-file-modes) +:eg-result-string "#o755" +@end example + +@item :no-manual +This function is not documented in the manual. + +@item :args +By default, the function's actual argument list is shown. If +@code{:args} is present, use that instead. + +@example +:args (regexp string) +@end example + +@end table + +@defun shortdoc-add-function shortdoc-add-function group section elem +External packages can add functions to groups with this command. Each +@var{elem} should be a function descriptions, as seen above. +@var{group} is the function group, and @var{section} is what section +in the function group to insert the function into. + +If @var{group} doesn't exist, it will be created. If @var{section} +doesn't exist, it will be added to the end of the function group. +@end defun diff --git a/etc/NEWS b/etc/NEWS index e1f9382228..3166eb22a6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -85,6 +85,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 ++++ +*** A new system for displaying documentation for groups of function is added. +This can either be used by saying 'M-x short-documentation-group' and +choosing a group, or clicking a button in the *Help* buffers when +looking at the doc string of a function that belongs to one of these +groups. + *** New var 'redisplay-skip-initial-frame' to enable batch redisplay tests. Setting it to nil forces the redisplay to do its job even in the initial frame used in batch mode. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el new file mode 100644 index 0000000000..f4eeb996af --- /dev/null +++ b/lisp/emacs-lisp/shortdoc.el @@ -0,0 +1,1077 @@ +;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Keywords: lisp, help +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'macroexp) +(require 'seq) +(eval-when-compile (require 'cl-lib)) + +(defgroup shortdoc nil + "Short documentation." + :group 'lisp) + +(defface shortdoc-section + '((((class color) (background dark)) + (:inherit variable-pitch + :background "#303030" :extend t)) + (((class color) (background light)) + (:inherit variable-pitch + :background "#d0d0d0" :extend t))) + "Face used for a section.") + +(defface shortdoc-example + '((((class color) (background dark)) + (:background "#202020" :extend t)) + (((class color) (background light)) + (:background "#c0c0c0" :extend t))) + "Face used for examples.") + +(defvar shortdoc--groups nil) + +(defmacro define-short-documentation-group (group &rest functions) + "Add GROUP to the list of defined documentation groups. +FUNCTIONS is a list of elements on the form: + + (fun + :no-manual BOOL + :args ARGS + :eval EXAMPLE-FORM + :no-eval EXAMPLE-FORM + :no-value EXAMPLE-FORM + :result RESULT-FORM + :eg-result RESULT-FORM + :eg-result-string RESULT-FORM) + +BOOL should be non-nil if the function isn't documented in the +manual. + +ARGS is optional, and the functions definition is displayed +instead in not present. + +If EVAL isn't a string, it will be printed with `prin1', and then +evaled to give a result, which is also printed. If it's a +string, it'll be inserted as is, then the string will be `read', +and then evaled. + +There can be any number of :example/:result elements." + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups))) + +(define-short-documentation-group string + "Making Strings" + (make-string + :args (length init) + :eval "(make-string 5 ?x)") + (string + :eval "(string ?a ?b ?c)") + (concat + :eval (concat "foo" "bar" "zot")) + (string-join + :no-manual t + :eval (string-join '("foo" "bar" "zot") " ")) + (mapconcat + :eval (mapconcat (lambda (a) (concat "[" a "]")) + '("foo" "bar" "zot") " ")) + (mapcar + :eval (mapcar #'identity "123")) + (format + :eval (format "This number is %d" 4)) + "Manipulating Strings" + (substring + :eval (substring "foobar" 0 3) + :eval (substring "foobar" 3)) + (split-string + :eval (split-string "foo bar") + :eval (split-string "|foo|bar|" "|") + :eval (split-string "|foo|bar|" "|" t)) + (string-replace + :eval (string-replace "foo" "bar" "foozot")) + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-trim + :no-manual t + :args (string) + :doc "Trim STRING of leading and trailing white space." + :eval (string-trim " foo ")) + (string-trim-left + :no-manual t + :eval (string-trim-left "oofoo" "o+")) + (string-trim-right + :no-manual t + :eval (string-trim-right "barkss" "s+")) + (string-truncate-left + :no-manual t + :eval (string-truncate-left "longstring" 8)) + (string-remove-suffix + :no-manual t + :eval (string-remove-suffix "bar" "foobar")) + (string-remove-prefix + :no-manual t + :eval (string-remove-prefix "foo" "foobar")) + (reverse + :eval (reverse "foo")) + (substring-no-properties + :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) + "Predicates for Strings" + (string-equal + :eval (string-equal "foo" "foo")) + (eq + :eval (eq "foo" "foo")) + (eql + :eval (eql "foo" "foo")) + (equal + :eval (equal "foo" "foo")) + (cl-equalp + :eval (cl-equalp "Foo" "foo")) + (stringp + :eval "(stringp ?a)") + (string-empty-p + :no-manual t + :eval (string-empty-p "")) + (string-blank-p + :no-manual t + :eval (string-blank-p " \n")) + (string-lessp + :eval (string-lessp "foo" "bar")) + (string-greaterp + :eval (string-greaterp "foo" "bar")) + (string-version-lessp + :eval (string-lessp "foo32.png" "bar4.png")) + (string-prefix-p + :eval (string-prefix-p "foo" "foobar")) + (string-suffix-p + :eval (string-suffix-p "bar" "foobar")) + "Case Manipulation" + (upcase + :eval (upcase "foo")) + (downcase + :eval (downcase "FOObar")) + (capitalize + :eval (capitalize "foo bar zot")) + (upcase-initials + :eval (upcase-initials "The CAT in the hAt")) + "Converting Strings" + (string-to-number + :eval (string-to-number "42") + :eval (string-to-number "deadbeef" 16)) + (number-to-string + :eval (number-to-string 42)) + "Data About Strings" + (length + :eval (length "foo")) + (string-search + :eval (string-search "bar" "foobarzot")) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (seq-position + :eval "(seq-position \"foobarzot\" ?z)")) + +(define-short-documentation-group file-name + "File Name Manipulation" + (file-name-directory + :eval (file-name-directory "/tmp/foo") + :eval (file-name-directory "/tmp/foo/")) + (file-name-nondirectory + :eval (file-name-nondirectory "/tmp/foo") + :eval (file-name-nondirectory "/tmp/foo/")) + (file-name-sans-versions + :args (filename) + :eval (file-name-sans-versions "/tmp/foo~")) + (file-name-extension + :eval (file-name-extension "/tmp/foo.txt")) + (file-name-sans-extension + :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-base + :eval (file-name-base "/tmp/foo.txt")) + (file-relative-name + :eval (file-relative-name "/tmp/foo" "/tmp")) + (make-temp-name + :eval (make-temp-name "/tmp/foo-")) + (expand-file-name + :eval (expand-file-name "foo" "/tmp/")) + (substitute-in-file-name + :eval (substitute-in-file-name "$HOME/foo")) + "Directory Functions" + (file-name-as-directory + :eval (file-name-as-directory "/tmp/foo")) + (directory-file-name + :eval (directory-file-name "/tmp/foo/")) + (abbreviate-file-name + :no-eval (abbreviate-file-name "/home/some-user") + :eg-result "~some-user") + "Quoted File Names" + (file-name-quote + :args (name) + :eval (file-name-quote "/tmp/foo")) + (file-name-unquote + :args (name) + :eval (file-name-unquote "/:/tmp/foo")) + "Predicates" + (file-name-absolute-p + :eval (file-name-absolute-p "/tmp/foo") + :eval (file-name-absolute-p "foo")) + (directory-name-p + :eval (directory-name-p "/tmp/foo/")) + (file-name-quoted-p + :eval (file-name-quoted-p "/:/tmp/foo"))) + +(define-short-documentation-group file + "Inserting Contents" + (insert-file-contents + :no-eval (insert-file-contents "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (insert-file-contents-literally + :no-eval (insert-file-contents-literally "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (find-file + :no-eval (find-file "/tmp/foo") + :eg-result-string "#") + "Predicates" + (file-symlink-p + :no-eval (file-symlink-p "/tmp/foo") + :eg-result t) + (file-directory-p + :no-eval (file-directory-p "/tmp") + :eg-result t) + (file-regular-p + :no-eval (file-regular-p "/tmp/foo") + :eg-result t) + (file-exists-p + :no-eval (file-exists-p "/tmp/foo") + :eg-result t) + (file-readable-p + :no-eval (file-readable-p "/tmp/foo") + :eg-result t) + (file-writeable-p + :no-eval (file-writeable-p "/tmp/foo") + :eg-result t) + (file-accessible-directory-p + :no-eval (file-accessible-directory-p "/tmp") + :eg-result t) + (file-executable-p + :no-eval (file-executable-p "/bin/cat") + :eg-result t) + (file-newer-than-file-p + :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") + :eg-result nil) + (file-equal-p + :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") + :eg-result nil) + (file-in-directory-p + :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") + :eg-result t) + (file-locked-p + :no-eval (file-locked-p "/tmp/foo") + :eg-result nil) + "Information" + (file-attributes + :no-eval* (file-attributes "/tmp")) + (file-truename + :no-eval (file-truename "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (file-chase-links + :no-eval (file-chase-links "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (vc-responsible-backend + :no-eval (vc-responsible-backend "/src/foo/bar.c") + :eg-result Git) + (file-acl + :no-eval (file-acl "/tmp/foo") + :eg-result "user::rw-\ngroup::r--\nother::r--\n") + (file-extended-attributes + :no-eval* (file-extended-attributes "/tmp/foo")) + (file-selinux-context + :no-eval* (file-selinux-context "/tmp/foo")) + (locate-file + :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) + :eg-result "/var/log/syslog") + (executable-find + :no-eval (executable-find "ls") + :eg-result "/usr/bin/ls") + "Creating" + (make-temp-file + :no-eval (make-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-ZcXFMj") + (make-nearby-temp-file + :no-eval (make-nearby-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-xe8iON") + (write-region + :no-value (write-region (point-min) (point-max) "/tmp/foo")) + "Directories" + (make-directory + :no-value (make-directory "/tmp/bar/zot/" t)) + (directory-files + :no-eval (directory-files "/tmp/") + :eg-result ("." ".." ".ICE-unix" ".Test-unix")) + (directory-files-recursively + :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") + :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) + (directory-files-and-attributes + :no-eval* (directory-files-and-attributes "/tmp/foo")) + (file-expand-wildcards + :no-eval (file-expand-wildcards "/tmp/*.png") + :eg-result ("/tmp/foo.png" "/tmp/zot.png")) + (locate-dominating-file + :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") + :eg-result "/tmp/foo.png") + (copy-directory + :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) + (delete-directory + :no-value (delete-directory "/tmp/bar/")) + "File Operations" + (rename-file + :no-value (rename-file "/tmp/foo" "/tmp/newname")) + (copy-file + :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) + (delete-file + :no-value (delete-file "/tmp/foo")) + (make-empty-file + :no-value (make-empty-file "/tmp/foo")) + (make-symbolic-link + :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) + (add-name-to-file + :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) + (set-file-modes + :no-value "(set-file-modes \"/tmp/foo\" #o644)") + (set-file-times + :no-value (set-file-times "/tmp/foo" (current-time))) + "File Modes" + (set-default-file-modes + :no-value "(set-default-file-modes #o755)") + (default-file-modes + :no-eval (default-file-modes) + :eg-result-string "#o755") + (file-modes-symbolic-to-number + :no-eval (file-modes-symbolic-to-number "a+r") + :eg-result-string "#o444") + (file-modes-number-to-symbolic + :eval "(file-modes-number-to-symbolic #o444)") + (set-file-extended-attributes + :no-eval (set-file-extended-attributes + "/tmp/foo" '((acl . "group::rxx"))) + :eg-result t) + (set-file-selinux-context + :no-eval (set-file-selinux-context + "/tmp/foo" '(unconfined_u object_r user_home_t s0)) + :eg-result t) + (set-file-acl + :no-eval (set-file-acl "/tmp/foo" "group::rxx") + :eg-result t)) + + +(define-short-documentation-group list + "Making Lists" + (make-list + :eval (make-list 5 'a)) + (cons + :eval (cons 1 '(2 3 4))) + (list + :eval (list 1 2 3)) + (number-sequence + :eval (number-sequence 5 8)) + "Operations on Lists" + (append + :eval (append '("foo" "bar") '("zot"))) + (copy-tree + :eval (copy-tree '(1 (2 3) 4))) + (flatten-tree + :eval (flatten-tree '(1 (2 3) 4))) + (car + :eval (car '(one two three))) + (cdr + :eval (cdr '(one two three))) + (last + :eval (last '(one two three))) + (butlast + :eval (butlast '(one two three))) + (nbutlast + :eval (nbutlast (list 'one 'two 'three))) + (nth + :eval (nth 1 '(one two three))) + (nthcdr + :eval (nthcdr 1 '(one two three))) + (elt + :eval (elt '(one two three) 1)) + (car-safe + :eval (car-safe '(one two three))) + (cdr-safe + :eval (cdr-safe '(one two three))) + (push + :no-eval* (push 'a list)) + (pop + :no-eval* (pop list)) + (setcar + :no-eval (setcar list 'c) + :result c) + (setcdr + :no-eval (setcdr list (list c)) + :result '(c)) + (nconc + :eval (nconc (list 1) (list 2 3 4))) + (delq + :eval (delq 2 (list 1 2 3 4)) + :eval (delq "a" (list "a" "b" "c" "d"))) + (delete + :eval (delete 2 (list 1 2 3 4)) + :eval (delete "a" (list "a" "b" "c" "d"))) + (remove + :eval (remove 2 '(1 2 3 4)) + :eval (remove "a" '("a" "b" "c" "d"))) + (delete-dups + :eval (delete-dups (list 1 2 4 3 2 4))) + "Mapping Over Lists" + (mapcar + :eval (mapcar #'list '(1 2 3))) + (mapcan + :eval (mapcan #'list '(1 2 3))) + (mapc + :eval (mapc #'insert '("1" "2" "3"))) + (reduce + :eval (reduce #'+ '(1 2 3))) + (mapconcat + :eval (mapconcat #'identity '("foo" "bar") "|")) + "Predicates" + (listp + :eval (listp '(1 2 3)) + :eval (listp nil) + :eval (listp '(1 . 2))) + (consp + :eval (consp '(1 2 3)) + :eval (consp nil)) + (proper-list-p + :eval (proper-list-p '(1 2 3)) + :eval (proper-list-p nil) + :eval (proper-list-p '(1 . 2))) + (null + :eval (null nil)) + (atom + :eval (atom 'a)) + (nlistp + :eval (nlistp '(1 2 3)) + :eval (nlistp t) + :eval (nlistp '(1 . 2))) + "Finding Elements" + (memq + :eval (memq 2 '(1 2 3)) + :eval (memq 2.0 '(1.0 2.0 3.0)) + :eval (memq "b" '("a" "b" "c"))) + (member + :eval (member 2 '(1 2 3)) + :eval (member "b" '("a" "b" "c"))) + (remq + :eval (remq 2 '(1 2 3 2 4 2)) + :eval (remq "b" '("a" "b" "c"))) + (memql + :eval (memql 2.0 '(1.0 2.0 3.0))) + (member-ignore-case + :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) + "Association Lists" + (assoc + :eval (assoc 'b '((a 1) (b 2)))) + (rassoc + :eval (rassoc '2 '((a . 1) (b . 2)))) + (assq + :eval (assq 'b '((a 1) (b 2))) + :eval (assq "a" '(("a" 1) ("b" 2)))) + (rassq + :eval (rassq '2 '((a . 1) (b . 2)))) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (alist-get + :eval (alist-get 2 '((1 . a) (2 . b)))) + (assoc-default + :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) + (copy-alist + :eval (copy-alist '((1 . a) (2 . b)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + "Property Lists" + (plist-get + :eval (plist-get '(a 1 b 2 c 3) 'b)) + (plist-put + :no-eval (setq plist (plist-put plist 'd 4)) + :eq-result (a 1 b 2 c 3 d 4)) + (lax-plist-get + :eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b")) + (lax-plist-put + :no-eval (setq plist (plist-put plist "d" 4)) + :eq-result '("a" 1 "b" 2 "c" 3 "d" 4)) + (plist-member + :eval (plist-member '(a 1 b 2 c 3) 'b)) + "Data About Lists" + (length + :eval (length '(a b c))) + (safe-length + :eval (safe-length '(a b c)))) + + +(define-short-documentation-group vector + (make-vector + :eval (make-vector 5 "foo")) + (vector + :eval (vector 1 "b" 3)) + (vectorp + :eval (vectorp [1]) + :eval (vectorp "1")) + (vconcat + :eval (vconcat '(1 2) [3 4])) + (append + :eval (append [1 2] nil)) + (length + :eval (length [1 2 3])) + (mapcar + :eval (mapcar #'identity [1 2 3])) + (reduce + :eval (reduce #'+ [1 2 3])) + (seq-subseq + :eval (seq-subseq [1 2 3 4 5] 1 3) + :eval (seq-subseq [1 2 3 4 5] 1))) + +(define-short-documentation-group regexp + "Matching Strings" + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-match-p + :eval (string-match-p "^[fo]+" "foobar")) + (match-string + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + (match-string 0 "foobar"))) + (match-beginning + :no-eval (match-beginning 1) + :eg-result 0) + (match-end + :no-eval (match-end 1) + :eg-result 3) + "Looking in Buffers" + (re-search-forward + :no-eval (re-search-forward "^foo$" nil t) + :eg-result 43) + (re-search-backward + :no-eval (re-search-backward "^foo$" nil t) + :eg-result 43) + (looking-at-p + :no-eval (looking-at "f[0-9]") + :eg-result t) + "Utilities" + (regexp-quote + :eval (regexp-quote "foo.*bar")) + (regexp-opt + :eval (regexp-opt '("foo" "bar"))) + (regexp-opt-depth + :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) + (regexp-opt-charset + :eval (regexp-opt-charset '(?a ?b ?c ?d ?e)))) + +(define-short-documentation-group sequence + "Sequence Predicates" + (seq-contains-p + :eval (seq-contains '(a b c) 'b) + :eval (seq-contains '(a b c) 'd)) + (seq-every-p + :eval (seq-every-p #'numberp '(1 2 3))) + (seq-empty-p + :eval (seq-empty-p [])) + (seq-set-equal-p + :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) + (seq-some + :eval (seq-some #'cl-evenp '(1 2 3))) + "Building Sequences" + (seq-concatenate + :eval (seq-concatenate 'vector '(1 2) '(c d))) + (seq-copy + :eval (seq-copy '(a 2))) + (seq-into + :eval (seq-into '(1 2 3) 'vector)) + "Utility Functions" + (seq-count + :eval (seq-count #'numberp '(1 b c 4))) + (seq-elt + :eval (seq-elt '(a b c) 1)) + (seq-random-elt + :no-eval (seq-random-elt '(a b c)) + :eg-result c) + (seq-find + :eval (seq-find #'numberp '(a b 3 4 f 6))) + (seq-position + :eval (seq-position '(a b c) 'c)) + (seq-length + :eval (seq-length "abcde")) + (seq-max + :eval (seq-max [1 2 3])) + (seq-min + :eval (seq-min [1 2 3])) + (seq-first + :eval (seq-first [a b c])) + (seq-rest + :eval (seq-rest '[1 2 3])) + (seq-reverse + :eval (seq-reverse '(1 2 3))) + (seq-sort + :eval (seq-sort #'> '(1 2 3))) + (seq-sort-by + :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) + "Mapping Over Sequences" + (seq-map + :eval (seq-map #'1+ '(1 2 3))) + (seq-map-indexed + :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) + (seq-mapcat + :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) + (seq-do + :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) + :eg-result ("foo" "bar")) + (seq-do-indexed + :no-eval (seq-do-indexed + (lambda (a index) (message "%s:%s" index a)) + '("foo" "bar")) + :eg-result nil) + (seq-reduce + :eval (seq-reduce #'* [1 2 3] 2)) + "Excerpting Sequences" + (seq-drop + :eval (seq-drop '(a b c) 2)) + (seq-drop-while + :eval (seq-drop-while #'numberp '(1 2 c d 5))) + (seq-filter + :eval (seq-filter #'numberp '(a b 3 4 f 6))) + (seq-remove + :eval (seq-remove #'numberp '(1 2 c d 5))) + (seq-group-by + :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6))) + (seq-difference + :eval (seq-difference '(1 2 3) '(2 3 4))) + (seq-intersection + :eval (seq-intersection '(1 2 3) '(2 3 4))) + (seq-partition + :eval (seq-partition '(a b c d e f g h) 3)) + (seq-subseq + :eval (seq-subseq '(a b c d e) 2 4)) + (seq-take + :eval (seq-take '(a b c d e) 3)) + (seq-take-while + :eval (seq-take-while #'cl-evenp [2 4 9 6 5])) + (seq-uniq + :eval (seq-uniq '(a b d b a c)))) + +(define-short-documentation-group buffer + "Buffer Basics" + (current-buffer + :no-eval (current-buffer) + :eg-result-string "#") + (bufferp + :eval (bufferp 23)) + (buffer-live-p + :no-eval (buffer-live-p some-buffer) + :eg-result t) + (buffer-modified-p + :eval (buffer-modified-p (current-buffer))) + (buffer-name + :eval (buffer-name)) + (window-buffer + :eval (window-buffer)) + "Selecting Buffers" + (get-buffer-create + :no-eval (get-buffer-create "*foo*") + :eg-result-string "#") + (pop-to-buffer + :no-eval (pop-to-buffer "*foo*") + :eg-result-string "#") + (with-current-buffer + :no-eval* (with-current-buffer buffer (buffer-size))) + "Points and Positions" + (point + :eval (point)) + (point-min + :eval (point-max)) + (point-max + :eval (point-max)) + (line-beginning-position + :eval (line-beginning-position)) + (line-end-position + :eval (line-end-position)) + (buffer-size + :eval (buffer-size)) + "Moving Around" + (goto-char + :no-eval (goto-char (point-max)) + :eg-result 342) + (search-forward + :no-eval (search-forward "some-string" nil t) + :eg-result 245) + (re-search-forward + :no-eval (re-search-forward "some-s.*g" nil t) + :eg-result 245) + (forward-line + :no-eval (forward-line 1) + :eg-result 0 + :no-eval (forward-line -2) + :eg-result 0) + "Strings from Buffers" + (buffer-string + :no-eval* (buffer-string)) + (buffer-substring + :eval (buffer-substring (point-min) (+ (point-min) 10))) + (buffer-substring-no-properties + :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) + (following-char + :no-eval (following-char) + :eg-result 67) + (char-after + :eval (char-after 45)) + "Altering Buffers" + (delete-region + :no-value (delete-region (point-min) (point-max))) + (erase-buffer + :no-value (erase-buffer)) + (insert + :no-value (insert "This string will be inserted in the buffer\n")) + "Locking" + (lock-buffer + :no-value (lock-buffer "/tmp/foo")) + (unlock-buffer + :no-value (lock-buffer))) + +(define-short-documentation-group process + (make-process + :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) + :eg-result-string "#") + (processp + :eval (processp t)) + (delete-process + :no-value (delete-process process)) + (kill-process + :no-value (kill-process process)) + (set-process-sentinel + :no-value (set-process-sentinel process (lambda (proc string)))) + (process-buffer + :no-eval (process-buffer process) + :eg-result-string "#") + (get-buffer-process + :no-eval (get-buffer-process buffer) + :eg-result-string "#") + (process-live-p + :no-eval (process-live-p process) + :eg-result t)) + +(define-short-documentation-group number + "Arithmetic" + (+ + :eval (+ 1 2) + :eval (+ 1 2 3 4)) + (- + :eval (- 3 2) + :eval (- 6 3 2)) + (* + :eval (* 3 4 5)) + (/ + :eval (/ 10 5) + :eval (/ 10 6) + :eval (/ 10.0 6) + :eval (/ 10.0 3 3)) + (% + :eval (% 10 5) + :eval (% 10 6)) + (mod + :eval (mod 10 5) + :eval (mod 10 6) + :eval (mod 10.5 6)) + (1+ + :eval (1+ 2)) + (1- + :eval (1- 4)) + "Predicates" + (= + :eval (= 4 4) + :eval (= 4.0 4.0) + :eval (= 4 5 6 7)) + (eq + :eval (eq 4 4) + :eval (eq 4.0 4.0)) + (eql + :eval (eql 4 4) + :eval (eql 4 "4") + :eval (eql 4.0 4.0)) + (/= + :eval (/= 4 4)) + (< + :eval (< 4 4) + :eval (< 1 2 3)) + (<= + :eval (<= 4 4) + :eval (<= 1 2 3)) + (> + :eval (> 4 4) + :eval (> 1 2 3)) + (>= + :eval (>= 4 4) + :eval (>= 1 2 3)) + (zerop + :eval (zerop 0)) + (cl-plusp + :eval (cl-plusp 0) + :eval (cl-plusp 1)) + (bignump + :eval (bignump 4) + :eval (bignump (expt 2 90))) + (fixnump + :eval (fixnump 4) + :eval (fixnump (expt 2 90))) + (floatp + :eval (floatp 5.4)) + (integerp + :eval (integerp 5.4)) + (numberp + :eval (numberp "5.4")) + (natnump + :eval (natnump -1) + :eval (natnump 23)) + "Operations" + (max + :eval (max 7 9 3)) + (min + :eval (min 7 9 3)) + (abs + :eval (abs -4)) + (float + :eval (float 2)) + (truncate + :eval (truncate 1.2) + :eval (truncate -1.2) + :eval (truncate 5.4 2)) + (floor + :eval (floor 1.2) + :eval (floor -1.2) + :eval (floor 5.4 2)) + (ceiling + :eval (ceiling 1.2) + :eval (ceiling -1.2) + :eval (ceiling 5.4 2)) + (round + :eval (round 1.2) + :eval (round -1.2) + :eval (round 5.4 2)) + (random + :eval (random 6)) + "Bit Operations" + (ash + :eval (ash 1 4) + :eval (ash 16 -1)) + (lsh + :eval (lsh 1 4) + :eval (lsh 16 -1)) + (logand + :no-eval "(logand #b10 #b111)" + :result-string "#b10") + (logior + :eval (logior 4 16)) + (logxor + :eval (logxor 4 16)) + (lognot + :eval (lognot 5)) + (logcount + :eval (logcount 5)) + "Floating Point" + (isnan + :eval (isnan 5.0)) + (frexp + :eval (frexp 5.7)) + (ldexp + :eval (ldexp 0.7125 3)) + (logb + :eval (logb 10.5)) + (ffloor + :eval (floor 1.2)) + (fceiling + :eval (fceiling 1.2)) + (ftruncate + :eval (ftruncate 1.2)) + (fround + :eval (fround 1.2)) + "Standard Math Functions" + (sin + :eval (sin float-pi)) + (cos + :eval (cos float-pi)) + (tan + :eval (tan float-pi)) + (asin + :eval (asin float-pi)) + (acos + :eval (acos float-pi)) + (atan + :eval (atan float-pi)) + (exp + :eval (exp 4)) + (log + :eval (log 54.59)) + (expt + :eval (expt 2 16)) + (sqrt + :eval (sqrt -1))) + +(defun shortdoc-display-group (group) + "Pop to a buffer and display short documentation for functions in GROUP." + (interactive (list (completing-read "Show functions in: " + (mapcar #'car shortdoc--groups)))) + (when (stringp group) + (setq group (intern group))) + (unless (assq group shortdoc--groups) + (error "No such documentation group %s" group)) + (pop-to-buffer (format "*Shortdoc %s*" group)) + (let ((inhibit-read-only t)) + (erase-buffer) + (special-mode) + (button-mode) + (mapc + (lambda (data) + (cond + ((stringp data) + (insert (propertize + (concat data "\n\n") + 'face '(variable-pitch (:height 1.3 :weight bold))))) + ;; There may be functions not yet defined in the data. + ((fboundp (car data)) + (shortdoc--display-function data)))) + (cdr (assq group shortdoc--groups)))) + (goto-char (point-min))) + +(defun shortdoc--display-function (data) + (let ((function (pop data)) + (start-section (point)) + arglist-start) + ;; Function calling convention. + (insert "(") + (if (plist-get data :no-manual) + (insert (symbol-name function)) + (insert-text-button + (symbol-name function) + 'face 'button + 'action (lambda (_) + (info-lookup-symbol function 'emacs-lisp-mode)))) + (setq arglist-start (point)) + (insert ")\n") + ;; Doc string. + (insert " " + (or (plist-get data :doc) + (car (split-string (documentation function) "\n")))) + (insert "\n") + (add-face-text-property start-section (point) 'shortdoc-section t) + (let ((start (point)) + (print-escape-newlines t)) + (cl-loop for (type value) on data by #'cddr + do + (cl-case type + (:eval + (if (stringp value) + (insert " " value "\n") + (insert " ") + (prin1 value (current-buffer)) + (insert "\n") + (insert " => ") + (prin1 (eval value) (current-buffer)) + (insert "\n"))) + (:no-eval* + (if (stringp value) + (insert " " value "\n") + (insert " ") + (prin1 value (current-buffer))) + (insert "\n -> " + (propertize "[it depends]" + 'face 'variable-pitch) + "\n")) + (:no-value + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:no-eval + (if (stringp value) + (insert " " value) + (insert " ") + (prin1 value (current-buffer))) + (insert "\n")) + (:result + (insert " => ") + (prin1 value (current-buffer)) + (insert "\n")) + (:result-string + (insert " => ") + (princ value (current-buffer)) + (insert "\n")) + (:eg-result + (insert " eg. => ") + (prin1 value (current-buffer)) + (insert "\n")) + (:eg-result-string + (insert " eg. => ") + (princ value (current-buffer)) + (insert "\n")))) + (put-text-property start (point) 'face 'shortdoc-example)) + (insert "\n") + ;; Insert the arglist after doing the evals, in case that's pulled + ;; in the function definition. + (save-excursion + (goto-char arglist-start) + (dolist (param (or (plist-get data :args) + (help-function-arglist function t))) + (insert " " (symbol-name param))) + (add-face-text-property arglist-start (point) 'shortdoc-section t)))) + +(defun shortdoc-function-groups (function) + "Return all shortdoc groups FUNCTION appears in." + (cl-loop for group in shortdoc--groups + when (assq function (cdr group)) + collect (car group))) + +(defun shortdoc-add-function (group section elem) + "Add ELEM to shortdoc GROUP in SECTION. +If SECTION doesn't exist, it will be added. + +Example: + + (shortdoc-add-function + 'file \"Predicates\" + '(file-locked-p :no-eval (file-locked-p \"/tmp\")))" + (let ((glist (assq group shortdoc--groups))) + (unless glist + (setq glist (list group)) + (setq shortdoc--groups (append shortdoc--groups (list glist)))) + (let ((slist (member section glist))) + (unless slist + (setq slist (list section)) + (setq slist (append glist slist))) + (while (and (cdr slist) + (not (stringp (cadr slist)))) + (setq slist (cdr slist))) + (setcdr slist (cons elem (cdr slist)))))) + +(provide 'shortdoc) + +;;; shortdoc.el ends here diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 24fb09137c..ee626ebc70 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -659,6 +659,39 @@ FILE is the file where FUNCTION was probably defined." (insert (format " Probably introduced at or before Emacs version %s.\n" first)))))) +(declare-function shortdoc-display-group "shortdoc") +(declare-function shortdoc-function-groups "shortdoc") + +(add-hook 'help-fns-describe-function-functions + #'help-fns--mention-shortdoc-groups) +(defun help-fns--mention-shortdoc-groups (object) + (require 'shortdoc) + (when-let ((groups (and (symbolp object) + (shortdoc-function-groups object)))) + (let ((start (point)) + (times 0)) + (with-current-buffer standard-output + (insert " Other relevant functions are documented in the ") + (mapc + (lambda (group) + (when (> times 0) + (insert (if (= times (1- (length groups))) + " and " + ", "))) + (setq times (1+ times)) + (insert-text-button + (symbol-name group) + 'action (lambda (_) + (shortdoc-display-group group)))) + groups) + (insert (if (= (length groups) 1) + " group.\n" + " groups.\n"))) + (save-restriction + (narrow-to-region start (point)) + (fill-region-as-paragraph (point-min) (point-max)) + (goto-char (point-max)))))) + (defun help-fns-short-filename (filename) (let* ((abbrev (abbreviate-file-name filename)) (short abbrev)) commit f38751db5dd9ff62367d382df85063e924239662 Author: Juri Linkov Date: Sun Oct 11 05:04:40 2020 +0200 Make C-w worth in isearch when at the last match in the buffer * lisp/isearch.el (isearch-yank-internal): Make C-w work when at the last match in the buffer (bug#22118). diff --git a/lisp/isearch.el b/lisp/isearch.el index f39de79303..1efd9b2130 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2535,6 +2535,8 @@ is bound to outside of Isearch." (let ((pasted-text (nth 1 event))) (isearch-yank-string pasted-text)))) +(defvar isearch--yank-prev-point nil) + (defun isearch-yank-internal (jumpform) "Pull the text from point to the point reached by JUMPFORM. JUMPFORM is a lambda expression that takes no arguments and returns @@ -2545,7 +2547,14 @@ or it might return the position of the end of the line." (save-excursion (and (not isearch-forward) isearch-other-end (goto-char isearch-other-end)) - (buffer-substring-no-properties (point) (funcall jumpform))))) + (and (not isearch-success) isearch--yank-prev-point + (goto-char isearch--yank-prev-point)) + (buffer-substring-no-properties + (point) + (prog1 + (setq isearch--yank-prev-point (funcall jumpform)) + (when isearch-success + (setq isearch--yank-prev-point nil))))))) (defun isearch-yank-char-in-minibuffer (&optional arg) "Pull next character from buffer into end of search string in minibuffer." commit 8b1c6476bb4532c89bd1942525559d30bbae14ee Author: Noam Postavsky Date: Sun Oct 11 04:25:52 2020 +0200 Clarify how to set single-function hooks * doc/lispref/modes.texi (Hooks): Clarify the difference between normal hooks and single-function "hooks" (bug#25581). diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 41c86d69ab..022eda0bec 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -35,10 +35,11 @@ user. For related topics such as keymaps and syntax tables, see @section Hooks @cindex hooks - A @dfn{hook} is a variable where you can store a function or functions -to be called on a particular occasion by an existing program. Emacs -provides hooks for the sake of customization. Most often, hooks are set -up in the init file (@pxref{Init File}), but Lisp programs can set them also. + A @dfn{hook} is a variable where you can store a function or +functions (@pxref{What Is a Function}) to be called on a particular +occasion by an existing program. Emacs provides hooks for the sake of +customization. Most often, hooks are set up in the init file +(@pxref{Init File}), but Lisp programs can set them also. @xref{Standard Hooks}, for a list of some standard hook variables. @cindex normal hook @@ -56,27 +57,36 @@ minor mode functions also run a mode hook at the end. But hooks are used in other contexts too. For example, the hook @code{suspend-hook} runs just before Emacs suspends itself (@pxref{Suspending Emacs}). - The recommended way to add a hook function to a hook is by calling -@code{add-hook} (@pxref{Setting Hooks}). The hook functions may be any -of the valid kinds of functions that @code{funcall} accepts (@pxref{What -Is a Function}). Most normal hook variables are initially void; -@code{add-hook} knows how to deal with this. You can add hooks either -globally or buffer-locally with @code{add-hook}. - @cindex abnormal hook If the hook variable's name does not end with @samp{-hook}, that indicates it is probably an @dfn{abnormal hook}. That means the hook functions are called with arguments, or their return values are used in some way. The hook's documentation says how the functions are -called. You can use @code{add-hook} to add a function to an abnormal -hook, but you must write the function to follow the hook's calling -convention. By convention, abnormal hook names end in @samp{-functions}. +called. Any functions added to an abnormal hook must follow the +hook's calling convention. By convention, abnormal hook names end in +@samp{-functions}. @cindex single-function hook -If the variable's name ends in @samp{-function}, then its value is -just a single function, not a list of functions. @code{add-hook} cannot be -used to modify such a @emph{single function hook}, and you have to use -@code{add-function} instead (@pxref{Advising Functions}). +If the name of the variable ends in @samp{-predicate} or +@samp{-function} (singular) then its value must be a function, not a +list of functions. As with abnormal hooks, the expected arguments and +meaning of the return value vary across such @emph{single function +hooks}. The details are explained in each variable's docstring. + + Since hooks (both multi and single function) are variables, their +values can be modified with @code{setq} or temporarily with +@code{let}. However, it is often useful to add or remove a particular +function from a hook while preserving any other functions it might +have. For multi function hooks, the recommended way of doing this is +with @code{add-hook} and @code{remove-hook} (@pxref{Setting Hooks}). +Most normal hook variables are initially void; @code{add-hook} knows +how to deal with this. You can add hooks either globally or +buffer-locally with @code{add-hook}. For hooks which hold only a +single function, @code{add-hook} is not appropriate, but you can use +@code{add-function} (@pxref{Advising Functions}) to combine new +functions with the hook. Note that some single function hooks may be +@code{nil} which @code{add-function} cannot deal with, so you must +check for that before calling @code{add-function}. @menu * Running Hooks:: How to run a hook. commit c44f1a4475475d640778b90467240a175c5c8f63 Author: Lars Ingebrigtsen Date: Sun Oct 11 04:05:41 2020 +0200 Fix link in previous display.texi change * doc/lispref/display.texi (Fontsets): Link to the correct node in the Elisp manual, not in the Emacs manual. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 5b4b6720af..c304342303 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3677,7 +3677,7 @@ does that, this function's value may not be accurate. This function may return non-@code{nil} even when there is no font available, since it also checks whether the coding system for the text -terminal can encode the character (@pxref{Terminal Coding}). +terminal can encode the character (@pxref{Terminal I/O Encoding}). @end defun @node Low-Level Font commit ff9ec6b139768e5385d7632465445cbcbe628092 Author: Robert Weiner Date: Sun Oct 11 04:03:47 2020 +0200 Make posn-set-point work on frame events * lisp/subr.el (event-start): Mention the frame part of the events. (posn-window): Ditto. (posn-set-point): Make this work if the event is a frame event (bug#28621). diff --git a/lisp/subr.el b/lisp/subr.el index 777ef103cf..07cab5909d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1367,7 +1367,8 @@ EVENT is nil, the value of `posn-at-point' is used instead. The following accessor functions are used to access the elements of the position: -`posn-window': The window the event is in. +`posn-window': The window of the event end, or its frame if the +event end point belongs to no window. `posn-area': A symbol identifying the area the event occurred in, or nil if the event occurred in the text area. `posn-point': The buffer position of the event. @@ -1423,8 +1424,9 @@ than a window, return nil." (defsubst posn-window (position) "Return the window in POSITION. -POSITION should be a list of the form returned by the `event-start' -and `event-end' functions." +If POSITION is outside the frame where the event was initiated, +return that frame instead. POSITION should be a list of the form +returned by the `event-start' and `event-end' functions." (nth 0 position)) (defsubst posn-area (position) @@ -1451,9 +1453,14 @@ a click on a scroll bar)." (defun posn-set-point (position) "Move point to POSITION. Select the corresponding window as well." - (if (not (windowp (posn-window position))) + (if (framep (posn-window position)) + (progn + (unless (windowp (frame-selected-window (posn-window position))) + (error "Position not in text area of window")) + (select-window (frame-selected-window (posn-window position)))) + (unless (windowp (posn-window position)) (error "Position not in text area of window")) - (select-window (posn-window position)) + (select-window (posn-window position))) (if (numberp (posn-point position)) (goto-char (posn-point position)))) commit 7db2879a81e21749ed9f0808fc25d48ce22939e6 Author: Robert Pluim Date: Sun Oct 11 03:49:37 2020 +0200 Fix the documentation of char-displayable-p * doc/lispref/display.texi (Fontsets): Make the documentation of char-displayable-p less incorrect (bug#35230). diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index d2e6cad6c4..5b4b6720af 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3668,12 +3668,16 @@ the charset @code{japanese-jisx0208}. @end defun @defun char-displayable-p char -This function returns @code{t} if Emacs ought to be able to display -@var{char}. More precisely, if the selected frame's fontset has a -font to display the character set that @var{char} belongs to. +This function returns non-@code{nil} if Emacs ought to be able to +display @var{char}. Or more precisely, if the selected frame's fontset +has a font to display the character set that @var{char} belongs to. Fontsets can specify a font on a per-character basis; when the fontset does that, this function's value may not be accurate. + +This function may return non-@code{nil} even when there is no font +available, since it also checks whether the coding system for the text +terminal can encode the character (@pxref{Terminal Coding}). @end defun @node Low-Level Font commit e8fcc14f2819d40283914cf0f9b4f43b2517ba80 Author: Rasmus Date: Sat Oct 10 22:32:41 2020 +0200 gnus-icalendar.el: Fix bug in gnus-icalendar-identities * lisp/gnus/gnus-icalendar.el (gnus-icalendar-event--find-attendee): (gnus-icalendar-identities) `gnus-ignored-from-addresses' and `message-alternative-emails' may be functions. This is not supported by `gnus-icalendar-event--find-attendee' (bug#43908). diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 7d4fa6c35c..d7e35c5587 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -180,8 +180,10 @@ (or (member (attendee-name prop) name-or-email) (let ((att-email (attendee-email prop))) (gnus-icalendar-find-if - (lambda (email) - (string-match email att-email)) + (lambda (str-or-fun) + (if (functionp str-or-fun) + (funcall str-or-fun att-email) + (string-match str-or-fun att-email))) name-or-email)))))) (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) @@ -763,9 +765,8 @@ These will be used to retrieve the RSVP information from ical events." (lambda (x) (if (listp x) x (list x))) (list user-full-name (regexp-quote user-mail-address) ;; NOTE: these can be lists - gnus-ignored-from-addresses ; already regexp-quoted - (unless (functionp message-alternative-emails) ; String or function. - message-alternative-emails) + gnus-ignored-from-addresses ; String or function. + message-alternative-emails ; String or function. (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) ;; TODO: make the template customizable commit f342b7c96929dcb0324c6eded32be4d98a764708 Author: Stefan Monnier Date: Sat Oct 10 16:00:51 2020 -0400 * lisp/calc/: Use lexical scoping in all the files Includes the following pervasive changes: - Move some defvars earlier in the file so they cover earlier let-bindings - Change dynamically scoped `calc-FOO` or `math-FOO` function arguments to just FOO and then let-bind the `calc-FOO` or `math-FOO` variable explicitly in the body of the function. In some cases, the beginning of the function was changed to refer to FOO so as to delay the binding to a nearby `let` when I could ensure that it did not make a difference. - Add an underscore in front of unused vars or comment them out altogether. - Replace unused `err` arg to `condition-case` with nil. Plus the additional itemized changes below. * lisp/calc/calc-map.el (calcFunc-reducer): * lisp/calc/calc-arith.el (math-setup-declarations): * lisp/calc/calc-help.el (calc-full-help, calc-help-index-entries) (calc-full-help): Use `ignore-errors`. * lisp/calc/calc-embed.el (calc-embedded-modes-change): Declare `the-language` and `the-display-just` as dynamically scoped. * lisp/calc/calc-forms.el (math-setup-year-holidays): Use `dolist`. * lisp/calc/calc-graph.el (calc-graph-set-styles): Use `symbol-value` rather than `eval.` (calc-graph-delete-temps, calc-graph-set-styles): Use ignore-errors. * lisp/calc/calc-macs.el (calc-with-trail-buffer): Add artificial use of `save-buf` to silence compiler warnings in all the cases where `body` doesn't make use of it. * lisp/calc/calc-math.el (math-largest-emacs-expt) (math-smallest-emacs-expt, math-use-emacs-fn): Use ignore-errors. * lisp/calc/calc-mode.el (calc-total-algebraic-mode): Remove "P" from interactive spec since it's not used anyway. * lisp/calc/calc-rewr.el (calc-match): Simplify. * lisp/calc/calc.el (calc-buffer): Give it a global nil value, so it's automatically declared dynbound in any file that requires `calc`. (calcDigit-nondigit): Adjust accordingly. * lisp/calc/calcalg2.el (calcFunc-table): Declare `var-dummy` as dynbound. (math-scan-for-limits): Comment out dead code. * lisp/calc/calcalg3.el (math-general-fit): Declare `var-YVAL` and `var-YVALX` as dynbound. diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 55ce971198..6c162b55f7 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -1,4 +1,4 @@ -;;; calc-aent.el --- algebraic entry functions for Calc +;;; calc-aent.el --- algebraic entry functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -158,7 +158,7 @@ (setq strp (cdr (cdr strp)))) (calc-do-calc-eval (car str) separator args))) ((eq separator 'eval) - (eval str)) + (eval str t)) ((eq separator 'macro) (require 'calc-ext) (let* ((calc-buffer (current-buffer)) @@ -285,6 +285,8 @@ The value t means abort and give an error message.") (defvar calc-alg-entry-history nil "History for algebraic entry.") +(defvar calc-plain-entry nil) + ;;;###autoload (defun calc-alg-entry (&optional initial prompt) (let* ((calc-dollar-values (mapcar #'calc-get-stack-element @@ -401,7 +403,6 @@ The value t means abort and give an error message.") (use-local-map calc-mode-map)) (calcAlg-enter)) -(defvar calc-plain-entry nil) (defun calcAlg-edit () (interactive) (if (or (not calc-plain-entry) @@ -576,8 +577,9 @@ in Calc algebraic input.") (defvar math-expr-data) ;;;###autoload -(defun math-read-exprs (math-exp-str) - (let ((math-exp-pos 0) +(defun math-read-exprs (str) + (let ((math-exp-str str) + (math-exp-pos 0) (math-exp-old-pos 0) (math-exp-keep-spaces nil) math-exp-token math-expr-data) @@ -738,8 +740,8 @@ in Calc algebraic input.") math-exp-pos (match-end 0))) ((and (setq adfn (assq ch (get calc-language 'math-lang-read-symbol))) - (eval (nth 1 adfn))) - (eval (nth 2 adfn))) + (eval (nth 1 adfn) t)) + (eval (nth 2 adfn) t)) ((eq ch ?\$) (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) math-exp-pos) @@ -771,8 +773,8 @@ in Calc algebraic input.") math-expr-data (math-match-substring math-exp-str 1) math-exp-pos (match-end 0))) ((and (setq adfn (get calc-language 'math-lang-read)) - (eval (nth 0 adfn)) - (eval (nth 1 adfn)))) + (eval (nth 0 adfn) t) + (eval (nth 1 adfn) t))) ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos) (setq math-exp-pos (match-end 0)) (math-read-token)) diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index b487aae688..ae397c4f2c 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -1,4 +1,4 @@ -;;; calc-arith.el --- arithmetic functions for Calc +;;; calc-arith.el --- arithmetic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -250,44 +250,43 @@ (while (setq p (cdr p)) (and (eq (car-safe (car p)) 'vec) (setq vec (nth 2 (car p))) - (condition-case err - (let ((v (nth 1 (car p)))) - (setq type nil range nil) - (or (eq (car-safe vec) 'vec) - (setq vec (list 'vec vec))) - (while (and (setq vec (cdr vec)) - (not (Math-objectp (car vec)))) - (and (eq (car-safe (car vec)) 'var) - (let ((st (assq (nth 1 (car vec)) - math-super-types))) - (cond (st (setq type (append type st))) - ((eq (nth 1 (car vec)) 'pos) - (setq type (append type - '(real number)) - range - '(intv 1 0 (var inf var-inf)))) - ((eq (nth 1 (car vec)) 'nonneg) - (setq type (append type - '(real number)) - range - '(intv 3 0 - (var inf var-inf)))))))) - (if vec - (setq type (append type '(real number)) - range (math-prepare-set (cons 'vec vec)))) - (setq type (list type range)) - (or (eq (car-safe v) 'vec) - (setq v (list 'vec v))) - (while (setq v (cdr v)) - (if (or (eq (car-safe (car v)) 'var) - (not (Math-primp (car v)))) - (setq math-decls-cache - (cons (cons (if (eq (car (car v)) 'var) - (nth 2 (car v)) - (car (car v))) - type) - math-decls-cache))))) - (error nil))))) + (ignore-errors + (let ((v (nth 1 (car p)))) + (setq type nil range nil) + (or (eq (car-safe vec) 'vec) + (setq vec (list 'vec vec))) + (while (and (setq vec (cdr vec)) + (not (Math-objectp (car vec)))) + (and (eq (car-safe (car vec)) 'var) + (let ((st (assq (nth 1 (car vec)) + math-super-types))) + (cond (st (setq type (append type st))) + ((eq (nth 1 (car vec)) 'pos) + (setq type (append type + '(real number)) + range + '(intv 1 0 (var inf var-inf)))) + ((eq (nth 1 (car vec)) 'nonneg) + (setq type (append type + '(real number)) + range + '(intv 3 0 + (var inf var-inf)))))))) + (if vec + (setq type (append type '(real number)) + range (math-prepare-set (cons 'vec vec)))) + (setq type (list type range)) + (or (eq (car-safe v) 'vec) + (setq v (list 'vec v))) + (while (setq v (cdr v)) + (if (or (eq (car-safe (car v)) 'var) + (not (Math-primp (car v)))) + (setq math-decls-cache + (cons (cons (if (eq (car (car v)) 'var) + (nth 2 (car v)) + (car (car v))) + type) + math-decls-cache))))))))) (setq math-decls-all (assq 'var-All math-decls-cache))))) (defun math-known-scalarp (a &optional assume-scalar) @@ -2892,7 +2891,7 @@ (eq a b)) (list 'calcFunc-exp sumpow)) (t - (condition-case err + (condition-case nil (math-pow a sumpow) (inexact-result (list '^ a sumpow))))))))) (and math-simplifying-units @@ -2927,7 +2926,7 @@ (math-div 1 (list 'calcFunc-sqrt (math-mul a b)))) (t (setq a (math-mul a b)) - (condition-case err + (condition-case nil (math-pow a apow) (inexact-result (list '^ a apow))))))))))) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index aa10d55e52..20dd1d441b 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -1,4 +1,4 @@ -;;; calc-bin.el --- binary functions for Calc +;;; calc-bin.el --- binary functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index f7e29c6e52..5aeb8cba0d 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -1,4 +1,4 @@ -;;; calc-comb.el --- combinatoric functions for Calc +;;; calc-comb.el --- combinatoric functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index f4324dcbf1..7438f63a90 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -1,4 +1,4 @@ -;;; calc-cplx.el --- Complex number functions for Calc +;;; calc-cplx.el --- Complex number functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 220213e0fb..f9c5281c26 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -1,4 +1,4 @@ -;;; calc-embed.el --- embed Calc in a buffer +;;; calc-embed.el --- embed Calc in a buffer -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -219,13 +219,17 @@ (defvar calc-override-minor-modes (cons t calc-override-minor-modes-map)) -(defun calc-do-embedded (calc-embed-arg end obeg oend) +(defvar calc-embedded-no-reselect nil) + +(defun calc-do-embedded (embed-arg end obeg oend) + (let ((calc-embed-arg embed-arg)) (if calc-embedded-info ;; Turn embedded mode off or switch to a new buffer. (cond ((eq (current-buffer) (aref calc-embedded-info 1)) (let ((calcbuf (current-buffer)) - (buf (aref calc-embedded-info 0))) + ;; (buf (aref calc-embedded-info 0)) + ) (calc-embedded-original-buffer t) (calc-embedded nil) (switch-to-buffer calcbuf))) @@ -291,7 +295,7 @@ (calc-embedded-info info) (calc-embedded-no-reselect t)) (calc-wrapper - (let* ((okay nil) + (let* (;; (okay nil) (calc-no-refresh-evaltos t)) (if (aref info 8) (progn @@ -336,7 +340,7 @@ "Type `C-x * x'" "Give this command again") " to return to normal"))))) - (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed. + (scroll-down 0))) ; fix a bug which occurs when truncate-lines is changed. (defun calc-embedded-select (arg) @@ -353,9 +357,10 @@ (calc-select-part 2))) -(defun calc-embedded-update-formula (calc-embed-arg) +(defun calc-embedded-update-formula (embed-arg) (interactive "P") - (if calc-embed-arg + (let ((calc-embed-arg embed-arg)) + (if embed-arg (let ((entry (assq (current-buffer) calc-embedded-active))) (while (setq entry (cdr entry)) (and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto) @@ -376,12 +381,13 @@ (progn (save-excursion (calc-embedded-update info 14 'eval t)) - (goto-char (+ (aref info 4) pt)))))))) + (goto-char (+ (aref info 4) pt))))))))) -(defun calc-embedded-edit (calc-embed-arg) +(defun calc-embedded-edit (embed-arg) (interactive "P") - (let ((info (calc-embedded-make-info (point) nil t calc-embed-arg)) + (let ((calc-embed-arg embed-arg)) + (let ((info (calc-embedded-make-info (point) nil t embed-arg)) str) (if (eq (car-safe (aref info 8)) 'error) (progn @@ -392,15 +398,14 @@ (math-format-nice-expr (aref info 8) (frame-width)))) (calc-edit-mode (list 'calc-embedded-finish-edit info)) (insert str "\n"))) - (calc-show-edit-buffer)) + (calc-show-edit-buffer))) (defvar calc-original-buffer) (defvar calc-edit-top) (defun calc-embedded-finish-edit (info) (let ((buf (current-buffer)) (str (buffer-substring calc-edit-top (point-max))) - (start (point)) - pos) + (start (point))) ;; pos (switch-to-buffer calc-original-buffer) (let ((val (with-current-buffer (aref info 1) (let ((calc-language nil) @@ -416,7 +421,8 @@ (calc-embedded-update info 14 t t)))) ;;;###autoload -(defun calc-do-embedded-activate (calc-embed-arg cbuf) +(defun calc-do-embedded-activate (embed-arg cbuf) + (let ((calc-embed-arg embed-arg)) (calc-plain-buffer-only) (if calc-embed-arg (calc-embedded-forget)) @@ -443,7 +449,7 @@ (or (eq (car-safe (aref info 8)) 'error) (goto-char (aref info 5)))))) (message "Activating %s for Calc Embedded mode...done" (buffer-name))) - (calc-embedded-active-state t)) + (calc-embedded-active-state t))) (defun calc-plain-buffer-only () (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode)) @@ -735,13 +741,13 @@ The command \\[yank] can retrieve it from there." (defun calc-find-globals () (interactive) - (and (eq major-mode 'calc-mode) + (and (derived-mode-p 'calc-mode) (error "This command should be used in a normal editing buffer")) (make-local-variable 'calc-embedded-globals) (let ((case-fold-search nil) (modes nil) (save-pt (point)) - found value) + found) ;; value (goto-char (point-min)) (while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t) (and (setq found (assoc (buffer-substring (match-beginning 1) @@ -764,7 +770,7 @@ The command \\[yank] can retrieve it from there." (modes nil) (emodes nil) (pmodes nil) - found value) + found) ;; value (while (and no-defaults (search-backward "[calc-" nil t)) (forward-char 6) (or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]") @@ -817,9 +823,13 @@ The command \\[yank] can retrieve it from there." (defvar calc-embed-vars-used) (defun calc-embedded-make-info (point cbuf fresh &optional - calc-embed-top calc-embed-bot - calc-embed-outer-top calc-embed-outer-bot) - (let* ((bufentry (assq (current-buffer) calc-embedded-active)) + embed-top embed-bot + embed-outer-top embed-outer-bot) + (let* ((calc-embed-top embed-top) + (calc-embed-bot embed-bot) + (calc-embed-outer-top embed-outer-top) + (calc-embed-outer-bot embed-outer-bot) + (bufentry (assq (current-buffer) calc-embedded-active)) (found bufentry) (force (and fresh calc-embed-top (null (equal calc-embed-top '(t))))) (fixed calc-embed-top) @@ -1175,7 +1185,6 @@ The command \\[yank] can retrieve it from there." ;;; These are hooks called by the main part of Calc. -(defvar calc-embedded-no-reselect nil) (defun calc-embedded-select-buffer () (if (eq (current-buffer) (aref calc-embedded-info 0)) (let ((info calc-embedded-info) @@ -1240,7 +1249,7 @@ The command \\[yank] can retrieve it from there." (with-current-buffer (aref calc-embedded-info 1) (let* ((info calc-embedded-info) (extra-line (if (eq calc-language 'big) 1 0)) - (the-point (point)) + ;; (the-point (point)) (empty (= (calc-stack-size) 0)) (entry (if empty (list '(var empty var-empty) 1 nil) @@ -1274,6 +1283,7 @@ The command \\[yank] can retrieve it from there." (set-buffer-modified-p (buffer-modified-p))))) (defun calc-embedded-modes-change (vars) + (defvar the-language) (defvar the-display-just) (if (eq (car vars) 'calc-language) (setq vars '(the-language))) (if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just))) (while (and vars diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 5c11554d5d..fc0a2c88fe 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1398,9 +1398,8 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-scroll-up (n) (interactive "P") - (condition-case nil - (scroll-up (or n (/ (window-height) 2))) - (error nil)) + (ignore-errors + (scroll-up (or n (/ (window-height) 2)))) (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) (if (eq major-mode 'calc-mode) (calc-realign) diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index d1525939b1..ea1ef24bb1 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -1,4 +1,4 @@ -;;; calc-fin.el --- financial functions for Calc +;;; calc-fin.el --- financial functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index a2f6696866..465d4520b0 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -1,4 +1,4 @@ -;;; calc-forms.el --- data format conversion functions for Calc +;;; calc-forms.el --- data format conversion functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -678,10 +678,11 @@ in the Gregorian calendar." (defvar math-fd-isoweek) (defvar math-fd-isoweekday) -(defun math-format-date (math-fd-date) - (if (eq (car-safe math-fd-date) 'date) - (setq math-fd-date (nth 1 math-fd-date))) - (let ((entry (list math-fd-date calc-internal-prec calc-date-format))) +(defun math-format-date (fd-date) + (let* ((math-fd-date (if (eq (car-safe fd-date) 'date) + (nth 1 fd-date) + fd-date)) + (entry (list math-fd-date calc-internal-prec calc-date-format))) (or (cdr (assoc entry math-format-date-cache)) (let* ((math-fd-dt nil) (math-fd-iso-dt nil) @@ -914,15 +915,16 @@ to Jan 1, 1970 AD.") ;; which is called by math-parse-date and math-parse-standard-date. (defvar math-pd-str) -(defun math-parse-date (math-pd-str) +(defun math-parse-date (pd-str) (catch 'syntax - (or (math-parse-standard-date math-pd-str t) - (math-parse-standard-date math-pd-str nil) - (and (string-match "W[0-9][0-9]" math-pd-str) - (math-parse-iso-date math-pd-str)) - (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str) - (list 'date (math-read-number (math-match-substring math-pd-str 1)))) + (or (math-parse-standard-date pd-str t) + (math-parse-standard-date pd-str nil) + (and (string-match "W[0-9][0-9]" pd-str) + (math-parse-iso-date pd-str)) + (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" pd-str) + (list 'date (math-read-number (math-match-substring pd-str 1)))) (let ((case-fold-search t) + (math-pd-str pd-str) (year nil) (month nil) (day nil) (weekday nil) (hour nil) (minute nil) (second nil) (bc-flag nil) (a nil) (b nil) (c nil) (bigyear nil) temp) @@ -1128,8 +1130,9 @@ to Jan 1, 1970 AD.") (substring math-pd-str (match-end 0)))) n)))) -(defun math-parse-standard-date (math-pd-str with-time) - (let ((case-fold-search t) +(defun math-parse-standard-date (pd-str with-time) + (let ((math-pd-str pd-str) + (case-fold-search t) (okay t) num (fmt calc-date-format) this next (gnext nil) (isoyear nil) (isoweek nil) (isoweekday nil) @@ -1306,9 +1309,10 @@ to Jan 1, 1970 AD.") (setq day (math-add day (1- yearday)))) day)))))) -(defun math-parse-iso-date (math-pd-str) - "Parse MATH-PD-STR as an ISO week date, or return nil." - (let ((case-fold-search t) +(defun math-parse-iso-date (pd-str) + "Parse PD-STR as an ISO week date, or return nil." + (let ((math-pd-str pd-str) + (case-fold-search t) (isoyear nil) (isoweek nil) (isoweekday nil) (hour nil) (minute nil) (second nil)) ;; Extract the time, if any. @@ -1613,7 +1617,7 @@ and ends on the first Sunday of November at 2 a.m." (math-std-daylight-savings-old date dt zone bump) (math-std-daylight-savings-new date dt zone bump))) -(defun math-std-daylight-savings-new (date dt zone bump) +(defun math-std-daylight-savings-new (date dt _zone bump) "Standard North American daylight saving algorithm as of 2007. This implements the rules for the U.S. and Canada. Daylight saving begins on the second Sunday of March at 2 a.m., @@ -1634,7 +1638,7 @@ and ends on the first Sunday of November at 2 a.m." (t 0)))) (t 0))) -(defun math-std-daylight-savings-old (date dt zone bump) +(defun math-std-daylight-savings-old (date dt _zone bump) "Standard North American daylight saving algorithm before 2007. This implements the rules for the U.S. and Canada. Daylight saving begins on the first Sunday of April at 2 a.m., @@ -1657,7 +1661,7 @@ and ends on the last Sunday of October at 2 a.m." ;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given ;;; day of the given month. -(defun math-prev-weekday-in-month (date dt day wday) +(defun math-prev-weekday-in-month (date dt day _wday) (or day (setq day (nth 2 dt))) (if (> day (math-days-in-month (car dt) (nth 1 dt))) (setq day (math-days-in-month (car dt) (nth 1 dt)))) @@ -2036,18 +2040,18 @@ and ends on the last Sunday of October at 2 a.m." nil))) (or done (setq math-holidays-cache-tag t)))))) -(defun math-setup-year-holidays (math-sh-year) - (let ((exprs (nth 2 math-holidays-cache))) - (while exprs +(defun math-setup-year-holidays (sh-year) + (let ((math-sh-year sh-year)) + (dolist (expr (nth 2 math-holidays-cache)) + (defvar var-y) (defvar var-m) (let* ((var-y math-sh-year) (var-m nil) - (expr (math-evaluate-expr (car exprs)))) + (expr (math-evaluate-expr expr))) (if (math-expr-contains expr '(var m var-m)) (let ((var-m 0)) (while (<= (setq var-m (1+ var-m)) 12) (math-setup-add-holidays (math-evaluate-expr expr)))) - (math-setup-add-holidays expr))) - (setq exprs (cdr exprs))))) + (math-setup-add-holidays expr)))))) (defun math-setup-add-holidays (days) ; uses "math-sh-year" (cond ((eq (car-safe days) 'vec) diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 33c1fbaab8..86a4808c5a 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -1,4 +1,4 @@ -;;; calc-frac.el --- fraction functions for Calc +;;; calc-frac.el --- fraction functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 14f5e32108..5c179ff05d 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -1,4 +1,4 @@ -;;; calc-funcs.el --- well-known functions for Calc +;;; calc-funcs.el --- well-known functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 4cdfdbd4b9..82e9335716 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1,4 +1,4 @@ -;;; calc-graph.el --- graph output functions for Calc +;;; calc-graph.el --- graph output functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -216,7 +216,7 @@ (or (and (Math-num-integerp pstyle) (math-trunc pstyle)) (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec) 0 -1)) - (math-contains-sdev-p (eval (nth 2 ydata)))))) + (math-contains-sdev-p (eval (nth 2 ydata) t))))) (defun calc-graph-lookup (thing) (if (and (eq (car-safe thing) 'var) @@ -319,7 +319,6 @@ (calc-slow-wrapper (let ((calcbuf (current-buffer)) (tempbuf (get-buffer-create "*Gnuplot Temp-2*")) - (tempbuftop 1) (tempoutfile nil) (calc-graph-curve-num 0) (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0))) @@ -403,7 +402,7 @@ (and (equal output "tty") (setq tty-output t))) (setq tempoutfile (calc-temp-file-name -1) output tempoutfile)) - (setq output (eval output))) + (setq output (eval output t))) (or (equal device calc-graph-last-device) (progn (setq calc-graph-last-device device) @@ -480,9 +479,11 @@ (calc-graph-xp calc-graph-xvalue) (calc-graph-yp calc-graph-yvalue) (calc-graph-zp nil) - (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil) + (calc-graph-xlow nil) (calc-graph-xhigh nil) + ;; (y3low nil) (y3high nil) calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY - y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil) + ;; y3val + calc-graph-y3step var-DUMMY2 (calc-graph-zval nil) calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector calc-graph-numsteps calc-graph-numsteps3 (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename))) @@ -562,7 +563,7 @@ calc-gnuplot-print-output))) (if (symbolp command) (funcall command output) - (eval command)))))))))) + (eval command t)))))))))) (defun calc-graph-compute-2d () (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec)) @@ -905,16 +906,15 @@ (while calc-graph-file-cache (and (car calc-graph-file-cache) (file-exists-p (car (car calc-graph-file-cache))) - (condition-case err - (delete-file (car (car calc-graph-file-cache))) - (error nil))) + (ignore-errors + (delete-file (car (car calc-graph-file-cache))))) (setq calc-graph-file-cache (cdr calc-graph-file-cache)))) (defun calc-graph-kill-hook () (calc-graph-delete-temps)) (defun calc-graph-show-tty (output) - "Default calc-gnuplot-plot-command for \"tty\" output mode. + "Default `calc-gnuplot-plot-command' for \"tty\" output mode. This is useful for tek40xx and other graphics-terminal types." (call-process shell-file-name nil calc-gnuplot-buffer nil shell-command-switch @@ -923,7 +923,7 @@ This is useful for tek40xx and other graphics-terminal types." (defvar calc-dumb-map nil "The keymap for the \"dumb\" terminal plot.") -(defun calc-graph-show-dumb (&optional output) +(defun calc-graph-show-dumb (&optional _output) "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type. This \"dumb\" driver will be present in Gnuplot 3.0." (interactive) @@ -1116,14 +1116,14 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (delete-region start end) (goto-char start) (setq errform - (condition-case nil - (math-contains-sdev-p - (eval (intern - (concat "var-" - (save-excursion - (re-search-backward ":\\(.*\\)}") - (match-string 1)))))) - (error nil))) + (ignore-errors + (math-contains-sdev-p + (symbol-value + (intern + (concat "var-" + (save-excursion + (re-search-backward ":\\(.*\\)}") + (match-string 1)))))))) (if yerr (insert " with yerrorbars") (insert " with " @@ -1165,7 +1165,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (or (calc-graph-find-plot nil nil) (error "No data points have been set!")) (let ((base (point)) - start + ;; start end) (re-search-forward "[,\n]\\|[ \t]+with") (setq end (match-beginning 0)) @@ -1462,7 +1462,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (match-beginning 1) (match-end 1)))) (setq calc-gnuplot-version 1)))) - (condition-case err + (condition-case nil (let ((args (append (and calc-gnuplot-display (not (equal calc-gnuplot-display (getenv "DISPLAY"))) diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 72cf90a758..0b327e8d0f 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -1,4 +1,4 @@ -;;; calc-help.el --- help display functions for Calc, +;;; calc-help.el --- help display functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -33,8 +33,8 @@ (declare-function Info-last "info" ()) -(defun calc-help-prefix (arg) - "This key is the prefix for Calc help functions. See calc-help-for-help." +(defun calc-help-prefix (&optional _arg) + "This key is the prefix for Calc help functions. See `calc-help-for-help'." (interactive "P") (or calc-dispatch-help (sit-for echo-keystrokes)) (let ((key (calc-read-key-sequence @@ -79,7 +79,7 @@ C-w Describe how there is no warranty for Calc." (message "Calc Help options: Help, Info, ... press SPC, DEL to scroll, C-g to cancel") (memq (setq key (read-event)) '(? ?\C-h ?\C-? ?\C-v ?\M-v))) - (condition-case err + (condition-case nil (if (memq key '(? ?\C-v)) (scroll-up) (scroll-down)) @@ -302,21 +302,19 @@ C-w Describe how there is no warranty for Calc." (let ((entrylist '()) entry) (require 'info nil t) - (while indices - (condition-case nil - (with-temp-buffer - (Info-mode) - (Info-goto-node (concat "(Calc)" (car indices) " Index")) - (goto-char (point-min)) - (while (re-search-forward "\n\\* \\(.*\\): " nil t) - (setq entry (match-string 1)) - (if (and (not (string-match "<[1-9]+>" entry)) - (not (string-match "(.*)" entry)) - (not (string= entry "Menu"))) - (unless (assoc entry entrylist) - (setq entrylist (cons entry entrylist)))))) - (error nil)) - (setq indices (cdr indices))) + (dolist (indice indices) + (ignore-errors + (with-temp-buffer + (Info-mode) + (Info-goto-node (concat "(Calc)" indice " Index")) + (goto-char (point-min)) + (while (re-search-forward "\n\\* \\(.*\\): " nil t) + (setq entry (match-string 1)) + (if (and (not (string-match "<[1-9]+>" entry)) + (not (string-match "(.*)" entry)) + (not (string= entry "Menu"))) + (unless (assoc entry entrylist) + (setq entrylist (cons entry entrylist)))))))) entrylist)) (defun calc-describe-function (&optional func) @@ -409,9 +407,7 @@ C-w Describe how there is no warranty for Calc." (substitute-command-keys x))))) (nreverse (cdr (reverse (cdr (calc-help)))))) (mapc (function (lambda (prefix) - (let ((msgs (condition-case err - (funcall prefix) - (error nil)))) + (let ((msgs (ignore-errors (funcall prefix)))) (if (car msgs) (princ (if (eq (nth 2 msgs) ?v) diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index c6264d1f5f..2c7a4f0561 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -1,4 +1,4 @@ -;;; calc-incom.el --- complex data type input functions for Calc +;;; calc-incom.el --- complex data type input functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index ecf43a12b0..47917dcac7 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -1,4 +1,4 @@ -;;; calc-keypd.el --- mouse-capable keypad input for Calc +;;; calc-keypd.el --- mouse-capable keypad input for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -35,17 +35,17 @@ (defvar calc-keypad-prev-input nil) (defvar calc-keypad-said-hello nil) -;;; |----+----+----+----+----+----| -;;; | ENTER |+/- |EEX |UNDO| <- | -;;; |-----+---+-+--+--+-+---++----| -;;; | INV | 7 | 8 | 9 | / | -;;; |-----+-----+-----+-----+-----| -;;; | HYP | 4 | 5 | 6 | * | -;;; |-----+-----+-----+-----+-----| -;;; |EXEC | 1 | 2 | 3 | - | -;;; |-----+-----+-----+-----+-----| -;;; | OFF | 0 | . | PI | + | -;;; |-----+-----+-----+-----+-----| +;; |----+----+----+----+----+----| +;; | ENTER |+/- |EEX |UNDO| <- | +;; |-----+---+-+--+--+-+---++----| +;; | INV | 7 | 8 | 9 | / | +;; |-----+-----+-----+-----+-----| +;; | HYP | 4 | 5 | 6 | * | +;; |-----+-----+-----+-----+-----| +;; |EXEC | 1 | 2 | 3 | - | +;; |-----+-----+-----+-----+-----| +;; | OFF | 0 | . | PI | + | +;; |-----+-----+-----+-----+-----| (defvar calc-keypad-layout '( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over ) ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over ) @@ -83,12 +83,12 @@ calc-keypad-modes-menu calc-keypad-user-menu ) ) -;;; |----+----+----+----+----+----| -;;; |FLR |CEIL|RND |TRNC|CLN2|FLT | -;;; |----+----+----+----+----+----| -;;; | LN |EXP | |ABS |IDIV|MOD | -;;; |----+----+----+----+----+----| -;;; |SIN |COS |TAN |SQRT|y^x |1/x | +;; |----+----+----+----+----+----| +;; |FLR |CEIL|RND |TRNC|CLN2|FLT | +;; |----+----+----+----+----+----| +;; | LN |EXP | |ABS |IDIV|MOD | +;; |----+----+----+----+----+----| +;; |SIN |COS |TAN |SQRT|y^x |1/x | (defvar calc-keypad-math-menu '( ( ( "FLR" calc-floor ) @@ -110,12 +110,12 @@ ( "y^x" calc-power ) ( "1/x" calc-inv ) ) )) -;;; |----+----+----+----+----+----| -;;; |IGAM|BETA|IBET|ERF |BESJ|BESY| -;;; |----+----+----+----+----+----| -;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN| -;;; |----+----+----+----+----+----| -;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP| +;; |----+----+----+----+----+----| +;; |IGAM|BETA|IBET|ERF |BESJ|BESY| +;; |----+----+----+----+----+----| +;; |IMAG|CONJ| RE |ATN2|RAND|RAGN| +;; |----+----+----+----+----+----| +;; |GCD |FACT|DFCT|BNOM|PERM|NXTP| (defvar calc-keypad-funcs-menu '( ( ( "IGAM" calc-inc-gamma ) @@ -137,12 +137,12 @@ ( "PERM" calc-perm ) ( "NXTP" calc-next-prime calc-prev-prime ) ) )) -;;; |----+----+----+----+----+----| -;;; |AND | OR |XOR |NOT |LSH |RSH | -;;; |----+----+----+----+----+----| -;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH| -;;; |----+----+----+----+----+----| -;;; | A | B | C | D | E | F | +;; |----+----+----+----+----+----| +;; |AND | OR |XOR |NOT |LSH |RSH | +;; |----+----+----+----+----+----| +;; |DEC |HEX |OCT |BIN |WSIZ|ARSH| +;; |----+----+----+----+----+----| +;; | A | B | C | D | E | F | (defvar calc-keypad-binary-menu '( ( ( "AND" calc-and calc-diff ) @@ -164,12 +164,12 @@ ( "E" ("E") ) ( "F" ("F") ) ) )) -;;; |----+----+----+----+----+----| -;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$| -;;; |----+----+----+----+----+----| -;;; |INV |DET |TRN |IDNT|CRSS|"x" | -;;; |----+----+----+----+----+----| -;;; |PACK|UNPK|INDX|BLD |LEN |... | +;; |----+----+----+----+----+----| +;; |SUM |PROD|MAX |MAP*|MAP^|MAP$| +;; |----+----+----+----+----+----| +;; |INV |DET |TRN |IDNT|CRSS|"x" | +;; |----+----+----+----+----+----| +;; |PACK|UNPK|INDX|BLD |LEN |... | (defvar calc-keypad-vector-menu '( ( ( "SUM" calc-vector-sum calc-vector-alt-sum calc-vector-mean ) @@ -196,12 +196,12 @@ ( "LEN" calc-vlength ) ( "..." calc-full-vectors ) ) )) -;;; |----+----+----+----+----+----| -;;; |FLT |FIX |SCI |ENG |GRP | | -;;; |----+----+----+----+----+----| -;;; |RAD |DEG |FRAC|POLR|SYMB|PREC| -;;; |----+----+----+----+----+----| -;;; |SWAP|RLL3|RLL4|OVER|STO |RCL | +;; |----+----+----+----+----+----| +;; |FLT |FIX |SCI |ENG |GRP | | +;; |----+----+----+----+----+----| +;; |RAD |DEG |FRAC|POLR|SYMB|PREC| +;; |----+----+----+----+----+----| +;; |SWAP|RLL3|RLL4|OVER|STO |RCL | (defvar calc-keypad-modes-menu '( ( ( "FLT" calc-normal-notation diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 4bbe850273..1c270cfc24 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1,4 +1,4 @@ -;;; calc-lang.el --- calc language functions +;;; calc-lang.el --- calc language functions -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -45,6 +45,8 @@ (defvar math-comp-comma) (defvar math-comp-vector-prec) +(defvar math-exp-str) ;; Dyn scoped + ;;; Alternate entry/display languages. (defun calc-set-language (lang &optional option no-refresh) @@ -144,7 +146,7 @@ ( y1 . (math-C-parse-bess)) ( tgamma . calcFunc-gamma ))) -(defun math-C-parse-bess (f val) +(defun math-C-parse-bess (_f val) "Parse C's j0, j1, y0, y1 functions." (let ((args (math-read-expr-list))) (math-read-token) @@ -155,7 +157,7 @@ ((eq val 'y1) '(calcFunc-besY 1))) args))) -(defun math-C-parse-fma (f val) +(defun math-C-parse-fma (_f _val) "Parse C's fma function fma(x,y,z) => (x * y + z)." (let ((args (math-read-expr-list))) (math-read-token) @@ -372,14 +374,14 @@ (defvar math-exp-old-pos) (defvar math-parsing-fortran-vector nil) -(defun math-parse-fortran-vector (op) +(defun math-parse-fortran-vector (_op) (let ((math-parsing-fortran-vector '(end . "\000"))) (prog1 (math-read-brackets t "]") (setq math-exp-token (car math-parsing-fortran-vector) math-expr-data (cdr math-parsing-fortran-vector))))) -(defun math-parse-fortran-vector-end (x op) +(defun math-parse-fortran-vector-end (x _op) (if math-parsing-fortran-vector (progn (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data) @@ -692,7 +694,7 @@ "_{" (math-compose-expr (nth 2 a) 0) "}{" (math-compose-expr (nth 1 a) 0) "}")))) -(defun math-parse-tex-sum (f val) +(defun math-parse-tex-sum (f _val) (let (low high save) (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) (math-read-token) @@ -727,14 +729,15 @@ (math-compose-expr (nth 3 a) 0) (if (memq (nth 1 a) '(0 2)) ")" "]"))) -(defun math-compose-tex-var (a prec) +(defun math-compose-tex-var (a _prec) (if (and calc-language-option (not (= calc-language-option 0)) (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" (symbol-name (nth 1 a)))) - (if (eq calc-language 'latex) - (format "\\text{%s}" (symbol-name (nth 1 a))) - (format "\\hbox{%s}" (symbol-name (nth 1 a)))) + (format (if (eq calc-language 'latex) + "\\text{%s}" + "\\hbox{%s}") + (symbol-name (nth 1 a))) (math-compose-var a))) (defun math-compose-tex-func (func a) @@ -906,7 +909,7 @@ (setq math-exp-str (copy-sequence math-exp-str)) (aset math-exp-str right ?\])))))))))) -(defun math-latex-parse-frac (f val) +(defun math-latex-parse-frac (_f _val) (let (numer denom) (setq numer (car (math-read-expr-list))) (math-read-token) @@ -916,7 +919,7 @@ (list 'frac numer denom) (list '/ numer denom)))) -(defun math-latex-parse-two-args (f val) +(defun math-latex-parse-two-args (f _val) (let (first second) (setq first (car (math-read-expr-list))) (math-read-token) @@ -931,7 +934,7 @@ (put 'latex 'math-input-filter 'math-tex-input-filter) -(defun calc-eqn-language (n) +(defun calc-eqn-language (_n) (interactive "P") (calc-wrapper (calc-set-language 'eqn) @@ -1159,7 +1162,7 @@ (math-compose-eqn-matrix (cdr a))))))) nil)) -(defun math-parse-eqn-matrix (f sym) +(defun math-parse-eqn-matrix (_f _sym) (let ((vec nil)) (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) (math-read-token) @@ -1175,7 +1178,7 @@ (math-read-token) (math-transpose (cons 'vec (nreverse vec))))) -(defun math-parse-eqn-prime (x sym) +(defun math-parse-eqn-prime (x _sym) (if (eq (car-safe x) 'var) (if (equal math-expr-data calc-function-open) (progn @@ -1363,7 +1366,7 @@ (math-compose-vector args ", " 0) "]"))))) -(defun math-yacas-parse-Sum (f val) +(defun math-yacas-parse-Sum (f _val) "Read in the arguments to \"Sum\" in Calc's Yacas mode." (let ((args (math-read-expr-list))) (math-read-token) @@ -1512,7 +1515,7 @@ ( substitute . (math-maxima-parse-subst)) ( taylor . (math-maxima-parse-taylor)))) -(defun math-maxima-parse-subst (f val) +(defun math-maxima-parse-subst (_f _val) "Read in the arguments to \"subst\" in Calc's Maxima mode." (let ((args (math-read-expr-list))) (math-read-token) @@ -1521,7 +1524,7 @@ (nth 2 args) (nth 0 args)))) -(defun math-maxima-parse-taylor (f val) +(defun math-maxima-parse-taylor (_f _val) "Read in the arguments to \"taylor\" in Calc's Maxima mode." (let ((args (math-read-expr-list))) (math-read-token) @@ -1762,7 +1765,7 @@ ( contains . (math-lang-switch-args calcFunc-in)) ( has . (math-lang-switch-args calcFunc-refers)))) -(defun math-lang-switch-args (f val) +(defun math-lang-switch-args (f _val) "Read the arguments to a Calc function in reverse order. This is used for various language modes which have functions in reverse order to Calc's." @@ -1805,15 +1808,15 @@ order to Calc's." (put 'giac 'math-compose-subscr (function (lambda (a) - (let ((args (cdr (cdr a)))) + ;; (let ((args (cdr (cdr a)))) (list 'horiz (math-compose-expr (nth 1 a) 1000) "[" (math-compose-expr (calc-normalize (list '- (nth 2 a) 1)) 0) - "]"))))) + "]")))) ;;) -(defun math-read-giac-subscr (x op) +(defun math-read-giac-subscr (x _op) (let ((idx (math-read-expr-level 0))) (or (equal math-expr-data "]") (throw 'syntax "Expected `]'")) @@ -1947,7 +1950,7 @@ order to Calc's." (math-compose-expr (nth 2 a) 0) "]]")))) -(defun math-read-math-subscr (x op) +(defun math-read-math-subscr (x _op) (let ((idx (math-read-expr-level 0))) (or (and (equal math-expr-data "]") (progn @@ -2094,10 +2097,13 @@ order to Calc's." (defvar math-rb-v1) (defvar math-rb-v2) -(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 +(defun math-read-big-rec (rb-h1 rb-v1 rb-h2 rb-v2 &optional baseline prec short) (or prec (setq prec 0)) - + (let ((math-rb-h1 rb-h1) + (math-rb-v1 rb-v1) + (math-rb-h2 rb-h2) + (math-rb-v2 rb-v2)) ;; Clip whitespace above or below. (while (and (< math-rb-v1 math-rb-v2) (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) @@ -2449,7 +2455,7 @@ order to Calc's." math-read-big-h2 h) (or short (= math-read-big-h2 math-rb-h2) (math-read-big-error h baseline)) - p))) + p)))) (defun math-read-big-char (h v) (or (and (>= h math-rb-h1) diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index 257d369b87..5aaa5f48d6 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -61,6 +61,7 @@ (defmacro calc-with-trail-buffer (&rest body) `(let ((save-buf (current-buffer)) (calc-command-flags nil)) + (ignore save-buf) ;FIXME: Use a name less conflict-prone! (with-current-buffer (calc-trail-display t) (progn (goto-char calc-trail-pointer) diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 139ba5b8e3..57483fc659 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -1,4 +1,4 @@ -;;; calc-map.el --- higher-order functions for Calc +;;; calc-map.el --- higher-order functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -48,6 +48,8 @@ (math-calcFunc-to-var (nth 1 oper)) expr))))) +(defvar calc-mapping-dir nil) + (defun calc-reduce (&optional oper accum) (interactive) (calc-wrapper @@ -136,7 +138,6 @@ (1+ calc-dollar-used)))))))) (defvar calc-verify-arglist t) -(defvar calc-mapping-dir nil) (defun calc-map-stack () "This is meant to be called by calc-keypad mode." (interactive) @@ -853,7 +854,7 @@ (i -1) (math-working-step 0) (math-working-step-2 nil) - len cols obj expr) + len obj expr) ;; cols (if (eq mode 'eqn) (setq mode 'elems heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt @@ -1023,22 +1024,21 @@ (let ((expr (car (setq vec (cdr vec))))) (if expr (progn - (condition-case err - (and (symbolp func) - (let ((lfunc (or (cdr (assq func - '( (calcFunc-add . math-add) - (calcFunc-sub . math-sub) - (calcFunc-mul . math-mul) - (calcFunc-div . math-div) - (calcFunc-pow . math-pow) - (calcFunc-mod . math-mod) - (calcFunc-vconcat . - math-concat) ))) - func))) - (while (cdr vec) - (setq expr (funcall lfunc expr (nth 1 vec)) - vec (cdr vec))))) - (error nil)) + (ignore-errors + (and (symbolp func) + (let ((lfunc (or (cdr (assq func + '( (calcFunc-add . math-add) + (calcFunc-sub . math-sub) + (calcFunc-mul . math-mul) + (calcFunc-div . math-div) + (calcFunc-pow . math-pow) + (calcFunc-mod . math-mod) + (calcFunc-vconcat + . math-concat) ))) + func))) + (while (cdr vec) + (setq expr (funcall lfunc expr (nth 1 vec)) + vec (cdr vec)))))) (while (setq vec (cdr vec)) (setq expr (math-build-call func (list expr (car vec))))) (math-normalize expr)) @@ -1229,9 +1229,11 @@ (defvar math-inner-mul-func) (defvar math-inner-add-func) -(defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b) +(defun calcFunc-inner (inner-mul-func inner-add-func a b) (or (math-vectorp a) (math-reject-arg a 'vectorp)) (or (math-vectorp b) (math-reject-arg b 'vectorp)) + (let ((math-inner-mul-func inner-mul-func) + (math-inner-add-func inner-add-func)) (if (math-matrixp a) (if (math-matrixp b) (if (= (length (nth 1 a)) (length b)) @@ -1247,12 +1249,12 @@ (math-dimension-error)))) (if (math-matrixp b) (nth 1 (math-inner-mats (list 'vec a) b)) - (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b))))) + (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b)))))) (defun math-inner-mats (a b) (let ((mat nil) (cols (length (nth 1 b))) - row col ap bp accum) + row col) ;; ap bp accum (while (setq a (cdr a)) (setq col cols row nil) diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 6bbd2f574e..46172d1b7f 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1,4 +1,4 @@ -;;; calc-math.el --- mathematical functions for Calc +;;; calc-math.el --- mathematical functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -60,33 +60,23 @@ pow (< pow 1.0e+INF)) (setq x (* 2 x)) - (setq pow (condition-case nil - (expt 10.0 (* 2 x)) - (error nil)))) + (setq pow (ignore-errors (expt 10.0 (* 2 x))))) ;; The following loop should stop when 10^(x+1) is too large. - (setq pow (condition-case nil - (expt 10.0 (1+ x)) - (error nil))) + (setq pow (ignore-errors (expt 10.0 (1+ x)))) (while (and pow (< pow 1.0e+INF)) (setq x (1+ x)) - (setq pow (condition-case nil - (expt 10.0 (1+ x)) - (error nil)))) + (setq pow (ignore-errors (expt 10.0 (1+ x))))) (1- x)) "The largest exponent which Calc will convert to an Emacs float.") (defvar math-smallest-emacs-expt (let ((x -1)) - (while (condition-case nil - (> (expt 10.0 x) 0.0) - (error nil)) + (while (ignore-errors (> (expt 10.0 x) 0.0)) (setq x (* 2 x))) (setq x (/ x 2)) - (while (condition-case nil - (> (expt 10.0 x) 0.0) - (error nil)) + (while (ignore-errors (> (expt 10.0 x) 0.0)) (setq x (1- x))) (+ x 2)) "The smallest exponent which Calc will convert to an Emacs float.") @@ -100,19 +90,18 @@ If this can't be done, return NIL." (let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x)))))) (and (<= math-smallest-emacs-expt xpon) (<= xpon math-largest-emacs-expt) - (condition-case nil - (math-read-number - (number-to-string - (funcall fn - (string-to-number - (let - ((calc-number-radix 10) - (calc-twos-complement-mode nil) - (calc-float-format (list 'float calc-internal-prec)) - (calc-group-digits nil) - (calc-point-char ".")) - (math-format-number (math-float x))))))) - (error nil)))))) + (ignore-errors + (math-read-number + (number-to-string + (funcall fn + (string-to-number + (let + ((calc-number-radix 10) + (calc-twos-complement-mode nil) + (calc-float-format (list 'float calc-internal-prec)) + (calc-group-digits nil) + (calc-point-char ".")) + (math-format-number (math-float x)))))))))))) (defun calc-sqrt (arg) (interactive "P") @@ -638,11 +627,11 @@ If this can't be done, return NIL." (defvar math-nrf-nf) (defvar math-nrf-nfm1) -(defun math-nth-root-float (a math-nrf-n &optional guess) +(defun math-nth-root-float (a nrf-n &optional guess) (math-inexact-result) (math-with-extra-prec 1 - (let ((math-nrf-nf (math-float math-nrf-n)) - (math-nrf-nfm1 (math-float (1- math-nrf-n)))) + (let ((math-nrf-nf (math-float nrf-n)) + (math-nrf-nfm1 (math-float (1- nrf-n)))) (math-nth-root-float-iter a (or guess (math-make-float 1 (/ (+ (math-numdigs (nth 1 a)) @@ -665,11 +654,12 @@ If this can't be done, return NIL." ;; math-nth-root-int. (defvar math-nri-n) -(defun math-nth-root-integer (a math-nri-n &optional guess) ; [I I S] - (math-nth-root-int-iter a (or guess - (math-scale-int 1 (/ (+ (math-numdigs a) - (1- math-nri-n)) - math-nri-n))))) +(defun math-nth-root-integer (a nri-n &optional guess) ; [I I S] + (let ((math-nri-n nri-n)) + (math-nth-root-int-iter a (or guess + (math-scale-int 1 (/ (+ (math-numdigs a) + (1- nri-n)) + nri-n)))))) (defun math-nth-root-int-iter (a guess) (math-working "root" guess) @@ -693,13 +683,13 @@ If this can't be done, return NIL." ;;;; Transcendental functions. -;;; All of these functions are defined on the complex plane. -;;; (Branch cuts, etc. follow Steele's Common Lisp book.) +;; All of these functions are defined on the complex plane. +;; (Branch cuts, etc. follow Steele's Common Lisp book.) -;;; Most functions increase calc-internal-prec by 2 digits, then round -;;; down afterward. "-raw" functions use the current precision, require -;;; their arguments to be in float (or complex float) format, and always -;;; work in radians (where applicable). +;; Most functions increase calc-internal-prec by 2 digits, then round +;; down afterward. "-raw" functions use the current precision, require +;; their arguments to be in float (or complex float) format, and always +;; work in radians (where applicable). (defun math-to-radians (a) ; [N N] (cond ((eq (car-safe a) 'hms) @@ -1126,9 +1116,9 @@ If this can't be done, return NIL." (math-div-float (cdr sc) (car sc))))))) -;;; This could use a smarter method: Reduce x as in math-sin-raw, then -;;; compute either sin(x) or cos(x), whichever is smaller, and compute -;;; the other using the identity sin(x)^2 + cos(x)^2 = 1. +;; This could use a smarter method: Reduce x as in math-sin-raw, then +;; compute either sin(x) or cos(x), whichever is smaller, and compute +;; the other using the identity sin(x)^2 + cos(x)^2 = 1. (defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x)) (cons (math-sin-raw x) (math-cos-raw x))) @@ -2072,7 +2062,7 @@ If this can't be done, return NIL." (put 'calcFunc-arctanh 'math-expandable t) -;;; Convert A from HMS or degrees to radians. +;; Convert A from HMS or degrees to radians. (defun calcFunc-rad (a) ; [R R] [Public] (cond ((or (Math-numberp a) (eq (car a) 'intv)) @@ -2089,7 +2079,7 @@ If this can't be done, return NIL." (t (list 'calcFunc-rad a)))) (put 'calcFunc-rad 'math-expandable t) -;;; Convert A from HMS or radians to degrees. +;; Convert A from HMS or radians to degrees. (defun calcFunc-deg (a) ; [R R] [Public] (cond ((or (Math-numberp a) (eq (car a) 'intv)) diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index 3cc98ef59c..d593eddb31 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -1,4 +1,4 @@ -;;; calc-menu.el --- a menu for Calc +;;; calc-menu.el --- a menu for Calc -*- lexical-binding:t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index a8f65ffe75..7c97dc6a9a 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -1,4 +1,4 @@ -;;; calc-misc.el --- miscellaneous functions for Calc +;;; calc-misc.el --- miscellaneous functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -505,7 +505,7 @@ With argument 0, switch line point is in with line mark is in." ;; 3 <-- mid-line = 3 ;; 4 <-- point ;; 5 <-- bot-line = 5 - (dotimes (i mid-line) + (dotimes (_ mid-line) (setq mid-cell old-top-list old-top-list (cdr old-top-list)) (setcdr mid-cell new-top-list) @@ -519,7 +519,7 @@ With argument 0, switch line point is in with line mark is in." ;; 2 ;; 1 (setq prev-mid-cell old-top-list) - (dotimes (i (- bot-line mid-line)) + (dotimes (_ (- bot-line mid-line)) (setq bot-cell old-top-list old-top-list (cdr old-top-list)) (setcdr bot-cell new-top-list) diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index ff99ccc466..e109233a82 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -1,4 +1,4 @@ -;;; calc-mode.el --- calculator modes for Calc +;;; calc-mode.el --- calculator modes for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -424,8 +424,8 @@ (t "Not recording mode changes permanently"))))) -(defun calc-total-algebraic-mode (flag) - (interactive "P") +(defun calc-total-algebraic-mode (&optional _flag) + (interactive) (calc-wrapper (if (eq calc-algebraic-mode 'total) (calc-algebraic-mode nil) diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 2850b33721..8deef7dc4f 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -1,4 +1,4 @@ -;;; calc-mtx.el --- matrix functions for Calc +;;; calc-mtx.el --- matrix functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 0fe955b28d..6f2a601cd9 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -1,4 +1,4 @@ -;;; calc-nlfit.el --- nonlinear curve fitting for Calc +;;; calc-nlfit.el --- nonlinear curve fitting for Calc -*- lexical-binding:t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. @@ -104,19 +104,19 @@ (list 'vec C12 C22)))) (list A B))))) -;;; The methods described by de Sousa require the cumulative data qdata -;;; and the rates pdata. We will assume that we are given either -;;; qdata and the corresponding times tdata, or pdata and the corresponding -;;; tdata. The following two functions will find pdata or qdata, -;;; given the other.. +;; The methods described by de Sousa require the cumulative data qdata +;; and the rates pdata. We will assume that we are given either +;; qdata and the corresponding times tdata, or pdata and the corresponding +;; tdata. The following two functions will find pdata or qdata, +;; given the other.. -;;; First, given two lists; one of values q0, q1, ..., qn and one of -;;; corresponding times t0, t1, ..., tn; return a list -;;; p0, p1, ..., pn of the rates of change of the qi with respect to t. -;;; p0 is the right hand derivative (q1 - q0)/(t1 - t0). -;;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)). -;;; The other pis are the averages of the two: -;;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)). +;; First, given two lists; one of values q0, q1, ..., qn and one of +;; corresponding times t0, t1, ..., tn; return a list +;; p0, p1, ..., pn of the rates of change of the qi with respect to t. +;; p0 is the right hand derivative (q1 - q0)/(t1 - t0). +;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)). +;; The other pis are the averages of the two: +;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)). (defun math-nlfit-get-rates-from-cumul (tdata qdata) (let ((pdata (list @@ -153,12 +153,12 @@ pdata)) (reverse pdata))) -;;; Next, given two lists -- one of rates p0, p1, ..., pn and one of -;;; corresponding times t0, t1, ..., tn -- and an initial values q0, -;;; return a list q0, q1, ..., qn of the cumulative values. -;;; q0 is the initial value given. -;;; For i>0, qi is computed using the trapezoid rule: -;;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1)) +;; Next, given two lists -- one of rates p0, p1, ..., pn and one of +;; corresponding times t0, t1, ..., tn -- and an initial values q0, +;; return a list q0, q1, ..., qn of the cumulative values. +;; q0 is the initial value given. +;; For i>0, qi is computed using the trapezoid rule: +;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1)) (defun math-nlfit-get-cumul-from-rates (tdata pdata q0) (let* ((qdata (list q0))) @@ -177,16 +177,16 @@ (setq tdata (cdr tdata))) (reverse qdata))) -;;; Given the qdata, pdata and tdata, find the parameters -;;; a, b and c that fit q = a/(1+b*exp(c*t)). -;;; a is found using the method described by de Sousa. -;;; b and c are found using least squares on the linearization -;;; log((a/q)-1) = log(b) + c*t -;;; In some cases (where the logistic curve may well be the wrong -;;; model), the computed a will be less than or equal to the maximum -;;; value of q in qdata; in which case the above linearization won't work. -;;; In this case, a will be replaced by a number slightly above -;;; the maximum value of q. +;; Given the qdata, pdata and tdata, find the parameters +;; a, b and c that fit q = a/(1+b*exp(c*t)). +;; a is found using the method described by de Sousa. +;; b and c are found using least squares on the linearization +;; log((a/q)-1) = log(b) + c*t +;; In some cases (where the logistic curve may well be the wrong +;; model), the computed a will be less than or equal to the maximum +;; value of q in qdata; in which case the above linearization won't work. +;; In this case, a will be replaced by a number slightly above +;; the maximum value of q. (defun math-nlfit-find-qmax (qdata pdata tdata) (let* ((ratios (math-map-binop 'math-div pdata qdata)) @@ -208,12 +208,12 @@ (calcFunc-exp (nth 0 bandc)) (nth 1 bandc)))) -;;; Next, given the pdata and tdata, we can find the qdata if we know q0. -;;; We first try to find q0, using the fact that when p takes on its largest -;;; value, q is half of its maximum value. So we'll find the maximum value -;;; of q given various q0, and use bisection to approximate the correct q0. +;; Next, given the pdata and tdata, we can find the qdata if we know q0. +;; We first try to find q0, using the fact that when p takes on its largest +;; value, q is half of its maximum value. So we'll find the maximum value +;; of q given various q0, and use bisection to approximate the correct q0. -;;; First, given pdata and tdata, find what half of qmax would be if q0=0. +;; First, given pdata and tdata, find what half of qmax would be if q0=0. (defun math-nlfit-find-qmaxhalf (pdata tdata) (let ((pmax (math-max-list (car pdata) (cdr pdata))) @@ -231,7 +231,7 @@ (setq tdata (cdr tdata))) qmh)) -;;; Next, given pdata and tdata, approximate q0. +;; Next, given pdata and tdata, approximate q0. (defun math-nlfit-find-q0 (pdata tdata) (let* ((qhalf (math-nlfit-find-qmaxhalf pdata tdata)) @@ -250,7 +250,7 @@ (setq q0 (math-add q0 qhalf))) (let* ((qmin (math-sub q0 qhalf)) (qmax q0) - (qt (math-nlfit-find-qmax + (_qt (math-nlfit-find-qmax (mapcar (lambda (q) (math-add q0 q)) qdata) @@ -270,20 +270,20 @@ (setq i (1+ i))) (math-mul '(float 5 -1) (math-add qmin qmax))))) -;;; To improve the approximations to the parameters, we can use -;;; Marquardt method as described in Schwarz's book. +;; To improve the approximations to the parameters, we can use +;; Marquardt method as described in Schwarz's book. -;;; Small numbers used in the Givens algorithm +;; Small numbers used in the Givens algorithm (defvar math-nlfit-delta '(float 1 -8)) (defvar math-nlfit-epsilon '(float 1 -5)) -;;; Maximum number of iterations +;; Maximum number of iterations (defvar math-nlfit-max-its 100) -;;; Next, we need some functions for dealing with vectors and -;;; matrices. For convenience, we'll work with Emacs lists -;;; as vectors, rather than Calc's vectors. +;; Next, we need some functions for dealing with vectors and +;; matrices. For convenience, we'll work with Emacs lists +;; as vectors, rather than Calc's vectors. (defun math-nlfit-set-elt (vec i x) (setcar (nthcdr (1- i) vec) x)) @@ -589,7 +589,7 @@ (calcFunc-trn j) j)) (calcFunc-inv j))) -(defun math-nlfit-get-sigmas (grad xlist pparms chisq) +(defun math-nlfit-get-sigmas (grad xlist pparms _chisq) (let* ((sgs nil) (covar (math-nlfit-find-covar grad xlist pparms)) (n (1- (length covar))) @@ -664,6 +664,8 @@ (calc-pop-push-record-list n prefix vals) (calc-handle-whys)) +(defvar calc-curve-nvars) + (defun math-nlfit-fit-curve (fn grad solnexpr initparms &optional sdv) (calc-slow-wrapper (let* ((sdevv (or (eq sdv 'calcFunc-efit) (eq sdv 'calcFunc-xfit))) @@ -678,7 +680,7 @@ (calc-curve-varnames nil) (calc-curve-coefnames nil) (calc-curve-nvars 1) - (fitvars (calc-get-fit-variables 1 3)) + (_fitvars (calc-get-fit-variables 1 3)) (var (nth 1 calc-curve-varnames)) (parms (cdr calc-curve-coefnames)) (parmguess @@ -763,7 +765,7 @@ (calc-curve-varnames nil) (calc-curve-coefnames nil) (calc-curve-nvars 1) - (fitvars (calc-get-fit-variables 1 2)) + (_fitvars (calc-get-fit-variables 1 2)) (var (nth 1 calc-curve-varnames)) (parms (cdr calc-curve-coefnames)) (soln (list '* (nth 0 finalparms) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 6db5de4c96..ea9c49748e 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1,4 +1,4 @@ -;;; calc-prog.el --- user programmability functions for Calc +;;; calc-prog.el --- user programmability functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -111,10 +111,15 @@ "Not reporting timing of commands")))) (defun calc-pass-errors () + ;; FIXME: This is broken at least since Emacs-26. + ;; AFAICT the immediate purpose of this code is to hack the + ;; `condition-case' in `calc-do' so it doesn't catch errors any + ;; more. I'm not sure why/whatfor this was designed, but I suspect + ;; that `condition-case-unless-debug' would cover the same needs. (interactive) ;; The following two cases are for the new, optimizing byte compiler ;; or the standard 18.57 byte compiler, respectively. - (condition-case err + (condition-case nil (let ((place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 15))) (or (memq (car-safe (car-safe place)) '(error xxxerror)) (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27))) @@ -165,6 +170,7 @@ ;; calc-user-define-composition and calc-finish-formula-edit, ;; but is used by calc-fix-user-formula. (defvar calc-user-formula-alist) +(defvar math-arglist) ; dynamically bound in all callers (defun calc-user-define-formula () (interactive) @@ -328,7 +334,6 @@ (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) (message ""))) -(defvar math-arglist) ; dynamically bound in all callers (defun calc-default-formula-arglist (form) (if (consp form) (if (eq (car form) 'var) @@ -511,8 +516,9 @@ ;; is called (indirectly) by calc-read-parse-table. (defvar calc-lang) -(defun calc-write-parse-table (tab calc-lang) - (let ((p tab)) +(defun calc-write-parse-table (tab lang) + (let ((calc-lang lang) + (p tab)) (while p (calc-write-parse-table-part (car (car p))) (insert ":= " @@ -551,8 +557,9 @@ (insert " ")))) (setq p (cdr p)))) -(defun calc-read-parse-table (calc-buf calc-lang) - (let ((tab nil)) +(defun calc-read-parse-table (calc-buf lang) + (let ((calc-lang lang) + (tab nil)) (while (progn (skip-chars-forward "\n\t ") (not (eobp))) @@ -860,7 +867,7 @@ (defun calc-edit-macro-combine-digits () "Put an entire sequence of digits on a single line." (let ((line (calc-edit-macro-command)) - curline) + ) ;; curline (goto-char (line-beginning-position)) (kill-line 1) (while (string-equal (calc-edit-macro-command-type) "calcDigit-start") @@ -1038,7 +1045,7 @@ Redefine the corresponding command." (let* ((cmd (cdr def)) (fcmd (and cmd (symbolp cmd) (symbol-function cmd))) (func nil) - (pt (point)) + ;; (pt (point)) (fill-column 70) (fill-prefix nil) str q-ok) @@ -1945,8 +1952,9 @@ Redefine the corresponding command." ;; by math-define-body. (defvar math-exp-env) -(defun math-define-body (body math-exp-env) - (math-define-list body)) +(defun math-define-body (body exp-env) + (let ((math-exp-env exp-env)) + (math-define-list body))) (defun math-define-list (body &optional quote) (cond ((null body) diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index bb909e728e..2cc7b6beef 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -1,4 +1,4 @@ -;;; calc-rewr.el --- rewriting functions for Calc +;;; calc-rewr.el --- rewriting functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -142,7 +142,7 @@ (calc-pop-push-record-list n "rwrt" (list expr))) (calc-handle-whys))) -(defun calc-match (pat &optional interactive) +(defun calc-match (pat &optional _interactive) (interactive "sPattern: \np") (calc-slow-wrapper (let (n expr) @@ -158,9 +158,9 @@ (setq expr (calc-top-n 1) n 1)) (or (math-vectorp expr) (error "Argument must be a vector")) - (if (calc-is-inverse) - (calc-enter-result n "mtcn" (math-match-patterns pat expr t)) - (calc-enter-result n "mtch" (math-match-patterns pat expr nil)))))) + (calc-enter-result n "mtcn" + (math-match-patterns pat expr + (not (not (calc-is-inverse)))))))) (defvar math-mt-many) @@ -169,8 +169,10 @@ ;; but is used by math-rewrite-phase (defvar math-rewrite-whole-expr) -(defun math-rewrite (math-rewrite-whole-expr rules &optional math-mt-many) - (let* ((crules (math-compile-rewrites rules)) +(defun math-rewrite (rewrite-whole-expr rules &optional mt-many) + (let* ((math-rewrite-whole-expr rewrite-whole-expr) + (math-mt-many mt-many) + (crules (math-compile-rewrites rules)) (heads (math-rewrite-heads math-rewrite-whole-expr)) (trace-buffer (get-buffer "*Trace*")) (calc-display-just 'center) @@ -211,6 +213,8 @@ ":\n" fmt "\n")))) math-rewrite-whole-expr)) +(defvar math-rewrite-phase 1) + (defun math-rewrite-phase (sched) (while (and sched (/= math-mt-many 0)) (if (listp (car sched)) @@ -464,6 +468,8 @@ ;;; whole match the name v. Beware of circular structures! ;;; +(defvar math-rewrite-whole nil) + (defun math-compile-patterns (pats) (if (and (eq (car-safe pats) 'var) (calc-var-value (nth 2 pats))) @@ -485,7 +491,6 @@ (cdr pats) (list pats))))))))) -(defvar math-rewrite-whole nil) (defvar math-make-import-list nil) ;; The variable math-import-list is local to part of math-compile-rewrites, @@ -580,7 +585,7 @@ (let ((rule-set nil) (all-heads nil) (nil-rules nil) - (rule-count 0) + ;; (rule-count 0) (math-schedule nil) (math-iterations nil) (math-phases nil) @@ -831,14 +836,16 @@ (defvar math-rwcomp-subst-new-func) (defvar math-rwcomp-subst-old-func) -(defun math-rwcomp-substitute (expr math-rwcomp-subst-old math-rwcomp-subst-new) - (if (and (eq (car-safe math-rwcomp-subst-old) 'var) - (memq (car-safe math-rwcomp-subst-new) '(var calcFunc-lambda))) - (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc math-rwcomp-subst-old)) - (math-rwcomp-subst-new-func (math-var-to-calcFunc math-rwcomp-subst-new))) +(defun math-rwcomp-substitute (expr rwcomp-subst-old rwcomp-subst-new) + (let ((math-rwcomp-subst-old rwcomp-subst-old) + (math-rwcomp-subst-new rwcomp-subst-new)) + (if (and (eq (car-safe rwcomp-subst-old) 'var) + (memq (car-safe rwcomp-subst-new) '(var calcFunc-lambda))) + (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc rwcomp-subst-old)) + (math-rwcomp-subst-new-func (math-var-to-calcFunc rwcomp-subst-new))) (math-rwcomp-subst-rec expr)) (let ((math-rwcomp-subst-old-func nil)) - (math-rwcomp-subst-rec expr)))) + (math-rwcomp-subst-rec expr))))) (defun math-rwcomp-subst-rec (expr) (cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new) @@ -1452,8 +1459,6 @@ ,form (setcar rules orig)))) -(defvar math-rewrite-phase 1) - ;; The variable math-apply-rw-regs is local to math-apply-rewrites, ;; but is used by math-rwapply-replace-regs and math-rwapply-reg-looks-negp ;; which are called by math-apply-rewrites. @@ -1463,11 +1468,12 @@ ;; but is used by math-rwapply-remember. (defvar math-apply-rw-ruleset) -(defun math-apply-rewrites (expr rules &optional heads math-apply-rw-ruleset) +(defun math-apply-rewrites (expr rules &optional heads apply-rw-ruleset) (and (setq rules (cdr (or (assq (car-safe expr) rules) (assq nil rules)))) - (let ((result nil) + (let ((math-apply-rw-ruleset apply-rw-ruleset) + (result nil) op math-apply-rw-regs inst part pc mark btrack (tracing math-rwcomp-tracing) (phase math-rewrite-phase)) diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index 1b7526c3c9..fe0e8a1e47 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -1,4 +1,4 @@ -;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc +;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 0342a0ae48..d294448887 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -1,4 +1,4 @@ -;;; calc-sel.el --- data selection functions for Calc +;;; calc-sel.el --- data selection functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -146,7 +146,8 @@ (defvar calc-fnp-op) (defvar calc-fnp-num) -(defun calc-find-nth-part (expr calc-fnp-num) +(defun calc-find-nth-part (expr fnp-num) + (let ((calc-fnp-num fnp-num)) (if (and calc-assoc-selections (assq (car-safe expr) calc-assoc-ops)) (let (calc-fnp-op) @@ -154,7 +155,7 @@ (if (eq (car-safe expr) 'intv) (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr)) (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr)) - (nth calc-fnp-num expr))))) + (nth calc-fnp-num expr)))))) (defun calc-find-nth-part-rec (expr) ; uses num, op (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops)) @@ -381,7 +382,7 @@ ;; (if (or (< num 1) (> num (calc-stack-size))) ;; (error "Cursor must be positioned on a stack element")) (let* ((entry (calc-top num 'entry)) - ww w) + ) ;; ww w (or (equal entry calc-selection-cache-entry) (progn (setcar entry (calc-encase-atoms (car entry))) @@ -481,8 +482,9 @@ (defvar calc-rsf-old) (defvar calc-rsf-new) -(defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new) - (setq calc-rsf-new (calc-encase-atoms calc-rsf-new)) +(defun calc-replace-sub-formula (expr rsf-old rsf-new) + (let ((calc-rsf-old rsf-old) + (calc-rsf-new (calc-encase-atoms rsf-new)))) (calc-replace-sub-formula-rec expr)) (defun calc-replace-sub-formula-rec (expr) @@ -671,7 +673,7 @@ (entry (calc-top num 'entry)) (expr (car entry)) (sel (or (calc-auto-selection entry) expr)) - alg) + ) ;; alg (let ((str (math-showing-full-precision (math-format-nice-expr sel (frame-width))))) (calc-edit-mode (list 'calc-finish-selection-edit diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index 09d3ce921c..196f743fc1 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -1,4 +1,4 @@ -;;; calc-stat.el --- statistical functions for Calc +;;; calc-stat.el --- statistical functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 79e6cf5c00..a1e385cb40 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -1,4 +1,4 @@ -;;; calc-store.el --- value storage functions for Calc +;;; calc-store.el --- value storage functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -184,10 +184,11 @@ (defvar calc-read-var-name-history nil "History for reading variable names.") -(defun calc-read-var-name (prompt &optional calc-store-opers) +(defun calc-read-var-name (prompt &optional store-opers) (setq calc-given-value nil calc-aborted-prefix nil) - (let ((var (concat + (let* ((calc-store-opers store-opers) + (var (concat "var-" (let ((minibuffer-completion-table (mapcar (lambda (x) (substring x 4)) @@ -504,7 +505,7 @@ (calc-wrapper (or var (setq var (calc-read-var-name "Declare: " 0))) (or var (setq var 'var-All)) - (let* (dp decl def row rp) + (let* (dp decl row rp) ;; def (or (and (calc-var-value 'var-Decls) (eq (car-safe var-Decls) 'vec)) (setq var-Decls (list 'vec))) diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index bbd61a2c4a..58b81faee5 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -1,4 +1,4 @@ -;;; calc-stuff.el --- miscellaneous functions for Calc +;;; calc-stuff.el --- miscellaneous functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -273,8 +273,9 @@ With a prefix, push that prefix as a number onto the stack." ;; math-map-over-constants. (defvar math-moc-func) -(defun math-map-over-constants (math-moc-func expr) - (math-map-over-constants-rec expr)) +(defun math-map-over-constants (moc-func expr) + (let ((math-moc-func moc-func)) + (math-map-over-constants-rec expr))) (defun math-map-over-constants-rec (expr) (cond ((or (Math-primp expr) diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index 9f289f21b0..de7205ee3c 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -1,4 +1,4 @@ -;;; calc-trail.el --- functions for manipulating the Calc "trail" +;;; calc-trail.el --- functions for manipulating the Calc "trail" -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 92682baa87..47971e8ab0 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -1,4 +1,4 @@ -;;; calc-undo.el --- undo functions for Calc +;;; calc-undo.el --- undo functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 6850ded717..875414595c 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -1,4 +1,4 @@ -;;; calc-vec.el --- vector functions for Calc +;;; calc-vec.el --- vector functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -1111,18 +1111,20 @@ ;; by calcFunc-grade and calcFunc-rgrade. (defvar math-grade-vec) -(defun calcFunc-grade (math-grade-vec) - (if (math-vectorp math-grade-vec) - (let* ((len (1- (length math-grade-vec)))) - (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep))) - (math-reject-arg math-grade-vec 'vectorp))) - -(defun calcFunc-rgrade (math-grade-vec) - (if (math-vectorp math-grade-vec) - (let* ((len (1- (length math-grade-vec)))) +(defun calcFunc-grade (grade-vec) + (if (math-vectorp grade-vec) + (let* ((math-grade-vec grade-vec) + (len (1- (length grade-vec)))) + (cons 'vec (sort (cdr (calcFunc-index len)) #'math-grade-beforep))) + (math-reject-arg grade-vec #'vectorp))) + +(defun calcFunc-rgrade (grade-vec) + (if (math-vectorp grade-vec) + (let* ((math-grade-vec grade-vec) + (len (1- (length grade-vec)))) (cons 'vec (nreverse (sort (cdr (calcFunc-index len)) - 'math-grade-beforep)))) - (math-reject-arg math-grade-vec 'vectorp))) + #'math-grade-beforep)))) + (math-reject-arg grade-vec #'vectorp))) (defun math-grade-beforep (i j) (math-beforep (nth i math-grade-vec) (nth j math-grade-vec))) @@ -1556,7 +1558,8 @@ of two matrices is a matrix." (defvar math-exp-keep-spaces) (defvar math-expr-data) -(defun math-read-brackets (space-sep math-rb-close) +(defun math-read-brackets (space-sep rb-close) + (let ((math-rb-close rb-close)) (and space-sep (setq space-sep (not (math-check-for-commas)))) (math-read-token) (while (eq math-exp-token 'space) @@ -1624,7 +1627,7 @@ of two matrices is a matrix." (throw 'syntax "Expected `]'"))) (or (eq math-exp-token 'end) (math-read-token)) - vals))) + vals)))) (defun math-check-for-commas (&optional balancing) (let ((count 0) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 690aaf2687..e03c00243c 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -1,4 +1,4 @@ -;;; calc-yank.el --- kill-ring functionality for Calc +;;; calc-yank.el --- kill-ring functionality for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -401,7 +401,7 @@ Interactively, reads the register using `register-read-with-preview'." (let* ((from-buffer (current-buffer)) (calc-was-started (get-buffer-window "*Calculator*")) (single nil) - data vals pos) + data vals) ;; pos (if arg (if (consp arg) (setq single t) @@ -776,7 +776,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (error "Original calculator buffer has been corrupted"))) (goto-char calc-edit-top) (if (buffer-modified-p) - (eval calc-edit-handler)) + (eval calc-edit-handler t)) (if (and one-window (not (one-window-p t))) (delete-window)) (if (get-buffer-window return) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index bf8b006d7c..bde7bd4e2b 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2313,7 +2313,7 @@ the United States." ((eq last-command-event ?@) "0@ ") (t (char-to-string last-command-event)))) -(defvar calc-buffer) +(defvar calc-buffer nil) (defvar calc-prev-char) (defvar calc-prev-prev-char) (defvar calc-digit-value) @@ -2353,7 +2353,7 @@ the United States." (defun calcDigit-nondigit () (interactive) ;; Exercise for the reader: Figure out why this is a good precaution! - (or (boundp 'calc-buffer) + (or calc-buffer (use-local-map minibuffer-local-map)) (let ((str (minibuffer-contents))) (setq calc-digit-value (with-current-buffer calc-buffer diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index bcfa77dad9..99d0549ca8 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1,4 +1,4 @@ -;;; calcalg2.el --- more algebraic functions for Calc +;;; calcalg2.el --- more algebraic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -333,8 +333,10 @@ (setq n (1+ n))) accum)))))) -(defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb) - (let* ((math-deriv-total nil) +(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb) + (let* ((math-deriv-var deriv-var) + (math-deriv-symb deriv-symb) + (math-deriv-total nil) (res (catch 'math-deriv (math-derivative expr)))) (or (eq (car-safe res) 'calcFunc-deriv) (null res) @@ -344,9 +346,11 @@ (math-expr-subst res math-deriv-var deriv-value) res)))) -(defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb) +(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb) (math-setup-declarations) - (let* ((math-deriv-total t) + (let* ((math-deriv-var deriv-var) + (math-deriv-symb deriv-symb) + (math-deriv-total t) (res (catch 'math-deriv (math-derivative expr)))) (or (eq (car-safe res) 'calcFunc-tderiv) (null res) @@ -363,10 +367,10 @@ (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))) (put 'calcFunc-deg\' 'math-derivative-1 - (function (lambda (u) (math-div-float '(float 18 1) (math-pi))))) + (function (lambda (_) (math-div-float '(float 18 1) (math-pi))))) (put 'calcFunc-rad\' 'math-derivative-1 - (function (lambda (u) (math-pi-over-180)))) + (function (lambda (_) (math-pi-over-180)))) (put 'calcFunc-ln\' 'math-derivative-1 (function (lambda (u) (math-div 1 u)))) @@ -1079,8 +1083,9 @@ ;; math-integ-try-substitutions. (defvar math-integ-expr) -(defun math-do-integral-methods (math-integ-expr) - (let ((math-so-far math-integ-var-list-list) +(defun math-do-integral-methods (integ-expr) + (let ((math-integ-expr integ-expr) + (math-so-far math-integ-var-list-list) rat-in) ;; Integration by substitution, for various likely sub-expressions. @@ -1195,10 +1200,11 @@ (defvar math-good-parts) -(defun math-integ-try-parts (expr &optional math-good-parts) +(defun math-integ-try-parts (expr &optional good-parts) ;; Integration by parts: ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x) ;; where h(x) = integ(g(x),x). + (let ((math-good-parts good-parts)) (or (let ((exp (calcFunc-expand expr))) (and (not (equal exp expr)) (math-integral exp))) @@ -1219,14 +1225,14 @@ (and (eq (car expr) '^) (math-integrate-by-parts (math-pow (nth 1 expr) (math-sub (nth 2 expr) 1)) - (nth 1 expr))))) + (nth 1 expr)))))) (defun math-integrate-by-parts (u vprime) (let ((math-integ-level (if (or math-good-parts (math-polynomial-p u math-integ-var)) math-integ-level (1- math-integ-level))) - (math-doing-parts t) + ;; (math-doing-parts t) ;Unused v temp) (and (>= math-integ-level 0) (unwind-protect @@ -1532,7 +1538,7 @@ (math-any-substs t) (math-enable-subst nil) (math-prev-parts-v nil) - (math-doing-parts nil) + ;; (math-doing-parts nil) ;Unused (math-good-parts nil) (res (if trace-buffer @@ -1883,7 +1889,10 @@ (defvar calc-high) (defvar math-var) -(defun calcFunc-table (expr math-var &optional calc-low calc-high step) +(defun calcFunc-table (expr var &optional low high step) + (let ((math-var var) + (calc-high high) + (calc-low low)) (or calc-low (setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf))) (or calc-high (setq calc-high calc-low calc-low 1)) @@ -1894,8 +1903,7 @@ (let ((known (+ (if (Math-objectp calc-low) 1 0) (if (Math-objectp calc-high) 1 0) (if (or (null step) (Math-objectp step)) 1 0))) - (count '(var inf var-inf)) - vec) + (count '(var inf var-inf))) ;; vec (or (= known 2) ; handy optimization (equal calc-high '(var inf var-inf)) (progn @@ -1906,6 +1914,7 @@ (setq count (math-trunc count))))) (if (Math-negp count) (setq count -1)) + (defvar var-DUMMY) (if (integerp count) (let ((var-DUMMY nil) (vec math-tabulate-initial) @@ -1939,7 +1948,7 @@ (and (not (and (equal calc-low '(neg (var inf var-inf))) (equal calc-high '(var inf var-inf)))) (list calc-low calc-high)) - (and step (list step)))))) + (and step (list step))))))) (defun math-scan-for-limits (x) (cond ((Math-primp x)) @@ -1951,8 +1960,10 @@ (high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x))) math-var nil)) temp) - (and low-val (math-realp low-val) - high-val (math-realp high-val)) + ;; FIXME: The below is a no-op, but I suspect its result + ;; was meant to be used, tho I don't know what for. + ;; (and low-val (math-realp low-val) + ;; high-val (math-realp high-val)) (and (Math-lessp high-val low-val) (setq temp low-val low-val high-val high-val temp)) (setq calc-low (math-max calc-low (math-ceiling low-val)) @@ -2361,8 +2372,11 @@ (defvar math-try-solve-sign) (defun math-try-solve-for - (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly) - (let (math-t1 math-t2 math-t3) + (solve-lhs solve-rhs &optional try-solve-sign no-poly) + (let ((math-solve-lhs solve-lhs) + (math-solve-rhs solve-rhs) + (math-try-solve-sign try-solve-sign) + math-t1 math-t2 math-t3) (cond ((equal math-solve-lhs math-solve-var) (setq math-solve-sign math-try-solve-sign) (if (eq math-solve-full 'all) @@ -2721,14 +2735,17 @@ (cons 'vec d) (math-reject-arg expr "Expected a polynomial")))) -(defun math-decompose-poly (math-solve-lhs math-solve-var degree sub-rhs) - (let ((math-solve-rhs (or sub-rhs 1)) +(defun math-decompose-poly (solve-lhs solve-var degree sub-rhs) + (let ((math-solve-lhs solve-lhs) + (math-solve-var solve-var) + (math-solve-rhs (or sub-rhs 1)) math-t1 math-t2 math-t3) (setq math-t2 (math-polynomial-base math-solve-lhs (function - (lambda (math-solve-b) - (let ((math-poly-neg-powers '(1)) + (lambda (solve-b) + (let ((math-solve-b solve-b) + (math-poly-neg-powers '(1)) (math-poly-mult-powers nil) (math-poly-frac-powers 1) (math-poly-exp-base t)) @@ -2964,7 +2981,7 @@ (math-poly-integer-root (car roots)) (setq roots (cdr roots))) (list math-int-factors (nreverse math-int-coefs) math-int-scale)) - (let ((vec nil) res) + (let ((vec nil)) ;; res (while roots (let ((root (car roots)) (math-solve-full (and math-solve-full 'all))) @@ -3109,7 +3126,7 @@ (iters 0) (m (1- (length p))) (try-newt (not polish)) - (tried-newt nil) + ;; (tried-newt nil) b d f x1 dx dxold) (while (and (or (< (setq iters (1+ iters)) 50) @@ -3146,7 +3163,7 @@ (math-lessp (math-abs-approx dx) (calcFunc-scf (math-abs-approx x) -3))) (let ((newt (math-poly-newton-root p x1 7))) - (setq tried-newt t + (setq ;; tried-newt t try-newt nil) (if (math-zerop (cdr newt)) (setq x (car newt) x1 x) @@ -3160,7 +3177,8 @@ (math-nearly-equal x x1)))) (let ((cdx (math-abs-approx dx))) (setq x x1 - tried-newt nil) + ;; tried-newt nil + ) (prog1 (or (<= iters 6) (math-lessp cdx dxold) @@ -3227,7 +3245,9 @@ ;; and math-solve-system-rec, but is used by math-solve-system-subst. (defvar math-solve-simplifying) -(defun math-solve-system (exprs math-solve-vars math-solve-full) +(defun math-solve-system (exprs solve-vars solve-full) + (let ((math-solve-vars solve-vars) + (math-solve-full solve-full)) (setq exprs (mapcar 'list (if (Math-vectorp exprs) (cdr exprs) (list exprs))) @@ -3237,7 +3257,7 @@ (or (let ((math-solve-simplifying nil)) (math-solve-system-rec exprs math-solve-vars nil)) (let ((math-solve-simplifying t)) - (math-solve-system-rec exprs math-solve-vars nil)))) + (math-solve-system-rec exprs math-solve-vars nil))))) ;;; The following backtracking solver works by choosing a variable ;;; and equation, and trying to solve the equation for the variable. @@ -3437,10 +3457,12 @@ (if (memq (car expr) '(* /)) (math-looks-evenp (nth 1 expr))))) -(defun math-solve-for (lhs rhs math-solve-var math-solve-full &optional sign) - (if (math-expr-contains rhs math-solve-var) - (math-solve-for (math-sub lhs rhs) 0 math-solve-var math-solve-full) - (and (math-expr-contains lhs math-solve-var) +(defun math-solve-for (lhs rhs solve-var solve-full &optional sign) + (let ((math-solve-var solve-var) + (math-solve-full solve-full)) + (if (math-expr-contains rhs solve-var) + (math-solve-for (math-sub lhs rhs) 0 solve-var solve-full) + (and (math-expr-contains lhs solve-var) (math-with-extra-prec 1 (let* ((math-poly-base-variable math-solve-var) (res (math-try-solve-for lhs rhs sign))) @@ -3462,7 +3484,7 @@ (format "*Omitted %d complex solutions" (- old-len new-len))))))) - res))))) + res)))))) (defun math-solve-eqn (expr var full) (if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 2d38c9c45b..f1f67211b8 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -1,4 +1,4 @@ -;;; calcalg3.el --- more algebraic functions for Calc +;;; calcalg3.el --- more algebraic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. @@ -120,18 +120,24 @@ (defvar calc-curve-fit-history nil "History for calc-curve-fit.") -(defun calc-curve-fit (arg &optional calc-curve-model - calc-curve-coefnames calc-curve-varnames) +(defvar calc-graph-no-auto-view) +(defvar calc-fit-to-trail nil) + +(defun calc-curve-fit (arg &optional curve-model + curve-coefnames curve-varnames) (interactive "P") (calc-slow-wrapper (setq calc-aborted-prefix nil) - (let ((func (if (calc-is-inverse) 'calcFunc-xfit + (let ((calc-curve-model curve-model) + (calc-curve-coefnames curve-coefnames) + (calc-curve-varnames curve-varnames) + (func (if (calc-is-inverse) 'calcFunc-xfit (if (calc-is-hyperbolic) 'calcFunc-efit 'calcFunc-fit))) key (which 0) (nonlinear nil) (plot nil) - n calc-curve-nvars temp data + n calc-curve-nvars data ;; temp (homog nil) (msgs '( "(Press ? for help)" "1 = linear or multilinear" @@ -321,7 +327,7 @@ (calc-get-fit-variables 1 (1- (length calc-curve-coefnames)) (and homog 1))) ((memq key '(?\$ ?\' ?u ?U)) - (let* ((defvars nil) + (let* (;; (defvars nil) (record-entry nil)) (if (eq key ?\') (let* ((calc-dollar-values calc-arg-values) @@ -708,7 +714,7 @@ "*Unable to find a sign change in this interval")))) ;;; "rtbis" (but we should be using Brent's method) -(defun math-bisect-root (expr low vlow high vhigh) +(defun math-bisect-root (expr low _vlow high vhigh) (let ((step (math-sub-float high low)) (pos (Math-posp vhigh)) var-DUMMY @@ -726,7 +732,8 @@ (setq high mid vhigh vmid) (setq low mid - vlow vmid))) + ;; vlow vmid + ))) (list 'vec mid vmid))) ;;; "mnewt" @@ -758,7 +765,8 @@ (list 'vec next expr-val)))) -(defun math-find-root (expr var guess math-root-widen) +(defun math-find-root (expr var guess root-widen) + (let ((math-root-widen root-widen)) (if (eq (car-safe expr) 'vec) (let ((n (1- (length expr))) (calc-symbolic-mode nil) @@ -871,7 +879,7 @@ (not (Math-numberp vlow)) (not (Math-numberp vhigh))) (math-search-root expr deriv low vlow high vhigh) - (math-bisect-root expr low vlow high vhigh)))))))))) + (math-bisect-root expr low vlow high vhigh))))))))))) (defun calcFunc-root (expr var guess) (math-find-root expr var guess nil)) @@ -1019,7 +1027,7 @@ math-min-or-max)))))) ;;; "brent" -(defun math-brent-min (expr prec a va x vx b vb) +(defun math-brent-min (expr prec a _va x vx b _vb) (let ((iters (+ 20 (* 5 prec))) (w x) (vw vx) @@ -1181,7 +1189,7 @@ (list 'calcFunc-mrow '(var line-p line-p) (1+ m))))) (math-evaluate-expr expr))) -(defun math-line-min (f1dim line-p line-xi n prec) +(defun math-line-min (f1dim line-p line-xi _n prec) (let* ((var-DUMMY nil) (expr (math-evaluate-expr f1dim)) (params (math-widen-min expr '(float 0 0) '(float 1 0))) @@ -1195,7 +1203,7 @@ (n 0) (var-DUMMY nil) (isvec (math-vectorp var)) - g guesses) + guesses) ;; g (or (math-vectorp var) (setq var (list 'vec var))) (or (math-vectorp guess) @@ -1493,7 +1501,8 @@ (defun math-ninteg-midpoint (expr lo hi mode) ; uses "math-ninteg-temp" (if (eq mode 'inf) - (let ((math-infinite-mode t) temp) + (let (;; (math-infinite-mode t) ;Unused! + temp) (setq temp (math-div 1 lo) lo (math-div 1 hi) hi temp))) @@ -1547,7 +1556,6 @@ (setq math-dummy-counter (1+ math-dummy-counter)))) (defvar math-in-fit 0) -(defvar calc-fit-to-trail nil) (defun calcFunc-fit (expr vars &optional coefs data) (let ((math-in-fit 10)) @@ -1573,6 +1581,7 @@ (defvar math-fit-new-coefs) (defun math-general-fit (expr vars coefs data mode) + (defvar var-YVAL) (defvar var-YVALX) (let ((calc-simplify-mode nil) (math-dummy-counter math-dummy-counter) (math-in-fit 1) @@ -1591,7 +1600,7 @@ (weights nil) (var-YVAL nil) (var-YVALX nil) covar beta - n nn m mm v dummy p) + n m mm v dummy p) ;; nn ;; Validate and parse arguments. (or data @@ -1687,7 +1696,7 @@ (isigsq 1) (xvals (make-vector mm 0)) (i 0) - j k xval yval sigmasqr wt covj covjk covk betaj lud) + j k xval yval sigmasqr wt covj covjk covk betaj) ;; lud (while (<= (setq i (1+ i)) n) ;; Assign various independent variables for this data point. diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index c8a714900d..faec230939 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -1,4 +1,4 @@ -;;; calcsel2.el --- selection functions for Calc +;;; calcsel2.el --- selection functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc. commit 46c0f28c0e4e212687e90ec0ecb239d994105a19 Author: Stefan Monnier Date: Sat Oct 10 11:07:28 2020 -0400 * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Doc tweak Try and clarify the meaning of `init-value`. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index fdc1233540..8c1e5b227a 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -137,6 +137,10 @@ appear in DOC, a paragraph is added to DOC explaining usage of the mode argument. Optional INIT-VALUE is the initial value of the mode's variable. + Note that the minor mode function won't be called by setting + this option, so the value *reflects* the minor mode's natural + initial state, rather than *setting* it. + In the vast majority of cases it should be nil. Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), commit 0ed0dac0ca501a9f328c332a7993bf0624c3873c Merge: 607dacb5a9 c00606171f Author: Glenn Morris Date: Sat Oct 10 07:50:20 2020 -0700 Merge from origin/emacs-27 c00606171f (origin/emacs-27) A better fix for bug#43886 3196fd44c3 Avoid crashes when a theme is loaded with one frame suspended 0407b15500 Removed an incorrectly placed extra word in the semantic docs 040dcbe53e Fix current-line hscrolling when overlays change c56eeba2ce Extend tests for shell-command-dont-erase-buffer commit 607dacb5a969ecbca08275d430132b202becd9db Merge: 530ec029cd 6fea8699a1 Author: Glenn Morris Date: Sat Oct 10 07:50:19 2020 -0700 ; Merge from origin/emacs-27 The following commit was skipped: 6fea8699a1 Clarify what ``chrooted environment means'' for TRAMP commit 530ec029cd9ac084fb5a3ba2b333cb17eb93758d Merge: 6e3bf3968d b6704d58e8 Author: Glenn Morris Date: Sat Oct 10 07:50:19 2020 -0700 Merge from origin/emacs-27 b6704d58e8 ; * src/xdisp.c (Fwindow_text_pixel_size): Doc fix. commit 6e3bf3968d51a31213079b6f324054f4a350033a Merge: 950911373c cbcca8159d Author: Glenn Morris Date: Sat Oct 10 07:50:19 2020 -0700 ; Merge from origin/emacs-27 The following commit was skipped: cbcca8159d Add missing full stop in MS-DOS processes documentation commit 950911373c7e3a7527748b377935f4bfff694fe8 Merge: 1006eb1198 acc9b46153 Author: Glenn Morris Date: Sat Oct 10 07:50:18 2020 -0700 Merge from origin/emacs-27 acc9b46153 Fix merging of region face for non-ASCII characters c2a13969e4 Make drag and drop on NS open all URLs (bug#43470) commit 1006eb119849e4f81aa9a0b1c214a72bc2fbf8e3 Author: Mattias Engdegård Date: Sat Oct 10 11:29:43 2020 +0200 Improve coverage of Calc bit shift test * test/lisp/calc/calc-tests.el (calc-tests--rsh, calc-tests--rash) (calc-shift-binary): Test with negative word sizes. diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index 4bced28a64..fe37c424d5 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -594,7 +594,10 @@ An existing calc stack is reused, otherwise a new one is created." "Logical shift right X by N steps, word size W." (if (< n 0) (calc-tests--lsh x (- n) w) - (ash (calc-tests--clip x w) (- n)))) + ;; First zero-extend, then shift. + (calc-tests--clip + (ash (calc-tests--clip x (abs w)) (- n)) + w))) (defun calc-tests--ash (x n w) "Arithmetic shift left X by N steps, word size W." @@ -607,8 +610,9 @@ An existing calc stack is reused, otherwise a new one is created." (if (< n 0) (calc-tests--ash x (- n) w) ;; First sign-extend, then shift. - (let ((x-sext (calc-tests--clip x (- (abs w))))) - (calc-tests--clip (ash x-sext (- n)) w)))) + (calc-tests--clip + (ash (calc-tests--clip x (- (abs w))) (- n)) + w))) (defun calc-tests--rot (x n w) "Rotate X left by N steps, word size W." @@ -619,11 +623,12 @@ An existing calc stack is reused, otherwise a new one is created." w))) (ert-deftest calc-shift-binary () - (dolist (w '(16 32)) + (dolist (w '(16 32 -16 -32)) (dolist (x '(0 1 #x1234 #x8000 #xabcd #xffff #x12345678 #xabcdef12 #x80000000 #xffffffff #x1234567890ab #x1234967890ab - -1 -14)) + -1 -14 #x-8000 #x-ffff #x-8001 #x-10000 + #x-80000000 #x-ffffffff #x-80000001 #x-100000000)) (dolist (n '(0 1 4 16 32 -1 -4 -16 -32)) (should (equal (calcFunc-lsh x n w) (calc-tests--lsh x n w))) commit c00606171f88be0df2c19346fa53f401ea71c71f Author: Eli Zaretskii Date: Sat Oct 10 11:11:34 2020 +0300 A better fix for bug#43886 * src/xfaces.c (load_color2, Fcolor_distance): Revert last change. * src/term.c (clear_tty_hooks): Don't clear defined_color_hook. diff --git a/src/term.c b/src/term.c index 94bf013f4a..370f6fcd45 100644 --- a/src/term.c +++ b/src/term.c @@ -3842,7 +3842,9 @@ clear_tty_hooks (struct terminal *terminal) terminal->update_begin_hook = 0; terminal->update_end_hook = 0; terminal->set_terminal_window_hook = 0; - terminal->defined_color_hook = 0; + /* Don't clear the defined_color_hook, as that makes it impossible + to unload or load a theme when some TTY frame is suspended. */ + /* terminal->defined_color_hook = 0; */ terminal->mouse_position_hook = 0; terminal->frame_rehighlight_hook = 0; terminal->frame_raise_lower_hook = 0; diff --git a/src/xfaces.c b/src/xfaces.c index fab29efe6f..66d6c34030 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1059,13 +1059,6 @@ static unsigned long load_color2 (struct frame *f, struct face *face, Lisp_Object name, enum lface_attribute_index target_index, Emacs_Color *color) { - if (FRAME_TERMINAL (f)->defined_color_hook == NULL) - { - Lisp_Object frame; - XSETFRAME (frame, f); - signal_error ("Unable to load colors for suspended TTY frame", frame); - } - eassert (STRINGP (name)); eassert (target_index == LFACE_FOREGROUND_INDEX || target_index == LFACE_BACKGROUND_INDEX @@ -4398,9 +4391,6 @@ two lists of the form (RED GREEN BLUE) aforementioned. */) struct frame *f = decode_live_frame (frame); Emacs_Color cdef1, cdef2; - if (FRAME_TERMINAL (f)->defined_color_hook == NULL) - signal_error ("Unable to validate colors for suspended TTY frame", frame); - if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1)) && !(STRINGP (color1) && FRAME_TERMINAL (f)->defined_color_hook (f, commit 3196fd44c36a5ce6789382f74442c461d9264471 Author: Eli Zaretskii Date: Fri Oct 9 22:21:18 2020 +0300 Avoid crashes when a theme is loaded with one frame suspended * src/xfaces.c (load_color2, Fcolor_distance): Don't try to call the frame's defined_color_hook if the frame is suspended. (Bug#43886) diff --git a/src/xfaces.c b/src/xfaces.c index 66d6c34030..fab29efe6f 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1059,6 +1059,13 @@ static unsigned long load_color2 (struct frame *f, struct face *face, Lisp_Object name, enum lface_attribute_index target_index, Emacs_Color *color) { + if (FRAME_TERMINAL (f)->defined_color_hook == NULL) + { + Lisp_Object frame; + XSETFRAME (frame, f); + signal_error ("Unable to load colors for suspended TTY frame", frame); + } + eassert (STRINGP (name)); eassert (target_index == LFACE_FOREGROUND_INDEX || target_index == LFACE_BACKGROUND_INDEX @@ -4391,6 +4398,9 @@ two lists of the form (RED GREEN BLUE) aforementioned. */) struct frame *f = decode_live_frame (frame); Emacs_Color cdef1, cdef2; + if (FRAME_TERMINAL (f)->defined_color_hook == NULL) + signal_error ("Unable to validate colors for suspended TTY frame", frame); + if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1)) && !(STRINGP (color1) && FRAME_TERMINAL (f)->defined_color_hook (f, commit 0407b155009542fd369350237fd975bd0a14f005 Author: Pankaj Jangid Date: Fri Oct 9 06:46:27 2020 +0200 Removed an incorrectly placed extra word in the semantic docs * doc/misc/semantic.texi (Parser code): Copy edit (bug#43861). Copyright-paperwork-exempt: yes diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi index 26979e4cb1..c2b2be2282 100644 --- a/doc/misc/semantic.texi +++ b/doc/misc/semantic.texi @@ -269,7 +269,7 @@ preprocessors. @item semantic/grammar.el @itemx semantic/bovine/grammar.el The ``bovine'' grammar. This is the first grammar mode written for -@semantic{} and is useful for simple creating simple parsers. +@semantic{} and is useful for creating simple parsers. @item semantic/wisent.el @itemx semantic/wisent/wisent.el commit 040dcbe53e39a83fde9cbd09e47b6cfe575d2d52 Author: Eli Zaretskii Date: Thu Oct 8 14:45:16 2020 +0300 Fix current-line hscrolling when overlays change * src/xdisp.c (redisplay_internal): Disable "optimization 1" when auto-hscrolling current line and we're redisplaying the selected window. (Bug#43835) diff --git a/src/xdisp.c b/src/xdisp.c index 05f69b0321..6c401d0abb 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15581,7 +15581,12 @@ redisplay_internal (void) && CHARPOS (this_line_end_pos) == CHARPOS (tlendpos) /* Line has same height as before. Otherwise other lines would have to be shifted up or down. */ - && this_line_pixel_height == line_height_before) + && this_line_pixel_height == line_height_before + /* Cannot use this optimization if hscrolling current + line and this line is the current one, because + display_line above is not informed about the + current-line's vpos, and cannot DTRT in that case. */ + && !hscrolling_current_line_p (w)) { /* If this is not the window's last line, we must adjust the charstarts of the lines below. */ commit c56eeba2ce3b20d1f420db5e0d8cff37df9835c0 Author: Michael Albinus Date: Thu Oct 8 11:28:50 2020 +0200 Extend tests for shell-command-dont-erase-buffer * test/lisp/simple-tests.el (simple-tests-shell-command-dont-erase-buffer): Extend test. * test/lisp/net/tramp-tests.el (tramp-test32-shell-command-dont-erase-buffer): Adapt test. Tag it :unstable. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 89d4171dde..fb4df639e5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4609,214 +4609,127 @@ INPUT, if non-nil, is a string sent to the process." ;; This test is inspired by Bug#39067. (ert-deftest tramp-test32-shell-command-dont-erase-buffer () "Check `shell-command-dont-erase-buffer'." - :tags '(:expensive-test) + ;; As long as Bug#40896 is not solved both in simple.el and Tramp, + ;; this test cannot run properly. + :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. (skip-unless (tramp--test-emacs27-p)) - ;; We check both the local and remote case, in order to guarantee - ;; that they behave similar. - (dolist (default-directory - `(,temporary-file-directory ,tramp-test-temporary-file-directory)) - (let ((buffer (generate-new-buffer "foo")) - ;; Suppress nasty messages. - (inhibit-message t) - point kill-buffer-query-functions) - (unwind-protect - (progn - ;; Don't erase if buffer is the current one. Point is not moved. - (let (shell-command-dont-erase-buffer) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - (should (= point (point))) - (should-not (= (point) (point-max))))) - - ;; Erase if the buffer is not current one. Point is not moved. - (let (shell-command-dont-erase-buffer) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "baz\n" (buffer-string))) - (should (= point (point))) - (should-not (= (point) (point-max))))) - - ;; Erase if buffer is the current one, but - ;; `shell-command-dont-erase-buffer' is set to `erase'. - ;; There is no point to check point. - (let ((shell-command-dont-erase-buffer 'erase)) - (with-temp-buffer - (insert "bar") - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "baz\n" (buffer-string))) - ;; In the local case, point is not moved after the - ;; inserted text. - (should (= (point) - (if (file-remote-p default-directory) - (point-max) (point-min)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `beg-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'beg-last-out)) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `beg-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'beg-last-out)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `end-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'end-last-out)) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; This does not work as expected in the local case. - ;; Therefore, we negate the test for the time being. - (should-not - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= point (point)))) - (should - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `end-last-out'. Check point. - (let ((shell-command-dont-erase-buffer 'end-last-out)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should-not (= point (point))) - (should (= (point) (point-max)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `save-point'. Check point. - (let ((shell-command-dont-erase-buffer 'save-point)) - (with-temp-buffer - (insert "bar") - (goto-char (1- (point-max))) - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (1- (point-max)))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "babaz\nr" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to - ;; `save-point'. Check point. - (let ((shell-command-dont-erase-buffer 'save-point)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (goto-char (1- (point-max))) - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (1- (point-max)))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - ;; This does not work as expected. Therefore, we - ;; use the "wrong" string. - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should (= point (point))) - (should-not (= (point) (point-max)))))) - - ;; Don't erase if the buffer is the current one and - ;; `shell-command-dont-erase-buffer' is set to a random - ;; value. Check point. - (let ((shell-command-dont-erase-buffer 'random)) - (with-temp-buffer - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (shell-command "echo baz" (current-buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; This does not work as expected in the local case. - ;; Therefore, we negate the test for the time being. - (should-not - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= point (point)))) - (should - (funcall (if (file-remote-p default-directory) #'identity #'not) - (= (point) (point-max)))))) - - ;; Don't erase if the buffer is not the current one and - ;; `shell-command-dont-erase-buffer' is set to a random - ;; value. Check point. - (let ((shell-command-dont-erase-buffer 'random)) - (with-current-buffer buffer - (erase-buffer) - (insert "bar") - (setq point (point)) - (should (string-equal "bar" (buffer-string))) - (should (= (point) (point-max))) - (with-temp-buffer - (shell-command "echo baz" buffer)) - (should (string-equal "barbaz\n" (buffer-string))) - ;; There is still an error in Tramp. - (unless (file-remote-p default-directory) - (should-not (= point (point))) - (should (= (point) (point-max))))))) - - ;; Cleanup. - (ignore-errors (kill-buffer buffer)))))) + ;; (message " s-c-d-e-b current-buffer buffer-string point") + ;; (message "===============================================") + + ;; s-c-d-e-b current-buffer buffer-string point + ;; =============================================== + ;; nil t foobazzbar 4 x + ;; nil nil bazz 5 + ;; ----------------------------------------------- + ;; erase t bazz 1 x + ;; erase nil bazz 5 + ;; ----------------------------------------------- + ;; beg-last-out t foobazzbar 4 x + ;; beg-last-out nil foobarbazz 7 + ;; ----------------------------------------------- + ;; end-last-out t foobazzbar 4 + ;; end-last-out nil foobazzbar 11 + ;; ----------------------------------------------- + ;; save-point t foobazzbar 4 x + ;; save-point nil foobarbazz 4 x + ;; ----------------------------------------------- + ;; random t foobazzbar 4 + ;; random nil foobazzbar 11 + ;; ----------------------------------------------- + + (let (;; Suppress nasty messages. + (inhibit-message t) + buffer kill-buffer-query-functions) + ;; We check both the local and remote case, in order to guarantee + ;; that they behave similar. + (dolist (default-directory + `(,temporary-file-directory ,tramp-test-temporary-file-directory)) + ;; These are the possible values of `shell-command-dont-erase-buffer'. + ;; `random' is taken as non-nil value without special meaning. + (dolist (shell-command-dont-erase-buffer + '(nil erase beg-last-out end-last-out save-point random)) + ;; `shell-command' might work over the current buffer, or not. + (dolist (current '(t nil)) + (with-temp-buffer + ;; We insert the string "foobar" into an empty buffer. + ;; Point is set between "foo" and "bar". + (setq buffer (current-buffer)) + (insert "foobar") + (goto-char (- (point) 3)) + (should (string-equal "foobar" (buffer-string))) + (should (string-equal "foo" (buffer-substring (point-min) (point)))) + (should (string-equal "bar" (buffer-substring (point) (point-max)))) + + ;; Apply `shell-command'. It shall output the string + ;; "bazz". Messages in the *Messages* buffer are + ;; suppressed. + (let (message-log-max) + (if current + (shell-command "echo -n bazz" (current-buffer)) + (with-temp-buffer (shell-command "echo -n bazz" buffer)))) + + ;; (message + ;; "%12s %14s %13s %5d" + ;; shell-command-dont-erase-buffer current (buffer-string) (point)))) + ;; (message "-----------------------------------------------"))))) + + ;; Check result. + (cond + (current + ;; String is inserted at point, and point is preserved + ;; unless dictated otherwise. + (cond + ((null shell-command-dont-erase-buffer) + (should (string-equal "foobazzbar" (buffer-string))) + (should (= 4 (point)))) + ((eq shell-command-dont-erase-buffer 'erase) + (should (string-equal "bazz" (buffer-string))) + (should (= 1 (point)))) + ((eq shell-command-dont-erase-buffer 'beg-last-out) + (should (string-equal "foobazzbar" (buffer-string))) + (should (= 4 (point)))) + ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'end-last-out) + ;; (should (string-equal "foobazzbar" (buffer-string))) + ;; (should (= 7 (point)))) + ((eq shell-command-dont-erase-buffer 'save-point) + (should (string-equal "foobazzbar" (buffer-string))) + (should (= 4 (point)))) + ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'random) + ;; (should (string-equal "foobazzbar" (buffer-string))) + ;; (should (= 7 (point)))))) + )) + + (t ;; not current buffer + ;; String is appended, and point is at point-max unless + ;; dictated otherwise. + (cond + ((null shell-command-dont-erase-buffer) + (should (string-equal "bazz" (buffer-string))) + (should (= 5 (point)))) + ((eq shell-command-dont-erase-buffer 'erase) + (should (string-equal "bazz" (buffer-string))) + (should (= 5 (point)))) + ((eq shell-command-dont-erase-buffer 'beg-last-out) + (should (string-equal "foobarbazz" (buffer-string))) + (should (= 7 (point)))) + ;; ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'end-last-out) + ;; (should (string-equal "foobarbazz" (buffer-string))) + ;; (should (= 11 (point)))) + ((eq shell-command-dont-erase-buffer 'save-point) + (should (string-equal "foobarbazz" (buffer-string))) + (should (= 4 (point)))) + ;; ;; Bug#40896 + ;; ((eq shell-command-dont-erase-buffer 'random) + ;; (should (string-equal "foobarbazz" (buffer-string))) + ;; (should (= 11 (point))))))))))))) + ))))))))) ;; This test is inspired by Bug#23952. (ert-deftest tramp-test33-environment-variables () diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index c8b913b3f1..dad54cb408 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -760,11 +760,12 @@ See Bug#21722." (let* ((str "foo\\n") (expected-point `((beg-last-out . ,(1+ (length str))) (end-last-out . ,(1+ (* 2 (length str)))) - (save-point . 1)))) + (save-point . 1) + (erase . ,(1+ (length str))) + (nil . ,(1+ (length str)))))) (dolist (output-buffer-is-current '(nil)) (with-shell-command-dont-erase-buffer str output-buffer-is-current - (when (memq shell-command-dont-erase-buffer '(beg-last-out end-last-out save-point)) - (should (= (point) (alist-get shell-command-dont-erase-buffer expected-point)))))))) + (should (= (point) (alist-get shell-command-dont-erase-buffer expected-point))))))) (provide 'simple-test) commit 6fea8699a188c5b222eb0786bed6b748ad9e11ac Author: Hong Xu Date: Wed Oct 7 04:41:29 2020 +0200 Clarify what ``chrooted environment means'' for TRAMP * doc/misc/tramp.texi (Frequently Asked Questions): Clarify what ``chrooted environment means'' for TRAMP (bug#43839). diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 2739098334..f990819cf5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4063,8 +4063,8 @@ first saving to a temporary file. @vindex tramp-local-host-regexp When connecting to a local host, @value{tramp} uses some internal -optimizations. They fail, when there is a chrooted environment. In -order to disable those optimizations, set user option +optimizations. They fail when Emacs runs in a chrooted environment. +In order to disable those optimizations, set user option @code{tramp-local-host-regexp} to @code{nil}. commit b6704d58e828e96d72185d9f3a63545771d2698f Author: Eli Zaretskii Date: Tue Oct 6 19:32:20 2020 +0300 ; * src/xdisp.c (Fwindow_text_pixel_size): Doc fix. diff --git a/src/xdisp.c b/src/xdisp.c index 5632aecfba..05f69b0321 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10436,7 +10436,7 @@ contains long lines that shall be truncated anyway. The optional argument Y-LIMIT, if non-nil, specifies the maximum Y coordinate beyond which the text is to be ignored; it is therefore -also the maxcomp height that the function can return (excluding the +also the maximum height that the function can return (excluding the height of the mode- or header-line, if any). Y-LIMIT nil or omitted means consider all of the accessible portion of buffer text up to the position specified by TO. Since calculating the text height of a commit cbcca8159d9f12250d213f148df58bf1888a1296 Author: Daniel Martín Date: Tue Oct 6 03:42:44 2020 +0200 Add missing full stop in MS-DOS processes documentation * doc/emacs/msdos-xtra.texi (MS-DOS Processes): Minor copy edig (bug#43820). diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi index 230e918c84..045ac6c460 100644 --- a/doc/emacs/msdos-xtra.texi +++ b/doc/emacs/msdos-xtra.texi @@ -563,7 +563,7 @@ finishes. Spell checking also works, by means of special support for synchronous invocation of the @code{ispell} program. This is slower than the -asynchronous invocation on other platforms +asynchronous invocation on other platforms. Instead of the Shell mode, which doesn't work on MS-DOS, you can use the @kbd{M-x eshell} command. This invokes the Eshell package that commit acc9b461538d65190cd88f87fd997f733f382ad9 Author: Eli Zaretskii Date: Mon Oct 5 12:34:22 2020 +0300 Fix merging of region face for non-ASCII characters * src/xdisp.c (extend_face_to_end_of_line): Restore the correct original face used by the iterator on this line, not the ASCII face. (Bug#43363) diff --git a/src/xdisp.c b/src/xdisp.c index 2af6144975..5632aecfba 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21808,13 +21808,14 @@ extend_face_to_end_of_line (struct it *it) in the text area has to be drawn to the end of the text area. */ it->glyph_row->fill_line_p = true; + const int orig_face_id = it->face_id; /* If current character of IT is not ASCII, make sure we have the ASCII face. This will be automatically undone the next time get_next_display_element returns a multibyte character. Note that the character will always be single byte in unibyte text. */ if (!ASCII_CHAR_P (it->c)) - it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); + it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); /* The default face, possibly remapped. */ struct face *default_face = @@ -22008,6 +22009,7 @@ extend_face_to_end_of_line (struct it *it) if (stretch_width < 0) it->glyph_row->x = stretch_width; } + it->face_id = orig_face_id; } else #endif /* HAVE_WINDOW_SYSTEM */ @@ -22017,7 +22019,6 @@ extend_face_to_end_of_line (struct it *it) struct text_pos saved_pos = it->position; Lisp_Object saved_object = it->object;; enum display_element_type saved_what = it->what; - int saved_face_id = it->face_id; it->what = IT_CHARACTER; memset (&it->position, 0, sizeof it->position); @@ -22120,7 +22121,7 @@ extend_face_to_end_of_line (struct it *it) it->object = saved_object; it->position = saved_pos; it->what = saved_what; - it->face_id = saved_face_id; + it->face_id = orig_face_id; } } commit c2a13969e41265506c9965b4b15c064155d3fb78 Author: Alan Third Date: Sun Sep 27 10:55:32 2020 +0100 Make drag and drop on NS open all URLs (bug#43470) * lisp/term/ns-win.el (ns-drag-n-drop): Merge generic and copy actions. Co-authored-by: Daniel Martín diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 90024b001f..184271d9e6 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -513,15 +513,9 @@ string dropped into the current buffer." (set-frame-selected-window nil window) (raise-frame) (setq window (selected-window)) - (cond ((memq 'ns-drag-operation-generic operations) - ;; Perform the default action for the type. - (if (eq type 'file) - (dolist (data objects) - (dnd-handle-one-url window 'private (concat "file:" data))) - (dnd-insert-text window 'private string))) - ((memq 'ns-drag-operation-copy operations) - ;; Try to open the file/URL. If type is nil, try to open - ;; it as a URL anyway. + (cond ((or (memq 'ns-drag-operation-generic operations) + (memq 'ns-drag-operation-copy operations)) + ;; Perform the default/copy action. (dolist (data objects) (dnd-handle-one-url window 'private (if (eq type 'file) (concat "file:" data)