diff --git a/ChangeLog.3 b/ChangeLog.3 index ed7704e47ff..83e5001e522 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -76935,7 +76935,7 @@ * lisp/emacs-lisp/lisp-mode.el (lisp-cl-font-lock-keywords-2): Highlight the Common Lisp conventional names as described in - http://www.cliki.net/Naming+conventions. + https://www.cliki.net/Naming+conventions. (lisp-el-font-lock-keywords-2): Remove the already commented out code for `do-' and `with-' because Emacs Lisp does not have a similar convention. @@ -122126,7 +122126,7 @@ I roughly followed the Bordeaux threads API: - http://trac.common-lisp.net/bordeaux-threads/wiki/ApiDocumentation + https://sionescu.github.io/bordeaux-threads/ ... but not identically. In particular I chose not to implement interrupt-thread or destroy-thread, but instead a thread-signaling diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 4054b094def..925c7019803 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -861,6 +861,7 @@ Projects * Project File Commands:: Commands for handling project files. * Project Buffer Commands:: Commands for handling project buffers. * Switching Projects:: Switching between projects. +* Managing Projects:: Managing the project list file. Change Logs diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 27504188717..dfe4eb0ea30 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1664,6 +1664,7 @@ the project back-end. For example, the VC back-end doesn't consider * Project File Commands:: Commands for handling project files. * Project Buffer Commands:: Commands for handling project buffers. * Switching Projects:: Switching between projects. +* Managing Projects:: Managing the project list file. @end menu @node Project File Commands @@ -1843,6 +1844,21 @@ in the menu, and which key invokes each command. records the list of known projects. It defaults to the file @file{projects} in @code{user-emacs-directory} (@pxref{Find Init}). +@node Managing Projects +@subsection Managing the Project List File + +@table @kbd +@item M-x project-remove-known-project +Remove a known project from the @code{project-list-file}. +@end table + +@findex project-remove-known-project + Normally Emacs automatically adds and removes projects to and from the +@code{project-list-file}, but sometimes you may want to manually edit +the available projects. @kbd{M-x project-remove-known-project} +prompts you to choose one of the available projects, and then removes +it from the file. + @node Change Log @section Change Logs diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 9c1b9757593..d0865c5d0bd 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -82,7 +82,9 @@ after a recursive minibuffer has been opened in the current command (@pxref{Recursive Mini,,, elisp}). This option is mainly to retain (approximately) the behavior prior to Emacs 28.1. Note that the effect of the command, when you finally finish using the minibuffer, -always takes place in the frame where you first opened it. +always takes place in the frame where you first opened it. The sole +exception is that when that frame no longer exists, the action takes +place in the currently selected frame. @node Minibuffer File @section Minibuffers for File Names diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 5cae939b7bf..b4d7bc729f5 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -390,6 +390,22 @@ whitespace to a single space character, as well as removing all whitespace from the start and the end of @var{string}. @end defun +@defun string-trim-left string &optional regexp +Remove the leading text that matches @var{regexp} from @var{string}. +@var{regexp} defaults to @samp{[ \t\n\r]+}. +@end defun + +@defun string-trim-right string &optional regexp +Remove the trailing text that matches @var{regexp} from @var{string}. +@var{regexp} defaults to @samp{[ \t\n\r]+}. +@end defun + +@defun string-trim string &optional trim-left trim-right +Remove the leading text that matches @var{trim-left} and trailing text +that matches @var{trim-right} from from @var{string}. Both regexps +default to @samp{[ \t\n\r]+}. +@end defun + @defun string-fill string length Attempt to Word-wrap @var{string} so that no lines are longer than @var{length}. Filling is done on whitespace boundaries only. If diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 35a25262115..d3db940dd92 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -1935,13 +1935,13 @@ when you're online. Let's talk about Unix systems first: For the news part, the easiest solution is a small nntp server like -@uref{http://www.leafnode.org/, Leafnode} or +@uref{https://www.leafnode.org/, Leafnode} or @uref{http://patrik.iki.fi/sn/, sn}, of course you can also install a full featured news server like @uref{https://www.isc.org/othersoftware/, inn}. Then you want to fetch your Mail, popular choices -are @uref{http://www.fetchmail.info/, fetchmail} +are @uref{https://www.fetchmail.info/, fetchmail} and @uref{http://pyropus.ca/software/getmail/, getmail}. You should tell those to write the mail to your disk and Gnus to read it from there. Last but not least the mail diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi index 3671ac8f3d2..4ca223d46c4 100644 --- a/doc/misc/nxml-mode.texi +++ b/doc/misc/nxml-mode.texi @@ -82,7 +82,7 @@ documents. To get validation and schema-sensitive editing, you need a RELAX NG Compact Syntax (RNC) schema for your document (@pxref{Locating a schema}). The @file{etc/schema} directory includes some schemas for popular document -types. See @url{http://relaxng.org/} for more information on RELAX NG@. +types. See @url{https://relaxng.org/} for more information on RELAX NG@. You can use the @samp{Trang} program from @url{http://www.thaiopensource.com/relaxng/trang.html} to automatically create RNC schemas. This program can: diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index dac7ae3d199..a91181b116e 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -1181,7 +1181,7 @@ where each line of input produces a line of output.} % double any backslashes. Otherwise, a name like "\node" will be % interpreted as a newline (\n), followed by o, d, e. Not good. % -% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and +% See https://mailman.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and % related messages. The final outcome is that it is up to the TeX user % to double the backslashes and otherwise make the string valid, so % that's what we do. pdftex 1.30.0 (ca.2005) introduced a primitive to @@ -3539,7 +3539,7 @@ $$% % We use the free feym* fonts from the eurosym package by Henrik % Theiling, which support regular, slanted, bold and bold slanted (and % "outlined" (blackboard board, sort of) versions, which we don't need). -% It is available from http://www.ctan.org/tex-archive/fonts/eurosym. +% It is available from https://www.ctan.org/tex-archive/fonts/eurosym. % % Although only regular is the truly official Euro symbol, we ignore % that. The Euro is designed to be slightly taller than the regular diff --git a/etc/NEWS b/etc/NEWS index a7da587be83..5274e2ce329 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -259,8 +259,8 @@ search buffer due to too many matches being highlighted. The 'C-x x' keymap now holds keystrokes for various buffer-oriented commands. The new keystrokes are 'C-x x g' ('revert-buffer'), 'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n' -('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t' -('toggle-truncate-lines'). +('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t' +('toggle-truncate-lines') and 'C-x x f' ('font-lock-update'). --- ** Commands 'set-frame-width' and 'set-frame-height' can now get their @@ -438,6 +438,9 @@ to nil. This was already sometimes the case, but it is now guaranteed. This is like '(pred (lambda (x) (not (FUN x))))' but results in better code. +--- +*** New function 'pcase-compile-patterns' to write other macros. + +++ ** profiler.el The results displayed by 'profiler-report' now have the usage figures @@ -564,7 +567,9 @@ It also supports a negative argument. *** 'C-x t G' assigns a group name to the tab. 'tab-close-group' can close all tabs that belong to the selected group. The user option 'tab-bar-new-tab-group' defines the default group of a -new tab. +new tab. After customizing 'tab-bar-tab-post-change-group-functions' +to 'tab-bar-move-tab-to-group', changing the tab group will also move it +closer to other tabs in the same group. --- *** New user option 'tab-bar-tab-name-format-function'. @@ -1583,6 +1588,11 @@ project's root directory, respectively. +++ *** New user option 'project-list-file'. ++++ +*** New command 'project-remove-known-project'. +This command lets you interactively remove an entry from the list of projects +in 'project-list-file'. + ** xref --- @@ -2277,13 +2287,24 @@ To restore the old binding, say something like: (require 'facemenu) (define-key global-map "\M-o" 'facemenu-keymap) + (define-key facemenu-keymap "\es" 'center-line) + (define-key facemenu-keymap "\eS" 'center-paragraph) + +The last two lines are not strictly necessary if you don't care about +having those two commands on the 'M-o' keymap; see the next section. ** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. -Use 'M-x center-line' and 'M-x center-paragraph' instead. +Use 'M-x center-line' and 'M-x center-paragraph' instead. See the +previous section for how to get back the old bindings. Alternatively, +if you only want these two commands to have global bindings they had +before, you can add the following to your init file: + + (define-key global-map "\M-o\M-s" 'center-line) + (define-key global-map "\M-o\M-S" 'center-paragraph) ** The 'M-o M-o' global binding has been removed. Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f' -command, which toggles fontification in the current buffer. +command, which updates the syntax highlighting in the current buffer. ** In 'f90-mode', the backslash character ('\') no longer escapes. For about a decade, the backslash character has no longer had a @@ -2299,6 +2320,10 @@ since the latter uses 'M-s' as a prefix key of the search prefix map. ** 'vc-print-branch-log' shows the change log for BRANCH from its root directory instead of the default directory. +--- +** 'project-shell' and 'shell' now use 'pop-to-buffer-same-window'. +This is to keep the same behavior as Eshell. + * Incompatible Lisp Changes in Emacs 28.1 diff --git a/lib/pipe2.c b/lib/pipe2.c index 41493aa4307..adbaa4a1021 100644 --- a/lib/pipe2.c +++ b/lib/pipe2.c @@ -41,7 +41,7 @@ pipe2 (int fd[2], int flags) { /* Mingw _pipe() corrupts fd on failure; also, if we succeed at creating the pipe but later fail at changing fcntl, we want - to leave fd unchanged: http://austingroupbugs.net/view.php?id=467 */ + to leave fd unchanged: https://austingroupbugs.net/view.php?id=467 */ int tmp[2]; tmp[0] = fd[0]; tmp[1] = fd[1]; diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index f251be8dfb9..a642af2dae1 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -6,7 +6,7 @@ ;; Version: 1.0 ;; Created: Dec 2005 ;; Keywords: outlines -;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout +;; Website: https://myriadicity.net/software-and-systems/craft/emacs-allout ;; This file is part of GNU Emacs. @@ -38,7 +38,7 @@ ;; See the `allout-widgets-mode' docstring for more details. ;; ;; Info about allout and allout-widgets development are available at -;; http://myriadicity.net/Sundry/EmacsAllout +;; https://myriadicity.net/software-and-systems/craft/emacs-allout ;; ;; The graphics include: ;; diff --git a/lisp/allout.el b/lisp/allout.el index 3981fdd785f..18762357530 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -6,7 +6,7 @@ ;; Created: Dec 1991 -- first release to usenet ;; Version: 2.3 ;; Keywords: outlines, wp, languages, PGP, GnuPG -;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout +;; Website: https://myriadicity.net/software-and-systems/craft/emacs-allout ;; This file is part of GNU Emacs. @@ -57,7 +57,7 @@ ;; mode. ;; ;; Directions to the latest development version and helpful notes are -;; available at http://myriadicity.net/Sundry/EmacsAllout . +;; available at https://myriadicity.net/software-and-systems/craft/emacs-allout . ;; ;; The outline menubar additions provide quick reference to many of the ;; features. See the docstring of the variables `allout-layout' and diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 39db1a710bd..a7b959c47fd 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -27,16 +27,18 @@ ;;; Commentary: -;; Integrates password-store (http://passwordstore.org/) within +;; Integrates password-store (https://passwordstore.org/) within ;; auth-source. ;;; Code: (require 'seq) -(eval-when-compile (require 'subr-x)) (require 'cl-lib) (require 'auth-source) (require 'url-parse) +;; Use `eval-when-compile' after the other `require's to avoid spurious +;; "might not be defined at runtime" warnings. +(eval-when-compile (require 'subr-x)) (defgroup auth-source-pass nil "password-store integration within auth-source." @@ -123,7 +125,7 @@ ENTRY is the name of a password-store entry. The key used to retrieve the password is the symbol `secret'. The convention used as the format for a password-store file is -the following (see http://www.passwordstore.org/#organization): +the following (see https://www.passwordstore.org/#organization): secret key1: value1 diff --git a/lisp/bindings.el b/lisp/bindings.el index a502373997a..6eac528eb61 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1211,7 +1211,7 @@ if `inhibit-field-text-motion' is non-nil." ;; (define-key global-map [kp-9] 'function-key-error) ;; (define-key global-map [kp-equal] 'function-key-error) -;; X11R6 distinguishes these keys from the non-kp keys. +;; X11 distinguishes these keys from the non-kp keys. ;; Make them behave like the non-kp keys unless otherwise bound. ;; FIXME: rather than list such mappings for every modifier-combination, ;; we should come up with a way to do it generically, something like diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index c2e4205c0bc..ff419c72f6f 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -27,7 +27,7 @@ ;; This collection of functions implements the features of calendar.el ;; and diary-lib.el that deal with the Bahá’í calendar. -;; The Bahá’í (http://www.bahai.org) calendar system is based on a +;; The Bahá’í (https://www.bahai.org) calendar system is based on a ;; solar cycle of 19 months with 19 days each. The four remaining ;; "intercalary" days are called the Ayyám-i-Há (days of Há), and are ;; placed between the 18th and 19th months. They are meant as a time diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 8f4dbf0c5e5..d9cd21e3cd2 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -66,7 +66,7 @@ ;; 0.02: ;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches! ;; - Added exporting from Emacs diary to ical. -;; - Some bugfixes, after testing with calendars from http://icalshare.com. +;; - Some bugfixes, after testing with calendars from https://icalshare.com. ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12 ;; 0.01: (2003-03-21) diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el index 5a109a73cd9..44c48119845 100644 --- a/lisp/calendar/iso8601.el +++ b/lisp/calendar/iso8601.el @@ -41,7 +41,7 @@ ;; ;; The standard can be found at: ;; -;; http://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf +;; https://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf ;; ;; The Wikipedia page on the standard is also informative: ;; diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index e75bc918e0b..7186a781235 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -79,13 +79,8 @@ (insert "(")) (t nil)))) -(defalias 'semantic-ia-get-completions #'semantic-ia-get-completions-deprecated) -(make-obsolete 'semantic-ia-get-completions - #'semantic-analyze-possible-completions "28.1") - -(defun semantic-ia-get-completions-deprecated (context _point) - "A function to help transition away from `semantic-ia-get-completions'. -Return completions based on CONTEXT at POINT." +(defun semantic-ia-get-completions (context _point) + "Fetch the completion of CONTEXT at POINT." (declare (obsolete semantic-analyze-possible-completions "28.1")) (semantic-analyze-possible-completions context)) diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index 7a5761ce8c8..9ac4ed9f518 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -27,8 +27,6 @@ ;;; Code: -(require 'rx) - ;; Try to load python support, but fail silently since it is only used ;; for optional functionality (require 'python nil t) diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index 772891d5d31..d43cdb15c0d 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -421,7 +421,7 @@ in the next one.") (defun scheme-load-file (file-name) "Load a Scheme file FILE-NAME into the inferior Scheme process." - (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file + (interactive (comint-get-source "Load Scheme file" scheme-prev-l/c-dir/file scheme-source-modes t)) ; t because `load' ; needs an exact name (comint-check-source file-name) ; Check to see if buffer needs saved. @@ -433,7 +433,7 @@ in the next one.") (defun scheme-compile-file (file-name) "Compile a Scheme file FILE-NAME in the inferior Scheme process." - (interactive (comint-get-source "Compile Scheme file: " + (interactive (comint-get-source "Compile Scheme file" scheme-prev-l/c-dir/file scheme-source-modes nil)) ; nil because COMPILE doesn't diff --git a/lisp/comint.el b/lisp/comint.el index 65072b01376..b04d404676d 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2946,7 +2946,7 @@ two arguments are used for determining defaults.) If MUSTMATCH-P is true, then the filename reader will only accept a file that exists. A typical use: - (interactive (comint-get-source \"Compile file: \" prev-lisp-dir/file + (interactive (comint-get-source \"Compile file\" prev-lisp-dir/file \\='(lisp-mode) t))" (let* ((def (comint-source-default prev-dir/file source-modes)) (stringfile (comint-extract-string)) @@ -2959,9 +2959,7 @@ A typical use: (car def))) (deffile (if sfile-p (file-name-nondirectory stringfile) (cdr def))) - (ans (read-file-name (if deffile (format "%s(default %s) " - prompt deffile) - prompt) + (ans (read-file-name (format-prompt prompt deffile) defdir (concat defdir deffile) mustmatch-p))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b04286c34ae..30d59137482 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -548,6 +548,10 @@ has the form (autoload . FILENAME).") (defvar byte-compile-unresolved-functions nil "Alist of undefined functions to which calls have been compiled. +Each element in the list has the form (FUNCTION POSITION . CALLS) +where CALLS is a list whose elements are integers (indicating the +number of arguments passed in the function call) or the constant `t' +if the function is called indirectly. This variable is only significant whilst compiling an entire buffer. Used for warnings when a function is not known to be defined or is later defined with incorrect args.") @@ -1472,9 +1476,9 @@ when printing the error message." ;; Remember number of args in call. (let ((cons (assq f byte-compile-unresolved-functions))) (if cons - (or (memq nargs (cdr cons)) - (push nargs (cdr cons))) - (push (list f nargs) + (or (memq nargs (cddr cons)) + (push nargs (cddr cons))) + (push (list f byte-compile-last-position nargs) byte-compile-unresolved-functions))))) ;; Warn if the form is calling a function with the wrong number of arguments. @@ -1574,14 +1578,14 @@ extra args." (setq byte-compile-unresolved-functions (delq calls byte-compile-unresolved-functions)) (setq calls (delq t calls)) ;Ignore higher-order uses of the function. - (when (cdr calls) + (when (cddr calls) (when (and (symbolp name) (eq (function-get name 'byte-optimizer) 'byte-compile-inline-expand)) (byte-compile-warn "defsubst `%s' was used before it was defined" name)) (setq sig (byte-compile-arglist-signature arglist) - nums (sort (copy-sequence (cdr calls)) (function <)) + nums (sort (copy-sequence (cddr calls)) (function <)) min (car nums) max (car (nreverse nums))) (when (or (< min (car sig)) @@ -1689,56 +1693,21 @@ It is too wide if it has any lines longer than the largest of kind name col)))) form) -(defun byte-compile-print-syms (str1 strn syms) - (when syms - (byte-compile-set-symbol-position (car syms) t)) - (cond ((and (cdr syms) (not noninteractive)) - (let* ((str strn) - (L (length str)) - s) - (while syms - (setq s (symbol-name (pop syms)) - L (+ L (length s) 2)) - (if (< L (1- (buffer-local-value 'fill-column - (or (get-buffer - byte-compile-log-buffer) - (current-buffer))))) - (setq str (concat str " " s (and syms ","))) - (setq str (concat str "\n " s (and syms ",")) - L (+ (length s) 4)))) - (byte-compile-warn "%s" str))) - ((cdr syms) - (byte-compile-warn "%s %s" - strn - (mapconcat #'symbol-name syms ", "))) - - (syms - (byte-compile-warn str1 (car syms))))) - ;; If we have compiled any calls to functions which are not known to be ;; defined, issue a warning enumerating them. ;; `unresolved' in the list `byte-compile-warnings' disables this. (defun byte-compile-warn-about-unresolved-functions () (when (byte-compile-warning-enabled-p 'unresolved) - (let ((byte-compile-current-form :end) - (noruntime nil) - (unresolved nil)) + (let ((byte-compile-current-form :end)) ;; Separate the functions that will not be available at runtime ;; from the truly unresolved ones. - (dolist (f byte-compile-unresolved-functions) - (setq f (car f)) - (when (not (memq f byte-compile-new-defuns)) - (if (fboundp f) (push f noruntime) (push f unresolved)))) - ;; Complain about the no-run-time functions - (byte-compile-print-syms - "the function `%s' might not be defined at runtime." - "the following functions might not be defined at runtime:" - noruntime) - ;; Complain about the unresolved functions - (byte-compile-print-syms - "the function `%s' is not known to be defined." - "the following functions are not known to be defined:" - unresolved))) + (dolist (urf byte-compile-unresolved-functions) + (let ((f (car urf))) + (when (not (memq f byte-compile-new-defuns)) + (let ((byte-compile-last-position (cadr urf))) + (byte-compile-warn + (if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.") + (car urf)))))))) nil) @@ -5006,10 +4975,10 @@ binding slots have been popped." (byte-compile-push-constant op) (byte-compile-form fun) (byte-compile-form prop) - (let* ((fun (eval fun)) - (prop (eval prop)) + (let* ((fun (eval fun t)) + (prop (eval prop t)) (val (if (macroexp-const-p val) - (eval val) + (eval val t) (byte-compile-lambda (cadr val))))) (push `(,fun . (,prop ,val ,@(alist-get fun overriding-plist-environment))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 55c7e67daa6..7f8f7105f33 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1976,7 +1976,8 @@ a `let' form, except that the list of symbols can be computed at run-time." (,binds ())) (while ,syms (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds)) - (eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun)))))))) + (eval (list 'let (nreverse ,binds) + (list 'funcall (list 'quote ,bodyfun)))))))) (defconst cl--labels-magic (make-symbol "cl--labels-magic")) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 4aa8ddcfa11..67b75460941 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -527,7 +527,7 @@ This will generate compile-time constants from BINDINGS." ;; This is too general -- rms. ;; A user complained that he has functions whose names start with `do' ;; and that they get the wrong color. - ;; That user has violated the http://www.cliki.net/Naming+conventions: + ;; That user has violated the https://www.cliki.net/Naming+conventions: ;; CL (but not EL!) `with-' (context) and `do-' (iteration) (,(concat "(\\(\\(do-\\|with-\\)" lisp-mode-symbol-regexp "\\)") (1 font-lock-keyword-face)) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 5342a0179d9..006517db759 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -207,6 +207,7 @@ If EXP fails to match any of the patterns in CASES, an error is signaled." (pcase--dontwarn-upats (cons x pcase--dontwarn-upats))) (pcase--expand ;; FIXME: Could we add the FILE:LINE data in the error message? + ;; FILE is available from `macroexp-file-name'. exp (append cases `((,x (error "No clause matching `%S'" ,x))))))) ;;;###autoload @@ -320,34 +321,46 @@ of the elements of LIST is performed as if by `pcase-let'. (defun pcase--trivial-upat-p (upat) (and (symbolp upat) (not (memq upat pcase--dontcare-upats)))) -(defun pcase--expand (exp cases) - ;; (message "pid=%S (pcase--expand %S ...hash=%S)" - ;; (emacs-pid) exp (sxhash cases)) +(defun pcase-compile-patterns (exp cases) + "Compile the set of patterns in CASES. +EXP is the expression that will be matched against the patterns. +CASES is a list of elements (PAT . CODEGEN) +where CODEGEN is a function that returns the code to use when +PAT matches. That code has to be in the form of a cons cell. + +CODEGEN will be called with at least 2 arguments, VARVALS and COUNT. +VARVALS is a list of elements of the form (VAR VAL . RESERVED) where VAR +is a variable bound by the pattern and VAL is a duplicable expression +that returns the value this variable should be bound to. +If the pattern PAT uses `or', CODEGEN may be called multiple times, +in which case it may want to generate the code differently to avoid +a potential code explosion. For this reason the COUNT argument indicates +how many time this CODEGEN is called." (macroexp-let2 macroexp-copyable-p val exp - (let* ((defs ()) - (seen '()) + (let* ((seen '()) + (phcounter 0) (main (pcase--u (mapcar (lambda (case) `(,(pcase--match val (pcase--macroexpand (car case))) ,(lambda (vars) - (let ((prev (assq case seen)) - (code (cdr case))) + (let ((prev (assq case seen))) (unless prev ;; Keep track of the cases that are used. (push (setq prev (list case)) seen)) - (if (member code '(nil (nil))) nil - ;; Put `code' in the cdr just so that not all - ;; branches look identical (to avoid things like - ;; `macroexp--if' optimizing them too optimistically). - (let ((ph (list 'pcase--placeholder code))) - (setcdr prev (cons (cons vars ph) (cdr prev))) - ph)))))) + ;; Put a counter in the cdr just so that not + ;; all branches look identical (to avoid things + ;; like `macroexp--if' optimizing them too + ;; optimistically). + (let ((ph (cons 'pcase--placeholder + (setq phcounter (1+ phcounter))))) + (setcdr prev (cons (cons vars ph) (cdr prev))) + ph))))) cases)))) ;; Take care of the place holders now. (dolist (branch seen) - (let ((code (cdar branch)) + (let ((codegen (cdar branch)) (uses (cdr branch))) ;; Find all the vars that are in scope (the union of the ;; vars provided in each use case). @@ -358,48 +371,74 @@ of the elements of LIST is performed as if by `pcase-let'. (if vi (if (cddr v) (setcdr vi 'used)) (push (cons (car v) (cddr v)) allvarinfo)))))) - (allvars (mapcar #'car allvarinfo)) - (ignores (mapcar (lambda (vi) (when (cdr vi) `(ignore ,(car vi)))) - allvarinfo))) - ;; Since we use a tree-based pattern matching - ;; technique, the leaves (the places that contain the - ;; code to run once a pattern is matched) can get - ;; copied a very large number of times, so to avoid - ;; code explosion, we need to keep track of how many - ;; times we've used each leaf and move it - ;; to a separate function if that number is too high. - (if (or (null (cdr uses)) (pcase--small-branch-p code)) - (dolist (use uses) - (let ((vars (car use)) - (placeholder (cdr use))) - ;; (cl-assert (eq (car placeholder) 'pcase--placeholder)) - (setcar placeholder 'let) - (setcdr placeholder - `(,(mapcar (lambda (v) (list v (cadr (assq v vars)))) - allvars) - ;; Try and silence some of the most common - ;; spurious "unused var" warnings. - ,@ignores - ,@code)))) - ;; Several occurrence of this non-small branch in the output. - (let ((bsym - (make-symbol (format "pcase-%d" (length defs))))) - (push `(,bsym (lambda ,allvars ,@ignores ,@code)) defs) - (dolist (use uses) - (let ((vars (car use)) - (placeholder (cdr use))) - ;; (cl-assert (eq (car placeholder) 'pcase--placeholder)) - (setcar placeholder 'funcall) - (setcdr placeholder - `(,bsym - ,@(mapcar (lambda (v) (cadr (assq v vars))) - allvars)))))))))) + (allvars (mapcar #'car allvarinfo))) + (dolist (use uses) + (let* ((vars (car use)) + (varvals + (mapcar (lambda (v) + `(,v ,(cadr (assq v vars)) + ,(cdr (assq v allvarinfo)))) + allvars)) + (placeholder (cdr use)) + (code (funcall codegen varvals (length uses)))) + ;; (cl-assert (eq (car placeholder) 'pcase--placeholder)) + (setcar placeholder (car code)) + (setcdr placeholder (cdr code))))))) (dolist (case cases) (unless (or (assq case seen) (memq (car case) pcase--dontwarn-upats)) - (message "pcase pattern %S shadowed by previous pcase pattern" - (car case)))) - (macroexp-let* defs main)))) + (setq main + (macroexp-warn-and-return + (format "pcase pattern %S shadowed by previous pcase pattern" + (car case)) + main)))) + main))) + +(defun pcase--expand (exp cases) + ;; (message "pid=%S (pcase--expand %S ...hash=%S)" + ;; (emacs-pid) exp (sxhash cases)) + (let* ((defs ()) + (codegen + (lambda (code) + (if (member code '(nil (nil) ('nil))) + (lambda (&rest _) ''nil) + (let ((bsym ())) + (lambda (varvals count &rest _) + (let* ((ignored-vars + (delq nil (mapcar (lambda (vv) (if (nth 2 vv) (car vv))) + varvals))) + (ignores (if ignored-vars + `((ignore . ,ignored-vars))))) + ;; Since we use a tree-based pattern matching + ;; technique, the leaves (the places that contain the + ;; code to run once a pattern is matched) can get + ;; copied a very large number of times, so to avoid + ;; code explosion, we need to keep track of how many + ;; times we've used each leaf and move it + ;; to a separate function if that number is too high. + (if (or (< count 2) (pcase--small-branch-p code)) + `(let ,(mapcar (lambda (vv) (list (car vv) (cadr vv))) + varvals) + ;; Try and silence some of the most common + ;; spurious "unused var" warnings. + ,@ignores + ,@code) + ;; Several occurrence of this non-small branch in + ;; the output. + (unless bsym + (setq bsym (make-symbol + (format "pcase-%d" (length defs)))) + (push `(,bsym (lambda ,(mapcar #'car varvals) + ,@ignores ,@code)) + defs)) + `(funcall ,bsym ,@(mapcar #'cadr varvals))))))))) + (main + (pcase-compile-patterns + exp + (mapcar (lambda (case) + (cons (car case) (funcall codegen (cdr case)))) + cases)))) + (macroexp-let* defs main))) (defun pcase--macroexpand (pat) "Expands all macro-patterns in PAT." diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 789d6325e9a..86d5130bbed 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -168,15 +168,12 @@ There can be any number of :example/:result elements." (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 diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 44be9afbfae..994433063ce 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -63,7 +63,7 @@ ;; building the 2D precedence tables and then computing the precedence levels ;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune ;; and Ceriel Jacobs (BookBody.pdf available at -;; http://dickgrune.com/Books/PTAPG_1st_Edition/). +;; https://dickgrune.com/Books/PTAPG_1st_Edition/). ;; ;; OTOH we had to kill many chickens, read many coffee grounds, and practice ;; untold numbers of black magic spells, to come up with the indentation code. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index a4514454c0b..9c8c967ee9c 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -215,28 +215,6 @@ The variable list SPEC is the same as in `if-let'." (define-obsolete-function-alias 'string-reverse 'reverse "25.1") -(defsubst string-trim-left (string &optional regexp) - "Trim STRING of leading string matching REGEXP. - -REGEXP defaults to \"[ \\t\\n\\r]+\"." - (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) - (substring string (match-end 0)) - string)) - -(defsubst string-trim-right (string &optional regexp) - "Trim STRING of trailing string matching REGEXP. - -REGEXP defaults to \"[ \\t\\n\\r]+\"." - (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") - string))) - (if i (substring string 0 i) string))) - -(defsubst string-trim (string &optional trim-left trim-right) - "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT. - -TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." - (string-trim-left (string-trim-right string trim-right) trim-left)) - ;;;###autoload (defun string-truncate-left (string length) "Truncate STRING to LENGTH, replacing initial surplus with \"...\"." diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 42d6c1eb198..728f790a962 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1786,7 +1786,7 @@ Undo previous insertion and inserts new." (do-not-change-default t)) (setq quote-str (viper-read-string-with-history - "Quote string: " + "Quote string" nil 'viper-quote-region-history ;; FIXME: Use comment-region. @@ -1995,24 +1995,17 @@ problems." #'viper-minibuffer-standard-hook (if (or (not (listp old)) (eq (car old) 'lambda)) (list old) old)))) - (val "") - (padding "") - temp-msg) + (val "")) (setq keymap (or keymap minibuffer-local-map) initial (or initial "") - viper-initial initial - temp-msg (if default - (format "(default %s) " default) - "")) + viper-initial initial) (setq viper-incomplete-ex-cmd nil) - (setq val (read-from-minibuffer prompt - (concat temp-msg initial val padding) - keymap nil history-var)) - (setq minibuffer-setup-hook nil - padding (viper-array-to-string (this-command-keys)) - temp-msg "") + (setq val (read-from-minibuffer (format-prompt prompt default) + nil + keymap nil history-var default)) + (setq minibuffer-setup-hook nil) ;; the following tries to be smart about what to put in history (if (not (string= val (car (symbol-value history-var)))) (push val (symbol-value history-var))) @@ -3825,7 +3818,7 @@ Null string will repeat previous search." (let (buffer buffer-name) (setq buffer-name (funcall viper-read-buffer-function - (format "Kill buffer (%s): " + (format-prompt "Kill buffer" (buffer-name (current-buffer))))) (setq buffer (if (null buffer-name) @@ -4171,8 +4164,8 @@ and regexp replace." (interactive) (let (str) (setq str (viper-read-string-with-history - (if viper-re-query-replace "Query replace regexp: " - "Query replace: ") + (if viper-re-query-replace "Query replace regexp" + "Query replace") nil ; no initial 'viper-replace1-history (car viper-replace1-history) ; default @@ -4187,7 +4180,7 @@ and regexp replace." (query-replace-regexp str (viper-read-string-with-history - (format-message "Query replace regexp `%s' with: " str) + (format-message "Query replace regexp `%s' with" str) nil ; no initial 'viper-replace1-history (car viper-replace1-history) ; default @@ -4195,7 +4188,7 @@ and regexp replace." (query-replace str (viper-read-string-with-history - (format-message "Query replace `%s' with: " str) + (format-message "Query replace `%s' with" str) nil ; no initial 'viper-replace1-history (car viper-replace1-history) ; default diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 8b13d1cf49c..044776c2363 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -105,18 +105,19 @@ longer than `erc-fill-column'." "Flag indicating whether nicks should be buttonized or not." :type 'boolean) -(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html" - "URL used to browse rfc references. +(defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s" + "URL used to browse RFC references. %s is replaced by the number." - :type 'string) + :type 'string + :version "28.1") (define-obsolete-variable-alias 'erc-button-google-url 'erc-button-search-url "27.1") -(defcustom erc-button-search-url "http://duckduckgo.com/?q=%s" +(defcustom erc-button-search-url "https://duckduckgo.com/?q=%s" "URL used to search for a term. %s is replaced by the search string." - :version "27.1" + :version "28.1" :type 'string) (defcustom erc-button-alist diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 2028917da0c..19bc2dbb8ec 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -40,8 +40,8 @@ ;; disable this module, it will continue removing message flags, but the ;; unidentified nickname prefix will not be added to messages. -;; Visit and -;; to find further +;; Visit and +;; to find further ;; explanations of this capability. ;; From freenode.net's web site (not there anymore) on how to mark diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bdb1914d7bf..b6dea95bb2b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3389,7 +3389,7 @@ to send. If only one word is given, display the mode of that target. A list of valid mode strings for Freenode may be found at -URL `http://freenode.net/using_the_network.shtml'." +URL `https://freenode.net/kb/all'." (cond ((string-match "^\\s-\\(.*\\)$" line) (let ((s (match-string 1 line))) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index d29b010ea09..f9dbce9770d 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -458,7 +458,7 @@ and the hook `eshell-exit-hook'." (let ((inhibit-read-only t) (no-default (eobp)) (find-tag-default-function 'ignore)) - (setq tagname (car (find-tag-interactive "Find tag: " no-default))) + (setq tagname (car (find-tag-interactive "Find tag" no-default))) (with-suppressed-warnings ((obsolete find-tag)) (find-tag tagname next-p regexp-p)))) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index c1db484be56..7d31845528b 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -23,14 +23,6 @@ ;;; Code: - -;; Unused. -;; (defgroup eshell-opt nil -;; "The options processing code handles command argument parsing for -;; Eshell commands implemented in Lisp." -;; :tag "Command options processing" -;; :group 'eshell) - ;;; User Functions: ;; Macro expansion of eshell-eval-using-options refers to eshell-stringify-list diff --git a/lisp/faces.el b/lisp/faces.el index 5ae3906acc2..3ea4c940a32 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1259,7 +1259,15 @@ of a global face. Value is the new attribute value." (or (car (rassoc old-value valid)) (format "%s" old-value)))) (setq new-value - (face-read-string face default attribute-name valid)) + (if (memq attribute '(:foreground :background)) + (let ((color + (read-color + (format-prompt "%s for face `%s'" + default attribute-name face)))) + (if (equal (string-trim color) "") + default + color)) + (face-read-string face default attribute-name valid))) (if (equal new-value default) ;; Nothing changed, so don't bother with all the stuff ;; below. In particular, this avoids a non-tty color diff --git a/lisp/files-x.el b/lisp/files-x.el index 526a128623c..23e4562f4b1 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -699,13 +699,14 @@ will not be changed." (copy-tree connection-local-variables-alist))) (hack-local-variables-apply))) -(defsubst connection-local-criteria-for-default-directory () - "Return a connection-local criteria, which represents `default-directory'." +(defsubst connection-local-criteria-for-default-directory (&optional application) + "Return a connection-local criteria, which represents `default-directory'. +If APPLICATION is nil, the symbol `tramp' is used." (when (file-remote-p default-directory) - `(:application tramp - :protocol ,(file-remote-p default-directory 'method) - :user ,(file-remote-p default-directory 'user) - :machine ,(file-remote-p default-directory 'host)))) + `(:application ,(or application 'tramp) + :protocol ,(file-remote-p default-directory 'method) + :user ,(file-remote-p default-directory 'user) + :machine ,(file-remote-p default-directory 'host)))) ;;;###autoload (defmacro with-connection-local-variables (&rest body) diff --git a/lisp/finder.el b/lisp/finder.el index 343739f9036..c2d5806c0cd 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -423,7 +423,7 @@ FILE should be in a form suitable for passing to `locate-library'." (defun finder-mouse-select (event) "Select item in a Finder buffer with the mouse." - (interactive "e" finder-mode) + (interactive "e") (with-current-buffer (window-buffer (posn-window (event-start event))) (goto-char (posn-point (event-start event))) (finder-select))) diff --git a/lisp/format.el b/lisp/format.el index 4209fc6401a..3e2d92fef13 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -747,13 +747,17 @@ to write these unknown annotations back into the file." (if (numberp val) ; add to ambient value if numeric (format-property-increment-region from to prop val 0) - (put-text-property - from to prop - (cond ((get prop 'format-list-valued) ; value gets consed onto - ; list-valued properties - (let ((prev (get-text-property from prop))) - (cons val (if (listp prev) prev (list prev))))) - (t val))))) ; normally, just set to val. + ;; Kludge alert: ignore items with reversed order of + ;; FROM and TO. They seem to be redundant anyway, and + ;; in one case I've seen them refer to EOB. + (when (<= from to) + (put-text-property + from to prop + (cond ((get prop 'format-list-valued) ; value gets consed onto + ; list-valued properties + (let ((prev (get-text-property from prop))) + (cons val (if (listp prev) prev (list prev))))) + (t val)))))) ; normally, just set to val. (setq todo (cdr todo))) (if unknown-ans diff --git a/lisp/gnus/.dir-locals.el b/lisp/gnus/.dir-locals.el deleted file mode 100644 index fb968e13a36..00000000000 --- a/lisp/gnus/.dir-locals.el +++ /dev/null @@ -1,4 +0,0 @@ -((emacs-lisp-mode . ((show-trailing-whitespace . t)))) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ad323089ad0..c1071c1c68c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -971,7 +971,7 @@ see http://www.cs.indiana.edu/picons/ftp/index.html" :version "22.1" :type '(repeat directory) :link '(url-link :tag "download" - "http://www.cs.indiana.edu/picons/ftp/index.html") + "http://www.cs.indiana.edu/picons/ftp/index.html") :link '(custom-manual "(gnus)Picons") :group 'gnus-picon) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 97da5503539..c30f9a5f350 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5977,14 +5977,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (input (read-string (if only-read-p - (format - "How many articles from %s (available %d, default %d): " - (gnus-group-real-name gnus-newsgroup-name) - number default) - (format - "How many articles from %s (%d default): " - (gnus-group-real-name gnus-newsgroup-name) - default)) + (format-prompt + "How many articles from %s (available %d)" + default + (gnus-group-real-name gnus-newsgroup-name) + number) + (format-prompt + "How many articles from %s" + default + (gnus-group-real-name gnus-newsgroup-name))) nil nil (number-to-string default)))) @@ -9514,11 +9515,9 @@ If BACKWARD, search backward instead." (interactive (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) + (format-prompt "Search article %s (regexp)" + gnus-last-search-regexp + (if current-prefix-arg "backward" "forward"))) current-prefix-arg) gnus-summary-mode) (if (string-equal regexp "") @@ -9537,10 +9536,8 @@ If BACKWARD, search backward instead." (interactive (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - "")))) + (format-prompt "Search article backward (regexp)" + gnus-last-search-regexp))) gnus-summary-mode) (gnus-summary-search-article-forward regexp 'backward)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 1e0362a3bfa..fad4ef3dcf6 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -382,7 +382,7 @@ Archives \(such as groups.google.com) respect this header." :group 'message-various) (defcustom message-archive-note - "X-No-Archive: Yes - save http://groups.google.com/" + "X-No-Archive: Yes - save https://groups.google.com/" "Note to insert why you wouldn't want this posting archived. If nil, don't insert any text in the body." :version "22.1" diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index a32eed44196..15157e6fbc8 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -140,7 +140,7 @@ by default identifies the used encryption keys, giving away the Bcc'ed identities. Clearly, this contradicts the original goal of *blind* copies. For an academic paper explaining the problem, see URL -`http://crypto.stanford.edu/portia/papers/bb-bcc.pdf'. +`https://crypto.stanford.edu/portia/papers/bb-bcc.pdf'. Use this variable to specify e-mail addresses whose owners do not mind if they are identifiable as recipients. This may be useful if you use Bcc headers to encrypt e-mails to yourself." diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 46691e3494b..4867455393a 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -21,7 +21,7 @@ ;;; Commentary: -;; Maildir format is documented at . +;; Maildir format is documented at . ;; nnmaildir also stores extra information in the .nnmaildir/ directory ;; within a maildir. ;; diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 36b7af0e345..a40fa88631f 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -930,60 +930,7 @@ Use Mark Pilgrim's `ultra-liberal rss locator'." (setq rss-link (nnrss-rss-title-description rss-ns href-data (car hrefs)))) (setq hrefs (cdr hrefs))))) - (if rss-link - rss-link - ;; 4. check syndic8 - (nnrss-find-rss-via-syndic8 url)))))))) - -(declare-function xml-rpc-method-call "ext:xml-rpc" - (server-url method &rest params)) - -(defun nnrss-find-rss-via-syndic8 (url) - "Query syndic8 for the rss feeds it has for URL." - (if (not (locate-library "xml-rpc")) - (progn - (message "XML-RPC is not available... not checking Syndic8.") - nil) - (require 'xml-rpc) - (let ((feedid (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.FindSites - url))) - (when feedid - (let* ((feedinfo (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.GetFeedInfo - feedid)) - (urllist - (delq nil - (mapcar - (lambda (listinfo) - (if (string-equal - (cdr (assoc "status" listinfo)) - "Syndicated") - (cons - (cdr (assoc "sitename" listinfo)) - (list - (cons 'title - (cdr (assoc - "sitename" listinfo))) - (cons 'href - (cdr (assoc - "dataurl" listinfo))))))) - feedinfo)))) - (if (not (> (length urllist) 1)) - (cdar urllist) - (let ((completion-ignore-case t) - (selection - (mapcar (lambda (listinfo) - (cons (cdr (assoc "sitename" listinfo)) - (string-to-number - (cdr (assoc "feedid" listinfo))))) - feedinfo))) - (cdr (assoc - (gnus-completing-read - "Multiple feeds found. Select one" - selection t) urllist))))))))) + rss-link)))))) (defun nnrss-rss-p (data) "Test if DATA is an RSS feed. @@ -1022,6 +969,11 @@ prefix), return the prefix." (concat ns ":") ns))) +(defun nnrss-find-rss-via-syndic8 (_url) + "This function is obsolete and does nothing. Syndic8 shut down in 2013." + (declare (obsolete nil "28.1")) + nil) + (provide 'nnrss) ;;; nnrss.el ends here diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 2446577c6ad..e9f703e90c6 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -42,7 +42,7 @@ ;; reflect this. ;; ;; The home of this file is in Gnus, but also available from -;; http://josefsson.org/smime.html. +;; https://josefsson.org/smime.html. ;;; Quick introduction: diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index e17bd0a081b..233c50504bf 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -1,4 +1,4 @@ -;;; help-at-pt.el --- local help through the keyboard +;;; help-at-pt.el --- local help through the keyboard -*- lexical-binding: t -*- ;; Copyright (C) 2003-2021 Free Software Foundation, Inc. @@ -42,9 +42,6 @@ ;; ;; (global-set-key [C-tab] 'scan-buf-next-region) ;; (global-set-key [C-M-tab] 'scan-buf-previous-region) -;; -;; You do not have to do anything special to use the functionality -;; provided by this file, because all important functions autoload. ;;; Code: diff --git a/lisp/iimage.el b/lisp/iimage.el index cc1461d7b0f..192530a8e6a 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -1,4 +1,4 @@ -;;; iimage.el --- Inline image minor mode. +;;; iimage.el --- Inline image minor mode. -*- lexical-binding: t -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. @@ -51,8 +51,7 @@ (defcustom iimage-mode-image-search-path nil "List of directories to search for image files for iimage-mode." - :type '(choice (const nil) (repeat directory)) - :group 'iimage) + :type '(choice (const nil) (repeat directory))) (defvar iimage-mode-image-filename-regex (concat "[-+./_0-9a-zA-Z]+\\." @@ -74,14 +73,12 @@ Examples of image filename patterns to match: \\=`file://foo.png\\=' \\[\\[foo.gif]] - foo.JPG -" - :type '(alist :key-type regexp :value-type integer) - :group 'iimage) + foo.JPG" + :type '(alist :key-type regexp :value-type integer)) (defvar iimage-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-l" 'iimage-recenter) + (define-key map "\C-l" #'iimage-recenter) map) "Keymap used in `iimage-mode'.") diff --git a/lisp/image-dired.el b/lisp/image-dired.el index e4b53bd2751..2509ecf8f82 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -67,9 +67,9 @@ ;; ;; * For `image-dired-get-exif-data' and `image-dired-set-exif-data' to work, ;; the command line tool `exiftool' is needed. It can be found here: -;; http://www.sno.phy.queensu.ca/~phil/exiftool/. These two functions -;; are, among other things, used for writing comments to image files -;; using `image-dired-thumbnail-set-image-description' and to create +;; https://exiftool.org/. These two functions are, among other +;; things, used for writing comments to image files using +;; `image-dired-thumbnail-set-image-description' and to create ;; "unique" file names using `image-dired-get-exif-file-name' (used by ;; `image-dired-copy-with-exif-file-name'). ;; diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 3c5a461a31e..0eb009fa526 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -43,12 +43,6 @@ ;;; Code: -;; Unused. -;;; (defgroup ccl nil -;;; "CCL (Code Conversion Language) compiler." -;;; :prefix "ccl-" -;;; :group 'i18n) - (defconst ccl-command-table [if branch loop break repeat write-repeat write-read-repeat read read-if read-branch write call end diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index e4bdf50f526..bf0df6f971d 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1524,7 +1524,7 @@ To deactivate it programmatically, use `deactivate-input-method'." (interactive (let* ((default (or (car input-method-history) default-input-method))) (list (read-input-method-name - (if default "Select input method (default %s): " "Select input method: ") + (format-prompt "Select input method" default) default t) t))) (activate-input-method input-method) @@ -1569,7 +1569,7 @@ which marks the variable `default-input-method' as set for Custom buffers." (if (or arg (not default)) (progn (read-input-method-name - (if default "Input method (default %s): " "Input method: " ) + (format-prompt "Input method" default) default t)) default)) (unless default-input-method @@ -1620,7 +1620,7 @@ If `default-transient-input-method' was not yet defined, prompt for it." "Describe input method INPUT-METHOD." (interactive (list (read-input-method-name - "Describe input method (default current choice): "))) + (format-prompt "Describe input method" current-input-method)))) (if (and input-method (symbolp input-method)) (setq input-method (symbol-name input-method))) (help-setup-xref (list #'describe-input-method @@ -1929,7 +1929,7 @@ runs the hook `exit-language-environment-hook'. After setting up the new language environment, it runs `set-language-environment-hook'." (interactive (list (read-language-name nil - "Set language environment (default English): "))) + (format-prompt "Set language environment" "English")))) (if language-name (if (symbolp language-name) (setq language-name (symbol-name language-name))) @@ -2144,7 +2144,7 @@ See `set-language-info-alist' for use in programs." (interactive (list (read-language-name 'documentation - "Describe language environment (default current choice): "))) + (format-prompt "Describe language environment" current-language-environment)))) (if (null language-name) (setq language-name current-language-environment)) (if (or (null language-name) @@ -2245,7 +2245,7 @@ See `set-language-info-alist' for use in programs." ;; LANGUAGE is a language code taken from ISO 639:1988 (E/F) ;; with additions from ISO 639/RA Newsletter No.1/1989; ;; see Internet RFC 2165 (1997-06) and - ;; http://www.evertype.com/standards/iso639/iso639-en.html + ;; https://www.evertype.com/standards/iso639/iso639-en.html ;; TERRITORY is a country code taken from ISO 3166 ;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html. ;; CODESET and MODIFIER are implementation-dependent. diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 64aac46fcee..2d36dab6320 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -41,7 +41,7 @@ ;; Standards docs equivalent to iso-2022 and iso-8859 are at ;; https://www.ecma.ch/. -;; FWIW, http://www.microsoft.com/globaldev/ lists the following for +;; FWIW, https://www.microsoft.com/globaldev/ lists the following for ;; MS Windows, which are presumably the only charsets we really need ;; to worry about on such systems: ;; `OEM codepages': 437, 720, 737, 775, 850, 852, 855, 857, 858, 862, 866 @@ -358,7 +358,7 @@ :code-offset #x130000 :unify-map "BIG5") ;; Fixme: AKA cp950 according to -;; . Is +;; . Is ;; that correct? (define-charset 'chinese-big5-1 @@ -708,7 +708,7 @@ ;; Original name for cp1125, says Serhii Hlodin (define-charset-alias 'cp866u 'cp1125) -;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html +;; Fixme: C.f. iconv, https://czyborra.com/charsets/codepages.html ;; shows this as not ASCII compatible, with various graphics in ;; 0x01-0x1F. (define-charset 'cp437 diff --git a/lisp/json.el b/lisp/json.el index 6677c3b1b37..0e61e1ad90c 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -26,7 +26,7 @@ ;; This is a library for parsing and generating JSON (JavaScript Object ;; Notation). -;; Learn all about JSON here: . +;; Learn all about JSON here: . ;; The user-serviceable entry points for the parser are the functions ;; `json-read' and `json-read-from-string'. The encoder has a single diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el index c12096f95eb..b64a237cf73 100644 --- a/lisp/language/cyrillic.el +++ b/lisp/language/cyrillic.el @@ -33,7 +33,7 @@ ;; are converted to Unicode internally. See ;; . For more info ;; on Cyrillic charsets, see -;; . The KOI and +;; . The KOI and ;; Alternativnyj coding systems should live in code-pages.el, but ;; they've always been preloaded and the coding system autoload ;; mechanism didn't get accepted, so they have to stay here and diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index fa971b33c7b..c9210c62514 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -36007,7 +36007,7 @@ Add a description of the problem and include a reproducible test case. Feel free to send questions and enhancement requests to . Official distribution is at -URL `http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html' +URL `https://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html' The Vera Mode Maintainer diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el index 0920bc79009..1a95395fd74 100644 --- a/lisp/leim/quail/ipa-praat.el +++ b/lisp/leim/quail/ipa-praat.el @@ -35,7 +35,7 @@ "ipa-praat" "IPA" "IPAP" t "International Phonetic Alphabet input method. This follows the input method of the phonetic analysis program -Praat (http://www.fon.hum.uva.nl/praat/). +Praat (https://www.fon.hum.uva.nl/praat/). * Vowels diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el index e805c6ad3b2..c25687574ed 100644 --- a/lisp/leim/quail/ipa.el +++ b/lisp/leim/quail/ipa.el @@ -336,12 +336,12 @@ exchange in environments where Unicode is not available. This input method uses this transliteration to allow you to produce the IPA in your editor with a keyboard that's limited to ASCII. -See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition +See https://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition of the mapping.") (quail-define-rules ;; Table taken from https://en.wikipedia.org/wiki/X-SAMPA, checked with - ;; http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf + ;; https://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf ("d`" "ɖ") ;; Voiced retroflex plosive U+0256 ("g" "ɡ") ;; Voiced velar plosive U+0261 diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index 8e21ed80130..10408776a2a 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -744,7 +744,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' ;;; correctly on most displays. ;;; This reference is an authoritative guide to Hawaiian orthography: -;;; http://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html +;;; https://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html ;;; Initial coding 2018-09-08 Bob Newell, Honolulu, Hawaiʻi ;;; Comments to bobnewell@bobnewell.net diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index 22006547c45..b8b0fabfa84 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -1294,7 +1294,7 @@ of characters from a single Latin-N charset. ;;; correctly on most displays. ;;; This reference is an authoritative guide to Hawaiian orthography: -;;; http://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html +;;; https://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html ;;; Initial coding 2018-09-08 Bob Newell, Honolulu, Hawaiʻi ;;; Comments to bobnewell@bobnewell.net diff --git a/lisp/leim/quail/programmer-dvorak.el b/lisp/leim/quail/programmer-dvorak.el index 49f9d82bc0d..9e1e23c04bb 100644 --- a/lisp/leim/quail/programmer-dvorak.el +++ b/lisp/leim/quail/programmer-dvorak.el @@ -24,7 +24,7 @@ ;;; Commentary: ;;; This file provides an input method for the programmers Dvorak keyboard -;;; layout by Roland Kaufman (). +;;; layout by Roland Kaufman (). ;;; Code: diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index d76017b9944..cec573642ec 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -163,7 +163,7 @@ ;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t) ;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail) ;; -;; Alternatively, the FLIM project +;; Alternatively, the FLIM project ;; provides a library called smtp.el. If you want to use that, the above lines ;; would be: ;; diff --git a/lisp/master.el b/lisp/master.el index 796f2189d66..3dcee50c5e0 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -1,4 +1,4 @@ -;;; master.el --- make a buffer the master over another buffer +;;; master.el --- make a buffer the master over another buffer -*- lexical-binding: t -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -23,7 +23,7 @@ ;;; Commentary: -;; master-mode is a minor mode which enables you to scroll another +;; `master-mode' is a minor mode which enables you to scroll another ;; buffer (the slave) without leaving your current buffer (the master). ;; It can be used by sql.el, for example: The SQL buffer is the master @@ -47,17 +47,8 @@ ;; ;; Rob Riepel -;;; History: -;; - ;;; Code: -;; Unused. -;;; (defgroup master nil -;;; "Support for master/slave relationships between buffers." -;;; :version "22.1" -;;; :group 'convenience) - ;; Variables that don't need initialization. (defvar master-of nil @@ -93,7 +84,7 @@ yourself the value of `master-of' by calling `master-show-slave'." ;; Initialize Master mode by setting a slave buffer. (defun master-set-slave (buffer) - "Makes BUFFER the slave of the current buffer. + "Make BUFFER the slave of the current buffer. Use \\[master-mode] to toggle control of the slave buffer." (interactive "bSlave: ") (setq-local master-of buffer) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 133df65cbcb..e6cce593430 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -604,7 +604,7 @@ Do the same for the keys of the same name." (define-key global-map [f20] 'clipboard-kill-region) (define-key global-map [f16] 'clipboard-kill-ring-save) (define-key global-map [f18] 'clipboard-yank) - ;; X11R6 versions: + ;; X11 versions: (define-key global-map [cut] 'clipboard-kill-region) (define-key global-map [copy] 'clipboard-kill-ring-save) (define-key global-map [paste] 'clipboard-yank)) diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 012725cab60..67c019aa179 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -1,4 +1,4 @@ -;;; mh-alias.el --- MH-E mail alias completion and expansion +;;; mh-alias.el --- MH-E mail alias completion and expansion -*- lexical-binding: t; -*- ;; Copyright (C) 1994-1997, 2001-2021 Free Software Foundation, Inc. @@ -42,8 +42,8 @@ "Time aliases were last loaded.") (defvar mh-alias-read-address-map (let ((map (copy-keymap minibuffer-local-completion-map))) - (define-key map "," 'mh-alias-minibuffer-confirm-address) - (define-key map " " 'self-insert-command) + (define-key map "," #'mh-alias-minibuffer-confirm-address) + (define-key map " " #'self-insert-command) map)) (defcustom mh-alias-system-aliases @@ -270,9 +270,9 @@ Blind aliases or users from /etc/passwd are not expanded." (t (split-string (completing-read prompt mh-alias-alist nil nil) ","))))) (if (not mh-alias-expand-aliases-flag) - (mapconcat 'identity the-answer ", ") + (mapconcat #'identity the-answer ", ") ;; Loop over all elements, checking if in passwd alias or blind first - (mapconcat 'mh-alias-expand the-answer ",\n "))))) + (mapconcat #'mh-alias-expand the-answer ",\n "))))) ;;;###mh-autoload (defun mh-alias-minibuffer-confirm-address () @@ -427,10 +427,10 @@ contains it." (if (or (not alias) (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist (completing-read "Alias file: " - (mapcar 'list mh-alias-insert-file) nil t) + (mapcar #'list mh-alias-insert-file) nil t) (or (mh-alias-which-file-has-alias alias mh-alias-insert-file) (completing-read "Alias file: " - (mapcar 'list mh-alias-insert-file) nil t))))) + (mapcar #'list mh-alias-insert-file) nil t))))) ((and mh-alias-insert-file (stringp mh-alias-insert-file)) mh-alias-insert-file) (t @@ -449,11 +449,10 @@ set `mh-alias-insert-file' or the \"Aliasfile:\" profile component")) (car autolist)) ((or (not alias) (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist - (completing-read "Alias file: " (mapcar 'list autolist) nil t)) + (completing-read "Alias file: " autolist nil t)) (t (or (mh-alias-which-file-has-alias alias autolist) - (completing-read "Alias file: " - (mapcar 'list autolist) nil t)))))))) + (completing-read "Alias file: " autolist nil t)))))))) ;;;###mh-autoload (defun mh-alias-address-to-alias (address) diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el index 55f74b6585d..a32f61c82eb 100644 --- a/lisp/mh-e/mh-buffers.el +++ b/lisp/mh-e/mh-buffers.el @@ -1,4 +1,4 @@ -;;; mh-buffers.el --- MH-E buffer constants and utilities +;;; mh-buffers.el --- MH-E buffer constants and utilities -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 0dedb7e0ad0..c1cd6c1a9e2 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -1,4 +1,4 @@ -;;; mh-comp.el --- MH-E functions for composing and sending messages +;;; mh-comp.el --- MH-E functions for composing and sending messages -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation, ;; Inc. @@ -719,12 +719,14 @@ message and scan line." (mh-insert-fields field value))))) (mh-components-to-list components-file)) (delete-file components-file)) - (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ") - "Resent-Cc:" (mapconcat 'identity (list cc comp-cc) ", ") - "Resent-Fcc:" (mapconcat 'identity (list fcc - comp-fcc) ", ") - "Resent-Bcc:" (mapconcat 'identity (list bcc - comp-bcc) ", ") + (mh-insert-fields "Resent-To:" (mapconcat #'identity (list to comp-to) + ", ") + "Resent-Cc:" (mapconcat #'identity (list cc comp-cc) + ", ") + "Resent-Fcc:" (mapconcat #'identity (list fcc comp-fcc) + ", ") + "Resent-Bcc:" (mapconcat #'identity (list bcc comp-bcc) + ", ") "Resent-From:" from) (save-buffer) (message "Redistributing...") @@ -1096,7 +1098,7 @@ letter." (setq mode-line-buffer-identification (list " {%b}")) (mh-logo-display) (mh-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t) + (add-hook 'kill-buffer-hook #'mh-tidy-draft-buffer nil t) (run-hook-with-args 'mh-compose-letter-function to subject cc)) (defun mh-insert-x-mailer () @@ -1165,7 +1167,7 @@ This should be the last function called when composing the draft." MSG can be a message number, a list of message numbers, or a sequence. The hook `mh-annotate-msg-hook' is run after annotating; see its documentation for variables it can use." - (apply 'mh-exec-cmd "anno" folder + (apply #'mh-exec-cmd "anno" folder (if (listp msg) (append msg args) (cons msg args))) (save-excursion (cond ((get-buffer folder) ; Buffer may be deleted diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 6d657afa3ed..0363c5aadac 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -42,7 +42,7 @@ (eval-when-compile (require 'mh-acros)) (mh-do-in-gnu-emacs - (defalias 'mh-require 'require)) + (defalias 'mh-require #'require)) (mh-do-in-xemacs (defun mh-require (feature &optional filename noerror) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index eaf8eb55651..1aac3374153 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -522,7 +522,7 @@ parsed by MH-E." (let* ((initial-size (mh-truncate-log-buffer)) (start (point)) (args (mh-list-to-string args))) - (apply 'call-process (expand-file-name command mh-progs) nil t nil args) + (apply #'call-process (expand-file-name command mh-progs) nil t nil args) (when (> (buffer-size) initial-size) (save-excursion (goto-char start) @@ -560,7 +560,7 @@ ARGS are passed to COMMAND as command line arguments." (with-current-buffer (get-buffer-create mh-log-buffer) (mh-truncate-log-buffer)) (let* ((process-connection-type nil) - (process (apply 'start-process + (process (apply #'start-process command nil (expand-file-name command mh-progs) (mh-list-to-string args)))) @@ -602,7 +602,7 @@ RAISE-ERROR is non-nil, in which case an error is signaled if (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (let ((value - (apply 'call-process + (apply #'call-process (expand-file-name command mh-progs) nil t nil args))) (goto-char (point-min)) @@ -616,7 +616,7 @@ Put the output into buffer after point. Set mark after inserted text. Output is expected to be shown to user, not parsed by MH-E." (push-mark (point) t) - (apply 'call-process + (apply #'call-process (expand-file-name command mh-progs) nil t display (mh-list-to-string args)) @@ -650,7 +650,7 @@ preserves whether the mark is active or not." "Execute MH library command COMMAND with ARGS. Put the output into buffer after point. Set mark after inserted text." - (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) + (apply #'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) (defun mh-handle-process-error (command status) "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." @@ -974,7 +974,7 @@ necessary and can actually cause problems." :set (lambda (symbol value) (set-default symbol value) ;Done in mh-variant-set-variant! (mh-variant-set value)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :group 'mh-e :package-version '(MH-E . "8.0")) @@ -1548,7 +1548,7 @@ as the result is undefined." '(radio) (mapcar (lambda (arg) `(const ,arg)) - (mapcar 'car mh-identity-list)))) + (mapcar #'car mh-identity-list)))) (cons :tag "Fcc Field" (const "fcc") (string :tag "Value")) @@ -1575,7 +1575,7 @@ See `mh-identity-list'." '(radio) (cons '(const :tag "None" nil) (mapcar (lambda (arg) `(const ,arg)) - (mapcar 'car mh-identity-list)))) + (mapcar #'car mh-identity-list)))) :group 'mh-identity :package-version '(MH-E . "7.1")) @@ -1744,7 +1744,7 @@ bogofilter, then you can set this option to \"Bogofilter\"." (const :tag "SpamAssassin" spamassassin) (const :tag "Bogofilter" bogofilter) (const :tag "SpamProbe" spamprobe)) - :set 'mh-junk-choose + :set #'mh-junk-choose :group 'mh-junk :package-version '(MH-E . "7.3")) @@ -1907,7 +1907,7 @@ white image, can be generated using the \"compface\" command (see URL `ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z'). The \"Online X-Face Converter\" is a useful resource for quick conversion of images into \"X-Face:\" header fields (see URL -`http://www.dairiki.org/xface/'). +`https://www.dairiki.org/xface/'). Use the \"make-face\" script to convert a JPEG image to the higher resolution, color, \"Face:\" header field (see URL @@ -2005,7 +2005,7 @@ call `mh-set-cmd-note' with the width specified by your format file you would use \"(mh-set-cmd-note 4)\"." :type 'boolean :group 'mh-scan-line-formats - :set 'mh-adaptive-cmd-note-flag-check + :set #'mh-adaptive-cmd-note-flag-check :package-version '(MH-E . "7.0")) (defun mh-scan-format-file-check (symbol value) @@ -2044,7 +2044,7 @@ Emacs start with 0)." (const :tag "Use Default scan Format" nil) (file :tag "Specify a scan Format File")) :group 'mh-scan-line-formats - :set 'mh-scan-format-file-check + :set #'mh-scan-format-file-check :package-version '(MH-E . "6.0")) (defun mh-adaptive-cmd-note-flag-check (symbol value) @@ -2466,9 +2466,9 @@ of citations entirely, choose \"None\"." "Disposition-Notification-Options:" ; RFC 2298 "Disposition-Notification-To:" ; RFC 2298 "Distribution:" ; RFC 1036 - "DKIM-" ; http://antispam.yahoo.com/domainkeys + "DKIM-" ; https://en.wikipedia.org/wiki/DomainKeys_Identified_Mail "DL-Expansion-History:" ; RFC 2156 - "DomainKey-" ; http://antispam.yahoo.com/domainkeys + "DomainKey-" ; https://en.wikipedia.org/wiki/DomainKeys_Identified_Mail "DomainKey-Signature:" "Encoding:" ; RFC 1505 "Envelope-to:" @@ -2555,7 +2555,7 @@ of citations entirely, choose \"None\"." "X-Abuse-Info:" "X-Accept-Language:" ; Netscape/Mozilla "X-Ack:" - "X-ACL-Warn:" ; http://www.exim.org + "X-ACL-Warn:" ; https://www.exim.org "X-Admin:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Administrivia-To:" "X-AMAZON" ; Amazon.com @@ -2579,8 +2579,8 @@ of citations entirely, choose \"None\"." "X-BFI:" "X-Bigfish:" "X-Bogosity:" ; bogofilter - "X-BPS1:" ; http://www.boggletools.com - "X-BPS2:" ; http://www.boggletools.com + "X-BPS1:" ; http://www.boggletools.com [dead link?] + "X-BPS2:" ; http://www.boggletools.com [dead link?] "X-Brightmail-Tracker:" ; Brightmail "X-BrightmailFiltered:" ; Brightmail "X-Bugzilla-" ; Bugzilla @@ -2596,12 +2596,12 @@ of citations entirely, choose \"None\"." "X-Confirm-Reading-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Content-Filtered-By:" "X-ContentStamp:" ; NetZero - "X-Country-Chain:" ; http://www.declude.com/x-note.htm + "X-Country-Chain:" ; http://www.declude.com/x-note.htm [dead link?] "X-Cr-Hashedpuzzle:" "X-Cr-Puzzleid:" "X-Cron-Env:" "X-DCC-" ; SpamAssassin - "X-Declude-" ; http://www.declude.com/x-note.htm + "X-Declude-" ; http://www.declude.com/x-note.htm [dead link?] "X-Dedicated:" "X-Delivered" "X-Destination-ID:" @@ -2616,7 +2616,7 @@ of citations entirely, choose \"None\"." "X-EID:" "X-ELNK-Trace:" ; Earthlink mailer "X-EM-" ; Some ecommerce software - "X-Email-Type-Id:" ; Paypal http://www.paypal.com + "X-Email-Type-Id:" ; Paypal https://www.paypal.com "X-Enigmail-Version:" "X-Envelope-Date:" ; GNU mailutils "X-Envelope-From:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ @@ -2632,21 +2632,21 @@ of citations entirely, choose \"None\"." "X-Folder:" ; Spam "X-Forwarded-" ; Google+ "X-From-Line" - "X-FuHaFi:" ; http://www.gmx.net/ + "X-FuHaFi:" ; https://www.gmx.net/ "X-Generated-By:" ; launchpad.net "X-Gmail-" ; Gmail "X-Gnus-Mail-Source:" ; gnus "X-Google-" ; Google mail "X-Google-Sender-Auth:" "X-Greylist:" ; milter-greylist-1.2.1 - "X-Habeas-" ; http://www.returnpath.net + "X-Habeas-" ; https://www.returnpath.net "X-Hashcash:" ; hashcash "X-Headers-End:" ; SpamCop "X-HPL-" "X-HR-" "X-HTTP-UserAgent:" "X-Hz" ; Hertz - "X-Identity:" ; http://www.declude.com/x-note.htm + "X-Identity:" ; http://www.declude.com/x-note.htm [dead link?] "X-IEEE-UCE-" ; IEEE spam filter "X-Image-URL:" "X-IMAP:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ @@ -2667,7 +2667,7 @@ of citations entirely, choose \"None\"." "X-Loop:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Lrde-Mailscanner:" "X-Lumos-SenderID:" ; Roving ConstantContact - "X-mail_abuse_inquiries:" ; http://www.salesforce.com + "X-mail_abuse_inquiries:" ; https://www.salesforce.com "X-Mail-from:" ; fastmail.fm "X-MAIL-INFO:" ; NetZero "X-Mailer_" @@ -2680,11 +2680,11 @@ of citations entirely, choose \"None\"." "X-Mailutils-Message-Id" ; GNU Mailutils "X-Majordomo:" ; Majordomo mailing list manager "X-Match:" - "X-MaxCode-Template:" ; Paypal http://www.paypal.com + "X-MaxCode-Template:" ; Paypal https://www.paypal.com "X-MB-Message-" ; AOL WebMail "X-MDaemon-Deliver-To:" "X-MDRemoteIP:" - "X-ME-Bayesian:" ; http://www.newmediadevelopment.net/page.cfm/parent/Client-Area/content/Managing-spam/ + "X-ME-Bayesian:" ; https://www.newmediadevelopment.net/page.cfm/parent/Client-Area/content/Managing-spam/ "X-Message-Id" "X-Message-Type:" "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX @@ -2755,7 +2755,7 @@ of citations entirely, choose \"None\"." "X-Server-Date:" "X-Server-Uuid:" "X-Service-Code:" - "X-SFDC-" ; http://www.salesforce.com + "X-SFDC-" ; https://www.salesforce.com "X-Sieve:" ; Sieve filtering "X-SMFBL:" "X-SMHeaderMap:" @@ -2770,7 +2770,7 @@ of citations entirely, choose \"None\"." "X-Submissions-To:" "X-Sun-Charset:" "X-Telecom-Digest" - "X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com + "X-TM-IMSS-Message-ID:" ; https://www.trendmicro.com "X-Trace:" "X-UID" "X-UIDL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ @@ -2790,10 +2790,10 @@ of citations entirely, choose \"None\"." "X-WebTV-Signature:" "X-Wss-Id:" ; Worldtalk gateways "X-X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/ - "X-XPT-XSL-Name:" ; Paypal http://www.paypal.com + "X-XPT-XSL-Name:" ; Paypal https://www.paypal.com "X-xsi-" - "X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm - "X-Y-GMX-Trusted:" ; http://www.gmx.net/ + "X-XWALL-" ; https://www.dataenter.co.at/doc/xwall_undocumented_config.htm + "X-Y-GMX-Trusted:" ; https://www.gmx.net/ "X-Yahoo" "X-Yahoo-Newman-" "X-YMail-" @@ -3039,7 +3039,7 @@ XEmacs. For more information, see URL `ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent versions of XEmacs have internal support for \"X-Face:\" images. If your version of XEmacs does not, then you'll need both \"uncompface\" -and the x-face package (see URL `http://www.jpl.org/ftp/pub/elisp/'). +and the x-face package (see URL `https://www.jpl.org/ftp/pub/elisp/'). Finally, MH-E will display images referenced by the \"X-Image-URL:\" header field if neither the \"Face:\" nor the \"X-Face:\" fields are diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 555d13d7235..2e288064f16 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -1,4 +1,4 @@ -;;; mh-folder.el --- MH-Folder mode +;;; mh-folder.el --- MH-Folder mode -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc. @@ -209,10 +209,10 @@ annotation.") ;; Use defalias to make sure the documented primary key bindings ;; appear in menu lists. -(defalias 'mh-alt-show 'mh-show) -(defalias 'mh-alt-refile-msg 'mh-refile-msg) -(defalias 'mh-alt-send 'mh-send) -(defalias 'mh-alt-visit-folder 'mh-visit-folder) +(defalias 'mh-alt-show #'mh-show) +(defalias 'mh-alt-refile-msg #'mh-refile-msg) +(defalias 'mh-alt-send #'mh-send) +(defalias 'mh-alt-visit-folder #'mh-visit-folder) ;; Save the "b" binding for a future `back'. Maybe? (gnus-define-keys mh-folder-mode-map @@ -650,11 +650,11 @@ perform the operation on all messages in that region. (auto-save-mode -1) (setq buffer-offer-save t) (mh-make-local-hook (mh-write-file-functions)) - (add-hook (mh-write-file-functions) 'mh-execute-commands nil t) + (add-hook (mh-write-file-functions) #'mh-execute-commands nil t) (make-local-variable 'revert-buffer-function) (make-local-variable 'hl-line-mode) ; avoid pollution (mh-funcall-if-exists hl-line-mode 1) - (setq revert-buffer-function 'mh-undo-folder) + (setq revert-buffer-function #'mh-undo-folder) (add-to-list 'minor-mode-alist '(mh-showing-mode " Show")) (mh-do-in-xemacs (easy-menu-add mh-folder-sequence-menu) @@ -1117,7 +1117,7 @@ called interactively." (message "Destination folder: %s" (cdr mh-last-destination))) (t (mh-iterate-on-range msg range - (apply 'mh-write-msg-to-file msg (cdr mh-last-destination))) + (apply #'mh-write-msg-to-file msg (cdr mh-last-destination))) (mh-next-msg interactive-flag)))) ;;;###mh-autoload @@ -1606,7 +1606,7 @@ after the commands are processed." ;; Now delete messages (cond (mh-delete-list (setq redraw-needed-flag t) - (apply 'mh-exec-cmd "rmm" folder + (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list mh-delete-list)) (mh-delete-scan-msgs mh-delete-list) (setq mh-delete-list nil))) @@ -1620,8 +1620,8 @@ after the commands are processed." ;; (mh-refile-a-msg nil (intern dest)) ;; (mh-delete-a-msg nil))) (if (null dest) - (apply 'mh-exec-cmd "rmm" folder msg-list) - (apply 'mh-exec-cmd "refile" "-src" folder dest msg-list) + (apply #'mh-exec-cmd "rmm" folder msg-list) + (apply #'mh-exec-cmd "refile" "-src" folder dest msg-list) (push dest folders-changed)) (setq redraw-needed-flag t) (mh-delete-scan-msgs mh-blacklist) @@ -1703,7 +1703,7 @@ after the commands are processed." (mh-recenter nil))) ;;;###mh-autoload -(defun mh-make-folder-mode-line (&optional ignored) +(defun mh-make-folder-mode-line (&optional _ignored) "Set the fields of the mode line for a folder buffer. The optional argument is now obsolete and IGNORED. It used to be used to pass in what is now stored in the buffer-local variable diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 309bcb4b49f..38ba43188da 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -1,4 +1,4 @@ -;;; mh-funcs.el --- MH-E functions not everyone will use right away +;;; mh-funcs.el --- MH-E functions not everyone will use right away -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc. @@ -348,7 +348,7 @@ See `mh-store-msg' for a description of DIRECTORY." (error "Error occurred during execution of %s" command))))) ;;;###mh-autoload -(defun mh-undo-folder (&rest ignored) +(defun mh-undo-folder (&rest _ignored) "Undo all refiles and deletes in the current folder. Arguments are IGNORED (for `revert-buffer')." (interactive) diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 6a9851662ab..ac46cc63fcc 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -1,4 +1,4 @@ -;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus +;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc. @@ -129,7 +129,7 @@ (unless default (setq default (mml-content-disposition type filename))) (let ((disposition (completing-read - (format "Disposition (default %s): " default) + (format-prompt "Disposition" default) '(("attachment") ("inline") ("")) nil t nil nil default))) (if (not (equal disposition "")) diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index 18443992177..aeab0497562 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -1,4 +1,4 @@ -;;; mh-identity.el --- multiple identify support for MH-E +;;; mh-identity.el --- multiple identify support for MH-E -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -50,7 +50,7 @@ This is normally set as part of an Identity in (defvar mh-identity-menu nil "The Identity menu.") -(defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu) +(defalias 'mh-identity-make-menu-no-autoload #'mh-identity-make-menu) ;;;###mh-autoload (defun mh-identity-make-menu () @@ -74,7 +74,7 @@ See `mh-identity-add-menu'." (mapcar (lambda (arg) `[,arg (mh-insert-identity ,arg) :style radio :selected (equal mh-identity-local ,arg)]) - (mapcar 'car mh-identity-list)) + (mapcar #'car mh-identity-list)) '(["None" (mh-insert-identity "None") :style radio :selected (not mh-identity-local)] @@ -142,7 +142,7 @@ See `mh-identity-list'." (completing-read "Identity: " (cons '("None") - (mapcar 'list (mapcar 'car mh-identity-list))) + (mapcar #'list (mapcar #'car mh-identity-list))) nil t default nil default)) (if (eq identity "None") nil @@ -171,8 +171,8 @@ See `mh-identity-list'." "Identity: " (if mh-identity-local (cons '("None") - (mapcar 'list (mapcar 'car mh-identity-list))) - (mapcar 'list (mapcar 'car mh-identity-list))) + (mapcar #'list (mapcar #'car mh-identity-list))) + (mapcar #'list (mapcar #'car mh-identity-list))) nil t) nil)) diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el index 32f731799b9..90d54895261 100644 --- a/lisp/mh-e/mh-inc.el +++ b/lisp/mh-e/mh-inc.el @@ -1,4 +1,4 @@ -;;; mh-inc.el --- MH-E "inc" and separate mail spool handling +;;; mh-inc.el --- MH-E "inc" and separate mail spool handling -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc. @@ -58,7 +58,7 @@ (mh-inc-spool-generator folder spool) (mh-inc-spool-def-key key folder)))))) -(defalias 'mh-inc-spool-make-no-autoload 'mh-inc-spool-make) +(defalias 'mh-inc-spool-make-no-autoload #'mh-inc-spool-make) (defun mh-inc-spool-generator (folder spool) "Create a command to inc into FOLDER from SPOOL file." diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index b49c6322492..5a407947a0b 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -1,4 +1,4 @@ -;;; mh-junk.el --- MH-E interface to anti-spam measures +;;; mh-junk.el --- MH-E interface to anti-spam measures -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2021 Free Software Foundation, Inc. diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index f5ad73d800d..59790181c4d 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -1,4 +1,4 @@ -;;; mh-letter.el --- MH-Letter mode +;;; mh-letter.el --- MH-Letter mode -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation, ;; Inc. @@ -334,15 +334,15 @@ order). ;; Maybe we want to use the existing Mail menu from mail-mode in ;; 9.0; in the mean time, let's remove it since the redundancy will ;; only produce confusion. - (define-key mh-letter-mode-map [menu-bar mail] 'undefined) + (define-key mh-letter-mode-map [menu-bar mail] #'undefined) (mh-do-in-xemacs (easy-menu-remove mail-menubar-menu)) (setq fill-column mh-letter-fill-column) (add-hook 'completion-at-point-functions - 'mh-letter-completion-at-point nil 'local) + #'mh-letter-completion-at-point nil 'local) ;; If text-mode-hook turned on auto-fill, tune it for messages (when auto-fill-function (make-local-variable 'auto-fill-function) - (setq auto-fill-function 'mh-auto-fill-for-letter))) + (setq auto-fill-function #'mh-auto-fill-for-letter))) @@ -390,10 +390,7 @@ This command leaves the mark before the letter and point after it." (or mh-sent-from-msg (nth 0 (mh-translate-range folder "cur"))) (nth 0 (mh-translate-range folder "cur")))) (message - (read-string (concat "Message number" - (or (and default - (format " (default %d): " default)) - ": ")) + (read-string (format-prompt "Message number" default) nil nil (if (numberp default) (int-to-string default) @@ -851,7 +848,7 @@ body." (forward-line))))) ;;;###mh-autoload -(defun mh-position-on-field (field &optional ignored) +(defun mh-position-on-field (field &optional _ignored) "Move to the end of the FIELD in the header. Move to end of entire header if FIELD not found. Returns non-nil if FIELD was found. diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el index 036522f3ddd..08f1b4093f1 100644 --- a/lisp/mh-e/mh-limit.el +++ b/lisp/mh-e/mh-limit.el @@ -1,4 +1,4 @@ -;;; mh-limit.el --- MH-E display limits +;;; mh-limit.el --- MH-E display limits -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2003, 2006-2021 Free Software Foundation, Inc. @@ -237,7 +237,7 @@ Return number of messages put in the sequence: (setq list (cons (mh-get-msg-num t) list))) (if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject)) ;; sort the result into a sequence - (let ((sorted-list (sort (copy-sequence list) 'mh-lessp))) + (let ((sorted-list (sort (copy-sequence list) #'mh-lessp))) (while sorted-list (mh-add-msgs-to-seq (car sorted-list) 'subject nil) (setq sorted-list (cdr sorted-list))) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 70df9e6b0f2..8af7bcdf8f4 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1,4 +1,4 @@ -;;; mh-mime.el --- MH-E MIME support +;;; mh-mime.el --- MH-E MIME support -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc. @@ -190,9 +190,9 @@ Set from last use.") ;; XEmacs doesn't care. (set-keymap-parent map mh-show-mode-map)) (mh-do-in-gnu-emacs - (define-key map [mouse-2] 'mh-push-button)) + (define-key map [mouse-2] #'mh-push-button)) (mh-do-in-xemacs - (define-key map '(button2) 'mh-push-button)) + (define-key map '(button2) #'mh-push-button)) (dolist (c mh-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -214,11 +214,11 @@ Set from last use.") (let ((map (make-sparse-keymap))) (unless (>= (string-to-number emacs-version) 21) (set-keymap-parent map mh-show-mode-map)) - (define-key map "\r" 'mh-press-button) + (define-key map "\r" #'mh-press-button) (mh-do-in-gnu-emacs - (define-key map [mouse-2] 'mh-push-button)) + (define-key map [mouse-2] #'mh-push-button)) (mh-do-in-xemacs - (define-key map '(button2) 'mh-push-button)) + (define-key map '(button2) #'mh-push-button)) map)) @@ -259,9 +259,7 @@ usually reads the file \"/etc/mailcap\"." (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) (mailcap-mime-info type 'all))) (def (caar methods)) - (prompt (format "Viewer%s: " (if def - (format " (default %s)" def) - ""))) + (prompt (format-prompt "Viewer" def)) (method (completing-read prompt methods nil nil nil nil def)) (folder mh-show-folder-buffer) (buffer-read-only nil)) @@ -395,9 +393,9 @@ do the work." ((and (or prompt (equal t mh-mime-save-parts-default-directory)) mh-mime-save-parts-directory) - (read-directory-name (format - "Store in directory (default %s): " - mh-mime-save-parts-directory) + (read-directory-name (format-prompt + "Store in directory" + mh-mime-save-parts-directory) "" mh-mime-save-parts-directory t "")) ((stringp mh-mime-save-parts-default-directory) mh-mime-save-parts-default-directory) @@ -413,7 +411,7 @@ do the work." (cd directory) (setq mh-mime-save-parts-directory directory) (let ((initial-size (mh-truncate-log-buffer))) - (apply 'call-process + (apply #'call-process (expand-file-name command mh-progs) nil t nil (mh-list-to-string (list folder msg "-auto" (if (not (mh-variant-p 'nmh)) @@ -452,7 +450,7 @@ decoding the same message multiple times." (let ((b (point)) (clean-message-header mh-clean-message-header-flag) (invisible-headers mh-invisible-header-fields-compiled) - (visible-headers nil)) + ) ;; (visible-headers nil) (save-excursion (save-restriction (narrow-to-region b b) @@ -474,7 +472,7 @@ decoding the same message multiple times." (cond (clean-message-header (mh-clean-msg-header (point-min) invisible-headers - visible-headers) + nil) ;; visible-headers (goto-char (point-min))) (t (mh-start-of-uncleaned-message))) @@ -1225,7 +1223,7 @@ The option `mh-compose-insertion' controls what type of tags are inserted." t) t t))) (list description folder range))) - (let ((messages (mapconcat 'identity (mh-list-to-string range) " "))) + (let ((messages (mapconcat #'identity (mh-list-to-string range) " "))) (dolist (message (mh-translate-range folder messages)) (if (equal mh-compose-insertion 'mml) (mh-mml-forward-message description folder (format "%s" message)) @@ -1258,11 +1256,7 @@ See also \\[mh-mh-to-mime]." (interactive (list (mml-minibuffer-read-description) (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) - (read-string (concat "Messages" - (if (numberp mh-sent-from-msg) - (format " (default %d): " - mh-sent-from-msg) - ": "))))) + (read-string (format-prompt "Messages" mh-sent-from-msg)))) (beginning-of-line) (insert "#forw [") (and description @@ -1596,7 +1590,7 @@ the possible security methods (see `mh-mml-method-default')." (if current-prefix-arg (let ((def (or (car mh-mml-cryptographic-method-history) mh-mml-method-default))) - (completing-read (format "Method (default %s): " def) + (completing-read (format-prompt "Method" def) '(("pgp") ("pgpmime") ("smime")) nil t nil 'mh-mml-cryptographic-method-history def)) mh-mml-method-default)) @@ -1731,7 +1725,7 @@ Optional argument DEFAULT is returned if a type isn't entered." (type (or (and (not (equal probed-type "application/octet-stream")) probed-type) (completing-read - (format "Content type (default %s): " default) + (format-prompt "Content type" default) (mapcar #'list (mailcap-mime-types)))))) (if (not (equal type "")) type diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el index 513a1bc953d..d084cf63e97 100644 --- a/lisp/mh-e/mh-print.el +++ b/lisp/mh-e/mh-print.el @@ -1,4 +1,4 @@ -;;; mh-print.el --- MH-E printing support +;;; mh-print.el --- MH-E printing support -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2021 Free Software Foundation, Inc. @@ -207,8 +207,9 @@ Consider using \\[mh-ps-print-msg] instead." ;; Print scan listing if we have more than one message. (if (> (length msgs) 1) (let* ((msgs-string - (mapconcat 'identity (mh-list-to-string - (mh-coalesce-msg-list msgs)) " ")) + (mapconcat #'identity (mh-list-to-string + (mh-coalesce-msg-list msgs)) + " ")) (lpr-command (format mh-lpr-command-format (cond ((listp range) diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index cec331389b0..f00ab22958a 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -1,4 +1,4 @@ -;;; mh-scan.el --- MH-E scan line constants and utilities +;;; mh-scan.el --- MH-E scan line constants and utilities -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation, ;; Inc. @@ -497,7 +497,7 @@ with `mh-scan-msg-format-string'." (width 0)) (with-current-buffer tmp-buffer (erase-buffer) - (apply 'call-process + (apply #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil (list folder "last" "-format" "%(msg)")) (goto-char (point-min)) diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 05ba12d7617..aece03ef0f3 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1,4 +1,4 @@ -;;; mh-search --- MH-Search mode +;;; mh-search --- MH-Search mode -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc. @@ -332,7 +332,7 @@ configuration and is used when the search folder is dismissed." (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t) (current-window-configuration))) ;; FIXME: `pick-folder' is unused! - (let ((pick-folder (if (equal folder "+") mh-current-folder folder))) + (let () ;; (pick-folder (if (equal folder "+") mh-current-folder folder)) (switch-to-buffer-other-window "search-pattern") (if (or (zerop (buffer-size)) (not (y-or-n-p "Reuse pattern? "))) @@ -356,7 +356,7 @@ configuration and is used when the search folder is dismissed." "---------\n") (mh-search-mode) (goto-char (point-min)) - (dotimes (i 5) + (dotimes (_ 5) (add-text-properties (point) (1+ (point)) '(front-sticky t)) (add-text-properties (- (mh-line-end-position) 2) (1- (mh-line-end-position)) @@ -453,7 +453,7 @@ search all folders." (defvar mh-flists-search-folders) -(defun mh-flists-execute (&rest ignored) +(defun mh-flists-execute (&rest _ignored) "Execute flists. Search for messages belonging to `mh-flists-sequence' in the folders specified by `mh-flists-search-folders'. If @@ -880,7 +880,7 @@ used to search." folder-path (format "%s/" folder-path))))) -(defalias 'mh-swish++-next-result 'mh-swish-next-result) +(defalias 'mh-swish++-next-result #'mh-swish-next-result) (defun mh-swish++-regexp-builder (regexp-list) "Generate query for swish++. @@ -1853,7 +1853,7 @@ PROC is used to convert the value to actual data." (1+ last-slash) (1- last-space))) (buffer-substring-no-properties (1+ last-space) end)))))) -(defalias 'mh-md5-parser 'mh-openssl-parser) +(defalias 'mh-md5-parser #'mh-openssl-parser) ;;;###mh-autoload (defun mh-index-update-maps (folder &optional origin-map) diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index e8a03f6704b..9b9675c78e1 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -1,4 +1,4 @@ -;;; mh-seq.el --- MH-E sequences support +;;; mh-seq.el --- MH-E sequences support -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc. @@ -156,7 +156,7 @@ The list appears in a buffer named \"*MH-E Sequences*\"." (let ((name (mh-seq-name (car seq-list))) (sorted-seq-msgs (mh-coalesce-msg-list - (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))) + (sort (copy-sequence (mh-seq-msgs (car seq-list))) #'<))) name-spec) (insert (setq name-spec (format (format "%%%ss:" max-len) name))) (while sorted-seq-msgs @@ -191,7 +191,7 @@ MESSAGE appears." (cond (dest-folder (format " (to be refiled to %s)" dest-folder)) (deleted-flag (format " (to be deleted)")) (t "")) - (mapconcat 'concat + (mapconcat #'concat (mh-list-to-string (mh-seq-containing-msg message t)) " ")))) @@ -390,10 +390,7 @@ Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply an optional DEFAULT sequence. A reply of `%' defaults to the first sequence containing the current message." - (let* ((input (completing-read (format "%s sequence%s: " prompt - (if default - (format " (default %s)" default) - "")) + (let* ((input (completing-read (format-prompt "%s sequence" default prompt) (mh-seq-names mh-seq-list) nil nil nil 'mh-sequence-history)) (seq (cond ((equal input "%") @@ -494,13 +491,13 @@ folder buffer are not updated." ;; Add to a SEQUENCE each message the list of MSGS. (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq))) (if msgs - (apply 'mh-exec-cmd "mark" mh-current-folder "-add" + (apply #'mh-exec-cmd "mark" mh-current-folder "-add" "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))) (defun mh-canonicalize-sequence (msgs) "Sort MSGS in decreasing order and remove duplicates." - (let* ((sorted-msgs (sort (copy-sequence msgs) '>)) + (let* ((sorted-msgs (sort (copy-sequence msgs) #'>)) (head sorted-msgs)) (while (cdr head) (if (= (car head) (cadr head)) @@ -565,7 +562,7 @@ OP is one of `widen' and `unthread'." (defvar mh-range-seq-names) (defvar mh-range-history ()) (defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map)) -(define-key mh-range-completion-map " " 'self-insert-command) +(define-key mh-range-completion-map " " #'self-insert-command) ;;;###mh-autoload (defun mh-interactive-range (range-prompt &optional default) @@ -646,13 +643,10 @@ should be replaced with: ((stringp default) default) ((symbolp default) (symbol-name default)))) (prompt (cond ((and guess large default) - (format "%s (folder has %s messages, default %s)" - prompt (car counts) default)) - ((and guess large) - (format "%s (folder has %s messages)" - prompt (car counts))) + (format-prompt "%s (folder has %s messages)" + default prompt (car counts))) (default - (format "%s (default %s)" prompt default)))) + (format-prompt prompt default)))) (minibuffer-local-completion-map mh-range-completion-map) (seq-list (if (eq folder mh-current-folder) mh-seq-list @@ -662,7 +656,7 @@ should be replaced with: (mh-seq-names seq-list))) (input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq)) ((and (not ask-flag) (not large)) "all") - (t (completing-read (format "%s: " prompt) + (t (completing-read prompt 'mh-range-completion-function nil nil nil 'mh-range-history default)))) msg-list) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 1d25b147323..cb9819f17c7 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -1,4 +1,4 @@ -;;; mh-show.el --- MH-Show mode +;;; mh-show.el --- MH-Show mode -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation, ;; Inc. @@ -195,7 +195,7 @@ Sets the current buffer to the show buffer." (let ((formfile mh-mhl-format-file) (clean-message-header mh-clean-message-header-flag) (invisible-headers mh-invisible-header-fields-compiled) - (visible-headers nil) + ;; (visible-headers nil) (msg-filename (mh-msg-filename msg-num folder-name)) (show-buffer mh-show-buffer) (mm-inline-media-tests mh-mm-inline-media-tests)) @@ -241,7 +241,7 @@ Sets the current buffer to the show buffer." (cond (clean-message-header (mh-clean-msg-header (point-min) invisible-headers - visible-headers) + nil) ;; visible-headers (goto-char (point-min))) (t (mh-start-of-uncleaned-message))) @@ -862,7 +862,7 @@ See also `mh-folder-mode'. (turn-on-font-lock)) (when mh-decode-mime-flag (mh-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t)) + (add-hook 'kill-buffer-hook #'mh-mime-cleanup nil t)) (mh-do-in-xemacs (easy-menu-add mh-show-sequence-menu) (easy-menu-add mh-show-message-menu) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 7cbd42c8ea2..b2deacf6a74 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -1,4 +1,4 @@ -;;; mh-speed.el --- MH-E speedbar support +;;; mh-speed.el --- MH-E speedbar support -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -100,9 +100,9 @@ ;; Alphabetical. -(defalias 'mh-speed-contract-folder 'mh-speed-toggle) +(defalias 'mh-speed-contract-folder #'mh-speed-toggle) -(defalias 'mh-speed-expand-folder 'mh-speed-toggle) +(defalias 'mh-speed-expand-folder #'mh-speed-toggle) (defun mh-speed-refresh () "Regenerates the list of folders in the speedbar. @@ -202,9 +202,9 @@ created." (mh-speed-flists nil)))) ;;;###mh-autoload -(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) +(defalias 'mh-show-speedbar-buttons #'mh-folder-speedbar-buttons) ;;;###mh-autoload -(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons) +(defalias 'mh-letter-speedbar-buttons #'mh-folder-speedbar-buttons) (defmacro mh-speed-select-attached-frame () "Compatibility macro to handle speedbar versions 0.11a and 0.14beta4." @@ -431,7 +431,7 @@ flists is run only for that one folder." (setq mh-speed-flists-folder nil) (mh-process-kill-without-query mh-speed-flists-process) (set-process-filter mh-speed-flists-process - 'mh-speed-parse-flists-output))))))) + #'mh-speed-parse-flists-output))))))) ;; Copied from mh-make-folder-list-filter... ;; XXX Refactor to use mh-make-folder-list-filer? diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index 365746259af..a7878aaae9b 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -1,4 +1,4 @@ -;;; mh-thread.el --- MH-E threading support +;;; mh-thread.el --- MH-E threading support -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc. diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 7dbddbc891b..40a430b9641 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -1,4 +1,4 @@ -;;; mh-tool-bar.el --- MH-E tool bar support +;;; mh-tool-bar.el --- MH-E tool bar support -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc. @@ -356,7 +356,7 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." '(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults)) "List of buttons to include in MH-Folder tool bar." :group 'mh-tool-bar - :set 'mh-tool-bar-folder-buttons-set + :set #'mh-tool-bar-folder-buttons-set :type '(set ,@(cl-loop for x in folder-buttons for y in folder-docs collect `(const :tag ,y ,x))) @@ -367,7 +367,7 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." '(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults)) "List of buttons to include in MH-Letter tool bar." :group 'mh-tool-bar - :set 'mh-tool-bar-letter-buttons-set + :set #'mh-tool-bar-letter-buttons-set :type '(set ,@(cl-loop for x in letter-buttons for y in letter-docs collect `(const :tag ,y ,x))) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index d7c607df5c3..be66e62a1d7 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -1,4 +1,4 @@ -;;; mh-utils.el --- MH-E general utilities +;;; mh-utils.el --- MH-E general utilities -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation, ;; Inc. @@ -268,7 +268,7 @@ and displayed in a help buffer." (interactive) (let* ((help (or help-messages (cdr (assoc nil (assoc major-mode mh-help-messages))))) - (text (substitute-command-keys (mapconcat 'identity help "")))) + (text (substitute-command-keys (mapconcat #'identity help "")))) (with-electric-help (lambda () (insert text)) @@ -298,7 +298,7 @@ and displayed in a help buffer." This is the inverse of `mh-read-msg-list', which expands ranges. Message lists passed to MH programs should be processed by this function to avoid exceeding system command line argument limits." - (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) + (let ((msgs (sort (copy-sequence messages) #'mh-greaterp)) (range-high nil) (prev -1) (ranges nil)) @@ -669,7 +669,7 @@ three arguments so we bind this variable to t or nil. This variable should never be set.") (defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) -(define-key mh-folder-completion-map " " 'minibuffer-complete) ;Why??? +(define-key mh-folder-completion-map " " #'minibuffer-complete) ;Why??? (defvar mh-speed-flists-inhibit-flag nil) @@ -730,8 +730,7 @@ See Info node `(elisp) Programmed Completion' for details." (t (file-directory-p path)))))))) ;; Shush compiler. -(mh-do-in-xemacs - (defvar completion-root-regexp)) +(defvar completion-root-regexp) ;; Apparently used in XEmacs (defun mh-folder-completing-read (prompt default allow-root-folder-flag) "Read folder name with PROMPT and default result DEFAULT. @@ -758,10 +757,9 @@ function will accept the folder +, which means all folders when used in searching." (if (null default) (setq default "")) - (let* ((default-string (cond (default-string (format " (default %s)" default-string)) - ((equal "" default) "") - (t (format " (default %s)" default)))) - (prompt (format "%s folder%s: " prompt default-string)) + (let* ((default-string (or default-string + (if (equal default "") nil default))) + (prompt (format-prompt "%s folder" default-string prompt)) (mh-current-folder-name mh-current-folder) read-name folder-name) (while (and (setq read-name (mh-folder-completing-read @@ -925,10 +923,10 @@ Handle RFC 822 (or later) continuation lines." (defvar mh-hidden-header-keymap (let ((map (make-sparse-keymap))) (mh-do-in-gnu-emacs - (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button)) + (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button)) (mh-do-in-xemacs (define-key map '(button2) - 'mh-letter-toggle-header-field-display-button)) + #'mh-letter-toggle-header-field-display-button)) map)) ;;;###mh-autoload diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 036575a8e64..0b53829b056 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -1,4 +1,4 @@ -;;; mh-xface.el --- MH-E X-Face and Face header field display +;;; mh-xface.el --- MH-E X-Face and Face header field display -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc. @@ -365,7 +365,7 @@ Replace the ?/ character with a ?! character and append .png. Also replaces special characters with `mh-url-hexify-string' since not all characters, such as :, are valid within Windows filenames. In addition, replaces * with %2a. See URL -`http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'." +`https://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'." (format "%s/%s.png" mh-x-image-cache-directory (mh-replace-regexp-in-string "\\*" "%2a" diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 55825e32fcd..5f594679ca3 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3941,13 +3941,15 @@ it. See `format' for details. If DEFAULT is a list, the first element is used as the default. If not, the element is used as is. -If DEFAULT is nil, no \"default value\" string is included in the -return value." +If DEFAULT is nil or an empty string, no \"default value\" string +is included in the return value." (concat (if (null format-args) prompt (apply #'format prompt format-args)) (and default + (or (not (stringp default)) + (length> default 0)) (format minibuffer-default-prompt-format (if (consp default) (car default) diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 9c7bcdc261a..683abaaa04a 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -4,7 +4,7 @@ ;; Author: Ted Zlatanov ;; Keywords: comm, tls, ssl, encryption -;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/) +;; Originally-By: Simon Josefsson (See https://josefsson.org/emacs-security/) ;; Thanks-To: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index c5488650b99..1d3a5e0f7da 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -67,9 +67,9 @@ considered to be running if the newsticker timer list is not empty." ;; Hard-coding URLs like this is a recipe for propagating obsolete info. (defconst newsticker--raw-url-list-defaults '(("Debian Security Advisories" - "http://www.debian.org/security/dsa.en.rdf") + "https://www.debian.org/security/dsa.en.rdf") ("Debian Security Advisories - Long format" - "http://www.debian.org/security/dsa-long.en.rdf") + "https://www.debian.org/security/dsa-long.en.rdf") ("Emacs Wiki" "https://www.emacswiki.org/emacs?action=rss" nil @@ -77,7 +77,7 @@ considered to be running if the newsticker timer list is not empty." ("LWN (Linux Weekly News)" "https://lwn.net/headlines/rss") ("Quote of the day" - "http://feeds.feedburner.com/quotationspage/qotd" + "https://feeds.feedburner.com/quotationspage/qotd" "07:00" 86400) ("The Register" @@ -1012,7 +1012,7 @@ Argument BUFFER is the buffer of the retrieval process." ;; And another one (20050702)! If description is HTML ;; encoded and starts with a `<', wrap the whole ;; description in a CDATA expression. This happened for - ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote + ;; https://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote (goto-char (point-min)) (while (re-search-forward "\\(" nil t) @@ -1176,7 +1176,7 @@ URL `http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html'" ;; unxml the content or the summary node. Atom ;; allows for integrating (x)html into the atom ;; structure but we need the raw html string. - ;; e.g. http://www.heise.de/open/news/news-atom.xml + ;; e.g. https://www.heise.de/open/news/news-atom.xml ;; http://feeds.feedburner.com/ru_nix_blogs (or (newsticker--unxml (car (xml-node-children diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index 705bff666af..76b1ef37640 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -4,7 +4,7 @@ ;; Author: Ulf Jasper ;; Filename: newst-plainview.el -;; URL: http://www.nongnu.org/newsticker +;; URL: https://www.nongnu.org/newsticker ;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 0ce65a35ead..1d9ee6db86c 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -640,7 +640,7 @@ References: [1]: Sotirov A, Stevens M et al (2008). \"MD5 considered harmful today - Creating a rogue CA certificate\", -`http://www.win.tue.nl/hashclash/rogue-ca/' +`https://www.win.tue.nl/hashclash/rogue-ca/' [2]: Turner S, Chen L (2011). \"Updated Security Considerations for the MD5 Message-Digest and the HMAC-MD5 Algorithms\", `https://tools.ietf.org/html/rfc6151'" diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 9d4dd7d42a5..2931b4f0cc8 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -49,6 +49,7 @@ (defvar recentf-exclude) (defvar tramp-current-connection) (defvar tramp-postfix-host-format) +(defvar tramp-use-ssh-controlmaster-options) ;;; Fontification of `read-file-name': diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7182cd6b1d9..d6fdbb0419f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3686,18 +3686,6 @@ Fall back to normal file name handler if no Tramp handler exists." '(created changed changes-done-hint moved deleted)) ((memq 'attribute-change flags) '(attribute-changed))) sequence `(,command "monitor" ,localname))) - ;; "gvfs-monitor-dir". - ((setq command (tramp-get-remote-gvfs-monitor-dir v)) - (setq filter #'tramp-sh-gvfs-monitor-dir-process-filter - events - (cond - ((and (memq 'change flags) (memq 'attribute-change flags)) - '(created changed changes-done-hint moved deleted - attribute-changed)) - ((memq 'change flags) - '(created changed changes-done-hint moved deleted)) - ((memq 'attribute-change flags) '(attribute-changed))) - sequence `(,command ,localname))) ;; None. (t (tramp-error v 'file-notify-error @@ -3795,56 +3783,6 @@ Fall back to normal file name handler if no Tramp handler exists." (when string (tramp-message proc 10 "Rest string:\n%s" string)) (process-put proc 'rest-string string))) -(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) - "Read output from \"gvfs-monitor-dir\" and add corresponding \ -`file-notify' events." - (let ((events (process-get proc 'events)) - (remote-prefix - (with-current-buffer (process-buffer proc) - (file-remote-p default-directory))) - (rest-string (process-get proc 'rest-string))) - (when rest-string - (tramp-message proc 10 "Previous string:\n%s" rest-string)) - (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Attribute change is returned in unused wording. - string (tramp-compat-string-replace - "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) - - (while (string-match - (concat "^[\n\r]*" - "Directory Monitor Event:[\n\r]+" - "Child = \\([^\n\r]+\\)[\n\r]+" - "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" - "Event = \\([^[:blank:]]+\\)[\n\r]+") - string) - (let* ((file (match-string 1 string)) - (file1 (match-string 3 string)) - (object - (list - proc - (list - (intern-soft - (tramp-compat-string-replace - "_" "-" (downcase (match-string 4 string))))) - ;; File names are returned as absolute paths. We must - ;; add the remote prefix. - (concat remote-prefix file) - (when file1 (concat remote-prefix file1))))) - (setq string (replace-match "" nil nil string)) - ;; Usually, we would add an Emacs event now. Unfortunately, - ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the handler directly. - (when (member (cl-caadr object) events) - (tramp-compat-funcall - (lookup-key special-event-map [file-notify]) - `(file-notify ,object file-notify-callback))))) - - ;; Save rest of the string. - (when (zerop (length string)) (setq string nil)) - (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (process-put proc 'rest-string string))) - (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding `file-notify' events." (let ((events (process-get proc 'events))) @@ -5658,7 +5596,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." ;; linked libraries of libgio. (when (tramp-send-command-and-check vec (concat "ldd " gio)) (goto-char (point-min)) - (when (re-search-forward "\\S-+/libgio\\S-+") + (when (re-search-forward "\\S-+/\\(libgio\\|cyggio\\)\\S-+") (when (tramp-send-command-and-check vec (concat "strings " (match-string 0))) (goto-char (point-min)) @@ -5666,23 +5604,12 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." (format "^%s$" (regexp-opt - '("GFamFileMonitor" "GFenFileMonitor" - "GInotifyFileMonitor" "GKqueueFileMonitor"))) + '("GFamFileMonitor" "GFamDirectoryMonitor" "GFenFileMonitor" + "GInotifyFileMonitor" "GKqueueFileMonitor" + "GPollFileMonitor"))) nil 'noerror) (intern (match-string 0))))))))) -(defun tramp-get-remote-gvfs-monitor-dir (vec) - "Determine remote `gvfs-monitor-dir' command." - (with-tramp-connection-property vec "gvfs-monitor-dir" - (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command") - ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to - ;; establish better timeouts in filenotify-tests.el. Any better - ;; distinction approach would be welcome! - (or (tramp-find-executable - vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t) - (tramp-find-executable - vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t)))) - (defun tramp-get-remote-inotifywait (vec) "Determine remote `inotifywait' command." (with-tramp-connection-property vec "inotifywait" diff --git a/lisp/notifications.el b/lisp/notifications.el index 2241afa9050..b439d822317 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -1,4 +1,4 @@ -;;; notifications.el --- Client interface to desktop notifications. +;;; notifications.el --- Client interface to desktop notifications. -*- lexical-binding: t -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -229,56 +229,69 @@ of another `notifications-notify' call." id) ;; Build hints array (when urgency - (add-to-list 'hints `(:dict-entry - "urgency" - (:variant :byte ,(pcase urgency - ('low 0) - ('critical 2) - (_ 1)))) t)) + (push `(:dict-entry + "urgency" + (:variant :byte ,(pcase urgency + ('low 0) + ('critical 2) + (_ 1)))) + hints)) (when category - (add-to-list 'hints `(:dict-entry - "category" - (:variant :string ,category)) t)) + (push `(:dict-entry + "category" + (:variant :string ,category)) + hints)) (when desktop-entry - (add-to-list 'hints `(:dict-entry - "desktop-entry" - (:variant :string ,desktop-entry)) t)) + (push `(:dict-entry + "desktop-entry" + (:variant :string ,desktop-entry)) + hints)) (when image-data - (add-to-list 'hints `(:dict-entry - "image-data" - (:variant :struct ,image-data)) t)) + (push `(:dict-entry + "image-data" + (:variant :struct ,image-data)) + hints)) (when image-path - (add-to-list 'hints `(:dict-entry - "image-path" - (:variant :string ,image-path)) t)) + (push `(:dict-entry + "image-path" + (:variant :string ,image-path)) + hints)) (when action-items - (add-to-list 'hints `(:dict-entry - "action-items" - (:variant :boolean ,action-items)) t)) + (push `(:dict-entry + "action-items" + (:variant :boolean ,action-items)) + hints)) (when sound-file - (add-to-list 'hints `(:dict-entry - "sound-file" - (:variant :string ,sound-file)) t)) + (push `(:dict-entry + "sound-file" + (:variant :string ,sound-file)) + hints)) (when sound-name - (add-to-list 'hints `(:dict-entry - "sound-name" - (:variant :string ,sound-name)) t)) + (push `(:dict-entry + "sound-name" + (:variant :string ,sound-name)) + hints)) (when suppress-sound - (add-to-list 'hints `(:dict-entry - "suppress-sound" - (:variant :boolean ,suppress-sound)) t)) + (push `(:dict-entry + "suppress-sound" + (:variant :boolean ,suppress-sound)) + hints)) (when resident - (add-to-list 'hints `(:dict-entry - "resident" - (:variant :boolean ,resident)) t)) + (push `(:dict-entry + "resident" + (:variant :boolean ,resident)) + hints)) (when transient - (add-to-list 'hints `(:dict-entry - "transient" - (:variant :boolean ,transient)) t)) + (push `(:dict-entry + "transient" + (:variant :boolean ,transient)) + hints)) (when x - (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t)) + (push `(:dict-entry "x" (:variant :int32 ,x)) hints)) (when y - (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t)) + (push `(:dict-entry "y" (:variant :int32 ,y)) hints)) + + (setq hints (nreverse hints)) ;; Call Notify method. (setq id @@ -313,8 +326,8 @@ of another `notifications-notify' call." (on-close (plist-get params :on-close)) (unique-name (dbus-get-name-owner bus notifications-service))) (when on-action - (add-to-list 'notifications-on-action-map - (list (list bus unique-name id) on-action)) + (push (list (list bus unique-name id) on-action) + notifications-on-action-map) (unless notifications-on-action-object (setq notifications-on-action-object (dbus-register-signal @@ -326,8 +339,8 @@ of another `notifications-notify' call." 'notifications-on-action-signal)))) (when on-close - (add-to-list 'notifications-on-close-map - (list (list bus unique-name id) on-close)) + (push (list (list bus unique-name id) on-close) + notifications-on-close-map) (unless notifications-on-close-object (setq notifications-on-close-object (dbus-register-signal diff --git a/lisp/novice.el b/lisp/novice.el index 22eca21784c..16766c253c5 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -1,4 +1,4 @@ -;;; novice.el --- handling of disabled commands ("novice mode") for Emacs +;;; novice.el --- handling of disabled commands ("novice mode") for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1994, 2001-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index 45a69a73f35..3d4b9f87414 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el @@ -26,7 +26,7 @@ ;; specified in rng-pttrn.el. ;; ;; RELAX NG Compact Syntax is specified by -;; http://relaxng.org/compact.html +;; https://relaxng.org/compact.html ;; ;; This file uses the prefix "rng-c-". diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el index 81314b85ca9..9941aba6eb1 100644 --- a/lisp/nxml/rng-xsd.el +++ b/lisp/nxml/rng-xsd.el @@ -24,14 +24,14 @@ ;; The main entry point is `rng-xsd-compile'. The validator ;; knows to use this for the datatype library with URI -;; http://www.w3.org/2001/XMLSchema-datatypes because it +;; https://www.w3.org/2001/XMLSchema-datatypes because it ;; is the value of the rng-dt-compile property on that URI ;; as a symbol. ;; ;; W3C XML Schema Datatypes are specified by -;; http://www.w3.org/TR/xmlschema-2/ +;; https://www.w3.org/TR/xmlschema-2/ ;; Guidelines for using them with RELAX NG are described in -;; http://relaxng.org/xsd.html +;; https://relaxng.org/xsd.html ;;; Code: diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el index 4aa6cd200e7..1c3581f7d05 100644 --- a/lisp/obsolete/bruce.el +++ b/lisp/obsolete/bruce.el @@ -30,7 +30,7 @@ ;; Decency Act of 1996. This Act bans "indecent speech", whatever that is, ;; from the Internet. For more on the CDA, see Richard Stallman's essay on ;; censorship, included in the etc directory of emacs distributions 19.34 -;; and up. See also http://www.eff.org/blueribbon.html. +;; and up. See also https://www.eff.org/blueribbon.html. ;; For many years, emacs has included a program called Spook. This program ;; adds a series of "keywords" to email just before it goes out. On the diff --git a/lisp/obsolete/inversion.el b/lisp/obsolete/inversion.el index e61b36cd88b..ac7749af5e8 100644 --- a/lisp/obsolete/inversion.el +++ b/lisp/obsolete/inversion.el @@ -454,7 +454,7 @@ If it is a URL, wget will be used for download. Optional argument VERSION will restrict the list of available versions to the file matching VERSION exactly, or nil." ;;DIRECTORY should also allow a URL: -;; \"http://ftp1.sourceforge.net/PACKAGE\" +;; \"https://ftp1.sourceforge.net/PACKAGE\" ;; but then I can get file listings easily. (if (symbolp package) (setq package (symbol-name package))) (directory-files directory t diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el index fef76ba327d..f2ea5c67ceb 100644 --- a/lisp/obsolete/nnir.el +++ b/lisp/obsolete/nnir.el @@ -274,7 +274,7 @@ that it is for swish++, not Namazu." :type '(regexp)) ;; Swish-E. -;; URL: http://swish-e.org/ +;; URL: http://swish-e.org/ [dead link?] ;; Variables `nnir-swish-e-index-files', `nnir-swish-e-program' and ;; `nnir-swish-e-additional-switches' @@ -311,7 +311,7 @@ that it is for swish-e, not Namazu. This could be a server parameter." :type '(regexp)) -;; HyREX engine, see +;; HyREX engine, see [dead link?] (defcustom nnir-hyrex-program "nnir-search" "Name of the nnir-search executable." diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el index d28c4a172fd..dbfc79bf913 100644 --- a/lisp/obsolete/terminal.el +++ b/lisp/obsolete/terminal.el @@ -32,7 +32,7 @@ ;; For information on US government censorship of the Internet, and ;; what you can do to bring back freedom of the press, see the web -;; site http://www.vtw.org/ +;; site https://www.eff.org/ [used to be vtw.org but that link is dead] ;;; Code: diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 00e7d26cd75..cfbf981d3c8 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -26,7 +26,7 @@ ;; The home page of the Arch version control system is at ;; -;; http://www.gnuarch.org/ +;; https://www.gnu.org/software/gnu-arch/ ;; ;; This is derived from vc-mcvs.el as follows: ;; - cp vc-mcvs.el vc-arch.el and then M-% mcvs RET arch RET diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index df2d691f68b..9834509fb03 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -38,7 +38,7 @@ ;; For SLIME, the best way to install these components is by following ;; the directions as set out by Phil Hagelberg (Technomancy) on the -;; web page: http://technomancy.us/126 +;; web page: https://technomancy.us/126 ;;; Code: (require 'ob) diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 0aa91afdb24..5fd6d1e09ff 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -32,7 +32,7 @@ ;;; Requirements: -;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/ +;; - tuareg-mode :: https://www-rocq.inria.fr/~acohen/tuareg/ ;;; Code: (require 'ob) diff --git a/lisp/org/org-install.el b/lisp/org/org-install.el index 58359597363..d521d819db2 100644 --- a/lisp/org/org-install.el +++ b/lisp/org/org-install.el @@ -1,4 +1,4 @@ -;;; org-install.el --- backward compatibility file for obsolete configuration +;;; org-install.el --- backward compatibility file for obsolete configuration -*- lexical-binding: t -*- ;; ;;; Code: ;; diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 25b3354bdd7..8871ef798d5 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -1,4 +1,4 @@ -;;; org-version.el --- autogenerated file, do not edit +;;; org-version.el --- autogenerated file, do not edit -*- lexical-binding: t -*- ;; ;;; Code: ;;;###autoload diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 263d646dc6e..39d4add2be1 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -31,11 +31,6 @@ (require 'pcomplete) -;; Unused. -;;; (defgroup pcmpl-linux nil -;;; "Functions for dealing with GNU/Linux completions." -;;; :group 'pcomplete) - ;; Functions: ;;;###autoload diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 084f0e66bc8..fd147101b69 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -27,7 +27,7 @@ (require 'pcomplete) -;;;; tlmgr - http://www.tug.org/texlive/tlmgr.html +;;;; tlmgr - https://www.tug.org/texlive/tlmgr.html (defcustom pcmpl-x-tlmgr-program "tlmgr" "Name of the tlmgr program." diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 46fd852b4c5..bf923f4f2e5 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -1583,7 +1583,7 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." E-mail: jo@samaritans.org or\, at your option\, anonymous E-mail: samaritans@anon.twwells.com\ \. or find a Befrienders crisis center at - http://www.befrienders.org/\ \. + https://www.befrienders.org/\ \. (doc$ doctor--please) (doc$ doctor--continue) \.))) (t (doctor-type (doc$ doctor--deathlst))))) diff --git a/lisp/play/morse.el b/lisp/play/morse.el index 8e09c225059..91dc687d195 100644 --- a/lisp/play/morse.el +++ b/lisp/play/morse.el @@ -146,7 +146,7 @@ "NATO phonetic alphabet. See “International Code of Signals” (INTERCO), United States Edition, 1969 Edition (Revised 2003) available from National -Geospatial-Intelligence Agency at URL `http://www.nga.mil/'") +Geospatial-Intelligence Agency at URL `https://www.nga.mil/'") ;;;###autoload (defun morse-region (beg end) diff --git a/lisp/printing.el b/lisp/printing.el index f6b9494e177..b9a2e33994a 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -103,14 +103,14 @@ Please send all bug fixes and enhancements to ;; For example, after previewing a PostScript file, *Printing Command Output* ;; will have the following entry: ;; -;; /usr/X11R6/bin/gv ("/home/user/example/file.ps") +;; /usr/bin/gv ("/home/user/example/file.ps") ;; Exit status: 0 ;; ;; In the example above, the previewing was successful. If during previewing, ;; you quit gv execution (by typing C-g during Emacs session), the log entry ;; would be: ;; -;; /usr/X11R6/bin/gv ("/home/user/example/file.ps") +;; /usr/bin/gv ("/home/user/example/file.ps") ;; Exit status: Quit ;; ;; So, if something goes wrong, a good place to take a look is the buffer @@ -264,7 +264,7 @@ Please send all bug fixes and enhancements to ;; Also the gsprint utility comes together with gsview distribution. ;; ;; For more information about gsprint see -;; `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. +;; `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. ;; ;; As an example of gsprint declaration: ;; @@ -950,18 +950,18 @@ Please send all bug fixes and enhancements to ;; * For GNU or Unix system: ;; ;; gs, gv `https://www.gnu.org/software/ghostscript/ghostscript.html' -;; enscript `http://people.ssh.fi/mtr/genscript/' +;; enscript `https://people.ssh.fi/mtr/genscript/' ;; psnup `http://www.knackered.org/angus/psutils/' -;; mpage `http://www.mesa.nl/pub/mpage/' +;; mpage `https://www.mesa.nl/pub/mpage/' ;; ;; * For Windows system: ;; ;; gswin32, gsview32 ;; `https://www.gnu.org/software/ghostscript/ghostscript.html' -;; gsprint `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. -;; enscript `http://people.ssh.fi/mtr/genscript/' +;; gsprint `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. +;; enscript `https://people.ssh.fi/mtr/genscript/' ;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm' -;; redmon `http://www.cs.wisc.edu/~ghost/redmon/' +;; redmon `http://www.ghostgum.com.au/software/redmon.htm' ;; ;; ;; Acknowledgments @@ -1520,22 +1520,19 @@ Examples: Useful links: * Information about the print command (print.exe) - `http://www.computerhope.com/printhlp.htm' + `https://www.computerhope.com/printhlp.htm' * RedMon - Redirection Port Monitor (redpr.exe) - `http://www.cs.wisc.edu/~ghost/redmon/index.htm' + `http://www.ghostgum.com.au/software/redmon.htm' * Redirection Port Monitor (redpr.exe on-line help) - `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm' + `https://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm' * UNIX man pages: lpr (or type `man lpr') - `http://bama.ua.edu/cgi-bin/man-cgi?lpr' - `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr' + `https://linux.die.net/man/1/lpr-cups' * UNIX man pages: lp (or type `man lp') - `http://bama.ua.edu/cgi-bin/man-cgi?lp' - `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp' -" + `https://linux.die.net/man/1/lp'" :type '(repeat (list :tag "Text Printer" (symbol :tag "Printer Symbol Name") @@ -1760,30 +1757,28 @@ are not printed. Useful links: * GSPRINT - Ghostscript print to Windows printer - `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm' + `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm' * Introduction to Ghostscript - `http://www.cs.wisc.edu/~ghost/doc/intro.htm' + `https://www.cs.wisc.edu/~ghost/doc/intro.htm' * How to use Ghostscript - `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' + `https://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' * Information about the print command (print.exe) - `http://www.computerhope.com/printhlp.htm' + `https://www.computerhope.com/printhlp.htm' * RedMon - Redirection Port Monitor (redpr.exe) - `http://www.cs.wisc.edu/~ghost/redmon/index.htm' + `http://www.ghostgum.com.au/software/redmon.htm' * Redirection Port Monitor (redpr.exe on-line help) - `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm' + `https://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm' * UNIX man pages: lpr (or type `man lpr') - `http://bama.ua.edu/cgi-bin/man-cgi?lpr' - `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr' + `https://linux.die.net/man/1/lpr-cups' * UNIX man pages: lp (or type `man lp') - `http://bama.ua.edu/cgi-bin/man-cgi?lp' - `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp' + `https://linux.die.net/man/1/lp' * GNU utilities for w32 (cp.exe) `http://unxutils.sourceforge.net/' @@ -1873,28 +1868,28 @@ Useful links: `https://www.gnu.org/software/gv/manual/gv.html' * GSview Help - `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm' + `https://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm' * GSview Help - Common Problems - `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm#Common_Problems' + `https://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm#Common_Problems' * GSview Readme (compilation & installation) - `http://www.cs.wisc.edu/~ghost/gsview/Readme.htm' + `https://www.cs.wisc.edu/~ghost/gsview/Readme.htm' * GSview (main site) - `http://www.cs.wisc.edu/~ghost/gsview/index.htm' + `https://www.cs.wisc.edu/~ghost/gsview/index.htm' * Ghostscript, Ghostview and GSview - `http://www.cs.wisc.edu/~ghost/' + `https://www.cs.wisc.edu/~ghost/' * Ghostview - `http://www.cs.wisc.edu/~ghost/gv/index.htm' + `https://www.cs.wisc.edu/~ghost/gv/index.htm' * gv 3.5, June 1997 - `http://www.cs.wisc.edu/~ghost/gv/gv_doc/gv.html' + `http://pages.cs.wisc.edu/~ghost/gv/gv_doc/gv.html' * MacGSView (Mac OS) - `http://www.cs.wisc.edu/~ghost/macos/index.htm' + `http://pages.cs.wisc.edu/~ghost/macos/index.htm' " :type '(string :tag "Ghostview Utility")) @@ -1910,16 +1905,16 @@ See also `pr-path-alist'. Useful links: * Ghostscript, Ghostview and GSview - `http://www.cs.wisc.edu/~ghost/' + `https://www.cs.wisc.edu/~ghost/' * Introduction to Ghostscript - `http://www.cs.wisc.edu/~ghost/doc/intro.htm' + `https://www.cs.wisc.edu/~ghost/doc/intro.htm' * How to use Ghostscript - `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' + `https://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' * Printer compatibility - `http://www.cs.wisc.edu/~ghost/doc/printer.htm' + `https://www.cs.wisc.edu/~ghost/doc/printer.htm' " :type '(string :tag "Ghostscript Utility")) @@ -1954,13 +1949,13 @@ To see ghostscript documentation for more information: Useful links: * Introduction to Ghostscript - `http://www.cs.wisc.edu/~ghost/doc/intro.htm' + `https://www.cs.wisc.edu/~ghost/doc/intro.htm' * How to use Ghostscript - `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' + `https://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' * Printer compatibility - `http://www.cs.wisc.edu/~ghost/doc/printer.htm' + `https://www.cs.wisc.edu/~ghost/doc/printer.htm' " :type '(repeat (string :tag "Ghostscript Switch"))) @@ -2407,11 +2402,10 @@ Examples: Useful links: * mpage download (GNU or Unix) - `http://www.mesa.nl/pub/mpage/' + `https://www.mesa.nl/pub/mpage/' * mpage documentation (GNU or Unix - or type `man mpage') - `http://www.cs.umd.edu/faq/guides/manual_unix/node48.html' - `http://www.rt.com/man/mpage.1.html' + `https://linux.die.net/man/1/mpage' * psnup (Windows, GNU or Unix) `http://www.knackered.org/angus/psutils/' @@ -2421,14 +2415,13 @@ Useful links: `http://gnuwin32.sourceforge.net/packages/psutils.htm' * psnup documentation (GNU or Unix - or type `man psnup') - `http://linux.about.com/library/cmd/blcmdl1_psnup.htm' - `http://amath.colorado.edu/computing/software/man/psnup.html' + `https://linux.die.net/man/1/psnup' * GNU Enscript (Windows, GNU or Unix) - `http://people.ssh.com/mtr/genscript/' + `https://people.ssh.com/mtr/genscript/' * GNU Enscript documentation (Windows, GNU or Unix) - `http://people.ssh.com/mtr/genscript/enscript.man.html' + `https://people.ssh.com/mtr/genscript/enscript.man.html' (on GNU or Unix, type `man enscript') " :type '(repeat diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 8a1d441773a..2a4b3482831 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -33,7 +33,7 @@ ;; the manual style, follow all commands mentioned in the documentation of ;; `antlr-mode'. ANTLR is a LL(k)-based recognition tool which generates ;; lexers, parsers and tree transformers in Java, C++ or Sather and can be -;; found at . +;; found at . ;; Bug fixes, bug reports, improvements, and suggestions for the newest version ;; are strongly appreciated. diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index 9e570b6c03f..2a37110f6ae 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -1,4 +1,4 @@ -;;; ebnf-abn.el --- parser for ABNF (Augmented BNF) +;;; ebnf-abn.el --- parser for ABNF (Augmented BNF) -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -39,10 +39,6 @@ ;; ;; See the URL: ;; `https://www.ietf.org/rfc/rfc2234.txt' -;; or -;; `http://www.faqs.org/rfcs/rfc2234.html' -;; or -;; `http://www.rnp.br/ietf/rfc/rfc2234.txt' ;; ("Augmented BNF for Syntax Specifications: ABNF"). ;; ;; diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index 93ebfe8654d..e6717cbdf01 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -1,4 +1,4 @@ -;;; ebnf-bnf.el --- parser for EBNF +;;; ebnf-bnf.el --- parser for EBNF -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 66e5dd095ea..93bae5a33c5 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -1,4 +1,4 @@ -;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML) +;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML) -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 389049e39a9..5d8541931e1 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -1,4 +1,4 @@ -;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX) +;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX) -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index d25ff3ecb4b..b4532c76251 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -1,4 +1,4 @@ -;;; ebnf-iso.el --- parser for ISO EBNF +;;; ebnf-iso.el --- parser for ISO EBNF -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -38,7 +38,7 @@ ;; --------------- ;; ;; See the URL: -;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' +;; `https://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' ;; ("International Standard of the ISO EBNF Notation"). ;; ;; diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index b724d75a7e5..84e59cc0a51 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -1,4 +1,4 @@ -;;; ebnf-otz.el --- syntactic chart OpTimiZer +;;; ebnf-otz.el --- syntactic chart OpTimiZer -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 2765d03acba..5abf1debb15 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -1,4 +1,4 @@ -;;; ebnf-yac.el --- parser for Yacc/Bison +;;; ebnf-yac.el --- parser for Yacc/Bison -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index b376423c185..7092d2c1d1f 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -330,7 +330,7 @@ Please send all bug fixes and enhancements to ;; ("Augmented BNF for Syntax Specifications: ABNF"). ;; ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: -;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' +;; `https://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' ;; ("International Standard of the ISO EBNF Notation"). ;; The following variables *ONLY* have effect with this ;; setting: @@ -1783,7 +1783,7 @@ Valid values are: (\"Augmented BNF for Syntax Specifications: ABNF\"). `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: - `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' + `https://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' (\"International Standard of the ISO EBNF Notation\"). The following variables *ONLY* have effect with this setting: @@ -2920,7 +2920,7 @@ See `ebnf-style-database' documentation." value (and (car value) (ebnf-apply-style1 (car value))) (while (setq value (cdr value)) - (set (caar value) (eval (cdar value))))))) + (set (caar value) (eval (cdar value) t)))))) (defun ebnf-check-style-values (values) @@ -5487,7 +5487,7 @@ killed after process termination." (ebnf-shape-value ebnf-chart-shape ebnf-terminal-shape-alist)) (format "/UserArrow{%s}def\n" - (let ((arrow (eval ebnf-user-arrow))) + (let ((arrow (eval ebnf-user-arrow t))) (if (stringp arrow) arrow ""))) @@ -6290,7 +6290,7 @@ killed after process termination." (defun ebnf-log-header (format-str &rest args) (when ebnf-log (apply - 'ebnf-log + #'ebnf-log (concat "\n\n===============================================================\n\n" format-str) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 023c90cca5b..13717b1b894 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -836,11 +836,7 @@ If no tags table is loaded, do nothing and return nil." "Read a tag name, with defaulting and completion." (let* ((completion-ignore-case (find-tag--completion-ignore-case)) (default (find-tag--default)) - (spec (completing-read (if default - (format "%s (default %s): " - (substring string 0 (string-match "[ :]+\\'" string)) - default) - string) + (spec (completing-read (format-prompt string default) (tags-lazy-completion-table) nil nil nil nil default))) (if (equal spec "") @@ -899,7 +895,7 @@ onto a ring and may be popped back to with \\[pop-tag-mark]. Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." - (interactive (find-tag-interactive "Find tag: ")) + (interactive (find-tag-interactive "Find tag")) (setq find-tag-history (cons tagname find-tag-history)) ;; Save the current buffer's value of `find-tag-hook' before @@ -971,7 +967,7 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." (declare (obsolete xref-find-definitions "25.1")) - (interactive (find-tag-interactive "Find tag: ")) + (interactive (find-tag-interactive "Find tag")) (let* ((buf (find-tag-noselect tagname next-p regexp-p)) (pos (with-current-buffer buf (point)))) (condition-case nil @@ -1000,7 +996,7 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." (declare (obsolete xref-find-definitions-other-window "25.1")) - (interactive (find-tag-interactive "Find tag other window: ")) + (interactive (find-tag-interactive "Find tag other window")) ;; This hair is to deal with the case where the tag is found in the ;; selected window's buffer; without the hair, point is moved in both @@ -1041,7 +1037,7 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." (declare (obsolete xref-find-definitions-other-frame "25.1")) - (interactive (find-tag-interactive "Find tag other frame: ")) + (interactive (find-tag-interactive "Find tag other frame")) (let ((pop-up-frames t)) (with-suppressed-warnings ((obsolete find-tag-other-window)) (find-tag-other-window tagname next-p)))) @@ -1065,7 +1061,7 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." (declare (obsolete xref-find-apropos "25.1")) - (interactive (find-tag-interactive "Find tag regexp: " t)) + (interactive (find-tag-interactive "Find tag regexp" t)) ;; We go through find-tag-other-window to do all the display hair there. (funcall (if other-window 'find-tag-other-window 'find-tag) regexp next-p t)) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 923f85fd4dd..6f1a8781b49 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1743,10 +1743,10 @@ first arg will be `hif-etc'." (defun hide-ifdef-guts () "Does most of the work of `hide-ifdefs'. It does not do the work that's pointless to redo on a recursive entry." - ;; (message "hide-ifdef-guts") (save-excursion (let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp' (expand-header (and hide-ifdef-expand-reinclusion-protection + (buffer-file-name) (string-match hide-ifdef-header-regexp (buffer-file-name)) (zerop hif-recurse-level))) diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index 25bc5ad881b..6d2d402e358 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -1,4 +1,4 @@ -;;; idlw-complete-structtag.el --- Completion of structure tags. +;;; idlw-complete-structtag.el --- Completion of structure tags. -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -100,12 +100,11 @@ (defvar idlwave-sint-structtags nil) ;; Create the sintern type for structure talks -(declare-function idlwave-sintern-structtag "idlw-complete-structtag" t t) -(idlwave-new-sintern-type 'structtag) +(idlwave-new-sintern-type structtag) ;; Hook the plugin into idlwave -(add-to-list 'idlwave-complete-special 'idlwave-complete-structure-tag) -(add-hook 'idlwave-update-rinfo-hook 'idlwave-structtag-reset) +(add-hook 'idlwave-complete-functions #'idlwave-complete-structure-tag) +(add-hook 'idlwave-update-rinfo-hook #'idlwave-structtag-reset) ;;; The main code follows below (defvar idlwave-completion-help-info) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 2e7b0aa7ef1..db76df96a56 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -1,4 +1,4 @@ -;;; idlw-help.el --- HTML Help code for IDLWAVE +;;; idlw-help.el --- HTML Help code for IDLWAVE -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; @@ -50,7 +50,6 @@ (defcustom idlwave-html-help-pre-v6 nil "Whether pre or post-v6.0 IDL help documents are being used." - :group 'idlwave-online-help :type 'boolean) (defvar idlwave-html-link-sep @@ -60,7 +59,6 @@ "The directory, relative to `idlwave-system-directory', where the IDL HTML help files live, for IDL 6.2 and later. This location, if found, is used in preference to the old `idlwave-html-help-location'." - :group 'idlwave-online-help :type 'directory) (defcustom idlwave-html-help-location @@ -69,7 +67,6 @@ is used in preference to the old `idlwave-html-help-location'." "/usr/local/etc/") "The directory where the idl_html_help/ dir lives. Obsolete for IDL 6.2 or later (see `idlwave-html-system-help-location')." - :group 'idlwave-online-help :type 'directory) (defvar idlwave-help-use-hh nil @@ -77,18 +74,15 @@ is used in preference to the old `idlwave-html-help-location'." (defcustom idlwave-help-use-assistant t "Whether to use the IDL Assistant as the help browser." - :group 'idlwave-online-help :type 'boolean) (defcustom idlwave-help-browser-function browse-url-browser-function "Function to use to display HTML help. Defaults to `browse-url-browser-function', which see." - :group 'idlwave-online-help :type 'function) (defcustom idlwave-help-browser-generic-program browse-url-generic-program "Program to run if using `browse-url-generic-program'." - :group 'idlwave-online-help :type '(choice (const nil) string)) ;; AFAICS, never used since it was introduced in 2004. @@ -96,7 +90,6 @@ Defaults to `browse-url-browser-function', which see." (if (boundp 'browse-url-generic-args) browse-url-generic-args "") "Program args to use if using `browse-url-generic-program'." - :group 'idlwave-online-help :type '(repeat string)) (defcustom idlwave-help-browser-is-local nil @@ -106,7 +99,6 @@ external programs. If the browser name contains \"-w3\", it is assumed to be local to Emacs. For other local browsers, this variable must be explicitly set non-nil in order for the variable `idlwave-help-use-dedicated-frame' to function." - :group 'idlwave-online-help :type 'boolean) (defvar idlwave-help-directory "" @@ -114,7 +106,6 @@ must be explicitly set non-nil in order for the variable (defcustom idlwave-help-use-dedicated-frame t "Non-nil means, use a separate frame for Online Help if possible." - :group 'idlwave-online-help :type 'boolean) (defcustom idlwave-help-frame-parameters @@ -123,14 +114,12 @@ must be explicitly set non-nil in order for the variable See also `idlwave-help-use-dedicated-frame'. If you do not set the frame width here, the value specified in `idlw-help.el' will be used." - :group 'idlwave-online-help :type '(repeat (cons symbol sexp))) (defcustom idlwave-max-popup-menu-items 20 "Maximum number of items per pane in popup menus. Currently only used for class selection during completion help." - :group 'idlwave-online-help :type 'integer) (defcustom idlwave-extra-help-function 'idlwave-help-with-source @@ -158,12 +147,10 @@ The default value for this function is `idlwave-help-with-source' which loads the routine source file into the help buffer. If you try to write a different function which accesses a special help file or so, it is probably a good idea to still call this function as a fallback." - :group 'idlwave-online-help :type 'symbol) (defcustom idlwave-help-fontify-source-code nil "Non-nil means, fontify source code displayed as help like normal code." - :group 'idlwave-online-help :type 'boolean) (defcustom idlwave-help-source-try-header t @@ -173,7 +160,6 @@ help text. When this variable is non-nil, we try to find a description of the help item in the first routine doclib header above the routine definition. If the variable is nil, or if we cannot find/parse the header, the routine definition is displayed instead." - :group 'idlwave-online-help :type 'boolean) @@ -181,20 +167,17 @@ definition is displayed instead." "A regexp for the heading word to search for in doclib headers which specifies the `name' section. Can be used for localization support." - :group 'idlwave-online-help :type 'regexp) (defcustom idlwave-help-doclib-keyword "KEYWORD" "A regexp for the heading word to search for in doclib headers which specifies the `keywords' section. Can be used for localization support." - :group 'idlwave-online-help :type 'regexp) (defface idlwave-help-link '((t :inherit link)) - "Face for highlighting links into IDLWAVE online help." - :group 'idlwave-online-help) + "Face for highlighting links into IDLWAVE online help.") (defvar idlwave-help-activate-links-aggressively nil "Obsolete variable.") @@ -219,20 +202,20 @@ support." (defvar idlwave-help-mode-map (let ((map (make-sparse-keymap))) - (define-key map "q" 'idlwave-help-quit) - (define-key map "w" 'widen) + (define-key map "q" #'idlwave-help-quit) + (define-key map "w" #'widen) (define-key map "\C-m" (lambda (arg) (interactive "p") (scroll-up arg))) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map [delete] 'scroll-down-command) - (define-key map "h" 'idlwave-help-find-header) - (define-key map "H" 'idlwave-help-find-first-header) - (define-key map "." 'idlwave-help-toggle-header-match-and-def) - (define-key map "F" 'idlwave-help-fontify) - (define-key map "\M-?" 'idlwave-help-return-to-calling-frame) - (define-key map "x" 'idlwave-help-return-to-calling-frame) + (define-key map " " #'scroll-up-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map [delete] #'scroll-down-command) + (define-key map "h" #'idlwave-help-find-header) + (define-key map "H" #'idlwave-help-find-first-header) + (define-key map "." #'idlwave-help-toggle-header-match-and-def) + (define-key map "F" #'idlwave-help-fontify) + (define-key map "\M-?" #'idlwave-help-return-to-calling-frame) + (define-key map "x" #'idlwave-help-return-to-calling-frame) map) "The keymap used in `idlwave-help-mode'.") @@ -374,7 +357,7 @@ It collects and prints the diagnostics messages." (setq idlwave-last-context-help-pos marker) (idlwave-do-context-help1 arg) (if idlwave-help-diagnostics - (message "%s" (mapconcat 'identity + (message "%s" (mapconcat #'identity (nreverse idlwave-help-diagnostics) "; ")))))) @@ -384,6 +367,12 @@ It collects and prints the diagnostics messages." (defvar idlwave-system-variables-alist) (defvar idlwave-executive-commands-alist) (defvar idlwave-system-class-info) +(defvar idlwave-query-class) +(defvar idlwave-force-class-query) +(defvar idlw-help-name) +(defvar idlw-help-kwd) +(defvar idlw-help-link) + (defun idlwave-do-context-help1 (&optional arg) "The work-horse version of `idlwave-context-help', which see." (save-excursion @@ -549,16 +538,16 @@ It collects and prints the diagnostics messages." (setq mod1 (append (list t) module)))) (if mod3 (condition-case nil - (apply 'idlwave-online-help mod1) + (apply #'idlwave-online-help mod1) (error (condition-case nil - (apply 'idlwave-online-help mod2) - (error (apply 'idlwave-online-help mod3))))) + (apply #'idlwave-online-help mod2) + (error (apply #'idlwave-online-help mod3))))) (if mod2 (condition-case nil - (apply 'idlwave-online-help mod1) - (error (apply 'idlwave-online-help mod2))) + (apply #'idlwave-online-help mod1) + (error (apply #'idlwave-online-help mod2))) (if mod1 - (apply 'idlwave-online-help mod1) + (apply #'idlwave-online-help mod1) (error "Don't know which item to show help for"))))))) (defun idlwave-do-mouse-completion-help (ev) @@ -660,7 +649,7 @@ Those words in `idlwave-completion-help-links' have links. The (props (list 'face 'idlwave-help-link)) (info idlwave-completion-help-info) ; global passed in (what (nth 0 info)) ; what was completed, or a func - (class (nth 3 info)) ; any class + ;; (class (nth 3 info)) ; any class word beg end doit) (goto-char (point-min)) (re-search-forward "possible completions are:" nil t) @@ -685,7 +674,7 @@ Those words in `idlwave-completion-help-links' have links. The ;; Arrange for this function to be called after completion (add-hook 'idlwave-completion-setup-hook - 'idlwave-highlight-linked-completions) + #'idlwave-highlight-linked-completions) (defvar idlwave-help-return-frame nil "The frame to return to from the help frame.") @@ -947,7 +936,7 @@ This function can be used as `idlwave-extra-help-function'." (point))) -(defun idlwave-help-find-routine-definition (name type class keyword) +(defun idlwave-help-find-routine-definition (name type class _keyword) "Find the definition of routine CLASS::NAME in current buffer. Returns the point of match if successful, nil otherwise. KEYWORD is ignored." @@ -967,7 +956,7 @@ KEYWORD is ignored." (defvar idlwave-doclib-start) (defvar idlwave-doclib-end) -(defun idlwave-help-find-in-doc-header (name type class keyword +(defun idlwave-help-find-in-doc-header (name _type class keyword &optional exact) "Find the requested help in the doc-header above point. @@ -1025,9 +1014,9 @@ If there is a match, we assume it is the keyword description." ":[ \t]*$\\)")) ;; Header start plus name - (header-re (concat "\\(" idlwave-doclib-start "\\).*\n" - "\\(^;+.*\n\\)*" - "\\(" name-re "\\)")) + ;; (header-re (concat "\\(" idlwave-doclib-start "\\).*\n" + ;; "\\(^;+.*\n\\)*" + ;; "\\(" name-re "\\)")) ;; A keywords section (kwds-re (concat ; forgiving "^;+\\*?[ \t]*" @@ -1095,8 +1084,8 @@ When DING is non-nil, ring the bell as well." (cons string idlwave-help-diagnostics)) (if ding (ding))))) -(defun idlwave-help-toggle-header-top-and-def (arg) - (interactive "P") +(defun idlwave-help-toggle-header-top-and-def (&optional _arg) + (interactive) (let (pos) (if idlwave-help-in-header ;; Header was the last thing displayed @@ -1119,8 +1108,8 @@ When DING is non-nil, ring the bell as well." (goto-char pos) (recenter 0))))) -(defun idlwave-help-find-first-header (arg) - (interactive "P") +(defun idlwave-help-find-first-header (&optional _arg) + (interactive) (let (pos) (save-excursion (goto-char (point-min)) @@ -1140,8 +1129,8 @@ When DING is non-nil, ring the bell as well." (setq idlwave-help-in-header nil) (idlwave-help-toggle-header-match-and-def arg 'top))) -(defun idlwave-help-toggle-header-match-and-def (arg &optional top) - (interactive "P") +(defun idlwave-help-toggle-header-match-and-def (&optional _arg top) + (interactive) (let ((args idlwave-help-args) pos) (if idlwave-help-in-header @@ -1150,7 +1139,7 @@ When DING is non-nil, ring the bell as well." (setq idlwave-help-in-header nil) (setq pos idlwave-help-def-pos)) ;; Try to display header - (setq pos (apply 'idlwave-help-find-in-doc-header + (setq pos (apply #'idlwave-help-find-in-doc-header (if top (list (car args) (nth 1 args) (nth 2 args) nil) args))) @@ -1184,7 +1173,7 @@ Useful when source code is displayed as help. See the option (with-no-warnings (font-lock-fontify-buffer)))))) -(defun idlwave-help-error (name type class keyword) +(defun idlwave-help-error (name _type class keyword) (error "Can't find help on %s%s %s" (or (and (or class name) (idlwave-make-full-name class name)) "") @@ -1272,11 +1261,11 @@ IDL assistant.") (delete-process idlwave-help-assistant-socket)) (setq idlwave-help-assistant-process - (apply 'start-process + (apply #'start-process "IDL_ASSISTANT_PROC" nil command "-server" extra-args)) (set-process-filter idlwave-help-assistant-process - (lambda (proc string) + (lambda (_proc string) (setq port (string-to-number string)))) (unless (accept-process-output idlwave-help-assistant-process 15) (error "Failed binding IDL_ASSISTANT socket")) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 4bc52247d86..134a6c6e497 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -729,7 +729,7 @@ IDL is currently stopped.") (defconst idlwave-shell-halt-messages-re - (mapconcat 'identity idlwave-shell-halt-messages "\\|") + (mapconcat #'identity idlwave-shell-halt-messages "\\|") "The regular expression computed from `idlwave-shell-halt-messages'.") (defconst idlwave-shell-trace-message-re @@ -934,8 +934,8 @@ IDL has currently stepped.") "[ \t\n]*\\'")) (when idlwave-shell-query-for-class - (add-to-list (make-local-variable 'idlwave-determine-class-special) - 'idlwave-shell-get-object-class) + (add-hook 'idlwave-determine-class-functions + #'idlwave-shell-get-object-class nil t) (setq idlwave-store-inquired-class t)) ;; Make sure comint-last-input-end does not go to beginning of @@ -950,10 +950,10 @@ IDL has currently stepped.") (setq idlwave-shell-default-directory default-directory) (setq idlwave-shell-hide-output nil) - (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm + (add-hook 'kill-buffer-hook #'idlwave-shell-kill-shell-buffer-confirm nil 'local) - (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) - (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files) + (add-hook 'kill-buffer-hook #'idlwave-shell-delete-temp-files nil 'local) + (add-hook 'kill-emacs-hook #'idlwave-shell-delete-temp-files) ;; Set the optional comint variables (when idlwave-shell-comint-settings @@ -962,7 +962,7 @@ IDL has currently stepped.") (set (make-local-variable (car entry)) (cdr entry))))) - (unless (memq 'comint-carriage-motion + (unless (memq #'comint-carriage-motion (default-value 'comint-output-filter-functions)) ;; Strip those pesky ctrl-m's. (add-hook 'comint-output-filter-functions @@ -976,18 +976,21 @@ IDL has currently stepped.") (while (search-forward "\r" pmark t) (delete-region (point) (line-beginning-position))))))) 'append 'local) - (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m nil 'local)) + (add-hook 'comint-output-filter-functions #'comint-strip-ctrl-m nil 'local)) ;; Python-mode, bundled with many Emacs installs, quite cavalierly ;; adds this function to the global default hook. It interferes ;; with overlay-arrows. - (remove-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file) + ;; FIXME: We should fix this interference rather than globally turn it off. + (when (fboundp 'py-pdbtrack-track-stack-file) + (remove-hook 'comint-output-filter-functions + #'py-pdbtrack-track-stack-file)) ;; IDLWAVE syntax, and turn on abbreviations (set (make-local-variable 'comment-start) ";") (setq abbrev-mode t) - (add-hook 'post-command-hook 'idlwave-command-hook nil t) + (add-hook 'post-command-hook #'idlwave-command-hook nil t) ;; Read the command history? (when (and idlwave-shell-save-command-history @@ -1045,7 +1048,7 @@ IDL has currently stepped.") (setq idlwave-path-alist old-path-alist)))) (if (not (fboundp 'idl-shell)) - (fset 'idl-shell 'idlwave-shell)) + (defalias 'idl-shell #'idlwave-shell)) (defvar idlwave-shell-idl-wframe nil "Frame for displaying the IDL shell window.") @@ -1120,7 +1123,7 @@ See also the variable `idlwave-shell-prompt-pattern'. (and idlwave-shell-use-dedicated-frame (setq idlwave-shell-idl-wframe (selected-frame))) (add-hook 'idlwave-shell-sentinel-hook - 'save-buffers-kill-emacs t)) + #'save-buffers-kill-emacs t)) ;; A non-nil arg means, we want a dedicated frame. This will last ;; for the current editing session. @@ -1130,7 +1133,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;; Check if the process still exists. If not, create it. (unless (comint-check-proc (idlwave-shell-buffer)) (let* ((prg (or idlwave-shell-explicit-file-name "idl")) - (buf (apply 'make-comint + (buf (apply #'make-comint idlwave-shell-process-name prg nil (if (stringp idlwave-shell-command-line-options) (idlwave-split-string @@ -1138,8 +1141,8 @@ See also the variable `idlwave-shell-prompt-pattern'. idlwave-shell-command-line-options))) (process (get-buffer-process buf))) (setq idlwave-idlwave_routine_info-compiled nil) - (set-process-filter process 'idlwave-shell-filter) - (set-process-sentinel process 'idlwave-shell-sentinel) + (set-process-filter process #'idlwave-shell-filter) + (set-process-sentinel process #'idlwave-shell-sentinel) (set-buffer buf) (idlwave-shell-mode))) (let ((window (idlwave-display-buffer (idlwave-shell-buffer) nil @@ -1315,10 +1318,7 @@ See also the variable `idlwave-shell-input-mode-spells'." (setq idlwave-shell-char-mode-active 'exit)) ((string-match (nth 1 idlwave-shell-input-mode-spells) string) ;; Set a timer which will soon start the character loop - (if (fboundp 'start-itimer) - (start-itimer "IDLWAVE Char Mode" 'idlwave-shell-char-mode-loop 0.5 - nil nil t 'no-error) - (run-at-time 0.5 nil 'idlwave-shell-char-mode-loop 'no-error))))) + (run-at-time 0.5 nil #'idlwave-shell-char-mode-loop 'no-error)))) (defvar keyboard-quit) (defun idlwave-shell-char-mode-loop (&optional no-error) @@ -1396,7 +1396,7 @@ Otherwise just move the line. Move down unless UP is non-nil." (idlwave-shell-move-or-history nil arg)) (define-obsolete-function-alias 'idlwave-shell-comint-filter - 'comint-output-filter "25.1") + #'comint-output-filter "25.1") (defun idlwave-shell-is-running () "Return t if the shell process is running." @@ -1510,13 +1510,12 @@ and then calls `idlwave-shell-send-command' for any pending commands." proc filtered)))))) ;; Call the post-command hook - (if (listp idlwave-shell-post-command-hook) - (progn - ;;(message "Calling list") - ;;(prin1 idlwave-shell-post-command-hook) - (eval idlwave-shell-post-command-hook)) - ;;(message "Calling command function") - (funcall idlwave-shell-post-command-hook)) + (if (functionp idlwave-shell-post-command-hook) + ;;(message "Calling command function") + (funcall idlwave-shell-post-command-hook) + ;;(message "Calling list") + ;;(prin1 idlwave-shell-post-command-hook) + (eval idlwave-shell-post-command-hook t)) ;; Reset to default state for next command. ;; Also we do not want to find this prompt again. @@ -1690,7 +1689,7 @@ the above." (if bp (let ((cmd (idlwave-shell-bp-get bp 'cmd))) (if cmd ;; Execute any breakpoint command - (if (listp cmd) (eval cmd) (funcall cmd)))) + (if (functionp cmd) (funcall cmd) (eval cmd t)))) ;; A breakpoint that we did not know about - perhaps it was ;; set by the user... Let's update our list. (idlwave-shell-bp-query))) @@ -1819,7 +1818,7 @@ The size is given by `idlwave-shell-graphics-window-size'." (interactive "P") (let ((n (if n (prefix-numeric-value n) 0))) (idlwave-shell-send-command - (apply 'format "window,%d,xs=%d,ys=%d" + (apply #'format "window,%d,xs=%d,ys=%d" n idlwave-shell-graphics-window-size) nil (idlwave-shell-hide-p 'misc) nil t))) @@ -1891,7 +1890,7 @@ HEAP_GC, /VERBOSE" (while (string-match "^PATH:[ \t]*<\\(.*\\)>[ \t]*\n" path-string start) (push (match-string 1 path-string) dirs) (setq start (match-end 0))) - (setq dirs (mapcar 'file-name-as-directory dirs)) + (setq dirs (mapcar #'file-name-as-directory dirs)) (if (string-match "^SYSDIR:[ \t]*<\\(.*\\)>[ \t]*\n" path-string) (setq sysdir (file-name-as-directory (match-string 1 path-string)))) @@ -1938,13 +1937,14 @@ HEAP_GC, /VERBOSE" key (nth 4 specs) keys (if (and (stringp key) (not (string-match "\\` *\\'" key))) - (mapcar 'list + (mapcar #'list (delete "" (idlwave-split-string key " +"))))) (setq name (idlwave-sintern-routine-or-method name class t) class (idlwave-sintern-class class t) file (if (equal file "") nil file) keys (mapcar (lambda (x) - (list (idlwave-sintern-keyword (car x) t))) keys)) + (list (idlwave-sintern-keyword (car x) t))) + keys)) ;; In the following ignore routines already defined in buffers, ;; assuming that if the buffer stuff differs, it is a "new" @@ -2053,7 +2053,7 @@ Change the default directory for the process buffer to concur." (match-string 1 idlwave-shell-command-output))))) (defvar idlwave-sint-sysvars nil) -(idlwave-new-sintern-type 'execcomm) +(idlwave-new-sintern-type execcomm) (defun idlwave-shell-complete (&optional arg) "Do completion in the idlwave-shell buffer. @@ -2180,7 +2180,7 @@ overlays." (defun idlwave-shell-parse-stack-and-display () (let* ((lines (delete "" (idlwave-split-string idlwave-shell-command-output "^%"))) - (stack (delq nil (mapcar 'idlwave-shell-parse-line lines))) + (stack (delq nil (mapcar #'idlwave-shell-parse-line lines))) (nmax (1- (length stack))) (nmin 0) message) (cond @@ -2710,45 +2710,34 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (interactive "P") (idlwave-shell-print arg 'help)) -(defmacro idlwave-shell-mouse-examine (help &optional ev) - "Create a function for generic examination of expressions." - `(lambda (event) - "Expansion function for expression examination." - (interactive "e") - (let* ((drag-track (fboundp 'mouse-drag-track)) - (transient-mark-mode t) - (tracker - ;; Emacs 22 no longer completes the drag with - ;; mouse-drag-region, without an additional - ;; event. mouse-drag-track does so. - (if drag-track 'mouse-drag-track 'mouse-drag-region))) - (funcall tracker event) - (idlwave-shell-print (if (region-active-p) '(4) nil) - ,help ,ev)))) +(defun idlwave-shell--mouse-examine (event help &optional ev) + "Expansion function for expression examination." + (let* ((transient-mark-mode t)) + (mouse-drag-track event) + (idlwave-shell-print (if (region-active-p) '(4) nil) + help ev))) -;; Begin terrible hack section -- XEmacs tests for button2 explicitly -;; on drag events, calling drag-n-drop code if detected. Ughhh... -(defun idlwave-default-mouse-track-event-is-with-button (_event _n) - (declare (obsolete nil "28.1")) - t) +(define-obsolete-function-alias + 'idlwave-default-mouse-track-event-is-with-button #'always "28.1") -(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1") +(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track + #'ignore "27.1") ;;; End terrible hack section (defun idlwave-shell-mouse-print (event) "Print value of variable at the mouse position, with `print'." (interactive "e") - (funcall (idlwave-shell-mouse-examine nil) event)) + (idlwave-shell--mouse-examine event nil)) (defun idlwave-shell-mouse-help (event) "Print value of variable at the mouse position, with `help'." (interactive "e") - (funcall (idlwave-shell-mouse-examine 'help) event)) + (idlwave-shell--mouse-examine event 'help)) (defun idlwave-shell-examine-select (event) "Pop-up a list to select from for examining the expression." (interactive "e") - (funcall (idlwave-shell-mouse-examine nil event) event)) + (idlwave-shell--mouse-examine event nil event)) (defmacro idlwave-shell-examine (help) "Create a function for key-driven expression examination." @@ -2814,7 +2803,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." (setq beg (region-beginning) end (region-end))) (t - (idlwave-with-special-syntax + (with-syntax-table idlwave-find-symbol-syntax-table ;; Move to beginning of current or previous expression (if (looking-at "\\<\\|(") ;; At beginning of expression, don't move backwards unless @@ -2847,9 +2836,9 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." (move-overlay idlwave-shell-expression-overlay beg end (current-buffer)) (add-hook 'pre-command-hook - 'idlwave-shell-delete-expression-overlay)) + #'idlwave-shell-delete-expression-overlay)) (add-hook 'pre-command-hook - 'idlwave-shell-delete-output-overlay) + #'idlwave-shell-delete-output-overlay) ;; Remove empty or comment-only lines (while (string-match "\n[ \t]*\\(;.*\\)?\r*\n" expr) @@ -2881,7 +2870,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." ;; "Print") (idlwave-popup-select ev - (mapcar 'car idlwave-shell-examine-alist) + (mapcar #'car idlwave-shell-examine-alist) "Examine with")) idlwave-shell-examine-alist)))) (setq help (cdr help-cons)) @@ -2916,9 +2905,8 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." "Variable to hold the win/height pairs for all *Examine* windows.") (defvar idlwave-shell-examine-map (make-sparse-keymap)) -(define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit) -(define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear) - +(define-key idlwave-shell-examine-map "q" #'idlwave-shell-examine-display-quit) +(define-key idlwave-shell-examine-map "c" #'idlwave-shell-examine-display-clear) (defun idlwave-shell-check-compiled-and-display () "Check examine output for warning about undefined procedure/function." @@ -3347,9 +3335,10 @@ the breakpoint overlays." count nil condition disabled)))))) (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist)) ;; Update breakpoint data - (if (eq bp-re bp-re54) - (mapc 'idlwave-shell-update-bp old-bp-alist) - (mapc 'idlwave-shell-update-bp-command-only old-bp-alist)))) + (mapc (if (eq bp-re bp-re54) + #'idlwave-shell-update-bp + #'idlwave-shell-update-bp-command-only) + old-bp-alist))) ;; Update the breakpoint overlays (unless no-show (idlwave-shell-update-bp-overlays)) ;; Return the new list @@ -3484,7 +3473,7 @@ The actual line number for a breakpoint in IDL may be different from the line number used with the IDL breakpoint command. Looks for a new breakpoint index number in the list. This is considered the new breakpoint if the file name of frame matches." - (let ((obp-index (mapcar 'idlwave-shell-bp-get idlwave-shell-old-bp)) + (let ((obp-index (mapcar #'idlwave-shell-bp-get idlwave-shell-old-bp)) (bpl idlwave-shell-bp-alist)) (while (and (member (idlwave-shell-bp-get (car bpl)) obp-index) (setq bpl (cdr bpl)))) @@ -3510,7 +3499,7 @@ considered the new breakpoint if the file name of frame matches." (defvar idlwave-shell-debug-line-map (make-sparse-keymap)) (define-key idlwave-shell-debug-line-map [mouse-3] - 'idlwave-shell-mouse-active-bp) + #'idlwave-shell-mouse-active-bp) (defun idlwave-shell-update-bp-overlays () "Update the overlays which mark breakpoints in the source code. @@ -3532,7 +3521,7 @@ Existing overlays are recycled, in order to minimize consumption." (setq ov-alist idlwave-shell-bp-overlays idlwave-shell-bp-overlays (if idlwave-shell-bp-glyph - (mapcar 'list (mapcar 'car idlwave-shell-bp-glyph)) + (mapcar #'list (mapcar #'car idlwave-shell-bp-glyph)) (list (list 'bp)))) (while (setq bp (pop bp-list)) (save-excursion @@ -3568,7 +3557,7 @@ Existing overlays are recycled, in order to minimize consumption." (if help-list (concat " - " - (mapconcat 'identity help-list ", "))) + (mapconcat #'identity help-list ", "))) (if (and (not count) (not condition)) " (use mouse-3 for breakpoint actions)"))) (full-type (if disabled @@ -3962,73 +3951,73 @@ Otherwise, just expand the file name." ;;(define-key map "\M-?" 'comint-dynamic-list-completions) ;;(define-key map "\t" 'comint-dynamic-complete) - (define-key map "\C-w" 'comint-kill-region) - (define-key map "\t" 'idlwave-shell-complete) - (define-key map "\M-\t" 'idlwave-shell-complete) - (define-key map "\C-c\C-s" 'idlwave-shell) - (define-key map "\C-c?" 'idlwave-routine-info) - (define-key map "\C-g" 'idlwave-keyboard-quit) - (define-key map "\M-?" 'idlwave-context-help) + (define-key map "\C-w" #'comint-kill-region) + (define-key map "\t" #'idlwave-shell-complete) + (define-key map "\M-\t" #'idlwave-shell-complete) + (define-key map "\C-c\C-s" #'idlwave-shell) + (define-key map "\C-c?" #'idlwave-routine-info) + (define-key map "\C-g" #'idlwave-keyboard-quit) + (define-key map "\M-?" #'idlwave-context-help) (define-key map [(control meta ?\?)] - 'idlwave-help-assistant-help-with-topic) - (define-key map "\C-c\C-i" 'idlwave-update-routine-info) - (define-key map "\C-c\C-y" 'idlwave-shell-char-mode-loop) - (define-key map "\C-c\C-x" 'idlwave-shell-send-char) - (define-key map "\C-c=" 'idlwave-resolve) - (define-key map "\C-c\C-v" 'idlwave-find-module) - (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) + #'idlwave-help-assistant-help-with-topic) + (define-key map "\C-c\C-i" #'idlwave-update-routine-info) + (define-key map "\C-c\C-y" #'idlwave-shell-char-mode-loop) + (define-key map "\C-c\C-x" #'idlwave-shell-send-char) + (define-key map "\C-c=" #'idlwave-resolve) + (define-key map "\C-c\C-v" #'idlwave-find-module) + (define-key map "\C-c\C-k" #'idlwave-kill-autoloaded-buffers) (define-key map idlwave-shell-prefix-key - 'idlwave-shell-debug-map) - (define-key map [(up)] 'idlwave-shell-up-or-history) - (define-key map [(down)] 'idlwave-shell-down-or-history) + #'idlwave-shell-debug-map) + (define-key map [(up)] #'idlwave-shell-up-or-history) + (define-key map [(down)] #'idlwave-shell-down-or-history) (define-key idlwave-shell-mode-map [(shift mouse-3)] - 'idlwave-mouse-context-help) + #'idlwave-mouse-context-help) map) "Keymap for `idlwave-mode'.") (defvar idlwave-shell-electric-debug-mode-map (let ((map (make-sparse-keymap))) ;; A few extras in the electric debug map - (define-key map " " 'idlwave-shell-step) - (define-key map "+" 'idlwave-shell-stack-up) - (define-key map "=" 'idlwave-shell-stack-up) - (define-key map "-" 'idlwave-shell-stack-down) - (define-key map "_" 'idlwave-shell-stack-down) + (define-key map " " #'idlwave-shell-step) + (define-key map "+" #'idlwave-shell-stack-up) + (define-key map "=" #'idlwave-shell-stack-up) + (define-key map "-" #'idlwave-shell-stack-down) + (define-key map "_" #'idlwave-shell-stack-down) (define-key map "e" (lambda () (interactive) (idlwave-shell-print '(16)))) - (define-key map "q" 'idlwave-shell-retall) + (define-key map "q" #'idlwave-shell-retall) (define-key map "t" (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) - (define-key map [(control ??)] 'idlwave-shell-electric-debug-help) + (define-key map [(control ??)] #'idlwave-shell-electric-debug-help) (define-key map "x" (lambda (arg) (interactive "P") (idlwave-shell-print arg nil nil t))) map)) (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap)) -(fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map) +(defalias 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map) (defvar idlwave-mode-prefix-map (make-sparse-keymap)) -(fset 'idlwave-mode-prefix-map idlwave-mode-prefix-map) +(defalias 'idlwave-mode-prefix-map idlwave-mode-prefix-map) (defun idlwave-shell-define-key-both (key hook) "Define a key in both the shell and buffer mode maps." (define-key idlwave-mode-map key hook) (define-key idlwave-shell-mode-map key hook)) -(define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop) -(define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char) +(define-key idlwave-mode-map "\C-c\C-y" #'idlwave-shell-char-mode-loop) +(define-key idlwave-mode-map "\C-c\C-x" #'idlwave-shell-send-char) ;; The mouse bindings for PRINT and HELP (idlwave-shell-define-key-both [(shift down-mouse-2)] - 'idlwave-shell-mouse-print) + #'idlwave-shell-mouse-print) (idlwave-shell-define-key-both [(control meta down-mouse-2)] - 'idlwave-shell-mouse-help) + #'idlwave-shell-mouse-help) (idlwave-shell-define-key-both [(control shift down-mouse-2)] - 'idlwave-shell-examine-select) + #'idlwave-shell-examine-select) ;; We need to turn off the button release events. -(idlwave-shell-define-key-both [(shift mouse-2)] 'ignore) -(idlwave-shell-define-key-both [(shift control mouse-2)] 'ignore) -(idlwave-shell-define-key-both [(control meta mouse-2)] 'ignore) +(idlwave-shell-define-key-both [(shift mouse-2)] #'ignore) +(idlwave-shell-define-key-both [(shift control mouse-2)] #'ignore) +(idlwave-shell-define-key-both [(control meta mouse-2)] #'ignore) ;; The following set of bindings is used to bind the debugging keys. @@ -4109,8 +4098,8 @@ Otherwise, just expand the file name." cmd)))) ; Enter the prefix map in two places. -(fset 'idlwave-debug-map idlwave-mode-prefix-map) -(fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map) +(defalias 'idlwave-debug-map idlwave-mode-prefix-map) +(defalias 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map) ;; The Electric Debug Minor Mode -------------------------------------------- @@ -4496,6 +4485,6 @@ static char * file[] = { (idlwave-toolbar-toggle)) (if idlwave-shell-use-toolbar - (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere)) + (add-hook 'idlwave-shell-mode-hook #'idlwave-toolbar-add-everywhere)) ;;; idlw-shell.el ends here diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 4bd0afb2ba1..d3f47fcf45e 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -1,4 +1,4 @@ -;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE +;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -24,8 +24,8 @@ ;;; Commentary: -;; This file implements a debugging toolbar for IDLWAVE. It requires -;; Emacs or XEmacs with toolbar and xpm support. +;; This file implements a debugging toolbar for IDLWAVE. +;; It requires toolbar and xpm support. ;; New versions of IDLWAVE, documentation, and more information ;; available from: @@ -35,22 +35,16 @@ ;;; Code: (defun idlwave-toolbar-make-button (image) - (if (featurep 'xemacs) - (toolbar-make-button-list image) - (list 'image :type 'xpm :data image))) + (list 'image :type 'xpm :data image)) (defvar idlwave-toolbar) (defvar default-toolbar) (defvar idlwave-toolbar-is-possible) -(if (not (or (and (featurep 'xemacs) ; This is XEmacs - (featurep 'xpm) ; need xpm - (featurep 'toolbar)) ; ... and the toolbar - (and (not (featurep 'xemacs)) ; This is Emacs - (boundp 'tool-bar-button-margin) ; need toolbar - (fboundp 'image-type-available-p) ; need image stuff - (image-type-available-p 'xpm)) ; need xpm - )) +(if (not (and (boundp 'tool-bar-button-margin) ; need toolbar + (fboundp 'image-type-available-p) ; need image stuff + (image-type-available-p 'xpm)) ; need xpm + ) ;; oops - cannot do the toolbar (message "Sorry, IDLWAVE xpm toolbar cannot be used on this version of Emacs") ;; OK, we can define a toolbar @@ -873,23 +867,12 @@ static char * file[] = { ;; When the shell exits, arrange to remove the special toolbar everywhere. (add-hook 'idlwave-shell-cleanup-hook - 'idlwave-toolbar-remove-everywhere) + #'idlwave-toolbar-remove-everywhere) );; End can define toolbar -(defun idlwave-toolbar-add () - "Add the IDLWAVE toolbar if appropriate." - (if (and (featurep 'xemacs) ; This is a noop on Emacs - (boundp 'idlwave-toolbar-is-possible) - (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) - (set-specifier default-toolbar (cons (current-buffer) - idlwave-toolbar)))) +(define-obsolete-function-alias 'idlwave-toolbar-add #'ignore "28.1") -(defun idlwave-toolbar-remove () - "Add the IDLWAVE toolbar if appropriate." - (if (and (featurep 'xemacs) ; This is a noop on Emacs - (boundp 'idlwave-toolbar-is-possible) - (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) - (remove-specifier default-toolbar (current-buffer)))) +(define-obsolete-function-alias 'idlwave-toolbar-remove #'ignore "28.1") (defvar idlwave-shell-mode-map) (defvar idlwave-mode-map) @@ -898,57 +881,40 @@ static char * file[] = { "Add the toolbar in all appropriate buffers." (when (boundp 'idlwave-toolbar-is-possible) - ;; First make sure new buffers will get the toolbar - (add-hook 'idlwave-mode-hook 'idlwave-toolbar-add) ;; Then add it to all existing buffers - (if (featurep 'xemacs) - ;; For XEmacs, map over all buffers to add toolbar - (save-excursion - (mapcar (lambda (buf) - (set-buffer buf) - (idlwave-toolbar-add)) - (buffer-list))) - ;; For Emacs, add the key definitions to the mode maps - (mapc (lambda (x) - (let* ((icon (aref x 0)) - (func (aref x 1)) - (show (aref x 2)) - (help (aref x 3)) - (key (vector 'tool-bar func)) - (def (list 'menu-item - "" - func - :image (symbol-value icon) - :visible show - :help help))) - (define-key idlwave-mode-map key def) - (define-key idlwave-shell-mode-map key def))) - (reverse idlwave-toolbar))) + ;; For Emacs, add the key definitions to the mode maps + (mapc (lambda (x) + (let* ((icon (aref x 0)) + (func (aref x 1)) + (show (aref x 2)) + (help (aref x 3)) + (key (vector 'tool-bar func)) + (def (list 'menu-item + "" + func + :image (symbol-value icon) + :visible show + :help help))) + (define-key idlwave-mode-map key def) + (define-key idlwave-shell-mode-map key def))) + (reverse idlwave-toolbar)) (setq idlwave-toolbar-visible t))) (defun idlwave-toolbar-remove-everywhere () "Remove the toolbar in all appropriate buffers." ;; First make sure new buffers won't get the toolbar (when idlwave-toolbar-is-possible - (remove-hook 'idlwave-mode-hook 'idlwave-toolbar-add) ;; Then remove it in all existing buffers. - (if (featurep 'xemacs) - ;; For XEmacs, map over all buffers to remove toolbar - (save-excursion - (mapcar (lambda (buf) - (set-buffer buf) - (idlwave-toolbar-remove)) - (buffer-list))) - ;; For Emacs, remove the key definitions from the mode maps - (mapc (lambda (x) - (let* (;;(icon (aref x 0)) - (func (aref x 1)) - ;;(show (aref x 2)) - ;;(help (aref x 3)) - (key (vector 'tool-bar func))) - (define-key idlwave-mode-map key nil) - (define-key idlwave-shell-mode-map key nil))) - idlwave-toolbar)) + ;; For Emacs, remove the key definitions from the mode maps + (mapc (lambda (x) + (let* (;;(icon (aref x 0)) + (func (aref x 1)) + ;;(show (aref x 2)) + ;;(help (aref x 3)) + (key (vector 'tool-bar func))) + (define-key idlwave-mode-map key nil) + (define-key idlwave-shell-mode-map key nil))) + idlwave-toolbar) (setq idlwave-toolbar-visible nil))) (defun idlwave-toolbar-toggle (&optional force-on) @@ -956,11 +922,8 @@ static char * file[] = { (if idlwave-toolbar-visible (or force-on (idlwave-toolbar-remove-everywhere)) (idlwave-toolbar-add-everywhere)) - ;; Now make sure this - (if (featurep 'xemacs) - nil ; no action necessary, toolbar gets updated automatically - ;; On Emacs, redraw the frame to make sure the Toolbar is updated. - (redraw-frame))) + ;; On Emacs, redraw the frame to make sure the Toolbar is updated. + (redraw-frame)) (provide 'idlw-toolbar) (provide 'idlwave-toolbar) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index e8e55ae96d1..f53f3f3b995 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1,4 +1,4 @@ -;; idlwave.el --- IDL editing mode for GNU Emacs +;; idlwave.el --- IDL editing mode for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -781,7 +781,7 @@ definitions, use the command `list-abbrevs', for abbrevs that move point. Moving point is useful, for example, to place point between parentheses of expanded functions. -See `idlwave-check-abbrev'." +See `idlwave-modify-abbrev'." :group 'idlwave-abbrev-and-indent-action :type 'boolean) @@ -819,18 +819,19 @@ Has effect only if in abbrev-mode." ;; Example actions: ;; ;; Capitalize system vars -;; (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t) +;; (idlwave-action-and-binding idlwave-sysvar +;; (lambda (_) (capitalize-word 1)) t) ;; ;; Capitalize procedure name ;; (idlwave-action-and-binding "\\<\\(pro\\|function\\)\\>[ \t]*\\<" -;; '(capitalize-word 1) t) +;; (lambda (_) (capitalize-word 1)) t) ;; ;; Capitalize common block name ;; (idlwave-action-and-binding "\\[ \t]+\\<" -;; '(capitalize-word 1) t) +;; (lambda (_) (capitalize-word 1)) t) ;; Capitalize label ;; (idlwave-action-and-binding (concat "^[ \t]*" idlwave-label) -;; '(capitalize-word -1) t) +;; (lambda (_) (capitalize-word 1)) t) (defvar idlwave-indent-action-table nil "Associated array containing action lists of search string (car), @@ -1121,91 +1122,101 @@ As a user, you should not set this to t.") "\\<\\(&&\\|and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\|||\\)\\>") -(let* (;; Procedure declarations. Fontify keyword plus procedure name. - ;; Function declarations. Fontify keyword plus function name. - (pros-and-functions - '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face nil t))) +(defmacro idlwave--dlet (binders &rest body) + "Like `dlet' but without warnings about non-prefixed var names." + (declare (indent 1) (debug let)) + (let ((vars (mapcar (lambda (binder) + (if (consp binder) (car binder) binder)) + binders))) + `(with-suppressed-warnings ((lexical ,@vars)) + (dlet ,binders ,@body)))) - ;; Common blocks - (common-blocks - '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" - (1 font-lock-keyword-face) ; "common" - (2 font-lock-constant-face nil t) ; block name - ("[ \t]*\\(\\sw+\\)[ ,]*" - ;; Start with point after block name and comma - nil nil (1 font-lock-variable-name-face)))) ; variable names +(idlwave--dlet + (;; Procedure declarations. Fontify keyword plus procedure name. + ;; Function declarations. Fontify keyword plus function name. + (pros-and-functions + '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face nil t))) - ;; Batch files - (batch-files - '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) + ;; Common blocks + (common-blocks + '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" + (1 font-lock-keyword-face) ; "common" + (2 font-lock-constant-face nil t) ; block name + ("[ \t]*\\(\\sw+\\)[ ,]*" + ;; Start with point after block name and comma + nil nil (1 font-lock-variable-name-face)))) ; variable names - ;; Labels - (label - '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) + ;; Batch files + (batch-files + '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) - ;; The goto statement and its label - (goto - '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" - (1 font-lock-keyword-face) - (2 font-lock-constant-face))) + ;; Labels + (label + '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) - ;; Tags in structure definitions. Note that this definition - ;; actually collides with labels, so we have to use the same - ;; face. It also matches named subscript ranges, - ;; e.g. vec{bottom:top]. No good way around this. - (structtag - '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face))) + ;; The goto statement and its label + (goto + '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" + (1 font-lock-keyword-face) + (2 font-lock-constant-face))) - ;; Structure names - (structname - '("\\({\\|\\#]" (0 font-lock-keyword-face))) + ;; System variables start with a bang. + (system-variables + '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)" + (1 font-lock-variable-name-face))) - ;; All operators (not used because too noisy) - ;; (all-operators - ;; '("[-*^#+<>/]" (0 font-lock-keyword-face))) + ;; Special and unusual operators (not used because too noisy) + ;; (special-operators + ;; '("[<>#]" (0 font-lock-keyword-face))) - ;; Arrows with text property `idlwave-class' - (class-arrows - '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) + ;; All operators (not used because too noisy) + ;; (all-operators + ;; '("[-*^#+<>/]" (0 font-lock-keyword-face))) + + ;; Arrows with text property `idlwave-class' + (class-arrows + '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) (defconst idlwave-font-lock-keywords-1 (list pros-and-functions batch-files) "Subdued level highlighting for IDLWAVE mode.") (defconst idlwave-font-lock-keywords-2 - (mapcar 'symbol-value idlwave-default-font-lock-items) + (mapcar #'symbol-value idlwave-default-font-lock-items) "Medium level highlighting for IDLWAVE mode.") (defconst idlwave-font-lock-keywords-3 - (list pros-and-functions - batch-files - idlwave-idl-keywords - label goto - structtag - structname - common-blocks - keyword-parameters - system-variables + (list pros-and-functions + batch-files + idlwave-idl-keywords + label goto + structtag + structname + common-blocks + keyword-parameters + system-variables class-arrows) "Gaudy level highlighting for IDLWAVE mode.")) @@ -1312,13 +1323,16 @@ blocks starting with a BEGIN statement. The matches must have associations (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" "\\(" idlwave-method-call "\\s *\\)?" idlwave-identifier - "\\s *(") nil)) + "\\s *(") + nil)) (cons 'call (list (concat "\\(" idlwave-method-call "\\s *\\)?" idlwave-identifier - "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) + "\\( *\\($\\|\\$\\)\\|\\s *,\\)") + nil)) (cons 'assign (list (concat - "\\(" idlwave-variable "\\) *=") nil))) + "\\(" idlwave-variable "\\) *=") + nil))) "Associated list of statement matching regular expressions. Each regular expression matches the start of an IDL statement. @@ -1333,10 +1347,6 @@ list order matters since matching an assignment statement exactly is not possible without parsing. Thus assignment statement become just the leftover unidentified statements containing an equal sign.") -;; FIXME: This var seems to only ever be set, but never actually used! -(defvar idlwave-fill-function 'auto-fill-function - "IDL mode auto fill function.") - (defvar idlwave-comment-indent-function 'comment-indent-function "IDL mode comment indent function.") @@ -1353,28 +1363,9 @@ Normally a space.") (defconst idlwave-mode-version "6.1_em22") -(defmacro idlwave-keyword-abbrev (&rest args) - "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." - `(lambda () - ,(append '(idlwave-check-abbrev) args))) - -;; If I take the time I can replace idlwave-keyword-abbrev with -;; idlwave-code-abbrev and remove the quoted abbrev check from -;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes -;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change -;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev. - -(defmacro idlwave-code-abbrev (&rest args) - "Creates a function for abbrev hooks that ensures abbrevs are not quoted. -Specifically, if the abbrev is in a comment or string it is unexpanded. -Otherwise ARGS forms a list that is evaluated." - ;; FIXME: it would probably be better to rely on the new :enable-function - ;; to enforce the "don't expand in comments or strings". - `(lambda () - ,(prin1-to-string args) ;; Puts the code in the doc string - (if (idlwave-quoted) - (progn (unexpand-abbrev) nil) - ,(append args)))) +(defun idlwave-keyword-abbrev (&rest args) + "Create a function for abbrev hooks to call `idlwave-modify-abbrev' with args." + (lambda () (append #'idlwave-modify-abbrev args))) (autoload 'idlwave-shell "idlw-shell" "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'." t) @@ -1388,41 +1379,41 @@ Otherwise ARGS forms a list that is evaluated." (autoload 'idlwave-shell-run-region "idlw-shell" "Compile and run the region." t) -(fset 'idlwave-debug-map (make-sparse-keymap)) +(defalias 'idlwave-debug-map (make-sparse-keymap)) (defvar idlwave-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c " 'idlwave-hard-tab) - (define-key map [(control tab)] 'idlwave-hard-tab) - ;;(define-key map "\C-c\C- " 'idlwave-hard-tab) - (define-key map "'" 'idlwave-show-matching-quote) - (define-key map "\"" 'idlwave-show-matching-quote) - (define-key map "\C-g" 'idlwave-keyboard-quit) - (define-key map "\C-c;" 'idlwave-toggle-comment-region) - (define-key map "\C-\M-a" 'idlwave-beginning-of-subprogram) - (define-key map "\C-\M-e" 'idlwave-end-of-subprogram) - (define-key map "\C-c{" 'idlwave-beginning-of-block) - (define-key map "\C-c}" 'idlwave-end-of-block) - (define-key map "\C-c]" 'idlwave-close-block) - (define-key map [(meta control h)] 'idlwave-mark-subprogram) - (define-key map "\M-\C-n" 'idlwave-forward-block) - (define-key map "\M-\C-p" 'idlwave-backward-block) - (define-key map "\M-\C-d" 'idlwave-down-block) - (define-key map "\M-\C-u" 'idlwave-backward-up-block) - (define-key map "\M-\r" 'idlwave-split-line) - (define-key map "\M-\C-q" 'idlwave-indent-subprogram) - (define-key map "\C-c\C-p" 'idlwave-previous-statement) - (define-key map "\C-c\C-n" 'idlwave-next-statement) - ;; (define-key map "\r" 'idlwave-newline) - ;; (define-key map "\t" 'idlwave-indent-line) - (define-key map [(shift iso-lefttab)] 'idlwave-indent-statement) - (define-key map "\C-c\C-a" 'idlwave-auto-fill-mode) - (define-key map "\M-q" 'idlwave-fill-paragraph) - (define-key map "\M-s" 'idlwave-edit-in-idlde) - (define-key map "\C-c\C-h" 'idlwave-doc-header) - (define-key map "\C-c\C-m" 'idlwave-doc-modification) - (define-key map "\C-c\C-c" 'idlwave-case) - (define-key map "\C-c\C-d" 'idlwave-debug-map) + (define-key map "\C-c " #'idlwave-hard-tab) + (define-key map [(control tab)] #'idlwave-hard-tab) + ;;(define-key map "\C-c\C- " #'idlwave-hard-tab) + (define-key map "'" #'idlwave-show-matching-quote) + (define-key map "\"" #'idlwave-show-matching-quote) + (define-key map "\C-g" #'idlwave-keyboard-quit) + (define-key map "\C-c;" #'idlwave-toggle-comment-region) + (define-key map "\C-\M-a" #'idlwave-beginning-of-subprogram) + (define-key map "\C-\M-e" #'idlwave-end-of-subprogram) + (define-key map "\C-c{" #'idlwave-beginning-of-block) + (define-key map "\C-c}" #'idlwave-end-of-block) + (define-key map "\C-c]" #'idlwave-close-block) + (define-key map [(meta control h)] #'idlwave-mark-subprogram) + (define-key map "\M-\C-n" #'idlwave-forward-block) + (define-key map "\M-\C-p" #'idlwave-backward-block) + (define-key map "\M-\C-d" #'idlwave-down-block) + (define-key map "\M-\C-u" #'idlwave-backward-up-block) + (define-key map "\M-\r" #'idlwave-split-line) + (define-key map "\M-\C-q" #'idlwave-indent-subprogram) + (define-key map "\C-c\C-p" #'idlwave-previous-statement) + (define-key map "\C-c\C-n" #'idlwave-next-statement) + ;; (define-key map "\r" #'idlwave-newline) + ;; (define-key map "\t" #'idlwave-indent-line) + (define-key map [(shift iso-lefttab)] #'idlwave-indent-statement) + (define-key map "\C-c\C-a" #'auto-fill-mode) + (define-key map "\M-q" #'idlwave-fill-paragraph) + (define-key map "\M-s" #'idlwave-edit-in-idlde) + (define-key map "\C-c\C-h" #'idlwave-doc-header) + (define-key map "\C-c\C-m" #'idlwave-doc-modification) + (define-key map "\C-c\C-c" #'idlwave-case) + (define-key map "\C-c\C-d" #'idlwave-debug-map) (when (and (listp idlwave-shell-debug-modifiers) (not (equal idlwave-shell-debug-modifiers '()))) ;; Bind the debug commands also with the special modifiers. @@ -1431,38 +1422,39 @@ Otherwise ARGS forms a list that is evaluated." (delq 'shift (copy-sequence idlwave-shell-debug-modifiers)))) (define-key map (vector (append mods-noshift (list (if shift ?C ?c)))) - 'idlwave-shell-save-and-run) + #'idlwave-shell-save-and-run) (define-key map (vector (append mods-noshift (list (if shift ?B ?b)))) - 'idlwave-shell-break-here) + #'idlwave-shell-break-here) (define-key map (vector (append mods-noshift (list (if shift ?E ?e)))) - 'idlwave-shell-run-region))) - (define-key map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) - (define-key map "\C-c\C-d\C-b" 'idlwave-shell-break-here) - (define-key map "\C-c\C-d\C-e" 'idlwave-shell-run-region) - (define-key map "\C-c\C-f" 'idlwave-for) - ;; (define-key map "\C-c\C-f" 'idlwave-function) - ;; (define-key map "\C-c\C-p" 'idlwave-procedure) - (define-key map "\C-c\C-r" 'idlwave-repeat) - (define-key map "\C-c\C-w" 'idlwave-while) - (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) - (define-key map "\C-c\C-s" 'idlwave-shell) - (define-key map "\C-c\C-l" 'idlwave-shell-recenter-shell-window) - (define-key map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows) - (define-key map "\C-c\C-v" 'idlwave-find-module) - (define-key map "\C-c\C-t" 'idlwave-find-module-this-file) - (define-key map "\C-c?" 'idlwave-routine-info) - (define-key map "\M-?" 'idlwave-context-help) + #'idlwave-shell-run-region))) + (define-key map "\C-c\C-d\C-c" #'idlwave-shell-save-and-run) + (define-key map "\C-c\C-d\C-b" #'idlwave-shell-break-here) + (define-key map "\C-c\C-d\C-e" #'idlwave-shell-run-region) + (define-key map "\C-c\C-f" #'idlwave-for) + ;; (define-key map "\C-c\C-f" #'idlwave-function) + ;; (define-key map "\C-c\C-p" #'idlwave-procedure) + (define-key map "\C-c\C-r" #'idlwave-repeat) + (define-key map "\C-c\C-w" #'idlwave-while) + (define-key map "\C-c\C-k" #'idlwave-kill-autoloaded-buffers) + (define-key map "\C-c\C-s" #'idlwave-shell) + (define-key map "\C-c\C-l" #'idlwave-shell-recenter-shell-window) + (define-key map "\C-c\C-b" #'idlwave-list-buffer-load-path-shadows) + (define-key map "\C-c\C-v" #'idlwave-find-module) + (define-key map "\C-c\C-t" #'idlwave-find-module-this-file) + (define-key map "\C-c?" #'idlwave-routine-info) + (define-key map "\M-?" #'idlwave-context-help) (define-key map [(control meta ?\?)] - 'idlwave-help-assistant-help-with-topic) + #'idlwave-help-assistant-help-with-topic) ;; Pickup both forms of Esc/Meta binding - (define-key map [(meta tab)] 'idlwave-complete) - (define-key map [?\e?\t] 'idlwave-complete) - (define-key map "\M-\C-i" 'idlwave-complete) - (define-key map "\C-c\C-i" 'idlwave-update-routine-info) - (define-key map "\C-c=" 'idlwave-resolve) - (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help) + ;; FIXME: Use `completion-at-point'! + (define-key map [(meta tab)] #'idlwave-complete) + (define-key map [?\e?\t] #'idlwave-complete) + (define-key map "\M-\C-i" #'idlwave-complete) + (define-key map "\C-c\C-i" #'idlwave-update-routine-info) + (define-key map "\C-c=" #'idlwave-resolve) + (define-key map [(shift mouse-3)] #'idlwave-mouse-context-help) map) "Keymap used in IDL mode.") @@ -1501,28 +1493,15 @@ Otherwise ARGS forms a list that is evaluated." st) "Syntax table that treats symbol characters as word characters.") -(defmacro idlwave-with-special-syntax (&rest body) - "Execute BODY with a different syntax table." - `(let ((saved-syntax (syntax-table))) - (unwind-protect - (progn - (set-syntax-table idlwave-find-symbol-syntax-table) - ,@body) - (set-syntax-table saved-syntax)))) - -;(defmacro idlwave-with-special-syntax1 (&rest body) -; "Execute BODY with a different syntax table." -; `(let ((saved-syntax (syntax-table))) -; (unwind-protect -; (progn -; (set-syntax-table idlwave-find-symbol-syntax-table) -; ,@body) -; (set-syntax-table saved-syntax)))) +;;(defmacro idlwave-with-special-syntax (&rest body) +;; "Execute BODY with `idlwave-find-symbol-syntax-table'." +;; `(with-syntax-table idlwave-find-symbol-syntax-table +;; ,@body)) (defun idlwave-action-and-binding (key cmd &optional select) "KEY and CMD are made into a key binding and an indent action. KEY is a string - same as for the `define-key' function. CMD is a -function of no arguments or a list to be evaluated. CMD is bound to +function of one argument. CMD is bound to KEY in `idlwave-mode-map' by defining an anonymous function calling `self-insert-command' followed by CMD. If KEY contains more than one character a binding will only be set if SELECT is `both'. @@ -1539,62 +1518,59 @@ Otherwise, if SELECT is non-nil then only an action is created. Some examples: No spaces before and 1 after a comma - (idlwave-action-and-binding \",\" \\='(idlwave-surround 0 1)) + (idlwave-action-and-binding \",\" (lambda (_) (idlwave-surround 0 1))) A minimum of 1 space before and after `=' (see `idlwave-expand-equal'). - (idlwave-action-and-binding \"=\" \\='(idlwave-expand-equal -1 -1)) + (idlwave-action-and-binding \"=\" (lambda (_) (idlwave-expand-equal -1 -1))) Capitalize system variables - action only - (idlwave-action-and-binding idlwave-sysvar \\='(capitalize-word 1) t)" + (idlwave-action-and-binding idlwave-sysvar (lambda (_) (capitalize-word 1) t))" (if (not (equal select 'noaction)) ;; Add action (let* ((table (if select 'idlwave-indent-action-table 'idlwave-indent-expand-table)) - (table-key (regexp-quote key)) - (cell (assoc table-key (eval table)))) - (if cell - ;; Replace action command - (setcdr cell cmd) - ;; New action - (set table (append (eval table) (list (cons table-key cmd))))))) + (table-key (regexp-quote key))) + (setf (alist-get table-key (symbol-value table) nil nil #'equal) cmd))) ;; Make key binding for action - (if (or (and (null select) (= (length key) 1)) - (equal select 'noaction) - (equal select 'both)) + (if (if (null select) (= (length key) 1) + (memq select '(noaction both))) + ;; FIXME: Use `post-self-insert-hook'! (define-key idlwave-mode-map key - `(lambda () - (interactive) - (self-insert-command 1) - ,(if (listp cmd) cmd (list cmd)))))) + (lambda () + (interactive) + (self-insert-command 1) + (if (functionp cmd) (funcall cmd nil) (eval cmd t)))))) ;; Set action and key bindings. ;; See description of the function `idlwave-action-and-binding'. ;; Automatically add spaces for the following characters ;; Actions for & are complicated by && -(idlwave-action-and-binding "&" 'idlwave-custom-ampersand-surround) +(idlwave-action-and-binding "&" #'idlwave-custom-ampersand-surround) ;; Automatically add spaces to equal sign if not keyword. This needs ;; to go ahead of > and <, so >= and <= will be treated correctly -(idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) +(idlwave-action-and-binding "=" (lambda (_) (idlwave-expand-equal -1 -1))) ;; Actions for > and < are complicated by >=, <=, and ->... -(idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil)) -(idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr)) +(idlwave-action-and-binding "<" (lambda (a) (idlwave-custom-ltgtr-surround nil a))) +(idlwave-action-and-binding ">" (lambda (a) (idlwave-custom-ltgtr-surround t a))) -(idlwave-action-and-binding "," '(idlwave-surround 0 -1 1)) +(idlwave-action-and-binding "," (lambda (a) (idlwave-surround 0 -1 1 a))) ;;; ;;; Abbrev Section ;;; -;;; When expanding abbrevs and the abbrev hook moves backward, an extra -;;; space is inserted (this is the space typed by the user to expanded -;;; the abbrev). -;;; -(defvar idlwave-mode-abbrev-table nil - "Abbreviation table used for IDLWAVE mode.") -(define-abbrev-table 'idlwave-mode-abbrev-table ()) +;; When expanding abbrevs and the abbrev hook moves backward, an extra +;; space is inserted (this is the space typed by the user to expanded +;; the abbrev). +;; FIXME: This can be controlled with `no-self-insert' property. +;; +(define-abbrev-table 'idlwave-mode-abbrev-table () + "Abbreviation table used for IDLWAVE mode." + :enable-function (lambda () (not (idlwave-quoted)))) (defun idlwave-define-abbrev (name expansion hook &optional noprefix table) + ;; FIXME: `table' is never passed. "Define-abbrev with backward compatibility. If NOPREFIX is non-nil, don't prepend prefix character. Installs into @@ -1605,8 +1581,8 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into expansion hook))) (condition-case nil - (apply 'define-abbrev (append args '(0 t))) - (error (apply 'define-abbrev args))))) + (apply #'define-abbrev (append args '(0 t))) + (error (apply #'define-abbrev args))))) (condition-case nil (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) @@ -1616,15 +1592,15 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into ;; ;; Templates ;; -(idlwave-define-abbrev "c" "" (idlwave-code-abbrev idlwave-case)) -(idlwave-define-abbrev "sw" "" (idlwave-code-abbrev idlwave-switch)) -(idlwave-define-abbrev "f" "" (idlwave-code-abbrev idlwave-for)) -(idlwave-define-abbrev "fu" "" (idlwave-code-abbrev idlwave-function)) -(idlwave-define-abbrev "pr" "" (idlwave-code-abbrev idlwave-procedure)) -(idlwave-define-abbrev "r" "" (idlwave-code-abbrev idlwave-repeat)) -(idlwave-define-abbrev "w" "" (idlwave-code-abbrev idlwave-while)) -(idlwave-define-abbrev "i" "" (idlwave-code-abbrev idlwave-if)) -(idlwave-define-abbrev "elif" "" (idlwave-code-abbrev idlwave-elif)) +(idlwave-define-abbrev "c" "" #'idlwave-case) +(idlwave-define-abbrev "sw" "" #'idlwave-switch) +(idlwave-define-abbrev "f" "" #'idlwave-for) +(idlwave-define-abbrev "fu" "" #'idlwave-function) +(idlwave-define-abbrev "pr" "" #'idlwave-procedure) +(idlwave-define-abbrev "r" "" #'idlwave-repeat) +(idlwave-define-abbrev "w" "" #'idlwave-while) +(idlwave-define-abbrev "i" "" #'idlwave-if) +(idlwave-define-abbrev "elif" "" #'idlwave-elif) ;; ;; Keywords, system functions, conversion routines ;; @@ -1639,15 +1615,15 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into (idlwave-define-abbrev "cc" "complex()" (idlwave-keyword-abbrev 1)) (idlwave-define-abbrev "cd" "double()" (idlwave-keyword-abbrev 1)) (idlwave-define-abbrev "e" "else" (idlwave-keyword-abbrev 0 t)) -(idlwave-define-abbrev "ec" "endcase" 'idlwave-show-begin) -(idlwave-define-abbrev "es" "endswitch" 'idlwave-show-begin) -(idlwave-define-abbrev "ee" "endelse" 'idlwave-show-begin) -(idlwave-define-abbrev "ef" "endfor" 'idlwave-show-begin) -(idlwave-define-abbrev "ei" "endif else if" 'idlwave-show-begin) -(idlwave-define-abbrev "el" "endif else" 'idlwave-show-begin) -(idlwave-define-abbrev "en" "endif" 'idlwave-show-begin) -(idlwave-define-abbrev "er" "endrep" 'idlwave-show-begin) -(idlwave-define-abbrev "ew" "endwhile" 'idlwave-show-begin) +(idlwave-define-abbrev "ec" "endcase" #'idlwave-show-begin) +(idlwave-define-abbrev "es" "endswitch" #'idlwave-show-begin) +(idlwave-define-abbrev "ee" "endelse" #'idlwave-show-begin) +(idlwave-define-abbrev "ef" "endfor" #'idlwave-show-begin) +(idlwave-define-abbrev "ei" "endif else if" #'idlwave-show-begin) +(idlwave-define-abbrev "el" "endif else" #'idlwave-show-begin) +(idlwave-define-abbrev "en" "endif" #'idlwave-show-begin) +(idlwave-define-abbrev "er" "endrep" #'idlwave-show-begin) +(idlwave-define-abbrev "ew" "endwhile" #'idlwave-show-begin) (idlwave-define-abbrev "g" "goto," (idlwave-keyword-abbrev 0 t)) (idlwave-define-abbrev "h" "help," (idlwave-keyword-abbrev 0)) (idlwave-define-abbrev "k" "keyword_set()" (idlwave-keyword-abbrev 1)) @@ -1695,15 +1671,15 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into (idlwave-define-abbrev "continue" "continue" (idlwave-keyword-abbrev 0 t) t) (idlwave-define-abbrev "do" "do" (idlwave-keyword-abbrev 0 t) t) (idlwave-define-abbrev "else" "else" (idlwave-keyword-abbrev 0 t) t) -(idlwave-define-abbrev "end" "end" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endcase" "endcase" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endelse" "endelse" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endfor" "endfor" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endif" "endif" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endrep" "endrep" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endswitch" "endswitch" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endwhi" "endwhi" 'idlwave-show-begin-check t) -(idlwave-define-abbrev "endwhile" "endwhile" 'idlwave-show-begin-check t) +(idlwave-define-abbrev "end" "end" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endcase" "endcase" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endelse" "endelse" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endfor" "endfor" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endif" "endif" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endrep" "endrep" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endswitch" "endswitch" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endwhi" "endwhi" #'idlwave-show-begin-check t) +(idlwave-define-abbrev "endwhile" "endwhile" #'idlwave-show-begin-check t) (idlwave-define-abbrev "eq" "eq" (idlwave-keyword-abbrev 0 t) t) (idlwave-define-abbrev "for" "for" (idlwave-keyword-abbrev 0 t) t) (idlwave-define-abbrev "function" "function" (idlwave-keyword-abbrev 0 t) t) @@ -1763,7 +1739,7 @@ The main features of this mode are Use \\[idlwave-fill-paragraph] to refill a paragraph inside a comment. The indentation of the second line of the paragraph relative to the first will be retained. Use - \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these + \\[auto-fill-mode] to toggle auto-fill mode for these comments. When the variable `idlwave-fill-comment-line-only' is nil, code can also be auto-filled and auto-indented. @@ -1861,7 +1837,7 @@ The main features of this mode are (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) (setq idlwave-startup-message nil) - (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) + (set (make-local-variable 'indent-line-function) #'idlwave-indent-and-action) (set (make-local-variable idlwave-comment-indent-function) #'idlwave-comment-hook) @@ -1875,7 +1851,7 @@ The main features of this mode are (setq abbrev-mode t) - (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) + (set (make-local-variable 'normal-auto-fill-function) #'idlwave-auto-fill) (setq comment-end "") (set (make-local-variable 'comment-multi-line) nil) (set (make-local-variable 'paragraph-separate) @@ -1886,26 +1862,27 @@ The main features of this mode are ;; ChangeLog (set (make-local-variable 'add-log-current-defun-function) - 'idlwave-current-routine-fullname) + #'idlwave-current-routine-fullname) ;; Set tag table list to use IDLTAGS as file name. (if (boundp 'tag-table-alist) - (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) + (add-to-list 'tag-table-alist '("\\.pro\\'" . "IDLTAGS"))) ;; Font-lock additions (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) (set (make-local-variable 'font-lock-mark-block-function) - 'idlwave-mark-subprogram) + #'idlwave-mark-subprogram) (set (make-local-variable 'font-lock-fontify-region-function) - 'idlwave-font-lock-fontify-region) + #'idlwave-font-lock-fontify-region) ;; Imenu setup - (set (make-local-variable 'imenu-create-index-function) - 'imenu-default-create-index-function) + ;;(set (make-local-variable 'imenu-create-index-function) + ;; ;; FIXME: Why set it explicitly to the value it already has? + ;; #'imenu-default-create-index-function) (set (make-local-variable 'imenu-extract-index-name-function) - 'idlwave-unit-name) + #'idlwave-unit-name) (set (make-local-variable 'imenu-prev-index-position-function) - 'idlwave-prev-index-position) + #'idlwave-prev-index-position) ;; HideShow setup (add-to-list 'hs-special-modes-alist @@ -1916,12 +1893,12 @@ The main features of this mode are 'idlwave-forward-block nil)) ;; Make a local post-command-hook and add our hook to it - (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) + (add-hook 'post-command-hook #'idlwave-command-hook nil 'local) ;; Make local hooks for buffer updates - (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) - (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) - (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) + (add-hook 'kill-buffer-hook #'idlwave-kill-buffer-update nil 'local) + (add-hook 'after-save-hook #'idlwave-save-buffer-update nil 'local) + (add-hook 'after-save-hook #'idlwave-revoke-license-to-kill nil 'local) ;; Setup directories and file, if necessary (idlwave-setup) @@ -1974,29 +1951,27 @@ The main features of this mode are ;;; This stuff is experimental -(defvar idlwave-command-hook nil - "If non-nil, a list that can be evaluated using `eval'. +(defvar idlwave--command-function nil + "If non-nil, a function called from `post-command-hook'. It is evaluated in the lisp function `idlwave-command-hook' which is placed in `post-command-hook'.") (defun idlwave-command-hook () "Command run after every command. -Evaluates a non-nil value of the *variable* `idlwave-command-hook' and +Evaluates a non-nil value of the *variable* `idlwave--command-function' and sets the variable to zero afterwards." - (and idlwave-command-hook - (listp idlwave-command-hook) - (condition-case nil - (eval idlwave-command-hook) - (error nil))) - (setq idlwave-command-hook nil)) + (and idlwave--command-function + (with-demoted-errors "idlwave-command-hook: %S" + (funcall (prog1 idlwave--command-function + (setq idlwave--command-function nil)))))) ;;; End experiment ;; It would be better to use expand.el for better abbrev handling and ;; versatility. -(defun idlwave-check-abbrev (arg &optional reserved) - "Reverse abbrev expansion if in comment or string. +(defun idlwave-modify-abbrev (arg &optional reserved) + "Tweak the abbrev we just expanded. Argument ARG is the number of characters to move point backward if `idlwave-abbrev-move' is non-nil. If optional argument RESERVED is non-nil then the expansion @@ -2006,21 +1981,16 @@ Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case' is non-nil, unless its value is `down' in which case the abbrev will be made into all lowercase. Returns non-nil if abbrev is left expanded." - (if (idlwave-quoted) - (progn (unexpand-abbrev) - nil) - (if (and reserved idlwave-reserved-word-upcase) - (upcase-region last-abbrev-location (point)) - (cond - ((equal idlwave-abbrev-change-case 'down) - (downcase-region last-abbrev-location (point))) - (idlwave-abbrev-change-case - (upcase-region last-abbrev-location (point))))) - (if (and idlwave-abbrev-move (> arg 0)) - (if (boundp 'post-command-hook) - (setq idlwave-command-hook (list 'backward-char (1+ arg))) - (backward-char arg))) - t)) + (if (and reserved idlwave-reserved-word-upcase) + (upcase-region last-abbrev-location (point)) + (cond + ((equal idlwave-abbrev-change-case 'down) + (downcase-region last-abbrev-location (point))) + (idlwave-abbrev-change-case + (upcase-region last-abbrev-location (point))))) + (if (and idlwave-abbrev-move (> arg 0)) + (setq idlwave--command-function (lambda () (backward-char (1+ arg))))) + t) (defun idlwave-in-comment () "Return t if point is inside a comment, nil otherwise." @@ -2047,7 +2017,7 @@ Returns point if comment found and nil otherwise." (backward-char 1) (point))))) -(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1") +(define-obsolete-function-alias 'idlwave-region-active-p #'use-region-p "28.1") (defun idlwave-show-matching-quote () "Insert quote and show matching quote if this is end of a string." @@ -2067,13 +2037,12 @@ Returns point if comment found and nil otherwise." (defun idlwave-show-begin-check () "Ensure that the previous word was a token before `idlwave-show-begin'. An END token must be preceded by whitespace." - (if (not (idlwave-quoted)) - (if - (save-excursion - (backward-word-strictly 1) - (backward-char 1) - (looking-at "[ \t\n\f]")) - (idlwave-show-begin)))) + (if + (save-excursion + (backward-word-strictly 1) + (backward-char 1) + (looking-at "[ \t\n\f]")) + (idlwave-show-begin))) (defun idlwave-show-begin () "Find the start of current block and blinks to it for a second. @@ -2088,7 +2057,7 @@ Also checks if the correct END statement has been used." begin-pos end-pos end end1 ) (if idlwave-reindent-end (idlwave-indent-line)) (setq last-abbrev-location (marker-position last-abbrev-marker)) - (when (and (idlwave-check-abbrev 0 t) + (when (and (idlwave-modify-abbrev 0 t) idlwave-show-block) (save-excursion ;; Move inside current block @@ -2178,11 +2147,11 @@ Also checks if the correct END statement has been used." (next-char (char-after (point))) (method-invoke (and gtr (eq prev-char ?-))) (len (if method-invoke 2 1))) - (unless (eq next-char ?=) + (unless (eq next-char ?=) ;; Key binding: pad only on left, to save for possible >=/<= (idlwave-surround -1 (if (or is-action method-invoke) -1) len)))) -(defun idlwave-surround (&optional before after length is-action) +(defun idlwave-surround (&optional before after length _is-action) "Surround the LENGTH characters before point with blanks. LENGTH defaults to 1. Optional arguments BEFORE and AFTER affect the behavior before and @@ -2641,7 +2610,7 @@ statement." (if st (append st (match-end 0)))))) -(defun idlwave-expand-equal (&optional before after is-action) +(defun idlwave-expand-equal (&optional before after _is-action) "Pad `=' with spaces. Two cases: Assignment statement, and keyword assignment. Which case is determined using `idlwave-start-of-substatement' and @@ -2749,10 +2718,10 @@ If the optional argument EXPAND is non-nil then the actions in ;; Before indenting, run action routines. ;; (if (and expand idlwave-do-actions) - (mapc 'idlwave-do-action idlwave-indent-expand-table)) + (mapc #'idlwave-do-action idlwave-indent-expand-table)) ;; (if idlwave-do-actions - (mapc 'idlwave-do-action idlwave-indent-action-table)) + (mapc #'idlwave-do-action idlwave-indent-action-table)) ;; ;; No longer expand abbrevs on the line. The user can do this ;; manually using expand-region-abbrevs. @@ -2781,18 +2750,19 @@ If the optional argument EXPAND is non-nil then the actions in (defun idlwave-do-action (action) "Perform an action repeatedly on a line. ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is -either a function name to be called with `funcall' or a list to be -evaluated with `eval'. The action performed by FUNC should leave -point after the match for REG - otherwise an infinite loop may be -entered. FUNC is always passed a final argument of `is-action', so it +either a function which will be called with one argument `is-action' or +a list to be evaluated with `eval'. +The action performed by FUNC should leave point after the match for REG +- otherwise an infinite loop may be entered. +FUNC is always passed a final argument of `is-action', so it can discriminate between being run as an action, or a key binding." (let ((action-key (car action)) (action-routine (cdr action))) (beginning-of-line) (while (idlwave-look-at action-key) - (if (listp action-routine) - (eval (append action-routine '('is-action))) - (funcall action-routine 'is-action))))) + (if (functionp action-routine) + (funcall action-routine 'is-action) + (eval (append action-routine '('is-action)) t))))) (defun idlwave-indent-to (col &optional min) "Indent from point with spaces until column COL. @@ -3053,7 +3023,7 @@ Return value is the beginning of the match or (in case of failure) nil." (let ((case-fold-search t) (search-func (if (> dir 0) 're-search-forward 're-search-backward)) found) - (idlwave-with-special-syntax + (with-syntax-table idlwave-find-symbol-syntax-table (save-excursion (catch 'exit (while (funcall search-func key-re limit t) @@ -3181,7 +3151,7 @@ If successful leaves point after the match, otherwise, does not move point." (if cont (idlwave-end-of-statement) (end-of-line)) (point))) found) - (idlwave-with-special-syntax + (with-syntax-table idlwave-find-symbol-syntax-table (if beg (idlwave-beginning-of-statement)) (while (and (setq found (re-search-forward regexp eos t)) (idlwave-quoted)))) @@ -3465,25 +3435,7 @@ if `idlwave-auto-fill-split-string' is non-nil." (idlwave-indent-line)) ))))) -(defun idlwave-auto-fill-mode (arg) - "Toggle auto-fill mode for IDL mode. -With arg, turn auto-fill mode on if arg is positive. -In auto-fill mode, inserting a space at a column beyond `fill-column' -automatically breaks the line at a previous space." - (interactive "P") - (prog1 (set idlwave-fill-function - (if (if (null arg) - (not (symbol-value idlwave-fill-function)) - (> (prefix-numeric-value arg) 0)) - 'idlwave-auto-fill - nil)) - ;; update mode-line - (set-buffer-modified-p (buffer-modified-p)))) - -;(defun idlwave-fill-routine-call () -; "Fill a routine definition or statement, indenting appropriately." -; (let ((where (idlwave-where))))) - +(define-obsolete-function-alias 'idlwave-auto-fill-mode #'auto-fill-mode "28.1") (defun idlwave-doc-header (&optional nomark) "Insert a documentation header at the beginning of the unit. @@ -3578,6 +3530,7 @@ Calling from a program, arguments are START END." (defun idlwave-quoted () "Return t if point is in a comment or quoted string. Returns nil otherwise." + ;; FIXME: Use (nth 8 (synx-ppss))! (and (or (idlwave-in-comment) (idlwave-in-quote)) t)) (defun idlwave-in-quote () @@ -3858,7 +3811,7 @@ Intended for `after-save-hook'." (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers))) ;; Remove this function from the hook. - (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) + (remove-hook 'after-save-hook #'idlwave-revoke-license-to-kill 'local))) (defvar idlwave-path-alist) (defun idlwave-locate-lib-file (file) @@ -4098,10 +4051,10 @@ blank lines." (set (idlwave-sintern-set name 'class idlwave-sint-classes set)) (name))) -(defun idlwave-sintern-dir (dir &optional set) +(defun idlwave-sintern-dir (dir &optional _set) (car (or (member dir idlwave-sint-dirs) (setq idlwave-sint-dirs (cons dir idlwave-sint-dirs))))) -(defun idlwave-sintern-libname (name &optional set) +(defun idlwave-sintern-libname (name &optional _set) (car (or (member name idlwave-sint-libnames) (setq idlwave-sint-libnames (cons name idlwave-sint-libnames))))) @@ -4169,7 +4122,7 @@ the base of the directory." ;; Creating new sintern tables -(defun idlwave-new-sintern-type (tag) +(defmacro idlwave-new-sintern-type (tag) "Define a variable and a function to sintern the new type TAG. This defines the function `idlwave-sintern-TAG' and the variable `idlwave-sint-TAGs'." @@ -4177,15 +4130,15 @@ This defines the function `idlwave-sintern-TAG' and the variable (names (concat name "s")) (var (intern (concat "idlwave-sint-" names))) (func (intern (concat "idlwave-sintern-" name)))) - (set var nil) ; initial value of the association list - (fset func ; set the function - `(lambda (name &optional set) - (cond ((not (stringp name)) name) - ((cdr (assoc (downcase name) ,var))) - (set - (setq ,var (cons (cons (downcase name) name) ,var)) - name) - (name)))))) + `(progn + (defvar ,var nil) ; initial value of the association list + (defun ,func (name &optional set) + (cond ((not (stringp name)) name) + ((cdr (assoc (downcase name) ,var))) + (set + (push (cons (downcase name) name) ,var) + name) + (name)))))) (defun idlwave-reset-sintern-type (tag) "Reset the sintern variable associated with TAG." @@ -4296,12 +4249,12 @@ will re-read the catalog." "-l" (expand-file-name "~/.emacs") "-l" "idlwave" "-f" "idlwave-rescan-catalog-directories")) - (process (apply 'start-process "idlcat" + (process (apply #'start-process "idlcat" nil emacs args))) (setq idlwave-catalog-process process) (set-process-sentinel process - (lambda (pro why) + (lambda (_pro why) (when (string-match "finished" why) (setq idlwave-routines nil idlwave-system-routines nil @@ -4449,7 +4402,7 @@ information updated immediately, leave NO-CONCATENATE nil." (setq idlwave-load-rinfo-idle-timer (run-with-idle-timer idlwave-init-rinfo-when-idle-after - nil 'idlwave-load-rinfo-next-step))) + nil #'idlwave-load-rinfo-next-step))) (error nil)))) ;;------ XML Help routine info system @@ -4935,7 +4888,7 @@ Cache to disk for quick recovery." (setq idlwave-load-rinfo-idle-timer (run-with-idle-timer idlwave-init-rinfo-when-idle-after - nil 'idlwave-load-rinfo-next-step)))))) + nil #'idlwave-load-rinfo-next-step)))))) (defvar idlwave-after-load-rinfo-hook nil) @@ -5109,7 +5062,7 @@ Can run from `after-save-hook'." (error nil))) (push res routine-lists))))) ;; Concatenate the individual lists and return the result - (apply 'nconc routine-lists))) + (apply #'nconc routine-lists))) (defun idlwave-get-buffer-routine-info () "Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)." @@ -5185,10 +5138,10 @@ Can run from `after-save-hook'." (if args (concat (if (string= type "function") "(" ", ") - (mapconcat 'identity args ", ") + (mapconcat #'identity args ", ") (if (string= type "function") ")" "")))) (if keywords - (cons nil (mapcar 'list keywords)) ;No help file + (cons nil (mapcar #'list keywords)) ;No help file nil)))) @@ -5246,7 +5199,7 @@ as last time - so no widget will pop up." (cons x (cdr path-entry)) (list x)))) (idlwave-expand-path idlwave-library-path)) - (mapcar 'list (idlwave-expand-path idlwave-library-path))))) + (mapcar #'list (idlwave-expand-path idlwave-library-path))))) ;; Ask the shell for the path and then run the widget (t @@ -5314,7 +5267,7 @@ directories and save the routine info. (widget-insert " ") (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _ignore) (let ((path-list (widget-get idlwave-widget :path-dirs))) (dolist (x path-list) (unless (memq 'lib (cdr x)) @@ -5324,7 +5277,7 @@ directories and save the routine info. (widget-insert " ") (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _ignore) (let ((path-list (widget-get idlwave-widget :path-dirs))) (dolist (x path-list) (idlwave-path-alist-remove-flag x 'user)) @@ -5332,7 +5285,7 @@ directories and save the routine info. "Deselect All") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (kill-buffer (current-buffer))) "Quit") (widget-insert "\n\n") @@ -5340,7 +5293,7 @@ directories and save the routine info. (widget-insert "Select Directories: \n") (setq idlwave-widget - (apply 'widget-create + (apply #'widget-create 'checklist :value (delq nil (mapcar (lambda (x) (if (memq 'user (cdr x)) @@ -5352,7 +5305,8 @@ directories and save the routine info. (list 'item (if (memq 'lib (cdr x)) (concat "[LIB] " (car x) ) - (car x)))) dirs-list))) + (car x)))) + dirs-list))) (widget-put idlwave-widget :path-dirs dirs-list) (widget-insert "\n") (use-local-map widget-keymap) @@ -5360,14 +5314,14 @@ directories and save the routine info. (goto-char (point-min)) (delete-other-windows)) -(defun idlwave-delete-user-catalog-file (&rest ignore) +(defun idlwave-delete-user-catalog-file (&rest _ignore) (if (yes-or-no-p (format "Delete file %s " idlwave-user-catalog-file)) (progn (delete-file idlwave-user-catalog-file) (message "%s has been deleted" idlwave-user-catalog-file)))) -(defun idlwave-widget-scan-user-lib-files (&rest ignore) +(defun idlwave-widget-scan-user-lib-files (&rest _ignore) ;; Call `idlwave-scan-user-lib-files' with data taken from the widget. (let* ((widget idlwave-widget) (selected-dirs (widget-value widget)) @@ -5517,7 +5471,7 @@ be set to nil to disable library catalog scanning." (let ((dirs (if idlwave-library-path (idlwave-expand-path idlwave-library-path) - (mapcar 'car idlwave-path-alist))) + (mapcar #'car idlwave-path-alist))) (old-libname "") dir-entry dir catalog all-routines) (if message-base (message "%s" message-base)) @@ -5730,11 +5684,10 @@ end (defvar idlwave-completion-help-info nil) (defvar idlwave-completion-help-links nil) (defvar idlwave-current-obj_new-class nil) -(defvar idlwave-complete-special nil) -(defvar method-selector) -(defvar class-selector) -(defvar type-selector) -(defvar super-classes) +(defvar idlwave--method-selector) +(defvar idlwave--class-selector) +(defvar idlwave--type-selector) +(defvar idlwave--super-classes) (defun idlwave-complete (&optional arg module class) "Complete a function, procedure or keyword name at point. @@ -5815,8 +5768,7 @@ When we force a method or a method keyword, CLASS can specify the class." (idlwave-complete-filename)) ;; Check for any special completion functions - ((and idlwave-complete-special - (idlwave-call-special idlwave-complete-special))) + ((run-hook-with-args-until-success 'idlwave-complete-functions)) ((null what) (error "Nothing to complete here")) @@ -5829,22 +5781,26 @@ When we force a method or a method keyword, CLASS can specify the class." ((eq what 'procedure) ;; Complete a procedure name (let* ((cw-list (nth 3 where-list)) - (class-selector (idlwave-determine-class cw-list 'pro)) - (super-classes (unless (idlwave-explicit-class-listed cw-list) - (idlwave-all-class-inherits class-selector))) - (isa (concat "procedure" (if class-selector "-method" ""))) - (type-selector 'pro)) + (idlwave--class-selector (idlwave-determine-class cw-list 'pro)) + (idlwave--super-classes + (unless (idlwave-explicit-class-listed cw-list) + (idlwave-all-class-inherits idlwave--class-selector))) + (isa (concat "procedure" + (if idlwave--class-selector "-method" ""))) + (idlwave--type-selector 'pro)) (setq idlwave-completion-help-info - (list 'routine nil type-selector class-selector nil super-classes)) + (list 'routine nil + idlwave--type-selector idlwave--class-selector + nil idlwave--super-classes)) (idlwave-complete-in-buffer - 'procedure (if class-selector 'method 'routine) + 'procedure (if idlwave--class-selector 'method 'routine) (idlwave-routines) 'idlwave-selector (format "Select a %s name%s" isa - (if class-selector + (if idlwave--class-selector (format " (class is %s)" - (if (eq class-selector t) - "unknown" class-selector)) + (if (eq idlwave--class-selector t) + "unknown" idlwave--class-selector)) "")) isa 'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) @@ -5852,22 +5808,25 @@ When we force a method or a method keyword, CLASS can specify the class." ((eq what 'function) ;; Complete a function name (let* ((cw-list (nth 3 where-list)) - (class-selector (idlwave-determine-class cw-list 'fun)) - (super-classes (unless (idlwave-explicit-class-listed cw-list) - (idlwave-all-class-inherits class-selector))) - (isa (concat "function" (if class-selector "-method" ""))) - (type-selector 'fun)) + (idlwave--class-selector (idlwave-determine-class cw-list 'fun)) + (idlwave--super-classes + (unless (idlwave-explicit-class-listed cw-list) + (idlwave-all-class-inherits idlwave--class-selector))) + (isa (concat "function" (if idlwave--class-selector "-method" ""))) + (idlwave--type-selector 'fun)) (setq idlwave-completion-help-info - (list 'routine nil type-selector class-selector nil super-classes)) + (list 'routine nil + idlwave--type-selector idlwave--class-selector + nil idlwave--super-classes)) (idlwave-complete-in-buffer - 'function (if class-selector 'method 'routine) + 'function (if idlwave--class-selector 'method 'routine) (idlwave-routines) 'idlwave-selector (format "Select a %s name%s" isa - (if class-selector + (if idlwave--class-selector (format " (class is %s)" - (if (eq class-selector t) - "unknown" class-selector)) + (if (eq idlwave--class-selector t) + "unknown" idlwave--class-selector)) "")) isa 'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) @@ -5880,11 +5839,12 @@ When we force a method or a method keyword, CLASS can specify the class." ;; Complete a procedure keyword (let* ((where (nth 3 where-list)) (name (car where)) - (method-selector name) - (type-selector 'pro) + (idlwave--method-selector name) + (idlwave--type-selector 'pro) (class (idlwave-determine-class where 'pro)) - (class-selector class) - (super-classes (idlwave-all-class-inherits class-selector)) + (idlwave--class-selector class) + (idlwave--super-classes (idlwave-all-class-inherits + idlwave--class-selector)) (isa (format "procedure%s-keyword" (if class "-method" ""))) (entry (idlwave-best-rinfo-assq name 'pro class (idlwave-routines))) @@ -5894,11 +5854,13 @@ When we force a method or a method keyword, CLASS can specify the class." (error "Nothing known about procedure %s" (idlwave-make-full-name class name))) (setq list (idlwave-fix-keywords name 'pro class list - super-classes system)) + idlwave--super-classes system)) (unless list (error "No keywords available for procedure %s" (idlwave-make-full-name class name))) (setq idlwave-completion-help-info - (list 'keyword name type-selector class-selector entry super-classes)) + (list 'keyword name + idlwave--type-selector idlwave--class-selector + entry idlwave--super-classes)) (idlwave-complete-in-buffer 'keyword 'keyword list nil (format "Select keyword for procedure %s%s" @@ -5913,11 +5875,12 @@ When we force a method or a method keyword, CLASS can specify the class." ;; Complete a function keyword (let* ((where (nth 3 where-list)) (name (car where)) - (method-selector name) - (type-selector 'fun) + (idlwave--method-selector name) + (idlwave--type-selector 'fun) (class (idlwave-determine-class where 'fun)) - (class-selector class) - (super-classes (idlwave-all-class-inherits class-selector)) + (idlwave--class-selector class) + (idlwave--super-classes (idlwave-all-class-inherits + idlwave--class-selector)) (isa (format "function%s-keyword" (if class "-method" ""))) (entry (idlwave-best-rinfo-assq name 'fun class (idlwave-routines))) @@ -5928,7 +5891,7 @@ When we force a method or a method keyword, CLASS can specify the class." (error "Nothing known about function %s" (idlwave-make-full-name class name))) (setq list (idlwave-fix-keywords name 'fun class list - super-classes system)) + idlwave--super-classes system)) ;; OBJ_NEW: Messages mention the proper Init method (setq msg-name (if (and (null class) (string= (upcase name) "OBJ_NEW")) @@ -5938,7 +5901,9 @@ When we force a method or a method keyword, CLASS can specify the class." (unless list (error "No keywords available for function %s" msg-name)) (setq idlwave-completion-help-info - (list 'keyword name type-selector class-selector nil super-classes)) + (list 'keyword name + idlwave--type-selector idlwave--class-selector + nil idlwave--super-classes)) (idlwave-complete-in-buffer 'keyword 'keyword list nil (format "Select keyword for function %s%s" msg-name @@ -5950,7 +5915,9 @@ When we force a method or a method keyword, CLASS can specify the class." (t (error "This should not happen (idlwave-complete)"))))) -(defvar idlwave-complete-special nil +(define-obsolete-variable-alias 'idlwave-complete-special + 'idlwave-complete-functions "28.1") +(defvar idlwave-complete-functions nil "List of special completion functions. These functions are called for each completion. Each function must check if its own special completion context is present. If yes, it @@ -5960,6 +5927,7 @@ complete other contexts will be done. If the function returns nil, other completions will be tried.") (defun idlwave-call-special (functions &rest args) + (declare (obsolete run-hook-with-args-until-success "28.1")) (let ((funcs functions) fun ret) (catch 'exit @@ -6002,9 +5970,9 @@ other completions will be tried.") (list nil-list nil-list 'procedure nil-list nil)) ((eq what 'procedure-keyword) - (let* ((class-selector nil) - (super-classes nil) - (type-selector 'pro) + (let* ((idlwave--class-selector nil) + (idlwave--super-classes nil) + (idlwave--type-selector 'pro) (pro (or module (idlwave-completing-read "Procedure: " (idlwave-routines) 'idlwave-selector)))) @@ -6016,9 +5984,9 @@ other completions will be tried.") (list nil-list nil-list 'function nil-list nil)) ((eq what 'function-keyword) - (let* ((class-selector nil) - (super-classes nil) - (type-selector 'fun) + (let* ((idlwave--class-selector nil) + (idlwave--super-classes nil) + (idlwave--type-selector 'fun) (func (or module (idlwave-completing-read "Function: " (idlwave-routines) 'idlwave-selector)))) @@ -6031,12 +5999,14 @@ other completions will be tried.") ((eq what 'procedure-method-keyword) (let* ((class (idlwave-determine-class class-list 'pro)) - (class-selector class) - (super-classes (idlwave-all-class-inherits class-selector)) - (type-selector 'pro) + (idlwave--class-selector class) + (idlwave--super-classes (idlwave-all-class-inherits + idlwave--class-selector)) + (idlwave--type-selector 'pro) (pro (or module (idlwave-completing-read - (format "Procedure in %s class: " class-selector) + (format "Procedure in %s class: " + idlwave--class-selector) (idlwave-routines) 'idlwave-selector)))) (setq pro (idlwave-sintern-method pro)) (list nil-list nil-list 'procedure-keyword @@ -6047,12 +6017,14 @@ other completions will be tried.") ((eq what 'function-method-keyword) (let* ((class (idlwave-determine-class class-list 'fun)) - (class-selector class) - (super-classes (idlwave-all-class-inherits class-selector)) - (type-selector 'fun) + (idlwave--class-selector class) + (idlwave--super-classes (idlwave-all-class-inherits + idlwave--class-selector)) + (idlwave--type-selector 'fun) (func (or module (idlwave-completing-read - (format "Function in %s class: " class-selector) + (format "Function in %s class: " + idlwave--class-selector) (idlwave-routines) 'idlwave-selector)))) (setq func (idlwave-sintern-method func)) (list nil-list nil-list 'function-keyword @@ -6069,14 +6041,14 @@ other completions will be tried.") (unwind-protect (progn (setq-default completion-ignore-case t) - (apply 'completing-read args)) + (apply #'completing-read args)) (setq-default completion-ignore-case old-value)))) (defvar idlwave-shell-default-directory) (defun idlwave-complete-filename () "Use the comint stuff to complete a file name." (require 'comint) - (let* ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-") + (dlet ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-") (comint-completion-addsuffix nil) (default-directory (if (and (boundp 'idlwave-shell-default-directory) @@ -6110,7 +6082,7 @@ other completions will be tried.") (defun idlwave-rinfo-assq-any-class (name type class list) ;; Return the first matching method on the inheritance list (let* ((classes (cons class (idlwave-all-class-inherits class))) - class rtn) + rtn) ;; class (while classes (if (setq rtn (idlwave-rinfo-assq name type (pop classes) list)) (setq classes nil))) @@ -6127,7 +6099,7 @@ syslib files." list)) syslibp) (when (> (length twins) 1) - (setq twins (sort twins 'idlwave-routine-entry-compare-twins)) + (setq twins (sort twins #'idlwave-routine-entry-compare-twins)) (if (and (null keep-system) (eq 'system (car (nth 3 (car twins)))) (setq syslibp (idlwave-any-syslib (cdr twins))) @@ -6174,7 +6146,7 @@ If yes, return the index (>=1)." TYPE is `fun' or `pro'. When TYPE is not specified, both procedures and functions will be considered." (if (null method) - (mapcar 'car (idlwave-class-alist)) + (mapcar #'car (idlwave-class-alist)) (let (rtn) (mapc (lambda (x) (and (nth 2 x) @@ -6228,9 +6200,11 @@ INFO is as returned by `idlwave-what-function' or `-procedure'." (save-excursion (goto-char apos) (looking-at "->[a-zA-Z][a-zA-Z0-9$_]*::"))))) -(defvar idlwave-determine-class-special nil - "List of special functions for determining class. -Must accept two arguments: `apos' and `info'.") +(define-obsolete-variable-alias 'idlwave-determine-class-special + 'idlwave-determine-class-functions "28.1") +(defvar idlwave-determine-class-functions nil + "Special hook to determine a class. +The functions should accept one argument, APOS.") (defun idlwave-determine-class (info type) ;; Determine the class of a routine call. @@ -6275,10 +6249,10 @@ Must accept two arguments: `apos' and `info'.") ;; Before prompting, try any special class determination routines (when (and (eq t class) - idlwave-determine-class-special (not force-query)) (setq special-class - (idlwave-call-special idlwave-determine-class-special apos)) + (run-hook-with-args-until-success + 'idlwave-determine-class-functions apos)) (if special-class (setq class (idlwave-sintern-class special-class) store idlwave-store-inquired-class))) @@ -6287,7 +6261,7 @@ Must accept two arguments: `apos' and `info'.") (when (and (eq class t) (or force-query query)) (setq class-alist - (mapcar 'list (idlwave-all-method-classes (car info) type))) + (mapcar #'list (idlwave-all-method-classes (car info) type))) (setq class (idlwave-sintern-class (cond @@ -6321,10 +6295,10 @@ Must accept two arguments: `apos' and `info'.") (t class)))) (defun idlwave-selector (a) - (and (eq (nth 1 a) type-selector) - (or (and (nth 2 a) (eq class-selector t)) - (eq (nth 2 a) class-selector) - (memq (nth 2 a) super-classes)))) + (and (eq (nth 1 a) idlwave--type-selector) + (or (and (nth 2 a) (eq idlwave--class-selector t)) + (eq (nth 2 a) idlwave--class-selector) + (memq (nth 2 a) idlwave--super-classes)))) (defun idlwave-add-file-link-selector (a) ;; Record a file link, if any, for the tested names during selection. @@ -6442,7 +6416,7 @@ ARROW: Location of the arrow" func-point (cnt 0) func arrow-start class) - (idlwave-with-special-syntax + (with-syntax-table idlwave-find-symbol-syntax-table (save-restriction (save-excursion (narrow-to-region (max 1 (or bound 0)) (point-max)) @@ -6472,7 +6446,7 @@ ARROW: Location of the arrow" (goto-char pos)) (throw 'exit nil))))))) -(defun idlwave-what-procedure (&optional bound) +(defun idlwave-what-procedure (&optional _bound) ;; Find out if point is within the argument list of a procedure. ;; The return value is ("procedure-name" class arrow-pos (point)). @@ -6562,10 +6536,10 @@ This function is not general, can only be used for completion stuff." (throw 'exit nil))) (t (throw 'exit (preceding-char)))))))) -(defvar idlwave-complete-after-success-form nil - "A form to evaluate after successful completion.") -(defvar idlwave-complete-after-success-form-force nil - "A form to evaluate after completion selection in *Completions* buffer.") +(defvar idlwave--complete-after-success-function #'ignore + "A function to evaluate after successful completion.") +(defvar idlwave--complete-after-success-force-function #'ignore + "A function to evaluate after completion selection in *Completions* buffer.") (defconst idlwave-completion-mark (make-marker) "A mark pointing to the beginning of the completion string.") @@ -6590,12 +6564,12 @@ accumulate information on matching completions." (skip-chars-backward "a-zA-Z0-9_$") (setq slash (eq (preceding-char) ?/) beg (point) - idlwave-complete-after-success-form - (list 'idlwave-after-successful-completion - (list 'quote type) slash beg) - idlwave-complete-after-success-form-force - (list 'idlwave-after-successful-completion - (list 'quote type) slash (list 'quote 'force)))) + idlwave--complete-after-success-function + (lambda () (idlwave-after-successful-completion + type slash beg)) + idlwave--complete-after-success-force-function + (lambda () (idlwave-after-successful-completion + type slash 'force)))) ;; Try a completion (setq part (buffer-substring beg end) @@ -6699,19 +6673,20 @@ accumulate information on matching completions." ;; 'class-tag, for class tags, and otherwise for methods. ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. (if (or (null show-classes) ; don't want to see classes - (null class-selector) ; not a method call + (null idlwave--class-selector) ; not a method call (and - (stringp class-selector) ; the class is already known - (not super-classes))) ; no possibilities for inheritance + (stringp idlwave--class-selector) ; the class is already known + (not idlwave--super-classes))) ; no possibilities for inheritance ;; In these cases, we do not have to do anything list (let* ((do-prop (>= show-classes 0)) (do-buf (not (= show-classes 0))) - (do-dots t) - (inherit (if (and (not (eq type 'class-tag)) super-classes) - (cons class-selector super-classes))) + ;; (do-dots t) + (inherit (if (and (not (eq type 'class-tag)) idlwave--super-classes) + (cons idlwave--class-selector idlwave--super-classes))) (max (abs show-classes)) - (lmax (if do-dots (apply 'max (mapcar 'length list)))) + (lmax ;; (if do-dots + (apply #'max (mapcar #'length list))) ;;) classes nclasses class-info space) (mapcar (lambda (x) @@ -6720,13 +6695,14 @@ accumulate information on matching completions." ;; Just one class for tags (setq classes (list - (idlwave-class-or-superclass-with-tag class-selector x))) + (idlwave-class-or-superclass-with-tag + idlwave--class-selector x))) ;; Multiple classes for method or method-keyword (setq classes (if (eq type 'kwd) (idlwave-all-method-keyword-classes - method-selector x type-selector) - (idlwave-all-method-classes x type-selector))) + idlwave--method-selector x idlwave--type-selector) + (idlwave-all-method-classes x idlwave--type-selector))) (if inherit (setq classes (delq nil @@ -6734,22 +6710,22 @@ accumulate information on matching completions." classes))))) (setq nclasses (length classes)) ;; Make the separator between item and class-info - (if do-dots - (setq space (concat " " (make-string (- lmax (length x)) ?.))) - (setq space " ")) + ;; (if do-dots + (setq space (concat " " (make-string (- lmax (length x)) ?.))) + ;; (setq space " ")) (if do-buf ;; We do want info in the buffer (if (<= nclasses max) (setq class-info (concat space - "<" (mapconcat 'identity classes ",") ">")) + "<" (mapconcat #'identity classes ",") ">")) (setq class-info (format "%s<%d classes>" space nclasses))) (setq class-info nil)) (when do-prop ;; We do want properties (setq x (copy-sequence x)) (put-text-property 0 (length x) - 'help-echo (mapconcat 'identity classes " ") + 'help-echo (mapconcat #'identity classes " ") x)) (if class-info (list x class-info) @@ -6839,7 +6815,7 @@ sort the list before displaying." (nth 2 last-command)) (progn (select-window win) - (eval idlwave-complete-after-success-form)) + (funcall idlwave--complete-after-success-function)) (set-window-start cwin (point-min))))) (and message (message "%s" message))) (select-window win)))) @@ -6882,7 +6858,7 @@ sort the list before displaying." (skip-chars-backward "a-zA-Z0-9_") (point)))) (remove-text-properties beg (point) '(face nil)))) - (eval idlwave-complete-after-success-form-force)) + (funcall idlwave--complete-after-success-force-function)) (defun idlwave-keyboard-quit () (interactive) @@ -6990,16 +6966,15 @@ If these don't exist, a letter in the string is automatically selected." (defun idlwave-local-value (var &optional buffer) "Return the value of VAR in BUFFER, but only if VAR is local to BUFFER." - (with-current-buffer (or buffer (current-buffer)) - (and (local-variable-p var (current-buffer)) - (symbol-value var)))) + (when (local-variable-p var buffer) + (buffer-local-value var (or buffer (current-buffer))))) (defvar idlwave-completion-map nil "Keymap for `completion-list-mode' with `idlwave-complete'.") -(defun idlwave-default-choose-completion (&rest args) - "Execute `default-choose-completion' and then restore the win-conf." - (apply 'idlwave-choose 'default-choose-completion args)) +;; (defun idlwave-default-choose-completion (&rest args) +;; "Execute `default-choose-completion' and then restore the win-conf." +;; (apply #'idlwave-choose #'default-choose-completion args)) (define-obsolete-function-alias 'idlwave-display-completion-list-emacs #'idlwave-display-completion-list-1 "28.1") @@ -7021,14 +6996,14 @@ If these don't exist, a letter in the string is automatically selected." "Replace `choose-completion' in OLD-MAP." (let ((new-map (copy-keymap old-map))) (substitute-key-definition - 'choose-completion 'idlwave-choose-completion new-map) - (define-key new-map [mouse-3] 'idlwave-mouse-completion-help) + #'choose-completion #'idlwave-choose-completion new-map) + (define-key new-map [mouse-3] #'idlwave-mouse-completion-help) new-map)) (defun idlwave-choose-completion (&rest args) "Choose the completion that point is in or next to." (interactive (list last-nonmenu-event)) - (apply 'idlwave-choose 'choose-completion args)) + (apply #'idlwave-choose #'choose-completion args)) (define-obsolete-function-alias 'idlwave-mouse-choose-completion #'idlwave-choose-completion "28.1") @@ -7278,8 +7253,8 @@ class/struct definition." (defun idlwave-all-class-tags (class) "Return a list of native and inherited tags in CLASS." (condition-case err - (apply 'append (mapcar 'idlwave-class-tags - (cons class (idlwave-all-class-inherits class)))) + (apply #'append (mapcar #'idlwave-class-tags + (cons class (idlwave-all-class-inherits class)))) (error (idlwave-class-tag-reset) (error "%s" (error-message-string err))))) @@ -7369,10 +7344,9 @@ property indicating the link is added." (defvar idlwave-current-class-tags nil) (defvar idlwave-current-native-class-tags nil) (defvar idlwave-sint-class-tags nil) -(declare-function idlwave-sintern-class-tag "idlwave" t t) -(idlwave-new-sintern-type 'class-tag) -(add-to-list 'idlwave-complete-special 'idlwave-complete-class-structure-tag) -(add-hook 'idlwave-update-rinfo-hook 'idlwave-class-tag-reset) +(idlwave-new-sintern-type class-tag) +(add-hook 'idlwave-complete-functions #'idlwave-complete-class-structure-tag) +(add-hook 'idlwave-update-rinfo-hook #'idlwave-class-tag-reset) (defun idlwave-complete-class-structure-tag () "Complete a structure tag on a `self' argument in an object method." @@ -7384,25 +7358,26 @@ property indicating the link is added." (skip-chars-backward "a-zA-Z0-9._$") (and (< (point) (- pos 4)) (looking-at "self\\."))) - (let* ((class-selector (nth 2 (idlwave-current-routine))) - (super-classes (idlwave-all-class-inherits class-selector))) + (let* ((idlwave--class-selector (nth 2 (idlwave-current-routine))) + (idlwave--super-classes (idlwave-all-class-inherits + idlwave--class-selector))) ;; Check if we are in a class routine - (unless class-selector + (unless idlwave--class-selector (error "Not in a method procedure or function")) ;; Check if we need to update the "current" class - (if (not (equal class-selector idlwave-current-tags-class)) - (idlwave-prepare-class-tag-completion class-selector)) + (if (not (equal idlwave--class-selector idlwave-current-tags-class)) + (idlwave-prepare-class-tag-completion idlwave--class-selector)) (setq idlwave-completion-help-info (list 'idlwave-complete-class-structure-tag-help (idlwave-sintern-routine - (concat class-selector "__define")) + (concat idlwave--class-selector "__define")) nil)) ;; FIXME: idlwave-cpl-bold doesn't seem used anywhere. - (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) + (let ((_idlwave-cpl-bold idlwave-current-native-class-tags)) (idlwave-complete-in-buffer 'class-tag 'class-tag idlwave-current-class-tags nil - (format "Select a tag of class %s" class-selector) + (format "Select a tag of class %s" idlwave--class-selector) "class tag" 'idlwave-attach-class-tag-classes)) t) ; return t to skip other completions @@ -7420,7 +7395,7 @@ property indicating the link is added." (list (idlwave-sintern-class-tag x 'set))) (idlwave-all-class-tags class))) (setq idlwave-current-native-class-tags - (mapcar 'downcase (idlwave-class-tags class)))) + (mapcar #'downcase (idlwave-class-tags class)))) ;=========================================================================== ;; @@ -7429,13 +7404,11 @@ property indicating the link is added." (defvar idlwave-sint-sysvars nil) (defvar idlwave-sint-sysvartags nil) -(declare-function idlwave-sintern-sysvar "idlwave" t t) -(declare-function idlwave-sintern-sysvartag "idlwave" t t) -(idlwave-new-sintern-type 'sysvar) -(idlwave-new-sintern-type 'sysvartag) -(add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag) -(add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset) -(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist) +(idlwave-new-sintern-type sysvar) +(idlwave-new-sintern-type sysvartag) +(add-hook 'idlwave-complete-functions #'idlwave-complete-sysvar-or-tag) +(add-hook 'idlwave-update-rinfo-hook #'idlwave-sysvars-reset) +(add-hook 'idlwave-after-load-rinfo-hook #'idlwave-sintern-sysvar-alist) (defun idlwave-complete-sysvar-or-tag () @@ -7591,7 +7564,7 @@ associated TAG, if any." (let ((text idlwave-shell-command-output) (start 0) (old idlwave-system-variables-alist) - var tags type name class link old-entry) + var tags link old-entry) ;; type name class (setq idlwave-system-variables-alist nil) (while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?" text start) @@ -7611,7 +7584,8 @@ associated TAG, if any." (cdr (assq (idlwave-sintern-sysvartag x) (cdr (assq 'tags old-entry)))))) - tags)) link) + tags)) + link) idlwave-system-variables-alist))) ;; Keep the old value if query was not successful (setq idlwave-system-variables-alist @@ -7700,7 +7674,7 @@ itself." (setq this-command last-command) (idlwave-do-mouse-completion-help ev)) -(defun idlwave-routine-info (&optional arg external) +(defun idlwave-routine-info (&optional arg _external) "Display a routines calling sequence and list of keywords. When point is on the name a function or procedure, or in the argument list of a function or procedure, this command displays a help buffer with @@ -7737,7 +7711,7 @@ arg, the class property is cleared out." (idlwave-force-class-query (equal arg '(4))) (module (idlwave-what-module))) (if (car module) - (apply 'idlwave-display-calling-sequence + (apply #'idlwave-display-calling-sequence (idlwave-fix-module-if-obj_new module)) (error "Don't know which calling sequence to show"))))) @@ -7820,7 +7794,7 @@ force class query for object methods." (name (idlwave-completing-read (if (or (not this-buffer) (assoc default list)) - (format "Module (Default %s): " default) + (format-prompt "Module" default) (format "Module in this file: ")) list)) type class) @@ -7954,7 +7928,7 @@ Used by `idlwave-routine-info' and `idlwave-find-module'." (stringp class)) (list (car module) (nth 1 module) - (apply 'idlwave-find-inherited-class module)) + (apply #'idlwave-find-inherited-class module)) module))) (defun idlwave-find-inherited-class (name type class) @@ -7979,7 +7953,7 @@ appropriate Init method." (setq string (buffer-substring (point) pos)) (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)" string))) - (let ((name "Init") + (let (;; (name "Init") (class (match-string 1 string))) (setq module (list (idlwave-sintern-method "Init") 'fun @@ -7992,7 +7966,8 @@ appropriate Init method." Translate OBJ_NEW, adding all super-class keywords, or all keywords from all classes if CLASS equals t. If SYSTEM is non-nil, don't demand _EXTRA in the keyword list." - (let ((case-fold-search t)) + (let ((case-fold-search t) + (idlwave--super-classes super-classes)) ;; If this is the OBJ_NEW function, try to figure out the class and use ;; the keywords from the corresponding INIT method. @@ -8013,7 +7988,8 @@ demand _EXTRA in the keyword list." (idlwave-sintern-method "INIT") 'fun class - (idlwave-routines)) 'do-link)))))) + (idlwave-routines)) + 'do-link)))))) ;; If the class is t, combine all keywords of all methods NAME (when (eq class t) @@ -8030,7 +8006,7 @@ demand _EXTRA in the keyword list." ;; If we have inheritance, add all keywords from superclasses, if ;; the user indicated that method in `idlwave-keyword-class-inheritance' (when (and - super-classes + idlwave--super-classes idlwave-keyword-class-inheritance (stringp class) (or @@ -8045,7 +8021,7 @@ demand _EXTRA in the keyword list." (cl-loop for entry in (idlwave-routines) do (and (nth 2 entry) ; non-nil class - (memq (nth 2 entry) super-classes) ; an inherited class + (memq (nth 2 entry) idlwave--super-classes) ;an inherited class (eq (nth 1 entry) type) ; correct type (eq (car entry) name) ; correct name (mapc (lambda (k) (add-to-list 'keywords k)) @@ -8095,16 +8071,16 @@ If we do not know about MODULE, just return KEYWORD literally." (defvar idlwave-rinfo-mouse-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'idlwave-mouse-active-rinfo) - (define-key map [(shift mouse-2)] 'idlwave-mouse-active-rinfo-shift) - (define-key map [mouse-3] 'idlwave-mouse-active-rinfo-right) - (define-key map " " 'idlwave-active-rinfo-space) - (define-key map "q" 'idlwave-quit-help) + (define-key map [mouse-2] #'idlwave-mouse-active-rinfo) + (define-key map [(shift mouse-2)] #'idlwave-mouse-active-rinfo-shift) + (define-key map [mouse-3] #'idlwave-mouse-active-rinfo-right) + (define-key map " " #'idlwave-active-rinfo-space) + (define-key map "q" #'idlwave-quit-help) map)) (defvar idlwave-rinfo-map (let ((map (make-sparse-keymap))) - (define-key map "q" 'idlwave-quit-help) + (define-key map "q" #'idlwave-quit-help) map)) (defvar idlwave-popup-source nil) @@ -8151,7 +8127,7 @@ If we do not know about MODULE, just return KEYWORD literally." (data (list name type class (current-buffer) nil initial-class)) (face 'idlwave-help-link) beg props win cnt total) - ;; Fix keywords, but don't add chained super-classes, since these + ;; Fix keywords, but don't add chained idlwave--super-classes, since these ;; are shown separately for that super-class (setq keywords (idlwave-fix-keywords name type class keywords)) (cond @@ -8336,7 +8312,7 @@ to it." (add-text-properties beg (point) (list 'face 'bold))) (when (and file (not (equal file ""))) (setq beg (point)) - (insert (apply 'abbreviate-file-name (list file))) + (insert (apply #'abbreviate-file-name (list file))) (if file-props (add-text-properties beg (point) file-props))))) @@ -8441,9 +8417,9 @@ was pressed." idlwave-keyword-completion-adds-equal) (insert "="))))) -(defun idlwave-list-buffer-load-path-shadows (&optional arg) +(defun idlwave-list-buffer-load-path-shadows (&optional _arg) "List the load path shadows of all routines defined in current buffer." - (interactive "P") + (interactive) (idlwave-routines) (if (derived-mode-p 'idlwave-mode) (idlwave-list-load-path-shadows @@ -8451,13 +8427,13 @@ was pressed." "in current buffer") (error "Current buffer is not in idlwave-mode"))) -(defun idlwave-list-shell-load-path-shadows (&optional arg) +(defun idlwave-list-shell-load-path-shadows (&optional _arg) "List the load path shadows of all routines compiled under the shell. This is very useful for checking an IDL application. Just compile the application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced routines and update IDLWAVE internal info. Then check for shadowing with this command." - (interactive "P") + (interactive) (cond ((or (not (fboundp 'idlwave-shell-is-running)) (not (idlwave-shell-is-running))) @@ -8468,15 +8444,15 @@ with this command." (idlwave-list-load-path-shadows nil idlwave-compiled-routines "in the shell")))) -(defun idlwave-list-all-load-path-shadows (&optional arg) +(defun idlwave-list-all-load-path-shadows (&optional _arg) "List the load path shadows of all routines known to IDLWAVE." - (interactive "P") + (interactive) (idlwave-list-load-path-shadows nil nil "globally")) (defvar idlwave-sort-prefer-buffer-info t "Internal variable used to influence `idlwave-routine-twin-compare'.") -(defun idlwave-list-load-path-shadows (arg &optional special-routines loc) +(defun idlwave-list-load-path-shadows (_arg &optional special-routines loc) "List the routines which are defined multiple times. Search the information IDLWAVE has about IDL routines for multiple definitions. @@ -8525,12 +8501,12 @@ can be used to detect possible name clashes during this process." (lambda (ev) (interactive "e") (mouse-set-point ev) - (apply 'idlwave-do-find-module + (apply #'idlwave-do-find-module (get-text-property (point) 'find-args)))) (define-key keymap [(return)] (lambda () (interactive) - (apply 'idlwave-do-find-module + (apply #'idlwave-do-find-module (get-text-property (point) 'find-args)))) (message "Compiling list...( 0%%)") (with-current-buffer (get-buffer-create "*Shadows*") @@ -8606,6 +8582,10 @@ ENTRY will also be returned, as the first item of this list." (push candidate twins)) (cons entry (nreverse twins)))) +;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins. +(defvar idlwave-twin-class) +(defvar idlwave-twin-name) + (defun idlwave-study-twins (entries) "Return dangerous twins of first entry in ENTRIES. Dangerous twins are routines with same name, but in different files on @@ -8618,7 +8598,7 @@ routines, and may have been scanned." (type (nth 1 entry)) ; Must be bound for (idlwave-twin-class (nth 2 entry)) ; idlwave-routine-twin-compare (cnt 0) - source type type-cons file alist syslibp key) + source type-cons file alist syslibp key) (while (setq entry (pop entries)) (cl-incf cnt) (setq source (nth 3 entry) @@ -8654,12 +8634,12 @@ routines, and may have been scanned." (when (and (idlwave-syslib-scanned-p) (setq entry (assoc 'system alist))) (setcar entry 'builtin)) - (sort alist 'idlwave-routine-twin-compare))) + (sort alist #'idlwave-routine-twin-compare))) ;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix. ;; (defvar type) -(define-obsolete-function-alias 'idlwave-xor 'xor "27.1") +(define-obsolete-function-alias 'idlwave-xor #'xor "27.1") (defun idlwave-routine-entry-compare (a b) "Compare two routine info entries for sorting. @@ -8690,7 +8670,7 @@ names and path locations." "Compare two routine entries, under the assumption that they are twins. This basically calls `idlwave-routine-twin-compare' with the correct args." (let* ((idlwave-twin-name (car a)) - (type (nth 1 a)) + ;; (type (nth 1 a)) (idlwave-twin-class (nth 2 a)) ; used in idlwave-routine-twin-compare (asrc (nth 3 a)) (atype (car asrc)) @@ -8706,10 +8686,6 @@ This basically calls `idlwave-routine-twin-compare' with the correct args." (list (file-truename bfile) bfile (list btype)) (list btype bfile (list btype)))))) -;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins. -(defvar idlwave-twin-class) -(defvar idlwave-twin-name) - (defun idlwave-routine-twin-compare (a b) "Compare two routine twin entries for sorting. In here, A and B are not normal routine info entries, but special @@ -8809,9 +8785,7 @@ This expects NAME TYPE IDLWAVE-TWIN-CLASS to be bound to the right values." (defun idlwave-path-alist-add-flag (list-entry flag) "Add a flag to the path list entry, if not set." - (let ((flags (cdr list-entry))) - (add-to-list 'flags flag) - (setcdr list-entry flags))) + (cl-pushnew flag (cdr list-entry) :test #'equal)) (defun idlwave-path-alist-remove-flag (list-entry flag) "Remove a flag to the path list entry, if set." @@ -8920,8 +8894,8 @@ Assumes that point is at the beginning of the unit as found by ["(Un)Comment Region" idlwave-toggle-comment-region t] ["Continue/Split line" idlwave-split-line t] "--" - ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle - :selected (symbol-value idlwave-fill-function)]) + ["Toggle Auto Fill" auto-fill-mode :style toggle + :selected auto-fill-function]) ("Templates" ["Procedure" idlwave-procedure t] ["Function" idlwave-function t] @@ -9069,7 +9043,7 @@ With arg, list all abbrevs with the corresponding hook. This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." (interactive "P") - (let ((table (symbol-value 'idlwave-mode-abbrev-table)) + (let ((table idlwave-mode-abbrev-table) abbrevs str rpl func fmt (len-str 0) (len-rpl 0)) (mapatoms diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 146ed4dca4a..af6ccce3d62 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -487,7 +487,7 @@ Used by these commands to determine defaults." (defun lisp-load-file (file-name) "Load a Lisp file into the inferior Lisp process." - (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file + (interactive (comint-get-source "Load Lisp file" lisp-prev-l/c-dir/file lisp-source-modes nil)) ; nil because LOAD ; doesn't need an exact name (comint-check-source file-name) ; Check to see if buffer needs saved. @@ -500,7 +500,7 @@ Used by these commands to determine defaults." (defun lisp-compile-file (file-name) "Compile a Lisp file in the inferior Lisp process." - (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file + (interactive (comint-get-source "Compile Lisp file" lisp-prev-l/c-dir/file lisp-source-modes nil)) ; nil = don't need ; suffix .lisp (comint-check-source file-name) ; Check to see if buffer needs saved. diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 536d3be0056..2a0374aa818 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -1,4 +1,4 @@ -;;; modula2.el --- Modula-2 editing support package +;;; modula2.el --- Modula-2 editing support package -*- lexical-binding: t -*- ;; Author: Michael Schmidt ;; Tom Perrine @@ -69,33 +69,33 @@ (defvar m2-mode-map (let ((map (make-sparse-keymap))) ;; FIXME: Many of those bindings are contrary to coding conventions. - (define-key map "\C-cb" 'm2-begin) - (define-key map "\C-cc" 'm2-case) - (define-key map "\C-cd" 'm2-definition) - (define-key map "\C-ce" 'm2-else) - (define-key map "\C-cf" 'm2-for) - (define-key map "\C-ch" 'm2-header) - (define-key map "\C-ci" 'm2-if) - (define-key map "\C-cm" 'm2-module) - (define-key map "\C-cl" 'm2-loop) - (define-key map "\C-co" 'm2-or) - (define-key map "\C-cp" 'm2-procedure) - (define-key map "\C-c\C-w" 'm2-with) - (define-key map "\C-cr" 'm2-record) - (define-key map "\C-cs" 'm2-stdio) - (define-key map "\C-ct" 'm2-type) - (define-key map "\C-cu" 'm2-until) - (define-key map "\C-cv" 'm2-var) - (define-key map "\C-cw" 'm2-while) - (define-key map "\C-cx" 'm2-export) - (define-key map "\C-cy" 'm2-import) - (define-key map "\C-c{" 'm2-begin-comment) - (define-key map "\C-c}" 'm2-end-comment) - (define-key map "\C-c\C-z" 'suspend-emacs) - (define-key map "\C-c\C-v" 'm2-visit) - (define-key map "\C-c\C-t" 'm2-toggle) - (define-key map "\C-c\C-l" 'm2-link) - (define-key map "\C-c\C-c" 'm2-compile) + (define-key map "\C-cb" #'m2-begin) + (define-key map "\C-cc" #'m2-case) + (define-key map "\C-cd" #'m2-definition) + (define-key map "\C-ce" #'m2-else) + (define-key map "\C-cf" #'m2-for) + (define-key map "\C-ch" #'m2-header) + (define-key map "\C-ci" #'m2-if) + (define-key map "\C-cm" #'m2-module) + (define-key map "\C-cl" #'m2-loop) + (define-key map "\C-co" #'m2-or) + (define-key map "\C-cp" #'m2-procedure) + (define-key map "\C-c\C-w" #'m2-with) + (define-key map "\C-cr" #'m2-record) + (define-key map "\C-cs" #'m2-stdio) + (define-key map "\C-ct" #'m2-type) + (define-key map "\C-cu" #'m2-until) + (define-key map "\C-cv" #'m2-var) + (define-key map "\C-cw" #'m2-while) + (define-key map "\C-cx" #'m2-export) + (define-key map "\C-cy" #'m2-import) + (define-key map "\C-c{" #'m2-begin-comment) + (define-key map "\C-c}" #'m2-end-comment) + (define-key map "\C-c\C-z" #'suspend-emacs) + (define-key map "\C-c\C-v" #'m2-visit) + (define-key map "\C-c\C-t" #'m2-toggle) + (define-key map "\C-c\C-l" #'m2-link) + (define-key map "\C-c\C-c" #'m2-compile) map) "Keymap used in Modula-2 mode.") diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index a8a86478d8b..196f2de3440 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -491,8 +491,8 @@ Non-nil means always go to the next Octave code line after sending." 'font-lock-keyword-face) ;; Note: 'end' also serves as the last index in an indexing expression, ;; and 'enumerate' is also a function. - ;; Ref: http://www.mathworks.com/help/matlab/ref/end.html - ;; Ref: http://www.mathworks.com/help/matlab/ref/enumeration.html + ;; Ref: https://www.mathworks.com/help/matlab/ref/end.html + ;; Ref: https://www.mathworks.com/help/matlab/ref/enumeration.html (list (lambda (limit) (while (re-search-forward "\\_" limit 'move) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index c7fa5ab84b0..fd23683bc0a 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -170,9 +170,9 @@ ;; (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)) ;; ;; Fontify function and package names in declarations. - ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?" + ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\(?:\\sw\\|::\\)+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) - ("\\(^\\|[^$@%&\\]\\)\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?" + ("\\(?:^\\|[^$@%&\\]\\)\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\(?:\\sw\\|::\\)+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))) "Subdued level highlighting for Perl mode.") @@ -187,7 +187,7 @@ "\\>") ;; ;; Fontify declarators and prefixes as types. - ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-type-face) ; declarators + ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-keyword-face) ; declarators ;; ;; Fontify function, variable and file name references. ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index bd552c917ac..f1546541d54 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -201,7 +201,8 @@ of the project instance object." (when maybe-prompt (if pr (project-remember-project pr) - (project--remove-from-project-list directory) + (project--remove-from-project-list + directory "Project `%s' not found; removed from list") (setq pr (cons 'transient directory)))) pr)) @@ -911,7 +912,7 @@ if one already exists." "-shell*")) (shell-buffer (get-buffer default-project-shell-name))) (if (and shell-buffer (not current-prefix-arg)) - (pop-to-buffer shell-buffer) + (pop-to-buffer-same-window shell-buffer) (shell (generate-new-buffer-name default-project-shell-name))))) ;;;###autoload @@ -1217,17 +1218,27 @@ Save the result in `project-list-file' if the list of projects has changed." (push (list dir) project--list) (project--write-project-list)))) -(defun project--remove-from-project-list (pr-dir) - "Remove directory PR-DIR of a missing project from the project list. +(defun project--remove-from-project-list (project-root report-message) + "Remove directory PROJECT-ROOT of a missing project from the project list. If the directory was in the list before the removal, save the result in `project-list-file'. Announce the project's removal -from the list." +from the list using REPORT-MESSAGE, which is a format string +passed to `message' as its first argument." (project--ensure-read-project-list) - (when-let ((ent (assoc pr-dir project--list))) + (when-let ((ent (assoc project-root project--list))) (setq project--list (delq ent project--list)) - (message "Project `%s' not found; removed from list" pr-dir) + (message report-message project-root) (project--write-project-list))) +;;;###autoload +(defun project-remove-known-project (project-root) + "Remove directory PROJECT-ROOT from the project list. +PROJECT-ROOT is the root directory of a known project listed in +the project list." + (interactive (list (project-prompt-project-dir))) + (project--remove-from-project-list + project-root "Project `%s' removed from known projects")) + (defun project-prompt-project-dir () "Prompt the user for a directory that is one of the known project roots. The project is chosen among projects known from the project list, diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 3f8afd97050..84ac8fdb281 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -331,7 +331,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (require 'smie) ;; Here's a simplified BNF grammar, for reference: -;; http://www.cse.buffalo.edu/~regan/cse305/RubyBNF.pdf +;; https://www.cse.buffalo.edu/~regan/cse305/RubyBNF.pdf (defconst ruby-smie-grammar (smie-prec2->grammar (smie-merge-prec2s diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 72ac2d95a21..b6972846cde 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -28,7 +28,7 @@ ;; the Lisp mode documented in the Emacs manual. `dsssl-mode' is a ;; variant of scheme-mode for editing DSSSL specifications for SGML ;; documents. [As of Apr 1997, some pointers for DSSSL may be found, -;; for instance, at .] +;; for instance, at .] ;; All these Lisp-ish modes vary basically in details of the language ;; syntax they highlight/indent/index, but dsssl-mode uses "^;;;" as ;; the page-delimiter since ^L isn't normally a valid SGML character. diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index ef157ce4ab7..f92f4468098 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -1573,7 +1573,19 @@ If not nil and not t, move to limit of search and return nil." ("^%\\([ \t\f].*\\)?$" nil comment) ("^%include\\>" nil include) ("\"[^\"\n]*\"\\|'.'\\|'![0-9]+!'" nil string) - ("\\<\\(ACTIVATE\\|AFTER\\|AND\\|ARRAY\\|AT\\|BEFORE\\|BEGIN\\|BOOLEAN\\|CHARACTER\\|CLASS\\|DELAY\\|DO\\|ELSE\\|END\\|EQ\\|EQV\\|EXTERNAL\\|FALSE\\|FOR\\|GE\\|GO\\|GOTO\\|GT\\|HIDDEN\\|IF\\|IMP\\|IN\\|INNER\\|INSPECT\\|INTEGER\\|IS\\|LABEL\\|LE\\|LONG\\|LT\\|NAME\\|NE\\|NEW\\|NONE\\|NOT\\|NOTEXT\\|OR\\|OTHERWISE\\|PRIOR\\|PROCEDURE\\|PROTECTED\\|QUA\\|REACTIVATE\\|REAL\\|REF\\|SHORT\\|STEP\\|SWITCH\\|TEXT\\|THEN\\|THIS\\|TO\\|TRUE\\|UNTIL\\|VALUE\\|VIRTUAL\\|WHEN\\|WHILE\\)\\>" nil keyword) + ((regexp-opt '("ACTIVATE" "AFTER" "AND" "ARRAY" "AT" "BEFORE" + "BEGIN" "BOOLEAN" "CHARACTER" "CLASS" "DELAY" + "DO" "ELSE" "END" "EQ" "EQV" "EXTERNAL" "FALSE" + "FOR" "GE" "GO" "GOTO" "GT" "HIDDEN" "IF" "IMP" + "IN" "INNER" "INSPECT" "INTEGER" "IS" "LABEL" + "LE" "LONG" "LT" "NAME" "NE" "NEW" "NONE" "NOT" + "NOTEXT" "OR" "OTHERWISE" "PRIOR" "PROCEDURE" + "PROTECTED" "QUA" "REACTIVATE" "REAL" "REF" + "SHORT" "STEP" "SWITCH" "TEXT" "THEN" "THIS" + "TO" "TRUE" "UNTIL" "VALUE" "VIRTUAL" "WHEN" + "WHILE") + 'words) + nil keyword) ("!\\|\\" ";" comment)) nil 'case-insensitive))) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index f1f4d61324b..6224b3b5f3f 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2992,7 +2992,7 @@ displayed." ;; (defconst sql-smie-grammar ;; (smie-prec2->grammar ;; (smie-bnf->prec2 -;; ;; Partly based on http://www.h2database.com/html/grammar.html +;; ;; Partly based on https://www.h2database.com/html/grammar.html ;; '((cmd ("SELECT" select-exp "FROM" select-table-exp) ;; ) ;; (select-exp ("*") (exp) (exp "AS" column-alias)) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 82e1343e057..f6a50bf1a88 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1413,7 +1413,7 @@ Prefix argument means switch to the Tcl buffer afterwards." (list ;; car because comint-get-source returns a list holding the ;; filename. - (car (comint-get-source "Load Tcl file: " + (car (comint-get-source "Load Tcl file" (or (and (derived-mode-p 'tcl-mode) (buffer-file-name)) @@ -1433,7 +1433,7 @@ If an inferior Tcl process exists, it is killed first. Prefix argument means switch to the Tcl buffer afterwards." (interactive (list - (car (comint-get-source "Restart with Tcl file: " + (car (comint-get-source "Restart with Tcl file" (or (and (derived-mode-p 'tcl-mode) (buffer-file-name)) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 036b2f447bf..4622256bb9c 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -5,7 +5,7 @@ ;; Author: Reto Zimmermann ;; Version: 2.28 ;; Keywords: languages vera -;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html +;; WWW: https://guest.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html ;; Yoni Rabkin contacted the maintainer of this ;; file on 18/3/2008, and the maintainer agreed that when a bug is @@ -249,7 +249,7 @@ Add a description of the problem and include a reproducible test case. Feel free to send questions and enhancement requests to . Official distribution is at -URL `http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html' +URL `https://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html' The Vera Mode Maintainer diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index c8e55da642f..856432ccf10 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -6,7 +6,7 @@ ;; Rodney J. Whitby ;; Maintainer: Reto Zimmermann ;; Keywords: languages vhdl -;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html +;; WWW: https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html ;; Yoni Rabkin contacted the maintainer of this ;; file on 18/3/2008, and the maintainer agreed that when a bug is diff --git a/lisp/repeat.el b/lisp/repeat.el index 84a613da0cf..a2b04b81b03 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -180,7 +180,7 @@ this function is always whether the value of `this-command' would've been (= repeat-num-input-keys-at-repeat num-input-keys)) ;; An example of the use of (repeat-is-really-this-command) may still be -;; available in ; search for +;; available in ; search for ;; "defun wm-switch-buffer". ;;;;; ******************* THE REPEAT COMMAND ITSELF ******************* ;;;;; diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index c9d39397e06..fc9196caf96 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -1,4 +1,4 @@ -;;; ruler-mode.el --- display a ruler in the header line +;;; ruler-mode.el --- display a ruler in the header line -*- lexical-binding: t -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -122,7 +122,6 @@ Also allowing to visually change `tab-stop-list' setting using and on the ruler to respectively add or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or on the ruler toggles showing/editing of tab stops." - :group 'ruler-mode :type 'boolean) ;; IMPORTANT: This function must be defined before the following @@ -140,7 +139,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or ?\¶ ?\|) "Character used at the `fill-column' location." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -148,7 +146,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defcustom ruler-mode-comment-column-char ?\# "Character used at the `comment-column' location." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -156,7 +153,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defcustom ruler-mode-goal-column-char ?G "Character used at the `goal-column' location." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -166,7 +162,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or ?\¦ ?\@) "Character used at the `current-column' location." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -174,7 +169,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defcustom ruler-mode-tab-stop-char ?\T "Character used at `tab-stop-list' locations." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -182,7 +176,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defcustom ruler-mode-basic-graduation-char ?\. "Character used for basic graduations." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -190,7 +183,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defcustom ruler-mode-inter-graduation-char ?\! "Character used for intermediate graduations." - :group 'ruler-mode :type '(choice (character :tag "Character") (integer :tag "Integer char value" @@ -198,7 +190,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defcustom ruler-mode-set-goal-column-ding-flag t "Non-nil means do `ding' when `goal-column' is set." - :group 'ruler-mode :type 'boolean) (defface ruler-mode-default @@ -215,8 +206,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or :line-width 1 :style released-button) ))) - "Default face used by the ruler." - :group 'ruler-mode) + "Default face used by the ruler.") (defface ruler-mode-pad '((((type tty)) @@ -227,64 +217,56 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (:inherit ruler-mode-default :background "grey64" ))) - "Face used to pad inactive ruler areas." - :group 'ruler-mode) + "Face used to pad inactive ruler areas.") (defface ruler-mode-margins '((t (:inherit ruler-mode-default :foreground "white" ))) - "Face used to highlight margin areas." - :group 'ruler-mode) + "Face used to highlight margin areas.") (defface ruler-mode-fringes '((t (:inherit ruler-mode-default :foreground "green" ))) - "Face used to highlight fringes areas." - :group 'ruler-mode) + "Face used to highlight fringes areas.") (defface ruler-mode-column-number '((t (:inherit ruler-mode-default :foreground "black" ))) - "Face used to highlight number graduations." - :group 'ruler-mode) + "Face used to highlight number graduations.") (defface ruler-mode-fill-column '((t (:inherit ruler-mode-default :foreground "red" ))) - "Face used to highlight the fill column character." - :group 'ruler-mode) + "Face used to highlight the fill column character.") (defface ruler-mode-comment-column '((t (:inherit ruler-mode-default :foreground "red" ))) - "Face used to highlight the comment column character." - :group 'ruler-mode) + "Face used to highlight the comment column character.") (defface ruler-mode-goal-column '((t (:inherit ruler-mode-default :foreground "red" ))) - "Face used to highlight the goal column character." - :group 'ruler-mode) + "Face used to highlight the goal column character.") (defface ruler-mode-tab-stop '((t (:inherit ruler-mode-default :foreground "steelblue" ))) - "Face used to highlight tab stop characters." - :group 'ruler-mode) + "Face used to highlight tab stop characters.") (defface ruler-mode-current-column '((t @@ -292,8 +274,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or :weight bold :foreground "yellow" ))) - "Face used to highlight the `current-column' character." - :group 'ruler-mode) + "Face used to highlight the `current-column' character.") (defsubst ruler-mode-full-window-width () @@ -547,15 +528,15 @@ START-EVENT is the mouse click event." (define-key km [header-line (control down-mouse-2)] #'ruler-mode-toggle-show-tab-stops) (define-key km [header-line (shift mouse-1)] - 'ignore) + #'ignore) (define-key km [header-line (shift mouse-3)] - 'ignore) + #'ignore) (define-key km [header-line (control mouse-1)] - 'ignore) + #'ignore) (define-key km [header-line (control mouse-3)] - 'ignore) + #'ignore) (define-key km [header-line (control mouse-2)] - 'ignore) + #'ignore) km) "Keymap for ruler minor mode.") diff --git a/lisp/ses.el b/lisp/ses.el index a11c754abc3..6058d48ed19 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -2653,9 +2653,7 @@ canceled." (barf-if-buffer-read-only) (if (eq default t) (setq default "") - (setq prompt (format "%s (default %S): " - (substring prompt 0 -2) - default))) + (setq prompt (format-prompt prompt default))) (dolist (key ses-completion-keys) (define-key ses-mode-edit-map key 'ses-read-printer-complete-symbol)) ;; make it globally visible, so that it can be visible from the minibuffer. @@ -2702,7 +2700,7 @@ right-justified) or a list of one string (will be left-justified)." ;;Range contains differing printer functions (setq default t) (throw 'ses-read-cell-printer t)))))) - (list (ses-read-printer (format "Cell %S printer: " ses--curcell) + (list (ses-read-printer (format "Cell %S printer" ses--curcell) default)))) (unless (eq newval t) (ses-begin-change) @@ -2716,7 +2714,7 @@ See `ses-read-cell-printer' for input forms." (interactive (let ((col (cdr (ses-sym-rowcol ses--curcell)))) (ses-check-curcell) - (list col (ses-read-printer (format "Column %s printer: " + (list col (ses-read-printer (format "Column %s printer" (ses-column-letter col)) (ses-col-printer col))))) @@ -2731,7 +2729,7 @@ See `ses-read-cell-printer' for input forms." "Set the default printer function for cells that have no other. See `ses-read-cell-printer' for input forms." (interactive - (list (ses-read-printer "Default printer: " ses--default-printer))) + (list (ses-read-printer "Default printer" ses--default-printer))) (unless (eq newval t) (ses-begin-change) (ses-set-parameter 'ses--default-printer newval) @@ -3773,7 +3771,7 @@ function is redefined." (setq name (intern name)) (let* ((cur-printer (gethash name ses--local-printer-hashmap)) (default (and cur-printer (ses--locprn-def cur-printer)))) - (setq def (ses-read-printer (format "Enter definition of printer %S: " name) + (setq def (ses-read-printer (format "Enter definition of printer %S" name) default))) (list name def))) diff --git a/lisp/shell.el b/lisp/shell.el index 53f5d0b6f1c..cd99b008776 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -110,11 +110,6 @@ "Directory support in shell mode." :group 'shell) -;; Unused. -;;; (defgroup shell-faces nil -;;; "Faces in shell buffers." -;;; :group 'shell) - ;;;###autoload (defcustom shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "Regexp to match shells that don't save their command history, and @@ -743,7 +738,7 @@ Make the shell buffer the current buffer, and return it. (current-buffer))) ;; The buffer's window must be correctly set when we call comint ;; (so that comint sets the COLUMNS env var properly). - (pop-to-buffer buffer) + (pop-to-buffer-same-window buffer) (with-connection-local-variables ;; On remote hosts, the local `shell-file-name' might be useless. diff --git a/lisp/simple.el b/lisp/simple.el index eeef40f3840..959bd831170 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -836,7 +836,10 @@ In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this command indents to the column specified by the function `current-left-margin'. -With ARG, perform this action that many times." +With ARG, perform this action that many times. + +Also see `open-line' (bound to \\[open-line]) for a command that +just inserts a newline without doing any indentation." (interactive "*p") (delete-horizontal-space t) (unless arg diff --git a/lisp/subr.el b/lisp/subr.el index 14335f43125..5af59ceceba 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2811,9 +2811,9 @@ This function is used by the `interactive' code letter `n'." (when default1 (setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt) - (replace-match (format " (default %s)" default1) t t prompt 1) + (replace-match (format minibuffer-default-prompt-format default1) t t prompt 1) (replace-regexp-in-string "[ \t]*\\'" - (format " (default %s) " default1) + (format minibuffer-default-prompt-format default1) prompt t t)))) (while (progn @@ -6205,6 +6205,28 @@ returned list are in the same order as in TREE. ;; for discoverability: (defalias 'flatten-list #'flatten-tree) +(defun string-trim-left (string &optional regexp) + "Trim STRING of leading string matching REGEXP. + +REGEXP defaults to \"[ \\t\\n\\r]+\"." + (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) + (substring string (match-end 0)) + string)) + +(defun string-trim-right (string &optional regexp) + "Trim STRING of trailing string matching REGEXP. + +REGEXP defaults to \"[ \\t\\n\\r]+\"." + (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") + string))) + (if i (substring string 0 i) string))) + +(defun string-trim (string &optional trim-left trim-right) + "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT. + +TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." + (string-trim-left (string-trim-right string trim-right) trim-left)) + ;; The initial anchoring is for better performance in searching matches. (defconst regexp-unmatchable "\\`a\\`" "Standard regexp guaranteed not to match any string at all.") diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 45ed2a6b314..2e27b293c5e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -345,7 +345,7 @@ before calling the command that adds a new tab." :group 'tab-bar :version "27.1") -(defcustom tab-bar-new-tab-group nil +(defcustom tab-bar-new-tab-group t "Defines what group to assign to a new tab. If nil, don't set a default group automatically. If t, inherit the group name from the previous tab. @@ -522,7 +522,7 @@ Return its existing value or a new value." (setf (cdr current-tab-name) (funcall tab-bar-tab-name-function)))) ;; Create default tabs - (setq tabs (list (tab-bar--current-tab))) + (setq tabs (list (tab-bar--current-tab-make))) (tab-bar-tabs-set tabs frame)) tabs)) @@ -795,7 +795,7 @@ on the tab bar instead." (push '(tabs . frameset-filter-tabs) frameset-filter-alist) (defun tab-bar--tab (&optional frame) - (let* ((tab (tab-bar--current-tab-find)) + (let* ((tab (tab-bar--current-tab-find nil frame)) (tab-explicit-name (alist-get 'explicit-name tab)) (tab-group (alist-get 'group tab)) (bl (seq-filter #'buffer-live-p (frame-parameter frame 'buffer-list))) @@ -816,7 +816,10 @@ on the tab bar instead." (wc-history-back . ,(gethash (or frame (selected-frame)) tab-bar-history-back)) (wc-history-forward . ,(gethash (or frame (selected-frame)) tab-bar-history-forward))))) -(defun tab-bar--current-tab (&optional tab) +(defun tab-bar--current-tab (&optional tab frame) + (tab-bar--current-tab-make (or tab (tab-bar--current-tab-find nil frame)))) + +(defun tab-bar--current-tab-make (&optional tab) ;; `tab' here is an argument meaning "use tab as template". This is ;; necessary when switching tabs, otherwise the destination tab ;; inherits the current tab's `explicit-name' parameter. @@ -933,7 +936,7 @@ ARG counts from 1. Negative ARG counts tabs from the end of the tab bar." (when from-index (setf (nth from-index tabs) from-tab)) - (setf (nth to-index tabs) (tab-bar--current-tab (nth to-index tabs))) + (setf (nth to-index tabs) (tab-bar--current-tab-make (nth to-index tabs))) (unless tab-bar-mode (message "Selected tab '%s'" (alist-get 'name to-tab)))) @@ -1111,7 +1114,7 @@ After the tab is created, the hooks in (when from-index (setf (nth from-index tabs) from-tab)) - (let* ((to-tab (tab-bar--current-tab + (let* ((to-tab (tab-bar--current-tab-make (when (eq tab-bar-new-tab-group t) `((group . ,(alist-get 'group from-tab)))))) (to-index (and to-index (prefix-numeric-value to-index))) @@ -1409,6 +1412,42 @@ function `tab-bar-tab-name-function'." ;;; Tab groups +(defun tab-bar-move-tab-to-group (&optional tab) + "Relocate TAB (or the current tab) closer to its group." + (interactive) + (let* ((tabs (funcall tab-bar-tabs-function)) + (tab (or tab (tab-bar--current-tab-find tabs))) + (tab-index (tab-bar--tab-index tab)) + (group (alist-get 'group tab)) + ;; Beginning position of the same group + (beg (seq-position tabs group + (lambda (tb gr) + (and (not (eq tb tab)) + (equal (alist-get 'group tb) gr))))) + ;; Size of the same group + (len (when beg + (seq-position (nthcdr beg tabs) group + (lambda (tb gr) + (not (equal (alist-get 'group tb) gr)))))) + (pos (when beg + (cond + ;; Don't move tab when it's already inside group bounds + ((and len (>= tab-index beg) (<= tab-index (+ beg len))) nil) + ;; Move tab from the right to the group end + ((and len (> tab-index (+ beg len))) (+ beg len 1)) + ;; Move tab from the left to the group beginning + ((< tab-index beg) beg))))) + (when pos + (tab-bar-move-tab-to pos (1+ tab-index))))) + +(defcustom tab-bar-tab-post-change-group-functions nil + "List of functions to call after changing a tab group. +The current tab is supplied as an argument." + :type 'hook + :options '(tab-bar-move-tab-to-group) + :group 'tab-bar + :version "28.1") + (defun tab-bar-change-tab-group (group-name &optional arg) "Add the tab specified by its absolute position ARG to GROUP-NAME. If no ARG is specified, then set the GROUP-NAME for the current tab. @@ -1442,6 +1481,8 @@ While using this command, you might also want to replace (setcdr group group-new-name) (nconc tab `((group . ,group-new-name)))) + (run-hook-with-args 'tab-bar-tab-post-change-group-functions tab) + (force-mode-line-update) (unless tab-bar-mode (message "Set tab group to '%s'" group-new-name)))) diff --git a/lisp/talk.el b/lisp/talk.el index 473f8ac9218..56d36dd8df4 100644 --- a/lisp/talk.el +++ b/lisp/talk.el @@ -1,4 +1,4 @@ -;;; talk.el --- allow several users to talk to each other through Emacs +;;; talk.el --- allow several users to talk to each other through Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc. @@ -23,7 +23,7 @@ ;;; Commentary: ;; This is a multi-user talk package that runs in Emacs. -;; Use talk-connect to bring a new person into the conversation. +;; Use `talk-connect' to bring a new person into the conversation. ;;; Code: diff --git a/lisp/term.el b/lisp/term.el index 6beb17fb66f..d41895ad3d9 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2535,7 +2535,7 @@ See `term-prompt-regexp'." ;; then the filename reader will only accept a file that exists. ;; ;; A typical use: -;; (interactive (term-get-source "Compile file: " prev-lisp-dir/file +;; (interactive (term-get-source "Compile file" prev-lisp-dir/file ;; '(lisp-mode) t)) ;; This is pretty stupid about strings. It decides we're in a string @@ -2566,9 +2566,7 @@ See `term-prompt-regexp'." (car def))) (deffile (if sfile-p (file-name-nondirectory stringfile) (cdr def))) - (ans (read-file-name (if deffile (format "%s(default %s) " - prompt deffile) - prompt) + (ans (read-file-name (format-prompt prompt deffile) defdir (concat defdir deffile) mustmatch-p))) diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 3d081220910..dc45a7306d8 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -6,7 +6,7 @@ ;; Keywords: mouse ;; Old-Version: 1.2.6 ;; Release-date: 6-Aug-2004 -;; Location: http://www.lysator.liu.se/~tab/artist/ +;; Location: https://www.lysator.liu.se/~tab/artist/ ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is filed in diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el index 820033486dc..6d01871bc52 100644 --- a/lisp/textmodes/bibtex-style.el +++ b/lisp/textmodes/bibtex-style.el @@ -49,7 +49,7 @@ "REVERSE" "SORT" "STRINGS")) (defconst bibtex-style-functions - ;; From http://www.eeng.dcu.ie/local-docs/btxdocs/btxhak/btxhak/node4.html. + ;; From https://www.eeng.dcu.ie/local-docs/btxdocs/btxhak/btxhak/node4.html. '("<" ">" "=" "+" "-" "*" ":=" "add.period$" "call.type$" "change.case$" "chr.to.int$" "cite$" "duplicate$" "empty$" "format.name$" "if$" "int.to.chr$" "int.to.str$" diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 301f7017e41..f01c66b1584 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1431,7 +1431,7 @@ If `bibtex-expand-strings' is non-nil, BibTeX strings are expanded for generating the URL. Set this variable before loading BibTeX mode. -The following is a complex example, see URL `http://link.aps.org/'. +The following is a complex example, see URL `https://link.aps.org/'. (((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\") \"http://link.aps.org/abstract/%s/v%s/p%s\" diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 622853da456..47b0b517ae0 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -427,7 +427,7 @@ "paged-y" "paged-x-controls" "paged-y-controls" "fragments") ;; CSS Text Decoration Module Level 3 - ;; (http://dev.w3.org/csswg/css-text-decor-3/#property-index) + ;; (https://dev.w3.org/csswg/css-text-decor-3/#property-index) ("text-decoration" text-decoration-line text-decoration-style text-decoration-color) ("text-decoration-color" color) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 81cd2f02cd7..cb5027a9763 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -703,7 +703,8 @@ space does not end a sentence, so don't break a line there." (or justify (setq justify (current-justification))) ;; Don't let Adaptive Fill mode alter the fill prefix permanently. - (let ((fill-prefix fill-prefix)) + (let ((actual-fill-prefix fill-prefix) + (fill-prefix fill-prefix)) ;; Figure out how this paragraph is indented, if desired. (when (and adaptive-fill-mode (or (null fill-prefix) (string= fill-prefix ""))) @@ -717,7 +718,7 @@ space does not end a sentence, so don't break a line there." (goto-char from) (beginning-of-line) - (if (not justify) ; filling disabled: just check indentation + (if (not justify) ; filling disabled: just check indentation (progn (goto-char from) (while (< (point) to) @@ -747,12 +748,14 @@ space does not end a sentence, so don't break a line there." linebeg) (while (< (point) to) ;; On the first line, there may be text in the fill prefix - ;; zone. In that case, don't consider that area when - ;; trying to find a place to put a line break (bug#45720). + ;; zone (when `fill-prefix' is specified externally, and + ;; not computed). In that case, don't consider that area + ;; when trying to find a place to put a line break + ;; (bug#45720). (if (not first) (setq linebeg (point)) (setq first nil - linebeg (+ (point) (length fill-prefix)))) + linebeg (+ (point) (length actual-fill-prefix)))) (move-to-column (current-fill-column)) (if (when (< (point) to) ;; Find the position where we'll break the line. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 7de5317b025..6958ab8f658 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -2368,7 +2368,7 @@ or Edit/Text Properties/Face commands. Pages can have named points and can link other points to them with see also somename. In the same way see also URL where URL is a filename relative to current -directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'. +directory, or absolute as in `https://www.cs.indiana.edu/elisp/w3/docs.html'. Images in many formats can be inlined with . diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index a9f066c4da4..13b4a6d05b0 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -2911,11 +2911,11 @@ HTML: URL `https://www.w3.org' LaTeX: - URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html' + URL `https://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html' CALS (DocBook DTD): - URL `http://www.oasis-open.org/html/a502.htm' - URL `http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751' + URL `https://www.oasis-open.org/html/a502.htm' + URL `https://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751' " (interactive (let* ((_ (unless (table--probe-cell) (error "Table not found here"))) diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 957940bfe0c..3e7c9124e2d 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -1,4 +1,4 @@ -;;; thumbs.el --- Thumbnails previewer for images files +;;; thumbs.el --- Thumbnails previewer for images files -*- lexical-binding: t -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. @@ -23,7 +23,7 @@ ;;; Commentary: -;; This package create two new modes: thumbs-mode and thumbs-view-image-mode. +;; This package create two new modes: `thumbs-mode' and `thumbs-view-image-mode'. ;; It is used for basic browsing and viewing of images from within Emacs. ;; Minimal image manipulation functions are also available via external ;; programs. If you want to do more complex tasks like categorize and tag @@ -34,7 +34,7 @@ ;; ;; Thanks: Alex Schroeder for maintaining the package at some ;; time. The peoples at #emacs@freenode.net for numerous help. RMS -;; for emacs and the GNU project. +;; for Emacs and the GNU project. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -68,29 +68,24 @@ (defcustom thumbs-thumbsdir (locate-user-emacs-file "thumbs") "Directory to store thumbnails." - :type 'directory - :group 'thumbs) + :type 'directory) (defcustom thumbs-geometry "100x100" "Size of thumbnails." - :type 'string - :group 'thumbs) + :type 'string) (defcustom thumbs-per-line 4 "Number of thumbnails per line to show in directory." - :type 'integer - :group 'thumbs) + :type 'integer) (defcustom thumbs-max-image-number 16 "Maximum number of images initially displayed in thumbs buffer." - :type 'integer - :group 'thumbs) + :type 'integer) (defcustom thumbs-thumbsdir-max-size 50000000 "Maximum size for thumbnails directory. When it reaches that size (in bytes), a warning is sent." - :type 'integer - :group 'thumbs) + :type 'integer) ;; Unfortunately Windows XP has a program called CONVERT.EXE in ;; C:/WINDOWS/SYSTEM32/ for partitioning NTFS systems. So Emacs @@ -98,54 +93,48 @@ When it reaches that size (in bytes), a warning is sent." ;; customize this value to the absolute filename. (defcustom thumbs-conversion-program (if (eq system-type 'windows-nt) + ;; FIXME is this necessary, or can a sane PATHEXE be assumed? + ;; Eg find-program does not do this. "convert.exe" - (or (executable-find "convert") - "/usr/X11R6/bin/convert")) + "convert") "Name of conversion program for thumbnails generation. -It must be \"convert\"." +This must be the ImageMagick \"convert\" utility." :type 'string - :group 'thumbs) + :version "28.1") (defcustom thumbs-setroot-command "xloadimage -onroot -fullscreen *" "Command to set the root window." - :type 'string - :group 'thumbs) + :type 'string) (defcustom thumbs-relief 5 "Size of button-like border around thumbnails." - :type 'integer - :group 'thumbs) + :type 'integer) (defcustom thumbs-margin 2 "Size of the margin around thumbnails. This is where you see the cursor." - :type 'integer - :group 'thumbs) + :type 'integer) (defcustom thumbs-thumbsdir-auto-clean t "If set, delete older file in the thumbnails directory. Deletion is done at load time when the directory size is bigger than `thumbs-thumbsdir-max-size'." - :type 'boolean - :group 'thumbs) + :type 'boolean) (defcustom thumbs-image-resizing-step 10 "Step by which to resize image as a percentage." - :type 'integer - :group 'thumbs) + :type 'integer) (defcustom thumbs-temp-dir temporary-file-directory "Temporary directory to use. Defaults to `temporary-file-directory'. Leaving it to this value can let another user see some of your images." - :type 'directory - :group 'thumbs) + :type 'directory) (defcustom thumbs-temp-prefix "emacsthumbs" "Prefix to add to temp files." - :type 'string - :group 'thumbs) + :type 'string) ;; Initialize some variable, for later use. (defvar-local thumbs-current-tmp-filename nil @@ -210,7 +199,7 @@ reached." ,f))) (directory-files (thumbs-thumbsdir) t (image-file-name-regexp))) (lambda (l1 l2) (time-less-p (car l1) (car l2))))) - (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list)))) + (dirsize (apply #'+ (mapcar (lambda (x) (cadr x)) files-list)))) (while (> dirsize thumbs-thumbsdir-max-size) (progn (message "Deleting file %s" (cadr (cdar files-list)))) @@ -290,7 +279,7 @@ smaller according to whether INCREMENT is 1 or -1." (subst-char-in-string ?\s ?\_ (apply - 'concat + #'concat (split-string filename "/"))))))) (defun thumbs-make-thumb (img) @@ -388,7 +377,7 @@ If MARKED is non-nil, the image is marked." "Make a preview buffer for all images in DIR. Optional argument REG to select file matching a regexp, and SAME-WINDOW to show thumbs in the same window." - (interactive "DDir: ") + (interactive "DThumbs (directory): ") (thumbs-show-thumbs-list (directory-files dir t (or reg (image-file-name-regexp))) dir same-window)) @@ -618,7 +607,7 @@ Open another window." (when (eolp) (forward-char))) ;; cleaning of old temp files -(mapc 'delete-file +(mapc #'delete-file (directory-files (thumbs-temp-dir) t thumbs-temp-prefix)) ;; Image modification routines diff --git a/lisp/time.el b/lisp/time.el index 1403c4ac00a..7e1d9180f60 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -614,13 +614,14 @@ point." str)))) ;;;###autoload -(defun emacs-init-time () - "Return a string giving the duration of the Emacs initialization." +(defun emacs-init-time (&optional format) + "Return a string giving the duration of the Emacs initialization. +FORMAT is a string to format the result, using `format'. If nil, +the default format \"%f seconds\" is used." (interactive) - (let ((str - (format "%s seconds" - (float-time - (time-subtract after-init-time before-init-time))))) + (let ((str (format (or format "%f seconds") + (float-time (time-subtract after-init-time + before-init-time))))) (if (called-interactively-p 'interactive) (message "%s" str) str))) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 57e5570d537..186bf35fe7e 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -1,4 +1,4 @@ -;;; tutorial.el --- tutorial for Emacs +;;; tutorial.el --- tutorial for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -25,10 +25,6 @@ ;; Code for running the Emacs tutorial. -;;; History: - -;; File was created 2006-09. - ;;; Code: (require 'help-mode) ;; for function help-buffer @@ -517,8 +513,8 @@ where (list "more info" 'current-binding key-fun def-fun key where)) nil)) - (add-to-list 'changed-keys - (list key def-fun def-fun-txt where remark nil)))))) + (push (list key def-fun def-fun-txt where remark nil) + changed-keys))))) changed-keys)) (defun tutorial--key-description (key) @@ -768,7 +764,7 @@ Run the Viper tutorial? ")) (if (fboundp 'viper-tutorial) (if (y-or-n-p (concat prompt1 prompt2)) (progn (message "") - (funcall 'viper-tutorial 0)) + (funcall #'viper-tutorial 0)) (message "Tutorial aborted by user")) (message prompt1))) (let* ((lang (cond diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1 index 5a3bf3afd1a..cdd37a64cdd 100644 --- a/lisp/url/ChangeLog.1 +++ b/lisp/url/ChangeLog.1 @@ -2337,7 +2337,7 @@ recurse when retrieving the property lists. Returns an assoc list keyed off of the resource, the cdr of which is a property list. (url-dav-datatype-attribute): We support the XML-Data note - (http://www.w3.org/TR/1998/NOTE-XML-data) to figure out what the + (https://www.w3.org/TR/1998/NOTE-XML-data) to figure out what the datatypes of attributes are. Currently only date, dateTime, int, number, float, boolean, and uri are supported. diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 085159cb500..27f4f88cb89 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -60,7 +60,7 @@ (defcustom url-cookie-multiple-line nil "If nil, HTTP requests put all cookies for the server on one line. -Some web servers, such as http://www.hotmail.com/, only accept cookies +Some web servers, such as https://www.hotmail.com/, only accept cookies when they are on one line. This is broken behavior, but just try telling Microsoft that." :type 'boolean diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 585a28291ae..49cc587590e 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -27,11 +27,6 @@ (require 'nntp) (autoload 'gnus-group-read-ephemeral-group "gnus-group") -;; Unused. -;;; (defgroup url-news nil -;;; "News related options." -;;; :group 'url) - (defun url-news-open-host (host port user pass) (if (fboundp 'nnheader-init-server-buffer) (nnheader-init-server-buffer)) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 342b4cc32b1..2c72c45f4b2 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2826,7 +2826,7 @@ hunk text is not found in the source file." ;;; Support for converting a diff to diff3 markers via `wiggle'. -;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest +;; Wiggle can be found at https://neil.brown.name/wiggle/ or in your nearest ;; Debian repository. (defun diff-wiggle () diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 465ed8735c2..fda8605c679 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -252,7 +252,7 @@ included in the completions." ;; Do not use the `file-name-directory' here: git-ls-files ;; sometimes fails to return the correct status for relative ;; path specs. - ;; See also: http://marc.info/?l=git&m=125787684318129&w=2 + ;; See also: https://marc.info/?l=git&m=125787684318129&w=2 (name (file-relative-name file dir)) (str (with-demoted-errors "Error: %S" (cd dir) diff --git a/lisp/view.el b/lisp/view.el index 026c1ece304..3476ced3f79 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -1,4 +1,4 @@ -;;; view.el --- peruse file or buffer without editing +;;; view.el --- peruse file or buffer without editing -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2021 Free Software ;; Foundation, Inc. @@ -26,9 +26,9 @@ ;; This package provides the `view' minor mode documented in the Emacs ;; user's manual. -;; View mode entry and exit is done through the functions view-mode-enter -;; and view-mode-exit. Use these functions to enter or exit view-mode from -;; emacs lisp programs. +;; View mode entry and exit is done through the functions `view-mode-enter' +;; and `view-mode-exit'. Use these functions to enter or exit `view-mode' from +;; Emacs Lisp programs. ;; We use both view- and View- as prefix for symbols. View- is used as ;; prefix for commands that have a key binding. view- is used for commands ;; without key binding. The purpose of this is to make it easier for a @@ -36,11 +36,11 @@ ;;; Suggested key bindings: ;; -;; (define-key ctl-x-4-map "v" 'view-file-other-window) ; ^x4v -;; (define-key ctl-x-5-map "v" 'view-file-other-frame) ; ^x5v +;; (define-key ctl-x-4-map "v" #'view-file-other-window) ; ^x4v +;; (define-key ctl-x-5-map "v" #'view-file-other-frame) ; ^x5v ;; -;; You could also bind view-file, view-buffer, view-buffer-other-window and -;; view-buffer-other-frame to keys. +;; You could also bind `view-file', `view-buffer', `view-buffer-other-window' and +;; `view-buffer-other-frame' to keys. ;;; Code: @@ -51,31 +51,27 @@ :group 'text) (defcustom view-highlight-face 'highlight - "The face used for highlighting the match found by View mode search." - :type 'face - :group 'view) + "The face used for highlighting the match found by View mode search." + :type 'face) (defcustom view-scroll-auto-exit nil "Non-nil means scrolling past the end of buffer exits View mode. A value of nil means attempting to scroll past the end of the buffer, only rings the bell and gives a message on how to leave." - :type 'boolean - :group 'view) + :type 'boolean) (defcustom view-try-extend-at-buffer-end nil "Non-nil means try to load more of file when reaching end of buffer. This variable is mainly intended to be temporarily set to non-nil by -the F command in view-mode, but you can set it to t if you want the action +the F command in `view-mode', but you can set it to t if you want the action for all scroll commands in view mode." - :type 'boolean - :group 'view) + :type 'boolean) ;;;###autoload (defcustom view-remove-frame-by-deleting t "Determine how View mode removes a frame no longer needed. If nil, make an icon of the frame. If non-nil, delete the frame." :type 'boolean - :group 'view :version "23.1") (defcustom view-exits-all-viewing-windows nil @@ -84,15 +80,13 @@ Commands that restore windows when finished viewing a buffer, apply to all windows that display the buffer and have restore information. If `view-exits-all-viewing-windows' is nil, only the selected window is considered for restoring." - :type 'boolean - :group 'view) + :type 'boolean) (defcustom view-inhibit-help-message nil "Non-nil inhibits the help message shown upon entering View mode. This setting takes effect only when View mode is entered via an interactive command; otherwise the help message is not shown." :type 'boolean - :group 'view :version "22.1") ;;;###autoload @@ -103,8 +97,7 @@ functions that enable or disable view mode.") (defcustom view-mode-hook nil "Normal hook run when starting to view a buffer or file." - :type 'hook - :group 'view) + :type 'hook) (defvar-local view-old-buffer-read-only nil) @@ -154,62 +147,62 @@ This is local in each buffer, once it is used.") ;; Some redundant "less"-like key bindings below have been commented out. (defvar view-mode-map (let ((map (make-sparse-keymap))) - (define-key map "C" 'View-kill-and-leave) - (define-key map "c" 'View-leave) - (define-key map "Q" 'View-quit-all) - (define-key map "E" 'View-exit-and-edit) - ;; (define-key map "v" 'View-exit) - (define-key map "e" 'View-exit) - (define-key map "q" 'View-quit) - ;; (define-key map "N" 'View-search-last-regexp-backward) - (define-key map "p" 'View-search-last-regexp-backward) - (define-key map "n" 'View-search-last-regexp-forward) - ;; (define-key map "?" 'View-search-regexp-backward) ; Less does this. - (define-key map "\\" 'View-search-regexp-backward) - (define-key map "/" 'View-search-regexp-forward) - (define-key map "r" 'isearch-backward) - (define-key map "s" 'isearch-forward) - (define-key map "m" 'point-to-register) - (define-key map "'" 'register-to-point) - (define-key map "x" 'exchange-point-and-mark) - (define-key map "@" 'View-back-to-mark) - (define-key map "." 'set-mark-command) - (define-key map "%" 'View-goto-percent) - ;; (define-key map "G" 'View-goto-line-last) - (define-key map "g" 'View-goto-line) - (define-key map "=" 'what-line) - (define-key map "F" 'View-revert-buffer-scroll-page-forward) - ;; (define-key map "k" 'View-scroll-line-backward) - (define-key map "y" 'View-scroll-line-backward) - ;; (define-key map "j" 'View-scroll-line-forward) - (define-key map "\n" 'View-scroll-line-forward) - (define-key map "\r" 'View-scroll-line-forward) - (define-key map "u" 'View-scroll-half-page-backward) - (define-key map "d" 'View-scroll-half-page-forward) - (define-key map "z" 'View-scroll-page-forward-set-page-size) - (define-key map "w" 'View-scroll-page-backward-set-page-size) - ;; (define-key map "b" 'View-scroll-page-backward) - (define-key map "\C-?" 'View-scroll-page-backward) - ;; (define-key map "f" 'View-scroll-page-forward) - (define-key map " " 'View-scroll-page-forward) - (define-key map [?\S-\ ] 'View-scroll-page-backward) - (define-key map "o" 'View-scroll-to-buffer-end) - (define-key map ">" 'end-of-buffer) - (define-key map "<" 'beginning-of-buffer) - (define-key map "-" 'negative-argument) - (define-key map "9" 'digit-argument) - (define-key map "8" 'digit-argument) - (define-key map "7" 'digit-argument) - (define-key map "6" 'digit-argument) - (define-key map "5" 'digit-argument) - (define-key map "4" 'digit-argument) - (define-key map "3" 'digit-argument) - (define-key map "2" 'digit-argument) - (define-key map "1" 'digit-argument) - (define-key map "0" 'digit-argument) - (define-key map "H" 'describe-mode) - (define-key map "?" 'describe-mode) ; Maybe do as less instead? See above. - (define-key map "h" 'describe-mode) + (define-key map "C" #'View-kill-and-leave) + (define-key map "c" #'View-leave) + (define-key map "Q" #'View-quit-all) + (define-key map "E" #'View-exit-and-edit) + ;; (define-key map "v" #'View-exit) + (define-key map "e" #'View-exit) + (define-key map "q" #'View-quit) + ;; (define-key map "N" #'View-search-last-regexp-backward) + (define-key map "p" #'View-search-last-regexp-backward) + (define-key map "n" #'View-search-last-regexp-forward) + ;; (define-key map "?" #'View-search-regexp-backward) ; Less does this. + (define-key map "\\" #'View-search-regexp-backward) + (define-key map "/" #'View-search-regexp-forward) + (define-key map "r" #'isearch-backward) + (define-key map "s" #'isearch-forward) + (define-key map "m" #'point-to-register) + (define-key map "'" #'register-to-point) + (define-key map "x" #'exchange-point-and-mark) + (define-key map "@" #'View-back-to-mark) + (define-key map "." #'set-mark-command) + (define-key map "%" #'View-goto-percent) + ;; (define-key map "G" #'View-goto-line-last) + (define-key map "g" #'View-goto-line) + (define-key map "=" #'what-line) + (define-key map "F" #'View-revert-buffer-scroll-page-forward) + ;; (define-key map "k" #'View-scroll-line-backward) + (define-key map "y" #'View-scroll-line-backward) + ;; (define-key map "j" #'View-scroll-line-forward) + (define-key map "\n" #'View-scroll-line-forward) + (define-key map "\r" #'View-scroll-line-forward) + (define-key map "u" #'View-scroll-half-page-backward) + (define-key map "d" #'View-scroll-half-page-forward) + (define-key map "z" #'View-scroll-page-forward-set-page-size) + (define-key map "w" #'View-scroll-page-backward-set-page-size) + ;; (define-key map "b" #'View-scroll-page-backward) + (define-key map "\C-?" #'View-scroll-page-backward) + ;; (define-key map "f" #'View-scroll-page-forward) + (define-key map " " #'View-scroll-page-forward) + (define-key map [?\S-\ ] #'View-scroll-page-backward) + (define-key map "o" #'View-scroll-to-buffer-end) + (define-key map ">" #'end-of-buffer) + (define-key map "<" #'beginning-of-buffer) + (define-key map "-" #'negative-argument) + (define-key map "9" #'digit-argument) + (define-key map "8" #'digit-argument) + (define-key map "7" #'digit-argument) + (define-key map "6" #'digit-argument) + (define-key map "5" #'digit-argument) + (define-key map "4" #'digit-argument) + (define-key map "3" #'digit-argument) + (define-key map "2" #'digit-argument) + (define-key map "1" #'digit-argument) + (define-key map "0" #'digit-argument) + (define-key map "H" #'describe-mode) + (define-key map "?" #'describe-mode) ; Maybe do as less instead? See above. + (define-key map "h" #'describe-mode) map)) ;;; Commands that enter or exit view mode. @@ -220,7 +213,7 @@ This is local in each buffer, once it is used.") ;; types C-x C-q again to return to view mode. ;;;###autoload (defun kill-buffer-if-not-modified (buf) - "Like `kill-buffer', but does nothing if the buffer is modified." + "Like `kill-buffer', but does nothing if buffer BUF is modified." (let ((buf (get-buffer buf))) (and buf (not (buffer-modified-p buf)) (kill-buffer buf)))) @@ -305,7 +298,7 @@ file: Users may suspend viewing in order to modify the buffer. Exiting View mode will then discard the user's edits. Setting EXIT-ACTION to `kill-buffer-if-not-modified' avoids this. -This function does not enable View mode if the buffer's major-mode +This function does not enable View mode if the buffer's major mode has a `special' mode-class, because such modes usually have their own View-like bindings." (interactive "bView buffer: ") @@ -331,7 +324,7 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as argument. This function is called when finished viewing buffer. Use this argument instead of explicitly setting `view-exit-action'. -This function does not enable View mode if the buffer's major-mode +This function does not enable View mode if the buffer's major mode has a `special' mode-class, because such modes usually have their own View-like bindings." (interactive "bIn other window view buffer:\nP") @@ -358,7 +351,7 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as argument. This function is called when finished viewing buffer. Use this argument instead of explicitly setting `view-exit-action'. -This function does not enable View mode if the buffer's major-mode +This function does not enable View mode if the buffer's major mode has a `special' mode-class, because such modes usually have their own View-like bindings." (interactive "bView buffer in other frame: \nP") @@ -662,8 +655,8 @@ previous state and go to previous buffer or window." (recenter '(1))) (defun view-page-size-default (lines) - ;; If LINES is nil, 0, or larger than `view-window-size', return nil. - ;; Otherwise, return LINES. + "If LINES is nil, 0, or larger than `view-window-size', return nil. +Otherwise, return LINES." (and lines (not (zerop (setq lines (prefix-numeric-value lines)))) (<= (abs lines) @@ -671,7 +664,7 @@ previous state and go to previous buffer or window." (abs lines))) (defun view-set-half-page-size-default (lines) - ;; Get and maybe set half page size. + "Get and maybe set half page size." (if (not lines) (or view-half-page-size (/ (view-window-size) 2)) (setq view-half-page-size @@ -749,7 +742,7 @@ invocations return to earlier marks." (if (view-really-at-end) (view-end-message))))) (defun view-really-at-end () - ;; Return true if buffer end visible. Maybe revert buffer and test. + "Return non-nil if buffer end visible. Maybe revert buffer and test." (and (or (null scroll-error-top-bottom) (eobp)) (pos-visible-in-window-p (point-max)) (let ((buf (current-buffer)) @@ -772,7 +765,7 @@ invocations return to earlier marks." (pos-visible-in-window-p (point-max))))))) (defun view-end-message () - ;; Tell that we are at end of buffer. + "Tell that we are at end of buffer." (goto-char (point-max)) (if (window-parameter nil 'quit-restore) (message "End of buffer. Type %s to quit viewing." @@ -979,7 +972,7 @@ for highlighting the match that is found." ;; https://lists.gnu.org/r/bug-gnu-emacs/2007-09/msg00073.html (defun view-search-no-match-lines (times regexp) "Search for the TIMESth occurrence of a line with no match for REGEXP. -If such a line is found, return non-nil and set the match-data to that line. +If such a line is found, return non-nil and set the match data to that line. If TIMES is negative, search backwards." (let ((step (if (>= times 0) 1 (setq times (- times)) diff --git a/lisp/wdired.el b/lisp/wdired.el index c495d8de341..43026d4bb7a 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -1,4 +1,4 @@ -;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*- +;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; lexical-binding: t; -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. @@ -85,15 +85,13 @@ If nil, WDired doesn't require confirmation to change the file names, and the variable `wdired-confirm-overwrite' controls whether it is ok to overwrite files without asking." - :type 'boolean - :group 'wdired) + :type 'boolean) (defcustom wdired-confirm-overwrite t "If nil the renames can overwrite files without asking. This variable has no effect at all if `wdired-use-interactive-rename' is not nil." - :type 'boolean - :group 'wdired) + :type 'boolean) (defcustom wdired-use-dired-vertical-movement nil "If t, the \"up\" and \"down\" movement works as in Dired mode. @@ -106,15 +104,13 @@ when editing several filenames. If nil, \"up\" and \"down\" movement is done as in any other buffer." :type '(choice (const :tag "As in any other mode" nil) (const :tag "Smart cursor placement" sometimes) - (other :tag "As in dired mode" t)) - :group 'wdired) + (other :tag "As in dired mode" t))) (defcustom wdired-allow-to-redirect-links t "If non-nil, the target of the symbolic links are editable. In systems without symbolic links support, this variable has no effect at all." - :type 'boolean - :group 'wdired) + :type 'boolean) (defcustom wdired-allow-to-change-permissions nil "If non-nil, the permissions bits of the files are editable. @@ -135,8 +131,7 @@ Anyway, the real change of the permissions is done by the external program `dired-chmod-program', which must exist." :type '(choice (const :tag "Not allowed" nil) (const :tag "Toggle/set bits" t) - (other :tag "Bits freely editable" advanced)) - :group 'wdired) + (other :tag "Bits freely editable" advanced))) (defcustom wdired-keep-marker-rename t ;; Use t as default so that renamed files "take their markers with them". @@ -149,8 +144,7 @@ See `dired-keep-marker-rename' if you want to do the same for files renamed by `dired-do-rename' and `dired-do-rename-regexp'." :type '(choice (const :tag "Keep" t) (character :tag "Mark" :value ?R)) - :version "24.3" - :group 'wdired) + :version "24.3") (defcustom wdired-create-parent-directories t "If non-nil, create parent directories of destination files. @@ -159,26 +153,25 @@ nonexistent directory, wdired will create any parent directories necessary. When nil, attempts to rename a file into a nonexistent directory will fail." :version "26.1" - :type 'boolean - :group 'wdired) + :type 'boolean) (defvar wdired-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-x\C-s" 'wdired-finish-edit) - (define-key map "\C-c\C-c" 'wdired-finish-edit) - (define-key map "\C-c\C-k" 'wdired-abort-changes) - (define-key map "\C-c\C-[" 'wdired-abort-changes) - (define-key map "\C-x\C-q" 'wdired-exit) - (define-key map "\C-m" 'undefined) - (define-key map "\C-j" 'undefined) - (define-key map "\C-o" 'undefined) - (define-key map [up] 'wdired-previous-line) - (define-key map "\C-p" 'wdired-previous-line) - (define-key map [down] 'wdired-next-line) - (define-key map "\C-n" 'wdired-next-line) - (define-key map [remap upcase-word] 'wdired-upcase-word) - (define-key map [remap capitalize-word] 'wdired-capitalize-word) - (define-key map [remap downcase-word] 'wdired-downcase-word) + (define-key map "\C-x\C-s" #'wdired-finish-edit) + (define-key map "\C-c\C-c" #'wdired-finish-edit) + (define-key map "\C-c\C-k" #'wdired-abort-changes) + (define-key map "\C-c\C-[" #'wdired-abort-changes) + (define-key map "\C-x\C-q" #'wdired-exit) + (define-key map "\C-m" #'undefined) + (define-key map "\C-j" #'undefined) + (define-key map "\C-o" #'undefined) + (define-key map [up] #'wdired-previous-line) + (define-key map "\C-p" #'wdired-previous-line) + (define-key map [down] #'wdired-next-line) + (define-key map "\C-n" #'wdired-next-line) + (define-key map [remap upcase-word] #'wdired-upcase-word) + (define-key map [remap capitalize-word] #'wdired-capitalize-word) + (define-key map [remap downcase-word] #'wdired-downcase-word) map) "Keymap used in `wdired-mode'.") @@ -249,11 +242,11 @@ See `wdired-mode'." (force-mode-line-update) (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-properties nil t) + (add-hook 'kill-buffer-hook #'wdired-check-kill-buffer 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) + (add-function :override (local 'revert-buffer-function) #'wdired-revert) ;; I temp disable undo for performance: since I'm going to clear the ;; undo list, it can save more than a 9% of time with big ;; directories because setting properties modify the undo-list. @@ -386,10 +379,9 @@ non-nil means return old filename." (setq major-mode 'dired-mode) (setq mode-name "Dired") (dired-advertise) - (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) - (remove-hook 'after-change-functions 'wdired--restore-properties t) - (setq-local revert-buffer-function 'dired-revert)) - + (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t) + (remove-hook 'after-change-functions #'wdired--restore-properties t) + (remove-function (local 'revert-buffer-function) #'wdired-revert)) (defun wdired-abort-changes () "Abort changes and return to dired mode." @@ -537,7 +529,7 @@ non-nil means return old filename." ;; So we must ensure dired-aux is loaded. (require 'dired-aux) (condition-case err - (let ((dired-backup-overwrite nil)) + (dlet ((dired-backup-overwrite nil)) (and wdired-create-parent-directories (wdired-create-parentdirs file-new)) (dired-rename-file file-ori file-new @@ -814,18 +806,18 @@ Like original function but it skips read-only words." (defvar wdired-perm-mode-map (let ((map (make-sparse-keymap))) - (define-key map " " 'wdired-toggle-bit) - (define-key map "r" 'wdired-set-bit) - (define-key map "w" 'wdired-set-bit) - (define-key map "x" 'wdired-set-bit) - (define-key map "-" 'wdired-set-bit) - (define-key map "S" 'wdired-set-bit) - (define-key map "s" 'wdired-set-bit) - (define-key map "T" 'wdired-set-bit) - (define-key map "t" 'wdired-set-bit) - (define-key map "s" 'wdired-set-bit) - (define-key map "l" 'wdired-set-bit) - (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit) + (define-key map " " #'wdired-toggle-bit) + (define-key map "r" #'wdired-set-bit) + (define-key map "w" #'wdired-set-bit) + (define-key map "x" #'wdired-set-bit) + (define-key map "-" #'wdired-set-bit) + (define-key map "S" #'wdired-set-bit) + (define-key map "s" #'wdired-set-bit) + (define-key map "T" #'wdired-set-bit) + (define-key map "t" #'wdired-set-bit) + (define-key map "s" #'wdired-set-bit) + (define-key map "l" #'wdired-set-bit) + (define-key map [mouse-1] #'wdired-mouse-toggle-bit) map)) ;; Put a keymap property to the permission bits of the files, and store the diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index 39b32217628..54b71c9f9f6 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -1,7 +1,7 @@ -;;; wid-browse.el --- functions for browsing widgets -;; +;;; wid-browse.el --- functions for browsing widgets -*- lexical-binding: t -*- + ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. -;; + ;; Author: Per Abrahamsen ;; Keywords: extensions ;; Package: emacs @@ -22,7 +22,7 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;; + ;; Widget browser. See `widget.el'. ;;; Code: @@ -38,7 +38,7 @@ (defvar widget-browse-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map widget-keymap) - (define-key map "q" 'bury-buffer) + (define-key map "q" #'bury-buffer) map) "Keymap for `widget-browse-mode'.") diff --git a/lisp/window.el b/lisp/window.el index cfd9876ed05..f27631bb86a 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4158,7 +4158,7 @@ returned by `window-start' and `window-point' respectively. This function is called only if `switch-to-buffer-preserve-window-point' evaluates non-nil." - (dolist (win (window-list)) + (dolist (win (window-list nil 'no-minibuf)) (let* ((buf (window-buffer (or window win))) (start (window-start win)) (pos (window-point win)) @@ -4416,7 +4416,8 @@ WINDOW must be a live window and defaults to the selected one." window (assq-delete-all buffer (window-prev-buffers window)))) ;; Don't record insignificant buffers. - (unless (eq (aref (buffer-name buffer) 0) ?\s) + (when (or (not (eq (aref (buffer-name buffer) 0) ?\s)) + (minibufferp buffer)) ;; Add an entry for buffer to WINDOW's previous buffers. (with-current-buffer buffer (let ((start (window-start window)) diff --git a/src/editfns.c b/src/editfns.c index bc6553a7d2c..87e743afc31 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3138,7 +3138,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) char *format_start = SSDATA (args[0]); bool multibyte_format = STRING_MULTIBYTE (args[0]); ptrdiff_t formatlen = SBYTES (args[0]); - bool fmt_props = string_intervals (args[0]); + bool fmt_props = !!string_intervals (args[0]); /* Upper bound on number of format specs. Each uses at least 2 chars. */ ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1; diff --git a/src/fns.c b/src/fns.c index 766e767e123..2cd59c83d91 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2279,6 +2279,52 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred) } } +Lisp_Object +merge_c (Lisp_Object org_l1, Lisp_Object org_l2, bool (*less) (Lisp_Object, Lisp_Object)) +{ + Lisp_Object l1 = org_l1; + Lisp_Object l2 = org_l2; + Lisp_Object tail = Qnil; + Lisp_Object value = Qnil; + + while (1) + { + if (NILP (l1)) + { + if (NILP (tail)) + return l2; + Fsetcdr (tail, l2); + return value; + } + if (NILP (l2)) + { + if (NILP (tail)) + return l1; + Fsetcdr (tail, l1); + return value; + } + + Lisp_Object tem; + if (less (Fcar (l1), Fcar (l2))) + { + tem = l1; + l1 = Fcdr (l1); + org_l1 = l1; + } + else + { + tem = l2; + l2 = Fcdr (l2); + org_l2 = l2; + } + if (NILP (tail)) + value = tem; + else + Fsetcdr (tail, tem); + tail = tem; + } +} + /* This does not check for quits. That is safe since it must terminate. */ diff --git a/src/frame.c b/src/frame.c index cfdf3b61938..66ae4943ba2 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1487,7 +1487,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor #endif internal_last_event_frame = Qnil; - move_minibuffer_onto_frame (); + move_minibuffers_onto_frame (sf, for_deletion); return frame; } diff --git a/src/lisp.h b/src/lisp.h index 4004b535cdf..474e49c8e1e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3628,6 +3628,7 @@ extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); +extern Lisp_Object merge_c (Lisp_Object, Lisp_Object, bool (*) (Lisp_Object, Lisp_Object)); extern Lisp_Object do_yes_or_no_p (Lisp_Object); extern int string_version_cmp (Lisp_Object, Lisp_Object); extern Lisp_Object concat2 (Lisp_Object, Lisp_Object); @@ -4370,7 +4371,7 @@ extern void clear_regexp_cache (void); extern Lisp_Object Vminibuffer_list; extern Lisp_Object last_minibuf_string; -extern void move_minibuffer_onto_frame (void); +extern void move_minibuffers_onto_frame (struct frame *, bool); extern bool is_minibuffer (EMACS_INT, Lisp_Object); extern EMACS_INT this_minibuffer_depth (Lisp_Object); extern EMACS_INT minibuf_level; diff --git a/src/minibuf.c b/src/minibuf.c index 4b1f4b1ff72..c9831fd50f4 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -59,6 +59,12 @@ Lisp_Object last_minibuf_string; static Lisp_Object minibuf_prompt; +/* The frame containinug the most recently opened Minibuffer. This is + used only when `minibuffer-follows-selected-frame' is neither nil + nor t. */ + +static Lisp_Object MB_frame; + /* Width of current mini-buffer prompt. Only set after display_line of the line that contains the prompt. */ @@ -67,6 +73,7 @@ static ptrdiff_t minibuf_prompt_width; static Lisp_Object nth_minibuffer (EMACS_INT depth); static EMACS_INT minibuf_c_loop_level (EMACS_INT depth); static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth); +static bool live_minibuffer_p (Lisp_Object); /* Return TRUE when a frame switch causes a minibuffer on the old @@ -78,6 +85,7 @@ minibuf_follows_frame (void) Qt); } +#if 0 /* Return TRUE when a minibuffer always remains on the frame where it was first invoked. */ static bool @@ -85,6 +93,7 @@ minibuf_stays_put (void) { return NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame)); } +#endif /* Return TRUE when opening a (recursive) minibuffer causes minibuffers on other frames to move to the selected frame. */ @@ -112,84 +121,85 @@ choose_minibuf_frame (void) emacs_abort (); minibuf_window = sf->minibuffer_window; - /* If we've still got another minibuffer open, use its mini-window - instead. */ - if (minibuf_level > 1 && minibuf_stays_put ()) - { - Lisp_Object buffer = get_minibuffer (minibuf_level); - Lisp_Object tail, frame; - - FOR_EACH_FRAME (tail, frame) - if (EQ (XWINDOW (XFRAME (frame)->minibuffer_window)->contents, - buffer)) - { - minibuf_window = XFRAME (frame)->minibuffer_window; - break; - } - } } - - if (minibuf_moves_frame_when_opened () - && FRAMEP (selected_frame) - && FRAME_LIVE_P (XFRAME (selected_frame))) - /* Make sure no other frame has a minibuffer as its selected window, - because the text would not be displayed in it, and that would be - confusing. Only allow the selected frame to do this, - and that only if the minibuffer is active. */ - { - Lisp_Object tail, frame; - struct frame *of; - - FOR_EACH_FRAME (tail, frame) - if (!EQ (frame, selected_frame) - && minibuf_level > 1 - /* The frame's minibuffer can be on a different frame. */ - && ! EQ (XWINDOW ((of = XFRAME (frame))->minibuffer_window)->frame, - selected_frame)) - { - if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of)))) - Fset_frame_selected_window (frame, Fframe_first_window (frame), - Qnil); - - if (!EQ (XWINDOW (of->minibuffer_window)->contents, - nth_minibuffer (0))) - set_window_buffer (of->minibuffer_window, - nth_minibuffer (0), 0, 0); - } - } } -/* If `minibuffer_follows_selected_frame' is t and we have a - minibuffer, move it from its current frame to the selected frame. - This function is intended to be called from `do_switch_frame' in - frame.c. */ -void move_minibuffer_onto_frame (void) +/* If ENT1 has a higher minibuffer index than ENT2, return true. More +precisely, compare the buffer components of each window->prev_buffers +entry. */ +static bool +minibuffer_ent_greater (Lisp_Object ent1, Lisp_Object ent2) { - if (!minibuf_level) - return; - if (!minibuf_follows_frame ()) - return; - if (FRAMEP (selected_frame) - && FRAME_LIVE_P (XFRAME (selected_frame)) - && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window)) + return this_minibuffer_depth (Fcar (ent1)) + > this_minibuffer_depth (Fcar (ent2)) ; +} + +/* Move the ordered "stack" of minibuffers from SOURCE_WINDOW to + DEST_WINDOW, interleaving those minibuffers with any in DEST_WINDOW + to produce an ordered combination. The ordering is by minibuffer + depth. A stack of minibuffers consists of the minibuffer currently + in DEST/SOURCE_WINDOW together with any recorded in the + ->prev_buffers field of the struct window. */ +static void +zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window) +{ + struct window *dw = XWINDOW (dest_window); + struct window *sw = XWINDOW (source_window); + Lisp_Object acc; + Lisp_Object d_ent; /* Entry from dw->prev_buffers */ + + if (!live_minibuffer_p (dw->contents) + && NILP (dw->prev_buffers)) { - EMACS_INT i; - struct frame *sf = XFRAME (selected_frame); - Lisp_Object old_frame = XWINDOW (minibuf_window)->frame; - struct frame *of = XFRAME (old_frame); + set_window_buffer (dest_window, sw->contents, 0, 0); + Fset_window_start (dest_window, Fwindow_start (source_window), Qnil); + Fset_window_point (dest_window, Fwindow_point (source_window)); + dw->prev_buffers = sw->prev_buffers; + set_window_buffer (source_window, get_minibuffer (0), 0, 0); + sw->prev_buffers = Qnil; + return; + } - /* Stack up all the (recursively) open minibuffers on the selected - mini_window. */ - for (i = 1; i <= minibuf_level; i++) - set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0); - minibuf_window = sf->minibuffer_window; - if (of != sf) - { - Lisp_Object temp = get_minibuffer (0); + if (live_minibuffer_p (dw->contents)) + call1 (Qrecord_window_buffer, dest_window); + if (live_minibuffer_p (sw->contents)) + call1 (Qrecord_window_buffer, source_window); - set_window_buffer (of->minibuffer_window, temp, 0, 0); - set_minibuffer_mode (temp, 0); - } + acc = merge_c (dw->prev_buffers, sw->prev_buffers, minibuffer_ent_greater); + + if (!NILP (acc)) + { + d_ent = Fcar (acc); + acc = Fcdr (acc); + set_window_buffer (dest_window, Fcar (d_ent), 0, 0); + Fset_window_start (dest_window, Fcar (Fcdr (d_ent)), Qnil); + Fset_window_point (dest_window, Fcar (Fcdr (Fcdr (d_ent)))); + } + dw->prev_buffers = acc; + sw->prev_buffers = Qnil; + set_window_buffer (source_window, get_minibuffer (0), 0, 0); +} + +/* If `minibuffer_follows_selected_frame' is t, or we're about to + delete a frame which potentially "contains" minibuffers, move them + from the old frame to the selected frame. This function is + intended to be called from `do_switch_frame' in frame.c. OF is the + old frame, FOR_DELETION is true if OF is about to be deleted. */ +void +move_minibuffers_onto_frame (struct frame *of, bool for_deletion) +{ + struct frame *f = XFRAME (selected_frame); + + minibuf_window = f->minibuffer_window; + if (!(minibuf_level + && (for_deletion || minibuf_follows_frame () || FRAME_INITIAL_P (of)))) + return; + if (FRAME_LIVE_P (f) + && !EQ (f->minibuffer_window, of->minibuffer_window)) + { + zip_minibuffer_stacks (f->minibuffer_window, of->minibuffer_window); + if (for_deletion && XFRAME (MB_frame) != of) + MB_frame = selected_frame; } } @@ -221,6 +231,7 @@ without invoking the usual minibuffer commands. */) /* Actual minibuffer invocation. */ static void read_minibuf_unwind (void); +static void minibuffer_unwind (void); static void run_exit_minibuf_hook (void); @@ -544,7 +555,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object histval; Lisp_Object empty_minibuf; - Lisp_Object dummy, frame; specbind (Qminibuffer_default, defalt); specbind (Qinhibit_read_only, Qnil); @@ -626,17 +636,24 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); if (minibuf_level > 1 + && !EQ (XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame, + MB_frame) && minibuf_moves_frame_when_opened () - && (!minibuf_follows_frame () - || (!EQ (mini_frame, selected_frame)))) + && (!minibuf_follows_frame ())) { - EMACS_INT i; + struct frame *of = XFRAME (MB_frame); - /* Stack up the existing minibuffers on the current mini-window */ - for (i = 1; i < minibuf_level; i++) - set_window_buffer (minibuf_window, nth_minibuffer (i), 0, 0); + zip_minibuffer_stacks (minibuf_window, of->minibuffer_window); + /* MB_frame's minibuffer can be on a different frame. */ + if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of)))) + Fset_frame_selected_window (MB_frame, + Fframe_first_window (MB_frame), Qnil); } + MB_frame = XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame; + if (live_minibuffer_p (XWINDOW (minibuf_window)->contents)) + call1 (Qrecord_window_buffer, minibuf_window); + record_unwind_protect_void (minibuffer_unwind); record_unwind_protect (restore_window_configuration, Fcons (Qt, Fcurrent_window_configuration (Qnil))); @@ -771,23 +788,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, empty_minibuf = get_minibuffer (0); set_minibuffer_mode (empty_minibuf, 0); - FOR_EACH_FRAME (dummy, frame) - { - Lisp_Object root_window = Fframe_root_window (frame); - Lisp_Object mini_window = XWINDOW (root_window)->next; - Lisp_Object buffer; - - if (!NILP (mini_window) && !EQ (mini_window, minibuf_window) - && !NILP (Fwindow_minibuffer_p (mini_window))) - { - buffer = XWINDOW (mini_window)->contents; - if (!live_minibuffer_p (buffer)) - /* Use set_window_buffer instead of Fset_window_buffer (see - discussion of bug#11984, bug#12025, bug#12026). */ - set_window_buffer (mini_window, empty_minibuf, 0, 0); - } - } - /* Display this minibuffer in the proper window. */ /* Use set_window_buffer instead of Fset_window_buffer (see discussion of bug#11984, bug#12025, bug#12026). */ @@ -908,7 +908,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, unbind_to (count, Qnil); /* Switch the frame back to the calling frame. */ - if (!EQ (selected_frame, calling_frame) + if ((!EQ (selected_frame, calling_frame) + || !EQ (XWINDOW (XFRAME (calling_frame)->minibuffer_window)->frame, + calling_frame)) && FRAMEP (calling_frame) && FRAME_LIVE_P (XFRAME (calling_frame))) call2 (intern ("select-frame-set-input-focus"), calling_frame, Qnil); @@ -1026,6 +1028,14 @@ run_exit_minibuf_hook (void) safe_run_hooks (Qminibuffer_exit_hook); } +/* This variable records the expired minibuffer's frame between the + calls of `read_minibuf_unwind' and `minibuffer_unwind'. It should + be used only by these two functions. Note that the same search + method for the MB's frame won't always work in `minibuffer_unwind' + because the intervening `restore-window-configuration' will have + changed the buffer in the mini-window. */ +static Lisp_Object exp_MB_frame; + /* This function is called on exiting minibuffer, whether normally or not, and it restores the current window, buffer, etc. */ @@ -1036,6 +1046,28 @@ read_minibuf_unwind (void) Lisp_Object calling_frame; Lisp_Object calling_window; Lisp_Object future_mini_window; + Lisp_Object saved_selected_frame = selected_frame; + Lisp_Object window, frames; + struct window *w; + struct frame *f; + + /* Locate the expired minibuffer. */ + FOR_EACH_FRAME (frames, exp_MB_frame) + { + f = XFRAME (exp_MB_frame); + window = f->minibuffer_window; + w = XWINDOW (window); + if (EQ (w->frame, exp_MB_frame) + && EQ (w->contents, nth_minibuffer (minibuf_level))) + goto found; + } + return; /* expired minibuffer not found. Maybe we should output an + error, here. */ + + found: + if (!EQ (exp_MB_frame, saved_selected_frame)) + do_switch_frame (exp_MB_frame, 0, 0, Qt); /* This also sets + minibuff_window */ /* To keep things predictable, in case it matters, let's be in the minibuffer when we reset the relevant variables. Don't depend on @@ -1127,20 +1159,61 @@ read_minibuf_unwind (void) away from the expired minibuffer window, both in the current minibuffer's frame and the original calling frame. */ choose_minibuf_frame (); - if (!EQ (WINDOW_FRAME (XWINDOW (minibuf_window)), calling_frame)) - { - Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil); - /* PREV can be on a different frame when we have a minibuffer only - frame, the other frame's minibuffer window is MINIBUF_WINDOW, - and its "focus window" is also MINIBUF_WINDOW. */ - if (!EQ (prev, minibuf_window) - && EQ (WINDOW_FRAME (XWINDOW (prev)), - WINDOW_FRAME (XWINDOW (minibuf_window)))) - Fset_frame_selected_window (selected_frame, prev, Qnil); - } - else - Fset_frame_selected_window (calling_frame, calling_window, Qnil); + if (NILP (XWINDOW (minibuf_window)->prev_buffers)) + { + if (!EQ (WINDOW_FRAME (XWINDOW (minibuf_window)), calling_frame)) + { + Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil); + /* PREV can be on a different frame when we have a minibuffer only + frame, the other frame's minibuffer window is MINIBUF_WINDOW, + and its "focus window" is also MINIBUF_WINDOW. */ + if (!EQ (prev, minibuf_window) + && EQ (WINDOW_FRAME (XWINDOW (prev)), + WINDOW_FRAME (XWINDOW (minibuf_window)))) + Fset_frame_selected_window (selected_frame, prev, Qnil); + } + else + Fset_frame_selected_window (calling_frame, calling_window, Qnil); + } + + /* Restore the selected frame. */ + if (!EQ (exp_MB_frame, saved_selected_frame)) + do_switch_frame (saved_selected_frame, 0, 0, Qt); } + +/* Replace the expired minibuffer in frame exp_MB_frame with the next less + nested minibuffer in that frame, if any. Otherwise, replace it + with the null minibuffer. MINIBUF_WINDOW is not changed. */ +static void +minibuffer_unwind (void) +{ + struct frame *f; + struct window *w; + Lisp_Object window; + Lisp_Object entry; + + f = XFRAME (exp_MB_frame); + window = f->minibuffer_window; + w = XWINDOW (window); + if (FRAME_LIVE_P (f)) + { + /* minibuf_window = sf->minibuffer_window; */ + if (!NILP (w->prev_buffers)) + { + entry = Fcar (w->prev_buffers); + w->prev_buffers = Fcdr (w->prev_buffers); + set_window_buffer (window, Fcar (entry), 0, 0); + Fset_window_start (window, Fcar (Fcdr (entry)), Qnil); + Fset_window_point (window, Fcar (Fcdr (Fcdr (entry)))); + /* set-window-configuration may/will have unselected the + mini-window as the selected window. Restore it. */ + Fset_frame_selected_window (exp_MB_frame, window, Qnil); + } + else + set_window_buffer (window, nth_minibuffer (0), 0, 0); + } +} + void @@ -1417,8 +1490,8 @@ function, instead of the usual behavior. */) STRING_MULTIBYTE (prompt)); } - AUTO_STRING (format, "%s (default %s): "); - prompt = CALLN (Fformat, format, prompt, + prompt = CALLN (Ffuncall, intern("format-prompt"), + prompt, CONSP (def) ? XCAR (def) : def); } @@ -2213,6 +2286,9 @@ syms_of_minibuf (void) { staticpro (&minibuf_prompt); staticpro (&minibuf_save_list); + staticpro (&MB_frame); + MB_frame = Qnil; + staticpro (&exp_MB_frame); DEFSYM (Qminibuffer_follows_selected_frame, "minibuffer-follows-selected-frame"); diff --git a/src/window.c b/src/window.c index f8b97287e64..661b1ae112c 100644 --- a/src/window.c +++ b/src/window.c @@ -6958,7 +6958,8 @@ the return value is nil. Otherwise the value is t. */) if (BUFFERP (w->contents) && !EQ (w->contents, p->buffer) - && BUFFER_LIVE_P (XBUFFER (p->buffer))) + && BUFFER_LIVE_P (XBUFFER (p->buffer)) + && (NILP (Fminibufferp (p->buffer, Qnil)))) /* If a window we restore gets another buffer, record the window's old buffer. */ call1 (Qrecord_window_buffer, window); diff --git a/src/xdisp.c b/src/xdisp.c index cc0a689ba32..a405d51f803 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12650,9 +12650,8 @@ gui_consider_frame_title (Lisp_Object frame) mode_line_noprop_buf; then display the title. */ record_unwind_protect (unwind_format_mode_line, format_mode_line_unwind_data - (f, current_buffer, selected_window, false)); + (NULL, current_buffer, Qnil, false)); - Fselect_window (f->selected_window, Qt); set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->contents)); fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format; diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 62a42b7fe44..44b3d8b672f 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -50,7 +50,8 @@ `(call-with-saved-electric-modes #'(lambda () ,@body))) (defun electric-pair-test-for (fixture where char expected-string - expected-point mode bindings fixture-fn) + expected-point mode bindings + fixture-fn &optional doc-string) (with-temp-buffer (funcall mode) (insert fixture) @@ -63,6 +64,14 @@ (mapcar #'car bindings) (mapcar #'cdr bindings) (call-interactively (key-binding `[,last-command-event]))))) + (when + (and doc-string + (not + (and + (equal (buffer-substring-no-properties (point-min) (point-max)) + expected-string) + (equal (point) expected-point)))) + (message "\n%s\n" doc-string)) (should (equal (buffer-substring-no-properties (point-min) (point-max)) expected-string)) (should (equal (point) @@ -109,14 +118,9 @@ (fixture (format "%s%s%s" prefix fixture suffix)) (expected-string (format "%s%s%s" prefix expected-string suffix)) (expected-point (+ (length prefix) expected-point)) - (pos (+ (length prefix) pos))) - `(ert-deftest ,(intern (format "electric-pair-%s-at-point-%s-in-%s%s" - name - (1+ pos) - mode - extra-desc)) - () - ,(format "Electricity test in a `%s' buffer.\n + (pos (+ (length prefix) pos)) + (doc-string + (format "Electricity test in a `%s' buffer.\n Start with point at %d in a %d-char-long buffer like this one: @@ -143,7 +147,14 @@ The buffer's contents should %s: char (if (string= fixture expected-string) "stay" "become") (replace-regexp-in-string "\n" "\\\\n" expected-string) - expected-point) + expected-point))) + `(ert-deftest ,(intern (format "electric-pair-%s-at-point-%s-in-%s%s" + name + (1+ pos) + mode + extra-desc)) + () + ,doc-string (electric-pair-test-for ,fixture ,(1+ pos) ,char @@ -151,7 +162,8 @@ The buffer's contents should %s: ,expected-point ',mode ,bindings - ,fixture-fn))))) + ,fixture-fn + ,doc-string))))) (cl-defmacro define-electric-pair-test (name fixture diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index df1d26a074e..dd6487603d3 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -648,4 +648,9 @@ collection clause." #'len)) (`(function (lambda (,_ ,_) . ,_)) t)))) +(ert-deftest cl-macs--progv () + (should (= (cl-progv '(test test) '(1 2) test) 2)) + (should (equal (cl-progv '(test1 test2) '(1 2) (list test1 test2)) + '(1 2)))) + ;;; cl-macs-tests.el ends here diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 8078e9c9fa9..14bc48b92fd 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -135,6 +135,25 @@ point in the distant past, and is still broken in perl-mode. " (should (equal (nth 3 (syntax-ppss)) nil)) (should (equal (nth 4 (syntax-ppss)) t)))))) +(ert-deftest cperl-test-fontify-declarations () + "Test that declarations and package usage use consistent fontification." + (with-temp-buffer + (funcall cperl-test-mode) + (insert "package Foo::Bar;\n") + (insert "use Fee::Fie::Foe::Foo\n;") + (insert "my $xyzzy = 'PLUGH';\n") + (goto-char (point-min)) + (font-lock-ensure) + (search-forward "Bar") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-function-name-face)) + (search-forward "use") ; This was buggy in perl-mode + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-keyword-face)) + (search-forward "my") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-keyword-face)))) + (defvar perl-continued-statement-offset) (defvar perl-indent-level) diff --git a/test/lisp/thumbs-tests.el b/test/lisp/thumbs-tests.el new file mode 100644 index 00000000000..ee096138453 --- /dev/null +++ b/test/lisp/thumbs-tests.el @@ -0,0 +1,34 @@ +;;; thumbs-tests.el --- tests for thumbs.el -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: + +(require 'ert) +(require 'thumbs) + +(ert-deftest thumbs-tests-thumbsdir/create-if-missing () + (let ((thumbs-thumbsdir (make-temp-file "thumbs-test" t))) + (unwind-protect + (progn + (delete-directory thumbs-thumbsdir) + (should (file-directory-p (thumbs-thumbsdir)))) + (delete-directory thumbs-thumbsdir)))) + +(provide 'thumbs-tests) +;;; thumbs-tests.el ends here diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 17aef30a433..b64c82c87d0 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -26,7 +26,6 @@ (require 'cl-lib) (require 'ert) (require 'puny) -(require 'rx) (require 'subr-x) (require 'dns)