procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into HEAD

Browse source
This commit is contained in:
Andrea Corallo 2021-01-08 21:40:45 +01:00
commit 400f620f24
140 changed files with 1773 additions and 1108 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile.in
View file

@ -987,6 +987,10 @@ else
@echo "Maybe you used a release tarfile that lacks tests."
endif
test/%:
$(MAKE) -C test $*
dist:
cd ${srcdir}; ./make-dist

2
admin/charsets/cp51932.awk
View file

@ -31,7 +31,7 @@
# already been mapped to 1 or 3.
BEGIN {
print ";;; cp51932.el -- translation table for CP51932";
print ";;; cp51932.el -- translation table for CP51932 -*- lexical-binding:t -*-";
print ";;; Automatically generated from CP932-2BYTE.map";
print "(let ((map";
printf " '(;JISEXT<->UNICODE";

2
admin/charsets/eucjp-ms.awk
View file

@ -38,7 +38,7 @@ BEGIN {
JISX0208_FROM2 = "/xf5/xa1";
JISX0212_FROM = "/x8f/xf3/xf3";
print ";;; eucjp-ms.el -- translation table for eucJP-ms";
print ";;; eucjp-ms.el -- translation table for eucJP-ms -*- lexical-binding:t -*-";
print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz";
print "(let ((map";
print " '(;JISEXT<->UNICODE";

20
admin/last-chance.el
View file

@ -105,18 +105,14 @@ defaulting to the one at point."
"Symbol: " obarray
nil nil
one nil one)))))
(let ((default-directory (or (vc-root-dir)
default-directory)))
(grep (format "%s %s"
last-chance-grep-command
symbol)))
(setf (buffer-local-value 'last-chance-symbol
(process-buffer
(car compilation-in-progress)))
symbol))
(add-to-list 'compilation-finish-functions
'last-chance-cleanup)
(with-current-buffer
(let ((default-directory (or (vc-root-dir)
default-directory)))
(grep (format "%s %s"
last-chance-grep-command
symbol)))
(add-hook 'compilation-finish-functions #'last-chance-cleanup nil t)
(setq-local last-chance-symbol symbol)))
(provide 'last-chance)

10
admin/nt/dist-build/build-zips.sh
View file

@ -20,7 +20,7 @@
function git_up {
echo [build] Making git worktree for Emacs $VERSION
cd $HOME/emacs-build/git/emacs-$MAJOR_VERSION
cd $REPO_DIR/emacs-$MAJOR_VERSION
git pull
git worktree add ../$BRANCH $BRANCH
@ -54,7 +54,7 @@ function build_zip {
if [ ! -f Makefile ] || (($CONFIG))
then
echo [build] Configuring Emacs $ARCH
../../../git/$BRANCH/configure \
$REPO_DIR/$BRANCH/configure \
--without-dbus \
--host=$HOST --without-compress-install \
$CACHE \
@ -88,7 +88,7 @@ function build_installer {
ARCH=$1
cd $HOME/emacs-build/install/emacs-$VERSION
echo [build] Calling makensis in `pwd`
cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi .
cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
makensis -v4 \
-DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
@ -110,6 +110,10 @@ CONFIG=1
CFLAGS="-O2 -static"
INSTALL_TARGET="install-strip"
## The location of the git repo
REPO_DIR=$HOME/emacs-build/git/
while getopts "36gb:hnsiV:" opt; do
case $opt in
3)

2
admin/unidata/blocks.awk
View file

@ -203,7 +203,7 @@ function name2alias(name , w, w2) {
}
END {
print ";;; charscript.el --- character script table"
print ";;; charscript.el --- character script table -*- lexical-binding:t -*-"
print ";;; Automatically generated from admin/unidata/Blocks.txt"
print "(let (script-list)"
print " (dolist (elt '("

12
configure.ac
View file

@ -4499,6 +4499,18 @@ TERMCAP_OBJ=tparam.o
if test $TERMINFO = yes; then
AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.])
TERMCAP_OBJ=terminfo.o
AC_CACHE_CHECK([whether $LIBS_TERMCAP library defines BC],
[emacs_cv_terminfo_defines_BC],
[OLD_LIBS=$LIBS
LIBS="$LIBS $LIBS_TERMCAP"
AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern char *BC;]], [[return !*BC;]])],
[emacs_cv_terminfo_defines_BC=yes],
[emacs_cv_terminfo_defines_BC=no])
LIBS=$OLD_LIBS])
if test "$emacs_cv_terminfo_defines_BC" = yes; then
AC_DEFINE([TERMINFO_DEFINES_BC], 1, [Define to 1 if the
terminfo library defines the variables BC, PC, and UP.])
fi
fi
if test "X$LIBS_TERMCAP" = "X-lncurses"; then
AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.])

2
doc/lispref/debugging.texi
View file

@ -424,7 +424,7 @@ move to it and type @key{RET}, to visit the source code. You can also
type @key{RET} while point is on any name of a function or variable
which is not underlined, to see help information for that symbol in a
help buffer, if any exists. The @code{xref-find-definitions} command,
bound to @key{M-.}, can also be used on any identifier in a backtrace
bound to @kbd{M-.}, can also be used on any identifier in a backtrace
(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}).
In backtraces, the tails of long lists and the ends of long strings,

2
doc/lispref/help.texi
View file

@ -545,7 +545,7 @@ brackets.
@end group
@group
(single-key-description 'C-mouse-1)
@result{} "<C-mouse-1>"
@result{} "C-<mouse-1>"
@end group
@group
(single-key-description 'C-mouse-1 t)

2
doc/lispref/minibuf.texi
View file

@ -348,7 +348,7 @@ default, it makes the following bindings:
@item @key{RET}
@code{exit-minibuffer}
@item @key{M-<}
@item @kbd{M-<}
@code{minibuffer-beginning-of-buffer}
@item @kbd{C-g}

6
doc/lispref/strings.texi
View file

@ -120,9 +120,9 @@ character (i.e., an integer), @code{nil} otherwise.
@cindex string creation
The following functions create strings, either from scratch, or by
putting strings together, or by taking them apart. (For functions that
create strings based on searching the contents of other strings (like
@code{string-replace} and @code{replace-regexp-in-string}), see
putting strings together, or by taking them apart. (For functions
that create strings based on the modified contents of other strings,
like @code{string-replace} and @code{replace-regexp-in-string}, see
@ref{Search and Replace}.)
@defun make-string count character &optional multibyte

2
doc/lispref/syntax.texi
View file

@ -252,7 +252,7 @@ comment and a newline or formfeed ends one.
@item Inherit standard syntax: @samp{@@}
This syntax class does not specify a particular syntax. It says to
look in the standard syntax table to find the syntax of this
look in the parent syntax table to find the syntax of this
character.
@item Generic comment delimiters: @samp{!}

6
doc/lispref/windows.texi
View file

@ -2634,6 +2634,12 @@ window and displaying the buffer in that window. It can fail if all
windows are dedicated to other buffers (@pxref{Dedicated Windows}).
@end defun
@defun display-buffer-use-least-recent-window buffer alist
This function is like @code{display-buffer-use-some-window}, but will
not reuse the current window, and will use the least recently
switched-to window.
@end defun
@defun display-buffer-in-direction buffer alist
This function tries to display @var{buffer} at a location specified by
@var{alist}. For this purpose, @var{alist} should contain a

8
doc/misc/widget.texi
View file

@ -692,14 +692,14 @@ arguments, which will be used when creating the @code{radio-button} or
@end table
@deffn {User Option} widget-glyph-directory
Directory where glyphs are found.
@deffn {User Option} widget-image-directory
Directory where Widget should look for images.
Widget will look here for a file with the same name as specified for the
image, with either a @file{.xpm} (if supported) or @file{.xbm} extension.
@end deffn
@deffn{User Option} widget-glyph-enable
If non-@code{nil}, allow glyphs to appear on displays where they are supported.
@deffn{User Option} widget-image-enable
If non-@code{nil}, allow images to appear on displays where they are supported.
@end deffn

40
etc/NEWS
View file

@ -212,6 +212,19 @@ This makes debugging Emacs Lisp scripts run in batch mode easier. To
get back the old behavior, set the new variable
'backtrace-on-error-noninteractive' to a nil value.
** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input.
This is another attempt to solve the problem of handling high key repeat rate
and other "slow scrolling" situations. It is hoped it behaves better
than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'.
It is not enabled by default.
+++
** Modifiers now go outside angle brackets in pretty-printed key bindings.
For example, <return> with Control and Meta modifiers is now shown as
C-M-<return> instead of <C-M-return>. Either variant can be used as
input; functions such as 'kbd' and 'read-kbd-macro' accept both styles
as equivalent (they have done so for a long time).
* Editing Changes in Emacs 28.1
@ -360,6 +373,15 @@ disabled entirely.
** Windows
+++
*** New 'display-buffer' function 'display-buffer-use-least-recent-window'
This is like 'display-buffer-use-some-window', but won't reuse the
current window, and when called repeatedly will try not to reuse a
previously selected window.
*** New function 'window-bump-use-time'.
This updates the use time of a window.
*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
It's bound to the command 'same-window-prefix' that requests the buffer
of the next command to be displayed in the same window.
@ -383,10 +405,19 @@ of the next command to be displayed in a new tab.
+++
*** New command 'C-x t C-r' to open file read-only in other tab.
---
*** The tab bar is frame-local when 'tab-bar-show' is a number.
Show/hide the tab bar independently for each frame, according to the
value of 'tab-bar-show'.
---
*** New command 'toggle-frame-tab-bar'.
It can be used to enable/disable the tab bar individually on each frame
independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
---
*** New user option 'tab-bar-tab-name-format-function'.
---
*** The tabs in the tab line can now be scrolled using horizontal scroll.
If your mouse or trackpad supports it, you can now scroll tabs when
@ -1831,6 +1862,9 @@ also keep the type information of their arguments. Use the
** CPerl Mode
---
*** New face 'perl-heredoc', used for heredoc elements.
---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
@ -2023,6 +2057,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
'wisent-lex-make-token-table'.
** The 'when' argument of `make-obsolete` and related functions is mandatory.
The use of those functions without a 'when' argument was marked
obsolete back in Emacs-23.1. The affected functions are:
make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
define-obsolete-variable-alias.
* Lisp Changes in Emacs 28.1

2
lisp/arc-mode.el
View file

@ -2237,8 +2237,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; not the GNU nor the BSD extensions. As it turns out, this is sufficient
;; for .deb packages.
(autoload 'tar-grind-file-mode "tar-mode")
(defconst archive-ar-file-header-re
"\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")

6
lisp/bindings.el
View file

@ -1,4 +1,4 @@
;;; bindings.el --- define standard key bindings and some variables
;;; bindings.el --- define standard key bindings and some variables -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software
;; Foundation, Inc.
@ -856,7 +856,7 @@ in contrast with \\[forward-char] and \\[backward-char], which
see."
(interactive "^p")
(if visual-order-cursor-movement
(dotimes (i (if (numberp n) (abs n) 1))
(dotimes (_ (if (numberp n) (abs n) 1))
(move-point-visually (if (and (numberp n) (< n 0)) -1 1)))
(if (eq (current-bidi-paragraph-direction) 'left-to-right)
(forward-char n)
@ -874,7 +874,7 @@ in contrast with \\[forward-char] and \\[backward-char], which
see."
(interactive "^p")
(if visual-order-cursor-movement
(dotimes (i (if (numberp n) (abs n) 1))
(dotimes (_ (if (numberp n) (abs n) 1))
(move-point-visually (if (and (numberp n) (< n 0)) 1 -1)))
(if (eq (current-bidi-paragraph-direction) 'left-to-right)
(backward-char n)

2
lisp/calc/calc-embed.el
View file

@ -396,7 +396,7 @@
(calc-wrapper
(setq str (math-showing-full-precision
(math-format-nice-expr (aref info 8) (frame-width))))
(calc-edit-mode (list 'calc-embedded-finish-edit info))
(calc--edit-mode (lambda () (calc-embedded-finish-edit info)))
(insert str "\n")))
(calc-show-edit-buffer)))

2
lisp/calc/calc-ext.el
View file

@ -1195,7 +1195,7 @@ calc-set-xor calc-sort calc-subvector calc-tail calc-transpose
calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
calc-copy-to-buffer calc-edit calc-edit-cancel calc--edit-mode
calc-kill calc-kill-region calc-yank))))
(defun calc-init-prefixes ()

25
lisp/calc/calc-prog.el
View file

@ -483,13 +483,13 @@
(interactive)
(calc-wrapper
(let ((lang calc-language))
(calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang))
t
(format "Editing %s-Mode Syntax Table. "
(cond ((null lang) "Normal")
((eq lang 'tex) "TeX")
((eq lang 'latex) "LaTeX")
(t (capitalize (symbol-name lang))))))
(calc--edit-mode (lambda () (calc-finish-user-syntax-edit lang))
t
(format "Editing %s-Mode Syntax Table. "
(cond ((null lang) "Normal")
((eq lang 'tex) "TeX")
((eq lang 'latex) "LaTeX")
(t (capitalize (symbol-name lang))))))
(calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
lang)))
(calc-show-edit-buffer))
@ -696,12 +696,13 @@
(setq cmd (symbol-function cmd)))
(cond ((or (stringp cmd)
(and (consp cmd)
(eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
(eq (car-safe (nth 3 cmd)) #'calc-execute-kbd-macro)))
;; FIXME: Won't (nth 3 cmd) fail when (stringp cmd)?
(let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
(str (edmacro-format-keys mac t))
(kys (nth 3 (nth 3 cmd))))
(calc-edit-mode
(list 'calc-edit-macro-finish-edit cmdname kys)
(calc--edit-mode
(lambda () (calc-edit-macro-finish-edit cmdname kys))
t (format (concat
"Editing keyboard macro (%s, bound to %s).\n"
"Original keys: %s \n")
@ -719,8 +720,8 @@
(if (and defn (calc-valid-formula-func func))
(let ((niceexpr (math-format-nice-expr defn (frame-width))))
(calc-wrapper
(calc-edit-mode
(list 'calc-finish-formula-edit (list 'quote func))
(calc--edit-mode
(lambda () (calc-finish-formula-edit func))
nil
(format (concat
"Editing formula (%s, %s, bound to %s).\n"

12
lisp/calc/calc-sel.el
View file

@ -675,12 +675,12 @@
(entry (calc-top num 'entry))
(expr (car entry))
(sel (or (calc-auto-selection entry) expr))
) ;; alg
(let ((str (math-showing-full-precision
(math-format-nice-expr sel (frame-width)))))
(calc-edit-mode (list 'calc-finish-selection-edit
num (list 'quote sel) calc-sel-reselect))
(insert str "\n"))))
;; alg
(str (math-showing-full-precision
(math-format-nice-expr sel (frame-width))))
(csr calc-sel-reselect))
(calc--edit-mode (lambda () (calc-finish-selection-edit num sel csr)))
(insert str "\n")))
(calc-show-edit-buffer))
(defvar calc-original-buffer)

8
lisp/calc/calc-store.el
View file

@ -437,10 +437,10 @@
(if (eq (car-safe value) 'special-const)
(error "%s is a special constant" var))
(setq calc-last-edited-variable var)
(calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
t
(format-message
"Editing variable `%s'" (calc-var-name var)))
(calc--edit-mode (lambda () (calc-finish-stack-edit var))
t
(format-message
"Editing variable `%s'" (calc-var-name var)))
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))

88
lisp/calc/calc-yank.el
View file

@ -651,14 +651,14 @@ Interactively, reads the register using `register-read-with-preview'."
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))
(calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret)
(calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n))) allow-ret)
(while list
(insert (car list) "\n")
(setq list (cdr list)))))
(calc-show-edit-buffer))
(defun calc-alg-edit (str)
(calc-edit-mode '(calc-finish-stack-edit 0))
(calc--edit-mode (lambda () (calc-finish-stack-edit 0)))
(calc-show-edit-buffer)
(insert str "\n")
(backward-char 1)
@ -666,54 +666,47 @@ Interactively, reads the register using `register-read-with-preview'."
(defvar calc-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\n" 'calc-edit-finish)
(define-key map "\r" 'calc-edit-return)
(define-key map "\C-c\C-c" 'calc-edit-finish)
(define-key map "\n" #'calc-edit-finish)
(define-key map "\r" #'calc-edit-return)
(define-key map "\C-c\C-c" #'calc-edit-finish)
map)
"Keymap for use by the calc-edit command.")
"Keymap for use by the `calc-edit' command.")
(defvar calc-original-buffer)
(defvar calc-return-buffer)
(defvar calc-one-window)
(defvar calc-edit-handler)
(defvar calc-restore-trail)
(defvar calc-allow-ret)
(defvar calc-edit-top)
(defvar calc-original-buffer nil)
(defvar calc-return-buffer nil)
(defvar calc-one-window nil)
(defvar calc-edit-handler nil)
(defvar calc-restore-trail nil)
(defvar calc-allow-ret nil)
(defvar calc-edit-top nil)
(defun calc-edit-mode (&optional handler allow-ret title)
(put 'calc-edit-mode 'mode-class 'special)
(define-derived-mode calc-edit-mode nil "Calc Edit"
"Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
To cancel the edit, simply kill the *Calc Edit* buffer."
(interactive)
(setq-local buffer-read-only nil)
(setq-local truncate-lines nil))
(defun calc--edit-mode (handler &optional allow-ret title)
(unless handler
(error "This command can be used only indirectly through calc-edit"))
(let ((oldbuf (current-buffer))
(buf (get-buffer-create "*Calc Edit*")))
(set-buffer buf)
(kill-all-local-variables)
(use-local-map calc-edit-mode-map)
(setq buffer-read-only nil)
(setq truncate-lines nil)
(setq major-mode 'calc-edit-mode)
(setq mode-name "Calc Edit")
(run-mode-hooks 'calc-edit-mode-hook)
(make-local-variable 'calc-original-buffer)
(setq calc-original-buffer oldbuf)
(make-local-variable 'calc-return-buffer)
(setq calc-return-buffer oldbuf)
(make-local-variable 'calc-one-window)
(setq calc-one-window (and (one-window-p t) pop-up-windows))
(make-local-variable 'calc-edit-handler)
(setq calc-edit-handler handler)
(make-local-variable 'calc-restore-trail)
(setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
(make-local-variable 'calc-allow-ret)
(setq calc-allow-ret allow-ret)
(calc-edit-mode)
(setq-local calc-original-buffer oldbuf)
(setq-local calc-return-buffer oldbuf)
(setq-local calc-one-window (and (one-window-p t) pop-up-windows))
(setq-local calc-edit-handler handler)
(setq-local calc-restore-trail (get-buffer-window (calc-trail-buffer)))
(setq-local calc-allow-ret allow-ret)
(let ((inhibit-read-only t))
(erase-buffer))
(add-hook 'kill-buffer-hook (lambda ()
(let ((calc-edit-handler nil))
(calc-edit-finish t))
(message "(Canceled)")) t t)
(message "(Canceled)"))
t t)
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
@ -721,9 +714,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(if allow-ret "" " or RET")
(format-message " to finish, `C-x k RET' to cancel.\n\n"))
'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
(make-local-variable 'calc-edit-top)
(setq calc-edit-top (point))))
(put 'calc-edit-mode 'mode-class 'special)
(setq-local calc-edit-top (point))))
(defun calc-show-edit-buffer ()
(let ((buf (current-buffer)))
@ -743,24 +734,19 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(defun calc-edit-return ()
(interactive)
(if (and (boundp 'calc-allow-ret) calc-allow-ret)
(if calc-allow-ret
(newline)
(calc-edit-finish)))
;; The variable calc-edit-disp-trail is local to calc-edit finish, but
;; is used by calc-finish-selection-edit and calc-finish-stack-edit.
;; The variable `calc-edit-disp-trail' is local to `calc-edit-finish', but
;; is used by `calc-finish-selection-edit' and `calc-finish-stack-edit'.
(defvar calc-edit-disp-trail)
(defun calc-edit-finish (&optional keep)
"Finish calc-edit mode. Parse buffer contents and push them on the stack."
"Finish `calc-edit' mode. Parse buffer contents and push them on the stack."
(interactive "P")
(message "Working...")
(or (and (boundp 'calc-original-buffer)
(boundp 'calc-return-buffer)
(boundp 'calc-one-window)
(boundp 'calc-edit-handler)
(boundp 'calc-restore-trail)
(eq major-mode 'calc-edit-mode))
(or (derived-mode-p 'calc-edit-mode)
(error "This command is valid only in buffers created by calc-edit"))
(let ((buf (current-buffer))
(original calc-original-buffer)
@ -775,7 +761,11 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(error "Original calculator buffer has been corrupted")))
(goto-char calc-edit-top)
(if (buffer-modified-p)
(eval calc-edit-handler t))
(if (functionp calc-edit-handler)
(funcall calc-edit-handler)
(message "Deprecated handler expression in calc-edit-handler: %S"
calc-edit-handler)
(eval calc-edit-handler t)))
(if (and one-window (not (one-window-p t)))
(delete-window))
(if (get-buffer-window return)

4
lisp/calendar/appt.el
View file

@ -700,7 +700,7 @@ ARG is positive, otherwise off."
(let ((appt-active appt-timer))
(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
(not appt-active)))
(remove-hook 'write-file-functions #'appt-update-list)
(remove-hook 'write-file-functions #'appt-update-list 'local)
(or global-mode-string (setq global-mode-string '("")))
(delq 'appt-mode-string global-mode-string)
(when appt-timer
@ -708,7 +708,7 @@ ARG is positive, otherwise off."
(setq appt-timer nil))
(if appt-active
(progn
(add-hook 'write-file-functions #'appt-update-list)
(add-hook 'write-file-functions #'appt-update-list nil t)
(setq appt-timer (run-at-time t 60 #'appt-check)
global-mode-string
(append global-mode-string '(appt-mode-string)))

3
lisp/cedet/semantic/symref/grep.el
View file

@ -168,7 +168,8 @@ This shell should support pipe redirect syntax."
(erase-buffer)
(setq default-directory rootdir)
(let ((cmd (semantic-symref-grep-use-template
(file-local-name rootdir) filepattern grepflags greppat)))
(file-name-as-directory (file-local-name rootdir))
filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)))
(setq ans (semantic-symref-parse-tool-output tool b))

8
lisp/cedet/srecode/semantic.el
View file

@ -1,4 +1,4 @@
;;; srecode/semantic.el --- Semantic specific extensions to SRecode.
;;; srecode/semantic.el --- Semantic specific extensions to SRecode -*- lexical-binding:t -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@ -57,7 +57,7 @@ This class will be used to derive dictionary values.")
(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function
dictionary)
_dictionary)
"Convert the compound dictionary value CP to a string.
If FUNCTION is non-nil, then FUNCTION is somehow applied to an
aspect of the compound value."
@ -410,7 +410,9 @@ as `function' will leave point where code might be inserted."
;; Insert the template.
(let ((endpt (srecode-insert-fcn temp dict nil t)))
(run-hook-with-args 'point-insert-fcn tag)
(if (functionp point-insert-fcn)
(funcall point-insert-fcn tag)
(dolist (f point-insert-fcn) (funcall f tag)))
;;(sit-for 1)
(cond

8
lisp/composite.el
View file

@ -1,4 +1,4 @@
;;; composite.el --- support character composition
;;; composite.el --- support character composition -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -593,7 +593,6 @@ All non-spacing characters have this function in
(as (lglyph-ascent glyph))
(de (lglyph-descent glyph))
(ce (/ (+ lb rb) 2))
(w (lglyph-width glyph))
xoff yoff)
(cond
((and class (>= class 200) (<= class 240))
@ -653,7 +652,8 @@ All non-spacing characters have this function in
((and (= class 0)
(eq (get-char-code-property (lglyph-char glyph)
;; Me = enclosing mark
'general-category) 'Me))
'general-category)
'Me))
;; Artificially laying out glyphs in an enclosing
;; mark is difficult. All we can do is to adjust
;; the x-offset and width of the base glyph to
@ -695,9 +695,7 @@ All non-spacing characters have this function in
(defun compose-gstring-for-dotted-circle (gstring direction)
(let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
(dc-id (lglyph-code dc))
(fc (lgstring-glyph gstring 1)) ; glyph of the following char
(fc-id (lglyph-code fc))
(gstr (and nil (font-shape-gstring gstring direction))))
(if (and gstr
(or (= (lgstring-glyph-len gstr) 1)

2
lisp/cus-face.el
View file

@ -1,4 +1,4 @@
;;; cus-face.el --- customization support for faces
;;; cus-face.el --- customization support for faces -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
;;

8
lisp/custom.el
View file

@ -161,7 +161,9 @@ set to nil, as the value is no longer rogue."
;; Whether automatically buffer-local.
buffer-local)
(unless (memq :group args)
(custom-add-to-group (custom-current-group) symbol 'custom-variable))
(let ((cg (custom-current-group)))
(when cg
(custom-add-to-group cg symbol 'custom-variable))))
(while args
(let ((keyword (pop args)))
(unless (symbolp keyword)
@ -525,7 +527,9 @@ If no such group is found, return nil."
"For customization option SYMBOL, handle keyword arguments ARGS.
Third argument TYPE is the custom option type."
(unless (memq :group args)
(custom-add-to-group (custom-current-group) symbol type))
(let ((cg (custom-current-group)))
(when cg
(custom-add-to-group cg symbol type))))
(while args
(let ((arg (car args)))
(setq args (cdr args))

2
lisp/disp-table.el
View file

@ -1,4 +1,4 @@
;;; disp-table.el --- functions for dealing with char tables
;;; disp-table.el --- functions for dealing with char tables -*- lexical-binding: t; -*-
;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software
;; Foundation, Inc.

2
lisp/dos-fns.el
View file

@ -1,4 +1,4 @@
;;; dos-fns.el --- MS-Dos specific functions
;;; dos-fns.el --- MS-Dos specific functions -*- lexical-binding: t; -*-
;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software
;; Foundation, Inc.

10
lisp/dos-w32.el
View file

@ -1,4 +1,4 @@
;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@ -154,13 +154,15 @@ when writing the file."
;; FIXME: Can't we use find-file-literally for the same purposes?
(interactive "FFind file binary: ")
(let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix?
(find-file filename)))
(with-suppressed-warnings ((interactive-only find-file))
(find-file filename))))
(defun find-file-text (filename)
"Visit file FILENAME and treat it as a text file."
(interactive "FFind file text: ")
(let ((coding-system-for-read 'undecided-dos))
(find-file filename)))
(with-suppressed-warnings ((interactive-only find-file))
(find-file filename))))
(defun w32-find-file-not-found-set-buffer-file-coding-system ()
(with-current-buffer (current-buffer)
@ -261,6 +263,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
:group 'dos-fns
:group 'w32)
(defvar w32-quote-process-args)
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
(defun w32-direct-print-region-helper (printer

4
lisp/electric.el
View file

@ -1,4 +1,4 @@
;;; electric.el --- window maker and Command loop for `electric' modes
;;; electric.el --- window maker and Command loop for `electric' modes -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation,
;; Inc.
@ -385,6 +385,8 @@ If multiple rules match, only first one is executed.")
(when electric-layout-mode
(electric-layout-post-self-insert-function-1)))
(defvar electric-pair-open-newline-between-pairs)
;; for edebug's sake, a separate function
(defun electric-layout-post-self-insert-function-1 ()
(let* ((pos (electric--after-char-pos))

25
lisp/emacs-lisp/autoload.el
View file

@ -222,16 +222,27 @@ expression, in which case we want to handle forms differently."
;; Convert defcustom to less space-consuming data.
((eq car 'defcustom)
(let ((varname (car-safe (cdr-safe form)))
(init (car-safe (cdr-safe (cdr-safe form))))
(doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
)
(let* ((varname (car-safe (cdr-safe form)))
(props (nthcdr 4 form))
(initializer (plist-get props :initialize))
(init (car-safe (cdr-safe (cdr-safe form))))
(doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
)
`(progn
(defvar ,varname ,init ,doc)
,(if (not (member initializer '(nil 'custom-initialize-default
#'custom-initialize-default
'custom-initialize-reset
#'custom-initialize-reset)))
form
`(defvar ,varname ,init ,doc))
;; When we include the complete `form', this `custom-autoload'
;; is not indispensable, but it still helps in case the `defcustom'
;; doesn't specify its group explicitly, and probably in a few other
;; corner cases.
(custom-autoload ',varname ,file
,(condition-case nil
(null (cadr (memq :set form)))
(null (plist-get props :set))
(error nil))))))
((eq car 'defgroup)

29
lisp/emacs-lisp/byte-run.el
View file

@ -382,7 +382,7 @@ convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
(defun make-obsolete (obsolete-name current-name &optional when)
(defun make-obsolete (obsolete-name current-name when)
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
OBSOLETE-NAME should be a function name or macro name (a symbol).
@ -391,17 +391,14 @@ If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
(declare (advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when) "23.1"))
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
(defmacro define-obsolete-function-alias ( obsolete-name current-name when
&optional docstring)
"Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete.
\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\")
@ -415,15 +412,13 @@ WHEN should be a string indicating when the function was first
made obsolete, for example a date or a release number.
See the docstrings of `defalias' and `make-obsolete' for more details."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when &optional docstring) "23.1"))
(declare (doc-string 4))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
(defun make-obsolete-variable ( obsolete-name current-name when
&optional access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
@ -431,16 +426,13 @@ WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
(declare (advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
(defmacro define-obsolete-variable-alias ( obsolete-name current-name when
&optional docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
WHEN should be a string indicating when the variable was first
@ -469,10 +461,7 @@ For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
`saved-value', `saved-variable-comment'."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when &optional docstring) "23.1"))
(declare (doc-string 4))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.

9
lisp/emacs-lisp/bytecomp.el
View file

@ -3529,10 +3529,11 @@ for symbols generated by the byte compiler itself."
(and od
(not (memq var byte-compile-not-obsolete-vars))
(not (memq var byte-compile-global-not-obsolete-vars))
(or (pcase (nth 1 od)
('set (not (eq access-type 'reference)))
('get (eq access-type 'reference))
(_ t)))))
(not (memq var byte-compile-lexical-variables))
(pcase (nth 1 od)
('set (not (eq access-type 'reference)))
('get (eq access-type 'reference))
(_ t))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)

3
lisp/emacs-lisp/eieio-core.el
View file

@ -215,7 +215,8 @@ It creates an autoload function for CNAME's constructor."
;; turn this into a usable self-pointing symbol
(when eieio-backward-compatibility
(set cname cname)
(make-obsolete-variable cname (format "use \\='%s instead" cname)
(make-obsolete-variable cname (format "\
use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
(setf (cl--find-class cname) newc)

92
lisp/emacs-lisp/package.el
View file

@ -173,12 +173,12 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
call (package-initialize) in your init-file."
call (package-activate-all) in your init-file."
:type 'boolean
:version "24.1")
(defcustom package-load-list '(all)
"List of packages for `package-initialize' to make available.
"List of packages for `package-activate-all' to make available.
Each element in this list should be a list (NAME VERSION), or the
symbol `all'. The symbol `all' says to make available the latest
installed versions of all packages not specified by other
@ -292,15 +292,18 @@ the package will be unavailable."
:risky t
:version "24.4")
;;;###autoload
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
:initialize #'custom-initialize-delay
:risky t
:version "24.1")
;;;###autoload
(defcustom package-directory-list
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
(let (result)
@ -315,6 +318,7 @@ Each directory name should be absolute.
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
:initialize #'custom-initialize-delay
:risky t
:version "24.1")
@ -593,9 +597,8 @@ package."
;;; Installed packages
;; The following variables store information about packages present in
;; the system. The most important of these is `package-alist'. The
;; command `package-initialize' is also closely related to this
;; section, but it is left for a later section because it also affects
;; other stuff.
;; command `package-activate-all' is also closely related to this
;; section.
(defvar package--builtins nil
"Alist of built-in packages.
@ -614,7 +617,7 @@ name (a symbol) and DESCS is a non-empty list of `package-desc'
structures, sorted by decreasing versions.
This variable is set automatically by `package-load-descriptor',
called via `package-initialize'. To change which packages are
called via `package-activate-all'. To change which packages are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
@ -875,6 +878,20 @@ DIR, sorted by most recently loaded last."
(lambda (x y) (< (cdr x) (cdr y))))))))
;;;; `package-activate'
(defun package--get-activatable-pkg (pkg-name)
;; Is "activatable" a word?
(let ((pkg-descs (cdr (assq pkg-name package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
(when pkg-descs
(let ((available-version (package-desc-version (car pkg-descs))))
(or (package-disabled-p pkg-name available-version)
;; Prefer a builtin package.
(package-built-in-p pkg-name available-version))))
(setq pkg-descs (cdr pkg-descs)))
(car pkg-descs)))
;; This function activates a newer version of a package if an older
;; one was already activated. It also loads a features of this
;; package which were already loaded.
@ -882,24 +899,16 @@ DIR, sorted by most recently loaded last."
"Activate the package named PACKAGE.
If FORCE is true, (re-)activate it if it's already activated.
Newer versions are always activated, regardless of FORCE."
(let ((pkg-descs (cdr (assq package package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
(when pkg-descs
(let ((available-version (package-desc-version (car pkg-descs))))
(or (package-disabled-p package available-version)
;; Prefer a builtin package.
(package-built-in-p package available-version))))
(setq pkg-descs (cdr pkg-descs)))
(let ((pkg-desc (package--get-activatable-pkg package)))
(cond
;; If no such package is found, maybe it's built-in.
((null pkg-descs)
((null pkg-desc)
(package-built-in-p package))
;; If the package is already activated, just return t.
((and (memq package package-activated-list) (not force))
t)
;; Otherwise, proceed with activation.
(t (package-activate-1 (car pkg-descs) nil 'deps)))))
(t (package-activate-1 pkg-desc nil 'deps)))))
;;; Installation -- Local operations
@ -1633,9 +1642,8 @@ that code in the early init-file."
;; `package--initialized' is t.
(package--build-compatibility-table))
(defvar package-quickstart-file)
;;;###autoload
(progn ;; Make the function usable without loading `package.el'.
(defun package-activate-all ()
"Activate all installed packages.
The variable `package-load-list' controls which packages to load."
@ -1649,13 +1657,19 @@ The variable `package-load-list' controls which packages to load."
;; 2 when loading the .el file (this assumes we were careful to
;; save this file so it doesn't need any decoding).
(let ((load-source-file-function nil))
(unless (boundp 'package-activated-list)
(setq package-activated-list nil))
(load qs nil 'nomessage))
(dolist (elt (package--alist))
(condition-case err
(package-activate (car elt))
;; Don't let failure of activation of a package arbitrarily stop
;; activation of further packages.
(error (message "%s" (error-message-string err))))))))
(require 'package)
(package--activate-all)))))
(defun package--activate-all ()
(dolist (elt (package--alist))
(condition-case err
(package-activate (car elt))
;; Don't let failure of activation of a package arbitrarily stop
;; activation of further packages.
(error (message "%s" (error-message-string err))))))
;;;; Populating `package-archive-contents' from archives
;; This subsection populates the variables listed above from the
@ -2083,6 +2097,13 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'."
(mapc #'package-install-from-archive packages))
(defun package--archives-initialize ()
"Make sure the list of installed and remote packages are initialized."
(unless package--initialized
(package-initialize t))
(unless package-archive-contents
(package-refresh-contents)))
;;;###autoload
(defun package-install (pkg &optional dont-select)
"Install the package PKG.
@ -2103,10 +2124,7 @@ to install it but still mark it as selected."
(progn
;; Initialize the package system to get the list of package
;; symbols for completion.
(unless package--initialized
(package-initialize t))
(unless package-archive-contents
(package-refresh-contents))
(package--archives-initialize)
(list (intern (completing-read
"Install package: "
(delq nil
@ -2116,6 +2134,7 @@ to install it but still mark it as selected."
package-archive-contents))
nil t))
nil)))
(package--archives-initialize)
(add-hook 'post-command-hook #'package-menu--post-refresh)
(let ((name (if (package-desc-p pkg)
(package-desc-name pkg)
@ -3742,7 +3761,7 @@ short description."
(package-menu--generate nil t)))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf)))
(pop-to-buffer-same-window buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
@ -4070,10 +4089,12 @@ activations need to be changed, such as when `package-load-list' is modified."
:type 'boolean
:version "27.1")
;;;###autoload
(defcustom package-quickstart-file
(locate-user-emacs-file "package-quickstart.el")
"Location of the file used to speed up activation of packages at startup."
:type 'file
:initialize #'custom-initialize-delay
:version "27.1")
(defun package--quickstart-maybe-refresh ()
@ -4140,6 +4161,8 @@ activations need to be changed, such as when `package-load-list' is modified."
;; no-update-autoloads: t
;; End:
"))
;; FIXME: Do it asynchronously in an Emacs subprocess, and
;; don't show the byte-compiler warnings.
(byte-compile-file package-quickstart-file)))
(defun package--imenu-prev-index-position-function ()
@ -4160,6 +4183,15 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
;;;; Introspection
(defun package-get-descriptor (pkg-name)
"Return the `package-desc' of PKG-NAME."
(unless package--initialized (package-initialize 'no-activate))
(or (package--get-activatable-pkg pkg-name)
(cadr (assq pkg-name package-alist))
(cadr (assq pkg-name package-archive-contents))))
(provide 'package)
;;; package.el ends here

79
lisp/erc/erc.el
View file

@ -1046,8 +1046,8 @@ anyway."
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
(defcustom erc-pre-send-functions nil
"List of functions called to possibly alter the string that is sent.
The functions are called with one argument, a `erc-input' struct,
"Special hook run to possibly alter the string that is sent.
The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
The struct has three slots:
@ -1056,7 +1056,7 @@ The struct has three slots:
`insertp': Whether the string should be inserted into the erc buffer.
`sendp': Whether the string should be sent to the irc server."
:group 'erc
:type '(repeat function)
:type 'hook
:version "27.1")
(defvar erc-insert-this t
@ -1295,9 +1295,9 @@ Example:
(define-erc-module replace nil
\"This mode replaces incoming text according to `erc-replace-alist'.\"
((add-hook \\='erc-insert-modify-hook
\\='erc-replace-insert))
#\\='erc-replace-insert))
((remove-hook \\='erc-insert-modify-hook
\\='erc-replace-insert)))"
#\\='erc-replace-insert)))"
(declare (doc-string 3))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
@ -1495,7 +1495,7 @@ Defaults to the server buffer."
(setq-local paragraph-start
(concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
(setq-local completion-ignore-case t)
(add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
(add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
;; activation
@ -2585,7 +2585,7 @@ This function adds `erc-lurker-update-status' to
most recent PRIVMSG as well as initializing the state variable
storing this information."
(setq erc-lurker-state (make-hash-table :test 'equal))
(add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
(add-hook 'erc-insert-pre-hook #'erc-lurker-update-status))
(defun erc-lurker-cleanup ()
"Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
@ -2694,7 +2694,7 @@ otherwise `erc-server-announced-name'. SERVER is matched against
(defun erc-add-targets (scope target-list)
(let ((targets
(mapcar (lambda (targets) (member scope targets)) target-list)))
(cdr (apply 'append (delete nil targets)))))
(cdr (apply #'append (delete nil targets)))))
(defun erc-hide-current-message-p (parsed)
"Predicate indicating whether the parsed ERC response PARSED should be hidden.
@ -3038,7 +3038,7 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(erc-display-message
nil 'notice (current-buffer) 'ops
?i (length ops) ?s (if (> (length ops) 1) "s" "")
?o (mapconcat 'identity ops " "))
?o (mapconcat #'identity ops " "))
(erc-display-message nil 'notice (current-buffer) 'ops-none)))
t)
@ -3209,7 +3209,7 @@ command."
(defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
"Kick the user indicated in LINE from the current channel.
LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
(let ((reasonstring (mapconcat 'identity reasonwords " ")))
(let ((reasonstring (mapconcat #'identity reasonwords " ")))
(if (string= "" reasonstring)
(setq reasonstring (format "Kicked by %s" (erc-current-nick))))
(if (erc-channel-p target)
@ -3744,7 +3744,7 @@ the message given by REASON."
" -"
(make-string (length people) ?o)
" "
(mapconcat 'identity people " ")))
(mapconcat #'identity people " ")))
t))
(defun erc-cmd-OP (&rest people)
@ -3754,7 +3754,7 @@ the message given by REASON."
" +"
(make-string (length people) ?o)
" "
(mapconcat 'identity people " ")))
(mapconcat #'identity people " ")))
t))
(defun erc-cmd-TIME (&optional line)
@ -3952,7 +3952,7 @@ Unban all currently banned users in the current channel."
(erc-server-send
(format "MODE %s -%s %s" (erc-default-target)
(make-string (length x) ?b)
(mapconcat 'identity x " "))))
(mapconcat #'identity x " "))))
(erc-group-list bans 3))))
t))))
@ -4183,7 +4183,7 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
(erc-display-message
parsed 'notice proc
(mapconcat
'identity
#'identity
(let (res)
(mapc #'(lambda (x)
(if (stringp x)
@ -5553,12 +5553,10 @@ This returns non-nil only if we actually send anything."
;; Instead `erc-pre-send-functions' is used as a filter to do
;; allow both changing and suppressing the string.
(run-hook-with-args 'erc-send-pre-hook input)
(setq state (make-erc-input :string str
(setq state (make-erc-input :string str ;May be != from `input' now!
:insertp erc-insert-this
:sendp erc-send-this))
(dolist (func erc-pre-send-functions)
;; The functions can return nil to inhibit sending.
(funcall func state))
(run-hook-with-args 'erc-pre-send-functions state)
(when (and (erc-input-sendp state)
erc-send-this)
(let ((string (erc-input-string state)))
@ -5579,26 +5577,26 @@ This returns non-nil only if we actually send anything."
(erc-process-input-line (concat string "\n") t nil))
t))))))
(defun erc-display-command (line)
(when erc-insert-this
(let ((insert-position (point)))
(unless erc-hide-prompt
(erc-display-prompt nil nil (erc-command-indicator)
(and (erc-command-indicator)
'erc-command-indicator-face)))
(let ((beg (point)))
(insert line)
(erc-put-text-property beg (point)
'font-lock-face 'erc-command-indicator-face)
(insert "\n"))
(when (processp erc-server-process)
(set-marker (process-mark erc-server-process) (point)))
(set-marker erc-insert-marker (point))
(save-excursion
(save-restriction
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)
(run-hooks 'erc-send-post-hook))))))
;; (defun erc-display-command (line)
;; (when erc-insert-this
;; (let ((insert-position (point)))
;; (unless erc-hide-prompt
;; (erc-display-prompt nil nil (erc-command-indicator)
;; (and (erc-command-indicator)
;; 'erc-command-indicator-face)))
;; (let ((beg (point)))
;; (insert line)
;; (erc-put-text-property beg (point)
;; 'font-lock-face 'erc-command-indicator-face)
;; (insert "\n"))
;; (when (processp erc-server-process)
;; (set-marker (process-mark erc-server-process) (point)))
;; (set-marker erc-insert-marker (point))
;; (save-excursion
;; (save-restriction
;; (narrow-to-region insert-position (point))
;; (run-hooks 'erc-send-modify-hook)
;; (run-hooks 'erc-send-post-hook))))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at the
@ -6563,7 +6561,7 @@ If optional argument HERE is non-nil, insert version number at point."
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((string
(mapconcat 'identity
(mapconcat #'identity
(let (modes (case-fold-search nil))
(dolist (var (apropos-internal "^erc-.*mode$"))
(when (and (boundp var)
@ -6817,7 +6815,8 @@ See also `format-spec'."
;;; Various hook functions
(add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
;; FIXME: Don't set the hook globally!
(add-hook 'kill-buffer-hook #'erc-kill-buffer-function)
(defcustom erc-kill-server-hook '(erc-kill-server)
"Invoked whenever a server buffer is killed via `kill-buffer'."

2
lisp/facemenu.el
View file

@ -1,4 +1,4 @@
;;; facemenu.el --- create a face menu for interactively adding fonts to text
;;; facemenu.el --- create a face menu for interactively adding fonts to text -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.

477
lisp/filesets.el
View file

@ -1,4 +1,4 @@
;;; filesets.el --- handle group of files
;;; filesets.el --- handle group of files -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -88,7 +88,8 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'cl-lib)
(require 'seq)
(require 'easymenu)
;;; Some variables
@ -153,52 +154,25 @@ COND-FN takes one argument: the current element."
; (cl-remove 'dummy lst :test (lambda (dummy elt)
; (not (funcall cond-fn elt)))))
(let ((rv nil))
(dolist (elt lst rv)
(dolist (elt lst)
(when (funcall cond-fn elt)
(setq rv (append rv (list elt)))))))
(push elt rv)))
(nreverse rv)))
(defun filesets-ormap (fsom-pred lst)
"Return the tail of LST for the head of which FSOM-PRED is non-nil."
(let ((fsom-lst lst)
(fsom-rv nil))
(while (and (not (null fsom-lst))
(while (and fsom-lst
(null fsom-rv))
(if (funcall fsom-pred (car fsom-lst))
(setq fsom-rv fsom-lst)
(setq fsom-lst (cdr fsom-lst))))
fsom-rv))
(defun filesets-some (fss-pred fss-lst)
"Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
Like `some', return the first value of FSS-PRED that is non-nil."
(catch 'exit
(dolist (fss-this fss-lst nil)
(let ((fss-rv (funcall fss-pred fss-this)))
(when fss-rv
(throw 'exit fss-rv))))))
;(fset 'filesets-some 'cl-some) ;; or use the cl function
(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
"Find the first occurrence of FSM-ITEM in FSM-LST.
It is supposed to work like cl's `member*'. At the moment only the :test
key is supported."
(let ((fsm-test (or (plist-get fsm-keys ':test)
(function equal))))
(filesets-ormap (lambda (fsm-this)
(funcall fsm-test fsm-item fsm-this))
fsm-lst)))
;(fset 'filesets-member 'cl-member) ;; or use the cl function
(defun filesets-sublist (lst beg &optional end)
"Get the sublist of LST from BEG to END - 1."
(let ((rv nil)
(i beg)
(top (or end
(length lst))))
(while (< i top)
(setq rv (append rv (list (nth i lst))))
(setq i (+ i 1)))
rv))
(define-obsolete-function-alias 'filesets-some #'cl-some "28.1")
(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
(defun filesets-select-command (cmd-list)
"Select one command from CMD-LIST -- a string with space separated names."
@ -222,7 +196,7 @@ key is supported."
(defun filesets-message (level &rest args)
"Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
(when (<= level (abs filesets-verbosity))
(apply 'message args)))
(apply #'message args)))
;;; config file
@ -233,9 +207,9 @@ key is supported."
(defun filesets-reset-fileset (&optional fileset no-cache)
"Reset the cached values for one or all filesets."
(if fileset
(setq filesets-submenus (lax-plist-put filesets-submenus fileset nil))
(setq filesets-submenus nil))
(setq filesets-submenus (if fileset
(lax-plist-put filesets-submenus fileset nil)
nil))
(setq filesets-has-changed-flag t)
(setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
(not no-cache))))
@ -303,50 +277,46 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with
(defcustom filesets-menu-name "Filesets"
"Filesets' menu name."
:set (function filesets-set-default)
:type 'string
:group 'filesets)
:set #'filesets-set-default
:type 'string)
(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(choice (const :tag "Top Level" nil)
(sexp :tag "Menu Path"))
:version "23.1" ; was nil
:group 'filesets)
)
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(choice (string :tag "Name")
(const :tag "Last" nil))
:version "23.1" ; was "File"
:group 'filesets)
)
(defcustom filesets-menu-in-menu nil
"Use that instead of `current-menubar' as the menu to change.
See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type 'sexp
:group 'filesets)
:set #'filesets-set-default
:type 'sexp)
(defcustom filesets-menu-shortcuts-flag t
"Non-nil means to prepend menus with hopefully unique shortcuts."
:set (function filesets-set-default!)
:type 'boolean
:group 'filesets)
:set #'filesets-set-default!
:type 'boolean)
(defcustom filesets-menu-shortcuts-marker "%_"
"String for marking menu shortcuts."
:set (function filesets-set-default!)
:type 'string
:group 'filesets)
:set #'filesets-set-default!
:type 'string)
;;(defcustom filesets-menu-cnvfp-flag nil
;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
;; :set (function filesets-set-default!)
;; :set #'filesets-set-default!
;; :type 'boolean
;; :group 'filesets)
@ -355,9 +325,8 @@ See `easy-menu-add-item' for documentation."
"File to be used for saving the filesets menu between sessions.
Set this to \"\", to disable caching of menus.
Don't forget to check out `filesets-menu-ensure-use-cached'."
:set (function filesets-set-default)
:type 'file
:group 'filesets)
:set #'filesets-set-default
:type 'file)
(put 'filesets-menu-cache-file 'risky-local-variable t)
(defcustom filesets-menu-cache-contents
@ -383,7 +352,7 @@ If you want caching to work properly, at least `filesets-submenus',
list.
Don't forget to check out `filesets-menu-ensure-use-cached'."
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(repeat
(choice :tag "Variable"
(const :tag "filesets-submenus"
@ -400,8 +369,7 @@ Don't forget to check out `filesets-menu-ensure-use-cached'."
:value filesets-ingroup-patterns)
(const :tag "filesets-be-docile-flag"
:value filesets-be-docile-flag)
(sexp :tag "Other" :value nil)))
:group 'filesets)
(sexp :tag "Other" :value nil))))
(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
'filesets-cache-fill-content-hook "24.3")
@ -423,48 +391,43 @@ configuration file, you can add a something like this
to this hook.
Don't forget to check out `filesets-menu-ensure-use-cached'."
:set (function filesets-set-default)
:type 'hook
:group 'filesets)
:set #'filesets-set-default
:type 'hook)
(defcustom filesets-cache-hostname-flag nil
"Non-nil means cache the hostname.
If the current name differs from the cached one,
rebuild the menu and create a new cache file."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
:set #'filesets-set-default
:type 'boolean)
(defcustom filesets-cache-save-often-flag nil
"Non-nil means save buffer on every change of the filesets menu.
If this variable is set to nil and if Emacs crashes, the cache and
filesets-data could get out of sync. Set this to t if this happens from
time to time or if the fileset cache causes troubles."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
:set #'filesets-set-default
:type 'boolean)
(defcustom filesets-max-submenu-length 25
"Maximum length of submenus.
Set this value to 0 to turn menu splitting off. BTW, parts of submenus
will not be rewrapped if their length exceeds this value."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
:set #'filesets-set-default
:type 'integer)
(defcustom filesets-max-entry-length 50
"Truncate names of split submenus to this length."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
:set #'filesets-set-default
:type 'integer)
(defcustom filesets-browse-dir-function 'dired
(defcustom filesets-browse-dir-function #'dired
"A function or command used for browsing directories.
When using an external command, \"%s\" will be replaced with the
directory's name.
Note: You have to manually rebuild the menu if you change this value."
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "dired"
:value dired)
@ -473,10 +436,9 @@ Note: You have to manually rebuild the menu if you change this value."
(string :tag "Name")
(string :tag "Arguments"))
(function :tag "Function"
:value nil))
:group 'filesets)
:value nil)))
(defcustom filesets-open-file-function 'filesets-find-or-display-file
(defcustom filesets-open-file-function #'filesets-find-or-display-file
"The function used for opening files.
`filesets-find-or-display-file' ... Filesets' default function for
@ -489,26 +451,24 @@ for a specific file type. Either this viewer, if defined, or
readable, will not be opened.
Caveat: Changes will take effect only after rebuilding the menu."
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "filesets-find-or-display-file"
:value filesets-find-or-display-file)
(const :tag "filesets-find-file"
:value filesets-find-file)
(function :tag "Function"
:value nil))
:group 'filesets)
:value nil)))
(defcustom filesets-save-buffer-function 'save-buffer
(defcustom filesets-save-buffer-function #'save-buffer
"The function used to save a buffer.
Caveat: Changes will take effect after rebuilding the menu."
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "save-buffer"
:value save-buffer)
(function :tag "Function"
:value nil))
:group 'filesets)
:value nil)))
(defcustom filesets-find-file-delay
(if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
@ -519,29 +479,25 @@ This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
Set this to 0, if you don't use XEmacs's buffer tabs."
:set (function filesets-set-default)
:type 'number
:group 'filesets)
:set #'filesets-set-default
:type 'number)
(defcustom filesets-be-docile-flag nil
"Non-nil means don't complain if a file or a directory doesn't exist.
This is useful if you want to use the same startup files in different
computer environments."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
:set #'filesets-set-default
:type 'boolean)
(defcustom filesets-sort-menu-flag t
"Non-nil means sort the filesets menu alphabetically."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
:set #'filesets-set-default
:type 'boolean)
(defcustom filesets-sort-case-sensitive-flag t
"Non-nil means sorting of the filesets menu is case sensitive."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
:set #'filesets-set-default
:type 'boolean)
(defcustom filesets-tree-max-level 3
"Maximum scan depth for directory trees.
@ -561,9 +517,8 @@ i.e. how deep the menu should be. Try something like
and it should become clear what this option is about. In any case,
including directory trees to the menu can take a lot of memory."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
:set #'filesets-set-default
:type 'integer)
(defcustom filesets-commands
'(("Isearch"
@ -590,7 +545,7 @@ function that returns one) to be run on a filesets' files.
The argument <file-name> or <<file-name>> (quoted) will be replaced with
the filename."
:set (function filesets-set-default+)
:set #'filesets-set-default+
:type '(repeat :tag "Commands"
(list :tag "Definition" :value ("")
(string "Name")
@ -606,8 +561,7 @@ the filename."
(string :tag "Quoted File Name"
:value "<<file-name>>")
(function :tag "Function"
:value nil)))))
:group 'filesets)
:value nil))))))
(put 'filesets-commands 'risky-local-variable t)
(defcustom filesets-external-viewers
@ -627,28 +581,33 @@ the filename."
(dvi-cmd "xdvi")
(doc-cmd "antiword")
(pic-cmd "gqview"))
`(("^.+\\..?html?$" browse-url
`((".\\..?html?\\'" browse-url
((:ignore-on-open-all t)))
("^.+\\.pdf$" ,pdf-cmd
(".\\.pdf\\'" ,pdf-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
(:constraint-flag ,pdf-cmd)))
("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
;; (:constraintp ,pdf-cmd)
))
(".\\.e?ps\\(?:\\.gz\\)?\\'" ,ps-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
(:constraint-flag ,ps-cmd)))
("^.+\\.dvi$" ,dvi-cmd
;; (:constraintp ,ps-cmd)
))
(".\\.dvi\\'" ,dvi-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
(:constraint-flag ,dvi-cmd)))
("^.+\\.doc$" ,doc-cmd
;; (:constraintp ,dvi-cmd)
))
(".\\.doc\\'" ,doc-cmd
((:capture-output t)
(:ignore-on-read-text t)
(:constraint-flag ,doc-cmd)))
("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
;; (:constraintp ,doc-cmd)
))
(".\\.\\(tiff\\|xpm\\|gif\\|pgn\\)\\'" ,pic-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
(:constraint-flag ,pic-cmd)))))
;; (:constraintp ,pic-cmd)
))))
"Association list of file patterns and external viewers for use with
`filesets-find-or-display-file'.
@ -665,10 +624,8 @@ i.e. on open-all-files-events or when running commands
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
:constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
in conjunction with :capture-output
:open-hook FUNCTIONs ... run FUNCTIONs after spawning the viewer -- mainly
useful in conjunction with :capture-output
:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
\(defaults to (list \"%S\")) when using shell commands
@ -693,7 +650,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(:constraintp (lambda ()
(and (filesets-which-command-p \"rtf2htm\")
(filesets-which-command-p \"w3m\"))))))"
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(repeat :tag "Viewer"
(list :tag "Definition"
:value ("^.+\\.suffix$" "")
@ -708,7 +665,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(const :format ""
:value :constraintp)
(function :tag "Function"))
(list :tag ":constraint-flag"
(list :tag ":constraint-flag (obsolete)"
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
@ -749,8 +706,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
:value (:capture-output t)
(const :format ""
:value :capture-output)
(boolean :tag "Boolean"))))))
:group 'filesets)
(boolean :tag "Boolean")))))))
(put 'filesets-external-viewers 'risky-local-variable t)
(defcustom filesets-ingroup-patterns
@ -891,7 +847,7 @@ With duplicates removed, it would be:
M + A - X
B"
:set (function filesets-set-default)
:set #'filesets-set-default
:type '(repeat
:tag "Include"
(list
@ -937,8 +893,7 @@ With duplicates removed, it would be:
(list :tag ":preprocess"
:value (:preprocess)
(const :format "" :value :preprocess)
(function :tag "Function")))))))
:group 'filesets)
(function :tag "Function"))))))))
(put 'filesets-ingroup-patterns 'risky-local-variable t)
(defcustom filesets-data nil
@ -1009,8 +964,7 @@ is used.
Before using :ingroup, make sure that the file type is already
defined in `filesets-ingroup-patterns'."
:group 'filesets
:set (function filesets-data-set-default)
:set #'filesets-data-set-default
:type '(repeat
(cons :tag "Fileset"
(string :tag "Name" :value "")
@ -1072,9 +1026,8 @@ defined in `filesets-ingroup-patterns'."
(defcustom filesets-query-user-limit 15
"Query the user before opening a fileset with that many files."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
:set #'filesets-set-default
:type 'integer)
(defun filesets-filter-dir-names (lst &optional negative)
@ -1127,16 +1080,16 @@ Return full path if FULL-FLAG is non-nil."
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched dir %S with pattern %S"
this pattern)
(setq dirs (cons this dirs))))
(push this dirs)))
(t
(when (or (not pattern)
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched file %S with pattern %S"
this pattern)
(setq files (cons (if full-flag
(concat (file-name-as-directory dir) this)
this)
files))))))
(push (if full-flag
(concat (file-name-as-directory dir) this)
this)
files)))))
(cond
((equal what ':dirs)
(filesets-conditional-sort dirs))
@ -1193,7 +1146,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-convert-path-list (string)
"Return a path-list given as STRING as list."
(if string
(mapcar (lambda (x) (file-name-as-directory x))
(mapcar #'file-name-as-directory
(split-string string path-separator))
nil))
@ -1203,17 +1156,17 @@ Return full path if FULL-FLAG is non-nil."
filename)))
(if (file-exists-p f)
f
(filesets-some
(cl-some
(lambda (dir)
(let ((dir (file-name-as-directory dir))
(files (if (file-exists-p dir)
(filesets-directory-files dir nil ':files)
nil)))
(filesets-some (lambda (file)
(if (equal filename (file-name-nondirectory file))
(concat dir file)
nil))
files)))
(cl-some (lambda (file)
(if (equal filename (file-name-nondirectory file))
(concat dir file)
nil))
files)))
path-list))))
@ -1223,12 +1176,14 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-eviewer-constraint-p (entry)
(let* ((props (filesets-eviewer-get-props entry))
(constraint (assoc ':constraintp props))
(constraint-flag (assoc ':constraint-flag props)))
(constraint (assoc :constraintp props))
(constraint-flag (assoc :constraint-flag props)))
(cond
(constraint
(funcall (cadr constraint)))
(constraint-flag
(message "Obsolete :constraint-flag %S, use :constraintp instead"
(cadr constraint-flag))
(eval (cadr constraint-flag)))
(t
t))))
@ -1236,7 +1191,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
(filesets-some
(cl-some
(lambda (entry)
(when (and (string-match-p (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
@ -1246,7 +1201,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
(filesets-some
(cl-some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
@ -1308,17 +1263,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
(oh (filesets-filetype-get-prop ':open-hook file entry))
(args (let ((fmt (filesets-filetype-get-prop ':args file entry)))
(if fmt
(let ((rv ""))
(dolist (this fmt rv)
(setq rv (concat rv
(cond
((stringp this)
(format this file))
((and (symbolp this)
(fboundp this))
(format "%S" (funcall this)))
(t
(format "%S" this)))))))
(mapconcat
(lambda (this)
(if (stringp this) (format this file)
(format "%S" (if (functionp this)
(funcall this)
this))))
fmt "")
(format "%S" file))))
(output
(cond
@ -1338,13 +1289,15 @@ Use the viewer defined in EV-ENTRY (a valid element of
(insert output)
(setq-local filesets-output-buffer-flag t)
(set-visited-file-name file t)
(when oh
(run-hooks 'oh))
(if (functionp oh)
(funcall oh)
(mapc #'funcall oh))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min)))
(when oh
(run-hooks 'oh))))
(if (functionp oh)
(funcall oh)
(mapc #'funcall oh))))
(error "Filesets: general error when spawning external viewer"))))
(defun filesets-find-file (file)
@ -1355,7 +1308,8 @@ not be opened."
(when (or (file-readable-p file)
(not filesets-be-docile-flag))
(sit-for filesets-find-file-delay)
(find-file file)))
(with-suppressed-warnings ((interactive-only find-file))
(find-file file))))
(defun filesets-find-or-display-file (&optional file viewer)
"Visit FILE using an external VIEWER or open it in an Emacs buffer."
@ -1394,7 +1348,8 @@ not be opened."
(if (functionp filesets-browse-dir-function)
(funcall filesets-browse-dir-function dir)
(let ((name (car filesets-browse-dir-function))
(args (format (cadr filesets-browse-dir-function) (expand-file-name dir))))
(args (format (cadr filesets-browse-dir-function)
(expand-file-name dir))))
(with-temp-buffer
(start-process (concat "Filesets:" name)
"*Filesets external directory browser*"
@ -1445,7 +1400,7 @@ Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
(filesets-some
(cl-some
(lambda (x)
(if (assoc x data)
x))
@ -1557,16 +1512,15 @@ SAVE-FUNCTION takes no argument, but works on the current buffer."
(assoc cmd-name filesets-commands))
(defun filesets-cmd-get-args (cmd-name)
(let ((args (let ((def (filesets-cmd-get-def cmd-name)))
(nth 2 def)))
(rv nil))
(dolist (this args rv)
(cond
((and (symbolp this) (fboundp this))
(let ((x (funcall this)))
(setq rv (append rv (if (listp x) x (list x))))))
(t
(setq rv (append rv (list this))))))))
(mapcan (lambda (this)
(cond
((and (symbolp this) (fboundp this))
(let ((x (funcall this)))
(if (listp x) x (list x))))
(t
(list this))))
(let ((def (filesets-cmd-get-def cmd-name)))
(nth 2 def))))
(defun filesets-cmd-get-fn (cmd-name)
(let ((def (filesets-cmd-get-def cmd-name)))
@ -1628,28 +1582,24 @@ Replace <file-name> or <<file-name>> with filename."
(cond
((stringp fn)
(let* ((args
(let ((txt ""))
(dolist (this args txt)
(setq txt
(concat txt
(if (equal txt "") "" " ")
(filesets-run-cmd--repl-fn
(mapconcat
(lambda (this)
(filesets-run-cmd--repl-fn
this
(lambda (this)
(format "%s" this))))))))
(format "%s" this))))
args
" "))
(cmd (concat fn " " args)))
(filesets-cmd-show-result
cmd (shell-command-to-string cmd))))
((symbolp fn)
(let ((args
(let ((argl nil))
(dolist (this args argl)
(setq argl
(append argl
(filesets-run-cmd--repl-fn
this
'list)))))))
(apply fn args)))))))))))))))))
(apply fn
(mapcan (lambda (this)
(filesets-run-cmd--repl-fn
this
'list))
args)))))))))))))))))
(defun filesets-get-cmd-menu ()
"Create filesets command menu."
@ -1832,8 +1782,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
(inlist (filesets-member this files
:test 'filesets-files-equalp)))
(inlist (cl-member this files
:test #'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: `%s' is already in `%s'" this name))
@ -1858,8 +1808,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
(inlist (filesets-member this files
:test 'filesets-files-equalp)))
(inlist (cl-member this files
:test #'filesets-files-equalp)))
;;(message "%s %s %s" files this inlist)
(if (and files this inlist)
(let ((new (list (cons ':files (delete (car inlist) files)))))
@ -1908,7 +1858,7 @@ User will be queried, if no fileset name is provided."
(substring (elt submenu 0) 2))))
(if (listp submenu)
(cons name (cdr submenu))
(apply 'vector (list name (cadr (append submenu nil)))))))
(apply #'vector (list name (cadr (append submenu nil)))))))
; (vconcat `[,name] (subseq submenu 1)))))
(defun filesets-wrap-submenu (submenu-body)
@ -1926,12 +1876,14 @@ User will be queried, if no fileset name is provided."
((or (> count bl)
(null data)))
;; (let ((sl (subseq submenu-body count
(let ((sl (filesets-sublist submenu-body count
(let ((x (+ count factor)))
(if (>= bl x)
x
nil)))))
(let ((sl (seq-subseq submenu-body count
(let ((x (+ count factor)))
(if (>= bl x)
x
nil)))))
(when sl
;; FIXME: O(n²) performance bug because of repeated `append':
;; use `mapcan'?
(setq result
(append
result
@ -1948,6 +1900,8 @@ User will be queried, if no fileset name is provided."
(if (null (cdr x))
""
", "))))
;; FIXME: O(n²) performance bug because of
;; repeated `concat': use `mapconcat'?
(setq rv
(concat
rv
@ -2023,11 +1977,11 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(and (stringp a)
(stringp b)
(string-match-p a b))))))
(filesets-some (lambda (x)
(if (funcall fn (car x) masterfile)
(nth pos x)
nil))
filesets-ingroup-patterns)))
(cl-some (lambda (x)
(if (funcall fn (car x) masterfile)
(nth pos x)
nil))
filesets-ingroup-patterns)))
(defun filesets-ingroup-get-pattern (master)
"Access to `filesets-ingroup-patterns'. Extract patterns."
@ -2039,12 +1993,8 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(defun filesets-ingroup-collect-finder (patt case-sensitivep)
"Helper function for `filesets-ingroup-collect'. Find pattern PATT."
(let ((cfs case-fold-search)
(rv (progn
(setq case-fold-search (not case-sensitivep))
(re-search-forward patt nil t))))
(setq case-fold-search cfs)
rv))
(let ((case-fold-search (not case-sensitivep)))
(re-search-forward patt nil t)))
(defun filesets-ingroup-cache-get (master)
"Access to `filesets-ingroup-cache'."
@ -2102,9 +2052,9 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(when (and f
(not (member f flist))
(or (not remdupl-flag)
(not (filesets-member
(not (cl-member
f filesets-ingroup-files
:test 'filesets-files-equalp))))
:test #'filesets-files-equalp))))
(let ((no-stub-flag
(and (not this-stub-flag)
(if this-stubp
@ -2116,16 +2066,18 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(cons f filesets-ingroup-files))
(when no-stub-flag
(filesets-ingroup-cache-put master f))
(setq lst (append lst (list f))))))))
(push f lst))))))
(when lst
(setq rv
;; FIXME: O(n²) performance bug because of repeated
;; `nconc'.
(nconc rv
(mapcar (lambda (this)
`((,this ,this-name)
,@(filesets-ingroup-collect-files
fs remdupl-flag this
(- this-sd 1))))
lst))))))))
(nreverse lst)))))))))
(filesets-message 2 "Filesets: no patterns defined for %S" master)))))
(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
@ -2135,42 +2087,41 @@ FS is a fileset's name. FLIST is a list returned by
(if (null flist)
nil
(let ((count 0)
(fsn fs)
(rv nil))
(dolist (this flist rv)
(setq count (+ count 1))
(let* ((def (if (listp this) (car this) (list this "")))
(files (if (listp this) (cdr this) nil))
(master (nth 0 def))
(name (nth 1 def))
(nm (concat (filesets-get-shortcut (if (or (not other-count) files)
count other-count))
(if (or (null name) (equal name ""))
""
(format "%s: " name))
(file-name-nondirectory master))))
(setq rv
(append rv
(if files
`((,nm
[,(concat "Inclusion Group: "
(file-name-nondirectory master))
(filesets-open ':ingroup ',master ',fsn)]
"---"
[,master (filesets-file-open nil ',master ',fsn)]
"---"
,@(let ((count 0))
(mapcar
(lambda (this)
(setq count (+ count 1))
(let ((ff (filesets-ingroup-collect-build-menu
fs (list this) count)))
(if (= (length ff) 1)
(car ff)
ff)))
files))
,@(filesets-get-menu-epilog master ':ingroup fsn)))
`([,nm (filesets-file-open nil ',master ',fsn)])))))))))
(fsn fs))
(mapcan (lambda (this)
(setq count (+ count 1))
(let* ((def (if (listp this) (car this) (list this "")))
(files (if (listp this) (cdr this) nil))
(master (nth 0 def))
(name (nth 1 def))
(nm (concat (filesets-get-shortcut
(if (or (not other-count) files)
count other-count))
(if (or (null name) (equal name ""))
""
(format "%s: " name))
(file-name-nondirectory master))))
(if files
`((,nm
[,(concat "Inclusion Group: "
(file-name-nondirectory master))
(filesets-open ':ingroup ',master ',fsn)]
"---"
[,master (filesets-file-open nil ',master ',fsn)]
"---"
,@(let ((count 0))
(mapcar
(lambda (this)
(setq count (+ count 1))
(let ((ff (filesets-ingroup-collect-build-menu
fs (list this) count)))
(if (= (length ff) 1)
(car ff)
ff)))
files))
,@(filesets-get-menu-epilog master ':ingroup fsn)))
`([,nm (filesets-file-open nil ',master ',fsn)]))))
flist))))
(defun filesets-ingroup-collect (fs remdupl-flag master)
"Collect names of included files and build submenu."
@ -2275,7 +2226,7 @@ Construct a shortcut from COUNT."
(:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
(pattname (apply 'concat (cons "Pattern: " dirpatt)))
(pattname (apply #'concat (cons "Pattern: " dirpatt)))
(count 0))
;;(filesets-message 3 "Filesets: scanning %S" pattname)
`([,pattname
@ -2418,14 +2369,14 @@ fileset thinks this is necessary or not."
(dolist (this filesets-menu-cache-contents)
(if (get this 'custom-type)
(progn
(insert (format "(setq-default %s '%S)" this (eval this)))
(insert (format "(setq-default %s '%S)" this (eval this t)))
(when filesets-menu-ensure-use-cached
(newline)
(insert (format "(setq %s (cons '%s %s))"
'filesets-ignore-next-set-default
this
'filesets-ignore-next-set-default))))
(insert (format "(setq %s '%S)" this (eval this))))
(insert (format "(setq %s '%S)" this (eval this t))))
(newline 2))
(insert (format "(setq filesets-cache-version %S)" filesets-version))
(newline 2)
@ -2526,9 +2477,9 @@ We apologize for the inconvenience.")))
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
(add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
(add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
(add-hook 'first-change-hook (function filesets-reset-filename-on-change))
(add-hook 'kill-emacs-hook (function filesets-exit))
(add-hook 'kill-buffer-hook #'filesets-remove-from-ubl)
(add-hook 'first-change-hook #'filesets-reset-filename-on-change)
(add-hook 'kill-emacs-hook #'filesets-exit)
(if (filesets-menu-cache-file-load)
(progn
(filesets-build-menu-maybe)
@ -2542,7 +2493,7 @@ Set up hooks, load the cache file -- if existing -- and build the menu."
(defun filesets-error (_class &rest args)
"`error' wrapper."
(declare (obsolete error "28.1"))
(error "%s" (mapconcat 'identity args " ")))
(error "%s" (mapconcat #'identity args " ")))
(provide 'filesets)

2
lisp/font-core.el
View file

@ -1,4 +1,4 @@
;;; font-core.el --- Core interface to font-lock
;;; font-core.el --- Core interface to font-lock -*- lexical-binding: t; -*-
;; Copyright (C) 1992-2021 Free Software Foundation, Inc.

5
lisp/format.el
View file

@ -1,4 +1,4 @@
;;; format.el --- read and save files in multiple formats
;;; format.el --- read and save files in multiple formats -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software
;; Foundation, Inc.
@ -419,7 +419,8 @@ If FORMAT is nil then do not do any format conversion."
(file-name-nondirectory file)))))
(list file fmt)))
(let ((format-alist nil))
(find-file filename))
(with-suppressed-warnings ((interactive-only find-file))
(find-file filename)))
(if format
(format-decode-buffer format)))

19
lisp/gnus/mm-decode.el
View file

@ -1264,11 +1264,20 @@ in HANDLE."
(when (and (mm-handle-buffer handle)
(buffer-name (mm-handle-buffer handle)))
(with-temp-buffer
(mm-disable-multibyte)
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle))
(if (and (eq (mm-handle-encoding handle) '8bit)
(with-current-buffer (mm-handle-buffer handle)
enable-multibyte-characters))
;; Due to unfortunate historical reasons, we may have a
;; multibyte buffer here, but if it's using an 8bit
;; Content-Transfer-Encoding, then work around that by
;; just ignoring the situation.
(insert-buffer-substring (mm-handle-buffer handle))
;; Do the decoding.
(mm-disable-multibyte)
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle)))
,@forms))))
(put 'mm-with-part 'lisp-indent-function 1)
(put 'mm-with-part 'edebug-form-spec '(body))

2
lisp/gnus/nnmaildir.el
View file

@ -494,7 +494,7 @@ This variable is set by `nnmaildir-request-article'.")
(delete-char 1)
(setq nov (nnheader-parse-head t)
field (or (mail-header-lines nov) 0)))
(unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
(unless (or (<= field 0) (nnmaildir--param pgname 'distrust-Lines:))
(setq nov-mid field))
(setq nov-mid (number-to-string nov-mid)
nov-mid (concat (number-to-string attr) "\t" nov-mid))

21
lisp/info.el
View file

@ -160,17 +160,14 @@ A header-line does not scroll with the rest of the buffer."
:version "24.4")
;; This is a defcustom largely so that we can get the benefit
;; of custom-initialize-delay. Perhaps it would work to make it a
;; defvar and explicitly give it a standard-value property, and
;; call custom-initialize-delay on it.
;; The progn forces the autoloader to include the whole thing, not
;; just an abbreviated version. The value is initialized at startup
;; time, when command-line calls custom-reevaluate-setting on all
;; the defcustoms in custom-delayed-init-variables. This is
;; somewhat sub-optimal, as ideally this should be done when Info
;; mode is first invoked.
;; of `custom-initialize-delay'. Perhaps it would work to make it a
;; `defvar' and explicitly give it a `standard-value' property, and
;; call `custom-initialize-delay' on it.
;; The value is initialized at startup time, when command-line calls
;; `custom-reevaluate-setting' on all the defcustoms in
;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally
;; this should be done when Info mode is first invoked.
;;;###autoload
(progn
(defcustom Info-default-directory-list
(let* ((config-dir
(file-name-as-directory
@ -232,8 +229,8 @@ the environment variable INFOPATH is set.
Although this is a customizable variable, that is mainly for technical
reasons. Normally, you should either set INFOPATH or customize
`Info-additional-directory-list', rather than changing this variable."
:initialize 'custom-initialize-delay
:type '(repeat directory)))
:initialize #'custom-initialize-delay
:type '(repeat directory))
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.

101
lisp/international/characters.el
View file

@ -1,4 +1,4 @@
;;; characters.el --- set syntax and category for multibyte characters
;;; characters.el --- set syntax and category for multibyte characters -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@ -226,6 +226,7 @@ with L, LRE, or LRO Unicode bidi character type.")
;; JISX0208
;; Note: Some of these have their syntax updated later below.
(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
(let ((chars '(?ー ?゛ ?゜ ?ヽ ?ヾ ?ゝ ?ゞ ?〃 ?仝 ?々 ?〆 ?〇)))
@ -317,6 +318,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-syntax-entry #x5be ".") ; MAQAF
(modify-syntax-entry #x5c0 ".") ; PASEQ
(modify-syntax-entry #x5c3 ".") ; SOF PASUQ
(modify-syntax-entry #x5c6 ".") ; NUN HAFUKHA
(modify-syntax-entry #x5f3 ".") ; GERESH
(modify-syntax-entry #x5f4 ".") ; GERSHAYIM
@ -521,9 +523,9 @@ with L, LRE, or LRO Unicode bidi character type.")
;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.) There should be a well-defined way of
;; relating Unicode categories to Emacs syntax codes.
;; NBSP isn't semantically interchangeable with other whitespace chars,
;; so it's more like punctuation.
(set-case-syntax ?  "." tbl)
;; FIXME: We should probably just use the Unicode properties to set
;; up the syntax table.
(set-case-syntax ?¡ "." tbl)
(set-case-syntax ?¦ "_" tbl)
(set-case-syntax ?§ "." tbl)
@ -558,7 +560,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(setq c (1+ c)))
;; Latin Extended Additional
(modify-category-entry '(#x1e00 . #x1ef9) ?l)
(modify-category-entry '(#x1E00 . #x1EF9) ?l)
;; Latin Extended-C
(setq c #x2C60)
@ -579,13 +581,13 @@ with L, LRE, or LRO Unicode bidi character type.")
(setq c (1+ c)))
;; Greek
(modify-category-entry '(#x0370 . #x03ff) ?g)
(modify-category-entry '(#x0370 . #x03FF) ?g)
;; Armenian
(setq c #x531)
;; Greek Extended
(modify-category-entry '(#x1f00 . #x1fff) ?g)
(modify-category-entry '(#x1F00 . #x1FFF) ?g)
;; cyrillic
(modify-category-entry '(#x0400 . #x04FF) ?y)
@ -597,48 +599,57 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Cyrillic Extended-C
(modify-category-entry '(#x1C80 . #x1C8F) ?y)
;; general punctuation
;; space characters (see section 6.2 in the Unicode Standard)
(set-case-syntax ?  " " tbl)
(setq c #x2000)
(while (<= c #x200b)
(set-case-syntax c " " tbl)
(setq c (1+ c)))
(let ((chars '(#x202F #x205F #x3000)))
(while chars
(set-case-syntax (car chars) " " tbl)
(setq chars (cdr chars))))
;; general punctuation
(while (<= c #x200F)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Fixme: These aren't all right:
(setq c #x2010)
(while (<= c #x2016)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Punctuation syntax for quotation marks (like `)
(while (<= c #x201f)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Fixme: These aren't all right:
(while (<= c #x2027)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
(while (<= c #x206F)
;; Fixme: What to do with characters that have Pi and Pf
;; Unicode properties?
(while (<= c #x2017)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Punctuation syntax for quotation marks (like `)
(while (<= c #x201F)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
(while (<= c #x2027)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
(setq c #x2030)
(while (<= c #x205E)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
(let ((chars '(?‹ ?› ?⁄ ?⁒)))
(while chars
(modify-syntax-entry (car chars) "_")
(setq chars (cdr chars))))
;; Fixme: The following blocks might be better as symbol rather than
;; punctuation.
;; Arrows
(setq c #x2190)
(while (<= c #x21FF)
(set-case-syntax c "." tbl)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Mathematical Operators
(while (<= c #x22FF)
(set-case-syntax c "." tbl)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Miscellaneous Technical
(while (<= c #x23FF)
(set-case-syntax c "." tbl)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Control Pictures
(while (<= c #x243F)
(while (<= c #x244F)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
@ -652,13 +663,13 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Supplemental Mathematical Operators
(setq c #x2A00)
(while (<= c #x2AFF)
(set-case-syntax c "." tbl)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Miscellaneous Symbols and Arrows
(setq c #x2B00)
(while (<= c #x2BFF)
(set-case-syntax c "." tbl)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Coptic
@ -674,19 +685,47 @@ with L, LRE, or LRO Unicode bidi character type.")
(set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Ideographic punctuation
(setq c #x3001)
(while (<= c #x3003)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
(set-case-syntax #x30FB "." tbl)
;; Symbols for Legacy Computing
(setq c #x1FB00)
(while (<= c #x1FBCA)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; FIXME: Should these be digits?
(while (<= c #x1FBFF)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Fullwidth Latin
(setq c #xff21)
(while (<= c #xff3a)
(setq c #xFF01)
(while (<= c #xFF0F)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
(set-case-syntax #xFF04 "_" tbl)
(set-case-syntax #xFF0B "_" tbl)
(set-case-syntax #xFF1A "." tbl)
(set-case-syntax #xFF1B "." tbl)
(set-case-syntax #xFF1F "." tbl)
(set-case-syntax #xFF20 "." tbl)
(setq c #xFF21)
(while (<= c #xFF3A)
(modify-category-entry c ?l)
(modify-category-entry (+ c #x20) ?l)
(setq c (1+ c)))
;; Halfwidth Latin
(setq c #xFF64)
(while (<= c #xFF65)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
(set-case-syntax #xFF61 "." tbl)
;; Combining diacritics
(modify-category-entry '(#x300 . #x362) ?^)
;; Combining marks

2
lisp/international/fontset.el
View file

@ -1,4 +1,4 @@
;;; fontset.el --- commands for handling fontset
;;; fontset.el --- commands for handling fontset -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/international/iso-transl.el
View file

@ -1,4 +1,4 @@
;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8 -*-
;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation,
;; Inc.

2
lisp/international/mule-conf.el
View file

@ -1,4 +1,4 @@
;;; mule-conf.el --- configure multilingual environment
;;; mule-conf.el --- configure multilingual environment -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011

2
lisp/international/mule.el
View file

@ -1,4 +1,4 @@
;;; mule.el --- basic commands for multilingual environment
;;; mule.el --- basic commands for multilingual environment -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

4
lisp/international/ucs-normalize.el
View file

@ -1,4 +1,4 @@
;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@ -185,7 +185,7 @@
;; always returns nil, something the code here doesn't like.
(define-char-code-property 'decomposition "uni-decomposition.el")
(define-char-code-property 'canonical-combining-class "uni-combining.el")
(let ((char 0) ccc decomposition)
(let (ccc decomposition)
(mapc
(lambda (start-end)
(cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))

8
lisp/isearch.el
View file

@ -669,6 +669,10 @@ This is like `describe-bindings', but displays only Isearch keys."
(if isearch-success 'isearch-abort binding))))
map))
;; Note: Before adding more key bindings to this map, please keep in
;; mind that any unbound key exits Isearch and runs the command bound
;; to it in the local or global map. So in effect every key unbound
;; in this map is implicitly bound.
(defvar isearch-mode-map
(let ((i 0)
(map (make-keymap)))
@ -834,6 +838,10 @@ This is like `describe-bindings', but displays only Isearch keys."
:image '(isearch-tool-bar-image "left-arrow")))
map))
;; Note: Before adding more key bindings to this map, please keep in
;; mind that any unbound key exits Isearch and runs the command bound
;; to it in the local or global map. So in effect every key unbound
;; in this map is implicitly bound.
(defvar minibuffer-local-isearch-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)

3
lisp/jka-cmpr-hook.el
View file

@ -1,4 +1,4 @@
;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software
;; Foundation, Inc.
@ -93,6 +93,7 @@ Otherwise, it is nil.")
"\\)" file-name-version-regexp "?\\'"))))
;; Functions for accessing the return value of jka-compr-get-compression-info
;; FIXME: Use cl-defstruct!
(defun jka-compr-info-regexp (info) (aref info 0))
(defun jka-compr-info-compress-message (info) (aref info 1))
(defun jka-compr-info-compress-program (info) (aref info 2))

5
lisp/json.el
View file

@ -55,7 +55,6 @@
;;; Code:
(require 'map)
(require 'seq)
(require 'subr-x)
;; Parameters
@ -655,7 +654,9 @@ become JSON objects."
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
(not (seq-empty-p array)))
(if (listp array)
array
(> (length array) 0)))
(concat
"["
(json--with-indentation

2
lisp/language/chinese.el
View file

@ -1,4 +1,4 @@
;;; chinese.el --- support for Chinese -*- coding: utf-8; -*-
;;; chinese.el --- support for Chinese -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/cyrillic.el
View file

@ -1,4 +1,4 @@
;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; -*-
;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/english.el
View file

@ -1,4 +1,4 @@
;;; english.el --- support for English
;;; english.el --- support for English -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,

2
lisp/language/ethiopic.el
View file

@ -1,4 +1,4 @@
;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*-
;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/european.el
View file

@ -1,4 +1,4 @@
;;; european.el --- support for European languages -*- coding: utf-8; -*-
;;; european.el --- support for European languages -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/hebrew.el
View file

@ -1,4 +1,4 @@
;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*-
;;; hebrew.el --- support for Hebrew -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/indian.el
View file

@ -1,4 +1,4 @@
;;; indian.el --- Indian languages support -*- coding: utf-8; -*-
;;; indian.el --- Indian languages support -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011

2
lisp/language/japanese.el
View file

@ -1,4 +1,4 @@
;;; japanese.el --- support for Japanese
;;; japanese.el --- support for Japanese -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/korean.el
View file

@ -1,4 +1,4 @@
;;; korean.el --- support for Korean -*- coding: utf-8 -*-
;;; korean.el --- support for Korean -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/lao.el
View file

@ -1,4 +1,4 @@
;;; lao.el --- support for Lao -*- coding: utf-8 -*-
;;; lao.el --- support for Lao -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,

2
lisp/language/misc-lang.el
View file

@ -1,4 +1,4 @@
;;; misc-lang.el --- support for miscellaneous languages (characters)
;;; misc-lang.el --- support for miscellaneous languages (characters) -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011

2
lisp/language/thai.el
View file

@ -1,4 +1,4 @@
;;; thai.el --- support for Thai -*- coding: utf-8 -*-
;;; thai.el --- support for Thai -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

2
lisp/language/tibetan.el
View file

@ -1,4 +1,4 @@
;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*-
;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,

82
lisp/mail/reporter.el
View file

@ -1,4 +1,4 @@
;;; reporter.el --- customizable bug reporting of lisp programs
;;; reporter.el --- customizable bug reporting of lisp programs -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc.
@ -158,7 +158,7 @@ composed.")
t)
(error indent-enclosing-p))))
(defun reporter-lisp-indent (indent-point state)
(defun reporter-lisp-indent (_indent-point state)
"A better lisp indentation style for bug reporting."
(save-excursion
(goto-char (1+ (nth 1 state)))
@ -193,7 +193,7 @@ MAILBUF is the mail buffer being composed."
(<= maxwidth (current-column)))
(save-excursion
(let ((compact-p (not (memq varsym reporter-dont-compact-list)))
(lisp-indent-function 'reporter-lisp-indent))
(lisp-indent-function #'reporter-lisp-indent))
(goto-char here)
(reporter-beautify-list maxwidth compact-p))))
(insert "\n"))
@ -206,6 +206,11 @@ MAILBUF is the mail buffer being composed."
(error
(error ""))))
(defun reporter--run-functions (funs)
(if (functionp funs)
(funcall funs)
(mapc #'funcall funs)))
(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
"Dump the state of the mode specific variables.
PKGNAME contains the name of the mode as it will appear in the bug
@ -230,42 +235,39 @@ properly.
PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but
before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is
dumped."
(let ((buffer (current-buffer)))
(set-buffer buffer)
(insert "Emacs : " (emacs-version) "\n")
(and pkgname
(insert "Package: " pkgname "\n"))
(run-hooks 'pre-hooks)
(if (not varlist)
nil
(insert "\ncurrent state:\n==============\n")
;; create an emacs-lisp-mode buffer to contain the output, which
;; we'll later insert into the mail buffer
(condition-case fault
(let ((mailbuf (current-buffer))
(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
(with-current-buffer elbuf
(emacs-lisp-mode)
(erase-buffer)
(insert "(setq\n")
(lisp-indent-line)
(mapc
(lambda (varsym-or-cons-cell)
(let ((varsym (or (car-safe varsym-or-cons-cell)
varsym-or-cons-cell))
(printer (or (cdr-safe varsym-or-cons-cell)
'reporter-dump-variable)))
(funcall printer varsym mailbuf)))
varlist)
(lisp-indent-line)
(insert ")\n"))
(insert-buffer-substring elbuf))
(error
(insert "State could not be dumped due to the following error:\n\n"
(format "%s" fault)
"\n\nYou should still send this bug report."))))
(run-hooks 'post-hooks)
))
(insert "Emacs : " (emacs-version) "\n")
(and pkgname
(insert "Package: " pkgname "\n"))
(reporter--run-functions pre-hooks)
(if (not varlist)
nil
(insert "\ncurrent state:\n==============\n")
;; create an emacs-lisp-mode buffer to contain the output, which
;; we'll later insert into the mail buffer
(condition-case fault
(let ((mailbuf (current-buffer))
(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
(with-current-buffer elbuf
(emacs-lisp-mode)
(erase-buffer)
(insert "(setq\n")
(lisp-indent-line)
(mapc
(lambda (varsym-or-cons-cell)
(let ((varsym (or (car-safe varsym-or-cons-cell)
varsym-or-cons-cell))
(printer (or (cdr-safe varsym-or-cons-cell)
'reporter-dump-variable)))
(funcall printer varsym mailbuf)))
varlist)
(lisp-indent-line)
(insert ")\n"))
(insert-buffer-substring elbuf))
(error
(insert "State could not be dumped due to the following error:\n\n"
(format "%s" fault)
"\n\nYou should still send this bug report."))))
(reporter--run-functions post-hooks))
(defun reporter-compose-outgoing ()
@ -365,7 +367,7 @@ mail-sending package is used for editing and sending the message."
(skip-chars-backward " \t\n")
(setq reporter-initial-text (buffer-substring after-sep-pos (point))))
(if (setq hookvar (get agent 'hookvar))
(add-hook hookvar 'reporter-bug-hook nil t))
(add-hook hookvar #'reporter-bug-hook nil t))
;; compose the minibuf message and display this.
(let* ((sendkey-whereis (where-is-internal

11
lisp/mail/rmail.el
View file

@ -160,13 +160,6 @@ its character representation and its display representation.")
:group 'rmail
:version "21.1")
;;;###autoload
(put 'rmail-spool-directory 'standard-value
'((cond ((file-exists-p "/var/mail") "/var/mail/")
((file-exists-p "/var/spool/mail") "/var/spool/mail/")
((memq system-type '(hpux usg-unix-v)) "/usr/mail/")
(t "/usr/spool/mail/"))))
;;;###autoload
(defcustom rmail-spool-directory
(purecopy
@ -181,12 +174,10 @@ its character representation and its display representation.")
(t "/usr/spool/mail/")))
"Name of directory used by system mailer for delivering new mail.
Its name should end with a slash."
:initialize 'custom-initialize-delay
:initialize #'custom-initialize-delay
:type 'directory
:group 'rmail)
;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
(defcustom rmail-movemail-program nil
"If non-nil, the file name of the `movemail' program."
:group 'rmail-retrieve

10
lisp/mb-depth.el
View file

@ -35,6 +35,11 @@
It is called with one argument, the minibuffer depth,
and must return a string.")
(defface minibuffer-depth-indicator '((t :inherit highlight))
"Face to use for minibuffer depth indicator."
:group 'minibuffer
:version "28.1")
;; An overlay covering the prompt. This is a buffer-local variable in
;; each affected minibuffer.
;;
@ -52,7 +57,10 @@ The prompt should already have been inserted."
(overlay-put minibuffer-depth-overlay 'before-string
(if minibuffer-depth-indicator-function
(funcall minibuffer-depth-indicator-function depth)
(propertize (format "[%d]" depth) 'face 'highlight)))
(concat (propertize (format "[%d]" depth)
'face
'minibuffer-depth-indicator)
" ")))
(overlay-put minibuffer-depth-overlay 'evaporate t))))
;;;###autoload

5
lisp/menu-bar.el
View file

@ -1,4 +1,4 @@
;;; menu-bar.el --- define a default menu bar
;;; menu-bar.el --- define a default menu bar -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
@ -229,7 +229,8 @@
(filename (car (find-file-read-args "Find file: " mustmatch))))
(if mustmatch
(find-file-existing filename)
(find-file filename))))
(with-suppressed-warnings ((interactive-only find-file))
(find-file filename)))))
;; The "Edit->Search" submenu
(defvar menu-bar-last-search-type nil

2
lisp/net/dictionary.el
View file

@ -516,7 +516,7 @@ The connection takes the proxy setting in customization group
;; Dealing with closing the buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dictionary-close ()
(defun dictionary-close (&rest ignored)
"Close the current dictionary buffer and its connection."
(interactive)
(if (eq major-mode 'dictionary-mode)

2
lisp/net/pop3.el
View file

@ -463,7 +463,7 @@ Return non-nil if it is necessary to update the local UIDL file."
(when (cdr elt)
(insert "(\"" (pop elt) "\"\n ")
(while elt
(insert (format "\"%s\" %s\n " (pop elt) (pop elt))))
(insert (format "%S %s\n " (pop elt) (pop elt))))
(delete-char -4)
(insert ")\n ")))
(delete-char -3)

4
lisp/net/sieve.el
View file

@ -360,8 +360,8 @@ Used to bracket operations which move point in the sieve-buffer."
(if (not (sieve-manage-ok-p err))
(message "Sieve upload failed: %s" (nth 2 err))
(message "Sieve upload done. Use %s to manage scripts."
(substitute-command-keys "\\[sieve-manage]"))
(set-buffer-modified-p nil))))))
(substitute-command-keys "\\[sieve-manage]"))))
(set-buffer-modified-p nil))))
;;;###autoload
(defun sieve-upload-and-bury (&optional name)

1
lisp/net/socks.el
View file

@ -385,6 +385,7 @@
)
)
(process-put proc 'socks-state socks-state-authenticated)
(process-put proc 'socks-scratch "")
(set-process-filter proc #'socks-filter)))
proc)))

9
lisp/net/tramp-sh.el
View file

@ -2672,7 +2672,8 @@ The method used must be an out-of-band method."
(tramp-get-remote-null-device v))))
(save-restriction
(let ((beg (point)))
(let ((beg (point))
(emc enable-multibyte-characters))
(narrow-to-region (point) (point))
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
@ -2681,7 +2682,9 @@ The method used must be an out-of-band method."
(with-current-buffer (tramp-get-buffer v)
(buffer-string)))
;; Check for "--dired" output.
;; Check for "--dired" output. We must enable unibyte
;; strings, because the "--dired" output counts in bytes.
(set-buffer-multibyte nil)
(forward-line -2)
(when (looking-at-p "//SUBDIRED//")
(forward-line -1))
@ -2701,6 +2704,8 @@ The method used must be an out-of-band method."
(while (looking-at "//")
(forward-line 1)
(delete-region (match-beginning 0) (point)))
;; Reset multibyte if needed.
(set-buffer-multibyte emc)
;; Some busyboxes are reluctant to discard colors.
(unless

29
lisp/play/dunnet.el
View file

@ -25,7 +25,8 @@
;;; Commentary:
;; This game can be run in batch mode. To do this, use:
;; emacs -batch -l dunnet
;;
;; emacs --batch -f dunnet
;;; Code:
@ -1170,11 +1171,13 @@ treasures for points?" "4" "four")
(defun dunnet ()
"Switch to *dungeon* buffer and start game."
(interactive)
(pop-to-buffer-same-window "*dungeon*")
(dun-mode)
(setq dun-dead nil)
(setq dun-room 0)
(dun-messages))
(if noninteractive
(dun--batch)
(pop-to-buffer-same-window "*dungeon*")
(dun-mode)
(setq dun-dead nil)
(setq dun-room 0)
(dun-messages)))
;;;;
;;;; This section contains all of the verbs and commands.
@ -3126,8 +3129,7 @@ File not found")))
(dun-mprinc "\n")
(dun-batch-loop))
;;;###autoload
(defun dun-batch ()
(defun dun--batch ()
"Start `dunnet' in batch mode."
(fset 'dun-mprinc #'dun-batch-mprinc)
(fset 'dun-mprincl #'dun-batch-mprincl)
@ -3140,6 +3142,17 @@ File not found")))
(setq dun-batch-mode t)
(dun-batch-loop))
;; Apparently, there are many references out there to running us via
;;
;; emacs --batch -l dunnet
;;
;; So try and accommodate those without interfering with other cases
;; where `dunnet.el' might be loaded in batch mode with no intention
;; to run the game.
(when (and noninteractive
(equal '("-l" "dunnet") (member "-l" command-line-args)))
(dun--batch))
(provide 'dunnet)
;; Local Variables:

2
lisp/progmodes/flymake.el
View file

@ -4,7 +4,7 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Version: 1.0.9
;; Version: 1.1.0
;; Keywords: c languages tools
;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))

29
lisp/progmodes/perl-mode.el
View file

@ -324,13 +324,33 @@
;; disambiguate with the left-bitshift operator.
"\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
(4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table))
(4 (let* ((eol (match-beginning 4))
(st (get-text-property eol 'syntax-table))
(name (match-string 2))
(indented (match-beginning 1)))
(goto-char (match-end 2))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
;; '<<' occurred in a string, or in a comment.
;; Leave the property of the newline unchanged.
st
;; Beware of `foo <<'BAR' #baz` because
;; the newline needs to start the here-doc
;; and can't be used to close the comment.
(let ((eol-state (save-excursion (syntax-ppss eol))))
(when (nth 4 eol-state)
(if (/= (1- eol) (nth 8 eol-state))
;; make the last char of the comment closing it
(put-text-property (1- eol) eol
'syntax-table (string-to-syntax ">"))
;; In `foo <<'BAR' #` the # is the last character
;; before eol and can't both open and close the
;; comment. Workaround: disguise the "#" as
;; whitespace and fontify it as a comment.
(put-text-property (1- eol) eol
'syntax-table (string-to-syntax "-"))
(put-text-property (1- eol) eol
'font-lock-face
'font-lock-comment-face))))
(cons (car (string-to-syntax "< c"))
;; Remember the names of heredocs found on this line.
(cons (cons (pcase (aref name 0)
@ -483,8 +503,15 @@
;; as twoarg).
(perl-syntax-propertize-special-constructs limit)))))))))
(defface perl-heredoc
'((t (:inherit font-lock-string-face)))
"The face for here-documents. Inherits from font-lock-string-face.")
(defun perl-font-lock-syntactic-face-function (state)
(cond
((and (eq 2 (nth 7 state)) ; c-style comment
(cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc
'perl-heredoc)
((and (nth 3 state)
(eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
;; This is a second-arg of s{..}{...} form; let's check if this second

3
lisp/progmodes/project.el
View file

@ -291,7 +291,8 @@ to find the list of ignores for each directory."
(localdir (file-local-name (expand-file-name dir)))
(command (format "%s %s %s -type f %s -print0"
find-program
localdir
;; In case DIR is a symlink.
(file-name-as-directory localdir)
(xref--find-ignores-arguments ignores localdir)
(if files
(concat (shell-quote-argument "(")

9
lisp/progmodes/ruby-mode.el
View file

@ -1598,13 +1598,16 @@ See `add-log-current-defun-function'."
(let* ((indent 0) mname mlist
(start (point))
(make-definition-re
(lambda (re)
(lambda (re &optional method-name?)
(concat "^[ \t]*" re "[ \t]+"
"\\("
;; \\. and :: for class methods
"\\([A-Za-z_]" ruby-symbol-re "*[?!]?\\|\\.\\|::" "\\)"
"\\([A-Za-z_]" ruby-symbol-re "*[?!]?"
"\\|"
(if method-name? ruby-operator-re "\\.")
"\\|::" "\\)"
"+\\)")))
(definition-re (funcall make-definition-re ruby-defun-beg-re))
(definition-re (funcall make-definition-re ruby-defun-beg-re t))
(module-re (funcall make-definition-re "\\(class\\|module\\)")))
;; Get the current method definition (or class/module).
(when (re-search-backward definition-re nil t)

13
lisp/progmodes/xref.el
View file

@ -547,8 +547,7 @@ If SELECT is non-nil, select the target window."
"Goto and display position POS of buffer BUF in a window.
Honor `xref--original-window-intent', run `xref-after-jump-hook'
and finally return the window."
(let* ((xref-buf (current-buffer))
(pop-up-frames
(let* ((pop-up-frames
(or (eq xref--original-window-intent 'frame)
pop-up-frames))
(action
@ -566,9 +565,6 @@ and finally return the window."
(with-selected-window (display-buffer buf action)
(xref--goto-char pos)
(run-hooks 'xref-after-jump-hook)
(let ((buf (current-buffer)))
(with-current-buffer xref-buf
(setq-local other-window-scroll-buffer buf)))
(selected-window))))
(defun xref--display-buffer-in-other-window (buffer alist)
@ -1009,8 +1005,8 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'."
'(display-buffer-in-direction . ((direction . below))))
(current-buffer))))))
(define-obsolete-function-alias
'xref--show-defs-buffer-at-bottom #'xref-show-definitions-buffer-at-bottom)
(define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
#'xref-show-definitions-buffer-at-bottom "28.1")
(defun xref-show-definitions-completing-read (fetcher alist)
"Let the user choose the target definition with completion.
@ -1378,7 +1374,8 @@ IGNORES is a list of glob patterns for files to ignore."
;; do that reliably enough, without creating false negatives?
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
files
(file-local-name (expand-file-name dir))
(file-name-as-directory
(file-local-name (expand-file-name dir)))
ignores))
(def default-directory)
(buf (get-buffer-create " *xref-grep*"))

2
lisp/rfn-eshadow.el
View file

@ -1,4 +1,4 @@
;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;

2
lisp/scroll-bar.el
View file

@ -1,4 +1,4 @@
;;; scroll-bar.el --- window system-independent scroll bar support
;;; scroll-bar.el --- window system-independent scroll bar support -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc.

12
lisp/startup.el
View file

@ -1238,17 +1238,7 @@ please check its value")
package-enable-at-startup
(not (bound-and-true-p package--activated))
(catch 'package-dir-found
(let (dirs)
(if (boundp 'package-directory-list)
(setq dirs package-directory-list)
(dolist (f load-path)
(and (stringp f)
(equal (file-name-nondirectory f) "site-lisp")
(push (expand-file-name "elpa" f) dirs))))
(push (if (boundp 'package-user-dir)
package-user-dir
(locate-user-emacs-file "elpa"))
dirs)
(let ((dirs (cons package-user-dir package-directory-list)))
(dolist (dir dirs)
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))

102
lisp/subr.el
View file

@ -1000,6 +1000,22 @@ a menu, so this function is not useful for non-menu keymaps."
(setq inserted t)))
(setq tail (cdr tail)))))
(defun define-prefix-command (command &optional mapvar name)
"Define COMMAND as a prefix command. COMMAND should be a symbol.
A new sparse keymap is stored as COMMAND's function definition and its
value.
This prepares COMMAND for use as a prefix key's binding.
If a second optional argument MAPVAR is given, it should be a symbol.
The map is then stored as MAPVAR's value instead of as COMMAND's
value; but COMMAND is still defined as a function.
The third optional argument NAME, if given, supplies a menu name
string for the map. This is required to use the keymap as a menu.
This function returns COMMAND."
(let ((map (make-sparse-keymap name)))
(fset command map)
(set (or mapvar command) map)
command))
(defun map-keymap-sorted (function keymap)
"Implement `map-keymap' with sorting.
Don't call this function; it is for internal use only."
@ -1244,35 +1260,83 @@ in a cleaner way with command remapping, like this:
;;;; The global keymap tree.
;; global-map, esc-map, and ctl-x-map have their values set up in
;; keymap.c; we just give them docstrings here.
(defvar global-map nil
"Default global keymap mapping Emacs keyboard input into commands.
The value is a keymap that is usually (but not necessarily) Emacs's
global map.")
(defvar esc-map nil
(defvar esc-map
(let ((map (make-keymap)))
(define-key map "u" #'upcase-word)
(define-key map "l" #'downcase-word)
(define-key map "c" #'capitalize-word)
(define-key map "x" #'execute-extended-command)
map)
"Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")
(defvar ctl-x-map nil
"Default keymap for C-x commands.
The normal global definition of the character C-x indirects to this keymap.")
(fset 'ESC-prefix esc-map)
(make-obsolete 'ESC-prefix 'esc-map "28.1")
(defvar ctl-x-4-map (make-sparse-keymap)
"Keymap for subcommands of C-x 4.")
(defalias 'ctl-x-4-prefix ctl-x-4-map)
(define-key ctl-x-map "4" 'ctl-x-4-prefix)
(defvar ctl-x-5-map (make-sparse-keymap)
"Keymap for frame commands.")
(defalias 'ctl-x-5-prefix ctl-x-5-map)
(define-key ctl-x-map "5" 'ctl-x-5-prefix)
(defvar tab-prefix-map (make-sparse-keymap)
"Keymap for tab-bar related commands.")
(define-key ctl-x-map "t" tab-prefix-map)
(defvar ctl-x-map
(let ((map (make-keymap)))
(define-key map "4" 'ctl-x-4-prefix)
(define-key map "5" 'ctl-x-5-prefix)
(define-key map "t" tab-prefix-map)
(define-key map "b" #'switch-to-buffer)
(define-key map "k" #'kill-buffer)
(define-key map "\C-u" #'upcase-region) (put 'upcase-region 'disabled t)
(define-key map "\C-l" #'downcase-region) (put 'downcase-region 'disabled t)
(define-key map "<" #'scroll-left)
(define-key map ">" #'scroll-right)
map)
"Default keymap for C-x commands.
The normal global definition of the character C-x indirects to this keymap.")
(fset 'Control-X-prefix ctl-x-map)
(make-obsolete 'Control-X-prefix 'ctl-x-map "28.1")
(defvar global-map
(let ((map (make-keymap)))
(define-key map "\C-[" 'ESC-prefix)
(define-key map "\C-x" 'Control-X-prefix)
(define-key map "\C-i" #'self-insert-command)
(let* ((vec1 (make-vector 1 nil))
(f (lambda (from to)
(while (< from to)
(aset vec1 0 from)
(define-key map vec1 #'self-insert-command)
(setq from (1+ from))))))
(funcall f #o040 #o0177)
(when (eq system-type 'ms-dos) ;FIXME: Why?
(funcall f #o0200 #o0240))
(funcall f #o0240 #o0400))
(define-key map "\C-a" #'beginning-of-line)
(define-key map "\C-b" #'backward-char)
(define-key map "\C-e" #'end-of-line)
(define-key map "\C-f" #'forward-char)
(define-key map "\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
(define-key map "\C-x\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
(define-key map "\C-v" #'scroll-up-command)
(define-key map "\M-v" #'scroll-down-command)
(define-key map "\M-\C-v" #'scroll-other-window)
(define-key map "\M-\C-c" #'exit-recursive-edit)
(define-key map "\C-]" #'abort-recursive-edit)
map)
"Default global keymap mapping Emacs keyboard input into commands.
The value is a keymap that is usually (but not necessarily) Emacs's
global map.")
(use-global-map global-map)
;;;; Event manipulation functions.
@ -1754,7 +1818,11 @@ unless HOOK has both local and global functions). If multiple
functions have the same representation under `princ', the first
one will be removed."
(interactive
(let* ((hook (intern (completing-read "Hook variable: " obarray #'boundp t)))
(let* ((default (and (symbolp (variable-at-point))
(symbol-name (variable-at-point))))
(hook (intern (completing-read
(format-prompt "Hook variable" default)
obarray #'boundp t nil nil default)))
(local
(and
(local-variable-p hook)

162
lisp/tab-bar.el
View file

@ -95,6 +95,45 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
:version "27.1")
(defun tab-bar--define-keys ()
"Install key bindings for switching between tabs if the user has configured them."
(when tab-bar-select-tab-modifiers
(global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
'tab-bar-switch-to-recent-tab)
(dotimes (i 9)
(global-set-key (vector (append tab-bar-select-tab-modifiers
(list (+ i 1 ?0))))
'tab-bar-select-tab)))
;; Don't override user customized key bindings
(unless (global-key-binding [(control tab)])
(global-set-key [(control tab)] 'tab-next))
(unless (global-key-binding [(control shift tab)])
(global-set-key [(control shift tab)] 'tab-previous))
(unless (global-key-binding [(control shift iso-lefttab)])
(global-set-key [(control shift iso-lefttab)] 'tab-previous)))
(defun tab-bar--load-buttons ()
"Load the icons for the tab buttons."
(when (and tab-bar-new-button
(not (get-text-property 0 'display tab-bar-new-button)))
;; This file is pre-loaded so only here we can use the right data-directory:
(add-text-properties 0 (length tab-bar-new-button)
`(display (image :type xpm
:file "tabs/new.xpm"
:margin (2 . 0)
:ascent center))
tab-bar-new-button))
(when (and tab-bar-close-button
(not (get-text-property 0 'display tab-bar-close-button)))
;; This file is pre-loaded so only here we can use the right data-directory:
(add-text-properties 0 (length tab-bar-close-button)
`(display (image :type xpm
:file "tabs/close.xpm"
:margin (2 . 0)
:ascent center))
tab-bar-close-button)))
(define-minor-mode tab-bar-mode
"Toggle the tab bar in all graphical frames (Tab Bar mode)."
:global t
@ -110,43 +149,10 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
(cons (cons 'tab-bar-lines val)
(assq-delete-all 'tab-bar-lines
default-frame-alist)))))
(when (and tab-bar-mode tab-bar-new-button
(not (get-text-property 0 'display tab-bar-new-button)))
;; This file is pre-loaded so only here we can use the right data-directory:
(add-text-properties 0 (length tab-bar-new-button)
`(display (image :type xpm
:file "tabs/new.xpm"
:margin (2 . 0)
:ascent center))
tab-bar-new-button))
(when (and tab-bar-mode tab-bar-close-button
(not (get-text-property 0 'display tab-bar-close-button)))
;; This file is pre-loaded so only here we can use the right data-directory:
(add-text-properties 0 (length tab-bar-close-button)
`(display (image :type xpm
:file "tabs/close.xpm"
:margin (2 . 0)
:ascent center))
tab-bar-close-button))
(when tab-bar-mode
(tab-bar--load-buttons))
(if tab-bar-mode
(progn
(when tab-bar-select-tab-modifiers
(global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
'tab-bar-switch-to-recent-tab)
(dotimes (i 9)
(global-set-key (vector (append tab-bar-select-tab-modifiers
(list (+ i 1 ?0))))
'tab-bar-select-tab)))
;; Don't override user customized key bindings
(unless (global-key-binding [(control tab)])
(global-set-key [(control tab)] 'tab-next))
(unless (global-key-binding [(control shift tab)])
(global-set-key [(control shift tab)] 'tab-previous))
(unless (global-key-binding [(control shift iso-lefttab)])
(global-set-key [(control shift iso-lefttab)] 'tab-previous)))
(tab-bar--define-keys)
;; Unset only keys bound by tab-bar
(when (eq (global-key-binding [(control tab)]) 'tab-next)
(global-unset-key [(control tab)]))
@ -181,15 +187,27 @@ on a console which has no window system but does have a mouse."
;; Clicking anywhere outside existing tabs will add a new tab
(tab-bar-new-tab)))))
;; Used in the Show/Hide menu, to have the toggle reflect the current frame.
(defun toggle-tab-bar-mode-from-frame (&optional arg)
"Toggle tab bar on or off, based on the status of the current frame.
Used in the Show/Hide menu, to have the toggle reflect the current frame.
See `tab-bar-mode' for more information."
(interactive (list (or current-prefix-arg 'toggle)))
(if (eq arg 'toggle)
(tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1))
(tab-bar-mode arg)))
(defun toggle-frame-tab-bar (&optional frame)
"Toggle tab bar of FRAME.
This is useful when you want to enable the tab bar individually
on each new frame when the global `tab-bar-mode' is disabled,
or when you want to disable the tab bar individually on each
new frame when the global `tab-bar-mode' is enabled, by using
(add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
(interactive)
(set-frame-parameter frame 'tab-bar-lines
(if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)))
(defvar tab-bar-map (make-sparse-keymap)
"Keymap for the tab bar.
Define this locally to override the global tab bar.")
@ -218,18 +236,31 @@ If the value is `1', then hide the tab bar when it has only one tab,
and show it again once more tabs are created.
If nil, always keep the tab bar hidden. In this case it's still
possible to use persistent named window configurations by relying on
keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc."
keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc.
Setting this variable directly does not take effect; please customize
it (see the info node `Easy Customization'), then it will automatically
update the tab bar on all frames according to the new value.
To enable or disable the tab bar individually on each frame,
you can use the command `toggle-frame-tab-bar'."
:type '(choice (const :tag "Always" t)
(const :tag "When more than one tab" 1)
(const :tag "Never" nil))
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
(tab-bar-mode
(if (or (eq val t)
(and (natnump val)
(> (length (funcall tab-bar-tabs-function)) val)))
1 -1)))
;; Preload button images
(tab-bar-mode 1)
;; Then handle each frame individually
(dolist (frame (frame-list))
(set-frame-parameter
frame 'tab-bar-lines
(if (or (eq val t)
(and (natnump val)
(> (length (funcall tab-bar-tabs-function frame))
val)))
1 0))))
:group 'tab-bar
:version "27.1")
@ -418,6 +449,30 @@ Return its existing value or a new value."
tabs))
(defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default
"Function to format a tab name.
Function gets two arguments, the tab and its number, and should return
the formatted tab name to display in the tab bar."
:type 'function
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
(force-mode-line-update))
:group 'tab-bar
:version "28.1")
(defun tab-bar-tab-name-format-default (tab i)
(let ((current-p (eq (car tab) 'current-tab)))
(propertize
(concat (if tab-bar-tab-hints (format "%d " i) "")
(alist-get 'name tab)
(or (and tab-bar-close-button-show
(not (eq tab-bar-close-button-show
(if current-p 'non-selected 'selected)))
tab-bar-close-button)
""))
'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive))))
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
(let* ((separator (or tab-bar-separator (if window-system " " "|")))
@ -443,25 +498,13 @@ Return its existing value or a new value."
((eq (car tab) 'current-tab)
`((current-tab
menu-item
,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
(alist-get 'name tab)
(or (and tab-bar-close-button-show
(not (eq tab-bar-close-button-show
'non-selected))
tab-bar-close-button) ""))
'face 'tab-bar-tab)
,(funcall tab-bar-tab-name-format-function tab i)
ignore
:help "Current tab")))
(t
`((,(intern (format "tab-%i" i))
menu-item
,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
(alist-get 'name tab)
(or (and tab-bar-close-button-show
(not (eq tab-bar-close-button-show
'selected))
tab-bar-close-button) ""))
'face 'tab-bar-tab-inactive)
,(funcall tab-bar-tab-name-format-function tab i)
,(or
(alist-get 'binding tab)
`(lambda ()
@ -815,7 +858,10 @@ After the tab is created, the hooks in
((and (natnump tab-bar-show)
(> (length (funcall tab-bar-tabs-function)) tab-bar-show)
(zerop (frame-parameter nil 'tab-bar-lines)))
(set-frame-parameter nil 'tab-bar-lines 1)))
(progn
(tab-bar--load-buttons)
(tab-bar--define-keys)
(set-frame-parameter nil 'tab-bar-lines 1))))
(force-mode-line-update)
(unless tab-bar-mode

2
lisp/term/common-win.el
View file

@ -1,4 +1,4 @@
;;; common-win.el --- common part of handling window systems
;;; common-win.el --- common part of handling window systems -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.

2
lisp/term/tty-colors.el
View file

@ -1,4 +1,4 @@
;;; tty-colors.el --- color support for character terminals
;;; tty-colors.el --- color support for character terminals -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.

4
lisp/textmodes/bibtex.el
View file

@ -312,7 +312,9 @@ If parsing fails, try to set this variable to nil."
(option (choice :tag "Comment" :value nil
(const nil) string))
(option (choice :tag "Init" :value nil
(const nil) string function)))))))
(const nil) string function))
(option (choice :tag "Alternative" :value nil
(const nil) integer)))))))
(define-obsolete-variable-alias 'bibtex-entry-field-alist
'bibtex-BibTeX-entry-alist "24.1")

31
lisp/textmodes/fill.el
View file

@ -1,4 +1,4 @@
;;; fill.el --- fill commands for Emacs
;;; fill.el --- fill commands for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free
;; Software Foundation, Inc.
@ -40,13 +40,11 @@ Non-nil means changing indent doesn't end a paragraph.
That mode can handle paragraphs with extra indentation on the first line,
but it requires separator lines between paragraphs.
A value of nil means that any change in indentation starts a new paragraph."
:type 'boolean
:group 'fill)
:type 'boolean)
(defcustom colon-double-space nil
"Non-nil means put two spaces after a colon when filling."
:type 'boolean
:group 'fill)
:type 'boolean)
(put 'colon-double-space 'safe-local-variable 'booleanp)
(defcustom fill-separate-heterogeneous-words-with-space nil
@ -56,7 +54,6 @@ the beginning of the next line when concatenating them for
filling those lines. Whether to use a space depends on how the
words are categorized."
:type 'boolean
:group 'fill
:version "26.1")
(defvar fill-paragraph-function nil
@ -75,8 +72,7 @@ such as `fill-forward-paragraph-function'.")
Kinsoku processing is designed to prevent certain characters from being
placed at the beginning or end of a line by filling.
See the documentation of `kinsoku' for more information."
:type 'boolean
:group 'fill)
:type 'boolean)
(defun set-fill-prefix ()
"Set the fill prefix to the current line up to point.
@ -96,8 +92,7 @@ reinserts the fill prefix in each resulting line."
(defcustom adaptive-fill-mode t
"Non-nil means determine a paragraph's fill prefix from its text."
:type 'boolean
:group 'fill)
:type 'boolean)
(defcustom adaptive-fill-regexp
;; Added `!' for doxygen comments starting with `//!' or `/*!'.
@ -113,8 +108,7 @@ standard indentation for the whole paragraph.
If the paragraph has just one line, the indentation is taken from that
line, but in that case `adaptive-fill-first-line-regexp' also plays
a role."
:type 'regexp
:group 'fill)
:type 'regexp)
(defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'")
"Regexp specifying whether to set fill prefix from a one-line paragraph.
@ -126,15 +120,13 @@ By default, this regexp matches sequences of just spaces and tabs.
However, we never use a prefix from a one-line paragraph
if it would act as a paragraph-starter on the second line."
:type 'regexp
:group 'fill)
:type 'regexp)
(defcustom adaptive-fill-function #'ignore
"Function to call to choose a fill prefix for a paragraph.
A nil return value means the function has not determined the fill prefix."
:version "27.1"
:type 'function
:group 'fill)
:type 'function)
(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
"Whether or not filling should try to use the major mode's indentation.")
@ -367,15 +359,13 @@ which is an error according to some typographical conventions."
The predicates are called with no arguments, with point at the place to
be tested. If it returns a non-nil value, fill commands do not break
the line there."
:group 'fill
:type 'hook
:options '(fill-french-nobreak-p fill-single-word-nobreak-p
fill-single-char-nobreak-p))
(defcustom fill-nobreak-invisible nil
"Non-nil means that fill commands do not break lines in invisible text."
:type 'boolean
:group 'fill)
:type 'boolean)
(defun fill-nobreak-p ()
"Return nil if breaking the line at point is allowed.
@ -1110,8 +1100,7 @@ The `justification' text-property can locally override this variable."
(const full)
(const center)
(const none))
:safe 'symbolp
:group 'fill)
:safe 'symbolp)
(make-variable-buffer-local 'default-justification)
(defun current-justification ()

63
lisp/textmodes/paragraphs.el
View file

@ -371,50 +371,33 @@ See `forward-paragraph' for more information."
(defun mark-paragraph (&optional arg allow-extend)
"Put point at beginning of this paragraph, mark at end.
The paragraph marked is the one that contains point or follows
point.
The paragraph marked is the one that contains point or follows point.
With argument ARG, puts mark at the end of this or a following
paragraph, so that the number of paragraphs marked equals ARG.
With argument ARG, puts mark at end of a following paragraph, so that
the number of paragraphs marked equals ARG.
If ARG is negative, point is put at the end of this paragraph,
mark is put at the beginning of this or a previous paragraph.
If ARG is negative, point is put at end of this paragraph, mark is put
at beginning of this or a previous paragraph.
Interactively (or if ALLOW-EXTEND is non-nil), if this command is
repeated or (in Transient Mark mode) if the mark is active, it
marks the next ARG paragraphs after the region already marked.
This also means when activating the mark immediately before using
this command, the current paragraph is only marked from point."
(interactive "P\np")
(let ((numeric-arg (prefix-numeric-value arg)))
(cond ((zerop numeric-arg))
((and allow-extend
(or (and (eq last-command this-command) mark-active)
(region-active-p)))
(if arg
(setq arg numeric-arg)
(if (< (mark) (point))
(setq arg -1)
(setq arg 1)))
(set-mark
(save-excursion
(goto-char (mark))
(forward-paragraph arg)
(point))))
;; don't activate the mark when at eob
((and (eobp) (> numeric-arg 0)))
(t
(unless (save-excursion
(forward-line 0)
(looking-at paragraph-start))
(backward-paragraph (cond ((> numeric-arg 0) 1)
((< numeric-arg 0) -1)
(t 0))))
(push-mark
(save-excursion
(forward-paragraph numeric-arg)
(point))
t t)))))
repeated or (in Transient Mark mode) if the mark is active,
it marks the next ARG paragraphs after the ones already marked."
(interactive "p\np")
(unless arg (setq arg 1))
(when (zerop arg)
(error "Cannot mark zero paragraphs"))
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
(and transient-mark-mode mark-active)))
(set-mark
(save-excursion
(goto-char (mark))
(forward-paragraph arg)
(point))))
(t
(forward-paragraph arg)
(push-mark nil t t)
(backward-paragraph arg))))
(defun kill-paragraph (arg)
"Kill forward to end of paragraph.

12
lisp/w32-fns.el
View file

@ -1,4 +1,4 @@
;;; w32-fns.el --- Lisp routines for 32-bit Windows
;;; w32-fns.el --- Lisp routines for 32-bit Windows -*- lexical-binding: t; -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@ -383,10 +383,10 @@ for any permissions.
This is required because the Windows build environment is not required
to include Sed, which is used by leim/Makefile.in to do the job."
(find-file orig)
(goto-char (point-max))
(insert-file-contents extra)
(delete-matching-lines "^$\\|^;")
(save-buffers-kill-emacs t))
(with-current-buffer (find-file-noselect orig)
(goto-char (point-max))
(insert-file-contents extra)
(delete-matching-lines "^$\\|^;")
(save-buffers-kill-emacs t)))
;;; w32-fns.el ends here

1
lisp/wid-edit.el
View file

@ -1204,7 +1204,6 @@ This is much faster.")
ARG may be negative to move backward.
When the second optional argument is non-nil,
nothing is shown in the echo area."
(or (bobp) (> arg 0) (backward-char))
(let ((wrapped 0)
(number arg)
(old (widget-tabable-at)))

2
lisp/widget.el
View file

@ -1,4 +1,4 @@
;;; widget.el --- a library of user interface components
;;; widget.el --- a library of user interface components -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;;

61
lisp/window.el
View file

@ -7243,6 +7243,7 @@ The actual non-nil value of this variable will be copied to the
(const display-buffer-below-selected)
(const display-buffer-at-bottom)
(const display-buffer-in-previous-window)
(const display-buffer-use-least-recent-window)
(const display-buffer-use-some-window)
(const display-buffer-use-some-frame)
(function :tag "Other function"))
@ -7378,6 +7379,37 @@ fails, call `display-buffer-pop-up-frame'.")
(defun display-buffer (buffer-or-name &optional action frame)
"Display BUFFER-OR-NAME in some window, without selecting it.
To change which window is used, set `display-buffer-alist'
to an expression containing one of these \"action\" functions:
`display-buffer-same-window' -- Use the selected window.
`display-buffer-reuse-window' -- Use a window already showing
the buffer.
`display-buffer-in-previous-window' -- Use a window that did
show the buffer before.
`display-buffer-use-some-window' -- Use some existing window.
`display-buffer-use-least-recent-window' -- Try to avoid re-using
windows that have recently been switched to.
`display-buffer-pop-up-window' -- Pop up a new window.
`display-buffer-below-selected' -- Use or pop up a window below
the selected one.
`display-buffer-at-bottom' -- Use or pop up a window at the
bottom of the selected frame.
`display-buffer-pop-up-frame' -- Show the buffer on a new frame.
`display-buffer-in-child-frame' -- Show the buffer in a
child frame.
`display-buffer-no-window' -- Do not display the buffer and
have `display-buffer' return nil immediately.
For instance:
(setq display-buffer-alist '((\".*\" display-buffer-at-bottom)))
Buffer display can be further customized to a very high degree;
the rest of this docstring explains some of the many
possibilities, and also see `(emacs)Window Choice' for more
information.
BUFFER-OR-NAME must be a buffer or a string naming a live buffer.
Return the window chosen for displaying that buffer, or nil if no
such window is found.
@ -7403,23 +7435,8 @@ function in the combined function list in turn, passing the
buffer as the first argument and the combined action alist as the
second argument, until one of the functions returns non-nil.
Action functions and the action they try to perform are:
`display-buffer-same-window' -- Use the selected window.
`display-buffer-reuse-window' -- Use a window already showing
the buffer.
`display-buffer-in-previous-window' -- Use a window that did
show the buffer before.
`display-buffer-use-some-window' -- Use some existing window.
`display-buffer-pop-up-window' -- Pop up a new window.
`display-buffer-below-selected' -- Use or pop up a window below
the selected one.
`display-buffer-at-bottom' -- Use or pop up a window at the
bottom of the selected frame.
`display-buffer-pop-up-frame' -- Show the buffer on a new frame.
`display-buffer-in-child-frame' -- Show the buffer in a
child frame.
`display-buffer-no-window' -- Do not display the buffer and
have `display-buffer' return nil immediately.
See above for the action functions and the action they try to
perform.
Action alist entries are:
`inhibit-same-window' -- A non-nil value prevents the same
@ -8242,6 +8259,16 @@ indirectly called by the latter."
(when (setq window (or best-window second-best-window))
(window--display-buffer buffer window 'reuse alist))))
(defun display-buffer-use-least-recent-window (buffer alist)
"Display BUFFER in an existing window, but that hasn't been used lately.
This `display-buffer' action function is like
`display-buffer-use-some-window', but will cycle through windows
when displaying buffers repeatedly, and if there's only a single
window, it will split the window."
(when-let ((window (display-buffer-use-some-window
buffer (cons (cons 'inhibit-same-window t) alist))))
(window-bump-use-time window)))
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
Search for a usable window, set that window to the buffer, and

12
src/buffer.c
View file

@ -2602,8 +2602,6 @@ current buffer is cleared. */)
p += bytes, pos += bytes;
}
}
if (narrowed)
Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
}
else
{
@ -2682,9 +2680,6 @@ current buffer is cleared. */)
if (pt != PT)
TEMP_SET_PT (pt);
if (narrowed)
Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
/* Do this first, so that chars_in_text asks the right question.
set_intervals_multibyte needs it too. */
bset_enable_multibyte_characters (current_buffer, Qt);
@ -6385,10 +6380,3 @@ nil NORECORD argument since it may lead to infinite recursion. */);
Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
}
void
keys_of_buffer (void)
{
initial_define_key (control_x_map, 'b', "switch-to-buffer");
initial_define_key (control_x_map, 'k', "kill-buffer");
}

13
src/casefiddle.c
View file

@ -682,16 +682,3 @@ Called with one argument METHOD which can be:
defsubr (&Sdowncase_word);
defsubr (&Scapitalize_word);
}
void
keys_of_casefiddle (void)
{
initial_define_key (control_x_map, Ctl ('U'), "upcase-region");
Fput (intern ("upcase-region"), Qdisabled, Qt);
initial_define_key (control_x_map, Ctl ('L'), "downcase-region");
Fput (intern ("downcase-region"), Qdisabled, Qt);
initial_define_key (meta_map, 'u', "upcase-word");
initial_define_key (meta_map, 'l', "downcase-word");
initial_define_key (meta_map, 'c', "capitalize-word");
}

21
src/cmds.c
View file

@ -529,24 +529,3 @@ This is run after inserting the character. */);
defsubr (&Sdelete_char);
defsubr (&Sself_insert_command);
}
void
keys_of_cmds (void)
{
int n;
initial_define_key (global_map, Ctl ('I'), "self-insert-command");
for (n = 040; n < 0177; n++)
initial_define_key (global_map, n, "self-insert-command");
#ifdef MSDOS
for (n = 0200; n < 0240; n++)
initial_define_key (global_map, n, "self-insert-command");
#endif
for (n = 0240; n < 0400; n++)
initial_define_key (global_map, n, "self-insert-command");
initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
initial_define_key (global_map, Ctl ('B'), "backward-char");
initial_define_key (global_map, Ctl ('E'), "end-of-line");
initial_define_key (global_map, Ctl ('F'), "forward-char");
}

Some files were not shown because too many files have changed in this diff Show more