mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-17 10:27:41 +00:00
Merge remote-tracking branch 'savannah/master' into HEAD
This commit is contained in:
Andrea Corallo
commit
9daffe9cfe
61 changed files with 2050 additions and 1205 deletions
|
|
@ -727,6 +727,8 @@ them. Rectangle commands are useful with text in multicolumn formats,
|
|||
and for changing text into or out of such formats.
|
||||
|
||||
@cindex mark rectangle
|
||||
@cindex region-rectangle
|
||||
@cindex rectangular region
|
||||
To specify a rectangle for a command to work on, set the mark at one
|
||||
corner and point at the opposite corner. The rectangle thus specified
|
||||
is called the @dfn{region-rectangle}. If point and the mark are in
|
||||
|
|
|
|||
|
|
@ -1326,16 +1326,17 @@ stored in the system and the available font names are defined by the
|
|||
system, fontsets are defined within Emacs itself. Once you have
|
||||
defined a fontset, you can use it within Emacs by specifying its name,
|
||||
anywhere that you could use a single font. Of course, Emacs fontsets
|
||||
can use only the fonts that the system supports. If some characters
|
||||
can use only the fonts that your system supports. If some characters
|
||||
appear on the screen as empty boxes or hex codes, this means that the
|
||||
fontset in use for them has no font for those characters. In this
|
||||
case, or if the characters are shown, but not as well as you would
|
||||
like, you may need to install extra fonts. Your operating system may
|
||||
have optional fonts that you can install; or you can install the GNU
|
||||
Intlfonts package, which includes fonts for most supported
|
||||
scripts.@footnote{If you run Emacs on X, you may need to inform the X
|
||||
server about the location of the newly installed fonts with commands
|
||||
such as:
|
||||
like, you may need to install extra fonts or modify the fontset to use
|
||||
specific fonts already installed on your system (see below). Your
|
||||
operating system may have optional fonts that you can install; or you
|
||||
can install the GNU Intlfonts package, which includes fonts for most
|
||||
supported scripts.@footnote{If you run Emacs on X, you may need to
|
||||
inform the X server about the location of the newly installed fonts
|
||||
with commands such as:
|
||||
@c FIXME? I feel like this may be out of date.
|
||||
@c E.g., the intlfonts tarfile is ~ 10 years old.
|
||||
|
||||
|
|
@ -1376,14 +1377,20 @@ explicitly requested, despite its name.
|
|||
@w{@kbd{M-x describe-fontset}} command. It prompts for a fontset
|
||||
name, defaulting to the one used by the current frame, and then
|
||||
displays all the subranges of characters and the fonts assigned to
|
||||
them in that fontset.
|
||||
them in that fontset. To see which fonts Emacs is using in a session
|
||||
started without a specific fontset (which is what happens normally),
|
||||
type @kbd{fontset-default @key{RET}} at the prompt, or just
|
||||
@kbd{@key{RET}} to describe the fontset used by the current frame.
|
||||
|
||||
A fontset does not necessarily specify a font for every character
|
||||
code. If a fontset specifies no font for a certain character, or if
|
||||
it specifies a font that does not exist on your system, then it cannot
|
||||
display that character properly. It will display that character as a
|
||||
hex code or thin space or an empty box instead. (@xref{Text Display, ,
|
||||
glyphless characters}, for details.)
|
||||
hex code or thin space or an empty box instead. (@xref{Text Display,
|
||||
, glyphless characters}, for details.) Or a fontset might specify a
|
||||
font for some range of characters, but you may not like their visual
|
||||
appearance. If this happens, you may wish to modify your fontset; see
|
||||
@ref{Modifying Fontsets}, for how to do that.
|
||||
|
||||
@node Defining Fontsets
|
||||
@section Defining Fontsets
|
||||
|
|
@ -1542,10 +1549,10 @@ call this function explicitly to create a fontset.
|
|||
|
||||
Fontsets do not always have to be created from scratch. If only
|
||||
minor changes are required it may be easier to modify an existing
|
||||
fontset. Modifying @samp{fontset-default} will also affect other
|
||||
fontsets that use it as a fallback, so can be an effective way of
|
||||
fixing problems with the fonts that Emacs chooses for a particular
|
||||
script.
|
||||
fontset, usually @samp{fontset-default}. Modifying
|
||||
@samp{fontset-default} will also affect other fontsets that use it as
|
||||
a fallback, so can be an effective way of fixing problems with the
|
||||
fonts that Emacs chooses for a particular script.
|
||||
|
||||
Fontsets can be modified using the function @code{set-fontset-font},
|
||||
specifying a character, a charset, a script, or a range of characters
|
||||
|
|
@ -1553,26 +1560,61 @@ to modify the font for, and a font specification for the font to be
|
|||
used. Some examples are:
|
||||
|
||||
@example
|
||||
;; Use Liberation Mono for latin-3 charset.
|
||||
(set-fontset-font "fontset-default" 'iso-8859-3
|
||||
"Liberation Mono")
|
||||
|
||||
;; Prefer a big5 font for han characters.
|
||||
(set-fontset-font "fontset-default"
|
||||
'han (font-spec :registry "big5")
|
||||
nil 'prepend)
|
||||
|
||||
;; Use DejaVu Sans Mono as a fallback in fontset-startup
|
||||
;; before resorting to fontset-default.
|
||||
(set-fontset-font "fontset-startup" nil "DejaVu Sans Mono"
|
||||
nil 'append)
|
||||
|
||||
;; Use MyPrivateFont for the Unicode private use area.
|
||||
(set-fontset-font "fontset-default" '(#xe000 . #xf8ff)
|
||||
"MyPrivateFont")
|
||||
|
||||
;; Use Liberation Mono for latin-3 charset.
|
||||
(set-fontset-font "fontset-default" 'iso-8859-3
|
||||
"Liberation Mono")
|
||||
|
||||
;; Use DejaVu Sans Mono as a fallback in fontset-startup
|
||||
;; before resorting to fontset-default.
|
||||
(set-fontset-font "fontset-startup" nil "DejaVu Sans Mono"
|
||||
nil 'append)
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
@xref{Fontsets, , , elisp, GNU Emacs Lisp Reference Manual}, for more
|
||||
details about using the @code{set-fontset-font} function.
|
||||
|
||||
@cindex script of a character
|
||||
@cindex codepoint of a character
|
||||
If you don't know the character's codepoint or the script to which it
|
||||
belongs, you can ask Emacs. With point at the character, type
|
||||
@w{@kbd{C-u C-x =}} (@code{what-cursor-position}), and this
|
||||
information, together with much more, will be displayed in the
|
||||
@file{*Help*} buffer that Emacs pops up. @xref{Position Info}. For
|
||||
example, Japanese characters belong to the @samp{kana} script, but
|
||||
Japanese text also mixes them with Chinese characters so the following
|
||||
uses the @samp{han} script to set up Emacs to use the @samp{Kochi
|
||||
Gothic} font for Japanese text:
|
||||
|
||||
@example
|
||||
(set-fontset-font "fontset-default" 'han "Kochi Gothic")
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
@cindex CKJ characters
|
||||
(For convenience, the @samp{han} script in Emacs is set up to support
|
||||
all of the Chinese, Japanese, and Korean, a.k.a.@: @acronym{CJK},
|
||||
characters, not just Chinese characters.)
|
||||
|
||||
@vindex script-representative-chars
|
||||
For the list of known scripts, see the variable
|
||||
@code{script-representative-chars}.
|
||||
|
||||
Fontset settings like those above only affect characters that the
|
||||
default font doesn't support, so if the @samp{Kochi Gothic} font
|
||||
covers Latin characters, it will not be used for displaying Latin
|
||||
scripts, since the default font used by Emacs usually covers Basic
|
||||
Latin.
|
||||
|
||||
@cindex ignore font
|
||||
@cindex fonts, how to ignore
|
||||
@vindex face-ignored-fonts
|
||||
|
|
|
|||
|
|
@ -7317,8 +7317,6 @@ which leave the original list as it was. One way to find out how this
|
|||
works is to experiment. We will start with the @code{setcar} function.
|
||||
|
||||
@need 1200
|
||||
@cindex constant lists
|
||||
@cindex mutable lists
|
||||
First, we can make a list and then set the value of a variable to the
|
||||
list, using the @code{setq} special form. Because we intend to use
|
||||
@code{setcar} to change the list, this @code{setq} should not use the
|
||||
|
|
@ -7327,8 +7325,7 @@ a list that is part of the program and bad things could happen if we
|
|||
tried to change part of the program while running it. Generally
|
||||
speaking an Emacs Lisp program's components should be constant (or
|
||||
unchanged) while the program is running. So we instead construct an
|
||||
animal list that is @dfn{mutable} (or changeable) by using the
|
||||
@code{list} function, as follows:
|
||||
animal list by using the @code{list} function, as follows:
|
||||
|
||||
@smallexample
|
||||
(setq animals (list 'antelope 'giraffe 'lion 'tiger))
|
||||
|
|
|
|||
|
|
@ -1905,6 +1905,7 @@ variables precisely as they were at the time of the error.
|
|||
@subsubsection Writing Code to Handle Errors
|
||||
@cindex error handler
|
||||
@cindex handling errors
|
||||
@cindex handle Lisp errors
|
||||
@cindex forms for handling errors
|
||||
|
||||
The usual effect of signaling an error is to terminate the command
|
||||
|
|
|
|||
|
|
@ -3597,9 +3597,9 @@ characters in the range @var{from} and @var{to} (inclusive).
|
|||
@var{character} may be a charset (@pxref{Character Sets}). In that
|
||||
case, use @var{font-spec} for all the characters in the charset.
|
||||
|
||||
@var{character} may be a script name (@pxref{Character Properties}).
|
||||
In that case, use @var{font-spec} for all the characters belonging to
|
||||
the script.
|
||||
@var{character} may be a script name (@pxref{Character Properties,
|
||||
char-script-table}). In that case, use @var{font-spec} for all the
|
||||
characters belonging to the script.
|
||||
|
||||
@var{character} may be @code{nil}, which means to use @var{font-spec}
|
||||
for any character which no font-spec is specified.
|
||||
|
|
|
|||
|
|
@ -297,7 +297,7 @@ Lisp Data Types
|
|||
* Circular Objects:: Read syntax for circular structure.
|
||||
* Type Predicates:: Tests related to types.
|
||||
* Equality Predicates:: Tests of equality between any two objects.
|
||||
* Constants and Mutability:: Whether an object's value can change.
|
||||
* Mutability:: Some objects should not be modified.
|
||||
|
||||
Programming Types
|
||||
|
||||
|
|
|
|||
|
|
@ -158,11 +158,11 @@ contents unchanged.
|
|||
@end group
|
||||
@end example
|
||||
|
||||
A self-evaluating form yields constant conses, vectors and strings, and you
|
||||
should not attempt to modify their contents via @code{setcar}, @code{aset} or
|
||||
A self-evaluating form yields a value that becomes part of the program,
|
||||
and you should not try to modify it via @code{setcar}, @code{aset} or
|
||||
similar operations. The Lisp interpreter might unify the constants
|
||||
yielded by your program's self-evaluating forms, so that these
|
||||
constants might share structure. @xref{Constants and Mutability}.
|
||||
constants might share structure. @xref{Mutability}.
|
||||
|
||||
It is common to write numbers, characters, strings, and even vectors
|
||||
in Lisp code, taking advantage of the fact that they self-evaluate.
|
||||
|
|
@ -564,8 +564,8 @@ and vectors.)
|
|||
|
||||
@defspec quote object
|
||||
This special form returns @var{object}, without evaluating it.
|
||||
The returned value is a constant, and should not be modified.
|
||||
@xref{Constants and Mutability}.
|
||||
The returned value might be shared and should not be modified.
|
||||
@xref{Self-Evaluating Forms}.
|
||||
@end defspec
|
||||
|
||||
@cindex @samp{'} for quoting
|
||||
|
|
@ -608,9 +608,9 @@ Here are some examples of expressions that use @code{quote}:
|
|||
|
||||
Although the expressions @code{(list '+ 1 2)} and @code{'(+ 1 2)}
|
||||
both yield lists equal to @code{(+ 1 2)}, the former yields a
|
||||
freshly-minted mutable list whereas the latter yields a constant list
|
||||
built from conses that may be shared with other constants.
|
||||
@xref{Constants and Mutability}.
|
||||
freshly-minted mutable list whereas the latter yields a list
|
||||
built from conses that might be shared and should not be modified.
|
||||
@xref{Self-Evaluating Forms}.
|
||||
|
||||
Other quoting constructs include @code{function} (@pxref{Anonymous
|
||||
Functions}), which causes an anonymous lambda expression written in Lisp
|
||||
|
|
@ -710,8 +710,9 @@ Here are some examples:
|
|||
@end example
|
||||
|
||||
If a subexpression of a backquote construct has no substitutions or
|
||||
splices, it acts like @code{quote} in that it yields constant conses,
|
||||
vectors and strings that should not be modified.
|
||||
splices, it acts like @code{quote} in that it yields conses,
|
||||
vectors and strings that might be shared and should not be modified.
|
||||
@xref{Self-Evaluating Forms}.
|
||||
|
||||
@node Eval
|
||||
@section Eval
|
||||
|
|
|
|||
|
|
@ -873,8 +873,8 @@ primitives @code{setcar} and @code{setcdr}. These are destructive
|
|||
operations because they change existing list structure.
|
||||
Destructive operations should be applied only to mutable lists,
|
||||
that is, lists constructed via @code{cons}, @code{list} or similar
|
||||
operations. Lists created by quoting are constants and should not be
|
||||
changed by destructive operations. @xref{Constants and Mutability}.
|
||||
operations. Lists created by quoting are part of the program and
|
||||
should not be changed by destructive operations. @xref{Mutability}.
|
||||
|
||||
@cindex CL note---@code{rplaca} vs @code{setcar}
|
||||
@quotation
|
||||
|
|
@ -911,7 +911,7 @@ value @var{object}. For example:
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq x (list 1 2)) ; @r{Create a mutable list.}
|
||||
(setq x (list 1 2))
|
||||
@result{} (1 2)
|
||||
@end group
|
||||
@group
|
||||
|
|
@ -931,7 +931,7 @@ these lists. Here is an example:
|
|||
|
||||
@example
|
||||
@group
|
||||
;; @r{Create two mutable lists that are partly shared.}
|
||||
;; @r{Create two lists that are partly shared.}
|
||||
(setq x1 (list 'a 'b 'c))
|
||||
@result{} (a b c)
|
||||
(setq x2 (cons 'z (cdr x1)))
|
||||
|
|
@ -1022,11 +1022,11 @@ reached via the @sc{cdr}.
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq x (list 1 2 3)) ; @r{Create a mutable list.}
|
||||
(setq x (list 1 2 3))
|
||||
@result{} (1 2 3)
|
||||
@end group
|
||||
@group
|
||||
(setcdr x '(4)) ; @r{Modify the list's tail to be a constant list.}
|
||||
(setcdr x '(4))
|
||||
@result{} (4)
|
||||
@end group
|
||||
@group
|
||||
|
|
@ -1135,11 +1135,11 @@ Unlike @code{append} (@pxref{Building Lists}), the @var{lists} are
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq x (list 1 2 3)) ; @r{Create a mutable list.}
|
||||
(setq x (list 1 2 3))
|
||||
@result{} (1 2 3)
|
||||
@end group
|
||||
@group
|
||||
(nconc x '(4 5)) ; @r{Modify the list's tail to be a constant list.}
|
||||
(nconc x '(4 5))
|
||||
@result{} (1 2 3 4 5)
|
||||
@end group
|
||||
@group
|
||||
|
|
|
|||
|
|
@ -46,10 +46,6 @@ you store in it, type and all. (Actually, a small number of Emacs
|
|||
Lisp variables can only take on values of a certain type.
|
||||
@xref{Variables with Restricted Values}.)
|
||||
|
||||
Some Lisp objects are @dfn{constant}: their values should never change.
|
||||
Others are @dfn{mutable}: their values can be changed via destructive
|
||||
operations that involve side effects.
|
||||
|
||||
This chapter describes the purpose, printed representation, and read
|
||||
syntax of each of the standard types in GNU Emacs Lisp. Details on how
|
||||
to use these types can be found in later chapters.
|
||||
|
|
@ -63,7 +59,7 @@ to use these types can be found in later chapters.
|
|||
* Circular Objects:: Read syntax for circular structure.
|
||||
* Type Predicates:: Tests related to types.
|
||||
* Equality Predicates:: Tests of equality between any two objects.
|
||||
* Constants and Mutability:: Whether an object's value can change.
|
||||
* Mutability:: Some objects should not be modified.
|
||||
@end menu
|
||||
|
||||
@node Printed Representation
|
||||
|
|
@ -2383,51 +2379,58 @@ that for two strings to be equal, they have the same text properties.
|
|||
@end example
|
||||
@end defun
|
||||
|
||||
@node Constants and Mutability
|
||||
@section Constants and Mutability
|
||||
@cindex constants
|
||||
@node Mutability
|
||||
@section Mutability
|
||||
@cindex mutable objects
|
||||
|
||||
Some Lisp objects are constant: their values should never change
|
||||
during a single execution of Emacs running well-behaved Lisp code.
|
||||
For example, you can create a new integer by calculating one, but you
|
||||
cannot modify the value of an existing integer.
|
||||
Some Lisp objects should never change. For example, the Lisp
|
||||
expression @code{"aaa"} yields a string, but you should not change
|
||||
its contents. And some objects cannot be changed; for example,
|
||||
although you can create a new number by calculating one, Lisp provides
|
||||
no operation to change the value of an existing number.
|
||||
|
||||
Other Lisp objects are mutable: it is safe to change their values
|
||||
via destructive operations involving side effects. For example, an
|
||||
existing marker can be changed by moving the marker to point to
|
||||
somewhere else.
|
||||
Other Lisp objects are @dfn{mutable}: it is safe to change their
|
||||
values via destructive operations involving side effects. For
|
||||
example, an existing marker can be changed by moving the marker to
|
||||
point to somewhere else.
|
||||
|
||||
Although all numbers are constants and all markers are
|
||||
mutable, some types contain both constant and mutable members. These
|
||||
types include conses, vectors, strings, and symbols. For example, the string
|
||||
literal @code{"aaa"} yields a constant string, whereas the function
|
||||
call @code{(make-string 3 ?a)} yields a mutable string that can be
|
||||
Although numbers never change and all markers are mutable,
|
||||
some types have members some of which are mutable and others not. These
|
||||
types include conses, vectors, and strings. For example,
|
||||
although @code{"cons"} and @code{(symbol-name 'cons)} both yield
|
||||
strings that should not be changed, @code{(copy-sequence "cons")} and
|
||||
@code{(make-string 3 ?a)} both yield mutable strings that can be
|
||||
changed via later calls to @code{aset}.
|
||||
|
||||
A mutable object can become constant if it is part of an expression
|
||||
that is evaluated. The reverse does not occur: constant objects
|
||||
should stay constant.
|
||||
A mutable object stops being mutable if it is part of an expression
|
||||
that is evaluated. For example:
|
||||
|
||||
Trying to modify a constant variable signals an error
|
||||
(@pxref{Constant Variables}).
|
||||
A program should not attempt to modify other types of constants because the
|
||||
resulting behavior is undefined: the Lisp interpreter might or might
|
||||
not detect the error, and if it does not detect the error the
|
||||
interpreter can behave unpredictably thereafter. Another way to put
|
||||
this is that although mutable objects are safe to change and constant
|
||||
variables reliably prevent attempts to change them, other constants
|
||||
are not safely mutable: if a misbehaving program tries to change such a
|
||||
constant then the constant's value might actually change, or the
|
||||
program might crash or worse. This problem occurs
|
||||
with types that have both constant and mutable members, and that have
|
||||
mutators like @code{setcar} and @code{aset} that are valid on mutable
|
||||
objects but hazardous on constants.
|
||||
@example
|
||||
(let* ((x (list 0.5))
|
||||
(y (eval (list 'quote x))))
|
||||
(setcar x 1.5) ;; The program should not do this.
|
||||
y)
|
||||
@end example
|
||||
|
||||
When the same constant occurs multiple times in a program, the Lisp
|
||||
@noindent
|
||||
Although the list @code{(0.5)} was mutable when it was created, it should not
|
||||
have been changed via @code{setcar} because it given to @code{eval}. The
|
||||
reverse does not occur: an object that should not be changed never
|
||||
becomes mutable afterwards.
|
||||
|
||||
If a program attempts to change objects that should not be
|
||||
changed, the resulting behavior is undefined: the Lisp interpreter
|
||||
might signal an error, or it might crash or behave unpredictably in
|
||||
other ways.@footnote{This is the behavior specified for languages like
|
||||
Common Lisp and C for constants, and this differs from languages like
|
||||
JavaScript and Python where an interpreter is required to signal an
|
||||
error if a program attempts to change an immutable object. Ideally the Emacs
|
||||
Lisp interpreter will evolve in latter direction.}
|
||||
|
||||
When similar constants occur as parts of a program, the Lisp
|
||||
interpreter might save time or space by reusing existing constants or
|
||||
constant components. For example, @code{(eq "abc" "abc")} returns
|
||||
their components. For example, @code{(eq "abc" "abc")} returns
|
||||
@code{t} if the interpreter creates only one instance of the string
|
||||
constant @code{"abc"}, and returns @code{nil} if it creates two
|
||||
literal @code{"abc"}, and returns @code{nil} if it creates two
|
||||
instances. Lisp programs should be written so that they work
|
||||
regardless of whether this optimization is in use.
|
||||
|
|
|
|||
|
|
@ -183,11 +183,11 @@ for other ways to copy sequences.
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq bar (list 1 2)) ; @r{Create a mutable list.}
|
||||
(setq bar (list 1 2))
|
||||
@result{} (1 2)
|
||||
@end group
|
||||
@group
|
||||
(setq x (vector 'foo bar)) ; @r{Create a mutable vector.}
|
||||
(setq x (vector 'foo bar))
|
||||
@result{} [foo (1 2)]
|
||||
@end group
|
||||
@group
|
||||
|
|
@ -278,7 +278,7 @@ Unlike @code{reverse} the original @var{sequence} may be modified.
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq x (list 'a 'b 'c)) ; @r{Create a mutable list.}
|
||||
(setq x (list 'a 'b 'c))
|
||||
@result{} (a b c)
|
||||
@end group
|
||||
@group
|
||||
|
|
@ -320,7 +320,7 @@ presented graphically:
|
|||
For the vector, it is even simpler because you don't need setq:
|
||||
|
||||
@example
|
||||
(setq x (copy-sequence [1 2 3 4])) ; @r{Create a mutable vector.}
|
||||
(setq x (copy-sequence [1 2 3 4]))
|
||||
@result{} [1 2 3 4]
|
||||
(nreverse x)
|
||||
@result{} [4 3 2 1]
|
||||
|
|
@ -331,6 +331,7 @@ x
|
|||
Note that unlike @code{reverse}, this function doesn't work with strings.
|
||||
Although you can alter string data by using @code{aset}, it is strongly
|
||||
encouraged to treat strings as immutable even when they are mutable.
|
||||
@xref{Mutability}.
|
||||
|
||||
@end defun
|
||||
|
||||
|
|
@ -374,7 +375,7 @@ appears in a different position in the list due to the change of
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq nums (list 1 3 2 6 5 4 0)) ; @r{Create a mutable list.}
|
||||
(setq nums (list 1 3 2 6 5 4 0))
|
||||
@result{} (1 3 2 6 5 4 0)
|
||||
@end group
|
||||
@group
|
||||
|
|
@ -1228,7 +1229,7 @@ This function sets the @var{index}th element of @var{array} to be
|
|||
|
||||
@example
|
||||
@group
|
||||
(setq w (vector 'foo 'bar 'baz)) ; @r{Create a mutable vector.}
|
||||
(setq w (vector 'foo 'bar 'baz))
|
||||
@result{} [foo bar baz]
|
||||
(aset w 0 'fu)
|
||||
@result{} fu
|
||||
|
|
@ -1237,7 +1238,7 @@ w
|
|||
@end group
|
||||
|
||||
@group
|
||||
;; @r{@code{copy-sequence} creates a mutable string.}
|
||||
;; @r{@code{copy-sequence} copies the string to be modified later.}
|
||||
(setq x (copy-sequence "asdfasfd"))
|
||||
@result{} "asdfasfd"
|
||||
(aset x 3 ?Z)
|
||||
|
|
@ -1247,9 +1248,7 @@ x
|
|||
@end group
|
||||
@end example
|
||||
|
||||
The @var{array} should be mutable; that is, it should not be a constant,
|
||||
such as the constants created via quoting or via self-evaluating forms.
|
||||
@xref{Constants and Mutability}.
|
||||
The @var{array} should be mutable. @xref{Mutability}.
|
||||
|
||||
If @var{array} is a string and @var{object} is not a character, a
|
||||
@code{wrong-type-argument} error results. The function converts a
|
||||
|
|
@ -1262,7 +1261,6 @@ each element of @var{array} is @var{object}. It returns @var{array}.
|
|||
|
||||
@example
|
||||
@group
|
||||
;; @r{Create a mutable vector and then fill it with zeros.}
|
||||
(setq a (copy-sequence [a b c d e f g]))
|
||||
@result{} [a b c d e f g]
|
||||
(fillarray a 0)
|
||||
|
|
@ -1271,7 +1269,6 @@ a
|
|||
@result{} [0 0 0 0 0 0 0]
|
||||
@end group
|
||||
@group
|
||||
;; @r{Create a mutable string and then fill it with "-".}
|
||||
(setq s (copy-sequence "When in the course"))
|
||||
@result{} "When in the course"
|
||||
(fillarray s ?-)
|
||||
|
|
@ -1310,8 +1307,8 @@ same way in Lisp input.
|
|||
evaluation: the result of evaluating it is the same vector. This does
|
||||
not evaluate or even examine the elements of the vector.
|
||||
@xref{Self-Evaluating Forms}. Vectors written with square brackets
|
||||
are constants and should not be modified via @code{aset} or other
|
||||
destructive operations. @xref{Constants and Mutability}.
|
||||
should not be modified via @code{aset} or other destructive
|
||||
operations. @xref{Mutability}.
|
||||
|
||||
Here are examples illustrating these principles:
|
||||
|
||||
|
|
|
|||
|
|
@ -49,10 +49,9 @@ by a distinguished character code.
|
|||
|
||||
Since strings are arrays, and therefore sequences as well, you can
|
||||
operate on them with the general array and sequence functions documented
|
||||
in @ref{Sequences Arrays Vectors}. For example, you can access or
|
||||
change individual characters in a string using the functions @code{aref}
|
||||
and @code{aset} (@pxref{Array Functions}). However, you should not
|
||||
try to change the contents of constant strings (@pxref{Modifying Strings}).
|
||||
in @ref{Sequences Arrays Vectors}. For example, you can access
|
||||
individual characters in a string using the function @code{aref}
|
||||
(@pxref{Array Functions}).
|
||||
|
||||
There are two text representations for non-@acronym{ASCII}
|
||||
characters in Emacs strings (and in buffers): unibyte and multibyte.
|
||||
|
|
@ -382,9 +381,7 @@ usual value is @w{@code{"[ \f\t\n\r\v]+"}}.
|
|||
@cindex string modification
|
||||
|
||||
You can alter the contents of a mutable string via operations
|
||||
described in this section. However, you should not try to use these
|
||||
operations to alter the contents of a constant string.
|
||||
@xref{Constants and Mutability}.
|
||||
described in this section. @xref{Mutability}.
|
||||
|
||||
The most basic way to alter the contents of an existing string is with
|
||||
@code{aset} (@pxref{Array Functions}). @code{(aset @var{string}
|
||||
|
|
|
|||
47
etc/NEWS
47
etc/NEWS
|
|
@ -139,6 +139,9 @@ directories with the help of new command 'dired-vc-next-action'.
|
|||
*** New commands 'vc-dir-mark-registered-files' (bound to '* r') and
|
||||
'vc-dir-mark-unregistered-files'.
|
||||
|
||||
*** Support for bookmark.el.
|
||||
Bookmark locations can refer to VC directory buffers.
|
||||
|
||||
** Gnus
|
||||
|
||||
---
|
||||
|
|
@ -226,6 +229,12 @@ key binding
|
|||
/ m package-menu-filter-marked
|
||||
/ / package-menu-filter-clear
|
||||
|
||||
---
|
||||
+++ Column widths in 'list-packages' display can now be customized.
|
||||
See the new user options 'package-name-column-width',
|
||||
'package-version-column-width', 'package-status-column-width', and
|
||||
'package-archive-column-width'.
|
||||
|
||||
** gdb-mi
|
||||
|
||||
+++
|
||||
|
|
@ -353,6 +362,44 @@ symbol property to the browsing functions. With a new command
|
|||
'browse-url-with-browser-kind', an URL can explicitly be browsed with
|
||||
either an internal or external browser.
|
||||
|
||||
** SHR
|
||||
|
||||
---
|
||||
*** The command 'shr-browse-url' now supports custom mailto handlers.
|
||||
Clicking on or otherwise following a 'mailto:' link in a HTML buffer
|
||||
rendered by SHR previously invoked the command 'browse-url-mailto'.
|
||||
This is still the case by default, but if you customize
|
||||
'browse-url-mailto-function' or 'browse-url-handlers' to call some
|
||||
other function, it will now be called instead of the default.
|
||||
|
||||
** EWW
|
||||
|
||||
---
|
||||
*** The command 'eww-follow-link' now supports custom mailto handlers.
|
||||
The function that is invoked when clicking on or otherwise following a
|
||||
'mailto:' link in an EWW buffer can now be customized. For more
|
||||
information, see the related entry about 'shr-browse-url' above.
|
||||
|
||||
** Project
|
||||
|
||||
*** New user option 'project-vc-merge-submodules'.
|
||||
|
||||
** json.el
|
||||
|
||||
---
|
||||
*** JSON number parsing is now stricter.
|
||||
Numbers with a leading plus sign, leading zeros, or a missing integer
|
||||
component are now rejected by 'json-read' and friends. This makes
|
||||
them more compliant with the JSON specification and consistent with
|
||||
the native JSON parsing functions.
|
||||
|
||||
** xml.el
|
||||
|
||||
*** XML serialization functions now reject invalid characters.
|
||||
Previously 'xml-print' would produce invalid XML when given a string
|
||||
with characters that are not valid in XML (see
|
||||
https://www.w3.org/TR/xml/#charsets). Now it rejects such strings.
|
||||
|
||||
|
||||
* New Modes and Packages in Emacs 28.1
|
||||
|
||||
|
|
|
|||
64
etc/TODO
64
etc/TODO
|
|
@ -220,10 +220,23 @@ https://lists.gnu.org/r/emacs-devel/2013-11/msg00515.html
|
|||
width fonts. However, more features are still needed to achieve this.
|
||||
|
||||
** Support ligatures out of the box
|
||||
For the list of typographical ligatures, see
|
||||
For the list of frequently-used typographical ligatures, see
|
||||
|
||||
https://en.wikipedia.org/wiki/Orthographic_ligature#Ligatures_in_Unicode_(Latin_alphabets)
|
||||
|
||||
(Note that in general, the number of possible ligatures can be much
|
||||
larger, and there's no way, in principle, to specify the superset of
|
||||
all the ligatures that could exist. Each font can support different
|
||||
ligatures. The reliable way of supporting any and all ligatures is to
|
||||
hand all text to be displayed to the shaping engine and get back the
|
||||
font glyphs to display that text. However, doing this is impossible
|
||||
with the current design of the Emacs display engine, since it examines
|
||||
buffer text one character at a time, and implements character
|
||||
composition by calls to Lisp, which makes doing this for every
|
||||
character impractically slow. Therefore, the rest of this item
|
||||
describes a limited form of ligature support which is compatible with
|
||||
the current display engine design and uses automatic compositions.)
|
||||
|
||||
For Text and derived modes, the job is to figure out which ligatures
|
||||
we want to support, how to let the user customize that, and probably
|
||||
define a minor mode for automatic ligation (as some contexts might not
|
||||
|
|
@ -237,12 +250,12 @@ prettify-symbols-mode. We need to figure out which ligatures are
|
|||
needed for each programming language, and provide user options to turn
|
||||
this on and off.
|
||||
|
||||
The implementation should use the infrastructure for character
|
||||
compositions, i.e., we should define appropriate regexp-based rules
|
||||
for character sequences that need to be composed into ligatures, and
|
||||
populate composition-function-table with those rules. See
|
||||
composite.el for examples of this, and also grep lisp/language/*.el
|
||||
for references to composition-function-table.
|
||||
The implementation should use the infrastructure for automatic
|
||||
character compositions, i.e., we should define appropriate
|
||||
regexp-based rules for character sequences that need to be composed
|
||||
into ligatures, and populate composition-function-table with those
|
||||
rules. See composite.el for examples of this, and also grep
|
||||
lisp/language/*.el for references to composition-function-table.
|
||||
|
||||
One problem with character compositions that will need to be solved is
|
||||
that composition-function-table, the char-table which holds the
|
||||
|
|
@ -259,11 +272,46 @@ way of preventing the ligation from happening. One possibility is to
|
|||
have a ZWNJ character separate these ASCII characters; another
|
||||
possibility is to introduce a special text property that prevents
|
||||
character composition, and place that property on the relevant parts
|
||||
of the mode line.
|
||||
of the mode line. Yet another possibility would be to write a
|
||||
specialized composition function, which would detect that it is called
|
||||
on mode-line strings, and return nil to signal that composition is not
|
||||
possible in this case; then use that function in the rules for
|
||||
ligatures stored in composition-function-table.
|
||||
|
||||
The prettify-symbols-mode should be deprecated once ligature support
|
||||
is in place.
|
||||
|
||||
A related, but somewhat independent, feature is being able to move the
|
||||
cursor "into a ligature", whereby cursor motion commands shows some
|
||||
pseudo-cursor on some part of a ligature. For example, if "ffi" is
|
||||
displayed as a ligature, then moving by one buffer position should
|
||||
show the middle part of the ligature's glyph similar to the cursor
|
||||
display: some special background and perhaps also a special
|
||||
foreground. There are two possible ways of figuring out the offset at
|
||||
which to display the pseudo-cursor:
|
||||
|
||||
. Arbitrarily divide the ligature's glyph width W into N parts,
|
||||
where N is the number of codepoints composed into the ligature, then
|
||||
move that pseudo-cursor by W/N pixels each time a cursor-motion
|
||||
command is invoked;
|
||||
. Use the font information. For example, HarfBuzz has the
|
||||
hb_ot_layout_get_ligature_carets API for that purpose. However,
|
||||
it could be that few fonts actually have that information recorded
|
||||
in them, in which case the previous heuristics will be needed as
|
||||
fallback.
|
||||
|
||||
One subtle issue needs to be resolved to have this feature of
|
||||
"sub-glyph" cursor movement inside composed characters. The way Emacs
|
||||
currently displays the default block cursor is by simply redrawing the
|
||||
glyph at point in reverse video. So Emacs currently doesn't have a
|
||||
way of displaying a cursor that "covers" only part of a glyph. To
|
||||
make this happen, the display code will probably need to be changed to
|
||||
draw the cursor as part of drawing the foreground and/or background of
|
||||
the corresponding glyph, which is against the current flow of the
|
||||
display code: it generally first completely draws the background and
|
||||
foreground of the entire text that needs to be redrawn, and only then
|
||||
draws the cursor where it should be placed.
|
||||
|
||||
** Support for Stylistic Sets
|
||||
This will allow using "alternate glyphs" supported by modern fonts.
|
||||
For an overview of this feature, see
|
||||
|
|
|
|||
|
|
@ -4197,9 +4197,9 @@ C_entries (int c_ext, FILE *inf)
|
|||
break;
|
||||
}
|
||||
FALLTHROUGH;
|
||||
resetfvdef:
|
||||
case '#': case '~': case '&': case '%': case '/':
|
||||
case '|': case '^': case '!': case '.': case '?':
|
||||
resetfvdef:
|
||||
if (definedef != dnone)
|
||||
break;
|
||||
/* These surely cannot follow a function tag in C. */
|
||||
|
|
|
|||
|
|
@ -858,12 +858,10 @@ The result should not exceed the screen width."
|
|||
"Convert the given STR to a number, according to the value of
|
||||
`calculator-input-radix'."
|
||||
(if calculator-input-radix
|
||||
(string-to-number str (cadr (assq calculator-input-radix
|
||||
'((bin 2) (oct 8) (hex 16)))))
|
||||
(let* ((str (replace-regexp-in-string
|
||||
"\\.\\([^0-9].*\\)?$" ".0\\1" str))
|
||||
(str (replace-regexp-in-string
|
||||
"[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str)))
|
||||
(string-to-number str (cadr (assq calculator-input-radix
|
||||
'((bin 2) (oct 8) (hex 16)))))
|
||||
;; Allow entry of "1.e3".
|
||||
(let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str)))
|
||||
(float (string-to-number str)))))
|
||||
|
||||
(defun calculator-push-curnum ()
|
||||
|
|
|
|||
|
|
@ -1515,8 +1515,11 @@ It does not apply the value to buffers."
|
|||
(when project-dir
|
||||
(ede-directory-get-open-project project-dir 'ROOT))))
|
||||
|
||||
(cl-defmethod project-roots ((project ede-project))
|
||||
(list (ede-project-root-directory project)))
|
||||
(cl-defmethod project-root ((project ede-project))
|
||||
(ede-project-root-directory project))
|
||||
|
||||
;;; FIXME: Could someone look into implementing `project-ignores' for
|
||||
;;; EDE and/or a faster `project-files'?
|
||||
|
||||
(add-hook 'project-find-functions #'project-try-ede)
|
||||
|
||||
|
|
|
|||
|
|
@ -2050,8 +2050,8 @@ See the command `doc-view-mode' for more information on this mode."
|
|||
(when (memq (selected-frame) (alist-get 'frames attrs))
|
||||
(let ((geom (alist-get 'geometry attrs)))
|
||||
(when geom
|
||||
(setq monitor-top (nth 0 geom))
|
||||
(setq monitor-left (nth 1 geom))
|
||||
(setq monitor-left (nth 0 geom))
|
||||
(setq monitor-top (nth 1 geom))
|
||||
(setq monitor-width (nth 2 geom))
|
||||
(setq monitor-height (nth 3 geom))))))
|
||||
(let ((frame (make-frame
|
||||
|
|
|
|||
|
|
@ -397,6 +397,26 @@ synchronously."
|
|||
:type 'boolean
|
||||
:version "25.1")
|
||||
|
||||
(defcustom package-name-column-width 30
|
||||
"Column width for the Package name in the package menu."
|
||||
:type 'number
|
||||
:version "28.1")
|
||||
|
||||
(defcustom package-version-column-width 14
|
||||
"Column width for the Package version in the package menu."
|
||||
:type 'number
|
||||
:version "28.1")
|
||||
|
||||
(defcustom package-status-column-width 12
|
||||
"Column width for the Package status in the package menu."
|
||||
:type 'number
|
||||
:version "28.1")
|
||||
|
||||
(defcustom package-archive-column-width 8
|
||||
"Column width for the Package status in the package menu."
|
||||
:type 'number
|
||||
:version "28.1")
|
||||
|
||||
|
||||
;;; `package-desc' object definition
|
||||
;; This is the struct used internally to represent packages.
|
||||
|
|
@ -2750,11 +2770,11 @@ Letters do not insert themselves; instead, they are commands.
|
|||
(package-menu--transaction-status
|
||||
package-menu--transaction-status)))
|
||||
(setq tabulated-list-format
|
||||
`[("Package" 18 package-menu--name-predicate)
|
||||
("Version" 13 package-menu--version-predicate)
|
||||
("Status" 10 package-menu--status-predicate)
|
||||
`[("Package" ,package-name-column-width package-menu--name-predicate)
|
||||
("Version" ,package-version-column-width package-menu--version-predicate)
|
||||
("Status" ,package-status-column-width package-menu--status-predicate)
|
||||
,@(if (cdr package-archives)
|
||||
'(("Archive" 10 package-menu--archive-predicate)))
|
||||
`(("Archive" ,package-archive-column-width package-menu--archive-predicate)))
|
||||
("Description" 0 package-menu--description-predicate)])
|
||||
(setq tabulated-list-padding 2)
|
||||
(setq tabulated-list-sort-key (cons "Status" nil))
|
||||
|
|
|
|||
|
|
@ -139,14 +139,28 @@ delimiter or an Escaped or Char-quoted character."))
|
|||
(point-max))))
|
||||
(cons beg end))
|
||||
|
||||
(defun syntax-propertize--shift-groups (re n)
|
||||
(replace-regexp-in-string
|
||||
"\\\\(\\?\\([0-9]+\\):"
|
||||
(lambda (s)
|
||||
(replace-match
|
||||
(number-to-string (+ n (string-to-number (match-string 1 s))))
|
||||
t t s 1))
|
||||
re t t))
|
||||
(defun syntax-propertize--shift-groups-and-backrefs (re n)
|
||||
(let ((new-re (replace-regexp-in-string
|
||||
"\\\\(\\?\\([0-9]+\\):"
|
||||
(lambda (s)
|
||||
(replace-match
|
||||
(number-to-string
|
||||
(+ n (string-to-number (match-string 1 s))))
|
||||
t t s 1))
|
||||
re t t))
|
||||
(pos 0))
|
||||
(while (string-match "\\\\\\([0-9]+\\)" new-re pos)
|
||||
(setq pos (+ 1 (match-beginning 1)))
|
||||
(when (save-match-data
|
||||
;; With \N, the \ must be in a subregexp context, i.e.,
|
||||
;; not in a character class or in a \{\} repetition.
|
||||
(subregexp-context-p new-re (match-beginning 0)))
|
||||
(let ((shifted (+ n (string-to-number (match-string 1 new-re)))))
|
||||
(when (> shifted 9)
|
||||
(error "There may be at most nine back-references"))
|
||||
(setq new-re (replace-match (number-to-string shifted)
|
||||
t t new-re 1)))))
|
||||
new-re))
|
||||
|
||||
(defmacro syntax-propertize-precompile-rules (&rest rules)
|
||||
"Return a precompiled form of RULES to pass to `syntax-propertize-rules'.
|
||||
|
|
@ -190,7 +204,8 @@ for subsequent HIGHLIGHTs.
|
|||
Also SYNTAX is free to move point, in which case RULES may not be applied to
|
||||
some parts of the text or may be applied several times to other parts.
|
||||
|
||||
Note: back-references in REGEXPs do not work."
|
||||
Note: There may be at most nine back-references in the REGEXPs of
|
||||
all RULES in total."
|
||||
(declare (debug (&rest &or symbolp ;FIXME: edebug this eval step.
|
||||
(form &rest
|
||||
(numberp
|
||||
|
|
@ -219,7 +234,7 @@ Note: back-references in REGEXPs do not work."
|
|||
;; tell when *this* match 0 has succeeded.
|
||||
(cl-incf offset)
|
||||
(setq re (concat "\\(" re "\\)")))
|
||||
(setq re (syntax-propertize--shift-groups re offset))
|
||||
(setq re (syntax-propertize--shift-groups-and-backrefs re offset))
|
||||
(let ((code '())
|
||||
(condition
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -5833,6 +5833,7 @@ all parts."
|
|||
"" "..."))
|
||||
(gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
|
||||
(buffer-size)))
|
||||
(help-echo "mouse-2: toggle the MIME part; down-mouse-3: more options")
|
||||
gnus-tmp-type-long b e)
|
||||
(when (string-match ".*/" gnus-tmp-name)
|
||||
(setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
|
||||
|
|
@ -5841,6 +5842,16 @@ all parts."
|
|||
(concat "; " gnus-tmp-name))))
|
||||
(unless (equal gnus-tmp-description "")
|
||||
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
|
||||
(when (zerop gnus-tmp-length)
|
||||
(setq gnus-tmp-type-long
|
||||
(concat
|
||||
gnus-tmp-type-long
|
||||
(substitute-command-keys
|
||||
(concat "\\<gnus-summary-mode-map> (not downloaded, "
|
||||
"\\[gnus-summary-show-complete-article] to fetch.)"))))
|
||||
(setq help-echo
|
||||
(concat "Type \\[gnus-summary-show-complete-article] "
|
||||
"to download complete article. " help-echo)))
|
||||
(setq b (point))
|
||||
(gnus-eval-format
|
||||
gnus-mime-button-line-format gnus-mime-button-line-format-alist
|
||||
|
|
@ -5859,8 +5870,7 @@ all parts."
|
|||
'keymap gnus-mime-button-map
|
||||
'face gnus-article-button-face
|
||||
'follow-link t
|
||||
'help-echo
|
||||
"mouse-2: toggle the MIME part; down-mouse-3: more options")))
|
||||
'help-echo help-echo)))
|
||||
|
||||
(defvar gnus-displaying-mime nil)
|
||||
|
||||
|
|
|
|||
|
|
@ -485,23 +485,25 @@ This is not required after changing `gnus-registry-cache-file'."
|
|||
(when from
|
||||
(setq entry (cons (delete from (assoc 'group entry))
|
||||
(assq-delete-all 'group entry))))
|
||||
|
||||
(dolist (kv `((group ,to)
|
||||
(sender ,sender)
|
||||
(recipient ,@recipients)
|
||||
(subject ,subject)))
|
||||
(when (cadr kv)
|
||||
(let ((new (or (assq (car kv) entry)
|
||||
(list (car kv)))))
|
||||
(dolist (toadd (cdr kv))
|
||||
(unless (member toadd new)
|
||||
(setq new (append new (list toadd)))))
|
||||
(setq entry (cons new
|
||||
(assq-delete-all (car kv) entry))))))
|
||||
(gnus-message 10 "Gnus registry: new entry for %s is %S"
|
||||
id
|
||||
entry)
|
||||
(gnus-registry-insert db id entry)))
|
||||
;; Only keep the entry if the message is going to a new group, or
|
||||
;; it's still in some previous group.
|
||||
(when (or to (alist-get 'group entry))
|
||||
(dolist (kv `((group ,to)
|
||||
(sender ,sender)
|
||||
(recipient ,@recipients)
|
||||
(subject ,subject)))
|
||||
(when (cadr kv)
|
||||
(let ((new (or (assq (car kv) entry)
|
||||
(list (car kv)))))
|
||||
(dolist (toadd (cdr kv))
|
||||
(unless (member toadd new)
|
||||
(setq new (append new (list toadd)))))
|
||||
(setq entry (cons new
|
||||
(assq-delete-all (car kv) entry))))))
|
||||
(gnus-message 10 "Gnus registry: new entry for %s is %S"
|
||||
id
|
||||
entry)
|
||||
(gnus-registry-insert db id entry))))
|
||||
|
||||
;; Function for nn{mail|imap}-split-fancy: look up all references in
|
||||
;; the cache and if a match is found, return that group.
|
||||
|
|
|
|||
19
lisp/ido.el
19
lisp/ido.el
|
|
@ -499,11 +499,14 @@ This means that \\[ido-complete] must always be followed by \\[ido-exit-minibuff
|
|||
even when there is only one unique completion."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom ido-cannot-complete-command 'ido-completion-help
|
||||
(defcustom ido-cannot-complete-command #'ido-completion-auto-help
|
||||
"Command run when `ido-complete' can't complete any more.
|
||||
The most useful values are `ido-completion-help', which pops up a
|
||||
window with completion alternatives, or `ido-next-match' or
|
||||
`ido-prev-match', which cycle the buffer list."
|
||||
window with completion alternatives; `ido-completion-auto-help',
|
||||
which does the same but respects the value of
|
||||
`completion-auto-help'; and `ido-next-match' or `ido-prev-match',
|
||||
which cycle the buffer list."
|
||||
:version "28.1"
|
||||
:type 'function)
|
||||
|
||||
|
||||
|
|
@ -1546,7 +1549,7 @@ This function also adds a hook to the minibuffer."
|
|||
((> (prefix-numeric-value arg) 0) 'both)
|
||||
(t nil)))
|
||||
|
||||
(ido-everywhere (if ido-everywhere 1 -1))
|
||||
(ido-everywhere (if (and ido-mode ido-everywhere) 1 -1))
|
||||
|
||||
(when ido-mode
|
||||
(ido-common-initialization)
|
||||
|
|
@ -3926,6 +3929,14 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
|
|||
(when (bobp)
|
||||
(next-completion 1)))))
|
||||
|
||||
(defun ido-completion-auto-help ()
|
||||
"Call `ido-completion-help' if `completion-auto-help' is non-nil."
|
||||
(interactive)
|
||||
;; Note: `completion-auto-help' could also be `lazy', but this value
|
||||
;; is irrelevant to ido, which is fundamentally eager, so it is
|
||||
;; treated the same as t.
|
||||
(when completion-auto-help
|
||||
(ido-completion-help)))
|
||||
|
||||
(defun ido-completion-help ()
|
||||
"Show possible completions in the `ido-completion-buffer'."
|
||||
|
|
|
|||
570
lisp/json.el
570
lisp/json.el
|
|
@ -3,7 +3,7 @@
|
|||
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Theresa O'Connor <ted@oconnor.cx>
|
||||
;; Version: 1.4
|
||||
;; Version: 1.5
|
||||
;; Keywords: convenience
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
|
@ -29,11 +29,11 @@
|
|||
;; Learn all about JSON here: <URL:http://json.org/>.
|
||||
|
||||
;; The user-serviceable entry points for the parser are the functions
|
||||
;; `json-read' and `json-read-from-string'. The encoder has a single
|
||||
;; `json-read' and `json-read-from-string'. The encoder has a single
|
||||
;; entry point, `json-encode'.
|
||||
|
||||
;; Since there are several natural representations of key-value pair
|
||||
;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
|
||||
;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you
|
||||
;; to specify which you'd prefer (see `json-object-type' and
|
||||
;; `json-array-type').
|
||||
|
||||
|
|
@ -55,6 +55,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'map)
|
||||
(require 'seq)
|
||||
(require 'subr-x)
|
||||
|
||||
;; Parameters
|
||||
|
|
@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.")
|
|||
"If non-nil, then the output of `json-encode' will be pretty-printed.")
|
||||
|
||||
(defvar json-encoding-lisp-style-closings nil
|
||||
"If non-nil, ] and } closings will be formatted lisp-style,
|
||||
without indentation.")
|
||||
"If non-nil, delimiters ] and } will be formatted Lisp-style.
|
||||
This means they will be placed on the same line as the last
|
||||
element of the respective array or object, without indentation.
|
||||
Used only when `json-encoding-pretty-print' is non-nil.")
|
||||
|
||||
(defvar json-encoding-object-sort-predicate nil
|
||||
"Sorting predicate for JSON object keys during encoding.
|
||||
|
|
@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object keys
|
|||
ordered alphabetically.")
|
||||
|
||||
(defvar json-pre-element-read-function nil
|
||||
"Function called (if non-nil) by `json-read-array' and
|
||||
`json-read-object' right before reading a JSON array or object,
|
||||
respectively. The function is called with one argument, which is
|
||||
the current JSON key.")
|
||||
"If non-nil, a function to call before reading a JSON array or object.
|
||||
It is called by `json-read-array' and `json-read-object',
|
||||
respectively, with one argument, which is the current JSON key.")
|
||||
|
||||
(defvar json-post-element-read-function nil
|
||||
"Function called (if non-nil) by `json-read-array' and
|
||||
`json-read-object' right after reading a JSON array or object,
|
||||
respectively.")
|
||||
"If non-nil, a function to call after reading a JSON array or object.
|
||||
It is called by `json-read-array' and `json-read-object',
|
||||
respectively, with no arguments.")
|
||||
|
||||
|
||||
|
||||
;;; Utilities
|
||||
|
||||
(defun json-join (strings separator)
|
||||
"Join STRINGS with SEPARATOR."
|
||||
(mapconcat 'identity strings separator))
|
||||
(define-obsolete-function-alias 'json-join #'string-join "28.1")
|
||||
|
||||
(defun json-alist-p (list)
|
||||
"Non-null if and only if LIST is an alist with simple keys."
|
||||
(while (consp list)
|
||||
(setq list (if (and (consp (car list))
|
||||
(atom (caar list)))
|
||||
(cdr list)
|
||||
'not-alist)))
|
||||
"Non-nil if and only if LIST is an alist with simple keys."
|
||||
(declare (pure t) (side-effect-free error-free))
|
||||
(while (and (consp (car-safe list))
|
||||
(atom (caar list))
|
||||
(setq list (cdr list))))
|
||||
(null list))
|
||||
|
||||
(defun json-plist-p (list)
|
||||
"Non-null if and only if LIST is a plist with keyword keys."
|
||||
(while (consp list)
|
||||
(setq list (if (and (keywordp (car list))
|
||||
(consp (cdr list)))
|
||||
(cddr list)
|
||||
'not-plist)))
|
||||
"Non-nil if and only if LIST is a plist with keyword keys."
|
||||
(declare (pure t) (side-effect-free error-free))
|
||||
(while (and (keywordp (car-safe list))
|
||||
(consp (cdr list))
|
||||
(setq list (cddr list))))
|
||||
(null list))
|
||||
|
||||
(defun json--plist-reverse (plist)
|
||||
"Return a copy of PLIST in reverse order.
|
||||
Unlike `reverse', this keeps the property-value pairs intact."
|
||||
(let (res)
|
||||
(while plist
|
||||
(let ((prop (pop plist))
|
||||
(val (pop plist)))
|
||||
(push val res)
|
||||
(push prop res)))
|
||||
res))
|
||||
(defun json--plist-nreverse (plist)
|
||||
"Return PLIST in reverse order.
|
||||
Unlike `nreverse', this keeps the ordering of each property
|
||||
relative to its value intact. Like `nreverse', this function may
|
||||
destructively modify PLIST to produce the result."
|
||||
(let (prev (next (cddr plist)))
|
||||
(while next
|
||||
(setcdr (cdr plist) prev)
|
||||
(setq prev plist plist next next (cddr next))
|
||||
(setcdr (cdr plist) prev)))
|
||||
plist)
|
||||
|
||||
(defun json--plist-to-alist (plist)
|
||||
"Return an alist of the property-value pairs in PLIST."
|
||||
(let (res)
|
||||
(while plist
|
||||
(let ((prop (pop plist))
|
||||
(val (pop plist)))
|
||||
(push (cons prop val) res)))
|
||||
(nreverse res)))
|
||||
|
||||
(defmacro json--with-indentation (body)
|
||||
(defmacro json--with-indentation (&rest body)
|
||||
"Evaluate BODY with the correct indentation for JSON encoding.
|
||||
This macro binds `json--encoding-current-indentation' according
|
||||
to `json-encoding-pretty-print' around BODY."
|
||||
(declare (debug t) (indent 0))
|
||||
`(let ((json--encoding-current-indentation
|
||||
(if json-encoding-pretty-print
|
||||
(concat json--encoding-current-indentation
|
||||
json-encoding-default-indentation)
|
||||
"")))
|
||||
,body))
|
||||
,@body))
|
||||
|
||||
;; Reader utilities
|
||||
|
||||
(define-inline json-advance (&optional n)
|
||||
"Advance N characters forward."
|
||||
"Advance N characters forward, or 1 character if N is nil.
|
||||
On reaching the end of the accessible region of the buffer, stop
|
||||
and signal an error."
|
||||
(inline-quote (forward-char ,n)))
|
||||
|
||||
(define-inline json-peek ()
|
||||
"Return the character at point."
|
||||
"Return the character at point.
|
||||
At the end of the accessible region of the buffer, return 0."
|
||||
(inline-quote (following-char)))
|
||||
|
||||
(define-inline json-pop ()
|
||||
"Advance past the character at point, returning it."
|
||||
"Advance past the character at point, returning it.
|
||||
Signal `json-end-of-file' if called at the end of the buffer."
|
||||
(inline-quote
|
||||
(let ((char (json-peek)))
|
||||
(if (zerop char)
|
||||
(signal 'json-end-of-file nil)
|
||||
(json-advance)
|
||||
char))))
|
||||
(prog1 (or (char-after)
|
||||
(signal 'json-end-of-file ()))
|
||||
(json-advance))))
|
||||
|
||||
(define-inline json-skip-whitespace ()
|
||||
"Skip past the whitespace at point."
|
||||
|
|
@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs intact."
|
|||
;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
|
||||
;; or https://tools.ietf.org/html/rfc7159#section-2 for the
|
||||
;; definition of whitespace in JSON.
|
||||
(inline-quote (skip-chars-forward "\t\r\n ")))
|
||||
(inline-quote (skip-chars-forward "\t\n\r ")))
|
||||
|
||||
|
||||
|
||||
|
|
@ -236,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs intact."
|
|||
;;; Paths
|
||||
|
||||
(defvar json--path '()
|
||||
"Used internally by `json-path-to-position' to keep track of
|
||||
the path during recursive calls to `json-read'.")
|
||||
"Keeps track of the path during recursive calls to `json-read'.
|
||||
Used internally by `json-path-to-position'.")
|
||||
|
||||
(defun json--record-path (key)
|
||||
"Record the KEY to the current JSON path.
|
||||
|
|
@ -248,7 +244,7 @@ Used internally by `json-path-to-position'."
|
|||
"Check if the last parsed JSON structure passed POSITION.
|
||||
Used internally by `json-path-to-position'."
|
||||
(let ((start (caar json--path)))
|
||||
(when (< start position (+ (point) 1))
|
||||
(when (< start position (1+ (point)))
|
||||
(throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
|
||||
:match-start start
|
||||
:match-end (point)))))
|
||||
|
|
@ -266,13 +262,13 @@ properties:
|
|||
:path -- A list of strings and numbers forming the path to
|
||||
the JSON element at the given position. Strings
|
||||
denote object names, while numbers denote array
|
||||
indexes.
|
||||
indices.
|
||||
|
||||
:match-start -- Position where the matched JSON element begins.
|
||||
|
||||
:match-end -- Position where the matched JSON element ends.
|
||||
|
||||
This can for instance be useful to determine the path to a JSON
|
||||
This can, for instance, be useful to determine the path to a JSON
|
||||
element in a deeply nested structure."
|
||||
(save-excursion
|
||||
(unless string
|
||||
|
|
@ -280,7 +276,7 @@ element in a deeply nested structure."
|
|||
(let* ((json--path '())
|
||||
(json-pre-element-read-function #'json--record-path)
|
||||
(json-post-element-read-function
|
||||
(apply-partially #'json--check-position position))
|
||||
(lambda () (json--check-position position)))
|
||||
(path (catch :json-path
|
||||
(if string
|
||||
(json-read-from-string string)
|
||||
|
|
@ -290,38 +286,33 @@ element in a deeply nested structure."
|
|||
|
||||
;;; Keywords
|
||||
|
||||
(defvar json-keywords '("true" "false" "null")
|
||||
(defconst json-keywords '("true" "false" "null")
|
||||
"List of JSON keywords.")
|
||||
(make-obsolete-variable 'json-keywords "it is no longer used." "28.1")
|
||||
|
||||
;; Keyword parsing
|
||||
|
||||
;; Characters that can follow a JSON value.
|
||||
(rx-define json--post-value (| (in "\t\n\r ,]}") eos))
|
||||
|
||||
(defun json-read-keyword (keyword)
|
||||
"Read a JSON keyword at point.
|
||||
KEYWORD is the keyword expected."
|
||||
(unless (member keyword json-keywords)
|
||||
(signal 'json-unknown-keyword (list keyword)))
|
||||
(mapc (lambda (char)
|
||||
(when (/= char (json-peek))
|
||||
(signal 'json-unknown-keyword
|
||||
(list (save-excursion
|
||||
(backward-word-strictly 1)
|
||||
(thing-at-point 'word)))))
|
||||
(json-advance))
|
||||
keyword)
|
||||
(json-skip-whitespace)
|
||||
(unless (looking-at "\\([],}]\\|$\\)")
|
||||
(signal 'json-unknown-keyword
|
||||
(list (save-excursion
|
||||
(backward-word-strictly 1)
|
||||
(thing-at-point 'word)))))
|
||||
(cond ((string-equal keyword "true") t)
|
||||
((string-equal keyword "false") json-false)
|
||||
((string-equal keyword "null") json-null)))
|
||||
"Read the expected JSON KEYWORD at point."
|
||||
(prog1 (cond ((equal keyword "true") t)
|
||||
((equal keyword "false") json-false)
|
||||
((equal keyword "null") json-null)
|
||||
(t (signal 'json-unknown-keyword (list keyword))))
|
||||
(or (looking-at-p keyword)
|
||||
(signal 'json-unknown-keyword (list (thing-at-point 'word))))
|
||||
(json-advance (length keyword))
|
||||
(or (looking-at-p (rx json--post-value))
|
||||
(signal 'json-unknown-keyword (list (thing-at-point 'word))))
|
||||
(json-skip-whitespace)))
|
||||
|
||||
;; Keyword encoding
|
||||
|
||||
(defun json-encode-keyword (keyword)
|
||||
"Encode KEYWORD as a JSON value."
|
||||
(declare (side-effect-free t))
|
||||
(cond ((eq keyword t) "true")
|
||||
((eq keyword json-false) "false")
|
||||
((eq keyword json-null) "null")))
|
||||
|
|
@ -330,37 +321,31 @@ KEYWORD is the keyword expected."
|
|||
|
||||
;; Number parsing
|
||||
|
||||
(defun json-read-number (&optional sign)
|
||||
"Read the JSON number following point.
|
||||
The optional SIGN argument is for internal use.
|
||||
(rx-define json--number
|
||||
(: (? ?-) ; Sign.
|
||||
(| (: (in "1-9") (* digit)) ?0) ; Integer.
|
||||
(? ?. (+ digit)) ; Fraction.
|
||||
(? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent.
|
||||
|
||||
N.B.: Only numbers which can fit in Emacs Lisp's native number
|
||||
representation will be parsed correctly."
|
||||
;; If SIGN is non-nil, the number is explicitly signed.
|
||||
(let ((number-regexp
|
||||
"\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
|
||||
(cond ((and (null sign) (= (json-peek) ?-))
|
||||
(json-advance)
|
||||
(- (json-read-number t)))
|
||||
((and (null sign) (= (json-peek) ?+))
|
||||
(json-advance)
|
||||
(json-read-number t))
|
||||
((and (looking-at number-regexp)
|
||||
(or (match-beginning 1)
|
||||
(match-beginning 2)))
|
||||
(goto-char (match-end 0))
|
||||
(string-to-number (match-string 0)))
|
||||
(t (signal 'json-number-format (list (point)))))))
|
||||
(defun json-read-number (&optional _sign)
|
||||
"Read the JSON number following point."
|
||||
(declare (advertised-calling-convention () "28.1"))
|
||||
(or (looking-at (rx json--number))
|
||||
(signal 'json-number-format (list (point))))
|
||||
(goto-char (match-end 0))
|
||||
(prog1 (string-to-number (match-string 0))
|
||||
(or (looking-at-p (rx json--post-value))
|
||||
(signal 'json-number-format (list (point))))
|
||||
(json-skip-whitespace)))
|
||||
|
||||
;; Number encoding
|
||||
|
||||
(defun json-encode-number (number)
|
||||
"Return a JSON representation of NUMBER."
|
||||
(format "%s" number))
|
||||
(defalias 'json-encode-number #'number-to-string
|
||||
"Return a JSON representation of NUMBER.")
|
||||
|
||||
;;; Strings
|
||||
|
||||
(defvar json-special-chars
|
||||
(defconst json-special-chars
|
||||
'((?\" . ?\")
|
||||
(?\\ . ?\\)
|
||||
(?b . ?\b)
|
||||
|
|
@ -368,7 +353,7 @@ representation will be parsed correctly."
|
|||
(?n . ?\n)
|
||||
(?r . ?\r)
|
||||
(?t . ?\t))
|
||||
"Characters which are escaped in JSON, with their elisp counterparts.")
|
||||
"Characters which are escaped in JSON, with their Elisp counterparts.")
|
||||
|
||||
;; String parsing
|
||||
|
||||
|
|
@ -378,48 +363,47 @@ representation will be parsed correctly."
|
|||
|
||||
(defun json-read-escaped-char ()
|
||||
"Read the JSON string escaped character at point."
|
||||
;; Skip over the '\'
|
||||
;; Skip over the '\'.
|
||||
(json-advance)
|
||||
(let* ((char (json-pop))
|
||||
(special (assq char json-special-chars)))
|
||||
(let ((char (json-pop)))
|
||||
(cond
|
||||
(special (cdr special))
|
||||
((not (eq char ?u)) char)
|
||||
((cdr (assq char json-special-chars)))
|
||||
((/= char ?u) char)
|
||||
;; Special-case UTF-16 surrogate pairs,
|
||||
;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that
|
||||
;; this clause overlaps with the next one and therefore has to
|
||||
;; come first.
|
||||
((looking-at
|
||||
(rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
|
||||
"\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
|
||||
(rx (group (any "Dd") (any "89ABab") (= 2 xdigit))
|
||||
"\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit))))
|
||||
(json-advance 10)
|
||||
(json--decode-utf-16-surrogates
|
||||
(string-to-number (match-string 1) 16)
|
||||
(string-to-number (match-string 2) 16)))
|
||||
((looking-at (rx (= 4 xdigit)))
|
||||
(let ((hex (match-string 0)))
|
||||
(json-advance 4)
|
||||
(string-to-number hex 16)))
|
||||
(json-advance 4)
|
||||
(string-to-number (match-string 0) 16))
|
||||
(t
|
||||
(signal 'json-string-escape (list (point)))))))
|
||||
|
||||
(defun json-read-string ()
|
||||
"Read the JSON string at point."
|
||||
(unless (= (json-peek) ?\")
|
||||
(signal 'json-string-format (list "doesn't start with `\"'!")))
|
||||
;; Skip over the '"'
|
||||
;; Skip over the '"'.
|
||||
(json-advance)
|
||||
(let ((characters '())
|
||||
(char (json-peek)))
|
||||
(while (not (= char ?\"))
|
||||
(while (/= char ?\")
|
||||
(when (< char 32)
|
||||
(signal 'json-string-format (list (prin1-char char))))
|
||||
(if (zerop char)
|
||||
(signal 'json-end-of-file ())
|
||||
(signal 'json-string-format (list char))))
|
||||
(push (if (= char ?\\)
|
||||
(json-read-escaped-char)
|
||||
(json-pop))
|
||||
(json-advance)
|
||||
char)
|
||||
characters)
|
||||
(setq char (json-peek)))
|
||||
;; Skip over the '"'
|
||||
;; Skip over the '"'.
|
||||
(json-advance)
|
||||
(if characters
|
||||
(concat (nreverse characters))
|
||||
|
|
@ -427,29 +411,47 @@ representation will be parsed correctly."
|
|||
|
||||
;; String encoding
|
||||
|
||||
;; Escape only quotation mark, backslash, and the control
|
||||
;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
|
||||
(rx-define json--escape (in ?\" ?\\ cntrl))
|
||||
|
||||
(defvar json--long-string-threshold 200
|
||||
"Length above which strings are considered long for JSON encoding.
|
||||
It is generally faster to manipulate such strings in a buffer
|
||||
rather than directly.")
|
||||
|
||||
(defvar json--string-buffer nil
|
||||
"Buffer used for encoding Lisp strings as JSON.
|
||||
Initialized lazily by `json-encode-string'.")
|
||||
|
||||
(defun json-encode-string (string)
|
||||
"Return a JSON representation of STRING."
|
||||
;; Reimplement the meat of `replace-regexp-in-string', for
|
||||
;; performance (bug#20154).
|
||||
(let ((l (length string))
|
||||
(start 0)
|
||||
res mb)
|
||||
;; Only escape quotation mark, backslash and the control
|
||||
;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
|
||||
(while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
|
||||
(let* ((c (aref string mb))
|
||||
(special (rassq c json-special-chars)))
|
||||
(push (substring string start mb) res)
|
||||
(push (if special
|
||||
;; Special JSON character (\n, \r, etc.).
|
||||
(string ?\\ (car special))
|
||||
;; Fallback: UCS code point in \uNNNN form.
|
||||
(format "\\u%04x" c))
|
||||
res)
|
||||
(setq start (1+ mb))))
|
||||
(push (substring string start l) res)
|
||||
(push "\"" res)
|
||||
(apply #'concat "\"" (nreverse res))))
|
||||
;; Try to avoid buffer overhead in trivial cases, while also
|
||||
;; avoiding searching pathological strings for escape characters.
|
||||
;; Since `string-match-p' doesn't take a LIMIT argument, we use
|
||||
;; string length as our heuristic. See also bug#20154.
|
||||
(if (and (< (length string) json--long-string-threshold)
|
||||
(not (string-match-p (rx json--escape) string)))
|
||||
(concat "\"" string "\"")
|
||||
(with-current-buffer
|
||||
(or json--string-buffer
|
||||
(with-current-buffer (generate-new-buffer " *json-string*")
|
||||
;; This seems to afford decent performance gains.
|
||||
(setq-local inhibit-modification-hooks t)
|
||||
(setq json--string-buffer (current-buffer))))
|
||||
(insert ?\" string)
|
||||
(goto-char (1+ (point-min)))
|
||||
(while (re-search-forward (rx json--escape) nil 'move)
|
||||
(let ((char (preceding-char)))
|
||||
(delete-char -1)
|
||||
(insert ?\\ (or
|
||||
;; Special JSON character (\n, \r, etc.).
|
||||
(car (rassq char json-special-chars))
|
||||
;; Fallback: UCS code point in \uNNNN form.
|
||||
(format "u%04x" char)))))
|
||||
(insert ?\")
|
||||
;; Empty buffer for next invocation.
|
||||
(delete-and-extract-region (point-min) (point-max)))))
|
||||
|
||||
(defun json-encode-key (object)
|
||||
"Return a JSON representation of OBJECT.
|
||||
|
|
@ -460,15 +462,13 @@ this signals `json-key-format'."
|
|||
(signal 'json-key-format (list object)))
|
||||
encoded))
|
||||
|
||||
;;; JSON Objects
|
||||
;;; Objects
|
||||
|
||||
(defun json-new-object ()
|
||||
"Create a new Elisp object corresponding to a JSON object.
|
||||
"Create a new Elisp object corresponding to an empty JSON object.
|
||||
Please see the documentation of `json-object-type'."
|
||||
(cond ((eq json-object-type 'hash-table)
|
||||
(make-hash-table :test 'equal))
|
||||
(t
|
||||
())))
|
||||
(and (eq json-object-type 'hash-table)
|
||||
(make-hash-table :test #'equal)))
|
||||
|
||||
(defun json-add-to-object (object key value)
|
||||
"Add a new KEY -> VALUE association to OBJECT.
|
||||
|
|
@ -476,10 +476,10 @@ Returns the updated object, which you should save, e.g.:
|
|||
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
|
||||
Please see the documentation of `json-object-type' and `json-key-type'."
|
||||
(let ((json-key-type
|
||||
(or json-key-type
|
||||
(cdr (assq json-object-type '((hash-table . string)
|
||||
(alist . symbol)
|
||||
(plist . keyword)))))))
|
||||
(cond (json-key-type)
|
||||
((eq json-object-type 'hash-table) 'string)
|
||||
((eq json-object-type 'alist) 'symbol)
|
||||
((eq json-object-type 'plist) 'keyword))))
|
||||
(setq key
|
||||
(cond ((eq json-key-type 'string)
|
||||
key)
|
||||
|
|
@ -499,13 +499,13 @@ Please see the documentation of `json-object-type' and `json-key-type'."
|
|||
|
||||
(defun json-read-object ()
|
||||
"Read the JSON object at point."
|
||||
;; Skip over the "{"
|
||||
;; Skip over the '{'.
|
||||
(json-advance)
|
||||
(json-skip-whitespace)
|
||||
;; read key/value pairs until "}"
|
||||
;; Read key/value pairs until '}'.
|
||||
(let ((elements (json-new-object))
|
||||
key value)
|
||||
(while (not (= (json-peek) ?}))
|
||||
(while (/= (json-peek) ?\})
|
||||
(json-skip-whitespace)
|
||||
(setq key (json-read-string))
|
||||
(json-skip-whitespace)
|
||||
|
|
@ -520,94 +520,94 @@ Please see the documentation of `json-object-type' and `json-key-type'."
|
|||
(funcall json-post-element-read-function))
|
||||
(setq elements (json-add-to-object elements key value))
|
||||
(json-skip-whitespace)
|
||||
(when (/= (json-peek) ?})
|
||||
(when (/= (json-peek) ?\})
|
||||
(if (= (json-peek) ?,)
|
||||
(json-advance)
|
||||
(signal 'json-object-format (list "," (json-peek))))))
|
||||
;; Skip over the "}"
|
||||
;; Skip over the '}'.
|
||||
(json-advance)
|
||||
(pcase json-object-type
|
||||
('alist (nreverse elements))
|
||||
('plist (json--plist-reverse elements))
|
||||
('plist (json--plist-nreverse elements))
|
||||
(_ elements))))
|
||||
|
||||
;; Hash table encoding
|
||||
|
||||
(defun json-encode-hash-table (hash-table)
|
||||
"Return a JSON representation of HASH-TABLE."
|
||||
(if json-encoding-object-sort-predicate
|
||||
(json-encode-alist (map-into hash-table 'list))
|
||||
(format "{%s%s}"
|
||||
(json-join
|
||||
(let (r)
|
||||
(json--with-indentation
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(push (format
|
||||
(if json-encoding-pretty-print
|
||||
"%s%s: %s"
|
||||
"%s%s:%s")
|
||||
json--encoding-current-indentation
|
||||
(json-encode-key k)
|
||||
(json-encode v))
|
||||
r))
|
||||
hash-table))
|
||||
r)
|
||||
json-encoding-separator)
|
||||
(if (or (not json-encoding-pretty-print)
|
||||
json-encoding-lisp-style-closings)
|
||||
""
|
||||
json--encoding-current-indentation))))
|
||||
(cond ((hash-table-empty-p hash-table) "{}")
|
||||
(json-encoding-object-sort-predicate
|
||||
(json--encode-alist (map-pairs hash-table) t))
|
||||
(t
|
||||
(let ((kv-sep (if json-encoding-pretty-print ": " ":"))
|
||||
result)
|
||||
(json--with-indentation
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(push (concat json--encoding-current-indentation
|
||||
(json-encode-key k)
|
||||
kv-sep
|
||||
(json-encode v))
|
||||
result))
|
||||
hash-table))
|
||||
(concat "{"
|
||||
(string-join (nreverse result) json-encoding-separator)
|
||||
(and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings)
|
||||
json--encoding-current-indentation)
|
||||
"}")))))
|
||||
|
||||
;; List encoding (including alists and plists)
|
||||
|
||||
(defun json-encode-alist (alist)
|
||||
"Return a JSON representation of ALIST."
|
||||
(defun json--encode-alist (alist &optional destructive)
|
||||
"Return a JSON representation of ALIST.
|
||||
DESTRUCTIVE non-nil means it is safe to modify ALIST by
|
||||
side-effects."
|
||||
(when json-encoding-object-sort-predicate
|
||||
(setq alist
|
||||
(sort alist (lambda (a b)
|
||||
(setq alist (sort (if destructive alist (copy-sequence alist))
|
||||
(lambda (a b)
|
||||
(funcall json-encoding-object-sort-predicate
|
||||
(car a) (car b))))))
|
||||
(format "{%s%s}"
|
||||
(json-join
|
||||
(json--with-indentation
|
||||
(mapcar (lambda (cons)
|
||||
(format (if json-encoding-pretty-print
|
||||
"%s%s: %s"
|
||||
"%s%s:%s")
|
||||
json--encoding-current-indentation
|
||||
(json-encode-key (car cons))
|
||||
(json-encode (cdr cons))))
|
||||
alist))
|
||||
json-encoding-separator)
|
||||
(if (or (not json-encoding-pretty-print)
|
||||
json-encoding-lisp-style-closings)
|
||||
""
|
||||
json--encoding-current-indentation)))
|
||||
(concat "{"
|
||||
(let ((kv-sep (if json-encoding-pretty-print ": " ":")))
|
||||
(json--with-indentation
|
||||
(mapconcat (lambda (cons)
|
||||
(concat json--encoding-current-indentation
|
||||
(json-encode-key (car cons))
|
||||
kv-sep
|
||||
(json-encode (cdr cons))))
|
||||
alist
|
||||
json-encoding-separator)))
|
||||
(and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings)
|
||||
json--encoding-current-indentation)
|
||||
"}"))
|
||||
|
||||
(defun json-encode-alist (alist)
|
||||
"Return a JSON representation of ALIST."
|
||||
(if alist (json--encode-alist alist) "{}"))
|
||||
|
||||
(defun json-encode-plist (plist)
|
||||
"Return a JSON representation of PLIST."
|
||||
(if json-encoding-object-sort-predicate
|
||||
(json-encode-alist (json--plist-to-alist plist))
|
||||
(let (result)
|
||||
(json--with-indentation
|
||||
(while plist
|
||||
(push (concat
|
||||
json--encoding-current-indentation
|
||||
(json-encode-key (car plist))
|
||||
(if json-encoding-pretty-print
|
||||
": "
|
||||
":")
|
||||
(json-encode (cadr plist)))
|
||||
(cond ((null plist) "{}")
|
||||
(json-encoding-object-sort-predicate
|
||||
(json--encode-alist (map-pairs plist) t))
|
||||
(t
|
||||
(let ((kv-sep (if json-encoding-pretty-print ": " ":"))
|
||||
result)
|
||||
(setq plist (cddr plist))))
|
||||
(concat "{"
|
||||
(json-join (nreverse result) json-encoding-separator)
|
||||
(if (and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings))
|
||||
json--encoding-current-indentation
|
||||
"")
|
||||
"}"))))
|
||||
(json--with-indentation
|
||||
(while plist
|
||||
(push (concat json--encoding-current-indentation
|
||||
(json-encode-key (pop plist))
|
||||
kv-sep
|
||||
(json-encode (pop plist)))
|
||||
result)))
|
||||
(concat "{"
|
||||
(string-join (nreverse result) json-encoding-separator)
|
||||
(and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings)
|
||||
json--encoding-current-indentation)
|
||||
"}")))))
|
||||
|
||||
(defun json-encode-list (list)
|
||||
"Return a JSON representation of LIST.
|
||||
|
|
@ -625,15 +625,17 @@ become JSON objects."
|
|||
|
||||
(defun json-read-array ()
|
||||
"Read the JSON array at point."
|
||||
;; Skip over the "["
|
||||
;; Skip over the '['.
|
||||
(json-advance)
|
||||
(json-skip-whitespace)
|
||||
;; read values until "]"
|
||||
(let (elements)
|
||||
(while (not (= (json-peek) ?\]))
|
||||
;; Read values until ']'.
|
||||
(let (elements
|
||||
(len 0))
|
||||
(while (/= (json-peek) ?\])
|
||||
(json-skip-whitespace)
|
||||
(when json-pre-element-read-function
|
||||
(funcall json-pre-element-read-function (length elements)))
|
||||
(funcall json-pre-element-read-function len)
|
||||
(setq len (1+ len)))
|
||||
(push (json-read) elements)
|
||||
(when json-post-element-read-function
|
||||
(funcall json-post-element-read-function))
|
||||
|
|
@ -641,8 +643,8 @@ become JSON objects."
|
|||
(when (/= (json-peek) ?\])
|
||||
(if (= (json-peek) ?,)
|
||||
(json-advance)
|
||||
(signal 'json-array-format (list ?, (json-peek))))))
|
||||
;; Skip over the "]"
|
||||
(signal 'json-array-format (list "," (json-peek))))))
|
||||
;; Skip over the ']'.
|
||||
(json-advance)
|
||||
(pcase json-array-type
|
||||
('vector (nreverse (vconcat elements)))
|
||||
|
|
@ -653,42 +655,43 @@ become JSON objects."
|
|||
(defun json-encode-array (array)
|
||||
"Return a JSON representation of ARRAY."
|
||||
(if (and json-encoding-pretty-print
|
||||
(> (length array) 0))
|
||||
(not (seq-empty-p array)))
|
||||
(concat
|
||||
"["
|
||||
(json--with-indentation
|
||||
(concat (format "[%s" json--encoding-current-indentation)
|
||||
(json-join (mapcar 'json-encode array)
|
||||
(format "%s%s"
|
||||
json-encoding-separator
|
||||
(concat json--encoding-current-indentation
|
||||
(mapconcat #'json-encode array
|
||||
(concat json-encoding-separator
|
||||
json--encoding-current-indentation))))
|
||||
(format "%s]"
|
||||
(if json-encoding-lisp-style-closings
|
||||
""
|
||||
json--encoding-current-indentation)))
|
||||
(unless json-encoding-lisp-style-closings
|
||||
json--encoding-current-indentation)
|
||||
"]")
|
||||
(concat "["
|
||||
(mapconcat 'json-encode array json-encoding-separator)
|
||||
(mapconcat #'json-encode array json-encoding-separator)
|
||||
"]")))
|
||||
|
||||
|
||||
|
||||
;;; JSON reader.
|
||||
;;; Reader
|
||||
|
||||
(defmacro json-readtable-dispatch (char)
|
||||
"Dispatch reader function for CHAR."
|
||||
(declare (debug (symbolp)))
|
||||
(let ((table
|
||||
'((?t json-read-keyword "true")
|
||||
(?f json-read-keyword "false")
|
||||
(?n json-read-keyword "null")
|
||||
(?{ json-read-object)
|
||||
(?\[ json-read-array)
|
||||
(?\" json-read-string)))
|
||||
res)
|
||||
(dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
|
||||
(push (list c 'json-read-number) table))
|
||||
(pcase-dolist (`(,c . ,rest) table)
|
||||
(push `((eq ,char ,c) (,@rest)) res))
|
||||
`(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
|
||||
"Dispatch reader function for CHAR at point.
|
||||
If CHAR is nil, signal `json-end-of-file'."
|
||||
(declare (debug t))
|
||||
(macroexp-let2 nil char char
|
||||
`(cond ,@(map-apply
|
||||
(lambda (key expr)
|
||||
`((eq ,char ,key) ,expr))
|
||||
`((?\" ,#'json-read-string)
|
||||
(?\[ ,#'json-read-array)
|
||||
(?\{ ,#'json-read-object)
|
||||
(?n ,#'json-read-keyword "null")
|
||||
(?f ,#'json-read-keyword "false")
|
||||
(?t ,#'json-read-keyword "true")
|
||||
,@(mapcar (lambda (c) (list c #'json-read-number))
|
||||
'(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))
|
||||
(,char (signal 'json-readtable-error (list ,char)))
|
||||
(t (signal 'json-end-of-file ())))))
|
||||
|
||||
(defun json-read ()
|
||||
"Parse and return the JSON object following point.
|
||||
|
|
@ -706,10 +709,7 @@ you will get the following structure returned:
|
|||
((c . :json-false))])
|
||||
(b . \"foo\"))"
|
||||
(json-skip-whitespace)
|
||||
(let ((char (json-peek)))
|
||||
(if (zerop char)
|
||||
(signal 'json-end-of-file nil)
|
||||
(json-readtable-dispatch char))))
|
||||
(json-readtable-dispatch (char-after)))
|
||||
|
||||
;; Syntactic sugar for the reader
|
||||
|
||||
|
|
@ -724,12 +724,11 @@ you will get the following structure returned:
|
|||
"Read the first JSON object contained in FILE and return it."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(goto-char (point-min))
|
||||
(json-read)))
|
||||
|
||||
|
||||
|
||||
;;; JSON encoder
|
||||
;;; Encoder
|
||||
|
||||
(defun json-encode (object)
|
||||
"Return a JSON representation of OBJECT as a string.
|
||||
|
|
@ -737,20 +736,21 @@ you will get the following structure returned:
|
|||
OBJECT should have a structure like one returned by `json-read'.
|
||||
If an error is detected during encoding, an error based on
|
||||
`json-error' is signaled."
|
||||
(cond ((memq object (list t json-null json-false))
|
||||
(json-encode-keyword object))
|
||||
((stringp object) (json-encode-string object))
|
||||
((keywordp object) (json-encode-string
|
||||
(substring (symbol-name object) 1)))
|
||||
((listp object) (json-encode-list object))
|
||||
((symbolp object) (json-encode-string
|
||||
(symbol-name object)))
|
||||
((numberp object) (json-encode-number object))
|
||||
((arrayp object) (json-encode-array object))
|
||||
((hash-table-p object) (json-encode-hash-table object))
|
||||
(t (signal 'json-error (list object)))))
|
||||
(cond ((eq object t) (json-encode-keyword object))
|
||||
((eq object json-null) (json-encode-keyword object))
|
||||
((eq object json-false) (json-encode-keyword object))
|
||||
((stringp object) (json-encode-string object))
|
||||
((keywordp object) (json-encode-string
|
||||
(substring (symbol-name object) 1)))
|
||||
((listp object) (json-encode-list object))
|
||||
((symbolp object) (json-encode-string
|
||||
(symbol-name object)))
|
||||
((numberp object) (json-encode-number object))
|
||||
((arrayp object) (json-encode-array object))
|
||||
((hash-table-p object) (json-encode-hash-table object))
|
||||
(t (signal 'json-error (list object)))))
|
||||
|
||||
;; Pretty printing & minimizing
|
||||
;;; Pretty printing & minimizing
|
||||
|
||||
(defun json-pretty-print-buffer (&optional minimize)
|
||||
"Pretty-print current buffer.
|
||||
|
|
@ -769,9 +769,9 @@ MAX-SECS.")
|
|||
With prefix argument MINIMIZE, minimize it instead."
|
||||
(interactive "r\nP")
|
||||
(let ((json-encoding-pretty-print (null minimize))
|
||||
;; Distinguish an empty objects from 'null'
|
||||
;; Distinguish an empty object from 'null'.
|
||||
(json-null :json-null)
|
||||
;; Ensure that ordering is maintained
|
||||
;; Ensure that ordering is maintained.
|
||||
(json-object-type 'alist)
|
||||
(orig-buf (current-buffer))
|
||||
error)
|
||||
|
|
@ -800,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead."
|
|||
;; them.
|
||||
(let ((space (buffer-substring
|
||||
(point)
|
||||
(+ (point)
|
||||
(skip-chars-forward
|
||||
" \t\n" (point-max)))))
|
||||
(+ (point) (skip-chars-forward " \t\n"))))
|
||||
(json (json-read)))
|
||||
(setq pos (point)) ; End of last good json-read.
|
||||
(set-buffer tmp-buf)
|
||||
|
|
@ -832,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead."
|
|||
"Pretty-print current buffer with object keys ordered.
|
||||
With prefix argument MINIMIZE, minimize it instead."
|
||||
(interactive "P")
|
||||
(let ((json-encoding-object-sort-predicate 'string<))
|
||||
(let ((json-encoding-object-sort-predicate #'string<))
|
||||
(json-pretty-print-buffer minimize)))
|
||||
|
||||
(defun json-pretty-print-ordered (begin end &optional minimize)
|
||||
"Pretty-print the region with object keys ordered.
|
||||
With prefix argument MINIMIZE, minimize it instead."
|
||||
(interactive "r\nP")
|
||||
(let ((json-encoding-object-sort-predicate 'string<))
|
||||
(let ((json-encoding-object-sort-predicate #'string<))
|
||||
(json-pretty-print begin end minimize)))
|
||||
|
||||
(provide 'json)
|
||||
|
|
|
|||
|
|
@ -37,7 +37,6 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'json)
|
||||
(require 'eieio)
|
||||
(eval-when-compile (require 'subr-x))
|
||||
(require 'warnings)
|
||||
|
|
@ -470,26 +469,35 @@ With optional CLEANUP, kill any associated buffers."
|
|||
;;;
|
||||
(define-error 'jsonrpc-error "jsonrpc-error")
|
||||
|
||||
(defun jsonrpc--json-read ()
|
||||
"Read JSON object in buffer, move point to end of buffer."
|
||||
;; TODO: I guess we can make these macros if/when jsonrpc.el
|
||||
;; goes into Emacs core.
|
||||
(cond ((fboundp 'json-parse-buffer) (json-parse-buffer
|
||||
:object-type 'plist
|
||||
:null-object nil
|
||||
:false-object :json-false))
|
||||
(t (let ((json-object-type 'plist))
|
||||
(json-read)))))
|
||||
(defalias 'jsonrpc--json-read
|
||||
(if (fboundp 'json-parse-buffer)
|
||||
(lambda ()
|
||||
(json-parse-buffer :object-type 'plist
|
||||
:null-object nil
|
||||
:false-object :json-false))
|
||||
(require 'json)
|
||||
(defvar json-object-type)
|
||||
(declare-function json-read "json" ())
|
||||
(lambda ()
|
||||
(let ((json-object-type 'plist))
|
||||
(json-read))))
|
||||
"Read JSON object in buffer, move point to end of buffer.")
|
||||
|
||||
(defun jsonrpc--json-encode (object)
|
||||
"Encode OBJECT into a JSON string."
|
||||
(cond ((fboundp 'json-serialize) (json-serialize
|
||||
object
|
||||
:false-object :json-false
|
||||
:null-object nil))
|
||||
(t (let ((json-false :json-false)
|
||||
(json-null nil))
|
||||
(json-encode object)))))
|
||||
(defalias 'jsonrpc--json-encode
|
||||
(if (fboundp 'json-serialize)
|
||||
(lambda (object)
|
||||
(json-serialize object
|
||||
:false-object :json-false
|
||||
:null-object nil))
|
||||
(require 'json)
|
||||
(defvar json-false)
|
||||
(defvar json-null)
|
||||
(declare-function json-encode "json" (object))
|
||||
(lambda (object)
|
||||
(let ((json-false :json-false)
|
||||
(json-null nil))
|
||||
(json-encode object))))
|
||||
"Encode OBJECT into a JSON string.")
|
||||
|
||||
(cl-defun jsonrpc--reply
|
||||
(connection id &key (result nil result-supplied-p) (error nil error-supplied-p))
|
||||
|
|
|
|||
|
|
@ -43,13 +43,17 @@
|
|||
("་" . "་")
|
||||
("༔" . "༔")
|
||||
;; Yes these are dirty. But ...
|
||||
("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
|
||||
("༎ ༎" . ,(compose-string (copy-sequence "༎ ༎")
|
||||
0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
|
||||
("༄༅༅" . ,(compose-string
|
||||
"࿁࿂࿂࿂" 0 4
|
||||
(copy-sequence "࿁࿂࿂࿂") 0 4
|
||||
[?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
|
||||
("༄༅" . ,(compose-string "࿁࿂࿂" 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
|
||||
("༆" . ,(compose-string "࿁࿂༙" 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
|
||||
("༄" . ,(compose-string "࿁࿂" 0 2 [?࿁ (Br . Bl) ?࿂]))))
|
||||
("༄༅" . ,(compose-string (copy-sequence "࿁࿂࿂")
|
||||
0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
|
||||
("༆" . ,(compose-string (copy-sequence "࿁࿂༙")
|
||||
0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
|
||||
("༄" . ,(compose-string (copy-sequence "࿁࿂")
|
||||
0 2 [?࿁ (Br . Bl) ?࿂]))))
|
||||
|
||||
;;;###autoload
|
||||
(defun tibetan-char-p (ch)
|
||||
|
|
|
|||
|
|
@ -2580,7 +2580,7 @@ in a tooltip."
|
|||
:type '(choice
|
||||
(const :tag "Do not show tooltips" nil)
|
||||
(const :tag "Show all text" t)
|
||||
(integer :tag "Show characters (max)" 256))
|
||||
(integer :tag "Max number of characters to show" 256))
|
||||
:version "26.1")
|
||||
|
||||
(defcustom mouse-drag-and-drop-region-show-cursor t
|
||||
|
|
|
|||
|
|
@ -307,10 +307,10 @@ the default EWW buffer."
|
|||
(insert (format "Loading %s..." url))
|
||||
(goto-char (point-min)))
|
||||
(let ((url-mime-accept-string eww-accept-content-types))
|
||||
(url-retrieve url 'eww-render
|
||||
(url-retrieve url #'eww-render
|
||||
(list url nil (current-buffer)))))
|
||||
|
||||
(put 'eww 'browse-url-browser-kind 'internal)
|
||||
(function-put 'eww 'browse-url-browser-kind 'internal)
|
||||
|
||||
(defun eww--dwim-expand-url (url)
|
||||
(setq url (string-trim url))
|
||||
|
|
@ -375,8 +375,8 @@ engine used."
|
|||
(let ((region-string (buffer-substring (region-beginning) (region-end))))
|
||||
(if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
|
||||
(eww region-string)
|
||||
(call-interactively 'eww)))
|
||||
(call-interactively 'eww)))
|
||||
(call-interactively #'eww)))
|
||||
(call-interactively #'eww)))
|
||||
|
||||
(defun eww-open-in-new-buffer ()
|
||||
"Fetch link at point in a new EWW buffer."
|
||||
|
|
@ -1013,7 +1013,7 @@ just re-display the HTML already fetched."
|
|||
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
|
||||
(point) (current-buffer)))
|
||||
(let ((url-mime-accept-string eww-accept-content-types))
|
||||
(url-retrieve url 'eww-render
|
||||
(url-retrieve url #'eww-render
|
||||
(list url (point) (current-buffer) encode))))))
|
||||
|
||||
;; Form support.
|
||||
|
|
@ -1576,8 +1576,10 @@ If EXTERNAL is double prefix, browse in new buffer."
|
|||
(cond
|
||||
((not url)
|
||||
(message "No link under point"))
|
||||
((string-match "^mailto:" url)
|
||||
(browse-url-mail url))
|
||||
((string-match-p "\\`mailto:" url)
|
||||
;; This respects the user options `browse-url-handlers'
|
||||
;; and `browse-url-mailto-function'.
|
||||
(browse-url url))
|
||||
((and (consp external) (<= (car external) 4))
|
||||
(funcall browse-url-secondary-browser-function url)
|
||||
(shr--blink-link))
|
||||
|
|
@ -1615,7 +1617,7 @@ Use link at point if there is one, else the current page's URL."
|
|||
(eww-current-url))))
|
||||
(if (not url)
|
||||
(message "No URL under point")
|
||||
(url-retrieve url 'eww-download-callback (list url)))))
|
||||
(url-retrieve url #'eww-download-callback (list url)))))
|
||||
|
||||
(defun eww-download-callback (status url)
|
||||
(unless (plist-get status :error)
|
||||
|
|
@ -2128,12 +2130,12 @@ entries (if any) will be removed from the list.
|
|||
Only the properties listed in `eww-desktop-data-save' are included.
|
||||
Generally, the list should not include the (usually overly large)
|
||||
:dom, :source and :text properties."
|
||||
(let ((history (mapcar 'eww-desktop-data-1
|
||||
(cons eww-data eww-history))))
|
||||
(list :history (if eww-desktop-remove-duplicates
|
||||
(cl-remove-duplicates
|
||||
history :test 'eww-desktop-history-duplicate)
|
||||
history))))
|
||||
(let ((history (mapcar #'eww-desktop-data-1
|
||||
(cons eww-data eww-history))))
|
||||
(list :history (if eww-desktop-remove-duplicates
|
||||
(cl-remove-duplicates
|
||||
history :test #'eww-desktop-history-duplicate)
|
||||
history))))
|
||||
|
||||
(defun eww-restore-desktop (file-name buffer-name misc-data)
|
||||
"Restore an eww buffer from its desktop file record.
|
||||
|
|
|
|||
|
|
@ -135,7 +135,7 @@ same domain as the main data."
|
|||
This is used for cid: URLs, and the function is called with the
|
||||
cid: URL as the argument.")
|
||||
|
||||
(defvar shr-put-image-function 'shr-put-image
|
||||
(defvar shr-put-image-function #'shr-put-image
|
||||
"Function called to put image and alt string.")
|
||||
|
||||
(defface shr-strike-through '((t :strike-through t))
|
||||
|
|
@ -365,25 +365,20 @@ If the URL is already at the front of the kill ring act like
|
|||
(shr-copy-url url)))
|
||||
|
||||
(defun shr--current-link-region ()
|
||||
(let ((current (get-text-property (point) 'shr-url))
|
||||
start)
|
||||
(save-excursion
|
||||
;; Go to the beginning.
|
||||
(while (and (not (bobp))
|
||||
(equal (get-text-property (point) 'shr-url) current))
|
||||
(forward-char -1))
|
||||
(unless (equal (get-text-property (point) 'shr-url) current)
|
||||
(forward-char 1))
|
||||
(setq start (point))
|
||||
;; Go to the end.
|
||||
(while (and (not (eobp))
|
||||
(equal (get-text-property (point) 'shr-url) current))
|
||||
(forward-char 1))
|
||||
(list start (point)))))
|
||||
"Return the start and end positions of the URL at point, if any.
|
||||
Value is a pair of positions (START . END) if there is a non-nil
|
||||
`shr-url' text property at point; otherwise nil."
|
||||
(when (get-text-property (point) 'shr-url)
|
||||
(let* ((end (or (next-single-property-change (point) 'shr-url)
|
||||
(point-max)))
|
||||
(beg (or (previous-single-property-change end 'shr-url)
|
||||
(point-min))))
|
||||
(cons beg end))))
|
||||
|
||||
(defun shr--blink-link ()
|
||||
(let* ((region (shr--current-link-region))
|
||||
(overlay (make-overlay (car region) (cadr region))))
|
||||
"Briefly fontify URL at point with the face `shr-selected-link'."
|
||||
(when-let* ((region (shr--current-link-region))
|
||||
(overlay (make-overlay (car region) (cdr region))))
|
||||
(overlay-put overlay 'face 'shr-selected-link)
|
||||
(run-at-time 1 nil (lambda ()
|
||||
(delete-overlay overlay)))))
|
||||
|
|
@ -437,7 +432,7 @@ the URL of the image to the kill buffer instead."
|
|||
(if (not url)
|
||||
(message "No image under point")
|
||||
(message "Inserting %s..." url)
|
||||
(url-retrieve url 'shr-image-fetched
|
||||
(url-retrieve url #'shr-image-fetched
|
||||
(list (current-buffer) (1- (point)) (point-marker))
|
||||
t))))
|
||||
|
||||
|
|
@ -463,7 +458,7 @@ size, and full-buffer size."
|
|||
(when (> (- (point) start) 2)
|
||||
(delete-region start (1- (point)))))
|
||||
(message "Inserting %s..." url)
|
||||
(url-retrieve url 'shr-image-fetched
|
||||
(url-retrieve url #'shr-image-fetched
|
||||
(list (current-buffer) (1- (point)) (point-marker)
|
||||
(list (cons 'size
|
||||
(cond ((or (eq size 'default)
|
||||
|
|
@ -493,7 +488,7 @@ size, and full-buffer size."
|
|||
((fboundp function)
|
||||
(apply function dom args))
|
||||
(t
|
||||
(apply 'shr-generic dom args)))))
|
||||
(apply #'shr-generic dom args)))))
|
||||
|
||||
(defun shr-descend (dom)
|
||||
(let ((function
|
||||
|
|
@ -730,9 +725,10 @@ size, and full-buffer size."
|
|||
(let ((gap-start (point))
|
||||
(face (get-text-property (point) 'face)))
|
||||
;; Extend the background to the end of the line.
|
||||
(if face
|
||||
(insert (propertize "\n" 'face (shr-face-background face)))
|
||||
(insert "\n"))
|
||||
(insert ?\n)
|
||||
(when face
|
||||
(put-text-property (1- (point)) (point)
|
||||
'face (shr-face-background face)))
|
||||
(shr-indent)
|
||||
(when (and (> (1- gap-start) (point-min))
|
||||
(get-text-property (point) 'shr-url)
|
||||
|
|
@ -935,12 +931,11 @@ size, and full-buffer size."
|
|||
|
||||
(defun shr-indent ()
|
||||
(when (> shr-indentation 0)
|
||||
(insert
|
||||
(if (not shr-use-fonts)
|
||||
(make-string shr-indentation ?\s)
|
||||
(propertize " "
|
||||
'display
|
||||
`(space :width (,shr-indentation)))))))
|
||||
(if (not shr-use-fonts)
|
||||
(insert-char ?\s shr-indentation)
|
||||
(insert ?\s)
|
||||
(put-text-property (1- (point)) (point)
|
||||
'display `(space :width (,shr-indentation))))))
|
||||
|
||||
(defun shr-fontize-dom (dom &rest types)
|
||||
(let ((start (point)))
|
||||
|
|
@ -987,16 +982,11 @@ the mouse click event."
|
|||
(cond
|
||||
((not url)
|
||||
(message "No link under point"))
|
||||
((string-match "^mailto:" url)
|
||||
(browse-url-mail url))
|
||||
(external
|
||||
(funcall browse-url-secondary-browser-function url)
|
||||
(shr--blink-link))
|
||||
(t
|
||||
(if external
|
||||
(progn
|
||||
(funcall browse-url-secondary-browser-function url)
|
||||
(shr--blink-link))
|
||||
(browse-url url (if new-window
|
||||
(not browse-url-new-window-flag)
|
||||
browse-url-new-window-flag)))))))
|
||||
(browse-url url (xor new-window browse-url-new-window-flag))))))
|
||||
|
||||
(defun shr-save-contents (directory)
|
||||
"Save the contents from URL in a file."
|
||||
|
|
@ -1005,7 +995,7 @@ the mouse click event."
|
|||
(if (not url)
|
||||
(message "No link under point")
|
||||
(url-retrieve (shr-encode-url url)
|
||||
'shr-store-contents (list url directory)))))
|
||||
#'shr-store-contents (list url directory)))))
|
||||
|
||||
(defun shr-store-contents (status url directory)
|
||||
(unless (plist-get status :error)
|
||||
|
|
@ -1156,7 +1146,6 @@ width/height instead."
|
|||
|
||||
;; url-cache-extract autoloads url-cache.
|
||||
(declare-function url-cache-create-filename "url-cache" (url))
|
||||
(autoload 'browse-url-mail "browse-url")
|
||||
|
||||
(defun shr-get-image-data (url)
|
||||
"Get image data for URL.
|
||||
|
|
@ -1230,7 +1219,7 @@ START, and END. Note that START and END should be markers."
|
|||
(funcall shr-put-image-function
|
||||
image (buffer-substring start end))
|
||||
(delete-region (point) end))))
|
||||
(url-retrieve url 'shr-image-fetched
|
||||
(url-retrieve url #'shr-image-fetched
|
||||
(list (current-buffer) start end)
|
||||
t t)))))
|
||||
|
||||
|
|
@ -1679,7 +1668,7 @@ The preference is a float determined from `shr-prefer-media-type'."
|
|||
(or alt "")))
|
||||
(insert " ")
|
||||
(url-queue-retrieve
|
||||
(shr-encode-url url) 'shr-image-fetched
|
||||
(shr-encode-url url) #'shr-image-fetched
|
||||
(list (current-buffer) start (set-marker (make-marker) (point))
|
||||
(list :width width :height height))
|
||||
t
|
||||
|
|
@ -2006,12 +1995,11 @@ BASE is the URL of the HTML being rendered."
|
|||
(cond
|
||||
((null tbodies)
|
||||
dom)
|
||||
((= (length tbodies) 1)
|
||||
((null (cdr tbodies))
|
||||
(car tbodies))
|
||||
(t
|
||||
;; Table with multiple tbodies. Convert into a single tbody.
|
||||
`(tbody nil ,@(cl-reduce 'append
|
||||
(mapcar 'dom-non-text-children tbodies)))))))
|
||||
`(tbody nil ,@(mapcan #'dom-non-text-children tbodies))))))
|
||||
|
||||
(defun shr--fix-tbody (tbody)
|
||||
(nconc (list 'tbody (dom-attributes tbody))
|
||||
|
|
@ -2311,8 +2299,8 @@ flags that control whether to collect or render objects."
|
|||
(dolist (column row)
|
||||
(aset natural-widths i (max (aref natural-widths i) column))
|
||||
(setq i (1+ i)))))
|
||||
(let ((extra (- (apply '+ (append suggested-widths nil))
|
||||
(apply '+ (append widths nil))
|
||||
(let ((extra (- (apply #'+ (append suggested-widths nil))
|
||||
(apply #'+ (append widths nil))
|
||||
(* shr-table-separator-pixel-width (1+ (length widths)))))
|
||||
(expanded-columns 0))
|
||||
;; We have extra, unused space, so divide this space amongst the
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@
|
|||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
;; Sometimes, compilation fails with "Variable binding depth exceeds
|
||||
;; max-specpdl-size".
|
||||
;; max-specpdl-size". Shall be fixed in Emacs 27.
|
||||
(eval-and-compile
|
||||
(let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs)))
|
||||
|
||||
|
|
@ -318,7 +318,10 @@ arguments to pass to the OPERATION."
|
|||
|
||||
(let* ((filename (apply #'tramp-archive-file-name-for-operation
|
||||
operation args))
|
||||
(archive (tramp-archive-file-name-archive filename)))
|
||||
(archive (tramp-archive-file-name-archive filename))
|
||||
;; Sometimes, it fails with "Variable binding depth exceeds
|
||||
;; max-specpdl-size". Shall be fixed in Emacs 27.
|
||||
(max-specpdl-size (* 2 max-specpdl-size)))
|
||||
|
||||
;; `filename' could be a quoted file name. Or the file
|
||||
;; archive could be a directory, see Bug#30293.
|
||||
|
|
|
|||
|
|
@ -477,7 +477,18 @@ file names."
|
|||
(with-tramp-connection-property
|
||||
(tramp-get-connection-process vec) "rclone-pid"
|
||||
(catch 'pid
|
||||
(dolist (pid (list-system-processes)) ;; "pidof rclone" ?
|
||||
(dolist
|
||||
(pid
|
||||
;; Until Emacs 25, `process-attributes' could
|
||||
;; crash Emacs for some processes. So we use
|
||||
;; "pidof", which might not work everywhere.
|
||||
(if (<= emacs-major-version 25)
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(mapcar
|
||||
#'string-to-number
|
||||
(split-string
|
||||
(shell-command-to-string "pidof rclone"))))
|
||||
(list-system-processes)))
|
||||
(and (string-match-p
|
||||
(regexp-quote
|
||||
(format "rclone mount %s:" (tramp-file-name-host vec)))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; webjump.el --- programmable Web hotlist
|
||||
;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -323,8 +323,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
|
|||
|
||||
(defun webjump-read-url-choice (what urls &optional default)
|
||||
;; Note: Convert this to use `webjump-read-choice' someday.
|
||||
(let* ((completions (mapcar (function (lambda (n) (cons n n)))
|
||||
urls))
|
||||
(let* ((completions (mapcar (lambda (n) (cons n n)) urls))
|
||||
(input (completing-read (concat what
|
||||
;;(if default " (RET for default)" "")
|
||||
": ")
|
||||
|
|
|
|||
|
|
@ -1,292 +0,0 @@
|
|||
;;; levents.el --- emulate the Lucid event data type and associated functions
|
||||
|
||||
;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: emulations
|
||||
;; Obsolete-since: 23.2
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Things we cannot emulate in Lisp:
|
||||
;; It is not possible to emulate current-mouse-event as a variable,
|
||||
;; though it is not hard to obtain the data from (this-command-keys).
|
||||
|
||||
;; We do not have a variable unread-command-event;
|
||||
;; instead, we have the more general unread-command-events.
|
||||
|
||||
;; Our read-key-sequence and read-char are not precisely
|
||||
;; compatible with those in Lucid Emacs, but they should work ok.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun next-command-event (event)
|
||||
(error "You must rewrite to use `read-command-event' instead of `next-command-event'"))
|
||||
|
||||
(defun next-event (event)
|
||||
(error "You must rewrite to use `read-event' instead of `next-event'"))
|
||||
|
||||
(defun dispatch-event (event)
|
||||
(error "`dispatch-event' not supported"))
|
||||
|
||||
;; Make events of type eval, menu and timeout
|
||||
;; execute properly.
|
||||
|
||||
(define-key global-map [menu] 'execute-eval-event)
|
||||
(define-key global-map [timeout] 'execute-eval-event)
|
||||
(define-key global-map [eval] 'execute-eval-event)
|
||||
|
||||
(defun execute-eval-event (event)
|
||||
(interactive "e")
|
||||
(funcall (nth 1 event) (nth 2 event)))
|
||||
|
||||
(put 'eval 'event-symbol-elements '(eval))
|
||||
(put 'menu 'event-symbol-elements '(eval))
|
||||
(put 'timeout 'event-symbol-elements '(eval))
|
||||
|
||||
(defun allocate-event ()
|
||||
"Return an empty event structure.
|
||||
In this emulation, it returns nil."
|
||||
nil)
|
||||
|
||||
(defun button-press-event-p (obj)
|
||||
"True if the argument is a mouse-button-press event object."
|
||||
(and (consp obj) (symbolp (car obj))
|
||||
(memq 'down (get (car obj) 'event-symbol-elements))))
|
||||
|
||||
(defun button-release-event-p (obj)
|
||||
"True if the argument is a mouse-button-release event object."
|
||||
(and (consp obj) (symbolp (car obj))
|
||||
(or (memq 'click (get (car obj) 'event-symbol-elements))
|
||||
(memq 'drag (get (car obj) 'event-symbol-elements)))))
|
||||
|
||||
(defun button-event-p (obj)
|
||||
"True if the argument is a mouse-button press or release event object."
|
||||
(and (consp obj) (symbolp (car obj))
|
||||
(or (memq 'click (get (car obj) 'event-symbol-elements))
|
||||
(memq 'down (get (car obj) 'event-symbol-elements))
|
||||
(memq 'drag (get (car obj) 'event-symbol-elements)))))
|
||||
|
||||
(defun mouse-event-p (obj)
|
||||
"True if the argument is a mouse-button press or release event object."
|
||||
(and (consp obj) (symbolp (car obj))
|
||||
(or (eq (car obj) 'mouse-movement)
|
||||
(memq 'click (get (car obj) 'event-symbol-elements))
|
||||
(memq 'down (get (car obj) 'event-symbol-elements))
|
||||
(memq 'drag (get (car obj) 'event-symbol-elements)))))
|
||||
|
||||
(defun character-to-event (ch &optional event)
|
||||
"Converts a numeric ASCII value to an event structure, replete with
|
||||
bucky bits. The character is the first argument, and the event to fill
|
||||
in is the second. This function contains knowledge about what the codes
|
||||
mean -- for example, the number 9 is converted to the character Tab,
|
||||
not the distinct character Control-I.
|
||||
|
||||
Beware that character-to-event and event-to-character are not strictly
|
||||
inverse functions, since events contain much more information than the
|
||||
ASCII character set can encode."
|
||||
ch)
|
||||
|
||||
(defun copy-event (event1 &optional event2)
|
||||
"Make a copy of the given event object.
|
||||
In this emulation, `copy-event' just returns its argument."
|
||||
event1)
|
||||
|
||||
(defun deallocate-event (event)
|
||||
"Allow the given event structure to be reused.
|
||||
In actual Lucid Emacs, you MUST NOT use this event object after
|
||||
calling this function with it. You will lose. It is not necessary to
|
||||
call this function, as event objects are garbage- collected like all
|
||||
other objects; however, it may be more efficient to explicitly
|
||||
deallocate events when you are sure that this is safe.
|
||||
|
||||
This emulation does not actually deallocate or reuse events
|
||||
except via garbage collection and `cons'."
|
||||
nil)
|
||||
|
||||
(defun enqueue-eval-event: (function object)
|
||||
"Add an eval event to the back of the queue.
|
||||
It will be the next event read after all pending events."
|
||||
(setq unread-command-events
|
||||
(nconc unread-command-events
|
||||
(list (list 'eval function object)))))
|
||||
|
||||
(defun eval-event-p (obj)
|
||||
"True if the argument is an eval or menu event object."
|
||||
(eq (car-safe obj) 'eval))
|
||||
|
||||
(defun event-button (event)
|
||||
"Return the button-number of the given mouse-button-press event."
|
||||
(let ((sym (car (get (car event) 'event-symbol-elements))))
|
||||
(cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3)
|
||||
(mouse-4 . 4) (mouse-5 . 5))))))
|
||||
|
||||
(defun event-function (event)
|
||||
"Return the callback function of the given timeout, menu, or eval event."
|
||||
(nth 1 event))
|
||||
|
||||
(defun event-key (event)
|
||||
"Return the KeySym of the given key-press event.
|
||||
The value is an ASCII printing character (not upper case) or a symbol."
|
||||
(if (symbolp event)
|
||||
(car (get event 'event-symbol-elements))
|
||||
(let ((base (logand event (1- (ash 1 18)))))
|
||||
(downcase (if (< base 32) (logior base 64) base)))))
|
||||
|
||||
(defun event-object (event)
|
||||
"Return the function argument of the given timeout, menu, or eval event."
|
||||
(nth 2 event))
|
||||
|
||||
(defun event-point (event)
|
||||
"Return the character position of the given mouse-related event.
|
||||
If the event did not occur over a window, or did
|
||||
not occur over text, then this returns nil. Otherwise, it returns an index
|
||||
into the buffer visible in the event's window."
|
||||
(posn-point (event-end event)))
|
||||
|
||||
;; Return position of start of line LINE in WINDOW.
|
||||
;; If LINE is nil, return the last position
|
||||
;; visible in WINDOW.
|
||||
(defun event-closest-point-1 (window &optional line)
|
||||
(let* ((total (- (window-height window)
|
||||
(if (window-minibuffer-p window)
|
||||
0 1)))
|
||||
(distance (or line total)))
|
||||
(save-excursion
|
||||
(goto-char (window-start window))
|
||||
(if (= (vertical-motion distance) distance)
|
||||
(if (not line)
|
||||
(forward-char -1)))
|
||||
(point))))
|
||||
|
||||
(defun event-closest-point (event &optional start-window)
|
||||
"Return the nearest position to where EVENT ended its motion.
|
||||
This is computed for the window where EVENT's motion started,
|
||||
or for window WINDOW if that is specified."
|
||||
(or start-window (setq start-window (posn-window (event-start event))))
|
||||
(if (eq start-window (posn-window (event-end event)))
|
||||
(if (eq (event-point event) 'vertical-line)
|
||||
(event-closest-point-1 start-window
|
||||
(cdr (posn-col-row (event-end event))))
|
||||
(if (eq (event-point event) 'mode-line)
|
||||
(event-closest-point-1 start-window)
|
||||
(event-point event)))
|
||||
;; EVENT ended in some other window.
|
||||
(let* ((end-w (posn-window (event-end event)))
|
||||
(end-w-top)
|
||||
(w-top (nth 1 (window-edges start-window))))
|
||||
(setq end-w-top
|
||||
(if (windowp end-w)
|
||||
(nth 1 (window-edges end-w))
|
||||
(/ (cdr (posn-x-y (event-end event)))
|
||||
(frame-char-height end-w))))
|
||||
(if (>= end-w-top w-top)
|
||||
(event-closest-point-1 start-window)
|
||||
(window-start start-window)))))
|
||||
|
||||
(defun event-process (event)
|
||||
"Return the process of the given process-output event."
|
||||
(nth 1 event))
|
||||
|
||||
(defun event-timestamp (event)
|
||||
"Return the timestamp of the given event object.
|
||||
In Lucid Emacs, this works for any kind of event.
|
||||
In this emulation, it returns nil for non-mouse-related events."
|
||||
(and (listp event)
|
||||
(posn-timestamp (event-end event))))
|
||||
|
||||
(defun event-to-character (event &optional lenient)
|
||||
"Return the closest ASCII approximation to the given event object.
|
||||
If the event isn't a keypress, this returns nil.
|
||||
If the second argument is non-nil, then this is lenient in its
|
||||
translation; it will ignore modifier keys other than control and meta,
|
||||
and will ignore the shift modifier on those characters which have no
|
||||
shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
|
||||
the same ASCII code as Control-A.) If the second arg is nil, then nil
|
||||
will be returned for events which have no direct ASCII equivalent."
|
||||
(if (symbolp event)
|
||||
(and lenient
|
||||
(cdr (assq event '((backspace . 8) (delete . 127) (tab . 9)
|
||||
(return . 10) (enter . 10)))))
|
||||
;; Our interpretation is, ASCII means anything a number can represent.
|
||||
(if (integerp event)
|
||||
event nil)))
|
||||
|
||||
(defun event-window (event)
|
||||
"Return the window of the given mouse-related event object."
|
||||
(posn-window (event-end event)))
|
||||
|
||||
(defun event-x (event)
|
||||
"Return the X position in characters of the given mouse-related event."
|
||||
(/ (car (posn-col-row (event-end event)))
|
||||
(frame-char-width (window-frame (event-window event)))))
|
||||
|
||||
(defun event-x-pixel (event)
|
||||
"Return the X position in pixels of the given mouse-related event."
|
||||
(car (posn-col-row (event-end event))))
|
||||
|
||||
(defun event-y (event)
|
||||
"Return the Y position in characters of the given mouse-related event."
|
||||
(/ (cdr (posn-col-row (event-end event)))
|
||||
(frame-char-height (window-frame (event-window event)))))
|
||||
|
||||
(defun event-y-pixel (event)
|
||||
"Return the Y position in pixels of the given mouse-related event."
|
||||
(cdr (posn-col-row (event-end event))))
|
||||
|
||||
(defun key-press-event-p (obj)
|
||||
"True if the argument is a keyboard event object."
|
||||
(or (integerp obj)
|
||||
(and (symbolp obj)
|
||||
(get obj 'event-symbol-elements))))
|
||||
|
||||
(defun menu-event-p (obj)
|
||||
"True if the argument is a menu event object."
|
||||
(eq (car-safe obj) 'menu))
|
||||
|
||||
(defun motion-event-p (obj)
|
||||
"True if the argument is a mouse-motion event object."
|
||||
(eq (car-safe obj) 'mouse-movement))
|
||||
|
||||
(defun read-command-event ()
|
||||
"Return the next keyboard or mouse event; execute other events.
|
||||
This is similar to the function `next-command-event' of Lucid Emacs,
|
||||
but different in that it returns the event rather than filling in
|
||||
an existing event object."
|
||||
(let (event)
|
||||
(while (progn
|
||||
(setq event (read-event))
|
||||
(not (or (key-press-event-p event)
|
||||
(button-press-event-p event)
|
||||
(button-release-event-p event)
|
||||
(menu-event-p event))))
|
||||
(let ((type (car-safe event)))
|
||||
(cond ((eq type 'eval)
|
||||
(funcall (nth 1 event) (nth 2 event)))
|
||||
((eq type 'switch-frame)
|
||||
(select-frame (nth 1 event))))))
|
||||
event))
|
||||
|
||||
(defun process-event-p (obj)
|
||||
"True if the argument is a process-output event object.
|
||||
GNU Emacs 19 does not currently generate process-output events."
|
||||
(eq (car-safe obj) 'process))
|
||||
|
||||
(provide 'levents)
|
||||
|
||||
;;; levents.el ends here
|
||||
|
|
@ -2995,7 +2995,8 @@ Agenda views are separated by `org-agenda-block-separator'."
|
|||
(erase-buffer)
|
||||
(insert (eval-when-compile
|
||||
(let ((header
|
||||
"Press key for an agenda command:
|
||||
(copy-sequence
|
||||
"Press key for an agenda command:
|
||||
-------------------------------- < Buffer, subtree/region restriction
|
||||
a Agenda for current week or day > Remove restriction
|
||||
t List of all TODO entries e Export agenda views
|
||||
|
|
@ -3004,7 +3005,7 @@ s Search for keywords M Like m, but only TODO entries
|
|||
/ Multi-occur S Like s, but only TODO entries
|
||||
? Find :FLAGGED: entries C Configure custom agenda commands
|
||||
* Toggle sticky agenda views # List stuck projects (!=configure)
|
||||
")
|
||||
"))
|
||||
(start 0))
|
||||
(while (string-match
|
||||
"\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
|
||||
|
|
|
|||
|
|
@ -31,7 +31,8 @@
|
|||
;; ;; Minibuffer prompt for password.
|
||||
;; => "foo"
|
||||
;;
|
||||
;; (password-cache-add "test" (copy-sequence "foo"))
|
||||
;; (password-cache-add "test" (read-passwd "Password? "))
|
||||
;; ;; Minibuffer prompt from read-passwd, which returns "foo".
|
||||
;; => nil
|
||||
|
||||
;; (password-read "Password? " "test")
|
||||
|
|
|
|||
|
|
@ -3412,8 +3412,14 @@ regexp should match \"(\" if parentheses are valid in declarators.
|
|||
The end of the first submatch is taken as the end of the operator.
|
||||
Identifier syntax is in effect when this is matched (see
|
||||
`c-identifier-syntax-table')."
|
||||
t (if (c-lang-const c-type-modifier-kwds)
|
||||
(concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>")
|
||||
t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds))
|
||||
(concat
|
||||
(regexp-opt (c--delete-duplicates
|
||||
(append (c-lang-const c-type-modifier-kwds)
|
||||
(c-lang-const c-modifier-kwds))
|
||||
:test 'string-equal)
|
||||
t)
|
||||
"\\>")
|
||||
;; Default to a regexp that never matches.
|
||||
regexp-unmatchable)
|
||||
;; Check that there's no "=" afterwards to avoid matching tokens
|
||||
|
|
|
|||
|
|
@ -795,7 +795,7 @@ compatible with old code; callers should always specify it."
|
|||
(set (make-local-variable 'outline-level) 'c-outline-level)
|
||||
(set (make-local-variable 'add-log-current-defun-function)
|
||||
(lambda ()
|
||||
(or (c-cpp-define-name) (c-defun-name))))
|
||||
(or (c-cpp-define-name) (car (c-defun-name-and-limits nil)))))
|
||||
(let ((rfn (assq mode c-require-final-newline)))
|
||||
(when rfn
|
||||
(if (boundp 'mode-require-final-newline)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
|
||||
;; Version: 0.1.3
|
||||
;; Version: 0.2.0
|
||||
;; Package-Requires: ((emacs "26.3"))
|
||||
|
||||
;; This is a GNU ELPA :core package. Avoid using functionality that
|
||||
|
|
@ -40,7 +40,7 @@
|
|||
;; Infrastructure:
|
||||
;;
|
||||
;; Function `project-current', to determine the current project
|
||||
;; instance, and 5 (at the moment) generic functions that act on it.
|
||||
;; instance, and 4 (at the moment) generic functions that act on it.
|
||||
;; This list is to be extended in future versions.
|
||||
;;
|
||||
;; Utils:
|
||||
|
|
@ -122,14 +122,25 @@ is not a part of a detectable project either, return a
|
|||
(defun project--find-in-directory (dir)
|
||||
(run-hook-with-args-until-success 'project-find-functions dir))
|
||||
|
||||
(cl-defgeneric project-root (project)
|
||||
"Return root directory of the current project.
|
||||
|
||||
It usually contains the main build file, dependencies
|
||||
configuration file, etc. Though neither is mandatory.
|
||||
|
||||
The directory name must be absolute."
|
||||
(car (project-roots project)))
|
||||
|
||||
(cl-defgeneric project-roots (project)
|
||||
"Return the list of directory roots of the current project.
|
||||
"Return the list containing the current project root.
|
||||
|
||||
Most often it's just one directory which contains the project
|
||||
build file and everything else in the project. But in more
|
||||
advanced configurations, a project can span multiple directories.
|
||||
|
||||
The directory names should be absolute.")
|
||||
The function is obsolete, all projects have one main root anyway,
|
||||
and the rest should be possible to express through
|
||||
`project-external-roots'."
|
||||
;; FIXME: Can we specify project's version here?
|
||||
;; FIXME: Could we make this affect cl-defmethod calls too?
|
||||
(declare (obsolete project-root "0.3.0"))
|
||||
(list (project-root project)))
|
||||
|
||||
;; FIXME: Add MODE argument, like in `ede-source-paths'?
|
||||
(cl-defgeneric project-external-roots (_project)
|
||||
|
|
@ -138,18 +149,14 @@ The directory names should be absolute.")
|
|||
It's the list of directories outside of the project that are
|
||||
still related to it. If the project deals with source code then,
|
||||
depending on the languages used, this list should include the
|
||||
headers search path, load path, class path, and so on.
|
||||
|
||||
The rule of thumb for whether to include a directory here, and
|
||||
not in `project-roots', is whether its contents are meant to be
|
||||
edited together with the rest of the project."
|
||||
headers search path, load path, class path, and so on."
|
||||
nil)
|
||||
|
||||
(cl-defgeneric project-ignores (_project _dir)
|
||||
"Return the list of glob patterns to ignore inside DIR.
|
||||
Patterns can match both regular files and directories.
|
||||
To root an entry, start it with `./'. To match directories only,
|
||||
end it with `/'. DIR must be one of `project-roots' or
|
||||
end it with `/'. DIR must be either `project-root' or one of
|
||||
`project-external-roots'."
|
||||
;; TODO: Document and support regexp ignores as used by Hg.
|
||||
;; TODO: Support whitelist entries.
|
||||
|
|
@ -170,13 +177,13 @@ end it with `/'. DIR must be one of `project-roots' or
|
|||
(t
|
||||
(complete-with-action action all-files string pred)))))
|
||||
|
||||
(cl-defmethod project-roots ((project (head transient)))
|
||||
(list (cdr project)))
|
||||
(cl-defmethod project-root ((project (head transient)))
|
||||
(cdr project))
|
||||
|
||||
(cl-defgeneric project-files (project &optional dirs)
|
||||
"Return a list of files in directories DIRS in PROJECT.
|
||||
DIRS is a list of absolute directories; it should be some
|
||||
subset of the project roots and external roots.
|
||||
subset of the project root and external roots.
|
||||
|
||||
The default implementation uses `find-program'. PROJECT is used
|
||||
to find the list of ignores for each directory."
|
||||
|
|
@ -184,7 +191,8 @@ to find the list of ignores for each directory."
|
|||
(lambda (dir)
|
||||
(project--files-in-directory dir
|
||||
(project--dir-ignores project dir)))
|
||||
(or dirs (project-roots project))))
|
||||
(or dirs
|
||||
(list (project-root project)))))
|
||||
|
||||
(defun project--files-in-directory (dir ignores &optional files)
|
||||
(require 'find-dired)
|
||||
|
|
@ -223,7 +231,7 @@ to find the list of ignores for each directory."
|
|||
local-files))))
|
||||
|
||||
(defgroup project-vc nil
|
||||
"Project implementation using the VC package."
|
||||
"Project implementation based on the VC package."
|
||||
:version "25.1"
|
||||
:group 'tools)
|
||||
|
||||
|
|
@ -232,6 +240,15 @@ to find the list of ignores for each directory."
|
|||
:type '(repeat string)
|
||||
:safe 'listp)
|
||||
|
||||
(defcustom project-vc-merge-submodules t
|
||||
"Non-nil to consider submodules part of the parent project.
|
||||
|
||||
After changing this variable (using Customize or .dir-locals.el)
|
||||
you might have to restart Emacs to see the effect."
|
||||
:type 'boolean
|
||||
:package-version '(project . "0.2.0")
|
||||
:safe 'booleanp)
|
||||
|
||||
;; FIXME: Using the current approach, major modes are supposed to set
|
||||
;; this variable to a buffer-local value. So we don't have access to
|
||||
;; the "external roots" of language A from buffers of language B, which
|
||||
|
|
@ -273,38 +290,48 @@ backend implementation of `project-external-roots'.")
|
|||
(pcase backend
|
||||
('Git
|
||||
;; Don't stop at submodule boundary.
|
||||
;; Note: It's not necessarily clear-cut what should be
|
||||
;; considered a "submodule" in the sense that some users
|
||||
;; may setup things equivalent to "git-submodule"s using
|
||||
;; "git worktree" instead (for example).
|
||||
;; FIXME: Also it may be the case that some users would consider
|
||||
;; a submodule as its own project. So there's a good chance
|
||||
;; we will need to let the user tell us what is their intention.
|
||||
(or (vc-file-getprop dir 'project-git-root)
|
||||
(let* ((root (vc-call-backend backend 'root dir))
|
||||
(gitfile (expand-file-name ".git" root)))
|
||||
(let ((root (vc-call-backend backend 'root dir)))
|
||||
(vc-file-setprop
|
||||
dir 'project-git-root
|
||||
(cond
|
||||
((file-directory-p gitfile)
|
||||
root)
|
||||
((with-temp-buffer
|
||||
(insert-file-contents gitfile)
|
||||
(goto-char (point-min))
|
||||
;; Kind of a hack to distinguish a submodule from
|
||||
;; other cases of .git files pointing elsewhere.
|
||||
(looking-at "gitdir: [./]+/\\.git/modules/"))
|
||||
(let* ((parent (file-name-directory
|
||||
(directory-file-name root))))
|
||||
(vc-call-backend backend 'root parent)))
|
||||
(t root)))
|
||||
)))
|
||||
(if (and
|
||||
;; FIXME: Invalidate the cache when the value
|
||||
;; of this variable changes.
|
||||
project-vc-merge-submodules
|
||||
(project--submodule-p root))
|
||||
(let* ((parent (file-name-directory
|
||||
(directory-file-name root))))
|
||||
(vc-call-backend backend 'root parent))
|
||||
root)))))
|
||||
('nil nil)
|
||||
(_ (ignore-errors (vc-call-backend backend 'root dir))))))
|
||||
(and root (cons 'vc root))))
|
||||
|
||||
(cl-defmethod project-roots ((project (head vc)))
|
||||
(list (cdr project)))
|
||||
(defun project--submodule-p (root)
|
||||
;; XXX: We only support Git submodules for now.
|
||||
;;
|
||||
;; For submodules, at least, we expect the users to prefer them to
|
||||
;; be considered part of the parent project. For those who don't,
|
||||
;; there is the custom var now.
|
||||
;;
|
||||
;; Some users may also set up things equivalent to Git submodules
|
||||
;; using "git worktree" (for example). However, we expect that most
|
||||
;; of them would prefer to treat those as separate projects anyway.
|
||||
(let* ((gitfile (expand-file-name ".git" root)))
|
||||
(cond
|
||||
((file-directory-p gitfile)
|
||||
nil)
|
||||
((with-temp-buffer
|
||||
(insert-file-contents gitfile)
|
||||
(goto-char (point-min))
|
||||
;; Kind of a hack to distinguish a submodule from
|
||||
;; other cases of .git files pointing elsewhere.
|
||||
(looking-at "gitdir: [./]+/\\.git/modules/"))
|
||||
t)
|
||||
(t nil))))
|
||||
|
||||
(cl-defmethod project-root ((project (head vc)))
|
||||
(cdr project))
|
||||
|
||||
(cl-defmethod project-external-roots ((project (head vc)))
|
||||
(project-subtract-directories
|
||||
|
|
@ -312,7 +339,7 @@ backend implementation of `project-external-roots'.")
|
|||
(mapcar
|
||||
#'file-name-as-directory
|
||||
(funcall project-vc-external-roots-function)))
|
||||
(project-roots project)))
|
||||
(list (project-root project))))
|
||||
|
||||
(cl-defmethod project-files ((project (head vc)) &optional dirs)
|
||||
(cl-mapcan
|
||||
|
|
@ -330,7 +357,8 @@ backend implementation of `project-external-roots'.")
|
|||
(project--files-in-directory
|
||||
dir
|
||||
(project--dir-ignores project dir)))))
|
||||
(or dirs (project-roots project))))
|
||||
(or dirs
|
||||
(list (project-root project)))))
|
||||
|
||||
(declare-function vc-git--program-version "vc-git")
|
||||
(declare-function vc-git--run-command-string "vc-git")
|
||||
|
|
@ -372,7 +400,9 @@ backend implementation of `project-external-roots'.")
|
|||
submodules)))
|
||||
(setq files
|
||||
(apply #'nconc files sub-files)))
|
||||
files))
|
||||
;; 'git ls-files' returns duplicate entries for merge conflicts.
|
||||
;; XXX: Better solutions welcome, but this seems cheap enough.
|
||||
(delete-consecutive-dups files)))
|
||||
(`Hg
|
||||
(let ((default-directory (expand-file-name (file-name-as-directory dir)))
|
||||
args)
|
||||
|
|
@ -471,7 +501,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
|
|||
(let* ((pr (project-current t))
|
||||
(files
|
||||
(if (not current-prefix-arg)
|
||||
(project-files pr (project-roots pr))
|
||||
(project-files pr)
|
||||
(let ((dir (read-directory-name "Base directory: "
|
||||
nil default-directory t)))
|
||||
(project--files-in-directory dir
|
||||
|
|
@ -482,9 +512,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
|
|||
nil)))
|
||||
|
||||
(defun project--dir-ignores (project dir)
|
||||
(let* ((roots (project-roots project))
|
||||
(root (cl-find dir roots :test #'file-in-directory-p)))
|
||||
(if (not root)
|
||||
(let ((root (project-root project)))
|
||||
(if (not (file-in-directory-p dir root))
|
||||
(project-ignores nil nil) ;The defaults.
|
||||
(let ((ignores (project-ignores project root)))
|
||||
(if (file-equal-p root dir)
|
||||
|
|
@ -502,8 +531,8 @@ pattern to search for."
|
|||
(require 'xref)
|
||||
(let* ((pr (project-current t))
|
||||
(files
|
||||
(project-files pr (append
|
||||
(project-roots pr)
|
||||
(project-files pr (cons
|
||||
(project-root pr)
|
||||
(project-external-roots pr)))))
|
||||
(xref--show-xrefs
|
||||
(apply-partially #'project--find-regexp-in-files regexp files)
|
||||
|
|
@ -541,23 +570,23 @@ pattern to search for."
|
|||
|
||||
;;;###autoload
|
||||
(defun project-find-file ()
|
||||
"Visit a file (with completion) in the current project's roots.
|
||||
"Visit a file (with completion) in the current project.
|
||||
The completion default is the filename at point, if one is
|
||||
recognized."
|
||||
(interactive)
|
||||
(let* ((pr (project-current t))
|
||||
(dirs (project-roots pr)))
|
||||
(dirs (list (project-root pr))))
|
||||
(project-find-file-in (thing-at-point 'filename) dirs pr)))
|
||||
|
||||
;;;###autoload
|
||||
(defun project-or-external-find-file ()
|
||||
"Visit a file (with completion) in the current project's roots or external roots.
|
||||
"Visit a file (with completion) in the current project or external roots.
|
||||
The completion default is the filename at point, if one is
|
||||
recognized."
|
||||
(interactive)
|
||||
(let* ((pr (project-current t))
|
||||
(dirs (append
|
||||
(project-roots pr)
|
||||
(dirs (cons
|
||||
(project-root pr)
|
||||
(project-external-roots pr))))
|
||||
(project-find-file-in (thing-at-point 'filename) dirs pr)))
|
||||
|
||||
|
|
@ -660,5 +689,13 @@ loop using the command \\[fileloop-continue]."
|
|||
from to (project-files (project-current t)) 'default)
|
||||
(fileloop-continue))
|
||||
|
||||
;;;###autoload
|
||||
(defun project-compile ()
|
||||
"Run `compile' in the project root."
|
||||
(interactive)
|
||||
(let* ((pr (project-current t))
|
||||
(default-directory (project-root pr)))
|
||||
(call-interactively 'compile)))
|
||||
|
||||
(provide 'project)
|
||||
;;; project.el ends here
|
||||
|
|
|
|||
|
|
@ -261,7 +261,6 @@
|
|||
(require 'ansi-color)
|
||||
(require 'cl-lib)
|
||||
(require 'comint)
|
||||
(require 'json)
|
||||
(require 'tramp-sh)
|
||||
|
||||
;; Avoid compiler warnings
|
||||
|
|
@ -2276,6 +2275,18 @@ Do not set this variable directly, instead use
|
|||
Do not set this variable directly, instead use
|
||||
`python-shell-prompt-set-calculated-regexps'.")
|
||||
|
||||
(defalias 'python--parse-json-array
|
||||
(if (fboundp 'json-parse-string)
|
||||
(lambda (string)
|
||||
(json-parse-string string :array-type 'list))
|
||||
(require 'json)
|
||||
(defvar json-array-type)
|
||||
(declare-function json-read-from-string "json" (string))
|
||||
(lambda (string)
|
||||
(let ((json-array-type 'list))
|
||||
(json-read-from-string string))))
|
||||
"Parse the JSON array in STRING into a Lisp list.")
|
||||
|
||||
(defun python-shell-prompt-detect ()
|
||||
"Detect prompts for the current `python-shell-interpreter'.
|
||||
When prompts can be retrieved successfully from the
|
||||
|
|
@ -2324,11 +2335,11 @@ detection and just returns nil."
|
|||
(catch 'prompts
|
||||
(dolist (line (split-string output "\n" t))
|
||||
(let ((res
|
||||
;; Check if current line is a valid JSON array
|
||||
(and (string= (substring line 0 2) "[\"")
|
||||
;; Check if current line is a valid JSON array.
|
||||
(and (string-prefix-p "[\"" line)
|
||||
(ignore-errors
|
||||
;; Return prompts as a list, not vector
|
||||
(append (json-read-from-string line) nil)))))
|
||||
;; Return prompts as a list.
|
||||
(python--parse-json-array line)))))
|
||||
;; The list must contain 3 strings, where the first
|
||||
;; is the input prompt, the second is the block
|
||||
;; prompt and the last one is the output prompt. The
|
||||
|
|
|
|||
|
|
@ -186,7 +186,7 @@ and you want to simplify them for the mode line
|
|||
"Non-nil means display current function name in mode line.
|
||||
This makes a difference only if `which-function-mode' is non-nil.")
|
||||
|
||||
(add-hook 'find-file-hook 'which-func-ff-hook t)
|
||||
(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t)
|
||||
|
||||
(defun which-func-try-to-enable ()
|
||||
(unless (or (not which-function-mode)
|
||||
|
|
@ -195,7 +195,7 @@ This makes a difference only if `which-function-mode' is non-nil.")
|
|||
(member major-mode which-func-modes)))))
|
||||
|
||||
(defun which-func-ff-hook ()
|
||||
"File find hook for Which Function mode.
|
||||
"`after-change-major-mode-hook' for Which Function mode.
|
||||
It creates the Imenu index for the buffer, if necessary."
|
||||
(which-func-try-to-enable)
|
||||
|
||||
|
|
@ -282,52 +282,55 @@ If no function name is found, return nil."
|
|||
(when (null name)
|
||||
(setq name (add-log-current-defun)))
|
||||
;; If Imenu is loaded, try to make an index alist with it.
|
||||
;; If `add-log-current-defun' ran and gave nil, accept that.
|
||||
(when (and (null name)
|
||||
(boundp 'imenu--index-alist)
|
||||
(or (null imenu--index-alist)
|
||||
;; Update if outdated
|
||||
(/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
|
||||
(null which-function-imenu-failed))
|
||||
(ignore-errors (imenu--make-index-alist t))
|
||||
(unless imenu--index-alist
|
||||
(set (make-local-variable 'which-function-imenu-failed) t)))
|
||||
;; If we have an index alist, use it.
|
||||
(when (and (null name)
|
||||
(boundp 'imenu--index-alist) imenu--index-alist)
|
||||
(let ((alist imenu--index-alist)
|
||||
(minoffset (point-max))
|
||||
offset pair mark imstack namestack)
|
||||
;; Elements of alist are either ("name" . marker), or
|
||||
;; ("submenu" ("name" . marker) ... ). The list can be
|
||||
;; arbitrarily nested.
|
||||
(while (or alist imstack)
|
||||
(if (null alist)
|
||||
(setq alist (car imstack)
|
||||
namestack (cdr namestack)
|
||||
imstack (cdr imstack))
|
||||
(null add-log-current-defun-function))
|
||||
(when (and (null name)
|
||||
(boundp 'imenu--index-alist)
|
||||
(or (null imenu--index-alist)
|
||||
;; Update if outdated
|
||||
(/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
|
||||
(null which-function-imenu-failed))
|
||||
(ignore-errors (imenu--make-index-alist t))
|
||||
(unless imenu--index-alist
|
||||
(set (make-local-variable 'which-function-imenu-failed) t)))
|
||||
;; If we have an index alist, use it.
|
||||
(when (and (null name)
|
||||
(boundp 'imenu--index-alist) imenu--index-alist)
|
||||
(let ((alist imenu--index-alist)
|
||||
(minoffset (point-max))
|
||||
offset pair mark imstack namestack)
|
||||
;; Elements of alist are either ("name" . marker), or
|
||||
;; ("submenu" ("name" . marker) ... ). The list can be
|
||||
;; arbitrarily nested.
|
||||
(while (or alist imstack)
|
||||
(if (null alist)
|
||||
(setq alist (car imstack)
|
||||
namestack (cdr namestack)
|
||||
imstack (cdr imstack))
|
||||
|
||||
(setq pair (car-safe alist)
|
||||
alist (cdr-safe alist))
|
||||
(setq pair (car-safe alist)
|
||||
alist (cdr-safe alist))
|
||||
|
||||
(cond
|
||||
((atom pair)) ; Skip anything not a cons.
|
||||
(cond
|
||||
((atom pair)) ; Skip anything not a cons.
|
||||
|
||||
((imenu--subalist-p pair)
|
||||
(setq imstack (cons alist imstack)
|
||||
namestack (cons (car pair) namestack)
|
||||
alist (cdr pair)))
|
||||
((imenu--subalist-p pair)
|
||||
(setq imstack (cons alist imstack)
|
||||
namestack (cons (car pair) namestack)
|
||||
alist (cdr pair)))
|
||||
|
||||
((or (number-or-marker-p (setq mark (cdr pair)))
|
||||
(and (overlayp mark)
|
||||
(setq mark (overlay-start mark))))
|
||||
(when (and (>= (setq offset (- (point) mark)) 0)
|
||||
(< offset minoffset)) ; Find the closest item.
|
||||
(setq minoffset offset
|
||||
name (if (null which-func-imenu-joiner-function)
|
||||
(car pair)
|
||||
(funcall
|
||||
which-func-imenu-joiner-function
|
||||
(reverse (cons (car pair) namestack))))))))))))
|
||||
((or (number-or-marker-p (setq mark (cdr pair)))
|
||||
(and (overlayp mark)
|
||||
(setq mark (overlay-start mark))))
|
||||
(when (and (>= (setq offset (- (point) mark)) 0)
|
||||
(< offset minoffset)) ; Find the closest item.
|
||||
(setq minoffset offset
|
||||
name (if (null which-func-imenu-joiner-function)
|
||||
(car pair)
|
||||
(funcall
|
||||
which-func-imenu-joiner-function
|
||||
(reverse (cons (car pair) namestack)))))))))))))
|
||||
;; Filter the name if requested.
|
||||
(when name
|
||||
(if which-func-cleanup-function
|
||||
|
|
|
|||
|
|
@ -268,8 +268,8 @@ find a search tool; by default, this uses \"find | grep\" in the
|
|||
(lambda (dir)
|
||||
(xref-references-in-directory identifier dir))
|
||||
(let ((pr (project-current t)))
|
||||
(append
|
||||
(project-roots pr)
|
||||
(cons
|
||||
(project-root pr)
|
||||
(project-external-roots pr)))))
|
||||
|
||||
(cl-defgeneric xref-backend-apropos (backend pattern)
|
||||
|
|
|
|||
|
|
@ -4117,7 +4117,11 @@ MODES is as for `set-default-file-modes'."
|
|||
;; now, but it generates slower code.
|
||||
(defmacro save-match-data (&rest body)
|
||||
"Execute the BODY forms, restoring the global value of the match data.
|
||||
The value returned is the value of the last form in BODY."
|
||||
The value returned is the value of the last form in BODY.
|
||||
NOTE: The convention in Elisp is that any function, except for a few
|
||||
exceptions like car/assoc/+/goto-char, can clobber the match data,
|
||||
so `save-match-data' should normally be used to save *your* match data
|
||||
rather than your caller's match data."
|
||||
;; It is better not to use backquote here,
|
||||
;; because that makes a bootstrapping problem
|
||||
;; if you need to recompile all the Lisp files using interpreted code.
|
||||
|
|
|
|||
|
|
@ -1106,6 +1106,7 @@ the *vc-dir* buffer.
|
|||
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
|
||||
(set (make-local-variable 'desktop-save-buffer)
|
||||
'vc-dir-desktop-buffer-misc-data)
|
||||
(setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
|
||||
(setq buffer-read-only t)
|
||||
(when (boundp 'tool-bar-map)
|
||||
(set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
|
||||
|
|
@ -1465,6 +1466,41 @@ These are the commands available for use in the file status buffer:
|
|||
(add-to-list 'desktop-buffer-mode-handlers
|
||||
'(vc-dir-mode . vc-dir-restore-desktop-buffer))
|
||||
|
||||
|
||||
;;; Support for bookmark.el (adapted from what info.el does).
|
||||
|
||||
(declare-function bookmark-make-record-default
|
||||
"bookmark" (&optional no-file no-context posn))
|
||||
(declare-function bookmark-prop-get "bookmark" (bookmark prop))
|
||||
(declare-function bookmark-default-handler "bookmark" (bmk))
|
||||
(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
|
||||
|
||||
(defun vc-dir-bookmark-make-record ()
|
||||
"Make record used to bookmark a `vc-dir' buffer.
|
||||
This implements the `bookmark-make-record-function' type for
|
||||
`vc-dir' buffers."
|
||||
(let* ((bookmark-name
|
||||
(concat "(" (symbol-name vc-dir-backend) ") "
|
||||
(file-name-nondirectory
|
||||
(directory-file-name default-directory))))
|
||||
(defaults (list bookmark-name default-directory)))
|
||||
`(,bookmark-name
|
||||
,@(bookmark-make-record-default 'no-file)
|
||||
(filename . ,default-directory)
|
||||
(handler . vc-dir-bookmark-jump)
|
||||
(defaults . ,defaults))))
|
||||
|
||||
;;;###autoload
|
||||
(defun vc-dir-bookmark-jump (bmk)
|
||||
"Provides the bookmark-jump behavior for a `vc-dir' buffer.
|
||||
This implements the `handler' function interface for the record
|
||||
type returned by `vc-dir-bookmark-make-record'."
|
||||
(let* ((file (bookmark-prop-get bmk 'filename))
|
||||
(buf (save-window-excursion
|
||||
(vc-dir file) (current-buffer))))
|
||||
(bookmark-default-handler
|
||||
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
|
||||
|
||||
|
||||
(provide 'vc-dir)
|
||||
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@
|
|||
;; by git, so it's probably
|
||||
;; not a good idea.
|
||||
;; - merge-news (file) see `merge-file'
|
||||
;; - mark-resolved (file) OK
|
||||
;; - steal-lock (file &optional revision) NOT NEEDED
|
||||
;; HISTORY FUNCTIONS
|
||||
;; * print-log (files buffer &optional shortlog start-revision limit) OK
|
||||
|
|
@ -1530,6 +1531,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
|
|||
(defun vc-git-rename-file (old new)
|
||||
(vc-git-command nil 0 (list old new) "mv" "-f" "--"))
|
||||
|
||||
(defun vc-git-mark-resolved (files)
|
||||
(vc-git-command nil 0 files "add"))
|
||||
|
||||
(defvar vc-git-extra-menu-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [git-grep]
|
||||
|
|
|
|||
|
|
@ -498,7 +498,7 @@ status of this file. Otherwise, the value returned is one of:
|
|||
"Return the repository version from which FILE was checked out.
|
||||
If FILE is not registered, this function always returns nil."
|
||||
(or (vc-file-getprop file 'vc-working-revision)
|
||||
(progn
|
||||
(let ((default-directory (file-name-directory file)))
|
||||
(setq backend (or backend (vc-backend file)))
|
||||
(when backend
|
||||
(vc-file-setprop file 'vc-working-revision
|
||||
|
|
|
|||
|
|
@ -163,8 +163,4 @@ correspond to the running Emacs.
|
|||
Optional argument DIR is a directory to use instead of `source-directory'."
|
||||
(emacs-repository-branch-git (or dir source-directory)))
|
||||
|
||||
;; We put version info into the executable in the form that `ident' uses.
|
||||
(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
|
||||
" $\n"))
|
||||
|
||||
;;; version.el ends here
|
||||
|
|
|
|||
13
lisp/xml.el
13
lisp/xml.el
|
|
@ -1023,9 +1023,17 @@ entity references (e.g., replace each & with &).
|
|||
XML character data must not contain & or < characters, nor the >
|
||||
character under some circumstances. The XML spec does not impose
|
||||
restriction on \" or \\=', but we just substitute for these too
|
||||
\(as is permitted by the spec)."
|
||||
\(as is permitted by the spec).
|
||||
|
||||
If STRING contains characters that are invalid in XML (as defined
|
||||
by https://www.w3.org/TR/xml/#charsets), signal an error of type
|
||||
`xml-invalid-character'."
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]")
|
||||
(signal 'xml-invalid-character (list (char-before) (match-beginning 0))))
|
||||
(dolist (substitution '(("&" . "&")
|
||||
("<" . "<")
|
||||
(">" . ">")
|
||||
|
|
@ -1036,6 +1044,9 @@ restriction on \" or \\=', but we just substitute for these too
|
|||
(replace-match (cdr substitution) t t nil)))
|
||||
(buffer-string)))
|
||||
|
||||
(define-error 'xml-invalid-character "Invalid XML character"
|
||||
'wrong-type-argument)
|
||||
|
||||
(defun xml-debug-print-internal (xml indent-string)
|
||||
"Outputs the XML tree in the current buffer.
|
||||
The first line is indented with INDENT-STRING."
|
||||
|
|
|
|||
53
src/alloc.c
53
src/alloc.c
|
|
@ -3429,23 +3429,6 @@ usage: (vector &rest OBJECTS) */)
|
|||
return val;
|
||||
}
|
||||
|
||||
void
|
||||
make_byte_code (struct Lisp_Vector *v)
|
||||
{
|
||||
/* Don't allow the global zero_vector to become a byte code object. */
|
||||
eassert (0 < v->header.size);
|
||||
|
||||
if (v->header.size > 1 && STRINGP (v->contents[1])
|
||||
&& STRING_MULTIBYTE (v->contents[1]))
|
||||
/* BYTECODE-STRING must have been produced by Emacs 20.2 or the
|
||||
earlier because they produced a raw 8-bit string for byte-code
|
||||
and now such a byte-code string is loaded as multibyte while
|
||||
raw 8-bit characters converted to multibyte form. Thus, now we
|
||||
must convert them back to the original unibyte form. */
|
||||
v->contents[1] = Fstring_as_unibyte (v->contents[1]);
|
||||
XSETPVECTYPE (v, PVEC_COMPILED);
|
||||
}
|
||||
|
||||
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
|
||||
doc: /* Create a byte-code object with specified arguments as elements.
|
||||
The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
|
||||
|
|
@ -3464,8 +3447,14 @@ stack before executing the byte-code.
|
|||
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
|
||||
(ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
Lisp_Object val = make_uninit_vector (nargs);
|
||||
struct Lisp_Vector *p = XVECTOR (val);
|
||||
if (! ((FIXNUMP (args[COMPILED_ARGLIST])
|
||||
|| CONSP (args[COMPILED_ARGLIST])
|
||||
|| NILP (args[COMPILED_ARGLIST]))
|
||||
&& STRINGP (args[COMPILED_BYTECODE])
|
||||
&& !STRING_MULTIBYTE (args[COMPILED_BYTECODE])
|
||||
&& VECTORP (args[COMPILED_CONSTANTS])
|
||||
&& FIXNATP (args[COMPILED_STACK_DEPTH])))
|
||||
error ("Invalid byte-code object");
|
||||
|
||||
/* We used to purecopy everything here, if purify-flag was set. This worked
|
||||
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
|
||||
|
|
@ -3474,10 +3463,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
|
|||
copied into pure space, including its free variables, which is sometimes
|
||||
just wasteful and other times plainly wrong (e.g. those free vars may want
|
||||
to be setcar'd). */
|
||||
|
||||
memcpy (p->contents, args, nargs * sizeof *args);
|
||||
make_byte_code (p);
|
||||
XSETCOMPILED (val, p);
|
||||
Lisp_Object val = Fvector (nargs, args);
|
||||
XSETPVECTYPE (XVECTOR (val), PVEC_COMPILED);
|
||||
return val;
|
||||
}
|
||||
|
||||
|
|
@ -5019,8 +5006,9 @@ mark_stack (char const *bottom, char const *end)
|
|||
#endif
|
||||
}
|
||||
|
||||
/* This is a trampoline function that flushes registers to the stack,
|
||||
and then calls FUNC. ARG is passed through to FUNC verbatim.
|
||||
/* flush_stack_call_func is the trampoline function that flushes
|
||||
registers to the stack, and then calls FUNC. ARG is passed through
|
||||
to FUNC verbatim.
|
||||
|
||||
This function must be called whenever Emacs is about to release the
|
||||
global interpreter lock. This lets the garbage collector easily
|
||||
|
|
@ -5028,7 +5016,20 @@ mark_stack (char const *bottom, char const *end)
|
|||
Lisp.
|
||||
|
||||
It is invalid to run any Lisp code or to allocate any GC memory
|
||||
from FUNC. */
|
||||
from FUNC.
|
||||
|
||||
Note: all register spilling is done in flush_stack_call_func before
|
||||
flush_stack_call_func1 is activated.
|
||||
|
||||
flush_stack_call_func1 is responsible for identifying the stack
|
||||
address range to be scanned. It *must* be carefully kept as
|
||||
noinline to make sure that registers has been spilled before it is
|
||||
called, otherwise given __builtin_frame_address (0) typically
|
||||
returns the frame pointer (base pointer) and not the stack pointer
|
||||
[1] GC will miss to scan callee-saved registers content
|
||||
(Bug#41357).
|
||||
|
||||
[1] <https://gcc.gnu.org/onlinedocs/gcc/Return-Address.html>. */
|
||||
|
||||
NO_INLINE void
|
||||
flush_stack_call_func1 (void (*func) (void *arg), void *arg)
|
||||
|
|
|
|||
40
src/buffer.c
40
src/buffer.c
|
|
@ -119,6 +119,7 @@ static void free_buffer_text (struct buffer *b);
|
|||
static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
|
||||
static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
|
||||
static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
|
||||
static Lisp_Object buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym);
|
||||
|
||||
static void
|
||||
CHECK_OVERLAY (Lisp_Object x)
|
||||
|
|
@ -1300,6 +1301,25 @@ buffer_lisp_local_variables (struct buffer *buf, bool clone)
|
|||
return result;
|
||||
}
|
||||
|
||||
|
||||
/* If the variable at position index OFFSET in buffer BUF has a
|
||||
buffer-local value, return (name . value). If SYM is non-nil,
|
||||
it replaces name. */
|
||||
|
||||
static Lisp_Object
|
||||
buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym)
|
||||
{
|
||||
int idx = PER_BUFFER_IDX (offset);
|
||||
if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
|
||||
&& SYMBOLP (PER_BUFFER_SYMBOL (offset)))
|
||||
{
|
||||
sym = NILP (sym) ? PER_BUFFER_SYMBOL (offset) : sym;
|
||||
Lisp_Object val = per_buffer_value (buf, offset);
|
||||
return EQ (val, Qunbound) ? sym : Fcons (sym, val);
|
||||
}
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("buffer-local-variables", Fbuffer_local_variables,
|
||||
Sbuffer_local_variables, 0, 1, 0,
|
||||
doc: /* Return an alist of variables that are buffer-local in BUFFER.
|
||||
|
|
@ -1311,25 +1331,25 @@ No argument or nil as argument means use current buffer as BUFFER. */)
|
|||
{
|
||||
struct buffer *buf = decode_buffer (buffer);
|
||||
Lisp_Object result = buffer_lisp_local_variables (buf, 0);
|
||||
Lisp_Object tem;
|
||||
|
||||
/* Add on all the variables stored in special slots. */
|
||||
{
|
||||
int offset, idx;
|
||||
int offset;
|
||||
|
||||
FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
|
||||
{
|
||||
idx = PER_BUFFER_IDX (offset);
|
||||
if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
|
||||
&& SYMBOLP (PER_BUFFER_SYMBOL (offset)))
|
||||
{
|
||||
Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
|
||||
Lisp_Object val = per_buffer_value (buf, offset);
|
||||
result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
|
||||
result);
|
||||
}
|
||||
tem = buffer_local_variables_1 (buf, offset, Qnil);
|
||||
if (!NILP (tem))
|
||||
result = Fcons (tem, result);
|
||||
}
|
||||
}
|
||||
|
||||
tem = buffer_local_variables_1 (buf, PER_BUFFER_VAR_OFFSET (undo_list),
|
||||
intern ("buffer-undo-list"));
|
||||
if (!NILP (tem))
|
||||
result = Fcons (tem, result);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -319,6 +319,19 @@ the third, MAXDEPTH, the maximum stack depth used in this function.
|
|||
If the third argument is incorrect, Emacs may crash. */)
|
||||
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
|
||||
{
|
||||
if (! (STRINGP (bytestr) && VECTORP (vector) && FIXNATP (maxdepth)))
|
||||
error ("Invalid byte-code");
|
||||
|
||||
if (STRING_MULTIBYTE (bytestr))
|
||||
{
|
||||
/* BYTESTR must have been produced by Emacs 20.2 or earlier
|
||||
because it produced a raw 8-bit string for byte-code and now
|
||||
such a byte-code string is loaded as multibyte with raw 8-bit
|
||||
characters converted to multibyte form. Convert them back to
|
||||
the original unibyte form. */
|
||||
bytestr = Fstring_as_unibyte (bytestr);
|
||||
}
|
||||
|
||||
return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
|
||||
}
|
||||
|
||||
|
|
@ -344,21 +357,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
|||
int volatile this_op = 0;
|
||||
#endif
|
||||
|
||||
CHECK_STRING (bytestr);
|
||||
CHECK_VECTOR (vector);
|
||||
CHECK_FIXNAT (maxdepth);
|
||||
eassert (!STRING_MULTIBYTE (bytestr));
|
||||
|
||||
ptrdiff_t const_length = ASIZE (vector);
|
||||
|
||||
if (STRING_MULTIBYTE (bytestr))
|
||||
/* BYTESTR must have been produced by Emacs 20.2 or the earlier
|
||||
because they produced a raw 8-bit string for byte-code and now
|
||||
such a byte-code string is loaded as multibyte while raw 8-bit
|
||||
characters converted to multibyte form. Thus, now we must
|
||||
convert them back to the originally intended unibyte form. */
|
||||
bytestr = Fstring_as_unibyte (bytestr);
|
||||
|
||||
ptrdiff_t bytestr_length = SBYTES (bytestr);
|
||||
ptrdiff_t bytestr_length = SCHARS (bytestr);
|
||||
Lisp_Object *vectorp = XVECTOR (vector)->contents;
|
||||
|
||||
unsigned char quitcounter = 1;
|
||||
|
|
|
|||
|
|
@ -124,6 +124,11 @@ static const char emacs_version[] = PACKAGE_VERSION;
|
|||
static const char emacs_copyright[] = COPYRIGHT;
|
||||
static const char emacs_bugreport[] = PACKAGE_BUGREPORT;
|
||||
|
||||
/* Put version info into the executable in the form that 'ident' uses. */
|
||||
char const EXTERNALLY_VISIBLE RCS_Id[]
|
||||
= "$Id" ": GNU Emacs " PACKAGE_VERSION
|
||||
" (" EMACS_CONFIGURATION " " EMACS_CONFIG_FEATURES ") $";
|
||||
|
||||
/* Empty lisp strings. To avoid having to build any others. */
|
||||
Lisp_Object empty_unibyte_string, empty_multibyte_string;
|
||||
|
||||
|
|
|
|||
62
src/eval.c
62
src/eval.c
|
|
@ -2913,6 +2913,21 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
|
|||
}
|
||||
}
|
||||
|
||||
/* Call the compiled Lisp function FUN. If we have not yet read FUN's
|
||||
bytecode string and constants vector, fetch them from the file first. */
|
||||
|
||||
static Lisp_Object
|
||||
fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left,
|
||||
ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
|
||||
Ffetch_bytecode (fun);
|
||||
return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
|
||||
AREF (fun, COMPILED_CONSTANTS),
|
||||
AREF (fun, COMPILED_STACK_DEPTH),
|
||||
syms_left, nargs, args);
|
||||
}
|
||||
|
||||
static Lisp_Object
|
||||
apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
|
||||
{
|
||||
|
|
@ -2977,9 +2992,6 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
|
|||
}
|
||||
else if (COMPILEDP (fun))
|
||||
{
|
||||
ptrdiff_t size = PVSIZE (fun);
|
||||
if (size <= COMPILED_STACK_DEPTH)
|
||||
xsignal1 (Qinvalid_function, fun);
|
||||
syms_left = AREF (fun, COMPILED_ARGLIST);
|
||||
if (FIXNUMP (syms_left))
|
||||
/* A byte-code object with an integer args template means we
|
||||
|
|
@ -2991,15 +3003,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
|
|||
argument-binding code below instead (as do all interpreted
|
||||
functions, even lexically bound ones). */
|
||||
{
|
||||
/* If we have not actually read the bytecode string
|
||||
and constants vector yet, fetch them from the file. */
|
||||
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
|
||||
Ffetch_bytecode (fun);
|
||||
return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
|
||||
AREF (fun, COMPILED_CONSTANTS),
|
||||
AREF (fun, COMPILED_STACK_DEPTH),
|
||||
syms_left,
|
||||
nargs, arg_vector);
|
||||
return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector);
|
||||
}
|
||||
lexenv = Qnil;
|
||||
}
|
||||
|
|
@ -3068,16 +3072,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
|
|||
if (CONSP (fun))
|
||||
val = Fprogn (XCDR (XCDR (fun)));
|
||||
else
|
||||
{
|
||||
/* If we have not actually read the bytecode string
|
||||
and constants vector yet, fetch them from the file. */
|
||||
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
|
||||
Ffetch_bytecode (fun);
|
||||
val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
|
||||
AREF (fun, COMPILED_CONSTANTS),
|
||||
AREF (fun, COMPILED_STACK_DEPTH),
|
||||
Qnil, 0, 0);
|
||||
}
|
||||
val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL);
|
||||
|
||||
return unbind_to (count, val);
|
||||
}
|
||||
|
|
@ -3162,9 +3157,6 @@ lambda_arity (Lisp_Object fun)
|
|||
}
|
||||
else if (COMPILEDP (fun))
|
||||
{
|
||||
ptrdiff_t size = PVSIZE (fun);
|
||||
if (size <= COMPILED_STACK_DEPTH)
|
||||
xsignal1 (Qinvalid_function, fun);
|
||||
syms_left = AREF (fun, COMPILED_ARGLIST);
|
||||
if (FIXNUMP (syms_left))
|
||||
return get_byte_code_arity (syms_left);
|
||||
|
|
@ -3207,13 +3199,11 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
|
|||
|
||||
if (COMPILEDP (object))
|
||||
{
|
||||
ptrdiff_t size = PVSIZE (object);
|
||||
if (size <= COMPILED_STACK_DEPTH)
|
||||
xsignal1 (Qinvalid_function, object);
|
||||
if (CONSP (AREF (object, COMPILED_BYTECODE)))
|
||||
{
|
||||
tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
|
||||
if (!CONSP (tem))
|
||||
if (! (CONSP (tem) && STRINGP (XCAR (tem))
|
||||
&& VECTORP (XCDR (tem))))
|
||||
{
|
||||
tem = AREF (object, COMPILED_BYTECODE);
|
||||
if (CONSP (tem) && STRINGP (XCAR (tem)))
|
||||
|
|
@ -3221,7 +3211,19 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
|
|||
else
|
||||
error ("Invalid byte code");
|
||||
}
|
||||
ASET (object, COMPILED_BYTECODE, XCAR (tem));
|
||||
|
||||
Lisp_Object bytecode = XCAR (tem);
|
||||
if (STRING_MULTIBYTE (bytecode))
|
||||
{
|
||||
/* BYTECODE must have been produced by Emacs 20.2 or earlier
|
||||
because it produced a raw 8-bit string for byte-code and now
|
||||
such a byte-code string is loaded as multibyte with raw 8-bit
|
||||
characters converted to multibyte form. Convert them back to
|
||||
the original unibyte form. */
|
||||
bytecode = Fstring_as_unibyte (bytecode);
|
||||
}
|
||||
|
||||
ASET (object, COMPILED_BYTECODE, bytecode);
|
||||
ASET (object, COMPILED_CONSTANTS, XCDR (tem));
|
||||
}
|
||||
}
|
||||
|
|
|
|||
51
src/fns.c
51
src/fns.c
|
|
@ -2508,26 +2508,36 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
|
|||
}
|
||||
else if (STRINGP (array))
|
||||
{
|
||||
register unsigned char *p = SDATA (array);
|
||||
int charval;
|
||||
unsigned char *p = SDATA (array);
|
||||
CHECK_CHARACTER (item);
|
||||
charval = XFIXNAT (item);
|
||||
int charval = XFIXNAT (item);
|
||||
size = SCHARS (array);
|
||||
if (STRING_MULTIBYTE (array))
|
||||
if (size != 0)
|
||||
{
|
||||
CHECK_IMPURE (array, XSTRING (array));
|
||||
unsigned char str[MAX_MULTIBYTE_LENGTH];
|
||||
int len = CHAR_STRING (charval, str);
|
||||
ptrdiff_t size_byte = SBYTES (array);
|
||||
ptrdiff_t product;
|
||||
int len;
|
||||
if (STRING_MULTIBYTE (array))
|
||||
len = CHAR_STRING (charval, str);
|
||||
else
|
||||
{
|
||||
str[0] = charval;
|
||||
len = 1;
|
||||
}
|
||||
|
||||
if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte)
|
||||
error ("Attempt to change byte length of a string");
|
||||
for (idx = 0; idx < size_byte; idx++)
|
||||
*p++ = str[idx % len];
|
||||
ptrdiff_t size_byte = SBYTES (array);
|
||||
if (len == 1 && size == size_byte)
|
||||
memset (p, str[0], size);
|
||||
else
|
||||
{
|
||||
ptrdiff_t product;
|
||||
if (INT_MULTIPLY_WRAPV (size, len, &product)
|
||||
|| product != size_byte)
|
||||
error ("Attempt to change byte length of a string");
|
||||
for (idx = 0; idx < size_byte; idx++)
|
||||
*p++ = str[idx % len];
|
||||
}
|
||||
}
|
||||
else
|
||||
for (idx = 0; idx < size; idx++)
|
||||
p[idx] = charval;
|
||||
}
|
||||
else if (BOOL_VECTOR_P (array))
|
||||
return bool_vector_fill (array, item);
|
||||
|
|
@ -2542,12 +2552,15 @@ DEFUN ("clear-string", Fclear_string, Sclear_string,
|
|||
This makes STRING unibyte and may change its length. */)
|
||||
(Lisp_Object string)
|
||||
{
|
||||
ptrdiff_t len;
|
||||
CHECK_STRING (string);
|
||||
len = SBYTES (string);
|
||||
memset (SDATA (string), 0, len);
|
||||
STRING_SET_CHARS (string, len);
|
||||
STRING_SET_UNIBYTE (string);
|
||||
ptrdiff_t len = SBYTES (string);
|
||||
if (len != 0 || STRING_MULTIBYTE (string))
|
||||
{
|
||||
CHECK_IMPURE (string, XSTRING (string));
|
||||
memset (SDATA (string), 0, len);
|
||||
STRING_SET_CHARS (string, len);
|
||||
STRING_SET_UNIBYTE (string);
|
||||
}
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1343,7 +1343,6 @@ dead_object (void)
|
|||
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
|
||||
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
|
||||
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
|
||||
#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
|
||||
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
|
||||
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
|
||||
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
|
||||
|
|
@ -3943,7 +3942,6 @@ build_string (const char *str)
|
|||
|
||||
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
|
||||
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
|
||||
extern void make_byte_code (struct Lisp_Vector *);
|
||||
extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
|
||||
extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
|
||||
|
||||
|
|
|
|||
26
src/lread.c
26
src/lread.c
|
|
@ -3030,8 +3030,26 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
|
|||
struct Lisp_Vector *vec;
|
||||
tmp = read_vector (readcharfun, 1);
|
||||
vec = XVECTOR (tmp);
|
||||
if (vec->header.size == 0)
|
||||
invalid_syntax ("Empty byte-code object");
|
||||
if (! (COMPILED_STACK_DEPTH < vec->header.size
|
||||
&& (FIXNUMP (vec->contents[COMPILED_ARGLIST])
|
||||
|| CONSP (vec->contents[COMPILED_ARGLIST])
|
||||
|| NILP (vec->contents[COMPILED_ARGLIST]))
|
||||
&& ((STRINGP (vec->contents[COMPILED_BYTECODE])
|
||||
&& VECTORP (vec->contents[COMPILED_CONSTANTS]))
|
||||
|| CONSP (vec->contents[COMPILED_BYTECODE]))
|
||||
&& FIXNATP (vec->contents[COMPILED_STACK_DEPTH])))
|
||||
invalid_syntax ("Invalid byte-code object");
|
||||
|
||||
if (STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE)))
|
||||
{
|
||||
/* BYTESTR must have been produced by Emacs 20.2 or earlier
|
||||
because it produced a raw 8-bit string for byte-code and
|
||||
now such a byte-code string is loaded as multibyte with
|
||||
raw 8-bit characters converted to multibyte form.
|
||||
Convert them back to the original unibyte form. */
|
||||
ASET (tmp, COMPILED_BYTECODE,
|
||||
Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE)));
|
||||
}
|
||||
|
||||
if (COMPILED_DOC_STRING < vec->header.size
|
||||
&& EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0)))
|
||||
|
|
@ -3050,7 +3068,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
|
|||
ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash));
|
||||
}
|
||||
|
||||
make_byte_code (vec);
|
||||
XSETPVECTYPE (vec, PVEC_COMPILED);
|
||||
return tmp;
|
||||
}
|
||||
if (c == '(')
|
||||
|
|
@ -3888,8 +3906,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag)
|
|||
{
|
||||
Lisp_Object tem = read_list (1, readcharfun);
|
||||
ptrdiff_t size = list_length (tem);
|
||||
if (bytecodeflag && size <= COMPILED_STACK_DEPTH)
|
||||
error ("Invalid byte code");
|
||||
Lisp_Object vector = make_nil_vector (size);
|
||||
|
||||
Lisp_Object *ptr = XVECTOR (vector)->contents;
|
||||
|
|
|
|||
12
src/w32.c
12
src/w32.c
|
|
@ -6519,7 +6519,15 @@ acl_get_file (const char *fname, acl_type_t type)
|
|||
if (!get_file_security (fname, si, psd, sd_len, &sd_len))
|
||||
{
|
||||
xfree (psd);
|
||||
errno = EIO;
|
||||
err = GetLastError ();
|
||||
if (err == ERROR_NOT_SUPPORTED)
|
||||
errno = ENOTSUP;
|
||||
else if (err == ERROR_FILE_NOT_FOUND
|
||||
|| err == ERROR_PATH_NOT_FOUND
|
||||
|| err == ERROR_INVALID_NAME)
|
||||
errno = ENOENT;
|
||||
else
|
||||
errno = EIO;
|
||||
psd = NULL;
|
||||
}
|
||||
}
|
||||
|
|
@ -6530,6 +6538,8 @@ acl_get_file (const char *fname, acl_type_t type)
|
|||
be encoded in the current ANSI codepage. */
|
||||
|| err == ERROR_INVALID_NAME)
|
||||
errno = ENOENT;
|
||||
else if (err == ERROR_NOT_SUPPORTED)
|
||||
errno = ENOTSUP;
|
||||
else
|
||||
errno = EIO;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -546,6 +546,24 @@ baz\"\""
|
|||
(electric-pair-delete-pair 1)
|
||||
(should (equal "" (buffer-string))))))
|
||||
|
||||
|
||||
;;; Undoing
|
||||
(ert-deftest electric-pair-undo-unrelated-state ()
|
||||
"Make sure `electric-pair-mode' does not confuse `undo' (bug#39680)."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(electric-pair-local-mode)
|
||||
(let ((last-command-event ?\())
|
||||
(ert-simulate-command '(self-insert-command 1)))
|
||||
(undo-boundary)
|
||||
(let ((last-command-event ?a))
|
||||
(ert-simulate-command '(self-insert-command 1)))
|
||||
(undo-boundary)
|
||||
(ert-simulate-command '(undo))
|
||||
(let ((last-command-event ?\())
|
||||
(ert-simulate-command '(self-insert-command 1)))
|
||||
(should (string= (buffer-string) "(())"))))
|
||||
|
||||
|
||||
;;; Electric newlines between pairs
|
||||
;;; TODO: better tests
|
||||
|
|
|
|||
67
test/lisp/emacs-lisp/syntax-tests.el
Normal file
67
test/lisp/emacs-lisp/syntax-tests.el
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
;;; syntax-tests.el --- tests for syntax.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2020 Free Software Foundation, Inc.
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'syntax)
|
||||
|
||||
(ert-deftest syntax-propertize--shift-groups-and-backrefs ()
|
||||
"Test shifting of numbered groups and back-references in regexps."
|
||||
;; A numbered group must be shifted.
|
||||
(should
|
||||
(string=
|
||||
(syntax-propertize--shift-groups-and-backrefs
|
||||
"\\(?2:[abc]+\\)foobar" 2)
|
||||
"\\(?4:[abc]+\\)foobar"))
|
||||
;; A back-reference \1 on a normal sub-regexp context must be
|
||||
;; shifted.
|
||||
(should
|
||||
(string=
|
||||
(syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\1" 2)
|
||||
"\\(a\\)\\3"))
|
||||
;; Shifting must not happen if the \1 appears in a character class,
|
||||
;; or in a \{\} repetition construct (although \1 isn't valid there
|
||||
;; anyway).
|
||||
(let ((rx-with-class "\\(a\\)[\\1-2]")
|
||||
(rx-with-rep "\\(a\\)\\{1,\\1\\}"))
|
||||
(should
|
||||
(string=
|
||||
(syntax-propertize--shift-groups-and-backrefs rx-with-class 2)
|
||||
rx-with-class))
|
||||
(should
|
||||
(string=
|
||||
(syntax-propertize--shift-groups-and-backrefs rx-with-rep 2)
|
||||
rx-with-rep)))
|
||||
;; Now numbered groups and back-references in combination.
|
||||
(should
|
||||
(string=
|
||||
(syntax-propertize--shift-groups-and-backrefs
|
||||
"\\(?2:[abc]+\\)foo\\(\\2\\)" 2)
|
||||
"\\(?4:[abc]+\\)foo\\(\\4\\)"))
|
||||
;; Emacs supports only the back-references \1,...,\9, so when a
|
||||
;; shift would result in \10 or more, an error must be signalled.
|
||||
(should-error
|
||||
(syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7)))
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
||||
;;; syntax-tests.el ends here.
|
||||
File diff suppressed because it is too large
Load diff
73
test/lisp/net/webjump-tests.el
Normal file
73
test/lisp/net/webjump-tests.el
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
;;; webjump-tests.el --- Tests for webjump.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Simen Heggestøyl <simenheg@gmail.com>
|
||||
;; Keywords:
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'webjump)
|
||||
|
||||
(ert-deftest webjump-tests-builtin ()
|
||||
(should (equal (webjump-builtin '[name] "gnu.org") "gnu.org")))
|
||||
|
||||
(ert-deftest webjump-tests-builtin-check-args ()
|
||||
(should (webjump-builtin-check-args [1 2 3] "Foo" 2))
|
||||
(should-error (webjump-builtin-check-args [1 2 3] "Foo" 3)))
|
||||
|
||||
(ert-deftest webjump-tests-mirror-default ()
|
||||
(should (equal (webjump-mirror-default
|
||||
'("https://ftp.gnu.org/pub/gnu/"
|
||||
"https://ftpmirror.gnu.org"))
|
||||
"https://ftp.gnu.org/pub/gnu/")))
|
||||
|
||||
(ert-deftest webjump-tests-null-or-blank-string-p ()
|
||||
(should (webjump-null-or-blank-string-p nil))
|
||||
(should (webjump-null-or-blank-string-p ""))
|
||||
(should (webjump-null-or-blank-string-p " "))
|
||||
(should-not (webjump-null-or-blank-string-p " . ")))
|
||||
|
||||
(ert-deftest webjump-tests-url-encode ()
|
||||
(should (equal (webjump-url-encode "") ""))
|
||||
(should (equal (webjump-url-encode "a b c") "a+b+c"))
|
||||
(should (equal (webjump-url-encode "foo?") "foo%3F"))
|
||||
(should (equal (webjump-url-encode "/foo\\") "/foo%5C"))
|
||||
(should (equal (webjump-url-encode "f&o") "f%26o")))
|
||||
|
||||
(ert-deftest webjump-tests-url-fix ()
|
||||
(should (equal (webjump-url-fix nil) ""))
|
||||
(should (equal (webjump-url-fix "/tmp/") "file:///tmp/"))
|
||||
(should (equal (webjump-url-fix "gnu.org") "http://gnu.org/"))
|
||||
(should (equal (webjump-url-fix "ftp.x.org") "ftp://ftp.x.org/"))
|
||||
(should (equal (webjump-url-fix "https://gnu.org")
|
||||
"https://gnu.org/")))
|
||||
|
||||
(ert-deftest webjump-tests-url-fix-trailing-slash ()
|
||||
(should (equal (webjump-url-fix-trailing-slash "https://gnu.org")
|
||||
"https://gnu.org/"))
|
||||
(should (equal (webjump-url-fix-trailing-slash "https://gnu.org/")
|
||||
"https://gnu.org/")))
|
||||
|
||||
(provide 'webjump-tests)
|
||||
;;; webjump-tests.el ends here
|
||||
|
|
@ -164,6 +164,16 @@ Parser is called with and without 'symbol-qnames argument.")
|
|||
(should (equal (cdr xml-parse-test--namespace-attribute-qnames)
|
||||
(xml-parse-region nil nil nil nil 'symbol-qnames)))))
|
||||
|
||||
(ert-deftest xml-print-invalid-cdata ()
|
||||
"Check that Bug#41094 is fixed."
|
||||
(with-temp-buffer
|
||||
(should (equal (should-error (xml-print '((foo () "\0")))
|
||||
:type 'xml-invalid-character)
|
||||
'(xml-invalid-character 0 1)))
|
||||
(should (equal (should-error (xml-print '((foo () "\u00FF \xFF")))
|
||||
:type 'xml-invalid-character)
|
||||
'(xml-invalid-character #x3FFFFF 3)))))
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
|
|||
|
|
@ -1327,4 +1327,10 @@ with parameters from the *Messages* buffer modification."
|
|||
(set-buffer-multibyte t)
|
||||
(buffer-string)))))))
|
||||
|
||||
;; https://debbugs.gnu.org/33492
|
||||
(ert-deftest buffer-tests-buffer-local-variables-undo ()
|
||||
"Test that `buffer-undo-list' appears in `buffer-local-variables'."
|
||||
(with-temp-buffer
|
||||
(should (assq 'buffer-undo-list (buffer-local-variables)))))
|
||||
|
||||
;;; buffer-tests.el ends here
|
||||
|
|
|
|||
Loading…
Reference in a new issue