Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-23 05:17:35 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'savannah/master' into native-comp

Browse source
This commit is contained in:
Andrea Corallo 2021-01-30 14:09:37 +01:00
commit a8b8d220b4
180 changed files with 2211 additions and 1237 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
admin/notes/unicode
View file

@ -256,15 +256,6 @@ nontrivial changes to the build process.
etc/tutorials/TUTORIAL.ja
* iso-2022-7bit
This file contains multiple Chinese charsets, and converting it
to UTF-8 would lose the charset property and would change the
code's behavior. Although this could be worked around by
propertizing the strings, that hasn't been done.
lisp/international/titdic-cnv.el
* utf-8-emacs
These files contain characters that cannot be encoded in UTF-8.
@ -276,6 +267,7 @@ nontrivial changes to the build process.
lisp/language/tibetan.el
lisp/leim/quail/ethiopic.el
lisp/leim/quail/tibetan.el
lisp/international/titdic-cnv.el
* binary files

6
admin/unidata/unidata-gen.el
View file

@ -1416,7 +1416,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(or elt (user-error "Unknown output file: %s" basename))
(or noninteractive (message "Generating %s..." file))
(with-temp-file file
(insert ";; " copyright "
(insert ";;; " basename " -*- lexical-binding:t -*-
;; " copyright "
;; Generated from Unicode data files by unidata-gen.el.
;; The sources for this file are found in the admin/unidata/ directory in
;; the Emacs sources. The Unicode data files are used under the
@ -1451,7 +1452,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(defun unidata-gen-charprop (&optional charprop-file)
(or charprop-file (setq charprop-file (pop command-line-args-left)))
(with-temp-file charprop-file
(insert ";; Automatically generated by unidata-gen.el.\n"
(insert ";; Automatically generated by unidata-gen.el."
" -*- lexical-binding: t -*-\n"
";; See the admin/unidata/ directory in the Emacs sources.\n")
(dolist (elt unidata-file-alist)
(dolist (proplist (cdr elt))

8
doc/emacs/glossary.texi
View file

@ -1369,10 +1369,14 @@ configurations. @xref{Tab Bars}.
The tab line is a line of tabs at the top of an Emacs window.
Clicking on one of these tabs switches window buffers. @xref{Tab Line}.
@item Tag
A tag is an identifier in a program source. @xref{Xref}.
@anchor{Glossary---Tags Table}
@item Tags Table
A tags table is a file that serves as an index to the function
definitions in one or more other files. @xref{Tags Tables}.
A tags table is a file that serves as an index to identifiers: definitions
of functions, macros, data structures, etc., in one or more other files.
@xref{Tags Tables}.
@item Termscript File
A termscript file contains a record of all characters sent by Emacs to

8
doc/emacs/kmacro.texi
View file

@ -179,6 +179,14 @@ itself counts as the first repetition, since it is executed as you
define it, so @kbd{C-u 4 C-x )} executes the macro immediately 3
additional times.
@findex kdb-macro-redisplay
@kindex C-x C-k Q
While executing a long-running keyboard macro, it can sometimes be
useful to trigger a redisplay (to show how far we've gotten). The
@kbd{C-x C-k Q} can be used for this. As a not very useful example,
@kbd{C-x ( M-f C-x C-k Q C-x )} will create a macro that will
redisplay once per iteration when saying @kbd{C-u 42 C-x e}.
@node Keyboard Macro Ring
@section The Keyboard Macro Ring

20
doc/emacs/maintaining.texi
View file

@ -1994,19 +1994,21 @@ Of course, you should substitute the proper years and copyright holder.
@section Find Identifier References
@cindex xref
@cindex tag
An @dfn{identifier} is a name of a syntactical subunit of the
program: a function, a subroutine, a method, a class, a data type, a
macro, etc. In a programming language, each identifier is a symbol in
the language's syntax. Program development and maintenance requires
capabilities to quickly find where each identifier was defined and
referenced, to rename identifiers across the entire project, etc.
the language's syntax. Identifiers are also known as @dfn{tags}.
These capabilities are also useful for finding references in major
modes other than those defined to support programming languages. For
example, chapters, sections, appendices, etc.@: of a text or a @TeX{}
document can be treated as subunits as well, and their names can be
used as identifiers. In this chapter, we use the term ``identifiers''
to collectively refer to the names of any kind of subunits, in program
Program development and maintenance requires capabilities to quickly
find where each identifier was defined and referenced, to rename
identifiers across the entire project, etc. These capabilities are
also useful for finding references in major modes other than those
defined to support programming languages. For example, chapters,
sections, appendices, etc.@: of a text or a @TeX{} document can be
treated as subunits as well, and their names can be used as
identifiers. In this chapter, we use the term ``identifiers'' to
collectively refer to the names of any kind of subunits, in program
source and in other kinds of text alike.
Emacs provides a unified interface to these capabilities, called

50
doc/lispref/frames.texi
View file

@ -694,9 +694,17 @@ parameter (@pxref{Management Parameters}).
@item Internal Border
The internal border is a border drawn by Emacs around the inner frame
(see below). Its width is specified by the @code{internal-border-width}
frame parameter (@pxref{Layout Parameters}). Its color is specified by
the background of the @code{internal-border} face.
(see below). The specification of its appearance depends on whether
or not the given frame is a child frame (@pxref{Child Frames}).
For normal frames its width is specified by the @code{internal-border-width}
frame parameter (@pxref{Layout Parameters}), and its color is specified by the
background of the @code{internal-border} face.
For child frames its width is specified by the @code{child-frame-border-width}
frame parameter (but will use the @code{internal-border-width} parameter as
fallback), and its color is specified by the background of the
@code{child-frame-border} face.
@item Inner Frame
@cindex inner frame
@ -1790,6 +1798,11 @@ The width in pixels of the frame's outer border (@pxref{Frame Geometry}).
The width in pixels of the frame's internal border (@pxref{Frame
Geometry}).
@vindex child-frame-border-width@r{, a frame parameter}
@item child-frame-border-width
The width in pixels of the frame's internal border (@pxref{Frame
Geometry}) if the given frame is a child frame (@pxref{Child Frames}).
@vindex vertical-scroll-bars@r{, a frame parameter}
@item vertical-scroll-bars
Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
@ -2398,7 +2411,7 @@ attribute of the @code{default} face.
@vindex foreground-color@r{, a frame parameter}
@item foreground-color
The color to use for the image of a character. It is equivalent to
The color to use for characters. It is equivalent to
the @code{:foreground} attribute of the @code{default} face.
@vindex background-color@r{, a frame parameter}
@ -3748,10 +3761,31 @@ for instance using the window manager, then this produces a quit and
You can specify the mouse pointer style for particular text or
images using the @code{pointer} text property, and for images with the
@code{:pointer} and @code{:map} image properties. The values you can
use in these properties are @code{text} (or @code{nil}), @code{arrow},
@code{hand}, @code{vdrag}, @code{hdrag}, @code{modeline}, and
@code{hourglass}. @code{text} stands for the usual mouse pointer
style used over text.
use in these properties are in the table below. The actual shapes
may vary between systems; the descriptions are examples.
@table @code
@item text
@itemx nil
The usual mouse pointer style used over text (an ``I''-like shape).
@item arrow
@itemx vdrag
@itemx modeline
An arrow that points north-west.
@item hand
A hand that points upwards.
@item hdrag
A right-left arrow.
@item nhdrag
An up-down arrow.
@item hourglass
A rotating ring.
@end table
Over void parts of the window (parts that do not correspond to any
of the buffer contents), the mouse pointer usually uses the

17
doc/lispref/text.texi
View file

@ -1441,6 +1441,11 @@ the @code{amalgamating-undo-limit} variable. If this variable is 1,
no changes are amalgamated.
@end defun
A Lisp program can amalgamate a series of changes into a single change
group by calling @code{undo-amalgamate-change-group} (@pxref{Atomic
Changes}). Note that @code{amalgamating-undo-limit} has no effect on
the groups produced by that function.
@defvar undo-auto-current-boundary-timer
Some buffers, such as process buffers, can change even when no
commands are executing. In these cases, @code{undo-boundary} is
@ -5629,9 +5634,17 @@ This function cancels and undoes all the changes in the change group
specified by @var{handle}.
@end defun
You can cause some or all of the changes in a change group to be
considered as a single unit for the purposes of the @code{undo}
commands (@pxref{Undo}) by using @code{undo-amalgamate-change-group}.
@defun undo-amalgamate-change-group
Amalgamate changes in change-group since @var{handle}. I.e., remove
all undo boundaries between the state of @var{handle} and now.
Amalgamate all the changes made in the change-group since the state
identified by @var{handle}. This function removes all undo boundaries
between undo records of changes since the state described by
@var{handle}. Usually, @var{handle} is the handle returned by
@code{prepare-change-group}, in which case all the changes since the
beginning of the change-group are amalgamated into a single undo unit.
@end defun
Your code should use @code{unwind-protect} to make sure the group is

6
doc/misc/org.texi
View file

@ -4071,7 +4071,7 @@ the link. Such a function will be called with the tag as the only
argument.
With the above setting, you could link to a specific bug with
@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[google:OrgMode]]},
@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[duckduckgo:OrgMode]]},
show the map location of the Free Software Foundation @samp{[[gmap:51
Franklin Street, Boston]]} or of Carsten office @samp{[[omap:Science Park 904,
Amsterdam, The Netherlands]]} and find out what the Org author is doing
@ -4082,8 +4082,8 @@ can define them in the file with
@cindex @samp{LINK}, keyword
@example
#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
#+LINK: google http://www.google.com/search?q=%s
#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
#+LINK: duckduckgo https://duckduckgo.com/?q=%s
@end example
In-buffer completion (see @ref{Completion}) can be used after @samp{[} to

3
doc/misc/tramp.texi
View file

@ -1286,6 +1286,9 @@ This method uses @command{sftp} in order to securely access remote
hosts. @command{sftp} is a more secure option for connecting to hosts
that for security reasons refuse @command{ssh} connections.
When there is a respective entry in your @command{ssh} configuration,
do @emph{not} set the @option{RemoteCommand} option.
@end table
@defopt tramp-gvfs-methods

29
etc/NEWS
View file

@ -504,6 +504,12 @@ time zones will use a form like "+0100" instead of "CET".
** Dired
---
*** Behaviour change on 'dired-clean-confirm-killing-deleted-buffers'.
Previously, if 'dired-clean-up-buffers-too' was non-nil, and
'dired-clean-confirm-killing-deleted-buffers' was nil, the buffers
wouldn't be killed. This combination will now kill the buffers.
+++
*** New user option 'dired-switches-in-mode-line'.
This user option controls how 'ls' switches are displayed in the mode
@ -1102,6 +1108,11 @@ If present in 'whitespace-style' (as it is by default), the final
character in the buffer will be highlighted if the buffer doesn't end
with a newline.
---
*** The default 'whitespace-enable-predicate' predicate has changed.
It used to check elements in the list version of
'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'.
** Texinfo
---
@ -1131,6 +1142,11 @@ bindings, will be aborted, and Emacs will not ask you whether to
enlarge 'max-specpdl-size' to complete the rendering. The default is
t, which preserves the original behavior.
---
*** New user option 'rmail-show-message-set-modified'.
If set non-nil, showing an unseen message will set the Rmail buffer's
modified flag.
** Apropos
*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
@ -1576,6 +1592,9 @@ This allows mode-specific alterations to how `thing-at-point' works.
** Miscellaneous
+++
*** New command `C-x C-k Q' to force redisplay in keyboard macros.
---
*** New user option 'remember-diary-regexp'.
@ -2022,6 +2041,14 @@ hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and
'buffer-list-update-hook' for the temporary buffers they create. This
avoids slowing them down when a lot of these hooks are defined.
** New face 'child-frame-border' and frame parameter 'child-frame-border-width'.
The face and width of child frames borders can now be determined
separately from those of normal frames. To minimize backward
incompatibility, child frames without a 'child-frame-border-width'
parameter will fall back to using 'internal-border-width'. However,
the new 'child-frame-border' face does constitute a breaking change
since child frames' borders no longer use the 'internal-border' face.
---
** The obsolete function 'thread-alive-p' has been removed.
@ -2137,6 +2164,8 @@ obsolete back in Emacs-23.1. The affected functions are:
make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
define-obsolete-variable-alias.
** The variable 'keyboard-type' is obsolete and not dynamically scoped any more
* Lisp Changes in Emacs 28.1

12
leim/leim-ext.el
View file

@ -1,4 +1,4 @@
;; leim-ext.el -- extra leim configuration -*- coding:utf-8; -*-
;; leim-ext.el -- extra leim configuration -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@ -39,13 +39,13 @@
(eval-after-load "quail/Punct-b5"
'(quail-defrule " " ?　 nil t))
(register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+"
(register-input-method "ucs" "UTF-8" #'ucs-input-activate "U+"
"Unicode input as hex in the form Uxxxx.")
(register-input-method
"korean-hangul"
"UTF-8"
'hangul-input-method-activate
#'hangul-input-method-activate
"한2"
"Hangul 2-Bulsik Input"
'hangul2-input-method
@ -54,7 +54,7 @@
(register-input-method
"korean-hangul3f"
"UTF-8"
'hangul-input-method-activate
#'hangul-input-method-activate
"한3f"
"Hangul 3-Bulsik final Input"
'hangul3-input-method
@ -63,7 +63,7 @@
(register-input-method
"korean-hangul390"
"UTF-8"
'hangul-input-method-activate
#'hangul-input-method-activate
"한390"
"Hangul 3-Bulsik 390 Input"
'hangul390-input-method
@ -72,7 +72,7 @@
(register-input-method
"korean-hangul3"
"UTF-8"
'hangul-input-method-activate
#'hangul-input-method-activate
"한390"
"Hangul 3-Bulsik 390 Input"
'hangul390-input-method

2
lisp/auth-source.el
View file

@ -588,7 +588,7 @@ Here's an example:
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
\\='((password . \"Enter IMAP password for %h:%p: \"))))
\\='((secret . \"Enter IMAP password for %h:%p: \"))))
(auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
:P \"pppp\" :Q \"qqqq\"
:create \\='(A B Q)))

101
lisp/autorevert.el
View file

@ -355,10 +355,9 @@ the list of old buffers.")
(add-hook 'after-set-visited-file-name-hook
#'auto-revert-set-visited-file-name)
(defvar auto-revert--buffers-by-watch-descriptor
(make-hash-table :test 'equal)
"A hash table mapping notification descriptors to lists of buffers.
The buffers use that descriptor for auto-revert notifications.
(defvar auto-revert--buffer-by-watch-descriptor nil
"An association list mapping notification descriptors to buffers.
The buffer uses that descriptor for auto-revert notifications.
The key is equal to `auto-revert-notify-watch-descriptor' in each
buffer.")
@ -630,16 +629,12 @@ will use an up-to-date value of `auto-revert-interval'."
(defun auto-revert-notify-rm-watch ()
"Disable file notification for current buffer's associated file."
(let ((desc auto-revert-notify-watch-descriptor)
(table auto-revert--buffers-by-watch-descriptor))
(when desc
(let ((buffers (delq (current-buffer) (gethash desc table))))
(if buffers
(puthash desc buffers table)
(remhash desc table)))
(ignore-errors
(file-notify-rm-watch desc))
(remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t)))
(when-let ((desc auto-revert-notify-watch-descriptor))
(setq auto-revert--buffer-by-watch-descriptor
(assoc-delete-all desc auto-revert--buffer-by-watch-descriptor))
(ignore-errors
(file-notify-rm-watch desc))
(remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))
(setq auto-revert-notify-watch-descriptor nil
auto-revert-notify-modified-p nil))
@ -660,13 +655,10 @@ will use an up-to-date value of `auto-revert-interval'."
(if buffer-file-name '(change attribute-change) '(change))
'auto-revert-notify-handler))))
(when auto-revert-notify-watch-descriptor
(setq auto-revert-notify-modified-p t)
(puthash
auto-revert-notify-watch-descriptor
(cons (current-buffer)
(gethash auto-revert-notify-watch-descriptor
auto-revert--buffers-by-watch-descriptor))
auto-revert--buffers-by-watch-descriptor)
(setq auto-revert-notify-modified-p t
auto-revert--buffer-by-watch-descriptor
(cons (cons auto-revert-notify-watch-descriptor (current-buffer))
auto-revert--buffer-by-watch-descriptor))
(add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t))))
;; If we have file notifications, we want to update the auto-revert buffers
@ -696,8 +688,8 @@ system.")
(action (nth 1 event))
(file (nth 2 event))
(file1 (nth 3 event)) ;; Target of `renamed'.
(buffers (gethash descriptor
auto-revert--buffers-by-watch-descriptor)))
(buffer (alist-get descriptor auto-revert--buffer-by-watch-descriptor
nil nil #'equal)))
;; Check, that event is meant for us.
(cl-assert descriptor)
;; Since we watch a directory, a file name must be returned.
@ -706,9 +698,9 @@ system.")
(when auto-revert-debug
(message "auto-revert-notify-handler %S" event))
(if (eq action 'stopped)
;; File notification has stopped. Continue with polling.
(cl-dolist (buffer buffers)
(when (buffer-live-p buffer)
(if (eq action 'stopped)
;; File notification has stopped. Continue with polling.
(with-current-buffer buffer
(when (or
;; A buffer associated with a file.
@ -721,38 +713,35 @@ system.")
(auto-revert-notify-rm-watch)
;; Restart the timer if it wasn't running.
(unless auto-revert-timer
(auto-revert-set-timer)))))
(auto-revert-set-timer))))
;; Loop over all buffers, in order to find the intended one.
(cl-dolist (buffer buffers)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (or
;; A buffer associated with a file.
(and (stringp buffer-file-name)
(or
(and (memq
action '(attribute-changed changed created))
(string-equal
(file-name-nondirectory file)
(file-name-nondirectory buffer-file-name)))
(and (eq action 'renamed)
(string-equal
(file-name-nondirectory file1)
(file-name-nondirectory buffer-file-name)))))
;; A buffer w/o a file, like dired.
(and (null buffer-file-name)
(memq action '(created renamed deleted))))
;; Mark buffer modified.
(setq auto-revert-notify-modified-p t)
(with-current-buffer buffer
(when (or
;; A buffer associated with a file.
(and (stringp buffer-file-name)
(or
(and (memq
action '(attribute-changed changed created))
(string-equal
(file-name-nondirectory file)
(file-name-nondirectory buffer-file-name)))
(and (eq action 'renamed)
(string-equal
(file-name-nondirectory file1)
(file-name-nondirectory buffer-file-name)))))
;; A buffer w/o a file, like dired.
(and (null buffer-file-name)
(memq action '(created renamed deleted))))
;; Mark buffer modified.
(setq auto-revert-notify-modified-p t)
;; Revert the buffer now if we're not locked out.
(unless auto-revert--lockout-timer
(auto-revert-handler)
(setq auto-revert--lockout-timer
(run-with-timer
auto-revert--lockout-interval nil
#'auto-revert--end-lockout buffer)))))))))))
;; Revert the buffer now if we're not locked out.
(unless auto-revert--lockout-timer
(auto-revert-handler)
(setq auto-revert--lockout-timer
(run-with-timer
auto-revert--lockout-interval nil
#'auto-revert--end-lockout buffer))))))))))
(defun auto-revert--end-lockout (buffer)
"End the lockout period after a notification.

6
lisp/calc/calc-graph.el
View file

@ -1136,11 +1136,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if penbl "linespoints" "lines")
(if penbl "points" "dots"))))
(if (and pstyle (> pstyle 0))
(insert " "
(insert " ls "
(if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
" " (int-to-string pstyle))
" ps " (int-to-string pstyle))
(if (and lstyle (> lstyle 0))
(insert " " (int-to-string lstyle)))))))
(insert " ls " (int-to-string lstyle)))))))
(calc-graph-view-commands))
(defun calc-graph-zero-x (flag)

2
lisp/dired-aux.el
View file

@ -1179,7 +1179,7 @@ archive to which you want to compress, and CMD is the
corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
output file. %i path(s) are relative, while %o is absolute.")
output file. %i path(s) are relative, while %o is absolute.")
;;;###autoload
(defun dired-do-compress-to ()

21
lisp/dired.el
View file

@ -3532,18 +3532,21 @@ confirmation. To disable the confirmation, see
(when (and (featurep 'dired-x) dired-clean-up-buffers-too)
(let ((buf (get-file-buffer fn)))
(and buf
(and dired-clean-confirm-killing-deleted-buffers
(funcall #'y-or-n-p
(format "Kill buffer of %s, too? "
(file-name-nondirectory fn))))
(or (and dired-clean-confirm-killing-deleted-buffers
(funcall #'y-or-n-p
(format "Kill buffer of %s, too? "
(file-name-nondirectory fn))))
(not dired-clean-confirm-killing-deleted-buffers))
(kill-buffer buf)))
(let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
(and buf-list
(and dired-clean-confirm-killing-deleted-buffers
(y-or-n-p (format (ngettext "Kill Dired buffer of %s, too? "
"Kill Dired buffers of %s, too? "
(length buf-list))
(file-name-nondirectory fn))))
(or (and dired-clean-confirm-killing-deleted-buffers
(y-or-n-p (format
(ngettext "Kill Dired buffer of %s, too? "
"Kill Dired buffers of %s, too? "
(length buf-list))
(file-name-nondirectory fn))))
(not dired-clean-confirm-killing-deleted-buffers))
(dolist (buf buf-list)
(kill-buffer buf))))))

112
lisp/emacs-lisp/bindat.el
View file

@ -1,4 +1,4 @@
;;; bindat.el --- binary data structure packing and unpacking.
;;; bindat.el --- binary data structure packing and unpacking. -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -198,7 +198,7 @@
(defun bindat--unpack-u8 ()
(prog1
(aref bindat-raw bindat-idx)
(aref bindat-raw bindat-idx)
(setq bindat-idx (1+ bindat-idx))))
(defun bindat--unpack-u16 ()
@ -276,6 +276,8 @@
(t nil)))
(defun bindat--unpack-group (spec)
(with-suppressed-warnings ((lexical last))
(defvar last))
(let (struct last)
(while spec
(let* ((item (car spec))
@ -287,11 +289,11 @@
data)
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)))))
(setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)))))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
(setq len (eval (car (cdr len)))))
(setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
@ -304,48 +306,51 @@
(cond
((eq type 'eval)
(if field
(setq data (eval len))
(eval len)))
(setq data (eval len t))
(eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(setq data (bindat--unpack-group (eval len))))
(setq data (bindat--unpack-group (eval len t))))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
(setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
(push (bindat--unpack-group (nthcdr tail item)) data)
(setq index (1+ index)))
(setq data (nreverse data))))
((eq type 'union)
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
(and (consp cc) (eval cc)))
(and (consp cc) (eval cc t)))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
(t
(setq data (bindat--unpack-item type len vectype)
last data)))
(if data
(if field
(setq struct (cons (cons field data) struct))
(setq struct (append data struct))))))
(setq struct (if field
(cons (cons field data) struct)
(append data struct))))))
struct))
(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
"Return structured data according to SPEC for binary data in BINDAT-RAW.
BINDAT-RAW is a unibyte string or vector.
Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW."
(when (multibyte-string-p bindat-raw)
(defun bindat-unpack (spec raw &optional idx)
"Return structured data according to SPEC for binary data in RAW.
RAW is a unibyte string or vector.
Optional third arg IDX specifies the starting offset in RAW."
(when (multibyte-string-p raw)
(error "String is multibyte"))
(unless bindat-idx (setq bindat-idx 0))
(bindat--unpack-group spec))
(let ((bindat-idx (or idx 0))
(bindat-raw raw))
(bindat--unpack-group spec)))
(defun bindat-get-field (struct &rest field)
"In structured data STRUCT, return value of field named FIELD.
@ -373,6 +378,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(ip . 4)))
(defun bindat--length-group (struct spec)
(with-suppressed-warnings ((lexical last))
(defvar last))
(let (last)
(while spec
(let* ((item (car spec))
@ -383,32 +390,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)))))
(setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)))))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
(setq len (eval (car (cdr len)))))
(setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply 'bindat-get-field struct len)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(while (eq type 'vec)
(let ((vlen 1))
(if (consp vectype)
(setq len (* len (nth 1 vectype))
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))))
(if (consp vectype)
(setq len (* len (nth 1 vectype))
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil)))
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
(eval len)))
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
@ -416,7 +422,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len)))
(if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
@ -425,13 +431,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
(and (consp cc) (eval cc)))
(and (consp cc) (eval cc t)))
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
@ -536,6 +544,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
(with-suppressed-warnings ((lexical last))
(defvar last))
(let (last)
(while spec
(let* ((item (car spec))
@ -546,11 +556,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)))))
(setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)))))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
(setq len (eval (car (cdr len)))))
(setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
@ -563,8 +573,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
(eval len)))
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
@ -572,7 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--pack-group
(if field (bindat-get-field struct field) struct) (eval len)))
(if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
@ -581,13 +591,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
(and (consp cc) (eval cc)))
(and (consp cc) (eval cc t)))
(progn
(bindat--pack-group struct (cdr case))
(setq cases nil))))))
@ -596,19 +608,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-item last type len vectype)
))))))
(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
(defun bindat-pack (spec struct &optional raw idx)
"Return binary data packed according to SPEC for structured data STRUCT.
Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
Optional third arg RAW is a pre-allocated unibyte string or vector to
pack into.
Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
(when (multibyte-string-p bindat-raw)
Optional fourth arg IDX is the starting offset into RAW."
(when (multibyte-string-p raw)
(error "Pre-allocated string is multibyte"))
(let ((no-return bindat-raw))
(unless bindat-idx (setq bindat-idx 0))
(unless bindat-raw
(setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0)))
(let* ((bindat-idx (or idx 0))
(bindat-raw
(or raw
(make-string (+ bindat-idx (bindat-length spec struct)) 0))))
(bindat--pack-group struct spec)
(if no-return nil bindat-raw)))
(if raw nil bindat-raw)))
;; Misc. format conversions

4
lisp/emacs-lisp/checkdoc.el
View file

@ -2362,7 +2362,9 @@ Code:, and others referenced in the style guide."
(checkdoc-create-error
(format "The footer should be: (provide '%s)\\n;;; %s%s ends here"
fn fn fe)
(1- (point-max)) (point-max)))))
;; The buffer may be empty.
(max (point-min) (1- (point-max)))
(point-max)))))
err))
;; The below checks will not return errors if the user says NO

2
lisp/emacs-lisp/crm.el
View file

@ -1,4 +1,4 @@
;;; crm.el --- read multiple strings with completion
;;; crm.el --- read multiple strings with completion -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.

2
lisp/emacs-lisp/derived.el
View file

@ -1,4 +1,4 @@
;;; derived.el --- allow inheritance of major modes
;;; derived.el --- allow inheritance of major modes -*- lexical-binding: t; -*-
;; (formerly mode-clone.el)
;; Copyright (C) 1993-1994, 1999, 2001-2021 Free Software Foundation,

2
lisp/emacs-lisp/eieio-opt.el
View file

@ -1,4 +1,4 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; generic.el --- defining simple major modes with comment and font-lock
;;; generic.el --- defining simple major modes with comment and font-lock -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;;
@ -245,7 +245,6 @@ Some generic modes are defined in `generic-x.el'."
"Set up comment functionality for generic mode."
(let ((chars nil)
(comstyles)
(comstyle "")
(comment-start nil))
;; Go through all the comments.
@ -269,14 +268,16 @@ Some generic modes are defined in `generic-x.el'."
;; Store the relevant info but don't update yet.
(push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
(push (cons c1 (concat (cdr (assoc c1 chars))
(concat "2" comstyle))) chars)))
(concat "2" comstyle)))
chars)))
(if (= (length end) 1)
(modify-syntax-entry (aref end 0)
(concat ">" comstyle) st)
(let ((c0 (aref end 0)) (c1 (aref end 1)))
;; Store the relevant info but don't update yet.
(push (cons c0 (concat (cdr (assoc c0 chars))
(concat "3" comstyle))) chars)
(concat "3" comstyle)))
chars)
(push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
;; Process the chars that were part of a 2-char comment marker

29
lisp/emacs-lisp/helper.el
View file

@ -1,4 +1,4 @@
;;; helper.el --- utility help package supporting help in electric modes
;;; helper.el --- utility help package supporting help in electric modes -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@ -39,20 +39,19 @@
;; keymap either.
(defvar Helper-help-map nil)
(if Helper-help-map
nil
(setq Helper-help-map (make-keymap))
;(fillarray Helper-help-map 'undefined)
(define-key Helper-help-map "m" 'Helper-describe-mode)
(define-key Helper-help-map "b" 'Helper-describe-bindings)
(define-key Helper-help-map "c" 'Helper-describe-key-briefly)
(define-key Helper-help-map "k" 'Helper-describe-key)
;(define-key Helper-help-map "f" 'Helper-describe-function)
;(define-key Helper-help-map "v" 'Helper-describe-variable)
(define-key Helper-help-map "?" 'Helper-help-options)
(define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
(fset 'Helper-help-map Helper-help-map))
(defvar Helper-help-map
(let ((map (make-sparse-keymap)))
;(fillarray map 'undefined)
(define-key map "m" 'Helper-describe-mode)
(define-key map "b" 'Helper-describe-bindings)
(define-key map "c" 'Helper-describe-key-briefly)
(define-key map "k" 'Helper-describe-key)
;(define-key map "f" 'Helper-describe-function)
;(define-key map "v" 'Helper-describe-variable)
(define-key map "?" 'Helper-help-options)
(define-key map (char-to-string help-char) 'Helper-help-options)
(fset 'Helper-help-map map)
map))
(defun Helper-help-scroller ()
(let ((blurb (or (and (boundp 'Helper-return-blurb)

81
lisp/emacs-lisp/lisp-mode.el
View file

@ -200,42 +200,54 @@
res))
(defun lisp--el-non-funcall-position-p (pos)
"Heuristically determine whether POS is an evaluated position."
(declare (obsolete lisp--el-funcall-position-p "28.1"))
(not (lisp--el-funcall-position-p pos)))
(defun lisp--el-funcall-position-p (pos)
"Heuristically determine whether POS is an evaluated position."
(save-match-data
(save-excursion
(ignore-errors
(goto-char pos)
;; '(lambda ..) is not a funcall position, but #'(lambda ...) is.
(or (and (eql (char-before) ?\')
(not (eql (char-before (1- (point))) ?#)))
(let* ((ppss (syntax-ppss))
(paren-posns (nth 9 ppss))
(parent
(when paren-posns
(goto-char (car (last paren-posns))) ;(up-list -1)
(cond
((ignore-errors
(and (eql (char-after) ?\()
(when (cdr paren-posns)
(goto-char (car (last paren-posns 2)))
(looking-at "(\\_<let\\*?\\_>"))))
(goto-char (match-end 0))
'let)
((looking-at
(rx "("
(group-n 1 (+ (or (syntax w) (syntax _))))
symbol-end))
(prog1 (intern-soft (match-string-no-properties 1))
(goto-char (match-end 1))))))))
(or (eq parent 'declare)
(and (eq parent 'let)
(progn
(forward-sexp 1)
(< pos (point))))
(and (eq parent 'condition-case)
(progn
(forward-sexp 2)
(< (point) pos))))))))))
(if (eql (char-before) ?\')
(eql (char-before (1- (point))) ?#)
(let* ((ppss (syntax-ppss))
(paren-posns (nth 9 ppss))
(parent
(when paren-posns
(goto-char (car (last paren-posns))) ;(up-list -1)
(cond
((ignore-errors
(and (eql (char-after) ?\()
(when (cdr paren-posns)
(goto-char (car (last paren-posns 2)))
(looking-at "(\\_<let\\*?\\_>"))))
(goto-char (match-end 0))
'let)
((looking-at
(rx "("
(group-n 1 (+ (or (syntax w) (syntax _))))
symbol-end))
(prog1 (intern-soft (match-string-no-properties 1))
(goto-char (match-end 1))))))))
(pcase parent
('declare nil)
('let
(forward-sexp 1)
(>= pos (point)))
('condition-case
;; If (cdr paren-posns), then we're in the BODY
;; of HANDLERS.
(or (cdr paren-posns)
(progn
(forward-sexp 1)
;; If we're in the second form, then we're in
;; a funcall position.
(< (point) pos (progn (forward-sexp 1)
(point))))))
(_ t))))))))
(defun lisp--el-match-keyword (limit)
;; FIXME: Move to elisp-mode.el.
@ -245,11 +257,9 @@
(concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
limit t)
(let ((sym (intern-soft (match-string 1))))
(when (or (special-form-p sym)
(and (macrop sym)
(not (get sym 'no-font-lock-keyword))
(not (lisp--el-non-funcall-position-p
(match-beginning 0)))))
(when (and (or (special-form-p sym) (macrop sym))
(not (get sym 'no-font-lock-keyword))
(lisp--el-funcall-position-p (match-beginning 0)))
(throw 'found t))))))
(defmacro let-when-compile (bindings &rest body)
@ -765,6 +775,7 @@ or to switch back to an existing one."
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
"\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
(setq-local comment-end "|#")
(setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()

39
lisp/emacs-lisp/macroexp.el
View file

@ -241,9 +241,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
form))
;; If the byte-optimizer is loaded, try to unfold this,
;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
;; creation of a closure, thus resulting in much better code.
(let ((newform (if (not (fboundp 'byte-compile-unfold-lambda))
'macroexp--not-unfolded
;; Don't unfold if byte-opt is not yet loaded.
(byte-compile-unfold-lambda form))))
(if (or (eq newform 'macroexp--not-unfolded)
(eq newform form))
;; Unfolding failed for some reason, avoid infinite recursion.
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
form)
(macroexp--expand-all newform))))
;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte
;; compiler has traditionally handled these functions specially
@ -257,17 +270,21 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
(macroexp--expand-all `(,fun ,f . ,args))))
(macroexp--expand-all `(,fun #',f . ,args))))
;; Second arg is a function:
(`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
(macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
(macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
(`(funcall #',(and f (pred symbolp)) . ,args)
;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
;; has a compiler-macro.
(macroexp--expand-all `(,f . ,args)))
(macroexp--expand-all `(,fun ,arg1 #',f . ,args))))
(`(funcall ,exp . ,args)
(let ((eexp (macroexp--expand-all exp))
(eargs (macroexp--all-forms args)))
;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
;; has a compiler-macro, or to unfold it.
(pcase eexp
(`#',f (macroexp--expand-all `(,f . ,eargs)))
(_ `(funcall ,eexp . ,eargs)))))
(`(,func . ,_)
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
@ -360,12 +377,12 @@ Never returns an empty list."
(t
`(cond (,test ,@(macroexp-unprogn then))
(,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
(t ,@(nthcdr 3 else))))))
,@(let ((def (nthcdr 3 else))) (if def `((t ,@def))))))))
((eq (car-safe else) 'cond)
`(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
;; Invert the test if that lets us reduce the depth of the tree.
((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
(t `(if ,test ,then ,@(macroexp-unprogn else)))))
(t `(if ,test ,then ,@(if else (macroexp-unprogn else))))))
(defmacro macroexp-let2 (test sym exp &rest body)
"Evaluate BODY with SYM bound to an expression for EXP's value.

2
lisp/emacs-lisp/package-x.el
View file

@ -1,4 +1,4 @@
;;; package-x.el --- Package extras
;;; package-x.el --- Package extras -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.

44
lisp/emacs-lisp/pcase.el
View file

@ -683,11 +683,6 @@ A and B can be one of:
;; and catch at least the easy cases such as (bug#14773).
(not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
;; In case UPAT is of the form (pred (not PRED))
((and (eq 'pred (car upat)) (eq 'not (car-safe (cadr upat))))
(let* ((test (cadr (cadr upat)))
(res (pcase--split-pred vars `(pred ,test) pat)))
(cons (cdr res) (car res))))
;; In case PAT is of the form (pred (not PRED))
((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
(let* ((test (cadr (cadr pat)))
@ -696,19 +691,34 @@ A and B can be one of:
((eq x :pcase--fail) :pcase--succeed)))))
(cons (funcall reverse (car res))
(funcall reverse (cdr res)))))
((and (eq 'pred (car upat))
(let ((otherpred
(cond ((eq 'pred (car-safe pat)) (cadr pat))
((not (eq 'quote (car-safe pat))) nil)
((consp (cadr pat)) #'consp)
((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
((byte-code-function-p (cadr pat))
#'byte-code-function-p))))
(pcase--mutually-exclusive-p (cadr upat) otherpred)))
;; All the rest below presumes UPAT is of the form (pred ...).
((not (eq 'pred (car upat))) nil)
;; In case UPAT is of the form (pred (not PRED))
((eq 'not (car-safe (cadr upat)))
(let* ((test (cadr (cadr upat)))
(res (pcase--split-pred vars `(pred ,test) pat)))
(cons (cdr res) (car res))))
((let ((otherpred
(cond ((eq 'pred (car-safe pat)) (cadr pat))
((not (eq 'quote (car-safe pat))) nil)
((consp (cadr pat)) #'consp)
((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
((byte-code-function-p (cadr pat))
#'byte-code-function-p))))
(pcase--mutually-exclusive-p (cadr upat) otherpred))
'(:pcase--fail . nil))
((and (eq 'pred (car upat))
(eq 'quote (car-safe pat))
;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
;; try and preserve the info we get from that memq test.
((and (eq 'pcase--flip (car-safe (cadr upat)))
(memq (cadr (cadr upat)) '(memq member memql))
(eq 'quote (car-safe (nth 2 (cadr upat))))
(eq 'quote (car-safe pat)))
(let ((set (cadr (nth 2 (cadr upat)))))
(if (member (cadr pat) set)
'(nil . :pcase--fail)
'(:pcase--fail . nil))))
((and (eq 'quote (car-safe pat))
(symbolp (cadr upat))
(or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
(get (cadr upat) 'side-effect-free)

51
lisp/emacs-lisp/regi.el
View file

@ -1,4 +1,4 @@
;;; regi.el --- REGular expression Interpreting engine
;;; regi.el --- REGular expression Interpreting engine -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@ -153,7 +153,7 @@ useful information:
;; set up the narrowed region
(and start
end
(let* ((tstart start)
(let* (;; (tstart start)
(start (min start end))
(end (max start end)))
(narrow-to-region
@ -206,30 +206,33 @@ useful information:
;; if the line matched, package up the argument list and
;; funcall the FUNC
(if match-p
(let* ((curline (buffer-substring
(regi-pos 'bol)
(regi-pos 'eol)))
(curframe current-frame)
(curentry entry)
(result (eval func))
(step (or (cdr (assq 'step result)) 1))
)
;; changing frame on the fly?
(if (assq 'frame result)
(setq working-frame (cdr (assq 'frame result))))
(with-suppressed-warnings
((lexical curframe curentry curline))
(defvar curframe) (defvar curentry) (defvar curline)
(let* ((curline (buffer-substring
(regi-pos 'bol)
(regi-pos 'eol)))
(curframe current-frame)
(curentry entry)
(result (eval func))
(step (or (cdr (assq 'step result)) 1))
)
;; changing frame on the fly?
(if (assq 'frame result)
(setq working-frame (cdr (assq 'frame result))))
;; continue processing current frame?
(if (memq 'continue result)
(setq current-frame (cdr current-frame))
(forward-line step)
(setq current-frame working-frame))
;; continue processing current frame?
(if (memq 'continue result)
(setq current-frame (cdr current-frame))
(forward-line step)
(setq current-frame working-frame))
;; abort current frame?
(if (memq 'abort result)
(progn
(setq donep t)
(throw 'regi-throw-top t)))
) ; end-let
;; abort current frame?
(if (memq 'abort result)
(progn
(setq donep t)
(throw 'regi-throw-top t)))
)) ; end-let
;; else if no match occurred, then process the next
;; frame-entry on the current line

22
lisp/emacs-lisp/shadow.el
View file

@ -1,4 +1,4 @@
;;; shadow.el --- locate Emacs Lisp file shadowings
;;; shadow.el --- locate Emacs Lisp file shadowings -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@ -58,8 +58,7 @@
(defcustom load-path-shadows-compare-text nil
"If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
:type 'boolean
:group 'lisp-shadow)
:type 'boolean)
(defun load-path-shadows-find (&optional path)
"Return a list of Emacs Lisp files that create shadows.
@ -78,8 +77,7 @@ See the documentation for `list-load-path-shadows' for further information."
dir-case-insensitive ; `file-name-case-insensitive-p' of dir.
curr-files ; This dir's Emacs Lisp files.
orig-dir ; Where the file was first seen.
files-seen-this-dir ; Files seen so far in this dir.
file) ; The current file.
files-seen-this-dir) ; Files seen so far in this dir.
(dolist (pp (or path load-path))
(setq dir (directory-file-name (file-truename (or pp "."))))
(if (member dir true-names)
@ -109,7 +107,7 @@ See the documentation for `list-load-path-shadows' for further information."
(dolist (file curr-files)
(if (string-match "\\.gz$" file)
(if (string-match "\\.gz\\'" file)
(setq file (substring file 0 -3)))
(setq file (substring
file 0 (if (string= (substring file -1) "c") -4 -3)))
@ -125,9 +123,13 @@ See the documentation for `list-load-path-shadows' for further information."
;; XXX.elc (or vice-versa) when they are in the same directory.
(setq files-seen-this-dir (cons file files-seen-this-dir))
(if (setq orig-dir (assoc file files
(when dir-case-insensitive
(lambda (f1 f2) (eq (compare-strings f1 nil nil f2 nil nil t) t)))))
(if (setq orig-dir
(assoc file files
(when dir-case-insensitive
(lambda (f1 f2)
(eq (compare-strings f1 nil nil
f2 nil nil t)
t)))))
;; This file was seen before, we have a shadowing.
;; Report it unless the files are identical.
(let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))
@ -142,7 +144,7 @@ See the documentation for `list-load-path-shadows' for further information."
(append shadows (list base1 base2)))))
;; Not seen before, add it to the list of seen files.
(setq files (cons (cons file dir) files)))))))
(push (cons file dir) files))))))
;; Return the list of shadowings.
shadows))

32
lisp/emacs-lisp/tcover-ses.el
View file

@ -1,4 +1,4 @@
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -19,21 +19,14 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; FIXME: Convert to ERT and move to `test/'?
;;; Code:
(require 'testcover)
(defvar ses-initial-global-parameters)
(defvar ses-mode-map)
(declare-function ses-set-curcell "ses")
(declare-function ses-update-cells "ses")
(declare-function ses-load "ses")
(declare-function ses-vector-delete "ses")
(declare-function ses-create-header-string "ses")
(declare-function ses-read-cell "ses")
(declare-function ses-read-symbol "ses")
(declare-function ses-command-hook "ses")
(declare-function ses-jump "ses")
(require 'ses)
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
@ -652,6 +645,7 @@ spreadsheet files with invalid formatting."
(testcover-start "ses.el" t))
(require 'unsafep)) ;In case user has safe-functions = t!
(defvar ses--curcell-overlay)
;;;#########################################################################
(defun ses-exercise ()
@ -674,8 +668,8 @@ spreadsheet files with invalid formatting."
(ses-load))
;;ses-vector-delete is always called from buffer-undo-list with the same
;;symbol as argument. We'll give it a different one here.
(let ((x [1 2 3]))
(ses-vector-delete 'x 0 0))
(dlet ((tcover-ses--x [1 2 3]))
(ses-vector-delete 'tcover-ses--x 0 0))
;;ses-create-header-string behaves differently in a non-window environment
;;but we always test under windows.
(let ((window-system (not window-system)))
@ -704,7 +698,7 @@ spreadsheet files with invalid formatting."
(ses-mode)))))
;;Test error-handling in command hook, outside a macro.
;;This will ring the bell.
(let (curcell-overlay)
(let (ses--curcell-overlay)
(ses-command-hook))
;;Due to use of run-with-timer, ses-command-hook sometimes gets called
;;after we switch to another buffer.
@ -720,4 +714,4 @@ spreadsheet files with invalid formatting."
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
;; testcover-ses.el ends here.
;;; testcover-ses.el ends here.

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

@ -1,4 +1,4 @@
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -129,15 +129,16 @@ in the parse.")
(put x 'safe-function t))
;;;###autoload
(defun unsafep (form &optional unsafep-vars)
(defun unsafep (form &optional vars)
"Return nil if evaluating FORM couldn't possibly do any harm.
Otherwise result is a reason why FORM is unsafe.
UNSAFEP-VARS is a list of symbols with local bindings."
VARS is a list of symbols with local bindings like `unsafep-vars'."
(catch 'unsafep
(if (or (eq safe-functions t) ;User turned off safety-checking
(atom form)) ;Atoms are never unsafe
(throw 'unsafep nil))
(let* ((fun (car form))
(let* ((unsafep-vars vars)
(fun (car form))
(reason (unsafep-function fun))
arg)
(cond

2
lisp/ezimage.el
View file

@ -1,4 +1,4 @@
;;; ezimage --- Generalized Image management
;;; ezimage.el --- Generalized Image management -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.

11
lisp/faces.el
View file

@ -2683,11 +2683,20 @@ the same as `window-divider' face."
(defface internal-border
'((t nil))
"Basic face for the internal border."
"Basic face for the internal border.
For the internal border of child frames see `child-frame-border'."
:version "26.1"
:group 'frames
:group 'basic-faces)
(defface child-frame-border
'((t nil))
"Basic face for the internal border of child frames.
For the internal border of non-child frames see `internal-border'."
:version "28.1"
:group 'frames
:group 'basic-faces)
(defface minibuffer-prompt
'((((background dark)) :foreground "cyan")
;; Don't use blue because many users of the MS-DOS port customize

2
lisp/files.el
View file

@ -4073,7 +4073,7 @@ Return the new variables list."
;; integer values for subdir, where N means
;; variables apply to this directory and N levels
;; below it (0 == nil).
(equal root default-directory))
(equal root (expand-file-name default-directory)))
(setq variables (dir-locals-collect-mode-variables
alist variables))))))))
(error

4
lisp/find-cmd.el
View file

@ -1,4 +1,4 @@
;;; find-cmd.el --- Build a valid find(1) command with sexps
;;; find-cmd.el --- Build a valid find(1) command with sexps -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -28,7 +28,7 @@
;; (find-cmd '(prune (name ".svn" ".git" ".CVS"))
;; '(and (or (name "*.pl" "*.pm" "*.t")
;; (mtime "+1"))
;; (fstype "nfs" "ufs"))))
;; (fstype "nfs" "ufs")))
;; will become (un-wrapped):

13
lisp/flow-ctrl.el
View file

@ -1,4 +1,4 @@
;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control -*- lexical-binding: t -*-
;; Copyright (C) 1990-1991, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@ -64,12 +64,11 @@ With arg, enable flow control mode if arg is positive, otherwise disable."
(progn
;; Turn flow control off, and stop exchanging chars.
(set-input-mode t nil (nth 2 (current-input-mode)))
(if keyboard-translate-table
(progn
(aset keyboard-translate-table flow-control-c-s-replacement nil)
(aset keyboard-translate-table ?\^s nil)
(aset keyboard-translate-table flow-control-c-q-replacement nil)
(aset keyboard-translate-table ?\^q nil))))
(when keyboard-translate-table
(aset keyboard-translate-table flow-control-c-s-replacement nil)
(aset keyboard-translate-table ?\^s nil)
(aset keyboard-translate-table flow-control-c-q-replacement nil)
(aset keyboard-translate-table ?\^q nil)))
;; Turn flow control on.
;; Tell emacs to pass C-s and C-q to OS.
(set-input-mode nil t (nth 2 (current-input-mode)))

109
lisp/generic-x.el
View file

@ -1,4 +1,4 @@
;;; generic-x.el --- A collection of generic modes
;;; generic-x.el --- A collection of generic modes -*- lexical-binding: t -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
@ -121,14 +121,12 @@
"If non-nil, add a hook to enter `default-generic-mode' automatically.
This is done if the first few lines of a file in fundamental mode
start with a hash comment character."
:group 'generic-x
:type 'boolean)
(defcustom generic-lines-to-scan 3
"Number of lines that `generic-mode-find-file-hook' looks at.
Relevant when deciding whether to enter Default-Generic mode automatically.
This variable should be set to a small positive number."
:group 'generic-x
:type 'integer)
(defcustom generic-find-file-regexp "^#"
@ -137,7 +135,6 @@ Files in fundamental mode whose first few lines contain a match
for this regexp, should be put into Default-Generic mode instead.
The number of lines tested for the matches is specified by the
value of the variable `generic-lines-to-scan', which see."
:group 'generic-x
:type 'regexp)
(defcustom generic-ignore-files-regexp "[Tt][Aa][Gg][Ss]\\'"
@ -146,7 +143,6 @@ Files whose names match this regular expression should not be put
into Default-Generic mode, even if they have lines which match
the regexp in `generic-find-file-regexp'. If the value is nil,
`generic-mode-find-file-hook' does not check the file names."
:group 'generic-x
:type '(choice (const :tag "Don't check file names" nil) regexp))
;; This generic mode is always defined
@ -249,7 +245,6 @@ This hook will be installed if the variable
Each entry in the list should be a symbol. If you set this variable
directly, without using customize, you must reload generic-x to put
your changes into effect."
:group 'generic-x
:type (let (list)
(dolist (mode
(sort (append generic-default-modes
@ -365,7 +360,8 @@ your changes into effect."
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
'(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face))
'(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face)
("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
"Generic mode for HOSTS files."))
@ -415,7 +411,8 @@ like an INI file. You can add this hook to `find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
(defalias 'generic-mode-ini-file-find-file-hook 'ini-generic-mode-find-file-hook))
(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
'ini-generic-mode-find-file-hook "28.1"))
;;; Windows REG files
;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
@ -1296,19 +1293,16 @@ like an INI file. You can add this hook to `find-file-hook'."
;; here manually instead
(defun generic-rul-mode-setup-function ()
(make-local-variable 'parse-sexp-ignore-comments)
(make-local-variable 'comment-start)
(make-local-variable 'comment-start-skip)
(make-local-variable 'comment-end)
(setq imenu-generic-expression
'((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1))
parse-sexp-ignore-comments t
comment-end "*/"
comment-start "/*"
;;; comment-end ""
;;; comment-start "//"
;;; comment-start-skip ""
)
'((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)))
(setq-local parse-sexp-ignore-comments t
comment-end "*/"
comment-start "/*"
;;; comment-end ""
;;; comment-start "//"
;;; comment-start-skip ""
)
;; (set-syntax-table rul-generic-mode-syntax-table)
(setq-local font-lock-syntax-table rul-generic-mode-syntax-table))
@ -1458,7 +1452,7 @@ like an INI file. You can add this hook to `find-file-hook'."
":"
;; Password, UID and GID
(mapconcat
'identity
#'identity
(make-list 3 "\\([^:]+\\)")
":")
":"
@ -1490,41 +1484,104 @@ like an INI file. You can add this hook to `find-file-hook'."
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
"ados"
"affs"
"anon_inodefs"
"atfs"
"audiofs"
"autofs"
"bdev"
"befs"
"bfs"
"binfmt_misc"
"btrfs"
"cd9660"
"cfs"
"cgroup"
"cifs"
"coda"
"coherent"
"configfs"
"cpuset"
"cramfs"
"devfs"
"devpts"
"devtmpfs"
"e2compr"
"efs"
"ext2"
"ext2fs"
"ext3"
"ext4"
"fdesc"
"ffs"
"filecore"
"fuse"
"fuseblk"
"fusectl"
"hfs"
"hpfs"
"hugetlbfs"
"iso9660"
"jffs"
"jffs2"
"jfs"
"kernfs"
"lfs"
"linprocfs"
"mfs"
"minix"
"mqueue"
"msdos"
"ncpfs"
"nfs"
"nfsd"
"nilfs2"
"none"
"ntfs"
"null"
"nwfs"
"overlay"
"ovlfs"
"pipefs"
"portal"
"proc"
"procfs"
"pstore"
"ptyfs"
"qnx4"
"ramfs"
"reiserfs"
"romfs"
"securityfs"
"shm"
"smbfs"
"cifs"
"usbdevfs"
"sysv"
"sockfs"
"squashfs"
"sshfs"
"std"
"subfs"
"sysfs"
"sysv"
"tcfs"
"tmpfs"
"udf"
"ufs"
"umap"
"umsdos"
"union"
"usbdevfs"
"usbfs"
"userfs"
"vfat"
"vs3fs"
"vxfs"
"wrapfs"
"wvfs"
"xenfs"
"xenix"
"xfs"
"zisofs"
"swap"
"auto"
"ignore")
@ -1575,8 +1632,7 @@ like an INI file. You can add this hook to `find-file-hook'."
(((class color) (min-colors 88)) (:background "red1"))
(((class color)) (:background "red"))
(t (:weight bold)))
"Font Lock mode face used to highlight TABs."
:group 'generic-x)
"Font Lock mode face used to highlight TABs.")
(defface show-tabs-space
'((((class grayscale) (background light)) (:background "DimGray" :weight bold))
@ -1584,8 +1640,7 @@ like an INI file. You can add this hook to `find-file-hook'."
(((class color) (min-colors 88)) (:background "yellow1"))
(((class color)) (:background "yellow"))
(t (:weight bold)))
"Font Lock mode face used to highlight spaces."
:group 'generic-x)
"Font Lock mode face used to highlight spaces.")
(define-generic-mode show-tabs-generic-mode
nil ;; no comment char

373
lisp/gnus/gnus-agent.el
View file

@ -1789,7 +1789,6 @@ variables. Returns the first non-nil value found."
. gnus-agent-enable-expiration)
(agent-predicate . gnus-agent-predicate)))))))
;; FIXME: This looks an awful lot like `gnus-agent-retrieve-headers'.
(defun gnus-agent-fetch-headers (group)
"Fetch interesting headers into the agent. The group's overview
file will be updated to include the headers while a list of available
@ -1811,9 +1810,10 @@ article numbers will be returned."
(cdr active))))
(gnus-uncompress-range (gnus-active group)))
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
(file-name-coding-system nnmail-pathname-coding-system)
headers fetched-headers)
(file-name-coding-system nnmail-pathname-coding-system))
(unless fetch-all
;; Add articles with marks to the list of article headers we want to
@ -1824,7 +1824,7 @@ article numbers will be returned."
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
(setq articles (gnus-range-add articles (cdr arts)))))
(setq articles (sort (gnus-uncompress-range articles) '<)))
(setq articles (sort (gnus-uncompress-sequence articles) '<)))
;; At this point, I have the list of articles to consider for
;; fetching. This is the list that I'll return to my caller. Some
@ -1867,52 +1867,38 @@ article numbers will be returned."
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
(gnus-compress-sequence articles t)))
;; Parse known headers from FILE.
(if (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(erase-buffer)
(let ((nnheader-file-coding-system
gnus-agent-file-coding-system))
(nnheader-insert-nov-file file (car articles))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring gnus-agent-overview-buffer)
(setq headers
(gnus-get-newsgroup-headers-xover
articles nil (buffer-local-value
'gnus-newsgroup-dependencies
gnus-summary-buffer)
gnus-newsgroup-name)))))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t)))
(with-current-buffer nntp-server-buffer
(if articles
(progn
(gnus-message 8 "Fetching headers for %s..." group)
;; Fetch our new headers.
(gnus-message 8 "Fetching headers for %s..." group)
(if articles
(setq fetched-headers (gnus-fetch-headers articles)))
;; Fetch them.
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
;; Merge two sets of headers.
(setq headers
(if (and headers fetched-headers)
(delete-dups
(sort (append headers (copy-sequence fetched-headers))
(lambda (l r)
(< (mail-header-number l)
(mail-header-number r)))))
(or headers fetched-headers)))
;; Save the new set of headers to FILE.
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(with-current-buffer gnus-agent-overview-buffer
(goto-char (point-max))
(mapc #'nnheader-insert-nov fetched-headers)
(sort-numeric-fields 1 (point-min) (point-max))
(gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent))
(gnus-agent-update-view-total-fetched-for group t)
(gnus-agent-save-alist group articles nil)))
headers))
(unless (eq 'nov (gnus-retrieve-headers articles group))
(nnvirtual-convert-headers))
(gnus-agent-check-overview-buffer)
;; Move these headers to the overview buffer so that
;; gnus-agent-braid-nov can merge them with the contents
;; of FILE.
(copy-to-buffer
gnus-agent-overview-buffer (point-min) (point-max))
;; NOTE: Call g-a-brand-nov even when the file does not
;; exist. As a minimum, it will validate the article
;; numbers already in the buffer.
(gnus-agent-braid-nov articles file)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent))
(gnus-agent-update-view-total-fetched-for group t)
(gnus-agent-save-alist group articles nil)
articles)
(ignore-errors
(erase-buffer)
(nnheader-insert-file-contents file)))))
articles))
(defsubst gnus-agent-read-article-number ()
"Read the article number at point.
@ -1938,6 +1924,96 @@ Return nil when a valid article number can not be read."
(set-buffer nntp-server-buffer)
(insert-buffer-substring gnus-agent-overview-buffer b e))))
(defun gnus-agent-braid-nov (articles file)
"Merge agent overview data with given file.
Takes unvalidated headers for ARTICLES from
`gnus-agent-overview-buffer' and validated headers from the given
FILE and places the combined valid headers into
`nntp-server-buffer'. This function can be used, when file
doesn't exist, to valid the overview buffer."
(let (start last)
(set-buffer gnus-agent-overview-buffer)
(goto-char (point-min))
(set-buffer nntp-server-buffer)
(erase-buffer)
(when (file-exists-p file)
(nnheader-insert-file-contents file))
(goto-char (point-max))
(forward-line -1)
(unless (or (= (point-min) (point-max))
(< (setq last (read (current-buffer))) (car articles)))
;; Old and new overlap -- We do it the hard way.
(when (nnheader-find-nov-line (car articles))
;; Replacing existing NOV entry
(delete-region (point) (progn (forward-line 1) (point))))
(gnus-agent-copy-nov-line (pop articles))
(ignore-errors
(while articles
(while (let ((art (read (current-buffer))))
(cond ((< art (car articles))
(forward-line 1)
t)
((= art (car articles))
(beginning-of-line)
(delete-region
(point) (progn (forward-line 1) (point)))
nil)
(t
(beginning-of-line)
nil))))
(gnus-agent-copy-nov-line (pop articles)))))
(goto-char (point-max))
;; Append the remaining lines
(when articles
(when last
(set-buffer gnus-agent-overview-buffer)
(setq start (point))
(set-buffer nntp-server-buffer))
(let ((p (point)))
(insert-buffer-substring gnus-agent-overview-buffer start)
(goto-char p))
(setq last (or last -134217728))
(while (catch 'problems
(let (sort art)
(while (not (eobp))
(setq art (gnus-agent-read-article-number))
(cond ((not art)
;; Bad art num - delete this line
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point))))
((< art last)
;; Art num out of order - enable sort
(setq sort t)
(forward-line 1))
((= art last)
;; Bad repeat of art number - delete this line
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point))))
(t
;; Good art num
(setq last art)
(forward-line 1))))
(when sort
;; something is seriously wrong as we simply shouldn't see out-of-order data.
;; First, we'll fix the sort.
(sort-numeric-fields 1 (point-min) (point-max))
;; but now we have to consider that we may have duplicate rows...
;; so reset to beginning of file
(goto-char (point-min))
(setq last -134217728)
;; and throw a code that restarts this scan
(throw 'problems t))
nil))))))
;; Keeps the compiler from warning about the free variable in
;; gnus-agent-read-agentview.
(defvar gnus-agent-read-agentview)
@ -2310,9 +2386,10 @@ modified) original contents, they are first saved to their own file."
(gnus-orphan-score gnus-orphan-score)
;; Maybe some other gnus-summary local variables should also
;; be put here.
fetched-headers
gnus-headers
gnus-score
articles
predicate info marks
)
(unless (gnus-check-group group)
@ -2333,35 +2410,38 @@ modified) original contents, they are first saved to their own file."
(setq info (gnus-get-info group)))))))
(when arts
(setq marked-articles (nconc (gnus-uncompress-range arts)
marked-articles))))))
marked-articles))
))))
(setq marked-articles (sort marked-articles '<))
(setq gnus-newsgroup-dependencies
(or gnus-newsgroup-dependencies
(gnus-make-hashtable)))
;; Fetch any new articles from the server
(setq articles (gnus-agent-fetch-headers group))
;; Fetch headers for any new articles from the server.
(setq fetched-headers (gnus-agent-fetch-headers group))
;; Merge new articles with marked
(setq articles (sort (append marked-articles articles) '<))
(when fetched-headers
(when articles
;; Parse them and see which articles we want to fetch.
(setq gnus-newsgroup-dependencies
(or gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles))))
(setq gnus-newsgroup-headers
(or gnus-newsgroup-headers
fetched-headers)))
(when marked-articles
;; `gnus-agent-overview-buffer' may be killed for timeout
;; reason. If so, recreate it.
(or gnus-newsgroup-headers
(gnus-get-newsgroup-headers-xover articles nil nil
group)))
;; `gnus-agent-overview-buffer' may be killed for
;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)
(setq predicate
(gnus-get-predicate
(gnus-agent-find-parameter group 'agent-predicate)))
;; If the selection predicate requires scoring, score each header.
(gnus-get-predicate
(gnus-agent-find-parameter group 'agent-predicate)))
;; If the selection predicate requires scoring, score each header
(unless (memq predicate '(gnus-agent-true gnus-agent-false))
(let ((score-param
(gnus-agent-find-parameter group 'agent-score-file)))
;; Translate score-param into real one.
;; Translate score-param into real one
(cond
((not score-param))
((eq score-param 'file)
@ -3581,9 +3661,11 @@ has been fetched."
(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
(save-excursion
(gnus-agent-create-buffer)
(let ((file (gnus-agent-article-name ".overview" group))
(file-name-coding-system nnmail-pathname-coding-system)
uncached-articles headers fetched-headers)
(let ((gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
uncached-articles
(file-name-coding-system nnmail-pathname-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
@ -3594,63 +3676,122 @@ has been fetched."
1)
(car (last articles))))))
;; See if we've got cached headers for ARTICLES and put them in
;; HEADERS. Articles with no cached headers go in
;; UNCACHED-ARTICLES to be fetched from the server.
;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(erase-buffer)
(let ((nnheader-file-coding-system
gnus-agent-file-coding-system))
(nnheader-insert-nov-file file (car articles))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring gnus-agent-overview-buffer)
(setq headers
(gnus-get-newsgroup-headers-xover
articles nil (buffer-local-value
'gnus-newsgroup-dependencies
gnus-summary-buffer)
gnus-newsgroup-name))))))
(nnheader-insert-nov-file file (car articles)))))
(setq uncached-articles
(gnus-agent-uncached-articles articles group t))
(if (setq uncached-articles (gnus-agent-uncached-articles articles group
t))
(progn
;; Populate nntp-server-buffer with uncached headers
(set-buffer nntp-server-buffer)
(erase-buffer)
(cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
(gnus-retrieve-headers
uncached-articles group))))
(nnvirtual-convert-headers))
((eq 'nntp (car gnus-current-select-method))
;; The author of gnus-get-newsgroup-headers-xover
;; reports that the XOVER command is commonly
;; unreliable. The problem is that recently
;; posted articles may not be entered into the
;; NOV database in time to respond to my XOVER
;; query.
;;
;; I'm going to use his assumption that the NOV
;; database is updated in order of ascending
;; article ID. Therefore, a response containing
;; article ID N implies that all articles from 1
;; to N-1 are up-to-date. Therefore, missing
;; articles in that range have expired.
(when uncached-articles
(let ((gnus-newsgroup-name group)
gnus-agent) ; Prevent loop.
;; Fetch additional headers for the uncached articles.
(setq fetched-headers (gnus-fetch-headers uncached-articles))
;; Merge headers we got from the overview file with our
;; newly-fetched headers.
(when fetched-headers
(setq headers
(delete-dups
(sort (append headers (copy-sequence fetched-headers))
(lambda (l r)
(< (mail-header-number l)
(mail-header-number r))))))
(set-buffer nntp-server-buffer)
(let* ((fetched-articles (list nil))
(tail-fetched-articles fetched-articles)
(min (car articles))
(max (car (last articles))))
;; Add the new set of known headers to the overview file.
;; Get the list of articles that were fetched
(goto-char (point-min))
(let ((pm (point-max))
art)
(while (< (point) pm)
(when (setq art (gnus-agent-read-article-number))
(gnus-agent-append-to-list tail-fetched-articles art))
(forward-line 1)))
;; Clip this list to the headers that will
;; actually be returned
(setq fetched-articles (gnus-list-range-intersection
(cdr fetched-articles)
(cons min max)))
;; Clip the uncached articles list to exclude
;; IDs after the last FETCHED header. The
;; excluded IDs may be fetchable using HEAD.
(if (car tail-fetched-articles)
(setq uncached-articles
(gnus-list-range-intersection
uncached-articles
(cons (car uncached-articles)
(car tail-fetched-articles)))))
;; Create the list of articles that were
;; "successfully" fetched. Success, in this
;; case, means that the ID should not be
;; fetched again. In the case of an expired
;; article, the header will not be fetched.
(setq uncached-articles
(gnus-sorted-nunion fetched-articles
uncached-articles))
)))
;; Erase the temp buffer
(set-buffer gnus-agent-overview-buffer)
(erase-buffer)
;; Copy the nntp-server-buffer to the temp buffer
(set-buffer nntp-server-buffer)
(copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
;; Merge the temp buffer with the known headers (found on
;; disk in FILE) into the nntp-server-buffer
(when uncached-articles
(gnus-agent-braid-nov uncached-articles file))
;; Save the new set of known headers to FILE
(set-buffer nntp-server-buffer)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(with-current-buffer gnus-agent-overview-buffer
;; We stick the new headers in at the end, then
;; re-sort the whole buffer with
;; `sort-numeric-fields'. If this turns out to be
;; slow, we could consider a loop to add the headers
;; in sorted order to begin with.
(goto-char (point-max))
(mapc #'nnheader-insert-nov fetched-headers)
(sort-numeric-fields 1 (point-min) (point-max))
(gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent)
(gnus-agent-update-view-total-fetched-for group t)
;; Update the group's article alist to include the
;; newly fetched articles.
(gnus-agent-load-alist group)
(gnus-agent-save-alist group uncached-articles nil))))))
headers)))
(gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent))
(gnus-agent-update-view-total-fetched-for group t)
;; Update the group's article alist to include the newly
;; fetched articles.
(gnus-agent-load-alist group)
(gnus-agent-save-alist group uncached-articles nil)
)
;; Copy the temp buffer to the nntp-server-buffer
(set-buffer nntp-server-buffer)
(erase-buffer)
(insert-buffer-substring gnus-agent-overview-buffer)))
(if (and fetch-old
(not (numberp fetch-old)))
t ; Don't remove anything.
(nnheader-nov-delete-outside-range
(car articles)
(car (last articles)))
t)
'nov))
(defun gnus-agent-request-article (article group)
"Retrieve ARTICLE in GROUP from the agent cache."

9
lisp/gnus/gnus-async.el
View file

@ -357,13 +357,8 @@ that was fetched."
(let ((nntp-server-buffer (current-buffer))
(nnheader-callback-function
(lambda (_arg)
(setq gnus-async-header-prefetched
(cons group unread)))))
;; FIXME: If header prefetch is ever put into use, we'll
;; have to handle the possibility that
;; `gnus-retrieve-headers' might return a list of header
;; vectors directly, rather than writing them into the
;; current buffer.
(setq gnus-async-header-prefetched
(cons group unread)))))
(gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
(defun gnus-async-retrieve-fetched-headers (articles group)

126
lisp/gnus/gnus-cache.el
View file

@ -294,47 +294,49 @@ it's not cached."
(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
"Retrieve the headers for ARTICLES in GROUP."
(let ((cached
(setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))
(gnus-newsgroup-name group)
(gnus-fetch-old-headers fetch-old))
(setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
(if (not cached)
;; No cached articles here, so we just retrieve them
;; the normal way.
(let ((gnus-use-cache nil))
(gnus-retrieve-headers articles group))
(gnus-retrieve-headers articles group fetch-old))
(let ((uncached-articles (gnus-sorted-difference articles cached))
(cache-file (gnus-cache-file-name group ".overview"))
(file-name-coding-system nnmail-pathname-coding-system)
headers)
type
(file-name-coding-system nnmail-pathname-coding-system))
;; We first retrieve all the headers that we don't have in
;; the cache.
(let ((gnus-use-cache nil))
(when uncached-articles
(setq headers (and articles
(gnus-fetch-headers uncached-articles)))))
(setq type (and articles
(gnus-retrieve-headers
uncached-articles group fetch-old)))))
(gnus-cache-save-buffers)
;; Then we include the cached headers.
(when (file-exists-p cache-file)
(setq headers
(delete-dups
(sort
(append headers
(let ((coding-system-for-read
gnus-cache-overview-coding-system))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-file-contents cache-file)
(gnus-get-newsgroup-headers-xover
(gnus-sorted-difference
cached uncached-articles)
nil (buffer-local-value
'gnus-newsgroup-dependencies
gnus-summary-buffer)
group))))
(lambda (l r)
(< (mail-header-number l)
(mail-header-number r)))))))
headers))))
;; Then we insert the cached headers.
(save-excursion
(cond
((not (file-exists-p cache-file))
;; There are no cached headers.
type)
((null type)
;; There were no uncached headers (or retrieval was
;; unsuccessful), so we use the cached headers exclusively.
(set-buffer nntp-server-buffer)
(erase-buffer)
(let ((coding-system-for-read
gnus-cache-overview-coding-system))
(insert-file-contents cache-file))
'nov)
((eq type 'nov)
;; We have both cached and uncached NOV headers, so we
;; braid them.
(gnus-cache-braid-nov group cached)
type)
(t
;; We braid HEADs.
(gnus-cache-braid-heads group (gnus-sorted-intersection
cached articles))
type)))))))
(defun gnus-cache-enter-article (&optional n)
"Enter the next N articles into the cache.
@ -527,6 +529,70 @@ Returns the list of articles removed."
(setq gnus-cache-active-altered t)))
articles)))
(defun gnus-cache-braid-nov (group cached &optional file)
(let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
beg end)
(gnus-cache-save-buffers)
(with-current-buffer cache-buf
(erase-buffer)
(let ((coding-system-for-read gnus-cache-overview-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
(insert-file-contents
(or file (gnus-cache-file-name group ".overview"))))
(goto-char (point-min))
(insert "\n")
(goto-char (point-min)))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(while cached
(while (and (not (eobp))
(< (read (current-buffer)) (car cached)))
(forward-line 1))
(beginning-of-line)
(set-buffer cache-buf)
(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
nil t)
(setq beg (point-at-bol)
end (progn (end-of-line) (point)))
(setq beg nil))
(set-buffer nntp-server-buffer)
(when beg
(insert-buffer-substring cache-buf beg end)
(insert "\n"))
(setq cached (cdr cached)))
(kill-buffer cache-buf)))
(defun gnus-cache-braid-heads (group cached)
(let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
(with-current-buffer cache-buf
(erase-buffer))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(dolist (entry cached)
(while (and (not (eobp))
(looking-at "2.. +\\([0-9]+\\) ")
(< (progn (goto-char (match-beginning 1))
(read (current-buffer)))
entry))
(search-forward "\n.\n" nil 'move))
(beginning-of-line)
(set-buffer cache-buf)
(erase-buffer)
(let ((coding-system-for-read gnus-cache-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
(insert-file-contents (gnus-cache-file-name group entry)))
(goto-char (point-min))
(insert "220 ")
(princ (pop cached) (current-buffer))
(insert " Article retrieved.\n")
(search-forward "\n\n" nil 'move)
(delete-region (point) (point-max))
(forward-char -1)
(insert ".")
(set-buffer nntp-server-buffer)
(insert-buffer-substring cache-buf))
(kill-buffer cache-buf)))
;;;###autoload
(defun gnus-jog-cache ()
"Go through all groups and put the articles into the cache.

16
lisp/gnus/gnus-cloud.el
View file

@ -30,8 +30,6 @@
(require 'parse-time)
(require 'nnimap)
(declare-function gnus-fetch-headers "gnus-sum")
(defvar gnus-alter-header-function)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
@ -393,6 +391,8 @@ When FULL is t, upload everything, not just a difference from the last full."
(gnus-group-refresh-group group))
(gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
(defvar gnus-alter-header-function)
(defun gnus-cloud-add-timestamps (elems)
(dolist (elem elems)
(let* ((file-name (plist-get elem :file-name))
@ -407,10 +407,14 @@ When FULL is t, upload everything, not just a difference from the last full."
(gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
(let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
(active (gnus-active group))
(gnus-newsgroup-name group)
(headers (gnus-fetch-headers (gnus-uncompress-range active))))
(when gnus-alter-header-function
(mapc gnus-alter-header-function headers))
headers head)
(when (gnus-retrieve-headers (gnus-uncompress-range active) group)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(while (setq head (nnheader-parse-head))
(when gnus-alter-header-function
(funcall gnus-alter-header-function head))
(push head headers))))
(sort (nreverse headers)
(lambda (h1 h2)
(> (gnus-cloud-chunk-sequence (mail-header-subject h1))

1
lisp/gnus/gnus-icalendar.el
View file

@ -835,6 +835,7 @@ These will be used to retrieve the RSVP information from ical events."
keymap ,gnus-mime-button-map
face ,gnus-article-button-face
follow-link t
category t
button t
gnus-data ,data))))

65
lisp/gnus/gnus-sum.el
View file

@ -5658,21 +5658,10 @@ or a straight list of headers."
(setf (mail-header-subject header) subject))))))
(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES.
This calls the `gnus-retrieve-headers' function of the current
group's backend server. The server can do one of two things:
1. Write the headers for ARTICLES into the
`nntp-server-buffer' (the current buffer) in a parseable format, or
2. Return the headers directly as a list of vectors.
In the first case, `gnus-retrieve-headers' returns a symbol
value, either `nov' or `headers'. This value determines which
parsing function is used to read the headers. It is also stored
into the variable `gnus-headers-retrieved-by', which is consulted
later when possibly building full threads."
"Fetch headers of ARTICLES."
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
(let ((res (setq gnus-headers-retrieved-by
(prog1
(pcase (setq gnus-headers-retrieved-by
(gnus-retrieve-headers
articles gnus-newsgroup-name
(or limit
@ -5682,34 +5671,22 @@ later when possibly building full threads."
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))
gnus-fetch-old-headers))))))
(prog1
(pcase res
('nov
(gnus-get-newsgroup-headers-xover
articles force-new dependencies gnus-newsgroup-name t))
;; For now, assume that any backend returning its own
;; headers takes some effort to do so, so return `headers'.
((pred listp)
(setq gnus-headers-retrieved-by 'headers)
(let ((dependencies
(or dependencies
(buffer-local-value
'gnus-newsgroup-dependencies gnus-summary-buffer))))
(when (functionp gnus-alter-header-function)
(mapc gnus-alter-header-function res))
(mapc (lambda (header)
;; The agent or the cache may have already
;; registered this header in the dependency
;; table.
(unless (gethash (mail-header-id header) dependencies)
(gnus-dependencies-add-header
header dependencies force-new)))
res)
res))
(_ (gnus-get-newsgroup-headers dependencies force-new)))
(gnus-message 7 "Fetching headers for %s...done"
gnus-newsgroup-name))))
gnus-fetch-old-headers))))
('nov
(gnus-get-newsgroup-headers-xover
articles force-new dependencies gnus-newsgroup-name t))
('headers
(gnus-get-newsgroup-headers dependencies force-new))
((pred listp)
(let ((dependencies
(or dependencies
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-dependencies))))
(delq nil (mapcar #'(lambda (header)
(gnus-dependencies-add-header
header dependencies force-new))
gnus-headers-retrieved-by)))))
(gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@ -6466,10 +6443,6 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(unless (gnus-ephemeral-group-p group)
(gnus-group-update-group group t))))))
;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and
;; extract the necessary bits for the direct-header-return case. Also
;; look at this and see how similar it is to
;; `nnheader-parse-naked-head'.
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(let ((dependencies
(or dependencies

9
lisp/gnus/gnus.el
View file

@ -2388,14 +2388,7 @@ Typical marks are those that make no sense in a standalone back end,
such as a mark that says whether an article is stored in the cache
\(which doesn't make sense in a standalone back end).")
(defvar gnus-headers-retrieved-by nil
"Holds the return value of `gnus-retrieve-headers'.
This is either the symbol `nov' or the symbol `headers'. This
value is checked during the summary creation process, when
building threads. A value of `nov' indicates that header
retrieval is relatively cheap and threading is encouraged to
include more old articles. A value of `headers' indicates that
retrieval is expensive and should be minimized.")
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(defvar gnus-override-method nil)
(defvar gnus-opened-servers nil)

170
lisp/gnus/nnvirtual.el
View file

@ -101,10 +101,15 @@ It is computed from the marks of individual component groups.")
(erase-buffer)
(if (stringp (car articles))
'headers
(let ((carticles (nnvirtual-partition-sequence articles))
(let ((vbuf (nnheader-set-temp-buffer
(gnus-get-buffer-create " *virtual headers*")))
(carticles (nnvirtual-partition-sequence articles))
(sysname (system-name))
cgroup headers all-headers article prefix)
(pcase-dolist (`(,cgroup . ,articles) carticles)
cgroup carticle article result prefix)
(while carticles
(setq cgroup (caar carticles))
(setq articles (cdar carticles))
(pop carticles)
(when (and articles
(gnus-check-server
(gnus-find-method-for-group cgroup) t)
@ -114,37 +119,69 @@ It is computed from the marks of individual component groups.")
;; This is probably evil if people have set
;; gnus-use-cache to nil themselves, but I
;; have no way of finding the true value of it.
(let ((gnus-use-cache t)
(gnus-newsgroup-name cgroup)
(gnus-fetch-old-headers nil))
(setq headers (gnus-fetch-headers articles))))
(erase-buffer)
;; Remove all header article numbers from `articles'.
;; If there's anything left, those are expired or
;; canceled articles, so we update the component group
;; below.
(dolist (h headers)
(setq articles (delq (mail-header-number h) articles)
article (nnvirtual-reverse-map-article
cgroup (mail-header-number h)))
;; Update all the header numbers according to their
;; reverse mapping, and drop any with no such mapping.
(when article
;; Do this first, before we re-set the header's
;; article number.
(nnvirtual-update-xref-header
h cgroup prefix sysname)
(setf (mail-header-number h) article)
(push h all-headers)))
;; Anything left in articles is expired or canceled.
;; Could be smart and not tell it about articles already
;; known?
(when articles
(gnus-group-make-articles-read cgroup articles))))
(let ((gnus-use-cache t))
(setq result (gnus-retrieve-headers
articles cgroup nil))))
(set-buffer nntp-server-buffer)
;; If we got HEAD headers, we convert them into NOV
;; headers. This is slow, inefficient and, come to think
;; of it, downright evil. So sue me. I couldn't be
;; bothered to write a header parse routine that could
;; parse a mixed HEAD/NOV buffer.
(when (eq result 'headers)
(nnvirtual-convert-headers))
(goto-char (point-min))
(while (not (eobp))
(delete-region (point)
(progn
(setq carticle (read nntp-server-buffer))
(point)))
(sort all-headers (lambda (h1 h2)
(< (mail-header-number h1)
(mail-header-number h2)))))))))
;; We remove this article from the articles list, if
;; anything is left in the articles list after going through
;; the entire buffer, then those articles have been
;; expired or canceled, so we appropriately update the
;; component group below. They should be coming up
;; generally in order, so this shouldn't be slow.
(setq articles (delq carticle articles))
(setq article (nnvirtual-reverse-map-article cgroup carticle))
(if (null article)
;; This line has no reverse mapping, that means it
;; was an extra article reference returned by nntp.
(progn
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point))))
;; Otherwise insert the virtual article number,
;; and clean up the xrefs.
(princ article nntp-server-buffer)
(nnvirtual-update-xref-header cgroup carticle
prefix sysname)
(forward-line 1))
)
(set-buffer vbuf)
(goto-char (point-max))
(insert-buffer-substring nntp-server-buffer))
;; Anything left in articles is expired or canceled.
;; Could be smart and not tell it about articles already known?
(when articles
(gnus-group-make-articles-read cgroup articles))
)
;; The headers are ready for reading, so they are inserted into
;; the nntp-server-buffer, which is where Gnus expects to find
;; them.
(prog1
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring vbuf)
;; FIX FIX FIX, we should be able to sort faster than
;; this if needed, since each cgroup is sorted, we just
;; need to merge
(sort-numeric-fields 1 (point-min) (point-max))
'nov)
(kill-buffer vbuf)))))))
(defvoo nnvirtual-last-accessed-component-group nil)
@ -335,18 +372,61 @@ It is computed from the marks of individual component groups.")
;;; Internal functions.
(defun nnvirtual-update-xref-header (header group prefix sysname)
"Add xref to component GROUP to HEADER.
Also add a server PREFIX any existing xref lines."
(let ((bits (split-string (mail-header-xref header)
nil t "[[:blank:]]"))
(art-no (mail-header-number header)))
(setf (mail-header-xref header)
(concat
(format "%s %s:%d " sysname group art-no)
(mapconcat (lambda (bit)
(concat prefix bit))
bits " ")))))
(defun nnvirtual-convert-headers ()
"Convert HEAD headers into NOV headers."
(with-current-buffer nntp-server-buffer
(let* ((dependencies (make-hash-table :test #'equal))
(headers (gnus-get-newsgroup-headers dependencies)))
(erase-buffer)
(mapc 'nnheader-insert-nov headers))))
(defun nnvirtual-update-xref-header (group article prefix sysname)
"Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
;; Move to beginning of Xref field, creating a slot if needed.
(beginning-of-line)
(looking-at
"[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
(goto-char (match-end 0))
(unless (search-forward "\t" (point-at-eol) 'move)
(insert "\t"))
;; Remove any spaces at the beginning of the Xref field.
(while (eq (char-after (1- (point))) ? )
(forward-char -1)
(delete-char 1))
(insert "Xref: " sysname " " group ":")
(princ article (current-buffer))
(insert " ")
;; If there were existing xref lines, clean them up to have the correct
;; component server prefix.
(save-restriction
(narrow-to-region (point)
(or (search-forward "\t" (point-at-eol) t)
(point-at-eol)))
(goto-char (point-min))
(when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
(replace-match "" t t))
(goto-char (point-min))
(when (re-search-forward
(concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
nil t)
(replace-match "" t t))
(unless (eobp)
(insert " ")
(when (not (string= "" prefix))
(while (re-search-forward "[^ ]+:[0-9]+" nil t)
(save-excursion
(goto-char (match-beginning 0))
(insert prefix))))))
;; Ensure a trailing \t.
(end-of-line)
(or (eq (char-after (1- (point))) ?\t)
(insert ?\t)))
(defun nnvirtual-possibly-change-server (server)
(or (not server)

15
lisp/image/gravatar.el
View file

@ -160,16 +160,19 @@ to track whether you're reading a specific mail."
(cond
((and
result ;there is a result
(let* ((data (mapcar (lambda (record)
(let* ((answers (dns-get 'answers result))
(data (mapcar (lambda (record)
(dns-get 'data (cdr record)))
(dns-get 'answers result)))
;; We may get junk data back (or CNAME;
;; ignore).
(and (eq (dns-get 'type answers) 'SRV)
answers)))
(priorities (mapcar (lambda (r)
(dns-get 'priority r))
data))
(max-priority (if priorities
(apply #'max priorities)
0))
(sum 0) top)
(max-priority (apply #'max 0 priorities))
(sum 0)
top)
;; Attempt to find all records with the same maximal
;; priority, and calculate the sum of their weights.
(dolist (ent data)

5
lisp/international/isearch-x.el
View file

@ -1,4 +1,4 @@
;;; isearch-x.el --- extended isearch handling commands
;;; isearch-x.el --- extended isearch handling commands -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@ -67,7 +67,7 @@
;; Exit from recursive edit safely. Set in `after-change-functions'
;; by isearch-with-keyboard-coding.
(defun isearch-exit-recursive-edit (start end length)
(defun isearch-exit-recursive-edit (_start _end _length)
(interactive)
(throw 'exit nil))
@ -102,6 +102,7 @@
;;;###autoload
(defun isearch-process-search-multibyte-characters (last-char &optional count)
(defvar junk-hist)
(if (eq this-command 'isearch-printing-char)
(let ((overriding-terminal-local-map nil)
(prompt (isearch-message-prefix))

24
lisp/international/iso-cvt.el
View file

@ -1,4 +1,4 @@
;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: utf-8 -*-
;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- lexical-binding: t; -*-
;; This file was formerly called gm-lingo.el.
;; Copyright (C) 1993-1998, 2000-2021 Free Software Foundation, Inc.
@ -79,7 +79,7 @@
(point-max))))
;;;###autoload
(defun iso-spanish (from to &optional buffer)
(defun iso-spanish (from to &optional _buffer)
"Translate net conventions for Spanish to ISO 8859-1.
Translate the region between FROM and TO using the table
`iso-spanish-trans-tab'.
@ -121,7 +121,7 @@ and may translate too little.")
"Currently active translation table for German.")
;;;###autoload
(defun iso-german (from to &optional buffer)
(defun iso-german (from to &optional _buffer)
"Translate net conventions for German to ISO 8859-1.
Translate the region FROM and TO using the table
`iso-german-trans-tab'.
@ -194,7 +194,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
"Translation table for translating ISO 8859-1 characters to TeX sequences.")
;;;###autoload
(defun iso-iso2tex (from to &optional buffer)
(defun iso-iso2tex (from to &optional _buffer)
"Translate ISO 8859-1 characters to TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2tex-trans-tab'.
@ -387,7 +387,7 @@ This table is not exhaustive (and due to TeX's power can never be).
It only contains commonly used sequences.")
;;;###autoload
(defun iso-tex2iso (from to &optional buffer)
(defun iso-tex2iso (from to &optional _buffer)
"Translate TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-tex2iso-trans-tab'.
@ -646,7 +646,7 @@ It only contains commonly used sequences.")
"Translation table for translating ISO 8859-1 characters to German TeX.")
;;;###autoload
(defun iso-gtex2iso (from to &optional buffer)
(defun iso-gtex2iso (from to &optional _buffer)
"Translate German TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-gtex2iso-trans-tab'.
@ -655,7 +655,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-gtex2iso-trans-tab))
;;;###autoload
(defun iso-iso2gtex (from to &optional buffer)
(defun iso-iso2gtex (from to &optional _buffer)
"Translate ISO 8859-1 characters to German TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2gtex-trans-tab'.
@ -674,7 +674,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
"Translation table for translating ISO 8859-1 characters to Duden sequences.")
;;;###autoload
(defun iso-iso2duden (from to &optional buffer)
(defun iso-iso2duden (from to &optional _buffer)
"Translate ISO 8859-1 characters to Duden sequences.
Translate the region between FROM and TO using the table
`iso-iso2duden-trans-tab'.
@ -812,7 +812,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
("&yuml;" "ÿ")))
;;;###autoload
(defun iso-iso2sgml (from to &optional buffer)
(defun iso-iso2sgml (from to &optional _buffer)
"Translate ISO 8859-1 characters in the region to SGML entities.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist')."
@ -820,7 +820,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-iso2sgml-trans-tab))
;;;###autoload
(defun iso-sgml2iso (from to &optional buffer)
(defun iso-sgml2iso (from to &optional _buffer)
"Translate SGML entities in the region to ISO 8859-1 characters.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist')."
@ -828,13 +828,13 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-sgml2iso-trans-tab))
;;;###autoload
(defun iso-cvt-read-only (&rest ignore)
(defun iso-cvt-read-only (&rest _ignore)
"Warn that format is read-only."
(interactive)
(error "This format is read-only; specify another format for writing"))
;;;###autoload
(defun iso-cvt-write-only (&rest ignore)
(defun iso-cvt-write-only (&rest _ignore)
"Warn that format is write-only."
(interactive)
(error "This format is write-only"))

11
lisp/international/ja-dic-cnv.el
View file

@ -1,4 +1,4 @@
;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -96,7 +96,7 @@
("もく" "目")
("ゆき" "行")))
(defun skkdic-convert-postfix (skkbuf buf)
(defun skkdic-convert-postfix (_skkbuf buf)
(byte-compile-info "Processing POSTFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
@ -150,7 +150,7 @@
(defconst skkdic-prefix-list '(skkdic-prefix-list))
(defun skkdic-convert-prefix (skkbuf buf)
(defun skkdic-convert-prefix (_skkbuf buf)
(byte-compile-info "Processing PREFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
@ -209,7 +209,7 @@
(substring str from idx)
skkdic-word-list)))
(if (or (and (consp kana2-list)
(let ((kana-len (length kana))
(let (;; (kana-len (length kana))
kana2)
(catch 'skkdic-tag
(while kana2-list
@ -342,7 +342,8 @@ The name of generated file is specified by the variable `ja-dic-filename'."
(with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
(insert ";;; ja-dic.el --- dictionary for Japanese input method\n"
(insert ";;; ja-dic.el --- dictionary for Japanese input method"
" -*- lexical-binding:t -*-\n"
";;\tGenerated by the command `skkdic-convert'\n"
";;\tOriginal SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)

2
lisp/international/ja-dic-utl.el
View file

@ -1,4 +1,4 @@
;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L)
;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L) -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011

2
lisp/international/kinsoku.el
View file

@ -1,4 +1,4 @@
;;; kinsoku.el --- `Kinsoku' processing funcs
;;; kinsoku.el --- `Kinsoku' processing funcs -*- 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/international/kkc.el
View file

@ -1,4 +1,4 @@
;;; kkc.el --- Kana Kanji converter
;;; kkc.el --- Kana Kanji converter -*- 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,

4
lisp/international/latexenc.el
View file

@ -1,4 +1,4 @@
;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: utf-8 -*-
;;; latexenc.el --- guess correct coding system in LaTeX files -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@ -109,6 +109,8 @@ Return nil if no matching input encoding can be found."
(defvar latexenc-dont-use-tex-guess-main-file-flag nil
"Non-nil means don't use tex-guessmain-file to find the coding system.")
(defvar tex-start-of-header)
;;;###autoload
(defun latexenc-find-file-coding-system (arg-list)
"Determine the coding system of a LaTeX file if it uses \"inputenc.sty\".

19
lisp/international/latin1-disp.el
View file

@ -1,4 +1,4 @@
;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: utf-8;-*-
;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -86,8 +86,8 @@ use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
:initialize 'custom-initialize-default
:set (lambda (symbol value)
:initialize #'custom-initialize-default
:set (lambda (_symbol value)
(if value
(apply #'latin1-display latin1-display-sets)
(latin1-display))))
@ -186,7 +186,7 @@ character set."
'arabic-iso8859-6
(car (remq 'ascii (get-language-info language
'charset))))))
(map-charset-chars #'(lambda (range arg)
(map-charset-chars #'(lambda (range _arg)
(standard-display-default (car range) (cdr range)))
charset))
(sit-for 0))
@ -201,11 +201,10 @@ character set: `latin-2', `hebrew' etc."
(char (and info (decode-char (car (remq 'ascii info)) ?\ ))))
(and char (char-displayable-p char))))
(defun latin1-display-setup (set &optional force)
(defun latin1-display-setup (set &optional _force)
"Set up Latin-1 display for characters in the given SET.
SET must be a member of `latin1-display-sets'. Normally, check
whether a font for SET is available and don't set the display if it
is. If FORCE is non-nil, set up the display regardless."
whether a font for SET is available and don't set the display if it is."
(cond
((eq set 'latin-2)
(latin1-display-identities set)
@ -735,7 +734,7 @@ is. If FORCE is non-nil, set up the display regardless."
(sit-for 0))
;;;###autoload
(defcustom latin1-display-ucs-per-lynx nil
(defcustom latin1-display-ucs-per-lynx nil ;FIXME: Isn't this a minor mode?
"Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser. The display isn't
changed if the display can render Unicode characters.
@ -745,8 +744,8 @@ use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
:initialize 'custom-initialize-default
:set (lambda (symbol value)
:initialize #'custom-initialize-default
:set (lambda (_symbol value)
(if value
(latin1-display-ucs-per-lynx 1)
(latin1-display-ucs-per-lynx -1))))

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

@ -1279,7 +1279,7 @@ in the format of Lisp expression for registering each input method.
Emacs loads this file at startup time.")
(defconst leim-list-header (format-message
";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
";;; %s --- list of LEIM (Library of Emacs Input Method) -*- lexical-binding:t -*-
;;
;; This file is automatically generated.
;;

27
lisp/international/mule-diag.el
View file

@ -1,4 +1,4 @@
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule) -*- 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,
@ -86,8 +86,7 @@ but still shows the full information."
(indent-to 48)
(insert "| +--CHARS\n")
(let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
("D CH FINAL-BYTE" . iso-spec)))
pos)
("D CH FINAL-BYTE" . iso-spec))))
(while columns
(if (stringp (car columns))
(insert (car columns))
@ -117,8 +116,8 @@ but still shows the full information."
SORT-KEY should be `name' or `iso-spec' (default `name')."
(or sort-key
(setq sort-key 'name))
(let ((tail charset-list)
charset-info-list supplementary-list charset sort-func)
(let (;; (tail charset-list)
charset-info-list supplementary-list sort-func)
(dolist (charset charset-list)
;; Generate a list that contains all information to display.
(let ((elt (list charset
@ -273,9 +272,9 @@ meanings of these arguments."
(setq tab-width 4)
(set-buffer-multibyte t)
(let ((dim (charset-dimension charset))
(chars (charset-chars charset))
;; (plane (charset-iso-graphic-plane charset))
(plane 1)
;; (chars (charset-chars charset))
;; (plane (charset-iso-graphic-plane charset))
;; (plane 1)
(range (plist-get (charset-plist charset) :code-space))
min max min2 max2)
(if (> dim 2)
@ -415,7 +414,8 @@ or provided just for backward compatibility." nil)))
(print-coding-system-briefly coding-system 'doc-string)
(let ((type (coding-system-type coding-system))
;; Fixme: use this
(extra-spec (coding-system-plist coding-system)))
;; (extra-spec (coding-system-plist coding-system))
)
(princ "Type: ")
(princ type)
(cond ((eq type 'undecided)
@ -858,6 +858,8 @@ The IGNORED argument is ignored."
(with-output-to-temp-buffer "*Help*"
(describe-font-internal font-info)))))
(defvar mule--print-opened)
(defun print-fontset-element (val)
;; VAL has this format:
;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
@ -915,7 +917,7 @@ The IGNORED argument is ignored."
(or adstyle "*") registry)))))
;; Insert opened font names (if any).
(if (and (boundp 'print-opened) (symbol-value 'print-opened))
(if (bound-and-true-p mule--print-opened)
(dolist (opened (cdr elt))
(insert "\n\t[" opened "]")))))))
@ -943,8 +945,9 @@ the current buffer."
" and [" (propertize "OPENED" 'face 'underline) "])")
(let* ((info (fontset-info fontset))
(default-info (char-table-extra-slot info 0))
(mule--print-opened print-opened)
start1 end1 start2 end2)
(describe-vector info 'print-fontset-element)
(describe-vector info #'print-fontset-element)
(when (char-table-range info nil)
;; The default of FONTSET is described.
(setq start1 (re-search-backward "^default"))
@ -956,7 +959,7 @@ the current buffer."
(when default-info
(insert "\n ---<fallback to the default fontset>---")
(put-text-property (line-beginning-position) (point) 'face 'highlight)
(describe-vector default-info 'print-fontset-element)
(describe-vector default-info #'print-fontset-element)
(when (char-table-range default-info nil)
;; The default of the default fontset is described.
(setq end2 (re-search-backward "^default"))

2
lisp/international/ogonek.el
View file

@ -1,4 +1,4 @@
;;; ogonek.el --- change the encoding of Polish diacritics
;;; ogonek.el --- change the encoding of Polish diacritics -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.

18
lisp/international/quail.el
View file

@ -1,4 +1,4 @@
;;; quail.el --- provides simple input method for multilingual text
;;; quail.el --- provides simple input method for multilingual text -*- 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,
@ -1046,7 +1046,7 @@ the following annotation types are supported.
(quail-install-decode-map ',decode-map))))))
;;;###autoload
(defun quail-install-map (map &optional name)
(defun quail-install-map (map &optional _name)
"Install the Quail map MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@ -1060,7 +1060,7 @@ The installed map can be referred by the function `quail-map'."
(setcar (cdr (cdr quail-current-package)) map))
;;;###autoload
(defun quail-install-decode-map (decode-map &optional name)
(defun quail-install-decode-map (decode-map &optional _name)
"Install the Quail decode map DECODE-MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@ -1390,7 +1390,7 @@ Return the input string."
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-translation-keymap))
(generated-events nil) ;FIXME: What is this?
;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command inhibit-record)
@ -1455,7 +1455,7 @@ Return the input string."
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-conversion-keymap))
(generated-events nil) ;FIXME: What is this?
;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command inhibit-record)
@ -2452,7 +2452,7 @@ should be made by `quail-build-decode-map' (which see)."
(insert-char ?- single-trans-width)
(forward-line 1)
;; Insert the key-tran pairs.
(dotimes (row rows)
(dotimes (_ rows)
(let ((elt (pop single-list)))
(when elt
(move-to-column col)
@ -2625,12 +2625,14 @@ KEY BINDINGS FOR CONVERSION
(run-hooks 'temp-buffer-show-hook)))))
(defun quail-help-insert-keymap-description (keymap &optional header)
(defvar the-keymap)
(let ((pos1 (point))
(the-keymap keymap)
pos2)
(if header
(insert header))
(save-excursion
(insert (substitute-command-keys "\\{keymap}")))
(insert (substitute-command-keys "\\{the-keymap}")))
;; Skip headers "key bindings", etc.
(forward-line 3)
(setq pos2 (point))
@ -3011,7 +3013,7 @@ of each directory."
;; At first, clean up the file.
(with-current-buffer list-buf
(goto-char 1)
(goto-char (point-min))
;; Insert the correct header.
(if (looking-at (regexp-quote leim-list-header))

2
lisp/international/robin.el
View file

@ -1,4 +1,4 @@
;;; robin.el --- yet another input method (smaller than quail)
;;; robin.el --- yet another input method (smaller than quail) -*- lexical-binding: t; -*-
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)

252
lisp/international/titdic-cnv.el
View file

@ -1,4 +1,4 @@
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*-
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding: utf-8-emacs; 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,
@ -83,9 +83,9 @@
;; how to select a translation from a list of candidates.
(defvar quail-cxterm-package-ext-info
'(("chinese-4corner" "$(0(?-F(B")
("chinese-array30" "$(0#R#O(B")
("chinese-ccdospy" "$AKuF4(B"
'(("chinese-4corner" "四角")
("chinese-array30" "３０")
("chinese-ccdospy" "缩拼"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard Roman transliteration method for Chinese.
@ -94,10 +94,10 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you type a single key for these Pinyin spelling.
Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B)
Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü)
keyseq: a f g h i j k l s u y v
For example:
Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B $ASq(B $AH+(B
Chinese: 啊 果 中 文 光 玉 全
Pinyin: a guo zhong wen guang yu quan
Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6
@ -106,14 +106,14 @@ For example:
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
("chinese-ecdict" "$(05CKH(B"
("chinese-ecdict" "英漢"
"In this input method, you enter a Chinese (Big5) character or word
by typing the corresponding English word. For example, if you type
\"computer\", \"$(0IZH+(B\" is input.
\"computer\", \"電腦\" is input.
\\<quail-translation-docstring>")
("chinese-etzy" "$(06/0D(B"
("chinese-etzy" "倚注"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@ -122,20 +122,20 @@ compose one Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
SPC, 1, 2, 3, or 4 specifying a tone (SPC:$(0?v(N(B, 1:$(0M=Vy(B, 2:$(0Dm(N(B, 3: $(0&9Vy(B,
4:$(0(+Vy(B).
SPC, 1, 2, 3, or 4 specifying a tone (SPC:陰平, 1:輕聲, 2:陽平, 3: 上聲,
4:去聲).
\\<quail-translation-docstring>")
("chinese-punct-b5" "$(0O:(BB"
("chinese-punct-b5" "標B"
"Input method for Chinese punctuation and symbols of Big5
\(`chinese-big5-1' and `chinese-big5-2').")
("chinese-punct" "$A1j(BG"
("chinese-punct" "标G"
"Input method for Chinese punctuation and symbols of GB2312
\(`chinese-gb2312').")
("chinese-py-b5" "$(03<(BB"
("chinese-py-b5" "拼B"
"Pinyin base input method for Chinese Big5 characters
\(`chinese-big5-1', `chinese-big5-2').
@ -153,28 +153,28 @@ method `chinese-qj-b5'.
The input method `chinese-py' and `chinese-tonepy' are also Pinyin
based, but for the character set GB2312 (`chinese-gb2312').")
("chinese-qj-b5" "$(0)A(BB")
("chinese-qj-b5" "全B")
("chinese-qj" "$AH+(BG")
("chinese-qj" "全G")
("chinese-sw" "$AJWN2(B"
("chinese-sw" "首尾"
"Radical base input method for Chinese charset GB2312 (`chinese-gb2312').
In this input method, you enter a Chinese character by typing two
keys. The first key corresponds to the first ($AJW(B) radical, the second
key corresponds to the last ($AN2(B) radical. The correspondence of keys
keys. The first key corresponds to the first (首) radical, the second
key corresponds to the last (尾) radical. The correspondence of keys
and radicals is as below:
first radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
$APD(B $AZ"(B $AJ,(B $AX<(B $A;p(B $A?Z(B $A^P(B $Ac_(B $AZ%(B $A\3(B $AXi(B $AD>(B $Alj(B $Ab;(B $ATB(B $Afy(B $AJ/(B $AMu(B $A0K(B $AX/(B $AHU(B $AeA(B $Aak(B $AVq(B $AR;(B $AHK(B
心 冖 尸 丶 火 口 扌 氵 讠 艹 亻 木 礻 饣 月 纟 石 王 八 丿 日 辶 犭 竹 一 人
last radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
$ASV(B $AI=(B $AMA(B $A56(B $AZb(B $A?Z(B $ARB(B $Aqb(B $A4s(B $A6!(B $A[L(B $Ala(B $AJ.(B $A4u(B $AXg(B $ACE(B $A=q(B $AX-(B $AE.(B $ARR(B $A`m(B $AP!(B $A3'(B $A3f(B $A_.(B $A27(B
又 山 土 刀 阝 口 衣 疋 大 丁 厶 灬 十 歹 冂 门 今 丨 女 乙 囗 小 厂 虫 弋 卜
\\<quail-translation-docstring>")
("chinese-tonepy" "$A5wF4(B"
("chinese-tonepy" "调拼"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard roman transliteration method for Chinese.
@ -183,18 +183,18 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you must type 1..5 after each Pinyin spelling to
specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B, 5:$AGaIy(B).
specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声).
\\<quail-translation-docstring>
For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is
For instance, to input 你, you type \"n i 3 3\", the first \"n i\" is
a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects
the third character from the candidate list.
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
("chinese-zozy" "$(0I\0D(B"
("chinese-zozy" "零注"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@ -203,8 +203,8 @@ compose a Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy(B, 4:$(0(+Vy(B,
7:$(0M=Vy(B).
SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲,
7:輕聲).
\\<quail-translation-docstring>")))
@ -269,6 +269,8 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
(tit-moveleft ",<")
(tit-keyprompt nil))
(princ (format ";;; %s -*- lexical-binding:t -*-\n"
(file-name-nondirectory filename)))
(princ ";; Quail package `")
(princ package)
(princ "\n")
@ -354,7 +356,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
(princ (nth 2 (assoc tit-encode tit-encode-list)))
(princ "\" \"")
(princ (or title
(if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
(if (string-match "[:∷：【]+\\([^:∷：】]+\\)" tit-prompt)
(substring tit-prompt (match-beginning 1) (match-end 1))
tit-prompt)))
(princ "\"\n"))
@ -375,7 +377,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
;; Arg DOCSTRING
(let ((doc (concat tit-prompt "\n"))
(comments (if tit-comments
(mapconcat 'identity (nreverse tit-comments) "\n")))
(mapconcat #'identity (nreverse tit-comments) "\n")))
(doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info))))
(if comments
(setq doc (concat doc "\n" comments "\n")))
@ -580,7 +582,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; )
(defvar quail-misc-package-ext-info
'(("chinese-b5-tsangchi" "$(06A(BB"
'(("chinese-b5-tsangchi" "倉B"
"cangjie-table.b5" big5 "tsang-b5.el"
tsang-b5-converter
"\
@ -590,7 +592,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
("chinese-b5-quick" "$(0X|(BB"
("chinese-b5-quick" "簡B"
"cangjie-table.b5" big5 "quick-b5.el"
quick-b5-converter
"\
@ -600,7 +602,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
("chinese-cns-tsangchi" "$(GT?(BC"
("chinese-cns-tsangchi" "倉C"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
tsang-cns-converter
"\
@ -610,7 +612,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
("chinese-cns-quick" "$(Gv|(BC"
("chinese-cns-quick" "簡C"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
quick-cns-converter
"\
@ -620,7 +622,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
("chinese-py" "$AF4(BG"
("chinese-py" "拼G"
"pinyin.map" cn-gb-2312 "PY.el"
py-converter
"\
@ -648,7 +650,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
("chinese-ziranma" "$AWTH;(B"
("chinese-ziranma" "自然"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
ziranma-converter
"\
@ -676,7 +678,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
("chinese-ctlau" "$AAuTA(B"
("chinese-ctlau" "刘粤"
"CTLau.html" cn-gb-2312 "CTLau.el"
ctlau-gb-converter
"\
@ -701,7 +703,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # You should have received a copy of the GNU General Public License
;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
("chinese-ctlaub" "$(0N,Gn(B"
("chinese-ctlaub" "劉粵"
"CTLau-b5.html" big5 "CTLau-b5.el"
ctlau-b5-converter
"\
@ -731,41 +733,27 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; dictionary in the buffer DICBUF. The input method name of the
;; Quail package is NAME, and the title string is TITLE.
;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise
;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is non-nil, the
;; TSANG-P is non-nil, generate 倉頡 input method. Otherwise
;; generate 簡易 (simple version of 倉頡). If BIG5-P is non-nil, the
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
(defun tsang-quick-converter (dicbuf tsang-p big5-p)
(let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B")
(if big5-p "$(0X|/y(B" "$(Gv|Mx(B")))
(let ((fulltitle (if tsang-p "倉頡" "簡易"))
dic)
(goto-char (point-max))
(if big5-p
(insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5
(insert (format "\"中文輸入【%s】%s
$(0KHM$(B%s$(0TT&,WoOu(B
漢語%s輸入鍵盤
[Q $(0'D(B] [W $(0(q(B] [E $(0'V(B] [R $(0&H(B] [T $(0'>(B] [Y $(0&4(B] [U $(0&U(B] [I $(0'B(B] [O $(0&*(B] [P $(0'A(B]
[Q 手] [W 田] [E 水] [R 口] [T 廿] [Y 卜] [U 山] [I 戈] [O 人] [P 心]
[A $(0'K(B] [S $(0&T(B] [D $(0'N(B] [F $(0'W(B] [G $(0&I(B] [H $(0*M(B] [J $(0&3(B] [L $(0&d(B]
[A 日] [S 尸] [D 木] [F 火] [G 土] [H 竹] [J 十] [L 中]
[Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N $(0&_(B] [M $(0&"(B]
[Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle))
(insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS
$(GiGk#(B%s$(GrSD+uomu(B
[Q $(GEC(B] [W $(GFp(B] [E $(GEU(B] [R $(GDG(B] [T $(GE=(B] [Y $(GD3(B] [U $(GDT(B] [I $(GEA(B] [O $(GD)(B] [P $(GE@(B]
[A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H $(GHL(B] [J $(GD2(B] [L $(GDc(B]
[Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N $(GD^(B] [M $(GD!(B]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle)))
fulltitle (if big5-p "BIG5" "CNS") fulltitle))
(insert " '((\".\" . quail-next-translation-block)
(\",\" . quail-prev-translation-block))
nil nil)\n\n")
@ -798,35 +786,35 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
(dolist (elt dic)
(insert (format "(%S\t%S)\n" (car elt) (cdr elt))))
(let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B")
(":" "$(0!(!+!3!%!$!&!0!1(B" "$(G!(!+!3!%!$!&!0!1(B")
("'" "$(0!e!d(B" "$(G!e!d(B")
("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B")
("\\" "$(0"`"b#M(B" "$(G"`"b#M(B")
("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B")
("/" "$(0"_"a#L(B" "$(G"_"a#L(B")
("?" "$(0!)!4(B" "$(G!)!4(B")
("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B")
(">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B")
("[" "$(0!F!J!b!H!L!V!Z!X!\(B" "$(G!F!J!b!H!L!V!Z!X!\(B")
("]" "$(0!G!K!c!I!M!W![!Y!](B" "$(G!G!K!c!I!M!W![!Y!](B")
("{" "$(0!B!`!D(B " "$(G!B!`!D(B ")
("}" "$(0!C!a!E(B" "$(G!C!a!E(B")
("`" "$(0!j!k(B" "$(G!j!k(B")
("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B")
("!" "$(0!*!5(B" "$(G!*!5(B")
("@" "$(0"i"n(B" "$(G"i"n(B")
("#" "$(0!l"-(B" "$(G!l"-(B")
("$" "$(0"c"l(B" "$(G"c"l(B")
("%" "$(0"h"m(B" "$(G"h"m(B")
("&" "$(0!m".(B" "$(G!m".(B")
("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B")
("(" "$(0!>!^!@(B" "$(G!>!^!@(B")
(")" "$(0!?!_!A(B" "$(G!?!_!A(B")
("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B")
("_" "$(0"%"&(B" "$(G"%"&(B")
("=" "$(0"8"C(B" "$(G"8"C(B")
("+" "$(0"0"?(B" "$(G"0"?(B"))))
(let ((punctuation '((";" "；﹔，、﹐﹑" "；﹔，、﹐﹑")
(":" "：︰﹕．。‧﹒·" "：︰﹕．。・﹒·")
("'" "’‘" "’‘")
("\"" "”“〝〞〃" "”“〝〞〃")
("\\" "＼﹨╲" "＼﹨╲")
("|" "｜︱︳∣" "︱︲<EFBFBD><EFBFBD><EFBFBD><EFBFBD>｜")
("/" "／∕╱" "／∕╱")
("?" "？﹖" "？﹖")
("<" "〈＜﹤︿∠" "〈＜﹤︿∠")
(">" "〉＞﹥﹀" "〉＞﹦﹀")
("[" "〔【﹝︹︻「『﹁﹃" "〔【﹝︹︻「『﹁﹃")
("]" "〕】﹞︺︼」』﹂﹄" "〕】﹞︺︼」』﹂﹄")
("{" "｛﹛︷ " "｛﹛︷ ")
("}" "｝﹜︸" "｝﹜︸")
("`" "‵′" "′‵")
("~" "～﹋﹌︴﹏" "∼﹋﹌<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>")
("!" "！﹗" "！﹗")
("@" "＠﹫" "＠﹫")
("#" "＃﹟" "＃﹟")
("$" "＄﹩" "＄﹩")
("%" "％﹪" "％﹪")
("&" "＆﹠" "＆﹠")
("*" "＊﹡※☆★" "＊﹡※☆★")
("(" "（﹙︵" "（﹙︵")
(")" "）﹚︶" "）﹚︶")
("-" "–—¯￣－﹣" "—–‾<EFBFBD><EFBFBD><EFBFBD><EFBFBD>－﹣")
("_" "＿ˍ" "＿<EFBFBD><EFBFBD><EFBFBD><EFBFBD>")
("=" "＝﹦" "＝﹥")
("+" "＋﹢" "＋﹢"))))
(dolist (elt punctuation)
(insert (format "(%S %S)\n" (concat "z" (car elt))
(if big5-p (nth 1 elt) (nth 2 elt))))))
@ -850,11 +838,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(defun py-converter (dicbuf)
(goto-char (point-max))
(insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B
(insert (format "%S\n" "汉字输入∷拼音∷
$AF4Rt7=08(B
拼音方案
$AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B
小写英文字母代表「拼音」符号， \"u(yu) 则用 u: 表示∶
Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
@ -868,14 +856,14 @@ character. The sequence is made by the combination of the initials
iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun
(Note: In the correct Pinyin writing, the sequence \"yu\" in the last
four finals should be written by the character u-umlaut `$A(9(B'.)
four finals should be written by the character u-umlaut `ü'.)
With this input method, you enter a Chinese character by first
entering its pinyin spelling.
\\<quail-translation-docstring>
For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\"
For instance, to input 你, you type \"n i C-n 3\". The first \"n i\"
is a Pinyin, \"C-n\" selects the next group of candidates (each group
contains at most 10 characters), \"3\" select the third character in
that group.
@ -953,27 +941,27 @@ method `chinese-tonepy' with which you must specify tones by digits
(= (length (aref trans i)) 1))
(setq i (1+ i)))
(if (= i len)
(setq trans (mapconcat 'identity trans "")))))
(setq trans (mapconcat #'identity trans "")))))
(setq dic (cons (cons key trans) dic)))
table)))
(setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
(goto-char (point-max))
(insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B
(insert (format "%S\n" "汉字输入∷【自然】∷
$A<|EL6TUU1m(B:
$A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B
$A)'#Q(B $A)'#W(B $A)'#E(B $A)'#R(B $A)'#T(B $A)'#Y(B $A)'#U(Bsh$A)'#I(Bch$A)'#O(B $A)'#P(B $A)'(B
$A)'(B iu$A)'(B ua$A)'(B e$A)'(B uan$A)'(B ue$A)'(B uai$A)'(B u$A)'(B i$A)'(B o$A)'(B un$A)'(B
$A)'(B $A)'(B ia$A)'(B $A)'(B van$A)'(B ve$A)'(B ing$A)'(B $A)'(B $A)'(B uo$A)'(B vn$A)'(B
$A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B
$A)'#A(B $A)'#S(B $A)'#D(B $A)'#F(B $A)'#G(B $A)'#H(B $A)'#J(B $A)'#K(B $A)'#L(B $A)'(B
$A)'(B a$A)'(Biong$A)'(Buang$A)'(B en$A)'(B eng$A)'(B ang$A)'(B an$A)'(B ao$A)'(B ai$A)'(B
$A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
$A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B
$A)'#Z(B $A)'#X(B $A)'#C(B $A)'#V(Bzh$A)'#B(B $A)'#N(B $A)'#M(B $A)'#,(B $A)'#.(B $A)'(B $A#/(B $A)'(B
$A)'(B ei$A)'(B ie$A)'(B iao$A)'(B ui$A)'(B ou$A)'(B in$A)'(B ian$A)'G0R3)':sR3)'7{:E)'(B
$A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
$A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B
键盘对照表:
┏━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┓
┃Ｑ ┃Ｗ ┃Ｅ ┃Ｒ ┃Ｔ ┃Ｙ ┃Ｕsh┃Ｉch┃Ｏ ┃Ｐ ┃
┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃
┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃
┗┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┛
┃Ａ ┃Ｓ ┃Ｄ ┃Ｆ ┃Ｇ ┃Ｈ ┃Ｊ ┃Ｋ ┃Ｌ ┃
┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃
┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃
┗┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━━┓
┃Ｚ ┃Ｘ ┃Ｃ ┃Ｖzh┃Ｂ ┃Ｎ ┃Ｍ ┃， ┃． ┃ ／ ┃
┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃前页┃后页┃符号┃
┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃
┗━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┛
Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312').
@ -985,34 +973,34 @@ method `chinese-py'.
Unlike the standard spelling of Pinyin, in this input method all
initials and finals are assigned to single keys (see the above table).
For instance, the initial \"ch\" is assigned to the key `i', the final
\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are
\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are
assigned to the keys `q', `w', `e', `r', `t' respectively.
\\<quail-translation-docstring>
To input one-letter words, you type 4 keys, the first two for the
Pinyin of the letter, next one for tone, and the last one is always a
quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these
quote ('). For instance, \"vsq'\" input 中. Exceptions are these
letters. You can input them just by typing a single key.
Character: $A04(B $A2;(B $A4N(B $A5D(B $A6~(B $A7"(B $A8v(B $A:M(B $A3v(B $A<0(B $A?I(B $AAK(B $AC;(B
Character: 按 不 次 的 二 发 个 和 出 及 可 了 没
Key: a b c d e f g h i j k l m
Character: $ADc(B $AE7(B $AF,(B $AF_(B $AHK(B $AH}(B $AK{(B $AJG(B $AWE(B $ANR(B $AP!(B $AR;(B $ATZ(B
Character: 你 欧 片 七 人 三 他 是 着 我 小 一 在
Key: n o p q r s t u v w x y z
To input two-letter words, you have two ways. One way is to type 4
keys, two for the first Pinyin, two for the second Pinyin. For
instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2
instance, \"vsgo\" inputs 中国. Another way is to type 3 keys: 2
initials of two letters, and quote ('). For instance, \"vg'\" also
inputs $AVP9z(B.
inputs 中国.
To input three-letter words, you type 4 keys: initials of three
letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B
$A>)Q<(B (the last `2' is to select one of the candidates).
letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北
京鸭 (the last `2' is to select one of the candidates).
To input words of more than three letters, you type 4 keys, initials
of the first three letters and the last letter. For instance,
\"bjdt\" inputs $A11>)5gJSL((B.
\"bjdt\" inputs 北京电视台.
To input symbols and punctuation, type `/' followed by one of `a' to
`z', then select one of the candidates."))
@ -1059,7 +1047,7 @@ To input symbols and punctuation, type `/' followed by one of `a' to
;; which the file is converted have no Big5 equivalent. Go
;; through and delete them.
(goto-char pos)
(while (search-forward "$(0!{(B" nil t)
(while (search-forward "□" nil t)
(delete-char -1))
;; Uppercase keys in dictionary need to be downcased. Backslashes
;; at the beginning of keys need to be turned into double
@ -1083,31 +1071,31 @@ To input symbols and punctuation, type `/' followed by one of `a' to
(defun ctlau-gb-converter (dicbuf)
(ctlau-converter dicbuf
"$A::WVJdHk!KAuN}OiJ=TARt!K(B
"汉字输入∷刘锡祥式粤音∷
$AAuN}OiJ=TASoW"Rt7=08(B
刘锡祥式粤语注音方案
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
This file was prepared by Fung Fung Lee ($A@n7c7e(B).
This file was prepared by Fung Fung Lee (李枫峰).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent GB characters are accessed by typing \\, followed by
the Cantonese romanization of the respective radical ($A2?JW(B)."))
the Cantonese romanization of the respective radical (部首)."))
(defun ctlau-b5-converter (dicbuf)
(ctlau-converter dicbuf
"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B
"漢字輸入：劉錫祥式粵音：
$(0N,Tg>A*#GnM$0D5x'J7{(B
劉錫祥式粵語注音方案
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
This file was prepared by Fung Fung Lee ($(0,XFS76(B).
This file was prepared by Fung Fung Lee (李楓峰).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent characters are accessed by typing \\, followed by
the Cantonese romanization of the respective radical ($(0?f5}(B)."))
the Cantonese romanization of the respective radical (部首)."))
(declare-function dos-8+3-filename "dos-fns.el" (filename))
@ -1147,6 +1135,8 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
(insert (format ";;; %s -*- lexical-binding:t -*-\n"
(file-name-nondirectory quailfile)))
(insert (format-message ";; Quail package `%s'\n" name))
(insert (format-message
";; Generated by the command `miscdic-convert'\n"))
@ -1212,8 +1202,10 @@ The library is named pinyin.el, and contains the constant
(dst-file (cadr command-line-args-left))
(coding-system-for-write 'utf-8-unix))
(with-temp-file dst-file
(insert ";; This file is automatically generated from pinyin.map,\
by the\n;; function pinyin-convert.\n\n")
(insert ";;; " (file-name-nondirectory dst-file)
" -*- lexical-binding:t -*-
;; This file is automatically generated from pinyin.map, by the
;; function pinyin-convert.\n\n")
(insert "(defconst pinyin-character-map\n'(")
(let ((pos (point)))
(insert-file-contents src-file)

2
lisp/international/utf-7.el
View file

@ -1,4 +1,4 @@
;;; utf-7.el --- utf-7 coding system
;;; utf-7.el --- utf-7 coding system -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.

3
lisp/isearch.el
View file

@ -513,7 +513,7 @@ This is like `describe-bindings', but displays only Isearch keys."
(call-interactively command)))
(defvar isearch-menu-bar-commands
'(isearch-tmm-menubar menu-bar-open mouse-minor-mode-menu)
'(isearch-tmm-menubar tmm-menubar menu-bar-open mouse-minor-mode-menu)
"List of commands that can open a menu during Isearch.")
(defvar isearch-menu-bar-yank-map
@ -787,7 +787,6 @@ This is like `describe-bindings', but displays only Isearch keys."
(define-key map [menu-bar search-menu]
(list 'menu-item "Isearch" isearch-menu-bar-map))
(define-key map [remap tmm-menubar] 'isearch-tmm-menubar)
map)
"Keymap for `isearch-mode'.")

11
lisp/kmacro.el
View file

@ -172,6 +172,7 @@ macro to be executed before appending to it."
(define-key map "\C-k" 'kmacro-end-or-call-macro-repeat)
(define-key map "r" 'apply-macro-to-region-lines)
(define-key map "q" 'kbd-macro-query) ;; Like C-x q
(define-key map "Q" 'kdb-macro-redisplay)
;; macro ring
(define-key map "\C-n" 'kmacro-cycle-ring-next)
@ -1298,6 +1299,16 @@ To customize possible responses, change the \"bindings\" in
(kmacro-push-ring)
(setq last-kbd-macro kmacro-step-edit-new-macro))))
(defun kdb-macro-redisplay ()
"Force redisplay during kbd macro execution."
(interactive)
(or executing-kbd-macro
defining-kbd-macro
(user-error "Not defining or executing kbd macro"))
(when executing-kbd-macro
(let ((executing-kbd-macro nil))
(redisplay))))
(provide 'kmacro)
;;; kmacro.el ends here

4
lisp/language/burmese.el
View file

@ -51,7 +51,7 @@
regexp t t))))
regexp))
(let ((elt (list (vector burmese-composable-pattern 0 'font-shape-gstring)
(vector "." 0 'font-shape-gstring))))
(let ((elt (list (vector burmese-composable-pattern 0 #'font-shape-gstring)
(vector "." 0 #'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1000 . #x107F) elt)
(set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt))

4
lisp/language/cham.el
View file

@ -23,13 +23,13 @@
;;; Commentary:
;; Tai Viet is being included in the Unicode at the range U+AA80..U+AADF.
;; Cham script is included in the Unicode at the range U+AA00..U+AA5F.
;;; Code:
(set-char-table-range composition-function-table
'(#xAA00 . #xAA5F)
(list (vector "[\xAA00-\xAA5F]+" 0 'font-shape-gstring)))
(list (vector "[\xAA00-\xAA5F]+" 0 #'font-shape-gstring)))
(set-language-info-alist
"Cham" '((charset unicode)

2
lisp/language/china-util.el
View file

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

2
lisp/language/cyril-util.el
View file

@ -1,4 +1,4 @@
;;; cyril-util.el --- utilities for Cyrillic scripts
;;; cyril-util.el --- utilities for Cyrillic scripts -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.

11
lisp/language/ethio-util.el
View file

@ -1,4 +1,4 @@
;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*-
;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2002-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@ -832,11 +832,12 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
(set-buffer-modified-p nil)))
;;;###autoload
(defun ethio-tex-to-fidel-buffer nil
(defun ethio-tex-to-fidel-buffer ()
"Convert fidel-tex commands in the current buffer into fidel chars."
(interactive)
(let ((buffer-read-only nil)
(p) (ch))
(let ((inhibit-read-only t)
;; (p) (ch)
)
;; TeX macros to Ethiopic characters
(robin-convert-region (point-min) (point-max) "ethiopic-tex")
@ -1018,7 +1019,7 @@ With ARG, insert that many delimiters."
;;
;;;###autoload
(defun ethio-composition-function (pos to font-object string _direction)
(defun ethio-composition-function (pos _to _font-object string _direction)
(setq pos (1- pos))
(let ((pattern "\\ce\\(፟\\|<7C><><EFBFBD><EFBFBD>\\)"))
(if string

4
lisp/language/ethiopic.el
View file

@ -79,8 +79,8 @@
)))
;; For automatic composition
(aset composition-function-table ?<3F><EFBFBD><EFBFBD><EFBFBD> 'ethio-composition-function)
(aset composition-function-table ?፟ 'ethio-composition-function)
(aset composition-function-table ?<3F><EFBFBD><EFBFBD><EFBFBD> #'ethio-composition-function)
(aset composition-function-table ?፟ #'ethio-composition-function)
(provide 'ethiopic)

2
lisp/language/hanja-util.el
View file

@ -1,4 +1,4 @@
;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*-
;;; hanja-util.el --- Korean Hanja util module -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.

6
lisp/language/hebrew.el
View file

@ -245,9 +245,9 @@ Bidirectional editing is supported.")))
(pattern2 (concat base "\u200D" combining)))
(set-char-table-range
composition-function-table '(#x591 . #x5C7)
(list (vector pattern2 3 'hebrew-shape-gstring)
(vector pattern2 2 'hebrew-shape-gstring)
(vector pattern1 1 'hebrew-shape-gstring)
(list (vector pattern2 3 #'hebrew-shape-gstring)
(vector pattern2 2 #'hebrew-shape-gstring)
(vector pattern1 1 #'hebrew-shape-gstring)
[nil 0 hebrew-shape-gstring]))
;; Exclude non-combining characters.
(set-char-table-range

14
lisp/language/ind-util.el
View file

@ -1,4 +1,4 @@
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; -*-
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -40,7 +40,7 @@
(defun indian-regexp-of-hashtbl-keys (hashtbl)
"Return the regular expression of hash table keys."
(let (keys)
(maphash (lambda (key val) (push key keys)) hashtbl)
(maphash (lambda (key _val) (push key keys)) hashtbl)
(regexp-opt keys)))
(defvar indian-dev-base-table
@ -565,7 +565,7 @@
(let ((regexp ,(indian-regexp-of-hashtbl-keys
(if encode-p (car (eval hashtable))
(cdr (eval hashtable))))))
(narrow-to-region from to)
(narrow-to-region ,from ,to)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(let ((matchstr (gethash (match-string 0)
@ -613,7 +613,7 @@
;; The followings provide conversion between IS 13194 (ISCII) and UCS.
(let
(dlet
;;Unicode vs IS13194 ;; only Devanagari is supported now.
((ucs-devanagari-to-is13194-alist
'((?\x0900 . "[U+0900]")
@ -820,11 +820,11 @@ Returns new end position."
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
(let* ((current-repertory is13194-default-repertory))
;; (let* ((current-repertory is13194-default-repertory))
(while (re-search-forward indian-ucs-to-is13194-regexp nil t)
(replace-match
(get-char-code-property (string-to-char (match-string 0))
'iscii))))
'iscii)));; )
(point-max))))
(defun indian-iscii-to-ucs-region (from to)
@ -1246,7 +1246,7 @@ Returns new end position."
(interactive "r")
(save-excursion
(save-restriction
(let ((pos from)
(let (;; (pos from)
(alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0)))
(narrow-to-region from to)
(decompose-region from to)

2
lisp/language/indian.el
View file

@ -381,7 +381,7 @@ South Indian language Malayalam is supported in this language environment."))
(if slot
(set-char-table-range
composition-function-table key
(list (vector (cdr slot) 0 'font-shape-gstring))))))
(list (vector (cdr slot) 0 #'font-shape-gstring))))))
char-script-table))
(provide 'indian)

8
lisp/language/japan-util.el
View file

@ -1,4 +1,4 @@
;;; japan-util.el --- utilities for Japanese
;;; japan-util.el --- utilities for Japanese -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@ -236,7 +236,7 @@ of which charset is `japanese-jisx0201-kana'."
(composition
(and (not hankaku)
(get-char-code-property kana 'kana-composition)))
next slot)
slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
@ -258,7 +258,7 @@ of which charset is `japanese-jisx0201-kana'."
(while (re-search-forward "\\cK\\|\\ck" nil t)
(let* ((kata (preceding-char))
(composition (get-char-code-property kata 'kana-composition))
next slot)
slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(get-char-code-property
@ -305,7 +305,7 @@ Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char."
(re-search-forward "\\ca\\|\\ck" nil t)))
(let* ((hankaku (preceding-char))
(composition (get-char-code-property hankaku 'kana-composition))
next slot)
slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))

2
lisp/language/khmer.el
View file

@ -31,7 +31,7 @@
(documentation . t)))
(let ((val (list (vector "[\x1780-\x17FF\x19E0-\x19FF\x200C\x200D]+"
0 'font-shape-gstring))))
0 #'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1780 . #x17FF) val)
(set-char-table-range composition-function-table '(#x19E0 . #x19FF) val))

6
lisp/language/korea-util.el
View file

@ -1,4 +1,4 @@
;;; korea-util.el --- utilities for Korean
;;; korea-util.el --- utilities for Korean -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@ -45,7 +45,7 @@
(activate-input-method
(concat "korean-hangul" default-korean-keyboard))))
(defun quail-hangul-switch-symbol-ksc (&rest ignore)
(defun quail-hangul-switch-symbol-ksc (&rest _ignore)
"Switch to/from Korean symbol package."
(interactive "i")
(and current-input-method
@ -54,7 +54,7 @@
default-korean-keyboard))
(activate-input-method "korean-symbol"))))
(defun quail-hangul-switch-hanja (&rest ignore)
(defun quail-hangul-switch-hanja (&rest _ignore)
"Switch to/from Korean hanja package."
(interactive "i")
(and current-input-method

4
lisp/language/korean.el
View file

@ -92,10 +92,10 @@ and the following key bindings are available within Korean input methods:
(pattern (concat choseong jungseong jongseong)))
(set-char-table-range composition-function-table
'(#x1100 . #x115F)
(list (vector pattern 0 'font-shape-gstring)))
(list (vector pattern 0 #'font-shape-gstring)))
(set-char-table-range composition-function-table
'(#xA960 . #xA97C)
(list (vector pattern 0 'font-shape-gstring))))
(list (vector pattern 0 #'font-shape-gstring))))
(provide 'korean)

8
lisp/language/lao-util.el
View file

@ -1,4 +1,4 @@
;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*-
;;; lao-util.el --- utilities for Lao -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@ -498,10 +498,10 @@ syllable. In that case, FROM and TO are indexes to STR."
(compose-gstring-for-graphic gstring direction)
(or (font-shape-gstring gstring direction)
(let ((glyph-len (lgstring-glyph-len gstring))
(i 0)
glyph)
(i 0)) ;; glyph
(while (and (< i glyph-len)
(setq glyph (lgstring-glyph gstring i)))
;; (setq glyph
(lgstring-glyph gstring i)) ;;)
(setq i (1+ i)))
(compose-glyph-string-relative gstring 0 i 0.1)))))

2
lisp/language/lao.el
View file

@ -66,7 +66,7 @@
(t (string c))))
(cdr l) ""))
;; Element of composition-function-table.
(elt (list (vector regexp 1 'lao-composition-function)
(elt (list (vector regexp 1 #'lao-composition-function)
fallback-rule))
ch)
(dotimes (i len)

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

@ -137,9 +137,9 @@ thin (i.e. 1-dot width) space."
composition-function-table
'(#x600 . #x74F)
(list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
1 'arabic-shape-gstring)
1 #'arabic-shape-gstring)
(vector "[\u0600-\u074F\u200C\u200D]+"
0 'arabic-shape-gstring)))
0 #'arabic-shape-gstring)))
;; The Egyptian Hieroglyph Format Controls were introduced in Unicode
;; Standard v12.0. Apparently, they are not yet well supported in
@ -186,13 +186,13 @@ thin (i.e. 1-dot width) space."
;; doesn't support these controls, the glyphs are
;; displayed individually, and not as a single
;; grapheme cluster.
1 'font-shape-gstring)))
1 #'font-shape-gstring)))
;; Grouping controls
(set-char-table-range
composition-function-table
#x13437
(list (vector "\U00013437[\U00013000-\U0001343F]+"
0 'egyptian-shape-grouping))))
0 #'egyptian-shape-grouping))))
(provide 'misc-lang)

2
lisp/language/sinhala.el
View file

@ -43,6 +43,6 @@
"[\u0D85-\u0D96][\u0D82-\u0D83]?\\|"
;; any other singleton characters
"[\u0D80-\u0DFF]")
0 'font-shape-gstring)))
0 #'font-shape-gstring)))
;; sinhala.el ends here

2
lisp/language/tai-viet.el
View file

@ -30,7 +30,7 @@
(set-char-table-range composition-function-table
'(#xAA80 . #xAADF)
'tai-viet-composition-function)
#'tai-viet-composition-function)
(set-language-info-alist
"TaiViet" '((charset unicode)

8
lisp/language/thai-util.el
View file

@ -1,4 +1,4 @@
;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
;;; thai-util.el --- utilities for Thai -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@ -232,10 +232,10 @@ positions (integers or markers) specifying the region."
(let ((glyph-len (lgstring-glyph-len gstring))
(last-char (lgstring-char gstring
(1- (lgstring-char-len gstring))))
(i 0)
glyph)
(i 0)) ;; glyph
(while (and (< i glyph-len)
(setq glyph (lgstring-glyph gstring i)))
;; (setq glyph
(lgstring-glyph gstring i)) ;; )
(setq i (1+ i)))
(if (= last-char ?ำ)
(setq i (1- i)))

5
lisp/language/thai-word.el
View file

@ -1,4 +1,4 @@
;;; thai-word.el -- find Thai word boundaries
;;; thai-word.el -- find Thai word boundaries -*- lexical-binding: t; -*-
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@ -10973,8 +10973,7 @@ If COUNT is negative, move point backward (- COUNT) words."
;; special instead of using forward-word.
(let ((start (point))
(limit (match-end 0))
boundaries
tail)
boundaries) ;; tail
;; If thai-forward-word has been called within a Thai
;; region, we must go back until the Thai region starts
;; to do the contextual analysis for finding word

64
lisp/language/tibet-util.el
View file

@ -1,4 +1,4 @@
;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*-
;;; tibet-util.el --- utilities for Tibetan -*- 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,
@ -126,42 +126,42 @@ The returned string has no composition information."
(setq t-str-list (cons (substring str idx) t-str-list)))
(apply 'concat (nreverse t-str-list))))
;;;
;;
;;; Functions for composing/decomposing Tibetan sequence.
;;;
;;; A Tibetan syllable is typically structured as follows:
;;;
;;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
;;;
;;; where C's are all vertically stacked, V appears below or above
;;; consonant cluster and M is always put above the C[C+]V combination.
;;; (Sanskrit visarga, though it is a vowel modifier, is considered
;;; to be a punctuation.)
;;;
;;; Here are examples of the words "bsgrubs" and "hfauM"
;;;
;;; བསྒྲུབས ཧཱུཾ
;;;
;;; M
;;; b s b s h
;;; g fa
;;; r u
;;; u
;;;
;;; Consonants `'' (འ), `w' (ཝ), `y' (ཡ), `r' (ར) take special
;;; forms when they are used as subjoined consonant. Consonant `r'
;;; takes another special form when used as superjoined in such a case
;;; as "rka", while it does not change its form when conjoined with
;;; subjoined `'', `w' or `y' as in "rwa", "rya".
;;
;; A Tibetan syllable is typically structured as follows:
;;
;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
;;
;; where C's are all vertically stacked, V appears below or above
;; consonant cluster and M is always put above the C[C+]V combination.
;; (Sanskrit visarga, though it is a vowel modifier, is considered
;; to be a punctuation.)
;;
;; Here are examples of the words "bsgrubs" and "hfauM"
;;
;; བསྒྲུབས ཧཱུཾ
;;
;; M
;; b s b s h
;; g fa
;; r u
;; u
;;
;; Consonants `'' (འ), `w' (ཝ), `y' (ཡ), `r' (ར) take special
;; forms when they are used as subjoined consonant. Consonant `r'
;; takes another special form when used as superjoined in such a case
;; as "rka", while it does not change its form when conjoined with
;; subjoined `'', `w' or `y' as in "rwa", "rya".
;; Append a proper composition rule and glyph to COMPONENTS to compose
;; CHAR with a composition that has COMPONENTS.
; Append a proper composition rule and glyph to COMPONENTS to compose
; CHAR with a composition that has COMPONENTS.
(defun tibetan-add-components (components char)
(let ((last (last components))
(stack-upper '(tc . bc))
(stack-under '(bc . tc))
rule comp-vowel tmp)
rule comp-vowel)
;; Special treatment for 'a chung.
;; If 'a follows a consonant, turn it into the subjoined form.
;; * Disabled by Tomabechi 2000/06/09 *
@ -246,7 +246,7 @@ The returned string has no composition information."
(defun tibetan-compose-region (beg end)
"Compose Tibetan text the region BEG and END."
(interactive "r")
(let (str result chars)
;; (let (str result chars)
(save-excursion
(save-restriction
(narrow-to-region beg end)
@ -272,7 +272,7 @@ The returned string has no composition information."
(while (< (point) to)
(tibetan-add-components components (following-char))
(forward-char 1))
(compose-region from to components)))))))
(compose-region from to components)))))) ;; )
(defvar tibetan-decompose-precomposition-alist
(mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x)))

2
lisp/language/tibetan.el
View file

@ -605,7 +605,7 @@ This also matches some punctuation characters which need conversion.")
;; For automatic composition.
(set-char-table-range
composition-function-table '(#xF00 . #xFD1)
(list (vector tibetan-composable-pattern 0 'font-shape-gstring)))
(list (vector tibetan-composable-pattern 0 #'font-shape-gstring)))
(provide 'tibetan)

4
lisp/language/tv-util.el
View file

@ -1,4 +1,4 @@
;;; tv-util.el --- support for Tai Viet -*- coding: utf-8 -*-
;;; tv-util.el --- support for Tai Viet -*- lexical-binding: t; -*-
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@ -128,7 +128,7 @@
;;;###autoload
(defun tai-viet-composition-function (from to font-object string _direction)
(defun tai-viet-composition-function (from _to _font-object string _direction)
(if string
(if (string-match tai-viet-re string from)
(tai-viet-compose-string from (match-end 0) string))

2
lisp/language/viet-util.el
View file

@ -1,4 +1,4 @@
;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*-
;;; viet-util.el --- utilities for Vietnamese -*- 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/leim/quail/compose.el
View file

@ -1,4 +1,4 @@
;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8;-*-
;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.

2
lisp/leim/quail/viqr.el
View file

@ -1,4 +1,4 @@
;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8;-*-
;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011

8
lisp/mail/rmail.el
View file

@ -2723,6 +2723,12 @@ See also `unrmail-mbox-format'."
:version "24.4"
:group 'rmail-files)
(defcustom rmail-show-message-set-modified nil
"If non-nil, displaying an unseen message marks the Rmail buffer as modified."
:type 'boolean
:group 'rmail
:version "28.1")
(defun rmail-show-message-1 (&optional msg)
"Show message MSG (default: current message) using `rmail-view-buffer'.
Return text to display in the minibuffer if MSG is out of
@ -2750,6 +2756,8 @@ The current mail message becomes the message displayed."
;; Mark the message as seen, but preserve buffer modified flag.
(let ((modiff (buffer-modified-p)))
(rmail-set-attribute rmail-unseen-attr-index nil)
(and rmail-show-message-set-modified
(setq modiff t))
(unless modiff
(restore-buffer-modified-p modiff)))
;; bracket the message in the mail

5
lisp/mail/rmailsum.el
View file

@ -974,8 +974,9 @@ a negative argument means to delete and move forward."
(delete-char 1)
(insert "D"))
;; Discard cached new summary line.
(with-current-buffer rmail-buffer
(aset rmail-summary-vector (1- n) nil))))
(when n
(with-current-buffer rmail-buffer
(aset rmail-summary-vector (1- n) nil)))))
(beginning-of-line))
(defun rmail-summary-update-line (n)

16
lisp/mail/sendmail.el
View file

@ -104,7 +104,9 @@ being sent is used), or nil (in which case the value of
(defcustom mail-self-blind nil
"Non-nil means insert Bcc to self in messages to be sent.
This is done when the message is initialized,
so you can remove or alter the Bcc field to override the default."
so you can remove or alter the Bcc field to override the default.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead."
:type 'boolean)
;;;###autoload
@ -172,14 +174,18 @@ This is used by the default mail-sending commands. See also
(defcustom mail-archive-file-name nil
"Name of file to write all outgoing messages in, or nil for none.
This is normally an mbox file, but for backwards compatibility may also
be a Babyl file."
be a Babyl file.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead."
:type '(choice file (const nil)))
;;;###autoload
(defcustom mail-default-reply-to nil
"Address to insert as default Reply-To field of outgoing messages.
If nil, it will be initialized from the REPLYTO environment variable
when you first send mail."
when you first send mail.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead."
:type '(choice (const nil) string))
(defcustom mail-alias-file nil
@ -388,7 +394,9 @@ in `message-auto-save-directory'."
(defcustom mail-default-headers nil
"A string containing header lines, to be inserted in outgoing messages.
It can contain newlines, and should end in one. It is inserted
before you edit the message, so you can edit or delete the lines."
before you edit the message, so you can edit or delete the lines.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead."
:type '(choice (const nil) string))
(defcustom mail-bury-selects-summary t

2
lisp/net/ange-ftp.el
View file

@ -2547,7 +2547,7 @@ can parse the output from a DIR listing for a host of type TYPE.")
FILE is the full name of the remote file, LSARGS is any args to pass to the
`ls' command, and PARSE specifies that the output should be parsed and stored
away in the internal cache."
(when (string-match "^--dired\\s-+" lsargs)
(while (string-match "^--dired\\s-+" lsargs)
(setq lsargs (replace-match "" nil t lsargs)))
;; If parse is t, we assume that file is a directory. i.e. we only parse
;; full directory listings.

1
lisp/net/dbus.el
View file

@ -2079,6 +2079,7 @@ daemon, it is rather the timestamp the corresponding D-Bus event
has been handled by this function."
(with-current-buffer (get-buffer-create "*D-Bus Monitor*")
(special-mode)
(buffer-disable-undo)
;; Move forward and backward between messages.
(local-set-key [?n] #'forward-paragraph)
(local-set-key [?p] #'backward-paragraph)

2
lisp/net/sasl-cram.el
View file

@ -1,4 +1,4 @@
;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.

2
lisp/net/sasl-digest.el
View file

@ -1,4 +1,4 @@
;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.

4
lisp/net/sasl-ntlm.el
View file

@ -1,4 +1,4 @@
;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
@ -40,7 +40,7 @@
"A list of functions to be called in sequence for the NTLM
authentication steps. They are called by `sasl-next-step'.")
(defun sasl-ntlm-request (client step)
(defun sasl-ntlm-request (client _step)
"SASL step function to generate a NTLM authentication request to the server.
Called from `sasl-next-step'.
CLIENT is a vector [mechanism user service server sasl-client-properties]

19
lisp/net/sasl.el
View file

@ -1,4 +1,4 @@
;;; sasl.el --- SASL client framework
;;; sasl.el --- SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
@ -161,15 +161,8 @@ the current challenge. At the first time STEP should be set to nil."
(if function
(vector function (funcall function client step)))))
(defvar sasl-read-passphrase nil)
(defvar sasl-read-passphrase 'read-passwd)
(defun sasl-read-passphrase (prompt)
(if (not sasl-read-passphrase)
(if (functionp 'read-passwd)
(setq sasl-read-passphrase 'read-passwd)
(if (load "passwd" t)
(setq sasl-read-passphrase 'read-passwd)
(autoload 'ange-ftp-read-passwd "ange-ftp")
(setq sasl-read-passphrase 'ange-ftp-read-passwd))))
(funcall sasl-read-passphrase prompt))
(defun sasl-unique-id ()
@ -210,7 +203,7 @@ It contain at least 64 bits of entropy."
(defconst sasl-plain-steps
'(sasl-plain-response))
(defun sasl-plain-response (client step)
(defun sasl-plain-response (client _step)
(let ((passphrase
(sasl-read-passphrase
(format "PLAIN passphrase for %s: " (sasl-client-name client))))
@ -236,12 +229,12 @@ It contain at least 64 bits of entropy."
sasl-login-response-1
sasl-login-response-2))
(defun sasl-login-response-1 (client step)
(defun sasl-login-response-1 (client _step)
;;; (unless (string-match "^Username:" (sasl-step-data step))
;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-client-name client))
(defun sasl-login-response-2 (client step)
(defun sasl-login-response-2 (client _step)
;;; (unless (string-match "^Password:" (sasl-step-data step))
;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-read-passphrase
@ -257,7 +250,7 @@ It contain at least 64 bits of entropy."
'(ignore ;no initial response
sasl-anonymous-response))
(defun sasl-anonymous-response (client step)
(defun sasl-anonymous-response (client _step)
(or (sasl-client-property client 'trace)
(sasl-client-name client)))

18
lisp/net/sieve-mode.el
View file

@ -128,6 +128,9 @@
(modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "_" st)
(modify-syntax-entry ?\' "\"" st)
(modify-syntax-entry ?\{ "(}" st)
(modify-syntax-entry ?\} "){" st)
(modify-syntax-entry ?\" "\"" st)
st)
"Syntax table in use in sieve-mode buffers.")
@ -178,12 +181,8 @@
'syntax-table (string-to-syntax "|")))))
;;;###autoload
(define-derived-mode sieve-mode c-mode "Sieve"
(define-derived-mode sieve-mode prog-mode "Sieve"
"Major mode for editing Sieve code.
This is much like C mode except for the syntax of comments. Its keymap
inherits from C mode's and it has the same variables for customizing
indentation. It has its own abbrev table and its own syntax table.
Turning on Sieve mode runs `sieve-mode-hook'."
(setq-local paragraph-start (concat "$\\|" page-delimiter))
(setq-local paragraph-separate paragraph-start)
@ -194,8 +193,17 @@ Turning on Sieve mode runs `sieve-mode-hook'."
(setq-local syntax-propertize-function #'sieve-syntax-propertize)
(setq-local font-lock-defaults
'(sieve-font-lock-keywords nil nil ((?_ . "w"))))
(setq-local indent-line-function #'sieve-mode-indent-function)
(easy-menu-add-item nil nil sieve-mode-menu))
(defun sieve-mode-indent-function ()
(save-excursion
(beginning-of-line)
(let ((depth (car (syntax-ppss))))
(when (looking-at "[ \t]*}")
(setq depth (1- depth)))
(indent-line-to (* 2 depth)))))
(provide 'sieve-mode)
;; sieve-mode.el ends here

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