diff options
| author | Andrea Corallo | 2020-05-24 10:20:23 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2020-05-24 10:20:23 +0100 |
| commit | 9daffe9cfe82d3b1e1e9fa8929dbb40cfed60f0f (patch) | |
| tree | c9e78cbb4e151dc3c3996a65cf1eedab19248fb4 | |
| parent | f5dceed09a8234548d5b3acb76d443569533cab9 (diff) | |
| parent | e021c2dc2279e0fd3a5331f9ea661e4d39c2e840 (diff) | |
| download | emacs-9daffe9cfe82d3b1e1e9fa8929dbb40cfed60f0f.tar.gz emacs-9daffe9cfe82d3b1e1e9fa8929dbb40cfed60f0f.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
61 files changed, 2064 insertions, 1219 deletions
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 834a5c6159d..6b1f35e6158 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi | |||
| @@ -727,6 +727,8 @@ them. Rectangle commands are useful with text in multicolumn formats, | |||
| 727 | and for changing text into or out of such formats. | 727 | and for changing text into or out of such formats. |
| 728 | 728 | ||
| 729 | @cindex mark rectangle | 729 | @cindex mark rectangle |
| 730 | @cindex region-rectangle | ||
| 731 | @cindex rectangular region | ||
| 730 | To specify a rectangle for a command to work on, set the mark at one | 732 | To specify a rectangle for a command to work on, set the mark at one |
| 731 | corner and point at the opposite corner. The rectangle thus specified | 733 | corner and point at the opposite corner. The rectangle thus specified |
| 732 | is called the @dfn{region-rectangle}. If point and the mark are in | 734 | is called the @dfn{region-rectangle}. If point and the mark are in |
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index e3fe20c76f8..373c7b55817 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi | |||
| @@ -1326,16 +1326,17 @@ stored in the system and the available font names are defined by the | |||
| 1326 | system, fontsets are defined within Emacs itself. Once you have | 1326 | system, fontsets are defined within Emacs itself. Once you have |
| 1327 | defined a fontset, you can use it within Emacs by specifying its name, | 1327 | defined a fontset, you can use it within Emacs by specifying its name, |
| 1328 | anywhere that you could use a single font. Of course, Emacs fontsets | 1328 | anywhere that you could use a single font. Of course, Emacs fontsets |
| 1329 | can use only the fonts that the system supports. If some characters | 1329 | can use only the fonts that your system supports. If some characters |
| 1330 | appear on the screen as empty boxes or hex codes, this means that the | 1330 | appear on the screen as empty boxes or hex codes, this means that the |
| 1331 | fontset in use for them has no font for those characters. In this | 1331 | fontset in use for them has no font for those characters. In this |
| 1332 | case, or if the characters are shown, but not as well as you would | 1332 | case, or if the characters are shown, but not as well as you would |
| 1333 | like, you may need to install extra fonts. Your operating system may | 1333 | like, you may need to install extra fonts or modify the fontset to use |
| 1334 | have optional fonts that you can install; or you can install the GNU | 1334 | specific fonts already installed on your system (see below). Your |
| 1335 | Intlfonts package, which includes fonts for most supported | 1335 | operating system may have optional fonts that you can install; or you |
| 1336 | scripts.@footnote{If you run Emacs on X, you may need to inform the X | 1336 | can install the GNU Intlfonts package, which includes fonts for most |
| 1337 | server about the location of the newly installed fonts with commands | 1337 | supported scripts.@footnote{If you run Emacs on X, you may need to |
| 1338 | such as: | 1338 | inform the X server about the location of the newly installed fonts |
| 1339 | with commands such as: | ||
| 1339 | @c FIXME? I feel like this may be out of date. | 1340 | @c FIXME? I feel like this may be out of date. |
| 1340 | @c E.g., the intlfonts tarfile is ~ 10 years old. | 1341 | @c E.g., the intlfonts tarfile is ~ 10 years old. |
| 1341 | 1342 | ||
| @@ -1376,14 +1377,20 @@ explicitly requested, despite its name. | |||
| 1376 | @w{@kbd{M-x describe-fontset}} command. It prompts for a fontset | 1377 | @w{@kbd{M-x describe-fontset}} command. It prompts for a fontset |
| 1377 | name, defaulting to the one used by the current frame, and then | 1378 | name, defaulting to the one used by the current frame, and then |
| 1378 | displays all the subranges of characters and the fonts assigned to | 1379 | displays all the subranges of characters and the fonts assigned to |
| 1379 | them in that fontset. | 1380 | them in that fontset. To see which fonts Emacs is using in a session |
| 1381 | started without a specific fontset (which is what happens normally), | ||
| 1382 | type @kbd{fontset-default @key{RET}} at the prompt, or just | ||
| 1383 | @kbd{@key{RET}} to describe the fontset used by the current frame. | ||
| 1380 | 1384 | ||
| 1381 | A fontset does not necessarily specify a font for every character | 1385 | A fontset does not necessarily specify a font for every character |
| 1382 | code. If a fontset specifies no font for a certain character, or if | 1386 | code. If a fontset specifies no font for a certain character, or if |
| 1383 | it specifies a font that does not exist on your system, then it cannot | 1387 | it specifies a font that does not exist on your system, then it cannot |
| 1384 | display that character properly. It will display that character as a | 1388 | display that character properly. It will display that character as a |
| 1385 | hex code or thin space or an empty box instead. (@xref{Text Display, , | 1389 | hex code or thin space or an empty box instead. (@xref{Text Display, |
| 1386 | glyphless characters}, for details.) | 1390 | , glyphless characters}, for details.) Or a fontset might specify a |
| 1391 | font for some range of characters, but you may not like their visual | ||
| 1392 | appearance. If this happens, you may wish to modify your fontset; see | ||
| 1393 | @ref{Modifying Fontsets}, for how to do that. | ||
| 1387 | 1394 | ||
| 1388 | @node Defining Fontsets | 1395 | @node Defining Fontsets |
| 1389 | @section Defining Fontsets | 1396 | @section Defining Fontsets |
| @@ -1542,10 +1549,10 @@ call this function explicitly to create a fontset. | |||
| 1542 | 1549 | ||
| 1543 | Fontsets do not always have to be created from scratch. If only | 1550 | Fontsets do not always have to be created from scratch. If only |
| 1544 | minor changes are required it may be easier to modify an existing | 1551 | minor changes are required it may be easier to modify an existing |
| 1545 | fontset. Modifying @samp{fontset-default} will also affect other | 1552 | fontset, usually @samp{fontset-default}. Modifying |
| 1546 | fontsets that use it as a fallback, so can be an effective way of | 1553 | @samp{fontset-default} will also affect other fontsets that use it as |
| 1547 | fixing problems with the fonts that Emacs chooses for a particular | 1554 | a fallback, so can be an effective way of fixing problems with the |
| 1548 | script. | 1555 | fonts that Emacs chooses for a particular script. |
| 1549 | 1556 | ||
| 1550 | Fontsets can be modified using the function @code{set-fontset-font}, | 1557 | Fontsets can be modified using the function @code{set-fontset-font}, |
| 1551 | specifying a character, a charset, a script, or a range of characters | 1558 | 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 | |||
| 1553 | used. Some examples are: | 1560 | used. Some examples are: |
| 1554 | 1561 | ||
| 1555 | @example | 1562 | @example |
| 1556 | ;; Use Liberation Mono for latin-3 charset. | ||
| 1557 | (set-fontset-font "fontset-default" 'iso-8859-3 | ||
| 1558 | "Liberation Mono") | ||
| 1559 | |||
| 1560 | ;; Prefer a big5 font for han characters. | 1563 | ;; Prefer a big5 font for han characters. |
| 1561 | (set-fontset-font "fontset-default" | 1564 | (set-fontset-font "fontset-default" |
| 1562 | 'han (font-spec :registry "big5") | 1565 | 'han (font-spec :registry "big5") |
| 1563 | nil 'prepend) | 1566 | nil 'prepend) |
| 1564 | 1567 | ||
| 1568 | ;; Use MyPrivateFont for the Unicode private use area. | ||
| 1569 | (set-fontset-font "fontset-default" '(#xe000 . #xf8ff) | ||
| 1570 | "MyPrivateFont") | ||
| 1571 | |||
| 1572 | ;; Use Liberation Mono for latin-3 charset. | ||
| 1573 | (set-fontset-font "fontset-default" 'iso-8859-3 | ||
| 1574 | "Liberation Mono") | ||
| 1575 | |||
| 1565 | ;; Use DejaVu Sans Mono as a fallback in fontset-startup | 1576 | ;; Use DejaVu Sans Mono as a fallback in fontset-startup |
| 1566 | ;; before resorting to fontset-default. | 1577 | ;; before resorting to fontset-default. |
| 1567 | (set-fontset-font "fontset-startup" nil "DejaVu Sans Mono" | 1578 | (set-fontset-font "fontset-startup" nil "DejaVu Sans Mono" |
| 1568 | nil 'append) | 1579 | nil 'append) |
| 1580 | @end example | ||
| 1569 | 1581 | ||
| 1570 | ;; Use MyPrivateFont for the Unicode private use area. | 1582 | @noindent |
| 1571 | (set-fontset-font "fontset-default" '(#xe000 . #xf8ff) | 1583 | @xref{Fontsets, , , elisp, GNU Emacs Lisp Reference Manual}, for more |
| 1572 | "MyPrivateFont") | 1584 | details about using the @code{set-fontset-font} function. |
| 1585 | |||
| 1586 | @cindex script of a character | ||
| 1587 | @cindex codepoint of a character | ||
| 1588 | If you don't know the character's codepoint or the script to which it | ||
| 1589 | belongs, you can ask Emacs. With point at the character, type | ||
| 1590 | @w{@kbd{C-u C-x =}} (@code{what-cursor-position}), and this | ||
| 1591 | information, together with much more, will be displayed in the | ||
| 1592 | @file{*Help*} buffer that Emacs pops up. @xref{Position Info}. For | ||
| 1593 | example, Japanese characters belong to the @samp{kana} script, but | ||
| 1594 | Japanese text also mixes them with Chinese characters so the following | ||
| 1595 | uses the @samp{han} script to set up Emacs to use the @samp{Kochi | ||
| 1596 | Gothic} font for Japanese text: | ||
| 1573 | 1597 | ||
| 1598 | @example | ||
| 1599 | (set-fontset-font "fontset-default" 'han "Kochi Gothic") | ||
| 1574 | @end example | 1600 | @end example |
| 1575 | 1601 | ||
| 1602 | @noindent | ||
| 1603 | @cindex CKJ characters | ||
| 1604 | (For convenience, the @samp{han} script in Emacs is set up to support | ||
| 1605 | all of the Chinese, Japanese, and Korean, a.k.a.@: @acronym{CJK}, | ||
| 1606 | characters, not just Chinese characters.) | ||
| 1607 | |||
| 1608 | @vindex script-representative-chars | ||
| 1609 | For the list of known scripts, see the variable | ||
| 1610 | @code{script-representative-chars}. | ||
| 1611 | |||
| 1612 | Fontset settings like those above only affect characters that the | ||
| 1613 | default font doesn't support, so if the @samp{Kochi Gothic} font | ||
| 1614 | covers Latin characters, it will not be used for displaying Latin | ||
| 1615 | scripts, since the default font used by Emacs usually covers Basic | ||
| 1616 | Latin. | ||
| 1617 | |||
| 1576 | @cindex ignore font | 1618 | @cindex ignore font |
| 1577 | @cindex fonts, how to ignore | 1619 | @cindex fonts, how to ignore |
| 1578 | @vindex face-ignored-fonts | 1620 | @vindex face-ignored-fonts |
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 7484ce57607..f6dd77a3d96 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi | |||
| @@ -7317,8 +7317,6 @@ which leave the original list as it was. One way to find out how this | |||
| 7317 | works is to experiment. We will start with the @code{setcar} function. | 7317 | works is to experiment. We will start with the @code{setcar} function. |
| 7318 | 7318 | ||
| 7319 | @need 1200 | 7319 | @need 1200 |
| 7320 | @cindex constant lists | ||
| 7321 | @cindex mutable lists | ||
| 7322 | First, we can make a list and then set the value of a variable to the | 7320 | First, we can make a list and then set the value of a variable to the |
| 7323 | list, using the @code{setq} special form. Because we intend to use | 7321 | list, using the @code{setq} special form. Because we intend to use |
| 7324 | @code{setcar} to change the list, this @code{setq} should not use the | 7322 | @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 | |||
| 7327 | tried to change part of the program while running it. Generally | 7325 | tried to change part of the program while running it. Generally |
| 7328 | speaking an Emacs Lisp program's components should be constant (or | 7326 | speaking an Emacs Lisp program's components should be constant (or |
| 7329 | unchanged) while the program is running. So we instead construct an | 7327 | unchanged) while the program is running. So we instead construct an |
| 7330 | animal list that is @dfn{mutable} (or changeable) by using the | 7328 | animal list by using the @code{list} function, as follows: |
| 7331 | @code{list} function, as follows: | ||
| 7332 | 7329 | ||
| 7333 | @smallexample | 7330 | @smallexample |
| 7334 | (setq animals (list 'antelope 'giraffe 'lion 'tiger)) | 7331 | (setq animals (list 'antelope 'giraffe 'lion 'tiger)) |
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index c601e3af9bc..58f93366fe9 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi | |||
| @@ -1905,6 +1905,7 @@ variables precisely as they were at the time of the error. | |||
| 1905 | @subsubsection Writing Code to Handle Errors | 1905 | @subsubsection Writing Code to Handle Errors |
| 1906 | @cindex error handler | 1906 | @cindex error handler |
| 1907 | @cindex handling errors | 1907 | @cindex handling errors |
| 1908 | @cindex handle Lisp errors | ||
| 1908 | @cindex forms for handling errors | 1909 | @cindex forms for handling errors |
| 1909 | 1910 | ||
| 1910 | The usual effect of signaling an error is to terminate the command | 1911 | The usual effect of signaling an error is to terminate the command |
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index e53f0e9f60c..3d738b9965f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi | |||
| @@ -3597,9 +3597,9 @@ characters in the range @var{from} and @var{to} (inclusive). | |||
| 3597 | @var{character} may be a charset (@pxref{Character Sets}). In that | 3597 | @var{character} may be a charset (@pxref{Character Sets}). In that |
| 3598 | case, use @var{font-spec} for all the characters in the charset. | 3598 | case, use @var{font-spec} for all the characters in the charset. |
| 3599 | 3599 | ||
| 3600 | @var{character} may be a script name (@pxref{Character Properties}). | 3600 | @var{character} may be a script name (@pxref{Character Properties, |
| 3601 | In that case, use @var{font-spec} for all the characters belonging to | 3601 | char-script-table}). In that case, use @var{font-spec} for all the |
| 3602 | the script. | 3602 | characters belonging to the script. |
| 3603 | 3603 | ||
| 3604 | @var{character} may be @code{nil}, which means to use @var{font-spec} | 3604 | @var{character} may be @code{nil}, which means to use @var{font-spec} |
| 3605 | for any character which no font-spec is specified. | 3605 | for any character which no font-spec is specified. |
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index bba1b63115f..9a6796790c4 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi | |||
| @@ -297,7 +297,7 @@ Lisp Data Types | |||
| 297 | * Circular Objects:: Read syntax for circular structure. | 297 | * Circular Objects:: Read syntax for circular structure. |
| 298 | * Type Predicates:: Tests related to types. | 298 | * Type Predicates:: Tests related to types. |
| 299 | * Equality Predicates:: Tests of equality between any two objects. | 299 | * Equality Predicates:: Tests of equality between any two objects. |
| 300 | * Constants and Mutability:: Whether an object's value can change. | 300 | * Mutability:: Some objects should not be modified. |
| 301 | 301 | ||
| 302 | Programming Types | 302 | Programming Types |
| 303 | 303 | ||
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index baddce4d9c9..39f342a798b 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi | |||
| @@ -158,11 +158,11 @@ contents unchanged. | |||
| 158 | @end group | 158 | @end group |
| 159 | @end example | 159 | @end example |
| 160 | 160 | ||
| 161 | A self-evaluating form yields constant conses, vectors and strings, and you | 161 | A self-evaluating form yields a value that becomes part of the program, |
| 162 | should not attempt to modify their contents via @code{setcar}, @code{aset} or | 162 | and you should not try to modify it via @code{setcar}, @code{aset} or |
| 163 | similar operations. The Lisp interpreter might unify the constants | 163 | similar operations. The Lisp interpreter might unify the constants |
| 164 | yielded by your program's self-evaluating forms, so that these | 164 | yielded by your program's self-evaluating forms, so that these |
| 165 | constants might share structure. @xref{Constants and Mutability}. | 165 | constants might share structure. @xref{Mutability}. |
| 166 | 166 | ||
| 167 | It is common to write numbers, characters, strings, and even vectors | 167 | It is common to write numbers, characters, strings, and even vectors |
| 168 | in Lisp code, taking advantage of the fact that they self-evaluate. | 168 | in Lisp code, taking advantage of the fact that they self-evaluate. |
| @@ -564,8 +564,8 @@ and vectors.) | |||
| 564 | 564 | ||
| 565 | @defspec quote object | 565 | @defspec quote object |
| 566 | This special form returns @var{object}, without evaluating it. | 566 | This special form returns @var{object}, without evaluating it. |
| 567 | The returned value is a constant, and should not be modified. | 567 | The returned value might be shared and should not be modified. |
| 568 | @xref{Constants and Mutability}. | 568 | @xref{Self-Evaluating Forms}. |
| 569 | @end defspec | 569 | @end defspec |
| 570 | 570 | ||
| 571 | @cindex @samp{'} for quoting | 571 | @cindex @samp{'} for quoting |
| @@ -608,9 +608,9 @@ Here are some examples of expressions that use @code{quote}: | |||
| 608 | 608 | ||
| 609 | Although the expressions @code{(list '+ 1 2)} and @code{'(+ 1 2)} | 609 | Although the expressions @code{(list '+ 1 2)} and @code{'(+ 1 2)} |
| 610 | both yield lists equal to @code{(+ 1 2)}, the former yields a | 610 | both yield lists equal to @code{(+ 1 2)}, the former yields a |
| 611 | freshly-minted mutable list whereas the latter yields a constant list | 611 | freshly-minted mutable list whereas the latter yields a list |
| 612 | built from conses that may be shared with other constants. | 612 | built from conses that might be shared and should not be modified. |
| 613 | @xref{Constants and Mutability}. | 613 | @xref{Self-Evaluating Forms}. |
| 614 | 614 | ||
| 615 | Other quoting constructs include @code{function} (@pxref{Anonymous | 615 | Other quoting constructs include @code{function} (@pxref{Anonymous |
| 616 | Functions}), which causes an anonymous lambda expression written in Lisp | 616 | Functions}), which causes an anonymous lambda expression written in Lisp |
| @@ -710,8 +710,9 @@ Here are some examples: | |||
| 710 | @end example | 710 | @end example |
| 711 | 711 | ||
| 712 | If a subexpression of a backquote construct has no substitutions or | 712 | If a subexpression of a backquote construct has no substitutions or |
| 713 | splices, it acts like @code{quote} in that it yields constant conses, | 713 | splices, it acts like @code{quote} in that it yields conses, |
| 714 | vectors and strings that should not be modified. | 714 | vectors and strings that might be shared and should not be modified. |
| 715 | @xref{Self-Evaluating Forms}. | ||
| 715 | 716 | ||
| 716 | @node Eval | 717 | @node Eval |
| 717 | @section Eval | 718 | @section Eval |
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index fcaf4386b15..ae793d5e15e 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi | |||
| @@ -873,8 +873,8 @@ primitives @code{setcar} and @code{setcdr}. These are destructive | |||
| 873 | operations because they change existing list structure. | 873 | operations because they change existing list structure. |
| 874 | Destructive operations should be applied only to mutable lists, | 874 | Destructive operations should be applied only to mutable lists, |
| 875 | that is, lists constructed via @code{cons}, @code{list} or similar | 875 | that is, lists constructed via @code{cons}, @code{list} or similar |
| 876 | operations. Lists created by quoting are constants and should not be | 876 | operations. Lists created by quoting are part of the program and |
| 877 | changed by destructive operations. @xref{Constants and Mutability}. | 877 | should not be changed by destructive operations. @xref{Mutability}. |
| 878 | 878 | ||
| 879 | @cindex CL note---@code{rplaca} vs @code{setcar} | 879 | @cindex CL note---@code{rplaca} vs @code{setcar} |
| 880 | @quotation | 880 | @quotation |
| @@ -911,7 +911,7 @@ value @var{object}. For example: | |||
| 911 | 911 | ||
| 912 | @example | 912 | @example |
| 913 | @group | 913 | @group |
| 914 | (setq x (list 1 2)) ; @r{Create a mutable list.} | 914 | (setq x (list 1 2)) |
| 915 | @result{} (1 2) | 915 | @result{} (1 2) |
| 916 | @end group | 916 | @end group |
| 917 | @group | 917 | @group |
| @@ -931,7 +931,7 @@ these lists. Here is an example: | |||
| 931 | 931 | ||
| 932 | @example | 932 | @example |
| 933 | @group | 933 | @group |
| 934 | ;; @r{Create two mutable lists that are partly shared.} | 934 | ;; @r{Create two lists that are partly shared.} |
| 935 | (setq x1 (list 'a 'b 'c)) | 935 | (setq x1 (list 'a 'b 'c)) |
| 936 | @result{} (a b c) | 936 | @result{} (a b c) |
| 937 | (setq x2 (cons 'z (cdr x1))) | 937 | (setq x2 (cons 'z (cdr x1))) |
| @@ -1022,11 +1022,11 @@ reached via the @sc{cdr}. | |||
| 1022 | 1022 | ||
| 1023 | @example | 1023 | @example |
| 1024 | @group | 1024 | @group |
| 1025 | (setq x (list 1 2 3)) ; @r{Create a mutable list.} | 1025 | (setq x (list 1 2 3)) |
| 1026 | @result{} (1 2 3) | 1026 | @result{} (1 2 3) |
| 1027 | @end group | 1027 | @end group |
| 1028 | @group | 1028 | @group |
| 1029 | (setcdr x '(4)) ; @r{Modify the list's tail to be a constant list.} | 1029 | (setcdr x '(4)) |
| 1030 | @result{} (4) | 1030 | @result{} (4) |
| 1031 | @end group | 1031 | @end group |
| 1032 | @group | 1032 | @group |
| @@ -1135,11 +1135,11 @@ Unlike @code{append} (@pxref{Building Lists}), the @var{lists} are | |||
| 1135 | 1135 | ||
| 1136 | @example | 1136 | @example |
| 1137 | @group | 1137 | @group |
| 1138 | (setq x (list 1 2 3)) ; @r{Create a mutable list.} | 1138 | (setq x (list 1 2 3)) |
| 1139 | @result{} (1 2 3) | 1139 | @result{} (1 2 3) |
| 1140 | @end group | 1140 | @end group |
| 1141 | @group | 1141 | @group |
| 1142 | (nconc x '(4 5)) ; @r{Modify the list's tail to be a constant list.} | 1142 | (nconc x '(4 5)) |
| 1143 | @result{} (1 2 3 4 5) | 1143 | @result{} (1 2 3 4 5) |
| 1144 | @end group | 1144 | @end group |
| 1145 | @group | 1145 | @group |
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index cd037d663da..83066744121 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi | |||
| @@ -46,10 +46,6 @@ you store in it, type and all. (Actually, a small number of Emacs | |||
| 46 | Lisp variables can only take on values of a certain type. | 46 | Lisp variables can only take on values of a certain type. |
| 47 | @xref{Variables with Restricted Values}.) | 47 | @xref{Variables with Restricted Values}.) |
| 48 | 48 | ||
| 49 | Some Lisp objects are @dfn{constant}: their values should never change. | ||
| 50 | Others are @dfn{mutable}: their values can be changed via destructive | ||
| 51 | operations that involve side effects. | ||
| 52 | |||
| 53 | This chapter describes the purpose, printed representation, and read | 49 | This chapter describes the purpose, printed representation, and read |
| 54 | syntax of each of the standard types in GNU Emacs Lisp. Details on how | 50 | syntax of each of the standard types in GNU Emacs Lisp. Details on how |
| 55 | to use these types can be found in later chapters. | 51 | to use these types can be found in later chapters. |
| @@ -63,7 +59,7 @@ to use these types can be found in later chapters. | |||
| 63 | * Circular Objects:: Read syntax for circular structure. | 59 | * Circular Objects:: Read syntax for circular structure. |
| 64 | * Type Predicates:: Tests related to types. | 60 | * Type Predicates:: Tests related to types. |
| 65 | * Equality Predicates:: Tests of equality between any two objects. | 61 | * Equality Predicates:: Tests of equality between any two objects. |
| 66 | * Constants and Mutability:: Whether an object's value can change. | 62 | * Mutability:: Some objects should not be modified. |
| 67 | @end menu | 63 | @end menu |
| 68 | 64 | ||
| 69 | @node Printed Representation | 65 | @node Printed Representation |
| @@ -2383,51 +2379,58 @@ that for two strings to be equal, they have the same text properties. | |||
| 2383 | @end example | 2379 | @end example |
| 2384 | @end defun | 2380 | @end defun |
| 2385 | 2381 | ||
| 2386 | @node Constants and Mutability | 2382 | @node Mutability |
| 2387 | @section Constants and Mutability | 2383 | @section Mutability |
| 2388 | @cindex constants | ||
| 2389 | @cindex mutable objects | 2384 | @cindex mutable objects |
| 2390 | 2385 | ||
| 2391 | Some Lisp objects are constant: their values should never change | 2386 | Some Lisp objects should never change. For example, the Lisp |
| 2392 | during a single execution of Emacs running well-behaved Lisp code. | 2387 | expression @code{"aaa"} yields a string, but you should not change |
| 2393 | For example, you can create a new integer by calculating one, but you | 2388 | its contents. And some objects cannot be changed; for example, |
| 2394 | cannot modify the value of an existing integer. | 2389 | although you can create a new number by calculating one, Lisp provides |
| 2395 | 2390 | no operation to change the value of an existing number. | |
| 2396 | Other Lisp objects are mutable: it is safe to change their values | 2391 | |
| 2397 | via destructive operations involving side effects. For example, an | 2392 | Other Lisp objects are @dfn{mutable}: it is safe to change their |
| 2398 | existing marker can be changed by moving the marker to point to | 2393 | values via destructive operations involving side effects. For |
| 2399 | somewhere else. | 2394 | example, an existing marker can be changed by moving the marker to |
| 2400 | 2395 | point to somewhere else. | |
| 2401 | Although all numbers are constants and all markers are | 2396 | |
| 2402 | mutable, some types contain both constant and mutable members. These | 2397 | Although numbers never change and all markers are mutable, |
| 2403 | types include conses, vectors, strings, and symbols. For example, the string | 2398 | some types have members some of which are mutable and others not. These |
| 2404 | literal @code{"aaa"} yields a constant string, whereas the function | 2399 | types include conses, vectors, and strings. For example, |
| 2405 | call @code{(make-string 3 ?a)} yields a mutable string that can be | 2400 | although @code{"cons"} and @code{(symbol-name 'cons)} both yield |
| 2401 | strings that should not be changed, @code{(copy-sequence "cons")} and | ||
| 2402 | @code{(make-string 3 ?a)} both yield mutable strings that can be | ||
| 2406 | changed via later calls to @code{aset}. | 2403 | changed via later calls to @code{aset}. |
| 2407 | 2404 | ||
| 2408 | A mutable object can become constant if it is part of an expression | 2405 | A mutable object stops being mutable if it is part of an expression |
| 2409 | that is evaluated. The reverse does not occur: constant objects | 2406 | that is evaluated. For example: |
| 2410 | should stay constant. | 2407 | |
| 2411 | 2408 | @example | |
| 2412 | Trying to modify a constant variable signals an error | 2409 | (let* ((x (list 0.5)) |
| 2413 | (@pxref{Constant Variables}). | 2410 | (y (eval (list 'quote x)))) |
| 2414 | A program should not attempt to modify other types of constants because the | 2411 | (setcar x 1.5) ;; The program should not do this. |
| 2415 | resulting behavior is undefined: the Lisp interpreter might or might | 2412 | y) |
| 2416 | not detect the error, and if it does not detect the error the | 2413 | @end example |
| 2417 | interpreter can behave unpredictably thereafter. Another way to put | 2414 | |
| 2418 | this is that although mutable objects are safe to change and constant | 2415 | @noindent |
| 2419 | variables reliably prevent attempts to change them, other constants | 2416 | Although the list @code{(0.5)} was mutable when it was created, it should not |
| 2420 | are not safely mutable: if a misbehaving program tries to change such a | 2417 | have been changed via @code{setcar} because it given to @code{eval}. The |
| 2421 | constant then the constant's value might actually change, or the | 2418 | reverse does not occur: an object that should not be changed never |
| 2422 | program might crash or worse. This problem occurs | 2419 | becomes mutable afterwards. |
| 2423 | with types that have both constant and mutable members, and that have | 2420 | |
| 2424 | mutators like @code{setcar} and @code{aset} that are valid on mutable | 2421 | If a program attempts to change objects that should not be |
| 2425 | objects but hazardous on constants. | 2422 | changed, the resulting behavior is undefined: the Lisp interpreter |
| 2426 | 2423 | might signal an error, or it might crash or behave unpredictably in | |
| 2427 | When the same constant occurs multiple times in a program, the Lisp | 2424 | other ways.@footnote{This is the behavior specified for languages like |
| 2425 | Common Lisp and C for constants, and this differs from languages like | ||
| 2426 | JavaScript and Python where an interpreter is required to signal an | ||
| 2427 | error if a program attempts to change an immutable object. Ideally the Emacs | ||
| 2428 | Lisp interpreter will evolve in latter direction.} | ||
| 2429 | |||
| 2430 | When similar constants occur as parts of a program, the Lisp | ||
| 2428 | interpreter might save time or space by reusing existing constants or | 2431 | interpreter might save time or space by reusing existing constants or |
| 2429 | constant components. For example, @code{(eq "abc" "abc")} returns | 2432 | their components. For example, @code{(eq "abc" "abc")} returns |
| 2430 | @code{t} if the interpreter creates only one instance of the string | 2433 | @code{t} if the interpreter creates only one instance of the string |
| 2431 | constant @code{"abc"}, and returns @code{nil} if it creates two | 2434 | literal @code{"abc"}, and returns @code{nil} if it creates two |
| 2432 | instances. Lisp programs should be written so that they work | 2435 | instances. Lisp programs should be written so that they work |
| 2433 | regardless of whether this optimization is in use. | 2436 | regardless of whether this optimization is in use. |
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 1cb0d05cc7b..91c3049f875 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi | |||
| @@ -183,11 +183,11 @@ for other ways to copy sequences. | |||
| 183 | 183 | ||
| 184 | @example | 184 | @example |
| 185 | @group | 185 | @group |
| 186 | (setq bar (list 1 2)) ; @r{Create a mutable list.} | 186 | (setq bar (list 1 2)) |
| 187 | @result{} (1 2) | 187 | @result{} (1 2) |
| 188 | @end group | 188 | @end group |
| 189 | @group | 189 | @group |
| 190 | (setq x (vector 'foo bar)) ; @r{Create a mutable vector.} | 190 | (setq x (vector 'foo bar)) |
| 191 | @result{} [foo (1 2)] | 191 | @result{} [foo (1 2)] |
| 192 | @end group | 192 | @end group |
| 193 | @group | 193 | @group |
| @@ -278,7 +278,7 @@ Unlike @code{reverse} the original @var{sequence} may be modified. | |||
| 278 | 278 | ||
| 279 | @example | 279 | @example |
| 280 | @group | 280 | @group |
| 281 | (setq x (list 'a 'b 'c)) ; @r{Create a mutable list.} | 281 | (setq x (list 'a 'b 'c)) |
| 282 | @result{} (a b c) | 282 | @result{} (a b c) |
| 283 | @end group | 283 | @end group |
| 284 | @group | 284 | @group |
| @@ -320,7 +320,7 @@ presented graphically: | |||
| 320 | For the vector, it is even simpler because you don't need setq: | 320 | For the vector, it is even simpler because you don't need setq: |
| 321 | 321 | ||
| 322 | @example | 322 | @example |
| 323 | (setq x (copy-sequence [1 2 3 4])) ; @r{Create a mutable vector.} | 323 | (setq x (copy-sequence [1 2 3 4])) |
| 324 | @result{} [1 2 3 4] | 324 | @result{} [1 2 3 4] |
| 325 | (nreverse x) | 325 | (nreverse x) |
| 326 | @result{} [4 3 2 1] | 326 | @result{} [4 3 2 1] |
| @@ -331,6 +331,7 @@ x | |||
| 331 | Note that unlike @code{reverse}, this function doesn't work with strings. | 331 | Note that unlike @code{reverse}, this function doesn't work with strings. |
| 332 | Although you can alter string data by using @code{aset}, it is strongly | 332 | Although you can alter string data by using @code{aset}, it is strongly |
| 333 | encouraged to treat strings as immutable even when they are mutable. | 333 | encouraged to treat strings as immutable even when they are mutable. |
| 334 | @xref{Mutability}. | ||
| 334 | 335 | ||
| 335 | @end defun | 336 | @end defun |
| 336 | 337 | ||
| @@ -374,7 +375,7 @@ appears in a different position in the list due to the change of | |||
| 374 | 375 | ||
| 375 | @example | 376 | @example |
| 376 | @group | 377 | @group |
| 377 | (setq nums (list 1 3 2 6 5 4 0)) ; @r{Create a mutable list.} | 378 | (setq nums (list 1 3 2 6 5 4 0)) |
| 378 | @result{} (1 3 2 6 5 4 0) | 379 | @result{} (1 3 2 6 5 4 0) |
| 379 | @end group | 380 | @end group |
| 380 | @group | 381 | @group |
| @@ -1228,7 +1229,7 @@ This function sets the @var{index}th element of @var{array} to be | |||
| 1228 | 1229 | ||
| 1229 | @example | 1230 | @example |
| 1230 | @group | 1231 | @group |
| 1231 | (setq w (vector 'foo 'bar 'baz)) ; @r{Create a mutable vector.} | 1232 | (setq w (vector 'foo 'bar 'baz)) |
| 1232 | @result{} [foo bar baz] | 1233 | @result{} [foo bar baz] |
| 1233 | (aset w 0 'fu) | 1234 | (aset w 0 'fu) |
| 1234 | @result{} fu | 1235 | @result{} fu |
| @@ -1237,7 +1238,7 @@ w | |||
| 1237 | @end group | 1238 | @end group |
| 1238 | 1239 | ||
| 1239 | @group | 1240 | @group |
| 1240 | ;; @r{@code{copy-sequence} creates a mutable string.} | 1241 | ;; @r{@code{copy-sequence} copies the string to be modified later.} |
| 1241 | (setq x (copy-sequence "asdfasfd")) | 1242 | (setq x (copy-sequence "asdfasfd")) |
| 1242 | @result{} "asdfasfd" | 1243 | @result{} "asdfasfd" |
| 1243 | (aset x 3 ?Z) | 1244 | (aset x 3 ?Z) |
| @@ -1247,9 +1248,7 @@ x | |||
| 1247 | @end group | 1248 | @end group |
| 1248 | @end example | 1249 | @end example |
| 1249 | 1250 | ||
| 1250 | The @var{array} should be mutable; that is, it should not be a constant, | 1251 | The @var{array} should be mutable. @xref{Mutability}. |
| 1251 | such as the constants created via quoting or via self-evaluating forms. | ||
| 1252 | @xref{Constants and Mutability}. | ||
| 1253 | 1252 | ||
| 1254 | If @var{array} is a string and @var{object} is not a character, a | 1253 | If @var{array} is a string and @var{object} is not a character, a |
| 1255 | @code{wrong-type-argument} error results. The function converts a | 1254 | @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}. | |||
| 1262 | 1261 | ||
| 1263 | @example | 1262 | @example |
| 1264 | @group | 1263 | @group |
| 1265 | ;; @r{Create a mutable vector and then fill it with zeros.} | ||
| 1266 | (setq a (copy-sequence [a b c d e f g])) | 1264 | (setq a (copy-sequence [a b c d e f g])) |
| 1267 | @result{} [a b c d e f g] | 1265 | @result{} [a b c d e f g] |
| 1268 | (fillarray a 0) | 1266 | (fillarray a 0) |
| @@ -1271,7 +1269,6 @@ a | |||
| 1271 | @result{} [0 0 0 0 0 0 0] | 1269 | @result{} [0 0 0 0 0 0 0] |
| 1272 | @end group | 1270 | @end group |
| 1273 | @group | 1271 | @group |
| 1274 | ;; @r{Create a mutable string and then fill it with "-".} | ||
| 1275 | (setq s (copy-sequence "When in the course")) | 1272 | (setq s (copy-sequence "When in the course")) |
| 1276 | @result{} "When in the course" | 1273 | @result{} "When in the course" |
| 1277 | (fillarray s ?-) | 1274 | (fillarray s ?-) |
| @@ -1310,8 +1307,8 @@ same way in Lisp input. | |||
| 1310 | evaluation: the result of evaluating it is the same vector. This does | 1307 | evaluation: the result of evaluating it is the same vector. This does |
| 1311 | not evaluate or even examine the elements of the vector. | 1308 | not evaluate or even examine the elements of the vector. |
| 1312 | @xref{Self-Evaluating Forms}. Vectors written with square brackets | 1309 | @xref{Self-Evaluating Forms}. Vectors written with square brackets |
| 1313 | are constants and should not be modified via @code{aset} or other | 1310 | should not be modified via @code{aset} or other destructive |
| 1314 | destructive operations. @xref{Constants and Mutability}. | 1311 | operations. @xref{Mutability}. |
| 1315 | 1312 | ||
| 1316 | Here are examples illustrating these principles: | 1313 | Here are examples illustrating these principles: |
| 1317 | 1314 | ||
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a4c9c2549c5..70c3b3cf4be 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi | |||
| @@ -49,10 +49,9 @@ by a distinguished character code. | |||
| 49 | 49 | ||
| 50 | Since strings are arrays, and therefore sequences as well, you can | 50 | Since strings are arrays, and therefore sequences as well, you can |
| 51 | operate on them with the general array and sequence functions documented | 51 | operate on them with the general array and sequence functions documented |
| 52 | in @ref{Sequences Arrays Vectors}. For example, you can access or | 52 | in @ref{Sequences Arrays Vectors}. For example, you can access |
| 53 | change individual characters in a string using the functions @code{aref} | 53 | individual characters in a string using the function @code{aref} |
| 54 | and @code{aset} (@pxref{Array Functions}). However, you should not | 54 | (@pxref{Array Functions}). |
| 55 | try to change the contents of constant strings (@pxref{Modifying Strings}). | ||
| 56 | 55 | ||
| 57 | There are two text representations for non-@acronym{ASCII} | 56 | There are two text representations for non-@acronym{ASCII} |
| 58 | characters in Emacs strings (and in buffers): unibyte and multibyte. | 57 | characters in Emacs strings (and in buffers): unibyte and multibyte. |
| @@ -382,9 +381,7 @@ usual value is @w{@code{"[ \f\t\n\r\v]+"}}. | |||
| 382 | @cindex string modification | 381 | @cindex string modification |
| 383 | 382 | ||
| 384 | You can alter the contents of a mutable string via operations | 383 | You can alter the contents of a mutable string via operations |
| 385 | described in this section. However, you should not try to use these | 384 | described in this section. @xref{Mutability}. |
| 386 | operations to alter the contents of a constant string. | ||
| 387 | @xref{Constants and Mutability}. | ||
| 388 | 385 | ||
| 389 | The most basic way to alter the contents of an existing string is with | 386 | The most basic way to alter the contents of an existing string is with |
| 390 | @code{aset} (@pxref{Array Functions}). @code{(aset @var{string} | 387 | @code{aset} (@pxref{Array Functions}). @code{(aset @var{string} |
| @@ -139,6 +139,9 @@ directories with the help of new command 'dired-vc-next-action'. | |||
| 139 | *** New commands 'vc-dir-mark-registered-files' (bound to '* r') and | 139 | *** New commands 'vc-dir-mark-registered-files' (bound to '* r') and |
| 140 | 'vc-dir-mark-unregistered-files'. | 140 | 'vc-dir-mark-unregistered-files'. |
| 141 | 141 | ||
| 142 | *** Support for bookmark.el. | ||
| 143 | Bookmark locations can refer to VC directory buffers. | ||
| 144 | |||
| 142 | ** Gnus | 145 | ** Gnus |
| 143 | 146 | ||
| 144 | --- | 147 | --- |
| @@ -226,6 +229,12 @@ key binding | |||
| 226 | / m package-menu-filter-marked | 229 | / m package-menu-filter-marked |
| 227 | / / package-menu-filter-clear | 230 | / / package-menu-filter-clear |
| 228 | 231 | ||
| 232 | --- | ||
| 233 | +++ Column widths in 'list-packages' display can now be customized. | ||
| 234 | See the new user options 'package-name-column-width', | ||
| 235 | 'package-version-column-width', 'package-status-column-width', and | ||
| 236 | 'package-archive-column-width'. | ||
| 237 | |||
| 229 | ** gdb-mi | 238 | ** gdb-mi |
| 230 | 239 | ||
| 231 | +++ | 240 | +++ |
| @@ -353,6 +362,44 @@ symbol property to the browsing functions. With a new command | |||
| 353 | 'browse-url-with-browser-kind', an URL can explicitly be browsed with | 362 | 'browse-url-with-browser-kind', an URL can explicitly be browsed with |
| 354 | either an internal or external browser. | 363 | either an internal or external browser. |
| 355 | 364 | ||
| 365 | ** SHR | ||
| 366 | |||
| 367 | --- | ||
| 368 | *** The command 'shr-browse-url' now supports custom mailto handlers. | ||
| 369 | Clicking on or otherwise following a 'mailto:' link in a HTML buffer | ||
| 370 | rendered by SHR previously invoked the command 'browse-url-mailto'. | ||
| 371 | This is still the case by default, but if you customize | ||
| 372 | 'browse-url-mailto-function' or 'browse-url-handlers' to call some | ||
| 373 | other function, it will now be called instead of the default. | ||
| 374 | |||
| 375 | ** EWW | ||
| 376 | |||
| 377 | --- | ||
| 378 | *** The command 'eww-follow-link' now supports custom mailto handlers. | ||
| 379 | The function that is invoked when clicking on or otherwise following a | ||
| 380 | 'mailto:' link in an EWW buffer can now be customized. For more | ||
| 381 | information, see the related entry about 'shr-browse-url' above. | ||
| 382 | |||
| 383 | ** Project | ||
| 384 | |||
| 385 | *** New user option 'project-vc-merge-submodules'. | ||
| 386 | |||
| 387 | ** json.el | ||
| 388 | |||
| 389 | --- | ||
| 390 | *** JSON number parsing is now stricter. | ||
| 391 | Numbers with a leading plus sign, leading zeros, or a missing integer | ||
| 392 | component are now rejected by 'json-read' and friends. This makes | ||
| 393 | them more compliant with the JSON specification and consistent with | ||
| 394 | the native JSON parsing functions. | ||
| 395 | |||
| 396 | ** xml.el | ||
| 397 | |||
| 398 | *** XML serialization functions now reject invalid characters. | ||
| 399 | Previously 'xml-print' would produce invalid XML when given a string | ||
| 400 | with characters that are not valid in XML (see | ||
| 401 | https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. | ||
| 402 | |||
| 356 | 403 | ||
| 357 | * New Modes and Packages in Emacs 28.1 | 404 | * New Modes and Packages in Emacs 28.1 |
| 358 | 405 | ||
| @@ -220,10 +220,23 @@ https://lists.gnu.org/r/emacs-devel/2013-11/msg00515.html | |||
| 220 | width fonts. However, more features are still needed to achieve this. | 220 | width fonts. However, more features are still needed to achieve this. |
| 221 | 221 | ||
| 222 | ** Support ligatures out of the box | 222 | ** Support ligatures out of the box |
| 223 | For the list of typographical ligatures, see | 223 | For the list of frequently-used typographical ligatures, see |
| 224 | 224 | ||
| 225 | https://en.wikipedia.org/wiki/Orthographic_ligature#Ligatures_in_Unicode_(Latin_alphabets) | 225 | https://en.wikipedia.org/wiki/Orthographic_ligature#Ligatures_in_Unicode_(Latin_alphabets) |
| 226 | 226 | ||
| 227 | (Note that in general, the number of possible ligatures can be much | ||
| 228 | larger, and there's no way, in principle, to specify the superset of | ||
| 229 | all the ligatures that could exist. Each font can support different | ||
| 230 | ligatures. The reliable way of supporting any and all ligatures is to | ||
| 231 | hand all text to be displayed to the shaping engine and get back the | ||
| 232 | font glyphs to display that text. However, doing this is impossible | ||
| 233 | with the current design of the Emacs display engine, since it examines | ||
| 234 | buffer text one character at a time, and implements character | ||
| 235 | composition by calls to Lisp, which makes doing this for every | ||
| 236 | character impractically slow. Therefore, the rest of this item | ||
| 237 | describes a limited form of ligature support which is compatible with | ||
| 238 | the current display engine design and uses automatic compositions.) | ||
| 239 | |||
| 227 | For Text and derived modes, the job is to figure out which ligatures | 240 | For Text and derived modes, the job is to figure out which ligatures |
| 228 | we want to support, how to let the user customize that, and probably | 241 | we want to support, how to let the user customize that, and probably |
| 229 | define a minor mode for automatic ligation (as some contexts might not | 242 | 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 | |||
| 237 | needed for each programming language, and provide user options to turn | 250 | needed for each programming language, and provide user options to turn |
| 238 | this on and off. | 251 | this on and off. |
| 239 | 252 | ||
| 240 | The implementation should use the infrastructure for character | 253 | The implementation should use the infrastructure for automatic |
| 241 | compositions, i.e., we should define appropriate regexp-based rules | 254 | character compositions, i.e., we should define appropriate |
| 242 | for character sequences that need to be composed into ligatures, and | 255 | regexp-based rules for character sequences that need to be composed |
| 243 | populate composition-function-table with those rules. See | 256 | into ligatures, and populate composition-function-table with those |
| 244 | composite.el for examples of this, and also grep lisp/language/*.el | 257 | rules. See composite.el for examples of this, and also grep |
| 245 | for references to composition-function-table. | 258 | lisp/language/*.el for references to composition-function-table. |
| 246 | 259 | ||
| 247 | One problem with character compositions that will need to be solved is | 260 | One problem with character compositions that will need to be solved is |
| 248 | that composition-function-table, the char-table which holds the | 261 | 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 | |||
| 259 | have a ZWNJ character separate these ASCII characters; another | 272 | have a ZWNJ character separate these ASCII characters; another |
| 260 | possibility is to introduce a special text property that prevents | 273 | possibility is to introduce a special text property that prevents |
| 261 | character composition, and place that property on the relevant parts | 274 | character composition, and place that property on the relevant parts |
| 262 | of the mode line. | 275 | of the mode line. Yet another possibility would be to write a |
| 276 | specialized composition function, which would detect that it is called | ||
| 277 | on mode-line strings, and return nil to signal that composition is not | ||
| 278 | possible in this case; then use that function in the rules for | ||
| 279 | ligatures stored in composition-function-table. | ||
| 263 | 280 | ||
| 264 | The prettify-symbols-mode should be deprecated once ligature support | 281 | The prettify-symbols-mode should be deprecated once ligature support |
| 265 | is in place. | 282 | is in place. |
| 266 | 283 | ||
| 284 | A related, but somewhat independent, feature is being able to move the | ||
| 285 | cursor "into a ligature", whereby cursor motion commands shows some | ||
| 286 | pseudo-cursor on some part of a ligature. For example, if "ffi" is | ||
| 287 | displayed as a ligature, then moving by one buffer position should | ||
| 288 | show the middle part of the ligature's glyph similar to the cursor | ||
| 289 | display: some special background and perhaps also a special | ||
| 290 | foreground. There are two possible ways of figuring out the offset at | ||
| 291 | which to display the pseudo-cursor: | ||
| 292 | |||
| 293 | . Arbitrarily divide the ligature's glyph width W into N parts, | ||
| 294 | where N is the number of codepoints composed into the ligature, then | ||
| 295 | move that pseudo-cursor by W/N pixels each time a cursor-motion | ||
| 296 | command is invoked; | ||
| 297 | . Use the font information. For example, HarfBuzz has the | ||
| 298 | hb_ot_layout_get_ligature_carets API for that purpose. However, | ||
| 299 | it could be that few fonts actually have that information recorded | ||
| 300 | in them, in which case the previous heuristics will be needed as | ||
| 301 | fallback. | ||
| 302 | |||
| 303 | One subtle issue needs to be resolved to have this feature of | ||
| 304 | "sub-glyph" cursor movement inside composed characters. The way Emacs | ||
| 305 | currently displays the default block cursor is by simply redrawing the | ||
| 306 | glyph at point in reverse video. So Emacs currently doesn't have a | ||
| 307 | way of displaying a cursor that "covers" only part of a glyph. To | ||
| 308 | make this happen, the display code will probably need to be changed to | ||
| 309 | draw the cursor as part of drawing the foreground and/or background of | ||
| 310 | the corresponding glyph, which is against the current flow of the | ||
| 311 | display code: it generally first completely draws the background and | ||
| 312 | foreground of the entire text that needs to be redrawn, and only then | ||
| 313 | draws the cursor where it should be placed. | ||
| 314 | |||
| 267 | ** Support for Stylistic Sets | 315 | ** Support for Stylistic Sets |
| 268 | This will allow using "alternate glyphs" supported by modern fonts. | 316 | This will allow using "alternate glyphs" supported by modern fonts. |
| 269 | For an overview of this feature, see | 317 | For an overview of this feature, see |
diff --git a/lib-src/etags.c b/lib-src/etags.c index eee2c596262..4672e3491da 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c | |||
| @@ -4197,9 +4197,9 @@ C_entries (int c_ext, FILE *inf) | |||
| 4197 | break; | 4197 | break; |
| 4198 | } | 4198 | } |
| 4199 | FALLTHROUGH; | 4199 | FALLTHROUGH; |
| 4200 | resetfvdef: | ||
| 4201 | case '#': case '~': case '&': case '%': case '/': | 4200 | case '#': case '~': case '&': case '%': case '/': |
| 4202 | case '|': case '^': case '!': case '.': case '?': | 4201 | case '|': case '^': case '!': case '.': case '?': |
| 4202 | resetfvdef: | ||
| 4203 | if (definedef != dnone) | 4203 | if (definedef != dnone) |
| 4204 | break; | 4204 | break; |
| 4205 | /* These surely cannot follow a function tag in C. */ | 4205 | /* These surely cannot follow a function tag in C. */ |
diff --git a/lisp/calculator.el b/lisp/calculator.el index 7e0b2fcc6a3..cd92f992689 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el | |||
| @@ -858,12 +858,10 @@ The result should not exceed the screen width." | |||
| 858 | "Convert the given STR to a number, according to the value of | 858 | "Convert the given STR to a number, according to the value of |
| 859 | `calculator-input-radix'." | 859 | `calculator-input-radix'." |
| 860 | (if calculator-input-radix | 860 | (if calculator-input-radix |
| 861 | (string-to-number str (cadr (assq calculator-input-radix | 861 | (string-to-number str (cadr (assq calculator-input-radix |
| 862 | '((bin 2) (oct 8) (hex 16))))) | 862 | '((bin 2) (oct 8) (hex 16))))) |
| 863 | (let* ((str (replace-regexp-in-string | 863 | ;; Allow entry of "1.e3". |
| 864 | "\\.\\([^0-9].*\\)?$" ".0\\1" str)) | 864 | (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str))) |
| 865 | (str (replace-regexp-in-string | ||
| 866 | "[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str))) | ||
| 867 | (float (string-to-number str))))) | 865 | (float (string-to-number str))))) |
| 868 | 866 | ||
| 869 | (defun calculator-push-curnum () | 867 | (defun calculator-push-curnum () |
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 8c336117c92..41252815734 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el | |||
| @@ -1515,8 +1515,11 @@ It does not apply the value to buffers." | |||
| 1515 | (when project-dir | 1515 | (when project-dir |
| 1516 | (ede-directory-get-open-project project-dir 'ROOT)))) | 1516 | (ede-directory-get-open-project project-dir 'ROOT)))) |
| 1517 | 1517 | ||
| 1518 | (cl-defmethod project-roots ((project ede-project)) | 1518 | (cl-defmethod project-root ((project ede-project)) |
| 1519 | (list (ede-project-root-directory project))) | 1519 | (ede-project-root-directory project)) |
| 1520 | |||
| 1521 | ;;; FIXME: Could someone look into implementing `project-ignores' for | ||
| 1522 | ;;; EDE and/or a faster `project-files'? | ||
| 1520 | 1523 | ||
| 1521 | (add-hook 'project-find-functions #'project-try-ede) | 1524 | (add-hook 'project-find-functions #'project-try-ede) |
| 1522 | 1525 | ||
diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 3cac2629a9c..de342f1519e 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el | |||
| @@ -2050,8 +2050,8 @@ See the command `doc-view-mode' for more information on this mode." | |||
| 2050 | (when (memq (selected-frame) (alist-get 'frames attrs)) | 2050 | (when (memq (selected-frame) (alist-get 'frames attrs)) |
| 2051 | (let ((geom (alist-get 'geometry attrs))) | 2051 | (let ((geom (alist-get 'geometry attrs))) |
| 2052 | (when geom | 2052 | (when geom |
| 2053 | (setq monitor-top (nth 0 geom)) | 2053 | (setq monitor-left (nth 0 geom)) |
| 2054 | (setq monitor-left (nth 1 geom)) | 2054 | (setq monitor-top (nth 1 geom)) |
| 2055 | (setq monitor-width (nth 2 geom)) | 2055 | (setq monitor-width (nth 2 geom)) |
| 2056 | (setq monitor-height (nth 3 geom)))))) | 2056 | (setq monitor-height (nth 3 geom)))))) |
| 2057 | (let ((frame (make-frame | 2057 | (let ((frame (make-frame |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 95659840ad5..808e4f34fc5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -397,6 +397,26 @@ synchronously." | |||
| 397 | :type 'boolean | 397 | :type 'boolean |
| 398 | :version "25.1") | 398 | :version "25.1") |
| 399 | 399 | ||
| 400 | (defcustom package-name-column-width 30 | ||
| 401 | "Column width for the Package name in the package menu." | ||
| 402 | :type 'number | ||
| 403 | :version "28.1") | ||
| 404 | |||
| 405 | (defcustom package-version-column-width 14 | ||
| 406 | "Column width for the Package version in the package menu." | ||
| 407 | :type 'number | ||
| 408 | :version "28.1") | ||
| 409 | |||
| 410 | (defcustom package-status-column-width 12 | ||
| 411 | "Column width for the Package status in the package menu." | ||
| 412 | :type 'number | ||
| 413 | :version "28.1") | ||
| 414 | |||
| 415 | (defcustom package-archive-column-width 8 | ||
| 416 | "Column width for the Package status in the package menu." | ||
| 417 | :type 'number | ||
| 418 | :version "28.1") | ||
| 419 | |||
| 400 | 420 | ||
| 401 | ;;; `package-desc' object definition | 421 | ;;; `package-desc' object definition |
| 402 | ;; This is the struct used internally to represent packages. | 422 | ;; This is the struct used internally to represent packages. |
| @@ -2750,11 +2770,11 @@ Letters do not insert themselves; instead, they are commands. | |||
| 2750 | (package-menu--transaction-status | 2770 | (package-menu--transaction-status |
| 2751 | package-menu--transaction-status))) | 2771 | package-menu--transaction-status))) |
| 2752 | (setq tabulated-list-format | 2772 | (setq tabulated-list-format |
| 2753 | `[("Package" 18 package-menu--name-predicate) | 2773 | `[("Package" ,package-name-column-width package-menu--name-predicate) |
| 2754 | ("Version" 13 package-menu--version-predicate) | 2774 | ("Version" ,package-version-column-width package-menu--version-predicate) |
| 2755 | ("Status" 10 package-menu--status-predicate) | 2775 | ("Status" ,package-status-column-width package-menu--status-predicate) |
| 2756 | ,@(if (cdr package-archives) | 2776 | ,@(if (cdr package-archives) |
| 2757 | '(("Archive" 10 package-menu--archive-predicate))) | 2777 | `(("Archive" ,package-archive-column-width package-menu--archive-predicate))) |
| 2758 | ("Description" 0 package-menu--description-predicate)]) | 2778 | ("Description" 0 package-menu--description-predicate)]) |
| 2759 | (setq tabulated-list-padding 2) | 2779 | (setq tabulated-list-padding 2) |
| 2760 | (setq tabulated-list-sort-key (cons "Status" nil)) | 2780 | (setq tabulated-list-sort-key (cons "Status" nil)) |
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 46dc8d9ade8..ce495af95bc 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el | |||
| @@ -139,14 +139,28 @@ delimiter or an Escaped or Char-quoted character.")) | |||
| 139 | (point-max)))) | 139 | (point-max)))) |
| 140 | (cons beg end)) | 140 | (cons beg end)) |
| 141 | 141 | ||
| 142 | (defun syntax-propertize--shift-groups (re n) | 142 | (defun syntax-propertize--shift-groups-and-backrefs (re n) |
| 143 | (replace-regexp-in-string | 143 | (let ((new-re (replace-regexp-in-string |
| 144 | "\\\\(\\?\\([0-9]+\\):" | 144 | "\\\\(\\?\\([0-9]+\\):" |
| 145 | (lambda (s) | 145 | (lambda (s) |
| 146 | (replace-match | 146 | (replace-match |
| 147 | (number-to-string (+ n (string-to-number (match-string 1 s)))) | 147 | (number-to-string |
| 148 | t t s 1)) | 148 | (+ n (string-to-number (match-string 1 s)))) |
| 149 | re t t)) | 149 | t t s 1)) |
| 150 | re t t)) | ||
| 151 | (pos 0)) | ||
| 152 | (while (string-match "\\\\\\([0-9]+\\)" new-re pos) | ||
| 153 | (setq pos (+ 1 (match-beginning 1))) | ||
| 154 | (when (save-match-data | ||
| 155 | ;; With \N, the \ must be in a subregexp context, i.e., | ||
| 156 | ;; not in a character class or in a \{\} repetition. | ||
| 157 | (subregexp-context-p new-re (match-beginning 0))) | ||
| 158 | (let ((shifted (+ n (string-to-number (match-string 1 new-re))))) | ||
| 159 | (when (> shifted 9) | ||
| 160 | (error "There may be at most nine back-references")) | ||
| 161 | (setq new-re (replace-match (number-to-string shifted) | ||
| 162 | t t new-re 1))))) | ||
| 163 | new-re)) | ||
| 150 | 164 | ||
| 151 | (defmacro syntax-propertize-precompile-rules (&rest rules) | 165 | (defmacro syntax-propertize-precompile-rules (&rest rules) |
| 152 | "Return a precompiled form of RULES to pass to `syntax-propertize-rules'. | 166 | "Return a precompiled form of RULES to pass to `syntax-propertize-rules'. |
| @@ -190,7 +204,8 @@ for subsequent HIGHLIGHTs. | |||
| 190 | Also SYNTAX is free to move point, in which case RULES may not be applied to | 204 | Also SYNTAX is free to move point, in which case RULES may not be applied to |
| 191 | some parts of the text or may be applied several times to other parts. | 205 | some parts of the text or may be applied several times to other parts. |
| 192 | 206 | ||
| 193 | Note: back-references in REGEXPs do not work." | 207 | Note: There may be at most nine back-references in the REGEXPs of |
| 208 | all RULES in total." | ||
| 194 | (declare (debug (&rest &or symbolp ;FIXME: edebug this eval step. | 209 | (declare (debug (&rest &or symbolp ;FIXME: edebug this eval step. |
| 195 | (form &rest | 210 | (form &rest |
| 196 | (numberp | 211 | (numberp |
| @@ -219,7 +234,7 @@ Note: back-references in REGEXPs do not work." | |||
| 219 | ;; tell when *this* match 0 has succeeded. | 234 | ;; tell when *this* match 0 has succeeded. |
| 220 | (cl-incf offset) | 235 | (cl-incf offset) |
| 221 | (setq re (concat "\\(" re "\\)"))) | 236 | (setq re (concat "\\(" re "\\)"))) |
| 222 | (setq re (syntax-propertize--shift-groups re offset)) | 237 | (setq re (syntax-propertize--shift-groups-and-backrefs re offset)) |
| 223 | (let ((code '()) | 238 | (let ((code '()) |
| 224 | (condition | 239 | (condition |
| 225 | (cond | 240 | (cond |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 6b9610d3121..614651afff9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -5833,6 +5833,7 @@ all parts." | |||
| 5833 | "" "...")) | 5833 | "" "...")) |
| 5834 | (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle) | 5834 | (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle) |
| 5835 | (buffer-size))) | 5835 | (buffer-size))) |
| 5836 | (help-echo "mouse-2: toggle the MIME part; down-mouse-3: more options") | ||
| 5836 | gnus-tmp-type-long b e) | 5837 | gnus-tmp-type-long b e) |
| 5837 | (when (string-match ".*/" gnus-tmp-name) | 5838 | (when (string-match ".*/" gnus-tmp-name) |
| 5838 | (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name))) | 5839 | (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name))) |
| @@ -5841,6 +5842,16 @@ all parts." | |||
| 5841 | (concat "; " gnus-tmp-name)))) | 5842 | (concat "; " gnus-tmp-name)))) |
| 5842 | (unless (equal gnus-tmp-description "") | 5843 | (unless (equal gnus-tmp-description "") |
| 5843 | (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) | 5844 | (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) |
| 5845 | (when (zerop gnus-tmp-length) | ||
| 5846 | (setq gnus-tmp-type-long | ||
| 5847 | (concat | ||
| 5848 | gnus-tmp-type-long | ||
| 5849 | (substitute-command-keys | ||
| 5850 | (concat "\\<gnus-summary-mode-map> (not downloaded, " | ||
| 5851 | "\\[gnus-summary-show-complete-article] to fetch.)")))) | ||
| 5852 | (setq help-echo | ||
| 5853 | (concat "Type \\[gnus-summary-show-complete-article] " | ||
| 5854 | "to download complete article. " help-echo))) | ||
| 5844 | (setq b (point)) | 5855 | (setq b (point)) |
| 5845 | (gnus-eval-format | 5856 | (gnus-eval-format |
| 5846 | gnus-mime-button-line-format gnus-mime-button-line-format-alist | 5857 | gnus-mime-button-line-format gnus-mime-button-line-format-alist |
| @@ -5859,8 +5870,7 @@ all parts." | |||
| 5859 | 'keymap gnus-mime-button-map | 5870 | 'keymap gnus-mime-button-map |
| 5860 | 'face gnus-article-button-face | 5871 | 'face gnus-article-button-face |
| 5861 | 'follow-link t | 5872 | 'follow-link t |
| 5862 | 'help-echo | 5873 | 'help-echo help-echo))) |
| 5863 | "mouse-2: toggle the MIME part; down-mouse-3: more options"))) | ||
| 5864 | 5874 | ||
| 5865 | (defvar gnus-displaying-mime nil) | 5875 | (defvar gnus-displaying-mime nil) |
| 5866 | 5876 | ||
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 480ed80ef81..f306889a7fc 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -485,23 +485,25 @@ This is not required after changing `gnus-registry-cache-file'." | |||
| 485 | (when from | 485 | (when from |
| 486 | (setq entry (cons (delete from (assoc 'group entry)) | 486 | (setq entry (cons (delete from (assoc 'group entry)) |
| 487 | (assq-delete-all 'group entry)))) | 487 | (assq-delete-all 'group entry)))) |
| 488 | 488 | ;; Only keep the entry if the message is going to a new group, or | |
| 489 | (dolist (kv `((group ,to) | 489 | ;; it's still in some previous group. |
| 490 | (sender ,sender) | 490 | (when (or to (alist-get 'group entry)) |
| 491 | (recipient ,@recipients) | 491 | (dolist (kv `((group ,to) |
| 492 | (subject ,subject))) | 492 | (sender ,sender) |
| 493 | (when (cadr kv) | 493 | (recipient ,@recipients) |
| 494 | (let ((new (or (assq (car kv) entry) | 494 | (subject ,subject))) |
| 495 | (list (car kv))))) | 495 | (when (cadr kv) |
| 496 | (dolist (toadd (cdr kv)) | 496 | (let ((new (or (assq (car kv) entry) |
| 497 | (unless (member toadd new) | 497 | (list (car kv))))) |
| 498 | (setq new (append new (list toadd))))) | 498 | (dolist (toadd (cdr kv)) |
| 499 | (setq entry (cons new | 499 | (unless (member toadd new) |
| 500 | (assq-delete-all (car kv) entry)))))) | 500 | (setq new (append new (list toadd))))) |
| 501 | (gnus-message 10 "Gnus registry: new entry for %s is %S" | 501 | (setq entry (cons new |
| 502 | id | 502 | (assq-delete-all (car kv) entry)))))) |
| 503 | entry) | 503 | (gnus-message 10 "Gnus registry: new entry for %s is %S" |
| 504 | (gnus-registry-insert db id entry))) | 504 | id |
| 505 | entry) | ||
| 506 | (gnus-registry-insert db id entry)))) | ||
| 505 | 507 | ||
| 506 | ;; Function for nn{mail|imap}-split-fancy: look up all references in | 508 | ;; Function for nn{mail|imap}-split-fancy: look up all references in |
| 507 | ;; the cache and if a match is found, return that group. | 509 | ;; the cache and if a match is found, return that group. |
diff --git a/lisp/ido.el b/lisp/ido.el index 81883402add..ad71d468cb4 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -499,11 +499,14 @@ This means that \\[ido-complete] must always be followed by \\[ido-exit-minibuff | |||
| 499 | even when there is only one unique completion." | 499 | even when there is only one unique completion." |
| 500 | :type 'boolean) | 500 | :type 'boolean) |
| 501 | 501 | ||
| 502 | (defcustom ido-cannot-complete-command 'ido-completion-help | 502 | (defcustom ido-cannot-complete-command #'ido-completion-auto-help |
| 503 | "Command run when `ido-complete' can't complete any more. | 503 | "Command run when `ido-complete' can't complete any more. |
| 504 | The most useful values are `ido-completion-help', which pops up a | 504 | The most useful values are `ido-completion-help', which pops up a |
| 505 | window with completion alternatives, or `ido-next-match' or | 505 | window with completion alternatives; `ido-completion-auto-help', |
| 506 | `ido-prev-match', which cycle the buffer list." | 506 | which does the same but respects the value of |
| 507 | `completion-auto-help'; and `ido-next-match' or `ido-prev-match', | ||
| 508 | which cycle the buffer list." | ||
| 509 | :version "28.1" | ||
| 507 | :type 'function) | 510 | :type 'function) |
| 508 | 511 | ||
| 509 | 512 | ||
| @@ -1546,7 +1549,7 @@ This function also adds a hook to the minibuffer." | |||
| 1546 | ((> (prefix-numeric-value arg) 0) 'both) | 1549 | ((> (prefix-numeric-value arg) 0) 'both) |
| 1547 | (t nil))) | 1550 | (t nil))) |
| 1548 | 1551 | ||
| 1549 | (ido-everywhere (if ido-everywhere 1 -1)) | 1552 | (ido-everywhere (if (and ido-mode ido-everywhere) 1 -1)) |
| 1550 | 1553 | ||
| 1551 | (when ido-mode | 1554 | (when ido-mode |
| 1552 | (ido-common-initialization) | 1555 | (ido-common-initialization) |
| @@ -3926,6 +3929,14 @@ If `ido-change-word-sub' cannot be found in WORD, return nil." | |||
| 3926 | (when (bobp) | 3929 | (when (bobp) |
| 3927 | (next-completion 1))))) | 3930 | (next-completion 1))))) |
| 3928 | 3931 | ||
| 3932 | (defun ido-completion-auto-help () | ||
| 3933 | "Call `ido-completion-help' if `completion-auto-help' is non-nil." | ||
| 3934 | (interactive) | ||
| 3935 | ;; Note: `completion-auto-help' could also be `lazy', but this value | ||
| 3936 | ;; is irrelevant to ido, which is fundamentally eager, so it is | ||
| 3937 | ;; treated the same as t. | ||
| 3938 | (when completion-auto-help | ||
| 3939 | (ido-completion-help))) | ||
| 3929 | 3940 | ||
| 3930 | (defun ido-completion-help () | 3941 | (defun ido-completion-help () |
| 3931 | "Show possible completions in the `ido-completion-buffer'." | 3942 | "Show possible completions in the `ido-completion-buffer'." |
diff --git a/lisp/json.el b/lisp/json.el index 6f3b791ed17..9002e868537 100644 --- a/lisp/json.el +++ b/lisp/json.el | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Theresa O'Connor <ted@oconnor.cx> | 5 | ;; Author: Theresa O'Connor <ted@oconnor.cx> |
| 6 | ;; Version: 1.4 | 6 | ;; Version: 1.5 |
| 7 | ;; Keywords: convenience | 7 | ;; Keywords: convenience |
| 8 | 8 | ||
| 9 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -29,11 +29,11 @@ | |||
| 29 | ;; Learn all about JSON here: <URL:http://json.org/>. | 29 | ;; Learn all about JSON here: <URL:http://json.org/>. |
| 30 | 30 | ||
| 31 | ;; The user-serviceable entry points for the parser are the functions | 31 | ;; The user-serviceable entry points for the parser are the functions |
| 32 | ;; `json-read' and `json-read-from-string'. The encoder has a single | 32 | ;; `json-read' and `json-read-from-string'. The encoder has a single |
| 33 | ;; entry point, `json-encode'. | 33 | ;; entry point, `json-encode'. |
| 34 | 34 | ||
| 35 | ;; Since there are several natural representations of key-value pair | 35 | ;; Since there are several natural representations of key-value pair |
| 36 | ;; mappings in elisp (alist, plist, hash-table), `json-read' allows you | 36 | ;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you |
| 37 | ;; to specify which you'd prefer (see `json-object-type' and | 37 | ;; to specify which you'd prefer (see `json-object-type' and |
| 38 | ;; `json-array-type'). | 38 | ;; `json-array-type'). |
| 39 | 39 | ||
| @@ -55,6 +55,7 @@ | |||
| 55 | ;;; Code: | 55 | ;;; Code: |
| 56 | 56 | ||
| 57 | (require 'map) | 57 | (require 'map) |
| 58 | (require 'seq) | ||
| 58 | (require 'subr-x) | 59 | (require 'subr-x) |
| 59 | 60 | ||
| 60 | ;; Parameters | 61 | ;; Parameters |
| @@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.") | |||
| 113 | "If non-nil, then the output of `json-encode' will be pretty-printed.") | 114 | "If non-nil, then the output of `json-encode' will be pretty-printed.") |
| 114 | 115 | ||
| 115 | (defvar json-encoding-lisp-style-closings nil | 116 | (defvar json-encoding-lisp-style-closings nil |
| 116 | "If non-nil, ] and } closings will be formatted lisp-style, | 117 | "If non-nil, delimiters ] and } will be formatted Lisp-style. |
| 117 | without indentation.") | 118 | This means they will be placed on the same line as the last |
| 119 | element of the respective array or object, without indentation. | ||
| 120 | Used only when `json-encoding-pretty-print' is non-nil.") | ||
| 118 | 121 | ||
| 119 | (defvar json-encoding-object-sort-predicate nil | 122 | (defvar json-encoding-object-sort-predicate nil |
| 120 | "Sorting predicate for JSON object keys during encoding. | 123 | "Sorting predicate for JSON object keys during encoding. |
| @@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object keys | |||
| 124 | ordered alphabetically.") | 127 | ordered alphabetically.") |
| 125 | 128 | ||
| 126 | (defvar json-pre-element-read-function nil | 129 | (defvar json-pre-element-read-function nil |
| 127 | "Function called (if non-nil) by `json-read-array' and | 130 | "If non-nil, a function to call before reading a JSON array or object. |
| 128 | `json-read-object' right before reading a JSON array or object, | 131 | It is called by `json-read-array' and `json-read-object', |
| 129 | respectively. The function is called with one argument, which is | 132 | respectively, with one argument, which is the current JSON key.") |
| 130 | the current JSON key.") | ||
| 131 | 133 | ||
| 132 | (defvar json-post-element-read-function nil | 134 | (defvar json-post-element-read-function nil |
| 133 | "Function called (if non-nil) by `json-read-array' and | 135 | "If non-nil, a function to call after reading a JSON array or object. |
| 134 | `json-read-object' right after reading a JSON array or object, | 136 | It is called by `json-read-array' and `json-read-object', |
| 135 | respectively.") | 137 | respectively, with no arguments.") |
| 136 | 138 | ||
| 137 | 139 | ||
| 138 | 140 | ||
| 139 | ;;; Utilities | 141 | ;;; Utilities |
| 140 | 142 | ||
| 141 | (defun json-join (strings separator) | 143 | (define-obsolete-function-alias 'json-join #'string-join "28.1") |
| 142 | "Join STRINGS with SEPARATOR." | ||
| 143 | (mapconcat 'identity strings separator)) | ||
| 144 | 144 | ||
| 145 | (defun json-alist-p (list) | 145 | (defun json-alist-p (list) |
| 146 | "Non-null if and only if LIST is an alist with simple keys." | 146 | "Non-nil if and only if LIST is an alist with simple keys." |
| 147 | (while (consp list) | 147 | (declare (pure t) (side-effect-free error-free)) |
| 148 | (setq list (if (and (consp (car list)) | 148 | (while (and (consp (car-safe list)) |
| 149 | (atom (caar list))) | 149 | (atom (caar list)) |
| 150 | (cdr list) | 150 | (setq list (cdr list)))) |
| 151 | 'not-alist))) | ||
| 152 | (null list)) | 151 | (null list)) |
| 153 | 152 | ||
| 154 | (defun json-plist-p (list) | 153 | (defun json-plist-p (list) |
| 155 | "Non-null if and only if LIST is a plist with keyword keys." | 154 | "Non-nil if and only if LIST is a plist with keyword keys." |
| 156 | (while (consp list) | 155 | (declare (pure t) (side-effect-free error-free)) |
| 157 | (setq list (if (and (keywordp (car list)) | 156 | (while (and (keywordp (car-safe list)) |
| 158 | (consp (cdr list))) | 157 | (consp (cdr list)) |
| 159 | (cddr list) | 158 | (setq list (cddr list)))) |
| 160 | 'not-plist))) | ||
| 161 | (null list)) | 159 | (null list)) |
| 162 | 160 | ||
| 163 | (defun json--plist-reverse (plist) | 161 | (defun json--plist-nreverse (plist) |
| 164 | "Return a copy of PLIST in reverse order. | 162 | "Return PLIST in reverse order. |
| 165 | Unlike `reverse', this keeps the property-value pairs intact." | 163 | Unlike `nreverse', this keeps the ordering of each property |
| 166 | (let (res) | 164 | relative to its value intact. Like `nreverse', this function may |
| 167 | (while plist | 165 | destructively modify PLIST to produce the result." |
| 168 | (let ((prop (pop plist)) | 166 | (let (prev (next (cddr plist))) |
| 169 | (val (pop plist))) | 167 | (while next |
| 170 | (push val res) | 168 | (setcdr (cdr plist) prev) |
| 171 | (push prop res))) | 169 | (setq prev plist plist next next (cddr next)) |
| 172 | res)) | 170 | (setcdr (cdr plist) prev))) |
| 173 | 171 | plist) | |
| 174 | (defun json--plist-to-alist (plist) | 172 | |
| 175 | "Return an alist of the property-value pairs in PLIST." | 173 | (defmacro json--with-indentation (&rest body) |
| 176 | (let (res) | 174 | "Evaluate BODY with the correct indentation for JSON encoding. |
| 177 | (while plist | 175 | This macro binds `json--encoding-current-indentation' according |
| 178 | (let ((prop (pop plist)) | 176 | to `json-encoding-pretty-print' around BODY." |
| 179 | (val (pop plist))) | 177 | (declare (debug t) (indent 0)) |
| 180 | (push (cons prop val) res))) | ||
| 181 | (nreverse res))) | ||
| 182 | |||
| 183 | (defmacro json--with-indentation (body) | ||
| 184 | `(let ((json--encoding-current-indentation | 178 | `(let ((json--encoding-current-indentation |
| 185 | (if json-encoding-pretty-print | 179 | (if json-encoding-pretty-print |
| 186 | (concat json--encoding-current-indentation | 180 | (concat json--encoding-current-indentation |
| 187 | json-encoding-default-indentation) | 181 | json-encoding-default-indentation) |
| 188 | ""))) | 182 | ""))) |
| 189 | ,body)) | 183 | ,@body)) |
| 190 | 184 | ||
| 191 | ;; Reader utilities | 185 | ;; Reader utilities |
| 192 | 186 | ||
| 193 | (define-inline json-advance (&optional n) | 187 | (define-inline json-advance (&optional n) |
| 194 | "Advance N characters forward." | 188 | "Advance N characters forward, or 1 character if N is nil. |
| 189 | On reaching the end of the accessible region of the buffer, stop | ||
| 190 | and signal an error." | ||
| 195 | (inline-quote (forward-char ,n))) | 191 | (inline-quote (forward-char ,n))) |
| 196 | 192 | ||
| 197 | (define-inline json-peek () | 193 | (define-inline json-peek () |
| 198 | "Return the character at point." | 194 | "Return the character at point. |
| 195 | At the end of the accessible region of the buffer, return 0." | ||
| 199 | (inline-quote (following-char))) | 196 | (inline-quote (following-char))) |
| 200 | 197 | ||
| 201 | (define-inline json-pop () | 198 | (define-inline json-pop () |
| 202 | "Advance past the character at point, returning it." | 199 | "Advance past the character at point, returning it. |
| 200 | Signal `json-end-of-file' if called at the end of the buffer." | ||
| 203 | (inline-quote | 201 | (inline-quote |
| 204 | (let ((char (json-peek))) | 202 | (prog1 (or (char-after) |
| 205 | (if (zerop char) | 203 | (signal 'json-end-of-file ())) |
| 206 | (signal 'json-end-of-file nil) | 204 | (json-advance)))) |
| 207 | (json-advance) | ||
| 208 | char)))) | ||
| 209 | 205 | ||
| 210 | (define-inline json-skip-whitespace () | 206 | (define-inline json-skip-whitespace () |
| 211 | "Skip past the whitespace at point." | 207 | "Skip past the whitespace at point." |
| @@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs intact." | |||
| 213 | ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf | 209 | ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf |
| 214 | ;; or https://tools.ietf.org/html/rfc7159#section-2 for the | 210 | ;; or https://tools.ietf.org/html/rfc7159#section-2 for the |
| 215 | ;; definition of whitespace in JSON. | 211 | ;; definition of whitespace in JSON. |
| 216 | (inline-quote (skip-chars-forward "\t\r\n "))) | 212 | (inline-quote (skip-chars-forward "\t\n\r "))) |
| 217 | 213 | ||
| 218 | 214 | ||
| 219 | 215 | ||
| @@ -236,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs intact." | |||
| 236 | ;;; Paths | 232 | ;;; Paths |
| 237 | 233 | ||
| 238 | (defvar json--path '() | 234 | (defvar json--path '() |
| 239 | "Used internally by `json-path-to-position' to keep track of | 235 | "Keeps track of the path during recursive calls to `json-read'. |
| 240 | the path during recursive calls to `json-read'.") | 236 | Used internally by `json-path-to-position'.") |
| 241 | 237 | ||
| 242 | (defun json--record-path (key) | 238 | (defun json--record-path (key) |
| 243 | "Record the KEY to the current JSON path. | 239 | "Record the KEY to the current JSON path. |
| @@ -248,7 +244,7 @@ Used internally by `json-path-to-position'." | |||
| 248 | "Check if the last parsed JSON structure passed POSITION. | 244 | "Check if the last parsed JSON structure passed POSITION. |
| 249 | Used internally by `json-path-to-position'." | 245 | Used internally by `json-path-to-position'." |
| 250 | (let ((start (caar json--path))) | 246 | (let ((start (caar json--path))) |
| 251 | (when (< start position (+ (point) 1)) | 247 | (when (< start position (1+ (point))) |
| 252 | (throw :json-path (list :path (nreverse (mapcar #'cdr json--path)) | 248 | (throw :json-path (list :path (nreverse (mapcar #'cdr json--path)) |
| 253 | :match-start start | 249 | :match-start start |
| 254 | :match-end (point))))) | 250 | :match-end (point))))) |
| @@ -266,13 +262,13 @@ properties: | |||
| 266 | :path -- A list of strings and numbers forming the path to | 262 | :path -- A list of strings and numbers forming the path to |
| 267 | the JSON element at the given position. Strings | 263 | the JSON element at the given position. Strings |
| 268 | denote object names, while numbers denote array | 264 | denote object names, while numbers denote array |
| 269 | indexes. | 265 | indices. |
| 270 | 266 | ||
| 271 | :match-start -- Position where the matched JSON element begins. | 267 | :match-start -- Position where the matched JSON element begins. |
| 272 | 268 | ||
| 273 | :match-end -- Position where the matched JSON element ends. | 269 | :match-end -- Position where the matched JSON element ends. |
| 274 | 270 | ||
| 275 | This can for instance be useful to determine the path to a JSON | 271 | This can, for instance, be useful to determine the path to a JSON |
| 276 | element in a deeply nested structure." | 272 | element in a deeply nested structure." |
| 277 | (save-excursion | 273 | (save-excursion |
| 278 | (unless string | 274 | (unless string |
| @@ -280,7 +276,7 @@ element in a deeply nested structure." | |||
| 280 | (let* ((json--path '()) | 276 | (let* ((json--path '()) |
| 281 | (json-pre-element-read-function #'json--record-path) | 277 | (json-pre-element-read-function #'json--record-path) |
| 282 | (json-post-element-read-function | 278 | (json-post-element-read-function |
| 283 | (apply-partially #'json--check-position position)) | 279 | (lambda () (json--check-position position))) |
| 284 | (path (catch :json-path | 280 | (path (catch :json-path |
| 285 | (if string | 281 | (if string |
| 286 | (json-read-from-string string) | 282 | (json-read-from-string string) |
| @@ -290,38 +286,33 @@ element in a deeply nested structure." | |||
| 290 | 286 | ||
| 291 | ;;; Keywords | 287 | ;;; Keywords |
| 292 | 288 | ||
| 293 | (defvar json-keywords '("true" "false" "null") | 289 | (defconst json-keywords '("true" "false" "null") |
| 294 | "List of JSON keywords.") | 290 | "List of JSON keywords.") |
| 291 | (make-obsolete-variable 'json-keywords "it is no longer used." "28.1") | ||
| 295 | 292 | ||
| 296 | ;; Keyword parsing | 293 | ;; Keyword parsing |
| 297 | 294 | ||
| 295 | ;; Characters that can follow a JSON value. | ||
| 296 | (rx-define json--post-value (| (in "\t\n\r ,]}") eos)) | ||
| 297 | |||
| 298 | (defun json-read-keyword (keyword) | 298 | (defun json-read-keyword (keyword) |
| 299 | "Read a JSON keyword at point. | 299 | "Read the expected JSON KEYWORD at point." |
| 300 | KEYWORD is the keyword expected." | 300 | (prog1 (cond ((equal keyword "true") t) |
| 301 | (unless (member keyword json-keywords) | 301 | ((equal keyword "false") json-false) |
| 302 | (signal 'json-unknown-keyword (list keyword))) | 302 | ((equal keyword "null") json-null) |
| 303 | (mapc (lambda (char) | 303 | (t (signal 'json-unknown-keyword (list keyword)))) |
| 304 | (when (/= char (json-peek)) | 304 | (or (looking-at-p keyword) |
| 305 | (signal 'json-unknown-keyword | 305 | (signal 'json-unknown-keyword (list (thing-at-point 'word)))) |
| 306 | (list (save-excursion | 306 | (json-advance (length keyword)) |
| 307 | (backward-word-strictly 1) | 307 | (or (looking-at-p (rx json--post-value)) |
| 308 | (thing-at-point 'word))))) | 308 | (signal 'json-unknown-keyword (list (thing-at-point 'word)))) |
| 309 | (json-advance)) | 309 | (json-skip-whitespace))) |
| 310 | keyword) | ||
| 311 | (json-skip-whitespace) | ||
| 312 | (unless (looking-at "\\([],}]\\|$\\)") | ||
| 313 | (signal 'json-unknown-keyword | ||
| 314 | (list (save-excursion | ||
| 315 | (backward-word-strictly 1) | ||
| 316 | (thing-at-point 'word))))) | ||
| 317 | (cond ((string-equal keyword "true") t) | ||
| 318 | ((string-equal keyword "false") json-false) | ||
| 319 | ((string-equal keyword "null") json-null))) | ||
| 320 | 310 | ||
| 321 | ;; Keyword encoding | 311 | ;; Keyword encoding |
| 322 | 312 | ||
| 323 | (defun json-encode-keyword (keyword) | 313 | (defun json-encode-keyword (keyword) |
| 324 | "Encode KEYWORD as a JSON value." | 314 | "Encode KEYWORD as a JSON value." |
| 315 | (declare (side-effect-free t)) | ||
| 325 | (cond ((eq keyword t) "true") | 316 | (cond ((eq keyword t) "true") |
| 326 | ((eq keyword json-false) "false") | 317 | ((eq keyword json-false) "false") |
| 327 | ((eq keyword json-null) "null"))) | 318 | ((eq keyword json-null) "null"))) |
| @@ -330,37 +321,31 @@ KEYWORD is the keyword expected." | |||
| 330 | 321 | ||
| 331 | ;; Number parsing | 322 | ;; Number parsing |
| 332 | 323 | ||
| 333 | (defun json-read-number (&optional sign) | 324 | (rx-define json--number |
| 334 | "Read the JSON number following point. | 325 | (: (? ?-) ; Sign. |
| 335 | The optional SIGN argument is for internal use. | 326 | (| (: (in "1-9") (* digit)) ?0) ; Integer. |
| 336 | 327 | (? ?. (+ digit)) ; Fraction. | |
| 337 | N.B.: Only numbers which can fit in Emacs Lisp's native number | 328 | (? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent. |
| 338 | representation will be parsed correctly." | 329 | |
| 339 | ;; If SIGN is non-nil, the number is explicitly signed. | 330 | (defun json-read-number (&optional _sign) |
| 340 | (let ((number-regexp | 331 | "Read the JSON number following point." |
| 341 | "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?")) | 332 | (declare (advertised-calling-convention () "28.1")) |
| 342 | (cond ((and (null sign) (= (json-peek) ?-)) | 333 | (or (looking-at (rx json--number)) |
| 343 | (json-advance) | 334 | (signal 'json-number-format (list (point)))) |
| 344 | (- (json-read-number t))) | 335 | (goto-char (match-end 0)) |
| 345 | ((and (null sign) (= (json-peek) ?+)) | 336 | (prog1 (string-to-number (match-string 0)) |
| 346 | (json-advance) | 337 | (or (looking-at-p (rx json--post-value)) |
| 347 | (json-read-number t)) | 338 | (signal 'json-number-format (list (point)))) |
| 348 | ((and (looking-at number-regexp) | 339 | (json-skip-whitespace))) |
| 349 | (or (match-beginning 1) | ||
| 350 | (match-beginning 2))) | ||
| 351 | (goto-char (match-end 0)) | ||
| 352 | (string-to-number (match-string 0))) | ||
| 353 | (t (signal 'json-number-format (list (point))))))) | ||
| 354 | 340 | ||
| 355 | ;; Number encoding | 341 | ;; Number encoding |
| 356 | 342 | ||
| 357 | (defun json-encode-number (number) | 343 | (defalias 'json-encode-number #'number-to-string |
| 358 | "Return a JSON representation of NUMBER." | 344 | "Return a JSON representation of NUMBER.") |
| 359 | (format "%s" number)) | ||
| 360 | 345 | ||
| 361 | ;;; Strings | 346 | ;;; Strings |
| 362 | 347 | ||
| 363 | (defvar json-special-chars | 348 | (defconst json-special-chars |
| 364 | '((?\" . ?\") | 349 | '((?\" . ?\") |
| 365 | (?\\ . ?\\) | 350 | (?\\ . ?\\) |
| 366 | (?b . ?\b) | 351 | (?b . ?\b) |
| @@ -368,7 +353,7 @@ representation will be parsed correctly." | |||
| 368 | (?n . ?\n) | 353 | (?n . ?\n) |
| 369 | (?r . ?\r) | 354 | (?r . ?\r) |
| 370 | (?t . ?\t)) | 355 | (?t . ?\t)) |
| 371 | "Characters which are escaped in JSON, with their elisp counterparts.") | 356 | "Characters which are escaped in JSON, with their Elisp counterparts.") |
| 372 | 357 | ||
| 373 | ;; String parsing | 358 | ;; String parsing |
| 374 | 359 | ||
| @@ -378,48 +363,47 @@ representation will be parsed correctly." | |||
| 378 | 363 | ||
| 379 | (defun json-read-escaped-char () | 364 | (defun json-read-escaped-char () |
| 380 | "Read the JSON string escaped character at point." | 365 | "Read the JSON string escaped character at point." |
| 381 | ;; Skip over the '\' | 366 | ;; Skip over the '\'. |
| 382 | (json-advance) | 367 | (json-advance) |
| 383 | (let* ((char (json-pop)) | 368 | (let ((char (json-pop))) |
| 384 | (special (assq char json-special-chars))) | ||
| 385 | (cond | 369 | (cond |
| 386 | (special (cdr special)) | 370 | ((cdr (assq char json-special-chars))) |
| 387 | ((not (eq char ?u)) char) | 371 | ((/= char ?u) char) |
| 388 | ;; Special-case UTF-16 surrogate pairs, | 372 | ;; Special-case UTF-16 surrogate pairs, |
| 389 | ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that | 373 | ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that |
| 390 | ;; this clause overlaps with the next one and therefore has to | 374 | ;; this clause overlaps with the next one and therefore has to |
| 391 | ;; come first. | 375 | ;; come first. |
| 392 | ((looking-at | 376 | ((looking-at |
| 393 | (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit))) | 377 | (rx (group (any "Dd") (any "89ABab") (= 2 xdigit)) |
| 394 | "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit))))) | 378 | "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit)))) |
| 395 | (json-advance 10) | 379 | (json-advance 10) |
| 396 | (json--decode-utf-16-surrogates | 380 | (json--decode-utf-16-surrogates |
| 397 | (string-to-number (match-string 1) 16) | 381 | (string-to-number (match-string 1) 16) |
| 398 | (string-to-number (match-string 2) 16))) | 382 | (string-to-number (match-string 2) 16))) |
| 399 | ((looking-at (rx (= 4 xdigit))) | 383 | ((looking-at (rx (= 4 xdigit))) |
| 400 | (let ((hex (match-string 0))) | 384 | (json-advance 4) |
| 401 | (json-advance 4) | 385 | (string-to-number (match-string 0) 16)) |
| 402 | (string-to-number hex 16))) | ||
| 403 | (t | 386 | (t |
| 404 | (signal 'json-string-escape (list (point))))))) | 387 | (signal 'json-string-escape (list (point))))))) |
| 405 | 388 | ||
| 406 | (defun json-read-string () | 389 | (defun json-read-string () |
| 407 | "Read the JSON string at point." | 390 | "Read the JSON string at point." |
| 408 | (unless (= (json-peek) ?\") | 391 | ;; Skip over the '"'. |
| 409 | (signal 'json-string-format (list "doesn't start with `\"'!"))) | ||
| 410 | ;; Skip over the '"' | ||
| 411 | (json-advance) | 392 | (json-advance) |
| 412 | (let ((characters '()) | 393 | (let ((characters '()) |
| 413 | (char (json-peek))) | 394 | (char (json-peek))) |
| 414 | (while (not (= char ?\")) | 395 | (while (/= char ?\") |
| 415 | (when (< char 32) | 396 | (when (< char 32) |
| 416 | (signal 'json-string-format (list (prin1-char char)))) | 397 | (if (zerop char) |
| 398 | (signal 'json-end-of-file ()) | ||
| 399 | (signal 'json-string-format (list char)))) | ||
| 417 | (push (if (= char ?\\) | 400 | (push (if (= char ?\\) |
| 418 | (json-read-escaped-char) | 401 | (json-read-escaped-char) |
| 419 | (json-pop)) | 402 | (json-advance) |
| 403 | char) | ||
| 420 | characters) | 404 | characters) |
| 421 | (setq char (json-peek))) | 405 | (setq char (json-peek))) |
| 422 | ;; Skip over the '"' | 406 | ;; Skip over the '"'. |
| 423 | (json-advance) | 407 | (json-advance) |
| 424 | (if characters | 408 | (if characters |
| 425 | (concat (nreverse characters)) | 409 | (concat (nreverse characters)) |
| @@ -427,29 +411,47 @@ representation will be parsed correctly." | |||
| 427 | 411 | ||
| 428 | ;; String encoding | 412 | ;; String encoding |
| 429 | 413 | ||
| 414 | ;; Escape only quotation mark, backslash, and the control | ||
| 415 | ;; characters U+0000 to U+001F (RFC 4627, ECMA-404). | ||
| 416 | (rx-define json--escape (in ?\" ?\\ cntrl)) | ||
| 417 | |||
| 418 | (defvar json--long-string-threshold 200 | ||
| 419 | "Length above which strings are considered long for JSON encoding. | ||
| 420 | It is generally faster to manipulate such strings in a buffer | ||
| 421 | rather than directly.") | ||
| 422 | |||
| 423 | (defvar json--string-buffer nil | ||
| 424 | "Buffer used for encoding Lisp strings as JSON. | ||
| 425 | Initialized lazily by `json-encode-string'.") | ||
| 426 | |||
| 430 | (defun json-encode-string (string) | 427 | (defun json-encode-string (string) |
| 431 | "Return a JSON representation of STRING." | 428 | "Return a JSON representation of STRING." |
| 432 | ;; Reimplement the meat of `replace-regexp-in-string', for | 429 | ;; Try to avoid buffer overhead in trivial cases, while also |
| 433 | ;; performance (bug#20154). | 430 | ;; avoiding searching pathological strings for escape characters. |
| 434 | (let ((l (length string)) | 431 | ;; Since `string-match-p' doesn't take a LIMIT argument, we use |
| 435 | (start 0) | 432 | ;; string length as our heuristic. See also bug#20154. |
| 436 | res mb) | 433 | (if (and (< (length string) json--long-string-threshold) |
| 437 | ;; Only escape quotation mark, backslash and the control | 434 | (not (string-match-p (rx json--escape) string))) |
| 438 | ;; characters U+0000 to U+001F (RFC 4627, ECMA-404). | 435 | (concat "\"" string "\"") |
| 439 | (while (setq mb (string-match "[\"\\[:cntrl:]]" string start)) | 436 | (with-current-buffer |
| 440 | (let* ((c (aref string mb)) | 437 | (or json--string-buffer |
| 441 | (special (rassq c json-special-chars))) | 438 | (with-current-buffer (generate-new-buffer " *json-string*") |
| 442 | (push (substring string start mb) res) | 439 | ;; This seems to afford decent performance gains. |
| 443 | (push (if special | 440 | (setq-local inhibit-modification-hooks t) |
| 444 | ;; Special JSON character (\n, \r, etc.). | 441 | (setq json--string-buffer (current-buffer)))) |
| 445 | (string ?\\ (car special)) | 442 | (insert ?\" string) |
| 446 | ;; Fallback: UCS code point in \uNNNN form. | 443 | (goto-char (1+ (point-min))) |
| 447 | (format "\\u%04x" c)) | 444 | (while (re-search-forward (rx json--escape) nil 'move) |
| 448 | res) | 445 | (let ((char (preceding-char))) |
| 449 | (setq start (1+ mb)))) | 446 | (delete-char -1) |
| 450 | (push (substring string start l) res) | 447 | (insert ?\\ (or |
| 451 | (push "\"" res) | 448 | ;; Special JSON character (\n, \r, etc.). |
| 452 | (apply #'concat "\"" (nreverse res)))) | 449 | (car (rassq char json-special-chars)) |
| 450 | ;; Fallback: UCS code point in \uNNNN form. | ||
| 451 | (format "u%04x" char))))) | ||
| 452 | (insert ?\") | ||
| 453 | ;; Empty buffer for next invocation. | ||
| 454 | (delete-and-extract-region (point-min) (point-max))))) | ||
| 453 | 455 | ||
| 454 | (defun json-encode-key (object) | 456 | (defun json-encode-key (object) |
| 455 | "Return a JSON representation of OBJECT. | 457 | "Return a JSON representation of OBJECT. |
| @@ -460,15 +462,13 @@ this signals `json-key-format'." | |||
| 460 | (signal 'json-key-format (list object))) | 462 | (signal 'json-key-format (list object))) |
| 461 | encoded)) | 463 | encoded)) |
| 462 | 464 | ||
| 463 | ;;; JSON Objects | 465 | ;;; Objects |
| 464 | 466 | ||
| 465 | (defun json-new-object () | 467 | (defun json-new-object () |
| 466 | "Create a new Elisp object corresponding to a JSON object. | 468 | "Create a new Elisp object corresponding to an empty JSON object. |
| 467 | Please see the documentation of `json-object-type'." | 469 | Please see the documentation of `json-object-type'." |
| 468 | (cond ((eq json-object-type 'hash-table) | 470 | (and (eq json-object-type 'hash-table) |
| 469 | (make-hash-table :test 'equal)) | 471 | (make-hash-table :test #'equal))) |
| 470 | (t | ||
| 471 | ()))) | ||
| 472 | 472 | ||
| 473 | (defun json-add-to-object (object key value) | 473 | (defun json-add-to-object (object key value) |
| 474 | "Add a new KEY -> VALUE association to OBJECT. | 474 | "Add a new KEY -> VALUE association to OBJECT. |
| @@ -476,10 +476,10 @@ Returns the updated object, which you should save, e.g.: | |||
| 476 | (setq obj (json-add-to-object obj \"foo\" \"bar\")) | 476 | (setq obj (json-add-to-object obj \"foo\" \"bar\")) |
| 477 | Please see the documentation of `json-object-type' and `json-key-type'." | 477 | Please see the documentation of `json-object-type' and `json-key-type'." |
| 478 | (let ((json-key-type | 478 | (let ((json-key-type |
| 479 | (or json-key-type | 479 | (cond (json-key-type) |
| 480 | (cdr (assq json-object-type '((hash-table . string) | 480 | ((eq json-object-type 'hash-table) 'string) |
| 481 | (alist . symbol) | 481 | ((eq json-object-type 'alist) 'symbol) |
| 482 | (plist . keyword))))))) | 482 | ((eq json-object-type 'plist) 'keyword)))) |
| 483 | (setq key | 483 | (setq key |
| 484 | (cond ((eq json-key-type 'string) | 484 | (cond ((eq json-key-type 'string) |
| 485 | key) | 485 | key) |
| @@ -499,13 +499,13 @@ Please see the documentation of `json-object-type' and `json-key-type'." | |||
| 499 | 499 | ||
| 500 | (defun json-read-object () | 500 | (defun json-read-object () |
| 501 | "Read the JSON object at point." | 501 | "Read the JSON object at point." |
| 502 | ;; Skip over the "{" | 502 | ;; Skip over the '{'. |
| 503 | (json-advance) | 503 | (json-advance) |
| 504 | (json-skip-whitespace) | 504 | (json-skip-whitespace) |
| 505 | ;; read key/value pairs until "}" | 505 | ;; Read key/value pairs until '}'. |
| 506 | (let ((elements (json-new-object)) | 506 | (let ((elements (json-new-object)) |
| 507 | key value) | 507 | key value) |
| 508 | (while (not (= (json-peek) ?})) | 508 | (while (/= (json-peek) ?\}) |
| 509 | (json-skip-whitespace) | 509 | (json-skip-whitespace) |
| 510 | (setq key (json-read-string)) | 510 | (setq key (json-read-string)) |
| 511 | (json-skip-whitespace) | 511 | (json-skip-whitespace) |
| @@ -520,94 +520,94 @@ Please see the documentation of `json-object-type' and `json-key-type'." | |||
| 520 | (funcall json-post-element-read-function)) | 520 | (funcall json-post-element-read-function)) |
| 521 | (setq elements (json-add-to-object elements key value)) | 521 | (setq elements (json-add-to-object elements key value)) |
| 522 | (json-skip-whitespace) | 522 | (json-skip-whitespace) |
| 523 | (when (/= (json-peek) ?}) | 523 | (when (/= (json-peek) ?\}) |
| 524 | (if (= (json-peek) ?,) | 524 | (if (= (json-peek) ?,) |
| 525 | (json-advance) | 525 | (json-advance) |
| 526 | (signal 'json-object-format (list "," (json-peek)))))) | 526 | (signal 'json-object-format (list "," (json-peek)))))) |
| 527 | ;; Skip over the "}" | 527 | ;; Skip over the '}'. |
| 528 | (json-advance) | 528 | (json-advance) |
| 529 | (pcase json-object-type | 529 | (pcase json-object-type |
| 530 | ('alist (nreverse elements)) | 530 | ('alist (nreverse elements)) |
| 531 | ('plist (json--plist-reverse elements)) | 531 | ('plist (json--plist-nreverse elements)) |
| 532 | (_ elements)))) | 532 | (_ elements)))) |
| 533 | 533 | ||
| 534 | ;; Hash table encoding | 534 | ;; Hash table encoding |
| 535 | 535 | ||
| 536 | (defun json-encode-hash-table (hash-table) | 536 | (defun json-encode-hash-table (hash-table) |
| 537 | "Return a JSON representation of HASH-TABLE." | 537 | "Return a JSON representation of HASH-TABLE." |
| 538 | (if json-encoding-object-sort-predicate | 538 | (cond ((hash-table-empty-p hash-table) "{}") |
| 539 | (json-encode-alist (map-into hash-table 'list)) | 539 | (json-encoding-object-sort-predicate |
| 540 | (format "{%s%s}" | 540 | (json--encode-alist (map-pairs hash-table) t)) |
| 541 | (json-join | 541 | (t |
| 542 | (let (r) | 542 | (let ((kv-sep (if json-encoding-pretty-print ": " ":")) |
| 543 | (json--with-indentation | 543 | result) |
| 544 | (maphash | 544 | (json--with-indentation |
| 545 | (lambda (k v) | 545 | (maphash |
| 546 | (push (format | 546 | (lambda (k v) |
| 547 | (if json-encoding-pretty-print | 547 | (push (concat json--encoding-current-indentation |
| 548 | "%s%s: %s" | 548 | (json-encode-key k) |
| 549 | "%s%s:%s") | 549 | kv-sep |
| 550 | json--encoding-current-indentation | 550 | (json-encode v)) |
| 551 | (json-encode-key k) | 551 | result)) |
| 552 | (json-encode v)) | 552 | hash-table)) |
| 553 | r)) | 553 | (concat "{" |
| 554 | hash-table)) | 554 | (string-join (nreverse result) json-encoding-separator) |
| 555 | r) | 555 | (and json-encoding-pretty-print |
| 556 | json-encoding-separator) | 556 | (not json-encoding-lisp-style-closings) |
| 557 | (if (or (not json-encoding-pretty-print) | 557 | json--encoding-current-indentation) |
| 558 | json-encoding-lisp-style-closings) | 558 | "}"))))) |
| 559 | "" | ||
| 560 | json--encoding-current-indentation)))) | ||
| 561 | 559 | ||
| 562 | ;; List encoding (including alists and plists) | 560 | ;; List encoding (including alists and plists) |
| 563 | 561 | ||
| 564 | (defun json-encode-alist (alist) | 562 | (defun json--encode-alist (alist &optional destructive) |
| 565 | "Return a JSON representation of ALIST." | 563 | "Return a JSON representation of ALIST. |
| 564 | DESTRUCTIVE non-nil means it is safe to modify ALIST by | ||
| 565 | side-effects." | ||
| 566 | (when json-encoding-object-sort-predicate | 566 | (when json-encoding-object-sort-predicate |
| 567 | (setq alist | 567 | (setq alist (sort (if destructive alist (copy-sequence alist)) |
| 568 | (sort alist (lambda (a b) | 568 | (lambda (a b) |
| 569 | (funcall json-encoding-object-sort-predicate | 569 | (funcall json-encoding-object-sort-predicate |
| 570 | (car a) (car b)))))) | 570 | (car a) (car b)))))) |
| 571 | (format "{%s%s}" | 571 | (concat "{" |
| 572 | (json-join | 572 | (let ((kv-sep (if json-encoding-pretty-print ": " ":"))) |
| 573 | (json--with-indentation | 573 | (json--with-indentation |
| 574 | (mapcar (lambda (cons) | 574 | (mapconcat (lambda (cons) |
| 575 | (format (if json-encoding-pretty-print | 575 | (concat json--encoding-current-indentation |
| 576 | "%s%s: %s" | 576 | (json-encode-key (car cons)) |
| 577 | "%s%s:%s") | 577 | kv-sep |
| 578 | json--encoding-current-indentation | 578 | (json-encode (cdr cons)))) |
| 579 | (json-encode-key (car cons)) | 579 | alist |
| 580 | (json-encode (cdr cons)))) | 580 | json-encoding-separator))) |
| 581 | alist)) | 581 | (and json-encoding-pretty-print |
| 582 | json-encoding-separator) | 582 | (not json-encoding-lisp-style-closings) |
| 583 | (if (or (not json-encoding-pretty-print) | 583 | json--encoding-current-indentation) |
| 584 | json-encoding-lisp-style-closings) | 584 | "}")) |
| 585 | "" | 585 | |
| 586 | json--encoding-current-indentation))) | 586 | (defun json-encode-alist (alist) |
| 587 | "Return a JSON representation of ALIST." | ||
| 588 | (if alist (json--encode-alist alist) "{}")) | ||
| 587 | 589 | ||
| 588 | (defun json-encode-plist (plist) | 590 | (defun json-encode-plist (plist) |
| 589 | "Return a JSON representation of PLIST." | 591 | "Return a JSON representation of PLIST." |
| 590 | (if json-encoding-object-sort-predicate | 592 | (cond ((null plist) "{}") |
| 591 | (json-encode-alist (json--plist-to-alist plist)) | 593 | (json-encoding-object-sort-predicate |
| 592 | (let (result) | 594 | (json--encode-alist (map-pairs plist) t)) |
| 593 | (json--with-indentation | 595 | (t |
| 594 | (while plist | 596 | (let ((kv-sep (if json-encoding-pretty-print ": " ":")) |
| 595 | (push (concat | ||
| 596 | json--encoding-current-indentation | ||
| 597 | (json-encode-key (car plist)) | ||
| 598 | (if json-encoding-pretty-print | ||
| 599 | ": " | ||
| 600 | ":") | ||
| 601 | (json-encode (cadr plist))) | ||
| 602 | result) | 597 | result) |
| 603 | (setq plist (cddr plist)))) | 598 | (json--with-indentation |
| 604 | (concat "{" | 599 | (while plist |
| 605 | (json-join (nreverse result) json-encoding-separator) | 600 | (push (concat json--encoding-current-indentation |
| 606 | (if (and json-encoding-pretty-print | 601 | (json-encode-key (pop plist)) |
| 607 | (not json-encoding-lisp-style-closings)) | 602 | kv-sep |
| 608 | json--encoding-current-indentation | 603 | (json-encode (pop plist))) |
| 609 | "") | 604 | result))) |
| 610 | "}")))) | 605 | (concat "{" |
| 606 | (string-join (nreverse result) json-encoding-separator) | ||
| 607 | (and json-encoding-pretty-print | ||
| 608 | (not json-encoding-lisp-style-closings) | ||
| 609 | json--encoding-current-indentation) | ||
| 610 | "}"))))) | ||
| 611 | 611 | ||
| 612 | (defun json-encode-list (list) | 612 | (defun json-encode-list (list) |
| 613 | "Return a JSON representation of LIST. | 613 | "Return a JSON representation of LIST. |
| @@ -625,15 +625,17 @@ become JSON objects." | |||
| 625 | 625 | ||
| 626 | (defun json-read-array () | 626 | (defun json-read-array () |
| 627 | "Read the JSON array at point." | 627 | "Read the JSON array at point." |
| 628 | ;; Skip over the "[" | 628 | ;; Skip over the '['. |
| 629 | (json-advance) | 629 | (json-advance) |
| 630 | (json-skip-whitespace) | 630 | (json-skip-whitespace) |
| 631 | ;; read values until "]" | 631 | ;; Read values until ']'. |
| 632 | (let (elements) | 632 | (let (elements |
| 633 | (while (not (= (json-peek) ?\])) | 633 | (len 0)) |
| 634 | (while (/= (json-peek) ?\]) | ||
| 634 | (json-skip-whitespace) | 635 | (json-skip-whitespace) |
| 635 | (when json-pre-element-read-function | 636 | (when json-pre-element-read-function |
| 636 | (funcall json-pre-element-read-function (length elements))) | 637 | (funcall json-pre-element-read-function len) |
| 638 | (setq len (1+ len))) | ||
| 637 | (push (json-read) elements) | 639 | (push (json-read) elements) |
| 638 | (when json-post-element-read-function | 640 | (when json-post-element-read-function |
| 639 | (funcall json-post-element-read-function)) | 641 | (funcall json-post-element-read-function)) |
| @@ -641,8 +643,8 @@ become JSON objects." | |||
| 641 | (when (/= (json-peek) ?\]) | 643 | (when (/= (json-peek) ?\]) |
| 642 | (if (= (json-peek) ?,) | 644 | (if (= (json-peek) ?,) |
| 643 | (json-advance) | 645 | (json-advance) |
| 644 | (signal 'json-array-format (list ?, (json-peek)))))) | 646 | (signal 'json-array-format (list "," (json-peek)))))) |
| 645 | ;; Skip over the "]" | 647 | ;; Skip over the ']'. |
| 646 | (json-advance) | 648 | (json-advance) |
| 647 | (pcase json-array-type | 649 | (pcase json-array-type |
| 648 | ('vector (nreverse (vconcat elements))) | 650 | ('vector (nreverse (vconcat elements))) |
| @@ -653,42 +655,43 @@ become JSON objects." | |||
| 653 | (defun json-encode-array (array) | 655 | (defun json-encode-array (array) |
| 654 | "Return a JSON representation of ARRAY." | 656 | "Return a JSON representation of ARRAY." |
| 655 | (if (and json-encoding-pretty-print | 657 | (if (and json-encoding-pretty-print |
| 656 | (> (length array) 0)) | 658 | (not (seq-empty-p array))) |
| 657 | (concat | 659 | (concat |
| 660 | "[" | ||
| 658 | (json--with-indentation | 661 | (json--with-indentation |
| 659 | (concat (format "[%s" json--encoding-current-indentation) | 662 | (concat json--encoding-current-indentation |
| 660 | (json-join (mapcar 'json-encode array) | 663 | (mapconcat #'json-encode array |
| 661 | (format "%s%s" | 664 | (concat json-encoding-separator |
| 662 | json-encoding-separator | ||
| 663 | json--encoding-current-indentation)))) | 665 | json--encoding-current-indentation)))) |
| 664 | (format "%s]" | 666 | (unless json-encoding-lisp-style-closings |
| 665 | (if json-encoding-lisp-style-closings | 667 | json--encoding-current-indentation) |
| 666 | "" | 668 | "]") |
| 667 | json--encoding-current-indentation))) | ||
| 668 | (concat "[" | 669 | (concat "[" |
| 669 | (mapconcat 'json-encode array json-encoding-separator) | 670 | (mapconcat #'json-encode array json-encoding-separator) |
| 670 | "]"))) | 671 | "]"))) |
| 671 | 672 | ||
| 672 | 673 | ||
| 673 | 674 | ||
| 674 | ;;; JSON reader. | 675 | ;;; Reader |
| 675 | 676 | ||
| 676 | (defmacro json-readtable-dispatch (char) | 677 | (defmacro json-readtable-dispatch (char) |
| 677 | "Dispatch reader function for CHAR." | 678 | "Dispatch reader function for CHAR at point. |
| 678 | (declare (debug (symbolp))) | 679 | If CHAR is nil, signal `json-end-of-file'." |
| 679 | (let ((table | 680 | (declare (debug t)) |
| 680 | '((?t json-read-keyword "true") | 681 | (macroexp-let2 nil char char |
| 681 | (?f json-read-keyword "false") | 682 | `(cond ,@(map-apply |
| 682 | (?n json-read-keyword "null") | 683 | (lambda (key expr) |
| 683 | (?{ json-read-object) | 684 | `((eq ,char ,key) ,expr)) |
| 684 | (?\[ json-read-array) | 685 | `((?\" ,#'json-read-string) |
| 685 | (?\" json-read-string))) | 686 | (?\[ ,#'json-read-array) |
| 686 | res) | 687 | (?\{ ,#'json-read-object) |
| 687 | (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) | 688 | (?n ,#'json-read-keyword "null") |
| 688 | (push (list c 'json-read-number) table)) | 689 | (?f ,#'json-read-keyword "false") |
| 689 | (pcase-dolist (`(,c . ,rest) table) | 690 | (?t ,#'json-read-keyword "true") |
| 690 | (push `((eq ,char ,c) (,@rest)) res)) | 691 | ,@(mapcar (lambda (c) (list c #'json-read-number)) |
| 691 | `(cond ,@res (t (signal 'json-readtable-error (list ,char)))))) | 692 | '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))) |
| 693 | (,char (signal 'json-readtable-error (list ,char))) | ||
| 694 | (t (signal 'json-end-of-file ()))))) | ||
| 692 | 695 | ||
| 693 | (defun json-read () | 696 | (defun json-read () |
| 694 | "Parse and return the JSON object following point. | 697 | "Parse and return the JSON object following point. |
| @@ -706,10 +709,7 @@ you will get the following structure returned: | |||
| 706 | ((c . :json-false))]) | 709 | ((c . :json-false))]) |
| 707 | (b . \"foo\"))" | 710 | (b . \"foo\"))" |
| 708 | (json-skip-whitespace) | 711 | (json-skip-whitespace) |
| 709 | (let ((char (json-peek))) | 712 | (json-readtable-dispatch (char-after))) |
| 710 | (if (zerop char) | ||
| 711 | (signal 'json-end-of-file nil) | ||
| 712 | (json-readtable-dispatch char)))) | ||
| 713 | 713 | ||
| 714 | ;; Syntactic sugar for the reader | 714 | ;; Syntactic sugar for the reader |
| 715 | 715 | ||
| @@ -724,12 +724,11 @@ you will get the following structure returned: | |||
| 724 | "Read the first JSON object contained in FILE and return it." | 724 | "Read the first JSON object contained in FILE and return it." |
| 725 | (with-temp-buffer | 725 | (with-temp-buffer |
| 726 | (insert-file-contents file) | 726 | (insert-file-contents file) |
| 727 | (goto-char (point-min)) | ||
| 728 | (json-read))) | 727 | (json-read))) |
| 729 | 728 | ||
| 730 | 729 | ||
| 731 | 730 | ||
| 732 | ;;; JSON encoder | 731 | ;;; Encoder |
| 733 | 732 | ||
| 734 | (defun json-encode (object) | 733 | (defun json-encode (object) |
| 735 | "Return a JSON representation of OBJECT as a string. | 734 | "Return a JSON representation of OBJECT as a string. |
| @@ -737,20 +736,21 @@ you will get the following structure returned: | |||
| 737 | OBJECT should have a structure like one returned by `json-read'. | 736 | OBJECT should have a structure like one returned by `json-read'. |
| 738 | If an error is detected during encoding, an error based on | 737 | If an error is detected during encoding, an error based on |
| 739 | `json-error' is signaled." | 738 | `json-error' is signaled." |
| 740 | (cond ((memq object (list t json-null json-false)) | 739 | (cond ((eq object t) (json-encode-keyword object)) |
| 741 | (json-encode-keyword object)) | 740 | ((eq object json-null) (json-encode-keyword object)) |
| 742 | ((stringp object) (json-encode-string object)) | 741 | ((eq object json-false) (json-encode-keyword object)) |
| 743 | ((keywordp object) (json-encode-string | 742 | ((stringp object) (json-encode-string object)) |
| 744 | (substring (symbol-name object) 1))) | 743 | ((keywordp object) (json-encode-string |
| 745 | ((listp object) (json-encode-list object)) | 744 | (substring (symbol-name object) 1))) |
| 746 | ((symbolp object) (json-encode-string | 745 | ((listp object) (json-encode-list object)) |
| 747 | (symbol-name object))) | 746 | ((symbolp object) (json-encode-string |
| 748 | ((numberp object) (json-encode-number object)) | 747 | (symbol-name object))) |
| 749 | ((arrayp object) (json-encode-array object)) | 748 | ((numberp object) (json-encode-number object)) |
| 750 | ((hash-table-p object) (json-encode-hash-table object)) | 749 | ((arrayp object) (json-encode-array object)) |
| 751 | (t (signal 'json-error (list object))))) | 750 | ((hash-table-p object) (json-encode-hash-table object)) |
| 752 | 751 | (t (signal 'json-error (list object))))) | |
| 753 | ;; Pretty printing & minimizing | 752 | |
| 753 | ;;; Pretty printing & minimizing | ||
| 754 | 754 | ||
| 755 | (defun json-pretty-print-buffer (&optional minimize) | 755 | (defun json-pretty-print-buffer (&optional minimize) |
| 756 | "Pretty-print current buffer. | 756 | "Pretty-print current buffer. |
| @@ -769,9 +769,9 @@ MAX-SECS.") | |||
| 769 | With prefix argument MINIMIZE, minimize it instead." | 769 | With prefix argument MINIMIZE, minimize it instead." |
| 770 | (interactive "r\nP") | 770 | (interactive "r\nP") |
| 771 | (let ((json-encoding-pretty-print (null minimize)) | 771 | (let ((json-encoding-pretty-print (null minimize)) |
| 772 | ;; Distinguish an empty objects from 'null' | 772 | ;; Distinguish an empty object from 'null'. |
| 773 | (json-null :json-null) | 773 | (json-null :json-null) |
| 774 | ;; Ensure that ordering is maintained | 774 | ;; Ensure that ordering is maintained. |
| 775 | (json-object-type 'alist) | 775 | (json-object-type 'alist) |
| 776 | (orig-buf (current-buffer)) | 776 | (orig-buf (current-buffer)) |
| 777 | error) | 777 | error) |
| @@ -800,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead." | |||
| 800 | ;; them. | 800 | ;; them. |
| 801 | (let ((space (buffer-substring | 801 | (let ((space (buffer-substring |
| 802 | (point) | 802 | (point) |
| 803 | (+ (point) | 803 | (+ (point) (skip-chars-forward " \t\n")))) |
| 804 | (skip-chars-forward | ||
| 805 | " \t\n" (point-max))))) | ||
| 806 | (json (json-read))) | 804 | (json (json-read))) |
| 807 | (setq pos (point)) ; End of last good json-read. | 805 | (setq pos (point)) ; End of last good json-read. |
| 808 | (set-buffer tmp-buf) | 806 | (set-buffer tmp-buf) |
| @@ -832,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead." | |||
| 832 | "Pretty-print current buffer with object keys ordered. | 830 | "Pretty-print current buffer with object keys ordered. |
| 833 | With prefix argument MINIMIZE, minimize it instead." | 831 | With prefix argument MINIMIZE, minimize it instead." |
| 834 | (interactive "P") | 832 | (interactive "P") |
| 835 | (let ((json-encoding-object-sort-predicate 'string<)) | 833 | (let ((json-encoding-object-sort-predicate #'string<)) |
| 836 | (json-pretty-print-buffer minimize))) | 834 | (json-pretty-print-buffer minimize))) |
| 837 | 835 | ||
| 838 | (defun json-pretty-print-ordered (begin end &optional minimize) | 836 | (defun json-pretty-print-ordered (begin end &optional minimize) |
| 839 | "Pretty-print the region with object keys ordered. | 837 | "Pretty-print the region with object keys ordered. |
| 840 | With prefix argument MINIMIZE, minimize it instead." | 838 | With prefix argument MINIMIZE, minimize it instead." |
| 841 | (interactive "r\nP") | 839 | (interactive "r\nP") |
| 842 | (let ((json-encoding-object-sort-predicate 'string<)) | 840 | (let ((json-encoding-object-sort-predicate #'string<)) |
| 843 | (json-pretty-print begin end minimize))) | 841 | (json-pretty-print begin end minimize))) |
| 844 | 842 | ||
| 845 | (provide 'json) | 843 | (provide 'json) |
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 293dfaa7483..42e7701af18 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el | |||
| @@ -37,7 +37,6 @@ | |||
| 37 | ;;; Code: | 37 | ;;; Code: |
| 38 | 38 | ||
| 39 | (require 'cl-lib) | 39 | (require 'cl-lib) |
| 40 | (require 'json) | ||
| 41 | (require 'eieio) | 40 | (require 'eieio) |
| 42 | (eval-when-compile (require 'subr-x)) | 41 | (eval-when-compile (require 'subr-x)) |
| 43 | (require 'warnings) | 42 | (require 'warnings) |
| @@ -470,26 +469,35 @@ With optional CLEANUP, kill any associated buffers." | |||
| 470 | ;;; | 469 | ;;; |
| 471 | (define-error 'jsonrpc-error "jsonrpc-error") | 470 | (define-error 'jsonrpc-error "jsonrpc-error") |
| 472 | 471 | ||
| 473 | (defun jsonrpc--json-read () | 472 | (defalias 'jsonrpc--json-read |
| 474 | "Read JSON object in buffer, move point to end of buffer." | 473 | (if (fboundp 'json-parse-buffer) |
| 475 | ;; TODO: I guess we can make these macros if/when jsonrpc.el | 474 | (lambda () |
| 476 | ;; goes into Emacs core. | 475 | (json-parse-buffer :object-type 'plist |
| 477 | (cond ((fboundp 'json-parse-buffer) (json-parse-buffer | 476 | :null-object nil |
| 478 | :object-type 'plist | 477 | :false-object :json-false)) |
| 479 | :null-object nil | 478 | (require 'json) |
| 480 | :false-object :json-false)) | 479 | (defvar json-object-type) |
| 481 | (t (let ((json-object-type 'plist)) | 480 | (declare-function json-read "json" ()) |
| 482 | (json-read))))) | 481 | (lambda () |
| 483 | 482 | (let ((json-object-type 'plist)) | |
| 484 | (defun jsonrpc--json-encode (object) | 483 | (json-read)))) |
| 485 | "Encode OBJECT into a JSON string." | 484 | "Read JSON object in buffer, move point to end of buffer.") |
| 486 | (cond ((fboundp 'json-serialize) (json-serialize | 485 | |
| 487 | object | 486 | (defalias 'jsonrpc--json-encode |
| 488 | :false-object :json-false | 487 | (if (fboundp 'json-serialize) |
| 489 | :null-object nil)) | 488 | (lambda (object) |
| 490 | (t (let ((json-false :json-false) | 489 | (json-serialize object |
| 491 | (json-null nil)) | 490 | :false-object :json-false |
| 492 | (json-encode object))))) | 491 | :null-object nil)) |
| 492 | (require 'json) | ||
| 493 | (defvar json-false) | ||
| 494 | (defvar json-null) | ||
| 495 | (declare-function json-encode "json" (object)) | ||
| 496 | (lambda (object) | ||
| 497 | (let ((json-false :json-false) | ||
| 498 | (json-null nil)) | ||
| 499 | (json-encode object)))) | ||
| 500 | "Encode OBJECT into a JSON string.") | ||
| 493 | 501 | ||
| 494 | (cl-defun jsonrpc--reply | 502 | (cl-defun jsonrpc--reply |
| 495 | (connection id &key (result nil result-supplied-p) (error nil error-supplied-p)) | 503 | (connection id &key (result nil result-supplied-p) (error nil error-supplied-p)) |
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el index 29fff9175b7..8684cdb1338 100644 --- a/lisp/language/tibet-util.el +++ b/lisp/language/tibet-util.el | |||
| @@ -43,13 +43,17 @@ | |||
| 43 | ("་" . "་") | 43 | ("་" . "་") |
| 44 | ("༔" . "༔") | 44 | ("༔" . "༔") |
| 45 | ;; Yes these are dirty. But ... | 45 | ;; Yes these are dirty. But ... |
| 46 | ("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎])) | 46 | ("༎ ༎" . ,(compose-string (copy-sequence "༎ ༎") |
| 47 | 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎])) | ||
| 47 | ("༄༅༅" . ,(compose-string | 48 | ("༄༅༅" . ,(compose-string |
| 48 | "࿁࿂࿂࿂" 0 4 | 49 | (copy-sequence "࿁࿂࿂࿂") 0 4 |
| 49 | [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂ (Br . Bl) ?࿂])) | 50 | [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂ (Br . Bl) ?࿂])) |
| 50 | ("༄༅" . ,(compose-string "࿁࿂࿂" 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂])) | 51 | ("༄༅" . ,(compose-string (copy-sequence "࿁࿂࿂") |
| 51 | ("༆" . ,(compose-string "࿁࿂༙" 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙])) | 52 | 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂])) |
| 52 | ("༄" . ,(compose-string "࿁࿂" 0 2 [?࿁ (Br . Bl) ?࿂])))) | 53 | ("༆" . ,(compose-string (copy-sequence "࿁࿂༙") |
| 54 | 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙])) | ||
| 55 | ("༄" . ,(compose-string (copy-sequence "࿁࿂") | ||
| 56 | 0 2 [?࿁ (Br . Bl) ?࿂])))) | ||
| 53 | 57 | ||
| 54 | ;;;###autoload | 58 | ;;;###autoload |
| 55 | (defun tibetan-char-p (ch) | 59 | (defun tibetan-char-p (ch) |
diff --git a/lisp/mouse.el b/lisp/mouse.el index f045e5bdce2..640f10af4e1 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -2580,7 +2580,7 @@ in a tooltip." | |||
| 2580 | :type '(choice | 2580 | :type '(choice |
| 2581 | (const :tag "Do not show tooltips" nil) | 2581 | (const :tag "Do not show tooltips" nil) |
| 2582 | (const :tag "Show all text" t) | 2582 | (const :tag "Show all text" t) |
| 2583 | (integer :tag "Show characters (max)" 256)) | 2583 | (integer :tag "Max number of characters to show" 256)) |
| 2584 | :version "26.1") | 2584 | :version "26.1") |
| 2585 | 2585 | ||
| 2586 | (defcustom mouse-drag-and-drop-region-show-cursor t | 2586 | (defcustom mouse-drag-and-drop-region-show-cursor t |
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index a6c1abdbb19..2a70560ca7b 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -307,10 +307,10 @@ the default EWW buffer." | |||
| 307 | (insert (format "Loading %s..." url)) | 307 | (insert (format "Loading %s..." url)) |
| 308 | (goto-char (point-min))) | 308 | (goto-char (point-min))) |
| 309 | (let ((url-mime-accept-string eww-accept-content-types)) | 309 | (let ((url-mime-accept-string eww-accept-content-types)) |
| 310 | (url-retrieve url 'eww-render | 310 | (url-retrieve url #'eww-render |
| 311 | (list url nil (current-buffer))))) | 311 | (list url nil (current-buffer))))) |
| 312 | 312 | ||
| 313 | (put 'eww 'browse-url-browser-kind 'internal) | 313 | (function-put 'eww 'browse-url-browser-kind 'internal) |
| 314 | 314 | ||
| 315 | (defun eww--dwim-expand-url (url) | 315 | (defun eww--dwim-expand-url (url) |
| 316 | (setq url (string-trim url)) | 316 | (setq url (string-trim url)) |
| @@ -375,8 +375,8 @@ engine used." | |||
| 375 | (let ((region-string (buffer-substring (region-beginning) (region-end)))) | 375 | (let ((region-string (buffer-substring (region-beginning) (region-end)))) |
| 376 | (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string)) | 376 | (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string)) |
| 377 | (eww region-string) | 377 | (eww region-string) |
| 378 | (call-interactively 'eww))) | 378 | (call-interactively #'eww))) |
| 379 | (call-interactively 'eww))) | 379 | (call-interactively #'eww))) |
| 380 | 380 | ||
| 381 | (defun eww-open-in-new-buffer () | 381 | (defun eww-open-in-new-buffer () |
| 382 | "Fetch link at point in a new EWW buffer." | 382 | "Fetch link at point in a new EWW buffer." |
| @@ -1013,7 +1013,7 @@ just re-display the HTML already fetched." | |||
| 1013 | (eww-display-html 'utf-8 url (plist-get eww-data :dom) | 1013 | (eww-display-html 'utf-8 url (plist-get eww-data :dom) |
| 1014 | (point) (current-buffer))) | 1014 | (point) (current-buffer))) |
| 1015 | (let ((url-mime-accept-string eww-accept-content-types)) | 1015 | (let ((url-mime-accept-string eww-accept-content-types)) |
| 1016 | (url-retrieve url 'eww-render | 1016 | (url-retrieve url #'eww-render |
| 1017 | (list url (point) (current-buffer) encode)))))) | 1017 | (list url (point) (current-buffer) encode)))))) |
| 1018 | 1018 | ||
| 1019 | ;; Form support. | 1019 | ;; Form support. |
| @@ -1576,8 +1576,10 @@ If EXTERNAL is double prefix, browse in new buffer." | |||
| 1576 | (cond | 1576 | (cond |
| 1577 | ((not url) | 1577 | ((not url) |
| 1578 | (message "No link under point")) | 1578 | (message "No link under point")) |
| 1579 | ((string-match "^mailto:" url) | 1579 | ((string-match-p "\\`mailto:" url) |
| 1580 | (browse-url-mail url)) | 1580 | ;; This respects the user options `browse-url-handlers' |
| 1581 | ;; and `browse-url-mailto-function'. | ||
| 1582 | (browse-url url)) | ||
| 1581 | ((and (consp external) (<= (car external) 4)) | 1583 | ((and (consp external) (<= (car external) 4)) |
| 1582 | (funcall browse-url-secondary-browser-function url) | 1584 | (funcall browse-url-secondary-browser-function url) |
| 1583 | (shr--blink-link)) | 1585 | (shr--blink-link)) |
| @@ -1615,7 +1617,7 @@ Use link at point if there is one, else the current page's URL." | |||
| 1615 | (eww-current-url)))) | 1617 | (eww-current-url)))) |
| 1616 | (if (not url) | 1618 | (if (not url) |
| 1617 | (message "No URL under point") | 1619 | (message "No URL under point") |
| 1618 | (url-retrieve url 'eww-download-callback (list url))))) | 1620 | (url-retrieve url #'eww-download-callback (list url))))) |
| 1619 | 1621 | ||
| 1620 | (defun eww-download-callback (status url) | 1622 | (defun eww-download-callback (status url) |
| 1621 | (unless (plist-get status :error) | 1623 | (unless (plist-get status :error) |
| @@ -2128,12 +2130,12 @@ entries (if any) will be removed from the list. | |||
| 2128 | Only the properties listed in `eww-desktop-data-save' are included. | 2130 | Only the properties listed in `eww-desktop-data-save' are included. |
| 2129 | Generally, the list should not include the (usually overly large) | 2131 | Generally, the list should not include the (usually overly large) |
| 2130 | :dom, :source and :text properties." | 2132 | :dom, :source and :text properties." |
| 2131 | (let ((history (mapcar 'eww-desktop-data-1 | 2133 | (let ((history (mapcar #'eww-desktop-data-1 |
| 2132 | (cons eww-data eww-history)))) | 2134 | (cons eww-data eww-history)))) |
| 2133 | (list :history (if eww-desktop-remove-duplicates | 2135 | (list :history (if eww-desktop-remove-duplicates |
| 2134 | (cl-remove-duplicates | 2136 | (cl-remove-duplicates |
| 2135 | history :test 'eww-desktop-history-duplicate) | 2137 | history :test #'eww-desktop-history-duplicate) |
| 2136 | history)))) | 2138 | history)))) |
| 2137 | 2139 | ||
| 2138 | (defun eww-restore-desktop (file-name buffer-name misc-data) | 2140 | (defun eww-restore-desktop (file-name buffer-name misc-data) |
| 2139 | "Restore an eww buffer from its desktop file record. | 2141 | "Restore an eww buffer from its desktop file record. |
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 1f80ab74db5..03260c9e70a 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el | |||
| @@ -135,7 +135,7 @@ same domain as the main data." | |||
| 135 | This is used for cid: URLs, and the function is called with the | 135 | This is used for cid: URLs, and the function is called with the |
| 136 | cid: URL as the argument.") | 136 | cid: URL as the argument.") |
| 137 | 137 | ||
| 138 | (defvar shr-put-image-function 'shr-put-image | 138 | (defvar shr-put-image-function #'shr-put-image |
| 139 | "Function called to put image and alt string.") | 139 | "Function called to put image and alt string.") |
| 140 | 140 | ||
| 141 | (defface shr-strike-through '((t :strike-through t)) | 141 | (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 | |||
| 365 | (shr-copy-url url))) | 365 | (shr-copy-url url))) |
| 366 | 366 | ||
| 367 | (defun shr--current-link-region () | 367 | (defun shr--current-link-region () |
| 368 | (let ((current (get-text-property (point) 'shr-url)) | 368 | "Return the start and end positions of the URL at point, if any. |
| 369 | start) | 369 | Value is a pair of positions (START . END) if there is a non-nil |
| 370 | (save-excursion | 370 | `shr-url' text property at point; otherwise nil." |
| 371 | ;; Go to the beginning. | 371 | (when (get-text-property (point) 'shr-url) |
| 372 | (while (and (not (bobp)) | 372 | (let* ((end (or (next-single-property-change (point) 'shr-url) |
| 373 | (equal (get-text-property (point) 'shr-url) current)) | 373 | (point-max))) |
| 374 | (forward-char -1)) | 374 | (beg (or (previous-single-property-change end 'shr-url) |
| 375 | (unless (equal (get-text-property (point) 'shr-url) current) | 375 | (point-min)))) |
| 376 | (forward-char 1)) | 376 | (cons beg end)))) |
| 377 | (setq start (point)) | ||
| 378 | ;; Go to the end. | ||
| 379 | (while (and (not (eobp)) | ||
| 380 | (equal (get-text-property (point) 'shr-url) current)) | ||
| 381 | (forward-char 1)) | ||
| 382 | (list start (point))))) | ||
| 383 | 377 | ||
| 384 | (defun shr--blink-link () | 378 | (defun shr--blink-link () |
| 385 | (let* ((region (shr--current-link-region)) | 379 | "Briefly fontify URL at point with the face `shr-selected-link'." |
| 386 | (overlay (make-overlay (car region) (cadr region)))) | 380 | (when-let* ((region (shr--current-link-region)) |
| 381 | (overlay (make-overlay (car region) (cdr region)))) | ||
| 387 | (overlay-put overlay 'face 'shr-selected-link) | 382 | (overlay-put overlay 'face 'shr-selected-link) |
| 388 | (run-at-time 1 nil (lambda () | 383 | (run-at-time 1 nil (lambda () |
| 389 | (delete-overlay overlay))))) | 384 | (delete-overlay overlay))))) |
| @@ -437,7 +432,7 @@ the URL of the image to the kill buffer instead." | |||
| 437 | (if (not url) | 432 | (if (not url) |
| 438 | (message "No image under point") | 433 | (message "No image under point") |
| 439 | (message "Inserting %s..." url) | 434 | (message "Inserting %s..." url) |
| 440 | (url-retrieve url 'shr-image-fetched | 435 | (url-retrieve url #'shr-image-fetched |
| 441 | (list (current-buffer) (1- (point)) (point-marker)) | 436 | (list (current-buffer) (1- (point)) (point-marker)) |
| 442 | t)))) | 437 | t)))) |
| 443 | 438 | ||
| @@ -463,7 +458,7 @@ size, and full-buffer size." | |||
| 463 | (when (> (- (point) start) 2) | 458 | (when (> (- (point) start) 2) |
| 464 | (delete-region start (1- (point))))) | 459 | (delete-region start (1- (point))))) |
| 465 | (message "Inserting %s..." url) | 460 | (message "Inserting %s..." url) |
| 466 | (url-retrieve url 'shr-image-fetched | 461 | (url-retrieve url #'shr-image-fetched |
| 467 | (list (current-buffer) (1- (point)) (point-marker) | 462 | (list (current-buffer) (1- (point)) (point-marker) |
| 468 | (list (cons 'size | 463 | (list (cons 'size |
| 469 | (cond ((or (eq size 'default) | 464 | (cond ((or (eq size 'default) |
| @@ -493,7 +488,7 @@ size, and full-buffer size." | |||
| 493 | ((fboundp function) | 488 | ((fboundp function) |
| 494 | (apply function dom args)) | 489 | (apply function dom args)) |
| 495 | (t | 490 | (t |
| 496 | (apply 'shr-generic dom args))))) | 491 | (apply #'shr-generic dom args))))) |
| 497 | 492 | ||
| 498 | (defun shr-descend (dom) | 493 | (defun shr-descend (dom) |
| 499 | (let ((function | 494 | (let ((function |
| @@ -730,9 +725,10 @@ size, and full-buffer size." | |||
| 730 | (let ((gap-start (point)) | 725 | (let ((gap-start (point)) |
| 731 | (face (get-text-property (point) 'face))) | 726 | (face (get-text-property (point) 'face))) |
| 732 | ;; Extend the background to the end of the line. | 727 | ;; Extend the background to the end of the line. |
| 733 | (if face | 728 | (insert ?\n) |
| 734 | (insert (propertize "\n" 'face (shr-face-background face))) | 729 | (when face |
| 735 | (insert "\n")) | 730 | (put-text-property (1- (point)) (point) |
| 731 | 'face (shr-face-background face))) | ||
| 736 | (shr-indent) | 732 | (shr-indent) |
| 737 | (when (and (> (1- gap-start) (point-min)) | 733 | (when (and (> (1- gap-start) (point-min)) |
| 738 | (get-text-property (point) 'shr-url) | 734 | (get-text-property (point) 'shr-url) |
| @@ -935,12 +931,11 @@ size, and full-buffer size." | |||
| 935 | 931 | ||
| 936 | (defun shr-indent () | 932 | (defun shr-indent () |
| 937 | (when (> shr-indentation 0) | 933 | (when (> shr-indentation 0) |
| 938 | (insert | 934 | (if (not shr-use-fonts) |
| 939 | (if (not shr-use-fonts) | 935 | (insert-char ?\s shr-indentation) |
| 940 | (make-string shr-indentation ?\s) | 936 | (insert ?\s) |
| 941 | (propertize " " | 937 | (put-text-property (1- (point)) (point) |
| 942 | 'display | 938 | 'display `(space :width (,shr-indentation)))))) |
| 943 | `(space :width (,shr-indentation))))))) | ||
| 944 | 939 | ||
| 945 | (defun shr-fontize-dom (dom &rest types) | 940 | (defun shr-fontize-dom (dom &rest types) |
| 946 | (let ((start (point))) | 941 | (let ((start (point))) |
| @@ -987,16 +982,11 @@ the mouse click event." | |||
| 987 | (cond | 982 | (cond |
| 988 | ((not url) | 983 | ((not url) |
| 989 | (message "No link under point")) | 984 | (message "No link under point")) |
| 990 | ((string-match "^mailto:" url) | 985 | (external |
| 991 | (browse-url-mail url)) | 986 | (funcall browse-url-secondary-browser-function url) |
| 987 | (shr--blink-link)) | ||
| 992 | (t | 988 | (t |
| 993 | (if external | 989 | (browse-url url (xor new-window browse-url-new-window-flag)))))) |
| 994 | (progn | ||
| 995 | (funcall browse-url-secondary-browser-function url) | ||
| 996 | (shr--blink-link)) | ||
| 997 | (browse-url url (if new-window | ||
| 998 | (not browse-url-new-window-flag) | ||
| 999 | browse-url-new-window-flag))))))) | ||
| 1000 | 990 | ||
| 1001 | (defun shr-save-contents (directory) | 991 | (defun shr-save-contents (directory) |
| 1002 | "Save the contents from URL in a file." | 992 | "Save the contents from URL in a file." |
| @@ -1005,7 +995,7 @@ the mouse click event." | |||
| 1005 | (if (not url) | 995 | (if (not url) |
| 1006 | (message "No link under point") | 996 | (message "No link under point") |
| 1007 | (url-retrieve (shr-encode-url url) | 997 | (url-retrieve (shr-encode-url url) |
| 1008 | 'shr-store-contents (list url directory))))) | 998 | #'shr-store-contents (list url directory))))) |
| 1009 | 999 | ||
| 1010 | (defun shr-store-contents (status url directory) | 1000 | (defun shr-store-contents (status url directory) |
| 1011 | (unless (plist-get status :error) | 1001 | (unless (plist-get status :error) |
| @@ -1156,7 +1146,6 @@ width/height instead." | |||
| 1156 | 1146 | ||
| 1157 | ;; url-cache-extract autoloads url-cache. | 1147 | ;; url-cache-extract autoloads url-cache. |
| 1158 | (declare-function url-cache-create-filename "url-cache" (url)) | 1148 | (declare-function url-cache-create-filename "url-cache" (url)) |
| 1159 | (autoload 'browse-url-mail "browse-url") | ||
| 1160 | 1149 | ||
| 1161 | (defun shr-get-image-data (url) | 1150 | (defun shr-get-image-data (url) |
| 1162 | "Get image data for URL. | 1151 | "Get image data for URL. |
| @@ -1230,7 +1219,7 @@ START, and END. Note that START and END should be markers." | |||
| 1230 | (funcall shr-put-image-function | 1219 | (funcall shr-put-image-function |
| 1231 | image (buffer-substring start end)) | 1220 | image (buffer-substring start end)) |
| 1232 | (delete-region (point) end)))) | 1221 | (delete-region (point) end)))) |
| 1233 | (url-retrieve url 'shr-image-fetched | 1222 | (url-retrieve url #'shr-image-fetched |
| 1234 | (list (current-buffer) start end) | 1223 | (list (current-buffer) start end) |
| 1235 | t t))))) | 1224 | t t))))) |
| 1236 | 1225 | ||
| @@ -1679,7 +1668,7 @@ The preference is a float determined from `shr-prefer-media-type'." | |||
| 1679 | (or alt ""))) | 1668 | (or alt ""))) |
| 1680 | (insert " ") | 1669 | (insert " ") |
| 1681 | (url-queue-retrieve | 1670 | (url-queue-retrieve |
| 1682 | (shr-encode-url url) 'shr-image-fetched | 1671 | (shr-encode-url url) #'shr-image-fetched |
| 1683 | (list (current-buffer) start (set-marker (make-marker) (point)) | 1672 | (list (current-buffer) start (set-marker (make-marker) (point)) |
| 1684 | (list :width width :height height)) | 1673 | (list :width width :height height)) |
| 1685 | t | 1674 | t |
| @@ -2006,12 +1995,11 @@ BASE is the URL of the HTML being rendered." | |||
| 2006 | (cond | 1995 | (cond |
| 2007 | ((null tbodies) | 1996 | ((null tbodies) |
| 2008 | dom) | 1997 | dom) |
| 2009 | ((= (length tbodies) 1) | 1998 | ((null (cdr tbodies)) |
| 2010 | (car tbodies)) | 1999 | (car tbodies)) |
| 2011 | (t | 2000 | (t |
| 2012 | ;; Table with multiple tbodies. Convert into a single tbody. | 2001 | ;; Table with multiple tbodies. Convert into a single tbody. |
| 2013 | `(tbody nil ,@(cl-reduce 'append | 2002 | `(tbody nil ,@(mapcan #'dom-non-text-children tbodies)))))) |
| 2014 | (mapcar 'dom-non-text-children tbodies))))))) | ||
| 2015 | 2003 | ||
| 2016 | (defun shr--fix-tbody (tbody) | 2004 | (defun shr--fix-tbody (tbody) |
| 2017 | (nconc (list 'tbody (dom-attributes tbody)) | 2005 | (nconc (list 'tbody (dom-attributes tbody)) |
| @@ -2311,8 +2299,8 @@ flags that control whether to collect or render objects." | |||
| 2311 | (dolist (column row) | 2299 | (dolist (column row) |
| 2312 | (aset natural-widths i (max (aref natural-widths i) column)) | 2300 | (aset natural-widths i (max (aref natural-widths i) column)) |
| 2313 | (setq i (1+ i))))) | 2301 | (setq i (1+ i))))) |
| 2314 | (let ((extra (- (apply '+ (append suggested-widths nil)) | 2302 | (let ((extra (- (apply #'+ (append suggested-widths nil)) |
| 2315 | (apply '+ (append widths nil)) | 2303 | (apply #'+ (append widths nil)) |
| 2316 | (* shr-table-separator-pixel-width (1+ (length widths))))) | 2304 | (* shr-table-separator-pixel-width (1+ (length widths))))) |
| 2317 | (expanded-columns 0)) | 2305 | (expanded-columns 0)) |
| 2318 | ;; We have extra, unused space, so divide this space amongst the | 2306 | ;; We have extra, unused space, so divide this space amongst the |
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 95cbfb8c22a..24ee6fa51f3 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el | |||
| @@ -109,7 +109,7 @@ | |||
| 109 | 109 | ||
| 110 | (eval-when-compile (require 'cl-lib)) | 110 | (eval-when-compile (require 'cl-lib)) |
| 111 | ;; Sometimes, compilation fails with "Variable binding depth exceeds | 111 | ;; Sometimes, compilation fails with "Variable binding depth exceeds |
| 112 | ;; max-specpdl-size". | 112 | ;; max-specpdl-size". Shall be fixed in Emacs 27. |
| 113 | (eval-and-compile | 113 | (eval-and-compile |
| 114 | (let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs))) | 114 | (let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs))) |
| 115 | 115 | ||
| @@ -318,7 +318,10 @@ arguments to pass to the OPERATION." | |||
| 318 | 318 | ||
| 319 | (let* ((filename (apply #'tramp-archive-file-name-for-operation | 319 | (let* ((filename (apply #'tramp-archive-file-name-for-operation |
| 320 | operation args)) | 320 | operation args)) |
| 321 | (archive (tramp-archive-file-name-archive filename))) | 321 | (archive (tramp-archive-file-name-archive filename)) |
| 322 | ;; Sometimes, it fails with "Variable binding depth exceeds | ||
| 323 | ;; max-specpdl-size". Shall be fixed in Emacs 27. | ||
| 324 | (max-specpdl-size (* 2 max-specpdl-size))) | ||
| 322 | 325 | ||
| 323 | ;; `filename' could be a quoted file name. Or the file | 326 | ;; `filename' could be a quoted file name. Or the file |
| 324 | ;; archive could be a directory, see Bug#30293. | 327 | ;; archive could be a directory, see Bug#30293. |
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 445098a5bca..08bba33afed 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el | |||
| @@ -477,7 +477,18 @@ file names." | |||
| 477 | (with-tramp-connection-property | 477 | (with-tramp-connection-property |
| 478 | (tramp-get-connection-process vec) "rclone-pid" | 478 | (tramp-get-connection-process vec) "rclone-pid" |
| 479 | (catch 'pid | 479 | (catch 'pid |
| 480 | (dolist (pid (list-system-processes)) ;; "pidof rclone" ? | 480 | (dolist |
| 481 | (pid | ||
| 482 | ;; Until Emacs 25, `process-attributes' could | ||
| 483 | ;; crash Emacs for some processes. So we use | ||
| 484 | ;; "pidof", which might not work everywhere. | ||
| 485 | (if (<= emacs-major-version 25) | ||
| 486 | (let ((default-directory temporary-file-directory)) | ||
| 487 | (mapcar | ||
| 488 | #'string-to-number | ||
| 489 | (split-string | ||
| 490 | (shell-command-to-string "pidof rclone")))) | ||
| 491 | (list-system-processes))) | ||
| 481 | (and (string-match-p | 492 | (and (string-match-p |
| 482 | (regexp-quote | 493 | (regexp-quote |
| 483 | (format "rclone mount %s:" (tramp-file-name-host vec))) | 494 | (format "rclone mount %s:" (tramp-file-name-host vec))) |
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index 6edd03c39cc..8bb156199c5 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; webjump.el --- programmable Web hotlist | 1 | ;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -323,8 +323,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke | |||
| 323 | 323 | ||
| 324 | (defun webjump-read-url-choice (what urls &optional default) | 324 | (defun webjump-read-url-choice (what urls &optional default) |
| 325 | ;; Note: Convert this to use `webjump-read-choice' someday. | 325 | ;; Note: Convert this to use `webjump-read-choice' someday. |
| 326 | (let* ((completions (mapcar (function (lambda (n) (cons n n))) | 326 | (let* ((completions (mapcar (lambda (n) (cons n n)) urls)) |
| 327 | urls)) | ||
| 328 | (input (completing-read (concat what | 327 | (input (completing-read (concat what |
| 329 | ;;(if default " (RET for default)" "") | 328 | ;;(if default " (RET for default)" "") |
| 330 | ": ") | 329 | ": ") |
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el deleted file mode 100644 index 2ae1ca48d16..00000000000 --- a/lisp/obsolete/levents.el +++ /dev/null | |||
| @@ -1,292 +0,0 @@ | |||
| 1 | ;;; levents.el --- emulate the Lucid event data type and associated functions | ||
| 2 | |||
| 3 | ;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: emacs-devel@gnu.org | ||
| 6 | ;; Keywords: emulations | ||
| 7 | ;; Obsolete-since: 23.2 | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; Things we cannot emulate in Lisp: | ||
| 27 | ;; It is not possible to emulate current-mouse-event as a variable, | ||
| 28 | ;; though it is not hard to obtain the data from (this-command-keys). | ||
| 29 | |||
| 30 | ;; We do not have a variable unread-command-event; | ||
| 31 | ;; instead, we have the more general unread-command-events. | ||
| 32 | |||
| 33 | ;; Our read-key-sequence and read-char are not precisely | ||
| 34 | ;; compatible with those in Lucid Emacs, but they should work ok. | ||
| 35 | |||
| 36 | ;;; Code: | ||
| 37 | |||
| 38 | (defun next-command-event (event) | ||
| 39 | (error "You must rewrite to use `read-command-event' instead of `next-command-event'")) | ||
| 40 | |||
| 41 | (defun next-event (event) | ||
| 42 | (error "You must rewrite to use `read-event' instead of `next-event'")) | ||
| 43 | |||
| 44 | (defun dispatch-event (event) | ||
| 45 | (error "`dispatch-event' not supported")) | ||
| 46 | |||
| 47 | ;; Make events of type eval, menu and timeout | ||
| 48 | ;; execute properly. | ||
| 49 | |||
| 50 | (define-key global-map [menu] 'execute-eval-event) | ||
| 51 | (define-key global-map [timeout] 'execute-eval-event) | ||
| 52 | (define-key global-map [eval] 'execute-eval-event) | ||
| 53 | |||
| 54 | (defun execute-eval-event (event) | ||
| 55 | (interactive "e") | ||
| 56 | (funcall (nth 1 event) (nth 2 event))) | ||
| 57 | |||
| 58 | (put 'eval 'event-symbol-elements '(eval)) | ||
| 59 | (put 'menu 'event-symbol-elements '(eval)) | ||
| 60 | (put 'timeout 'event-symbol-elements '(eval)) | ||
| 61 | |||
| 62 | (defun allocate-event () | ||
| 63 | "Return an empty event structure. | ||
| 64 | In this emulation, it returns nil." | ||
| 65 | nil) | ||
| 66 | |||
| 67 | (defun button-press-event-p (obj) | ||
| 68 | "True if the argument is a mouse-button-press event object." | ||
| 69 | (and (consp obj) (symbolp (car obj)) | ||
| 70 | (memq 'down (get (car obj) 'event-symbol-elements)))) | ||
| 71 | |||
| 72 | (defun button-release-event-p (obj) | ||
| 73 | "True if the argument is a mouse-button-release event object." | ||
| 74 | (and (consp obj) (symbolp (car obj)) | ||
| 75 | (or (memq 'click (get (car obj) 'event-symbol-elements)) | ||
| 76 | (memq 'drag (get (car obj) 'event-symbol-elements))))) | ||
| 77 | |||
| 78 | (defun button-event-p (obj) | ||
| 79 | "True if the argument is a mouse-button press or release event object." | ||
| 80 | (and (consp obj) (symbolp (car obj)) | ||
| 81 | (or (memq 'click (get (car obj) 'event-symbol-elements)) | ||
| 82 | (memq 'down (get (car obj) 'event-symbol-elements)) | ||
| 83 | (memq 'drag (get (car obj) 'event-symbol-elements))))) | ||
| 84 | |||
| 85 | (defun mouse-event-p (obj) | ||
| 86 | "True if the argument is a mouse-button press or release event object." | ||
| 87 | (and (consp obj) (symbolp (car obj)) | ||
| 88 | (or (eq (car obj) 'mouse-movement) | ||
| 89 | (memq 'click (get (car obj) 'event-symbol-elements)) | ||
| 90 | (memq 'down (get (car obj) 'event-symbol-elements)) | ||
| 91 | (memq 'drag (get (car obj) 'event-symbol-elements))))) | ||
| 92 | |||
| 93 | (defun character-to-event (ch &optional event) | ||
| 94 | "Converts a numeric ASCII value to an event structure, replete with | ||
| 95 | bucky bits. The character is the first argument, and the event to fill | ||
| 96 | in is the second. This function contains knowledge about what the codes | ||
| 97 | mean -- for example, the number 9 is converted to the character Tab, | ||
| 98 | not the distinct character Control-I. | ||
| 99 | |||
| 100 | Beware that character-to-event and event-to-character are not strictly | ||
| 101 | inverse functions, since events contain much more information than the | ||
| 102 | ASCII character set can encode." | ||
| 103 | ch) | ||
| 104 | |||
| 105 | (defun copy-event (event1 &optional event2) | ||
| 106 | "Make a copy of the given event object. | ||
| 107 | In this emulation, `copy-event' just returns its argument." | ||
| 108 | event1) | ||
| 109 | |||
| 110 | (defun deallocate-event (event) | ||
| 111 | "Allow the given event structure to be reused. | ||
| 112 | In actual Lucid Emacs, you MUST NOT use this event object after | ||
| 113 | calling this function with it. You will lose. It is not necessary to | ||
| 114 | call this function, as event objects are garbage- collected like all | ||
| 115 | other objects; however, it may be more efficient to explicitly | ||
| 116 | deallocate events when you are sure that this is safe. | ||
| 117 | |||
| 118 | This emulation does not actually deallocate or reuse events | ||
| 119 | except via garbage collection and `cons'." | ||
| 120 | nil) | ||
| 121 | |||
| 122 | (defun enqueue-eval-event: (function object) | ||
| 123 | "Add an eval event to the back of the queue. | ||
| 124 | It will be the next event read after all pending events." | ||
| 125 | (setq unread-command-events | ||
| 126 | (nconc unread-command-events | ||
| 127 | (list (list 'eval function object))))) | ||
| 128 | |||
| 129 | (defun eval-event-p (obj) | ||
| 130 | "True if the argument is an eval or menu event object." | ||
| 131 | (eq (car-safe obj) 'eval)) | ||
| 132 | |||
| 133 | (defun event-button (event) | ||
| 134 | "Return the button-number of the given mouse-button-press event." | ||
| 135 | (let ((sym (car (get (car event) 'event-symbol-elements)))) | ||
| 136 | (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3) | ||
| 137 | (mouse-4 . 4) (mouse-5 . 5)))))) | ||
| 138 | |||
| 139 | (defun event-function (event) | ||
| 140 | "Return the callback function of the given timeout, menu, or eval event." | ||
| 141 | (nth 1 event)) | ||
| 142 | |||
| 143 | (defun event-key (event) | ||
| 144 | "Return the KeySym of the given key-press event. | ||
| 145 | The value is an ASCII printing character (not upper case) or a symbol." | ||
| 146 | (if (symbolp event) | ||
| 147 | (car (get event 'event-symbol-elements)) | ||
| 148 | (let ((base (logand event (1- (ash 1 18))))) | ||
| 149 | (downcase (if (< base 32) (logior base 64) base))))) | ||
| 150 | |||
| 151 | (defun event-object (event) | ||
| 152 | "Return the function argument of the given timeout, menu, or eval event." | ||
| 153 | (nth 2 event)) | ||
| 154 | |||
| 155 | (defun event-point (event) | ||
| 156 | "Return the character position of the given mouse-related event. | ||
| 157 | If the event did not occur over a window, or did | ||
| 158 | not occur over text, then this returns nil. Otherwise, it returns an index | ||
| 159 | into the buffer visible in the event's window." | ||
| 160 | (posn-point (event-end event))) | ||
| 161 | |||
| 162 | ;; Return position of start of line LINE in WINDOW. | ||
| 163 | ;; If LINE is nil, return the last position | ||
| 164 | ;; visible in WINDOW. | ||
| 165 | (defun event-closest-point-1 (window &optional line) | ||
| 166 | (let* ((total (- (window-height window) | ||
| 167 | (if (window-minibuffer-p window) | ||
| 168 | 0 1))) | ||
| 169 | (distance (or line total))) | ||
| 170 | (save-excursion | ||
| 171 | (goto-char (window-start window)) | ||
| 172 | (if (= (vertical-motion distance) distance) | ||
| 173 | (if (not line) | ||
| 174 | (forward-char -1))) | ||
| 175 | (point)))) | ||
| 176 | |||
| 177 | (defun event-closest-point (event &optional start-window) | ||
| 178 | "Return the nearest position to where EVENT ended its motion. | ||
| 179 | This is computed for the window where EVENT's motion started, | ||
| 180 | or for window WINDOW if that is specified." | ||
| 181 | (or start-window (setq start-window (posn-window (event-start event)))) | ||
| 182 | (if (eq start-window (posn-window (event-end event))) | ||
| 183 | (if (eq (event-point event) 'vertical-line) | ||
| 184 | (event-closest-point-1 start-window | ||
| 185 | (cdr (posn-col-row (event-end event)))) | ||
| 186 | (if (eq (event-point event) 'mode-line) | ||
| 187 | (event-closest-point-1 start-window) | ||
| 188 | (event-point event))) | ||
| 189 | ;; EVENT ended in some other window. | ||
| 190 | (let* ((end-w (posn-window (event-end event))) | ||
| 191 | (end-w-top) | ||
| 192 | (w-top (nth 1 (window-edges start-window)))) | ||
| 193 | (setq end-w-top | ||
| 194 | (if (windowp end-w) | ||
| 195 | (nth 1 (window-edges end-w)) | ||
| 196 | (/ (cdr (posn-x-y (event-end event))) | ||
| 197 | (frame-char-height end-w)))) | ||
| 198 | (if (>= end-w-top w-top) | ||
| 199 | (event-closest-point-1 start-window) | ||
| 200 | (window-start start-window))))) | ||
| 201 | |||
| 202 | (defun event-process (event) | ||
| 203 | "Return the process of the given process-output event." | ||
| 204 | (nth 1 event)) | ||
| 205 | |||
| 206 | (defun event-timestamp (event) | ||
| 207 | "Return the timestamp of the given event object. | ||
| 208 | In Lucid Emacs, this works for any kind of event. | ||
| 209 | In this emulation, it returns nil for non-mouse-related events." | ||
| 210 | (and (listp event) | ||
| 211 | (posn-timestamp (event-end event)))) | ||
| 212 | |||
| 213 | (defun event-to-character (event &optional lenient) | ||
| 214 | "Return the closest ASCII approximation to the given event object. | ||
| 215 | If the event isn't a keypress, this returns nil. | ||
| 216 | If the second argument is non-nil, then this is lenient in its | ||
| 217 | translation; it will ignore modifier keys other than control and meta, | ||
| 218 | and will ignore the shift modifier on those characters which have no | ||
| 219 | shifted ASCII equivalent (Control-Shift-A for example, will be mapped to | ||
| 220 | the same ASCII code as Control-A.) If the second arg is nil, then nil | ||
| 221 | will be returned for events which have no direct ASCII equivalent." | ||
| 222 | (if (symbolp event) | ||
| 223 | (and lenient | ||
| 224 | (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9) | ||
| 225 | (return . 10) (enter . 10))))) | ||
| 226 | ;; Our interpretation is, ASCII means anything a number can represent. | ||
| 227 | (if (integerp event) | ||
| 228 | event nil))) | ||
| 229 | |||
| 230 | (defun event-window (event) | ||
| 231 | "Return the window of the given mouse-related event object." | ||
| 232 | (posn-window (event-end event))) | ||
| 233 | |||
| 234 | (defun event-x (event) | ||
| 235 | "Return the X position in characters of the given mouse-related event." | ||
| 236 | (/ (car (posn-col-row (event-end event))) | ||
| 237 | (frame-char-width (window-frame (event-window event))))) | ||
| 238 | |||
| 239 | (defun event-x-pixel (event) | ||
| 240 | "Return the X position in pixels of the given mouse-related event." | ||
| 241 | (car (posn-col-row (event-end event)))) | ||
| 242 | |||
| 243 | (defun event-y (event) | ||
| 244 | "Return the Y position in characters of the given mouse-related event." | ||
| 245 | (/ (cdr (posn-col-row (event-end event))) | ||
| 246 | (frame-char-height (window-frame (event-window event))))) | ||
| 247 | |||
| 248 | (defun event-y-pixel (event) | ||
| 249 | "Return the Y position in pixels of the given mouse-related event." | ||
| 250 | (cdr (posn-col-row (event-end event)))) | ||
| 251 | |||
| 252 | (defun key-press-event-p (obj) | ||
| 253 | "True if the argument is a keyboard event object." | ||
| 254 | (or (integerp obj) | ||
| 255 | (and (symbolp obj) | ||
| 256 | (get obj 'event-symbol-elements)))) | ||
| 257 | |||
| 258 | (defun menu-event-p (obj) | ||
| 259 | "True if the argument is a menu event object." | ||
| 260 | (eq (car-safe obj) 'menu)) | ||
| 261 | |||
| 262 | (defun motion-event-p (obj) | ||
| 263 | "True if the argument is a mouse-motion event object." | ||
| 264 | (eq (car-safe obj) 'mouse-movement)) | ||
| 265 | |||
| 266 | (defun read-command-event () | ||
| 267 | "Return the next keyboard or mouse event; execute other events. | ||
| 268 | This is similar to the function `next-command-event' of Lucid Emacs, | ||
| 269 | but different in that it returns the event rather than filling in | ||
| 270 | an existing event object." | ||
| 271 | (let (event) | ||
| 272 | (while (progn | ||
| 273 | (setq event (read-event)) | ||
| 274 | (not (or (key-press-event-p event) | ||
| 275 | (button-press-event-p event) | ||
| 276 | (button-release-event-p event) | ||
| 277 | (menu-event-p event)))) | ||
| 278 | (let ((type (car-safe event))) | ||
| 279 | (cond ((eq type 'eval) | ||
| 280 | (funcall (nth 1 event) (nth 2 event))) | ||
| 281 | ((eq type 'switch-frame) | ||
| 282 | (select-frame (nth 1 event)))))) | ||
| 283 | event)) | ||
| 284 | |||
| 285 | (defun process-event-p (obj) | ||
| 286 | "True if the argument is a process-output event object. | ||
| 287 | GNU Emacs 19 does not currently generate process-output events." | ||
| 288 | (eq (car-safe obj) 'process)) | ||
| 289 | |||
| 290 | (provide 'levents) | ||
| 291 | |||
| 292 | ;;; levents.el ends here | ||
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 5fe140d00ef..689d134627e 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el | |||
| @@ -2995,7 +2995,8 @@ Agenda views are separated by `org-agenda-block-separator'." | |||
| 2995 | (erase-buffer) | 2995 | (erase-buffer) |
| 2996 | (insert (eval-when-compile | 2996 | (insert (eval-when-compile |
| 2997 | (let ((header | 2997 | (let ((header |
| 2998 | "Press key for an agenda command: | 2998 | (copy-sequence |
| 2999 | "Press key for an agenda command: | ||
| 2999 | -------------------------------- < Buffer, subtree/region restriction | 3000 | -------------------------------- < Buffer, subtree/region restriction |
| 3000 | a Agenda for current week or day > Remove restriction | 3001 | a Agenda for current week or day > Remove restriction |
| 3001 | t List of all TODO entries e Export agenda views | 3002 | 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 | |||
| 3004 | / Multi-occur S Like s, but only TODO entries | 3005 | / Multi-occur S Like s, but only TODO entries |
| 3005 | ? Find :FLAGGED: entries C Configure custom agenda commands | 3006 | ? Find :FLAGGED: entries C Configure custom agenda commands |
| 3006 | * Toggle sticky agenda views # List stuck projects (!=configure) | 3007 | * Toggle sticky agenda views # List stuck projects (!=configure) |
| 3007 | ") | 3008 | ")) |
| 3008 | (start 0)) | 3009 | (start 0)) |
| 3009 | (while (string-match | 3010 | (while (string-match |
| 3010 | "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" | 3011 | "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" |
diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 86d802f283c..f5007579a8a 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el | |||
| @@ -31,7 +31,8 @@ | |||
| 31 | ;; ;; Minibuffer prompt for password. | 31 | ;; ;; Minibuffer prompt for password. |
| 32 | ;; => "foo" | 32 | ;; => "foo" |
| 33 | ;; | 33 | ;; |
| 34 | ;; (password-cache-add "test" (copy-sequence "foo")) | 34 | ;; (password-cache-add "test" (read-passwd "Password? ")) |
| 35 | ;; ;; Minibuffer prompt from read-passwd, which returns "foo". | ||
| 35 | ;; => nil | 36 | ;; => nil |
| 36 | 37 | ||
| 37 | ;; (password-read "Password? " "test") | 38 | ;; (password-read "Password? " "test") |
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 1e72352f719..17ffea59ff0 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el | |||
| @@ -3412,8 +3412,14 @@ regexp should match \"(\" if parentheses are valid in declarators. | |||
| 3412 | The end of the first submatch is taken as the end of the operator. | 3412 | The end of the first submatch is taken as the end of the operator. |
| 3413 | Identifier syntax is in effect when this is matched (see | 3413 | Identifier syntax is in effect when this is matched (see |
| 3414 | `c-identifier-syntax-table')." | 3414 | `c-identifier-syntax-table')." |
| 3415 | t (if (c-lang-const c-type-modifier-kwds) | 3415 | t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds)) |
| 3416 | (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>") | 3416 | (concat |
| 3417 | (regexp-opt (c--delete-duplicates | ||
| 3418 | (append (c-lang-const c-type-modifier-kwds) | ||
| 3419 | (c-lang-const c-modifier-kwds)) | ||
| 3420 | :test 'string-equal) | ||
| 3421 | t) | ||
| 3422 | "\\>") | ||
| 3417 | ;; Default to a regexp that never matches. | 3423 | ;; Default to a regexp that never matches. |
| 3418 | regexp-unmatchable) | 3424 | regexp-unmatchable) |
| 3419 | ;; Check that there's no "=" afterwards to avoid matching tokens | 3425 | ;; Check that there's no "=" afterwards to avoid matching tokens |
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index d822788bee2..b3b2374805d 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el | |||
| @@ -795,7 +795,7 @@ compatible with old code; callers should always specify it." | |||
| 795 | (set (make-local-variable 'outline-level) 'c-outline-level) | 795 | (set (make-local-variable 'outline-level) 'c-outline-level) |
| 796 | (set (make-local-variable 'add-log-current-defun-function) | 796 | (set (make-local-variable 'add-log-current-defun-function) |
| 797 | (lambda () | 797 | (lambda () |
| 798 | (or (c-cpp-define-name) (c-defun-name)))) | 798 | (or (c-cpp-define-name) (car (c-defun-name-and-limits nil))))) |
| 799 | (let ((rfn (assq mode c-require-final-newline))) | 799 | (let ((rfn (assq mode c-require-final-newline))) |
| 800 | (when rfn | 800 | (when rfn |
| 801 | (if (boundp 'mode-require-final-newline) | 801 | (if (boundp 'mode-require-final-newline) |
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 198f040fb29..c72e9d94b1c 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- | 1 | ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. |
| 4 | ;; Version: 0.1.3 | 4 | ;; Version: 0.2.0 |
| 5 | ;; Package-Requires: ((emacs "26.3")) | 5 | ;; Package-Requires: ((emacs "26.3")) |
| 6 | 6 | ||
| 7 | ;; This is a GNU ELPA :core package. Avoid using functionality that | 7 | ;; This is a GNU ELPA :core package. Avoid using functionality that |
| @@ -40,7 +40,7 @@ | |||
| 40 | ;; Infrastructure: | 40 | ;; Infrastructure: |
| 41 | ;; | 41 | ;; |
| 42 | ;; Function `project-current', to determine the current project | 42 | ;; Function `project-current', to determine the current project |
| 43 | ;; instance, and 5 (at the moment) generic functions that act on it. | 43 | ;; instance, and 4 (at the moment) generic functions that act on it. |
| 44 | ;; This list is to be extended in future versions. | 44 | ;; This list is to be extended in future versions. |
| 45 | ;; | 45 | ;; |
| 46 | ;; Utils: | 46 | ;; Utils: |
| @@ -122,14 +122,25 @@ is not a part of a detectable project either, return a | |||
| 122 | (defun project--find-in-directory (dir) | 122 | (defun project--find-in-directory (dir) |
| 123 | (run-hook-with-args-until-success 'project-find-functions dir)) | 123 | (run-hook-with-args-until-success 'project-find-functions dir)) |
| 124 | 124 | ||
| 125 | (cl-defgeneric project-roots (project) | 125 | (cl-defgeneric project-root (project) |
| 126 | "Return the list of directory roots of the current project. | 126 | "Return root directory of the current project. |
| 127 | |||
| 128 | It usually contains the main build file, dependencies | ||
| 129 | configuration file, etc. Though neither is mandatory. | ||
| 127 | 130 | ||
| 128 | Most often it's just one directory which contains the project | 131 | The directory name must be absolute." |
| 129 | build file and everything else in the project. But in more | 132 | (car (project-roots project))) |
| 130 | advanced configurations, a project can span multiple directories. | ||
| 131 | 133 | ||
| 132 | The directory names should be absolute.") | 134 | (cl-defgeneric project-roots (project) |
| 135 | "Return the list containing the current project root. | ||
| 136 | |||
| 137 | The function is obsolete, all projects have one main root anyway, | ||
| 138 | and the rest should be possible to express through | ||
| 139 | `project-external-roots'." | ||
| 140 | ;; FIXME: Can we specify project's version here? | ||
| 141 | ;; FIXME: Could we make this affect cl-defmethod calls too? | ||
| 142 | (declare (obsolete project-root "0.3.0")) | ||
| 143 | (list (project-root project))) | ||
| 133 | 144 | ||
| 134 | ;; FIXME: Add MODE argument, like in `ede-source-paths'? | 145 | ;; FIXME: Add MODE argument, like in `ede-source-paths'? |
| 135 | (cl-defgeneric project-external-roots (_project) | 146 | (cl-defgeneric project-external-roots (_project) |
| @@ -138,18 +149,14 @@ The directory names should be absolute.") | |||
| 138 | It's the list of directories outside of the project that are | 149 | It's the list of directories outside of the project that are |
| 139 | still related to it. If the project deals with source code then, | 150 | still related to it. If the project deals with source code then, |
| 140 | depending on the languages used, this list should include the | 151 | depending on the languages used, this list should include the |
| 141 | headers search path, load path, class path, and so on. | 152 | headers search path, load path, class path, and so on." |
| 142 | |||
| 143 | The rule of thumb for whether to include a directory here, and | ||
| 144 | not in `project-roots', is whether its contents are meant to be | ||
| 145 | edited together with the rest of the project." | ||
| 146 | nil) | 153 | nil) |
| 147 | 154 | ||
| 148 | (cl-defgeneric project-ignores (_project _dir) | 155 | (cl-defgeneric project-ignores (_project _dir) |
| 149 | "Return the list of glob patterns to ignore inside DIR. | 156 | "Return the list of glob patterns to ignore inside DIR. |
| 150 | Patterns can match both regular files and directories. | 157 | Patterns can match both regular files and directories. |
| 151 | To root an entry, start it with `./'. To match directories only, | 158 | To root an entry, start it with `./'. To match directories only, |
| 152 | end it with `/'. DIR must be one of `project-roots' or | 159 | end it with `/'. DIR must be either `project-root' or one of |
| 153 | `project-external-roots'." | 160 | `project-external-roots'." |
| 154 | ;; TODO: Document and support regexp ignores as used by Hg. | 161 | ;; TODO: Document and support regexp ignores as used by Hg. |
| 155 | ;; TODO: Support whitelist entries. | 162 | ;; TODO: Support whitelist entries. |
| @@ -170,13 +177,13 @@ end it with `/'. DIR must be one of `project-roots' or | |||
| 170 | (t | 177 | (t |
| 171 | (complete-with-action action all-files string pred))))) | 178 | (complete-with-action action all-files string pred))))) |
| 172 | 179 | ||
| 173 | (cl-defmethod project-roots ((project (head transient))) | 180 | (cl-defmethod project-root ((project (head transient))) |
| 174 | (list (cdr project))) | 181 | (cdr project)) |
| 175 | 182 | ||
| 176 | (cl-defgeneric project-files (project &optional dirs) | 183 | (cl-defgeneric project-files (project &optional dirs) |
| 177 | "Return a list of files in directories DIRS in PROJECT. | 184 | "Return a list of files in directories DIRS in PROJECT. |
| 178 | DIRS is a list of absolute directories; it should be some | 185 | DIRS is a list of absolute directories; it should be some |
| 179 | subset of the project roots and external roots. | 186 | subset of the project root and external roots. |
| 180 | 187 | ||
| 181 | The default implementation uses `find-program'. PROJECT is used | 188 | The default implementation uses `find-program'. PROJECT is used |
| 182 | to find the list of ignores for each directory." | 189 | to find the list of ignores for each directory." |
| @@ -184,7 +191,8 @@ to find the list of ignores for each directory." | |||
| 184 | (lambda (dir) | 191 | (lambda (dir) |
| 185 | (project--files-in-directory dir | 192 | (project--files-in-directory dir |
| 186 | (project--dir-ignores project dir))) | 193 | (project--dir-ignores project dir))) |
| 187 | (or dirs (project-roots project)))) | 194 | (or dirs |
| 195 | (list (project-root project))))) | ||
| 188 | 196 | ||
| 189 | (defun project--files-in-directory (dir ignores &optional files) | 197 | (defun project--files-in-directory (dir ignores &optional files) |
| 190 | (require 'find-dired) | 198 | (require 'find-dired) |
| @@ -223,7 +231,7 @@ to find the list of ignores for each directory." | |||
| 223 | local-files)))) | 231 | local-files)))) |
| 224 | 232 | ||
| 225 | (defgroup project-vc nil | 233 | (defgroup project-vc nil |
| 226 | "Project implementation using the VC package." | 234 | "Project implementation based on the VC package." |
| 227 | :version "25.1" | 235 | :version "25.1" |
| 228 | :group 'tools) | 236 | :group 'tools) |
| 229 | 237 | ||
| @@ -232,6 +240,15 @@ to find the list of ignores for each directory." | |||
| 232 | :type '(repeat string) | 240 | :type '(repeat string) |
| 233 | :safe 'listp) | 241 | :safe 'listp) |
| 234 | 242 | ||
| 243 | (defcustom project-vc-merge-submodules t | ||
| 244 | "Non-nil to consider submodules part of the parent project. | ||
| 245 | |||
| 246 | After changing this variable (using Customize or .dir-locals.el) | ||
| 247 | you might have to restart Emacs to see the effect." | ||
| 248 | :type 'boolean | ||
| 249 | :package-version '(project . "0.2.0") | ||
| 250 | :safe 'booleanp) | ||
| 251 | |||
| 235 | ;; FIXME: Using the current approach, major modes are supposed to set | 252 | ;; FIXME: Using the current approach, major modes are supposed to set |
| 236 | ;; this variable to a buffer-local value. So we don't have access to | 253 | ;; this variable to a buffer-local value. So we don't have access to |
| 237 | ;; the "external roots" of language A from buffers of language B, which | 254 | ;; the "external roots" of language A from buffers of language B, which |
| @@ -273,38 +290,48 @@ backend implementation of `project-external-roots'.") | |||
| 273 | (pcase backend | 290 | (pcase backend |
| 274 | ('Git | 291 | ('Git |
| 275 | ;; Don't stop at submodule boundary. | 292 | ;; Don't stop at submodule boundary. |
| 276 | ;; Note: It's not necessarily clear-cut what should be | ||
| 277 | ;; considered a "submodule" in the sense that some users | ||
| 278 | ;; may setup things equivalent to "git-submodule"s using | ||
| 279 | ;; "git worktree" instead (for example). | ||
| 280 | ;; FIXME: Also it may be the case that some users would consider | ||
| 281 | ;; a submodule as its own project. So there's a good chance | ||
| 282 | ;; we will need to let the user tell us what is their intention. | ||
| 283 | (or (vc-file-getprop dir 'project-git-root) | 293 | (or (vc-file-getprop dir 'project-git-root) |
| 284 | (let* ((root (vc-call-backend backend 'root dir)) | 294 | (let ((root (vc-call-backend backend 'root dir))) |
| 285 | (gitfile (expand-file-name ".git" root))) | ||
| 286 | (vc-file-setprop | 295 | (vc-file-setprop |
| 287 | dir 'project-git-root | 296 | dir 'project-git-root |
| 288 | (cond | 297 | (if (and |
| 289 | ((file-directory-p gitfile) | 298 | ;; FIXME: Invalidate the cache when the value |
| 290 | root) | 299 | ;; of this variable changes. |
| 291 | ((with-temp-buffer | 300 | project-vc-merge-submodules |
| 292 | (insert-file-contents gitfile) | 301 | (project--submodule-p root)) |
| 293 | (goto-char (point-min)) | 302 | (let* ((parent (file-name-directory |
| 294 | ;; Kind of a hack to distinguish a submodule from | 303 | (directory-file-name root)))) |
| 295 | ;; other cases of .git files pointing elsewhere. | 304 | (vc-call-backend backend 'root parent)) |
| 296 | (looking-at "gitdir: [./]+/\\.git/modules/")) | 305 | root))))) |
| 297 | (let* ((parent (file-name-directory | ||
| 298 | (directory-file-name root)))) | ||
| 299 | (vc-call-backend backend 'root parent))) | ||
| 300 | (t root))) | ||
| 301 | ))) | ||
| 302 | ('nil nil) | 306 | ('nil nil) |
| 303 | (_ (ignore-errors (vc-call-backend backend 'root dir)))))) | 307 | (_ (ignore-errors (vc-call-backend backend 'root dir)))))) |
| 304 | (and root (cons 'vc root)))) | 308 | (and root (cons 'vc root)))) |
| 305 | 309 | ||
| 306 | (cl-defmethod project-roots ((project (head vc))) | 310 | (defun project--submodule-p (root) |
| 307 | (list (cdr project))) | 311 | ;; XXX: We only support Git submodules for now. |
| 312 | ;; | ||
| 313 | ;; For submodules, at least, we expect the users to prefer them to | ||
| 314 | ;; be considered part of the parent project. For those who don't, | ||
| 315 | ;; there is the custom var now. | ||
| 316 | ;; | ||
| 317 | ;; Some users may also set up things equivalent to Git submodules | ||
| 318 | ;; using "git worktree" (for example). However, we expect that most | ||
| 319 | ;; of them would prefer to treat those as separate projects anyway. | ||
| 320 | (let* ((gitfile (expand-file-name ".git" root))) | ||
| 321 | (cond | ||
| 322 | ((file-directory-p gitfile) | ||
| 323 | nil) | ||
| 324 | ((with-temp-buffer | ||
| 325 | (insert-file-contents gitfile) | ||
| 326 | (goto-char (point-min)) | ||
| 327 | ;; Kind of a hack to distinguish a submodule from | ||
| 328 | ;; other cases of .git files pointing elsewhere. | ||
| 329 | (looking-at "gitdir: [./]+/\\.git/modules/")) | ||
| 330 | t) | ||
| 331 | (t nil)))) | ||
| 332 | |||
| 333 | (cl-defmethod project-root ((project (head vc))) | ||
| 334 | (cdr project)) | ||
| 308 | 335 | ||
| 309 | (cl-defmethod project-external-roots ((project (head vc))) | 336 | (cl-defmethod project-external-roots ((project (head vc))) |
| 310 | (project-subtract-directories | 337 | (project-subtract-directories |
| @@ -312,7 +339,7 @@ backend implementation of `project-external-roots'.") | |||
| 312 | (mapcar | 339 | (mapcar |
| 313 | #'file-name-as-directory | 340 | #'file-name-as-directory |
| 314 | (funcall project-vc-external-roots-function))) | 341 | (funcall project-vc-external-roots-function))) |
| 315 | (project-roots project))) | 342 | (list (project-root project)))) |
| 316 | 343 | ||
| 317 | (cl-defmethod project-files ((project (head vc)) &optional dirs) | 344 | (cl-defmethod project-files ((project (head vc)) &optional dirs) |
| 318 | (cl-mapcan | 345 | (cl-mapcan |
| @@ -330,7 +357,8 @@ backend implementation of `project-external-roots'.") | |||
| 330 | (project--files-in-directory | 357 | (project--files-in-directory |
| 331 | dir | 358 | dir |
| 332 | (project--dir-ignores project dir))))) | 359 | (project--dir-ignores project dir))))) |
| 333 | (or dirs (project-roots project)))) | 360 | (or dirs |
| 361 | (list (project-root project))))) | ||
| 334 | 362 | ||
| 335 | (declare-function vc-git--program-version "vc-git") | 363 | (declare-function vc-git--program-version "vc-git") |
| 336 | (declare-function vc-git--run-command-string "vc-git") | 364 | (declare-function vc-git--run-command-string "vc-git") |
| @@ -372,7 +400,9 @@ backend implementation of `project-external-roots'.") | |||
| 372 | submodules))) | 400 | submodules))) |
| 373 | (setq files | 401 | (setq files |
| 374 | (apply #'nconc files sub-files))) | 402 | (apply #'nconc files sub-files))) |
| 375 | files)) | 403 | ;; 'git ls-files' returns duplicate entries for merge conflicts. |
| 404 | ;; XXX: Better solutions welcome, but this seems cheap enough. | ||
| 405 | (delete-consecutive-dups files))) | ||
| 376 | (`Hg | 406 | (`Hg |
| 377 | (let ((default-directory (expand-file-name (file-name-as-directory dir))) | 407 | (let ((default-directory (expand-file-name (file-name-as-directory dir))) |
| 378 | args) | 408 | args) |
| @@ -471,7 +501,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." | |||
| 471 | (let* ((pr (project-current t)) | 501 | (let* ((pr (project-current t)) |
| 472 | (files | 502 | (files |
| 473 | (if (not current-prefix-arg) | 503 | (if (not current-prefix-arg) |
| 474 | (project-files pr (project-roots pr)) | 504 | (project-files pr) |
| 475 | (let ((dir (read-directory-name "Base directory: " | 505 | (let ((dir (read-directory-name "Base directory: " |
| 476 | nil default-directory t))) | 506 | nil default-directory t))) |
| 477 | (project--files-in-directory dir | 507 | (project--files-in-directory dir |
| @@ -482,9 +512,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." | |||
| 482 | nil))) | 512 | nil))) |
| 483 | 513 | ||
| 484 | (defun project--dir-ignores (project dir) | 514 | (defun project--dir-ignores (project dir) |
| 485 | (let* ((roots (project-roots project)) | 515 | (let ((root (project-root project))) |
| 486 | (root (cl-find dir roots :test #'file-in-directory-p))) | 516 | (if (not (file-in-directory-p dir root)) |
| 487 | (if (not root) | ||
| 488 | (project-ignores nil nil) ;The defaults. | 517 | (project-ignores nil nil) ;The defaults. |
| 489 | (let ((ignores (project-ignores project root))) | 518 | (let ((ignores (project-ignores project root))) |
| 490 | (if (file-equal-p root dir) | 519 | (if (file-equal-p root dir) |
| @@ -502,8 +531,8 @@ pattern to search for." | |||
| 502 | (require 'xref) | 531 | (require 'xref) |
| 503 | (let* ((pr (project-current t)) | 532 | (let* ((pr (project-current t)) |
| 504 | (files | 533 | (files |
| 505 | (project-files pr (append | 534 | (project-files pr (cons |
| 506 | (project-roots pr) | 535 | (project-root pr) |
| 507 | (project-external-roots pr))))) | 536 | (project-external-roots pr))))) |
| 508 | (xref--show-xrefs | 537 | (xref--show-xrefs |
| 509 | (apply-partially #'project--find-regexp-in-files regexp files) | 538 | (apply-partially #'project--find-regexp-in-files regexp files) |
| @@ -541,23 +570,23 @@ pattern to search for." | |||
| 541 | 570 | ||
| 542 | ;;;###autoload | 571 | ;;;###autoload |
| 543 | (defun project-find-file () | 572 | (defun project-find-file () |
| 544 | "Visit a file (with completion) in the current project's roots. | 573 | "Visit a file (with completion) in the current project. |
| 545 | The completion default is the filename at point, if one is | 574 | The completion default is the filename at point, if one is |
| 546 | recognized." | 575 | recognized." |
| 547 | (interactive) | 576 | (interactive) |
| 548 | (let* ((pr (project-current t)) | 577 | (let* ((pr (project-current t)) |
| 549 | (dirs (project-roots pr))) | 578 | (dirs (list (project-root pr)))) |
| 550 | (project-find-file-in (thing-at-point 'filename) dirs pr))) | 579 | (project-find-file-in (thing-at-point 'filename) dirs pr))) |
| 551 | 580 | ||
| 552 | ;;;###autoload | 581 | ;;;###autoload |
| 553 | (defun project-or-external-find-file () | 582 | (defun project-or-external-find-file () |
| 554 | "Visit a file (with completion) in the current project's roots or external roots. | 583 | "Visit a file (with completion) in the current project or external roots. |
| 555 | The completion default is the filename at point, if one is | 584 | The completion default is the filename at point, if one is |
| 556 | recognized." | 585 | recognized." |
| 557 | (interactive) | 586 | (interactive) |
| 558 | (let* ((pr (project-current t)) | 587 | (let* ((pr (project-current t)) |
| 559 | (dirs (append | 588 | (dirs (cons |
| 560 | (project-roots pr) | 589 | (project-root pr) |
| 561 | (project-external-roots pr)))) | 590 | (project-external-roots pr)))) |
| 562 | (project-find-file-in (thing-at-point 'filename) dirs pr))) | 591 | (project-find-file-in (thing-at-point 'filename) dirs pr))) |
| 563 | 592 | ||
| @@ -660,5 +689,13 @@ loop using the command \\[fileloop-continue]." | |||
| 660 | from to (project-files (project-current t)) 'default) | 689 | from to (project-files (project-current t)) 'default) |
| 661 | (fileloop-continue)) | 690 | (fileloop-continue)) |
| 662 | 691 | ||
| 692 | ;;;###autoload | ||
| 693 | (defun project-compile () | ||
| 694 | "Run `compile' in the project root." | ||
| 695 | (interactive) | ||
| 696 | (let* ((pr (project-current t)) | ||
| 697 | (default-directory (project-root pr))) | ||
| 698 | (call-interactively 'compile))) | ||
| 699 | |||
| 663 | (provide 'project) | 700 | (provide 'project) |
| 664 | ;;; project.el ends here | 701 | ;;; project.el ends here |
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 67383b34154..1ca9f019638 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el | |||
| @@ -261,7 +261,6 @@ | |||
| 261 | (require 'ansi-color) | 261 | (require 'ansi-color) |
| 262 | (require 'cl-lib) | 262 | (require 'cl-lib) |
| 263 | (require 'comint) | 263 | (require 'comint) |
| 264 | (require 'json) | ||
| 265 | (require 'tramp-sh) | 264 | (require 'tramp-sh) |
| 266 | 265 | ||
| 267 | ;; Avoid compiler warnings | 266 | ;; Avoid compiler warnings |
| @@ -2276,6 +2275,18 @@ Do not set this variable directly, instead use | |||
| 2276 | Do not set this variable directly, instead use | 2275 | Do not set this variable directly, instead use |
| 2277 | `python-shell-prompt-set-calculated-regexps'.") | 2276 | `python-shell-prompt-set-calculated-regexps'.") |
| 2278 | 2277 | ||
| 2278 | (defalias 'python--parse-json-array | ||
| 2279 | (if (fboundp 'json-parse-string) | ||
| 2280 | (lambda (string) | ||
| 2281 | (json-parse-string string :array-type 'list)) | ||
| 2282 | (require 'json) | ||
| 2283 | (defvar json-array-type) | ||
| 2284 | (declare-function json-read-from-string "json" (string)) | ||
| 2285 | (lambda (string) | ||
| 2286 | (let ((json-array-type 'list)) | ||
| 2287 | (json-read-from-string string)))) | ||
| 2288 | "Parse the JSON array in STRING into a Lisp list.") | ||
| 2289 | |||
| 2279 | (defun python-shell-prompt-detect () | 2290 | (defun python-shell-prompt-detect () |
| 2280 | "Detect prompts for the current `python-shell-interpreter'. | 2291 | "Detect prompts for the current `python-shell-interpreter'. |
| 2281 | When prompts can be retrieved successfully from the | 2292 | When prompts can be retrieved successfully from the |
| @@ -2324,11 +2335,11 @@ detection and just returns nil." | |||
| 2324 | (catch 'prompts | 2335 | (catch 'prompts |
| 2325 | (dolist (line (split-string output "\n" t)) | 2336 | (dolist (line (split-string output "\n" t)) |
| 2326 | (let ((res | 2337 | (let ((res |
| 2327 | ;; Check if current line is a valid JSON array | 2338 | ;; Check if current line is a valid JSON array. |
| 2328 | (and (string= (substring line 0 2) "[\"") | 2339 | (and (string-prefix-p "[\"" line) |
| 2329 | (ignore-errors | 2340 | (ignore-errors |
| 2330 | ;; Return prompts as a list, not vector | 2341 | ;; Return prompts as a list. |
| 2331 | (append (json-read-from-string line) nil))))) | 2342 | (python--parse-json-array line))))) |
| 2332 | ;; The list must contain 3 strings, where the first | 2343 | ;; The list must contain 3 strings, where the first |
| 2333 | ;; is the input prompt, the second is the block | 2344 | ;; is the input prompt, the second is the block |
| 2334 | ;; prompt and the last one is the output prompt. The | 2345 | ;; prompt and the last one is the output prompt. The |
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 1cee552b0c0..266f40abbae 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el | |||
| @@ -186,7 +186,7 @@ and you want to simplify them for the mode line | |||
| 186 | "Non-nil means display current function name in mode line. | 186 | "Non-nil means display current function name in mode line. |
| 187 | This makes a difference only if `which-function-mode' is non-nil.") | 187 | This makes a difference only if `which-function-mode' is non-nil.") |
| 188 | 188 | ||
| 189 | (add-hook 'find-file-hook 'which-func-ff-hook t) | 189 | (add-hook 'after-change-major-mode-hook 'which-func-ff-hook t) |
| 190 | 190 | ||
| 191 | (defun which-func-try-to-enable () | 191 | (defun which-func-try-to-enable () |
| 192 | (unless (or (not which-function-mode) | 192 | (unless (or (not which-function-mode) |
| @@ -195,7 +195,7 @@ This makes a difference only if `which-function-mode' is non-nil.") | |||
| 195 | (member major-mode which-func-modes))))) | 195 | (member major-mode which-func-modes))))) |
| 196 | 196 | ||
| 197 | (defun which-func-ff-hook () | 197 | (defun which-func-ff-hook () |
| 198 | "File find hook for Which Function mode. | 198 | "`after-change-major-mode-hook' for Which Function mode. |
| 199 | It creates the Imenu index for the buffer, if necessary." | 199 | It creates the Imenu index for the buffer, if necessary." |
| 200 | (which-func-try-to-enable) | 200 | (which-func-try-to-enable) |
| 201 | 201 | ||
| @@ -282,52 +282,55 @@ If no function name is found, return nil." | |||
| 282 | (when (null name) | 282 | (when (null name) |
| 283 | (setq name (add-log-current-defun))) | 283 | (setq name (add-log-current-defun))) |
| 284 | ;; If Imenu is loaded, try to make an index alist with it. | 284 | ;; If Imenu is loaded, try to make an index alist with it. |
| 285 | ;; If `add-log-current-defun' ran and gave nil, accept that. | ||
| 285 | (when (and (null name) | 286 | (when (and (null name) |
| 286 | (boundp 'imenu--index-alist) | 287 | (null add-log-current-defun-function)) |
| 287 | (or (null imenu--index-alist) | 288 | (when (and (null name) |
| 288 | ;; Update if outdated | 289 | (boundp 'imenu--index-alist) |
| 289 | (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)) | 290 | (or (null imenu--index-alist) |
| 290 | (null which-function-imenu-failed)) | 291 | ;; Update if outdated |
| 291 | (ignore-errors (imenu--make-index-alist t)) | 292 | (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)) |
| 292 | (unless imenu--index-alist | 293 | (null which-function-imenu-failed)) |
| 293 | (set (make-local-variable 'which-function-imenu-failed) t))) | 294 | (ignore-errors (imenu--make-index-alist t)) |
| 294 | ;; If we have an index alist, use it. | 295 | (unless imenu--index-alist |
| 295 | (when (and (null name) | 296 | (set (make-local-variable 'which-function-imenu-failed) t))) |
| 296 | (boundp 'imenu--index-alist) imenu--index-alist) | 297 | ;; If we have an index alist, use it. |
| 297 | (let ((alist imenu--index-alist) | 298 | (when (and (null name) |
| 298 | (minoffset (point-max)) | 299 | (boundp 'imenu--index-alist) imenu--index-alist) |
| 299 | offset pair mark imstack namestack) | 300 | (let ((alist imenu--index-alist) |
| 300 | ;; Elements of alist are either ("name" . marker), or | 301 | (minoffset (point-max)) |
| 301 | ;; ("submenu" ("name" . marker) ... ). The list can be | 302 | offset pair mark imstack namestack) |
| 302 | ;; arbitrarily nested. | 303 | ;; Elements of alist are either ("name" . marker), or |
| 303 | (while (or alist imstack) | 304 | ;; ("submenu" ("name" . marker) ... ). The list can be |
| 304 | (if (null alist) | 305 | ;; arbitrarily nested. |
| 305 | (setq alist (car imstack) | 306 | (while (or alist imstack) |
| 306 | namestack (cdr namestack) | 307 | (if (null alist) |
| 307 | imstack (cdr imstack)) | 308 | (setq alist (car imstack) |
| 308 | 309 | namestack (cdr namestack) | |
| 309 | (setq pair (car-safe alist) | 310 | imstack (cdr imstack)) |
| 310 | alist (cdr-safe alist)) | 311 | |
| 311 | 312 | (setq pair (car-safe alist) | |
| 312 | (cond | 313 | alist (cdr-safe alist)) |
| 313 | ((atom pair)) ; Skip anything not a cons. | 314 | |
| 314 | 315 | (cond | |
| 315 | ((imenu--subalist-p pair) | 316 | ((atom pair)) ; Skip anything not a cons. |
| 316 | (setq imstack (cons alist imstack) | 317 | |
| 317 | namestack (cons (car pair) namestack) | 318 | ((imenu--subalist-p pair) |
| 318 | alist (cdr pair))) | 319 | (setq imstack (cons alist imstack) |
| 319 | 320 | namestack (cons (car pair) namestack) | |
| 320 | ((or (number-or-marker-p (setq mark (cdr pair))) | 321 | alist (cdr pair))) |
| 321 | (and (overlayp mark) | 322 | |
| 322 | (setq mark (overlay-start mark)))) | 323 | ((or (number-or-marker-p (setq mark (cdr pair))) |
| 323 | (when (and (>= (setq offset (- (point) mark)) 0) | 324 | (and (overlayp mark) |
| 324 | (< offset minoffset)) ; Find the closest item. | 325 | (setq mark (overlay-start mark)))) |
| 325 | (setq minoffset offset | 326 | (when (and (>= (setq offset (- (point) mark)) 0) |
| 326 | name (if (null which-func-imenu-joiner-function) | 327 | (< offset minoffset)) ; Find the closest item. |
| 327 | (car pair) | 328 | (setq minoffset offset |
| 328 | (funcall | 329 | name (if (null which-func-imenu-joiner-function) |
| 329 | which-func-imenu-joiner-function | 330 | (car pair) |
| 330 | (reverse (cons (car pair) namestack)))))))))))) | 331 | (funcall |
| 332 | which-func-imenu-joiner-function | ||
| 333 | (reverse (cons (car pair) namestack))))))))))))) | ||
| 331 | ;; Filter the name if requested. | 334 | ;; Filter the name if requested. |
| 332 | (when name | 335 | (when name |
| 333 | (if which-func-cleanup-function | 336 | (if which-func-cleanup-function |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 7d1ee705b80..2477884f1ab 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -268,8 +268,8 @@ find a search tool; by default, this uses \"find | grep\" in the | |||
| 268 | (lambda (dir) | 268 | (lambda (dir) |
| 269 | (xref-references-in-directory identifier dir)) | 269 | (xref-references-in-directory identifier dir)) |
| 270 | (let ((pr (project-current t))) | 270 | (let ((pr (project-current t))) |
| 271 | (append | 271 | (cons |
| 272 | (project-roots pr) | 272 | (project-root pr) |
| 273 | (project-external-roots pr))))) | 273 | (project-external-roots pr))))) |
| 274 | 274 | ||
| 275 | (cl-defgeneric xref-backend-apropos (backend pattern) | 275 | (cl-defgeneric xref-backend-apropos (backend pattern) |
diff --git a/lisp/subr.el b/lisp/subr.el index 971bce36b77..683e44123d7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -4117,7 +4117,11 @@ MODES is as for `set-default-file-modes'." | |||
| 4117 | ;; now, but it generates slower code. | 4117 | ;; now, but it generates slower code. |
| 4118 | (defmacro save-match-data (&rest body) | 4118 | (defmacro save-match-data (&rest body) |
| 4119 | "Execute the BODY forms, restoring the global value of the match data. | 4119 | "Execute the BODY forms, restoring the global value of the match data. |
| 4120 | The value returned is the value of the last form in BODY." | 4120 | The value returned is the value of the last form in BODY. |
| 4121 | NOTE: The convention in Elisp is that any function, except for a few | ||
| 4122 | exceptions like car/assoc/+/goto-char, can clobber the match data, | ||
| 4123 | so `save-match-data' should normally be used to save *your* match data | ||
| 4124 | rather than your caller's match data." | ||
| 4121 | ;; It is better not to use backquote here, | 4125 | ;; It is better not to use backquote here, |
| 4122 | ;; because that makes a bootstrapping problem | 4126 | ;; because that makes a bootstrapping problem |
| 4123 | ;; if you need to recompile all the Lisp files using interpreted code. | 4127 | ;; if you need to recompile all the Lisp files using interpreted code. |
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 0c9e656add4..a86c37c24ae 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el | |||
| @@ -1106,6 +1106,7 @@ the *vc-dir* buffer. | |||
| 1106 | (set (make-local-variable 'vc-dir-backend) use-vc-backend) | 1106 | (set (make-local-variable 'vc-dir-backend) use-vc-backend) |
| 1107 | (set (make-local-variable 'desktop-save-buffer) | 1107 | (set (make-local-variable 'desktop-save-buffer) |
| 1108 | 'vc-dir-desktop-buffer-misc-data) | 1108 | 'vc-dir-desktop-buffer-misc-data) |
| 1109 | (setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record) | ||
| 1109 | (setq buffer-read-only t) | 1110 | (setq buffer-read-only t) |
| 1110 | (when (boundp 'tool-bar-map) | 1111 | (when (boundp 'tool-bar-map) |
| 1111 | (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)) | 1112 | (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)) |
| @@ -1466,6 +1467,41 @@ These are the commands available for use in the file status buffer: | |||
| 1466 | '(vc-dir-mode . vc-dir-restore-desktop-buffer)) | 1467 | '(vc-dir-mode . vc-dir-restore-desktop-buffer)) |
| 1467 | 1468 | ||
| 1468 | 1469 | ||
| 1470 | ;;; Support for bookmark.el (adapted from what info.el does). | ||
| 1471 | |||
| 1472 | (declare-function bookmark-make-record-default | ||
| 1473 | "bookmark" (&optional no-file no-context posn)) | ||
| 1474 | (declare-function bookmark-prop-get "bookmark" (bookmark prop)) | ||
| 1475 | (declare-function bookmark-default-handler "bookmark" (bmk)) | ||
| 1476 | (declare-function bookmark-get-bookmark-record "bookmark" (bmk)) | ||
| 1477 | |||
| 1478 | (defun vc-dir-bookmark-make-record () | ||
| 1479 | "Make record used to bookmark a `vc-dir' buffer. | ||
| 1480 | This implements the `bookmark-make-record-function' type for | ||
| 1481 | `vc-dir' buffers." | ||
| 1482 | (let* ((bookmark-name | ||
| 1483 | (concat "(" (symbol-name vc-dir-backend) ") " | ||
| 1484 | (file-name-nondirectory | ||
| 1485 | (directory-file-name default-directory)))) | ||
| 1486 | (defaults (list bookmark-name default-directory))) | ||
| 1487 | `(,bookmark-name | ||
| 1488 | ,@(bookmark-make-record-default 'no-file) | ||
| 1489 | (filename . ,default-directory) | ||
| 1490 | (handler . vc-dir-bookmark-jump) | ||
| 1491 | (defaults . ,defaults)))) | ||
| 1492 | |||
| 1493 | ;;;###autoload | ||
| 1494 | (defun vc-dir-bookmark-jump (bmk) | ||
| 1495 | "Provides the bookmark-jump behavior for a `vc-dir' buffer. | ||
| 1496 | This implements the `handler' function interface for the record | ||
| 1497 | type returned by `vc-dir-bookmark-make-record'." | ||
| 1498 | (let* ((file (bookmark-prop-get bmk 'filename)) | ||
| 1499 | (buf (save-window-excursion | ||
| 1500 | (vc-dir file) (current-buffer)))) | ||
| 1501 | (bookmark-default-handler | ||
| 1502 | `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk))))) | ||
| 1503 | |||
| 1504 | |||
| 1469 | (provide 'vc-dir) | 1505 | (provide 'vc-dir) |
| 1470 | 1506 | ||
| 1471 | ;;; vc-dir.el ends here | 1507 | ;;; vc-dir.el ends here |
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2caa287bce2..dcb52282656 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el | |||
| @@ -72,6 +72,7 @@ | |||
| 72 | ;; by git, so it's probably | 72 | ;; by git, so it's probably |
| 73 | ;; not a good idea. | 73 | ;; not a good idea. |
| 74 | ;; - merge-news (file) see `merge-file' | 74 | ;; - merge-news (file) see `merge-file' |
| 75 | ;; - mark-resolved (file) OK | ||
| 75 | ;; - steal-lock (file &optional revision) NOT NEEDED | 76 | ;; - steal-lock (file &optional revision) NOT NEEDED |
| 76 | ;; HISTORY FUNCTIONS | 77 | ;; HISTORY FUNCTIONS |
| 77 | ;; * print-log (files buffer &optional shortlog start-revision limit) OK | 78 | ;; * 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\"." | |||
| 1530 | (defun vc-git-rename-file (old new) | 1531 | (defun vc-git-rename-file (old new) |
| 1531 | (vc-git-command nil 0 (list old new) "mv" "-f" "--")) | 1532 | (vc-git-command nil 0 (list old new) "mv" "-f" "--")) |
| 1532 | 1533 | ||
| 1534 | (defun vc-git-mark-resolved (files) | ||
| 1535 | (vc-git-command nil 0 files "add")) | ||
| 1536 | |||
| 1533 | (defvar vc-git-extra-menu-map | 1537 | (defvar vc-git-extra-menu-map |
| 1534 | (let ((map (make-sparse-keymap))) | 1538 | (let ((map (make-sparse-keymap))) |
| 1535 | (define-key map [git-grep] | 1539 | (define-key map [git-grep] |
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 2ca9d3e620c..ce72a49b955 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el | |||
| @@ -498,7 +498,7 @@ status of this file. Otherwise, the value returned is one of: | |||
| 498 | "Return the repository version from which FILE was checked out. | 498 | "Return the repository version from which FILE was checked out. |
| 499 | If FILE is not registered, this function always returns nil." | 499 | If FILE is not registered, this function always returns nil." |
| 500 | (or (vc-file-getprop file 'vc-working-revision) | 500 | (or (vc-file-getprop file 'vc-working-revision) |
| 501 | (progn | 501 | (let ((default-directory (file-name-directory file))) |
| 502 | (setq backend (or backend (vc-backend file))) | 502 | (setq backend (or backend (vc-backend file))) |
| 503 | (when backend | 503 | (when backend |
| 504 | (vc-file-setprop file 'vc-working-revision | 504 | (vc-file-setprop file 'vc-working-revision |
diff --git a/lisp/version.el b/lisp/version.el index 24da21c731c..b247232dcfd 100644 --- a/lisp/version.el +++ b/lisp/version.el | |||
| @@ -163,8 +163,4 @@ correspond to the running Emacs. | |||
| 163 | Optional argument DIR is a directory to use instead of `source-directory'." | 163 | Optional argument DIR is a directory to use instead of `source-directory'." |
| 164 | (emacs-repository-branch-git (or dir source-directory))) | 164 | (emacs-repository-branch-git (or dir source-directory))) |
| 165 | 165 | ||
| 166 | ;; We put version info into the executable in the form that `ident' uses. | ||
| 167 | (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) | ||
| 168 | " $\n")) | ||
| 169 | |||
| 170 | ;;; version.el ends here | 166 | ;;; version.el ends here |
diff --git a/lisp/xml.el b/lisp/xml.el index dc774a202cf..767cf042846 100644 --- a/lisp/xml.el +++ b/lisp/xml.el | |||
| @@ -1023,9 +1023,17 @@ entity references (e.g., replace each & with &). | |||
| 1023 | XML character data must not contain & or < characters, nor the > | 1023 | XML character data must not contain & or < characters, nor the > |
| 1024 | character under some circumstances. The XML spec does not impose | 1024 | character under some circumstances. The XML spec does not impose |
| 1025 | restriction on \" or \\=', but we just substitute for these too | 1025 | restriction on \" or \\=', but we just substitute for these too |
| 1026 | \(as is permitted by the spec)." | 1026 | \(as is permitted by the spec). |
| 1027 | |||
| 1028 | If STRING contains characters that are invalid in XML (as defined | ||
| 1029 | by https://www.w3.org/TR/xml/#charsets), signal an error of type | ||
| 1030 | `xml-invalid-character'." | ||
| 1027 | (with-temp-buffer | 1031 | (with-temp-buffer |
| 1028 | (insert string) | 1032 | (insert string) |
| 1033 | (goto-char (point-min)) | ||
| 1034 | (when (re-search-forward | ||
| 1035 | "[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]") | ||
| 1036 | (signal 'xml-invalid-character (list (char-before) (match-beginning 0)))) | ||
| 1029 | (dolist (substitution '(("&" . "&") | 1037 | (dolist (substitution '(("&" . "&") |
| 1030 | ("<" . "<") | 1038 | ("<" . "<") |
| 1031 | (">" . ">") | 1039 | (">" . ">") |
| @@ -1036,6 +1044,9 @@ restriction on \" or \\=', but we just substitute for these too | |||
| 1036 | (replace-match (cdr substitution) t t nil))) | 1044 | (replace-match (cdr substitution) t t nil))) |
| 1037 | (buffer-string))) | 1045 | (buffer-string))) |
| 1038 | 1046 | ||
| 1047 | (define-error 'xml-invalid-character "Invalid XML character" | ||
| 1048 | 'wrong-type-argument) | ||
| 1049 | |||
| 1039 | (defun xml-debug-print-internal (xml indent-string) | 1050 | (defun xml-debug-print-internal (xml indent-string) |
| 1040 | "Outputs the XML tree in the current buffer. | 1051 | "Outputs the XML tree in the current buffer. |
| 1041 | The first line is indented with INDENT-STRING." | 1052 | The first line is indented with INDENT-STRING." |
diff --git a/src/alloc.c b/src/alloc.c index d6ba4d97905..76d49d2efd6 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -3429,23 +3429,6 @@ usage: (vector &rest OBJECTS) */) | |||
| 3429 | return val; | 3429 | return val; |
| 3430 | } | 3430 | } |
| 3431 | 3431 | ||
| 3432 | void | ||
| 3433 | make_byte_code (struct Lisp_Vector *v) | ||
| 3434 | { | ||
| 3435 | /* Don't allow the global zero_vector to become a byte code object. */ | ||
| 3436 | eassert (0 < v->header.size); | ||
| 3437 | |||
| 3438 | if (v->header.size > 1 && STRINGP (v->contents[1]) | ||
| 3439 | && STRING_MULTIBYTE (v->contents[1])) | ||
| 3440 | /* BYTECODE-STRING must have been produced by Emacs 20.2 or the | ||
| 3441 | earlier because they produced a raw 8-bit string for byte-code | ||
| 3442 | and now such a byte-code string is loaded as multibyte while | ||
| 3443 | raw 8-bit characters converted to multibyte form. Thus, now we | ||
| 3444 | must convert them back to the original unibyte form. */ | ||
| 3445 | v->contents[1] = Fstring_as_unibyte (v->contents[1]); | ||
| 3446 | XSETPVECTYPE (v, PVEC_COMPILED); | ||
| 3447 | } | ||
| 3448 | |||
| 3449 | DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, | 3432 | DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, |
| 3450 | doc: /* Create a byte-code object with specified arguments as elements. | 3433 | doc: /* Create a byte-code object with specified arguments as elements. |
| 3451 | The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant | 3434 | The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant |
| @@ -3464,8 +3447,14 @@ stack before executing the byte-code. | |||
| 3464 | usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) | 3447 | usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) |
| 3465 | (ptrdiff_t nargs, Lisp_Object *args) | 3448 | (ptrdiff_t nargs, Lisp_Object *args) |
| 3466 | { | 3449 | { |
| 3467 | Lisp_Object val = make_uninit_vector (nargs); | 3450 | if (! ((FIXNUMP (args[COMPILED_ARGLIST]) |
| 3468 | struct Lisp_Vector *p = XVECTOR (val); | 3451 | || CONSP (args[COMPILED_ARGLIST]) |
| 3452 | || NILP (args[COMPILED_ARGLIST])) | ||
| 3453 | && STRINGP (args[COMPILED_BYTECODE]) | ||
| 3454 | && !STRING_MULTIBYTE (args[COMPILED_BYTECODE]) | ||
| 3455 | && VECTORP (args[COMPILED_CONSTANTS]) | ||
| 3456 | && FIXNATP (args[COMPILED_STACK_DEPTH]))) | ||
| 3457 | error ("Invalid byte-code object"); | ||
| 3469 | 3458 | ||
| 3470 | /* We used to purecopy everything here, if purify-flag was set. This worked | 3459 | /* We used to purecopy everything here, if purify-flag was set. This worked |
| 3471 | OK for Emacs-23, but with Emacs-24's lexical binding code, it can be | 3460 | 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 | |||
| 3474 | copied into pure space, including its free variables, which is sometimes | 3463 | copied into pure space, including its free variables, which is sometimes |
| 3475 | just wasteful and other times plainly wrong (e.g. those free vars may want | 3464 | just wasteful and other times plainly wrong (e.g. those free vars may want |
| 3476 | to be setcar'd). */ | 3465 | to be setcar'd). */ |
| 3477 | 3466 | Lisp_Object val = Fvector (nargs, args); | |
| 3478 | memcpy (p->contents, args, nargs * sizeof *args); | 3467 | XSETPVECTYPE (XVECTOR (val), PVEC_COMPILED); |
| 3479 | make_byte_code (p); | ||
| 3480 | XSETCOMPILED (val, p); | ||
| 3481 | return val; | 3468 | return val; |
| 3482 | } | 3469 | } |
| 3483 | 3470 | ||
| @@ -5019,8 +5006,9 @@ mark_stack (char const *bottom, char const *end) | |||
| 5019 | #endif | 5006 | #endif |
| 5020 | } | 5007 | } |
| 5021 | 5008 | ||
| 5022 | /* This is a trampoline function that flushes registers to the stack, | 5009 | /* flush_stack_call_func is the trampoline function that flushes |
| 5023 | and then calls FUNC. ARG is passed through to FUNC verbatim. | 5010 | registers to the stack, and then calls FUNC. ARG is passed through |
| 5011 | to FUNC verbatim. | ||
| 5024 | 5012 | ||
| 5025 | This function must be called whenever Emacs is about to release the | 5013 | This function must be called whenever Emacs is about to release the |
| 5026 | global interpreter lock. This lets the garbage collector easily | 5014 | global interpreter lock. This lets the garbage collector easily |
| @@ -5028,7 +5016,20 @@ mark_stack (char const *bottom, char const *end) | |||
| 5028 | Lisp. | 5016 | Lisp. |
| 5029 | 5017 | ||
| 5030 | It is invalid to run any Lisp code or to allocate any GC memory | 5018 | It is invalid to run any Lisp code or to allocate any GC memory |
| 5031 | from FUNC. */ | 5019 | from FUNC. |
| 5020 | |||
| 5021 | Note: all register spilling is done in flush_stack_call_func before | ||
| 5022 | flush_stack_call_func1 is activated. | ||
| 5023 | |||
| 5024 | flush_stack_call_func1 is responsible for identifying the stack | ||
| 5025 | address range to be scanned. It *must* be carefully kept as | ||
| 5026 | noinline to make sure that registers has been spilled before it is | ||
| 5027 | called, otherwise given __builtin_frame_address (0) typically | ||
| 5028 | returns the frame pointer (base pointer) and not the stack pointer | ||
| 5029 | [1] GC will miss to scan callee-saved registers content | ||
| 5030 | (Bug#41357). | ||
| 5031 | |||
| 5032 | [1] <https://gcc.gnu.org/onlinedocs/gcc/Return-Address.html>. */ | ||
| 5032 | 5033 | ||
| 5033 | NO_INLINE void | 5034 | NO_INLINE void |
| 5034 | flush_stack_call_func1 (void (*func) (void *arg), void *arg) | 5035 | flush_stack_call_func1 (void (*func) (void *arg), void *arg) |
diff --git a/src/buffer.c b/src/buffer.c index 53b3bd960c4..f1cb4d50414 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -119,6 +119,7 @@ static void free_buffer_text (struct buffer *b); | |||
| 119 | static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); | 119 | static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); |
| 120 | static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); | 120 | static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t); |
| 121 | static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); | 121 | static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool); |
| 122 | static Lisp_Object buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym); | ||
| 122 | 123 | ||
| 123 | static void | 124 | static void |
| 124 | CHECK_OVERLAY (Lisp_Object x) | 125 | CHECK_OVERLAY (Lisp_Object x) |
| @@ -1300,6 +1301,25 @@ buffer_lisp_local_variables (struct buffer *buf, bool clone) | |||
| 1300 | return result; | 1301 | return result; |
| 1301 | } | 1302 | } |
| 1302 | 1303 | ||
| 1304 | |||
| 1305 | /* If the variable at position index OFFSET in buffer BUF has a | ||
| 1306 | buffer-local value, return (name . value). If SYM is non-nil, | ||
| 1307 | it replaces name. */ | ||
| 1308 | |||
| 1309 | static Lisp_Object | ||
| 1310 | buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym) | ||
| 1311 | { | ||
| 1312 | int idx = PER_BUFFER_IDX (offset); | ||
| 1313 | if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) | ||
| 1314 | && SYMBOLP (PER_BUFFER_SYMBOL (offset))) | ||
| 1315 | { | ||
| 1316 | sym = NILP (sym) ? PER_BUFFER_SYMBOL (offset) : sym; | ||
| 1317 | Lisp_Object val = per_buffer_value (buf, offset); | ||
| 1318 | return EQ (val, Qunbound) ? sym : Fcons (sym, val); | ||
| 1319 | } | ||
| 1320 | return Qnil; | ||
| 1321 | } | ||
| 1322 | |||
| 1303 | DEFUN ("buffer-local-variables", Fbuffer_local_variables, | 1323 | DEFUN ("buffer-local-variables", Fbuffer_local_variables, |
| 1304 | Sbuffer_local_variables, 0, 1, 0, | 1324 | Sbuffer_local_variables, 0, 1, 0, |
| 1305 | doc: /* Return an alist of variables that are buffer-local in BUFFER. | 1325 | 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. */) | |||
| 1311 | { | 1331 | { |
| 1312 | struct buffer *buf = decode_buffer (buffer); | 1332 | struct buffer *buf = decode_buffer (buffer); |
| 1313 | Lisp_Object result = buffer_lisp_local_variables (buf, 0); | 1333 | Lisp_Object result = buffer_lisp_local_variables (buf, 0); |
| 1334 | Lisp_Object tem; | ||
| 1314 | 1335 | ||
| 1315 | /* Add on all the variables stored in special slots. */ | 1336 | /* Add on all the variables stored in special slots. */ |
| 1316 | { | 1337 | { |
| 1317 | int offset, idx; | 1338 | int offset; |
| 1318 | 1339 | ||
| 1319 | FOR_EACH_PER_BUFFER_OBJECT_AT (offset) | 1340 | FOR_EACH_PER_BUFFER_OBJECT_AT (offset) |
| 1320 | { | 1341 | { |
| 1321 | idx = PER_BUFFER_IDX (offset); | 1342 | tem = buffer_local_variables_1 (buf, offset, Qnil); |
| 1322 | if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) | 1343 | if (!NILP (tem)) |
| 1323 | && SYMBOLP (PER_BUFFER_SYMBOL (offset))) | 1344 | result = Fcons (tem, result); |
| 1324 | { | ||
| 1325 | Lisp_Object sym = PER_BUFFER_SYMBOL (offset); | ||
| 1326 | Lisp_Object val = per_buffer_value (buf, offset); | ||
| 1327 | result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val), | ||
| 1328 | result); | ||
| 1329 | } | ||
| 1330 | } | 1345 | } |
| 1331 | } | 1346 | } |
| 1332 | 1347 | ||
| 1348 | tem = buffer_local_variables_1 (buf, PER_BUFFER_VAR_OFFSET (undo_list), | ||
| 1349 | intern ("buffer-undo-list")); | ||
| 1350 | if (!NILP (tem)) | ||
| 1351 | result = Fcons (tem, result); | ||
| 1352 | |||
| 1333 | return result; | 1353 | return result; |
| 1334 | } | 1354 | } |
| 1335 | 1355 | ||
diff --git a/src/bytecode.c b/src/bytecode.c index 3c90544f3f2..5ac30aa1010 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -319,6 +319,19 @@ the third, MAXDEPTH, the maximum stack depth used in this function. | |||
| 319 | If the third argument is incorrect, Emacs may crash. */) | 319 | If the third argument is incorrect, Emacs may crash. */) |
| 320 | (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) | 320 | (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) |
| 321 | { | 321 | { |
| 322 | if (! (STRINGP (bytestr) && VECTORP (vector) && FIXNATP (maxdepth))) | ||
| 323 | error ("Invalid byte-code"); | ||
| 324 | |||
| 325 | if (STRING_MULTIBYTE (bytestr)) | ||
| 326 | { | ||
| 327 | /* BYTESTR must have been produced by Emacs 20.2 or earlier | ||
| 328 | because it produced a raw 8-bit string for byte-code and now | ||
| 329 | such a byte-code string is loaded as multibyte with raw 8-bit | ||
| 330 | characters converted to multibyte form. Convert them back to | ||
| 331 | the original unibyte form. */ | ||
| 332 | bytestr = Fstring_as_unibyte (bytestr); | ||
| 333 | } | ||
| 334 | |||
| 322 | return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); | 335 | return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); |
| 323 | } | 336 | } |
| 324 | 337 | ||
| @@ -344,21 +357,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 344 | int volatile this_op = 0; | 357 | int volatile this_op = 0; |
| 345 | #endif | 358 | #endif |
| 346 | 359 | ||
| 347 | CHECK_STRING (bytestr); | 360 | eassert (!STRING_MULTIBYTE (bytestr)); |
| 348 | CHECK_VECTOR (vector); | ||
| 349 | CHECK_FIXNAT (maxdepth); | ||
| 350 | 361 | ||
| 351 | ptrdiff_t const_length = ASIZE (vector); | 362 | ptrdiff_t const_length = ASIZE (vector); |
| 352 | 363 | ptrdiff_t bytestr_length = SCHARS (bytestr); | |
| 353 | if (STRING_MULTIBYTE (bytestr)) | ||
| 354 | /* BYTESTR must have been produced by Emacs 20.2 or the earlier | ||
| 355 | because they produced a raw 8-bit string for byte-code and now | ||
| 356 | such a byte-code string is loaded as multibyte while raw 8-bit | ||
| 357 | characters converted to multibyte form. Thus, now we must | ||
| 358 | convert them back to the originally intended unibyte form. */ | ||
| 359 | bytestr = Fstring_as_unibyte (bytestr); | ||
| 360 | |||
| 361 | ptrdiff_t bytestr_length = SBYTES (bytestr); | ||
| 362 | Lisp_Object *vectorp = XVECTOR (vector)->contents; | 364 | Lisp_Object *vectorp = XVECTOR (vector)->contents; |
| 363 | 365 | ||
| 364 | unsigned char quitcounter = 1; | 366 | unsigned char quitcounter = 1; |
diff --git a/src/emacs.c b/src/emacs.c index e75cb588349..93a837a44ef 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -124,6 +124,11 @@ static const char emacs_version[] = PACKAGE_VERSION; | |||
| 124 | static const char emacs_copyright[] = COPYRIGHT; | 124 | static const char emacs_copyright[] = COPYRIGHT; |
| 125 | static const char emacs_bugreport[] = PACKAGE_BUGREPORT; | 125 | static const char emacs_bugreport[] = PACKAGE_BUGREPORT; |
| 126 | 126 | ||
| 127 | /* Put version info into the executable in the form that 'ident' uses. */ | ||
| 128 | char const EXTERNALLY_VISIBLE RCS_Id[] | ||
| 129 | = "$Id" ": GNU Emacs " PACKAGE_VERSION | ||
| 130 | " (" EMACS_CONFIGURATION " " EMACS_CONFIG_FEATURES ") $"; | ||
| 131 | |||
| 127 | /* Empty lisp strings. To avoid having to build any others. */ | 132 | /* Empty lisp strings. To avoid having to build any others. */ |
| 128 | Lisp_Object empty_unibyte_string, empty_multibyte_string; | 133 | Lisp_Object empty_unibyte_string, empty_multibyte_string; |
| 129 | 134 | ||
diff --git a/src/eval.c b/src/eval.c index 1091b082552..37d466f69ed 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -2913,6 +2913,21 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) | |||
| 2913 | } | 2913 | } |
| 2914 | } | 2914 | } |
| 2915 | 2915 | ||
| 2916 | /* Call the compiled Lisp function FUN. If we have not yet read FUN's | ||
| 2917 | bytecode string and constants vector, fetch them from the file first. */ | ||
| 2918 | |||
| 2919 | static Lisp_Object | ||
| 2920 | fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left, | ||
| 2921 | ptrdiff_t nargs, Lisp_Object *args) | ||
| 2922 | { | ||
| 2923 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 2924 | Ffetch_bytecode (fun); | ||
| 2925 | return exec_byte_code (AREF (fun, COMPILED_BYTECODE), | ||
| 2926 | AREF (fun, COMPILED_CONSTANTS), | ||
| 2927 | AREF (fun, COMPILED_STACK_DEPTH), | ||
| 2928 | syms_left, nargs, args); | ||
| 2929 | } | ||
| 2930 | |||
| 2916 | static Lisp_Object | 2931 | static Lisp_Object |
| 2917 | apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) | 2932 | apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) |
| 2918 | { | 2933 | { |
| @@ -2977,9 +2992,6 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 2977 | } | 2992 | } |
| 2978 | else if (COMPILEDP (fun)) | 2993 | else if (COMPILEDP (fun)) |
| 2979 | { | 2994 | { |
| 2980 | ptrdiff_t size = PVSIZE (fun); | ||
| 2981 | if (size <= COMPILED_STACK_DEPTH) | ||
| 2982 | xsignal1 (Qinvalid_function, fun); | ||
| 2983 | syms_left = AREF (fun, COMPILED_ARGLIST); | 2995 | syms_left = AREF (fun, COMPILED_ARGLIST); |
| 2984 | if (FIXNUMP (syms_left)) | 2996 | if (FIXNUMP (syms_left)) |
| 2985 | /* A byte-code object with an integer args template means we | 2997 | /* A byte-code object with an integer args template means we |
| @@ -2991,15 +3003,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 2991 | argument-binding code below instead (as do all interpreted | 3003 | argument-binding code below instead (as do all interpreted |
| 2992 | functions, even lexically bound ones). */ | 3004 | functions, even lexically bound ones). */ |
| 2993 | { | 3005 | { |
| 2994 | /* If we have not actually read the bytecode string | 3006 | return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector); |
| 2995 | and constants vector yet, fetch them from the file. */ | ||
| 2996 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 2997 | Ffetch_bytecode (fun); | ||
| 2998 | return exec_byte_code (AREF (fun, COMPILED_BYTECODE), | ||
| 2999 | AREF (fun, COMPILED_CONSTANTS), | ||
| 3000 | AREF (fun, COMPILED_STACK_DEPTH), | ||
| 3001 | syms_left, | ||
| 3002 | nargs, arg_vector); | ||
| 3003 | } | 3007 | } |
| 3004 | lexenv = Qnil; | 3008 | lexenv = Qnil; |
| 3005 | } | 3009 | } |
| @@ -3068,16 +3072,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, | |||
| 3068 | if (CONSP (fun)) | 3072 | if (CONSP (fun)) |
| 3069 | val = Fprogn (XCDR (XCDR (fun))); | 3073 | val = Fprogn (XCDR (XCDR (fun))); |
| 3070 | else | 3074 | else |
| 3071 | { | 3075 | val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL); |
| 3072 | /* If we have not actually read the bytecode string | ||
| 3073 | and constants vector yet, fetch them from the file. */ | ||
| 3074 | if (CONSP (AREF (fun, COMPILED_BYTECODE))) | ||
| 3075 | Ffetch_bytecode (fun); | ||
| 3076 | val = exec_byte_code (AREF (fun, COMPILED_BYTECODE), | ||
| 3077 | AREF (fun, COMPILED_CONSTANTS), | ||
| 3078 | AREF (fun, COMPILED_STACK_DEPTH), | ||
| 3079 | Qnil, 0, 0); | ||
| 3080 | } | ||
| 3081 | 3076 | ||
| 3082 | return unbind_to (count, val); | 3077 | return unbind_to (count, val); |
| 3083 | } | 3078 | } |
| @@ -3162,9 +3157,6 @@ lambda_arity (Lisp_Object fun) | |||
| 3162 | } | 3157 | } |
| 3163 | else if (COMPILEDP (fun)) | 3158 | else if (COMPILEDP (fun)) |
| 3164 | { | 3159 | { |
| 3165 | ptrdiff_t size = PVSIZE (fun); | ||
| 3166 | if (size <= COMPILED_STACK_DEPTH) | ||
| 3167 | xsignal1 (Qinvalid_function, fun); | ||
| 3168 | syms_left = AREF (fun, COMPILED_ARGLIST); | 3160 | syms_left = AREF (fun, COMPILED_ARGLIST); |
| 3169 | if (FIXNUMP (syms_left)) | 3161 | if (FIXNUMP (syms_left)) |
| 3170 | return get_byte_code_arity (syms_left); | 3162 | return get_byte_code_arity (syms_left); |
| @@ -3207,13 +3199,11 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 3207 | 3199 | ||
| 3208 | if (COMPILEDP (object)) | 3200 | if (COMPILEDP (object)) |
| 3209 | { | 3201 | { |
| 3210 | ptrdiff_t size = PVSIZE (object); | ||
| 3211 | if (size <= COMPILED_STACK_DEPTH) | ||
| 3212 | xsignal1 (Qinvalid_function, object); | ||
| 3213 | if (CONSP (AREF (object, COMPILED_BYTECODE))) | 3202 | if (CONSP (AREF (object, COMPILED_BYTECODE))) |
| 3214 | { | 3203 | { |
| 3215 | tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); | 3204 | tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); |
| 3216 | if (!CONSP (tem)) | 3205 | if (! (CONSP (tem) && STRINGP (XCAR (tem)) |
| 3206 | && VECTORP (XCDR (tem)))) | ||
| 3217 | { | 3207 | { |
| 3218 | tem = AREF (object, COMPILED_BYTECODE); | 3208 | tem = AREF (object, COMPILED_BYTECODE); |
| 3219 | if (CONSP (tem) && STRINGP (XCAR (tem))) | 3209 | if (CONSP (tem) && STRINGP (XCAR (tem))) |
| @@ -3221,7 +3211,19 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 3221 | else | 3211 | else |
| 3222 | error ("Invalid byte code"); | 3212 | error ("Invalid byte code"); |
| 3223 | } | 3213 | } |
| 3224 | ASET (object, COMPILED_BYTECODE, XCAR (tem)); | 3214 | |
| 3215 | Lisp_Object bytecode = XCAR (tem); | ||
| 3216 | if (STRING_MULTIBYTE (bytecode)) | ||
| 3217 | { | ||
| 3218 | /* BYTECODE must have been produced by Emacs 20.2 or earlier | ||
| 3219 | because it produced a raw 8-bit string for byte-code and now | ||
| 3220 | such a byte-code string is loaded as multibyte with raw 8-bit | ||
| 3221 | characters converted to multibyte form. Convert them back to | ||
| 3222 | the original unibyte form. */ | ||
| 3223 | bytecode = Fstring_as_unibyte (bytecode); | ||
| 3224 | } | ||
| 3225 | |||
| 3226 | ASET (object, COMPILED_BYTECODE, bytecode); | ||
| 3225 | ASET (object, COMPILED_CONSTANTS, XCDR (tem)); | 3227 | ASET (object, COMPILED_CONSTANTS, XCDR (tem)); |
| 3226 | } | 3228 | } |
| 3227 | } | 3229 | } |
| @@ -2508,26 +2508,36 @@ ARRAY is a vector, string, char-table, or bool-vector. */) | |||
| 2508 | } | 2508 | } |
| 2509 | else if (STRINGP (array)) | 2509 | else if (STRINGP (array)) |
| 2510 | { | 2510 | { |
| 2511 | register unsigned char *p = SDATA (array); | 2511 | unsigned char *p = SDATA (array); |
| 2512 | int charval; | ||
| 2513 | CHECK_CHARACTER (item); | 2512 | CHECK_CHARACTER (item); |
| 2514 | charval = XFIXNAT (item); | 2513 | int charval = XFIXNAT (item); |
| 2515 | size = SCHARS (array); | 2514 | size = SCHARS (array); |
| 2516 | if (STRING_MULTIBYTE (array)) | 2515 | if (size != 0) |
| 2517 | { | 2516 | { |
| 2517 | CHECK_IMPURE (array, XSTRING (array)); | ||
| 2518 | unsigned char str[MAX_MULTIBYTE_LENGTH]; | 2518 | unsigned char str[MAX_MULTIBYTE_LENGTH]; |
| 2519 | int len = CHAR_STRING (charval, str); | 2519 | int len; |
| 2520 | ptrdiff_t size_byte = SBYTES (array); | 2520 | if (STRING_MULTIBYTE (array)) |
| 2521 | ptrdiff_t product; | 2521 | len = CHAR_STRING (charval, str); |
| 2522 | else | ||
| 2523 | { | ||
| 2524 | str[0] = charval; | ||
| 2525 | len = 1; | ||
| 2526 | } | ||
| 2522 | 2527 | ||
| 2523 | if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte) | 2528 | ptrdiff_t size_byte = SBYTES (array); |
| 2524 | error ("Attempt to change byte length of a string"); | 2529 | if (len == 1 && size == size_byte) |
| 2525 | for (idx = 0; idx < size_byte; idx++) | 2530 | memset (p, str[0], size); |
| 2526 | *p++ = str[idx % len]; | 2531 | else |
| 2532 | { | ||
| 2533 | ptrdiff_t product; | ||
| 2534 | if (INT_MULTIPLY_WRAPV (size, len, &product) | ||
| 2535 | || product != size_byte) | ||
| 2536 | error ("Attempt to change byte length of a string"); | ||
| 2537 | for (idx = 0; idx < size_byte; idx++) | ||
| 2538 | *p++ = str[idx % len]; | ||
| 2539 | } | ||
| 2527 | } | 2540 | } |
| 2528 | else | ||
| 2529 | for (idx = 0; idx < size; idx++) | ||
| 2530 | p[idx] = charval; | ||
| 2531 | } | 2541 | } |
| 2532 | else if (BOOL_VECTOR_P (array)) | 2542 | else if (BOOL_VECTOR_P (array)) |
| 2533 | return bool_vector_fill (array, item); | 2543 | return bool_vector_fill (array, item); |
| @@ -2542,12 +2552,15 @@ DEFUN ("clear-string", Fclear_string, Sclear_string, | |||
| 2542 | This makes STRING unibyte and may change its length. */) | 2552 | This makes STRING unibyte and may change its length. */) |
| 2543 | (Lisp_Object string) | 2553 | (Lisp_Object string) |
| 2544 | { | 2554 | { |
| 2545 | ptrdiff_t len; | ||
| 2546 | CHECK_STRING (string); | 2555 | CHECK_STRING (string); |
| 2547 | len = SBYTES (string); | 2556 | ptrdiff_t len = SBYTES (string); |
| 2548 | memset (SDATA (string), 0, len); | 2557 | if (len != 0 || STRING_MULTIBYTE (string)) |
| 2549 | STRING_SET_CHARS (string, len); | 2558 | { |
| 2550 | STRING_SET_UNIBYTE (string); | 2559 | CHECK_IMPURE (string, XSTRING (string)); |
| 2560 | memset (SDATA (string), 0, len); | ||
| 2561 | STRING_SET_CHARS (string, len); | ||
| 2562 | STRING_SET_UNIBYTE (string); | ||
| 2563 | } | ||
| 2551 | return Qnil; | 2564 | return Qnil; |
| 2552 | } | 2565 | } |
| 2553 | 2566 | ||
diff --git a/src/lisp.h b/src/lisp.h index 9e4d53ccf17..4c0057b2552 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1343,7 +1343,6 @@ dead_object (void) | |||
| 1343 | #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) | 1343 | #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) |
| 1344 | #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) | 1344 | #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) |
| 1345 | #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) | 1345 | #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) |
| 1346 | #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) | ||
| 1347 | #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) | 1346 | #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) |
| 1348 | #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) | 1347 | #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) |
| 1349 | #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) | 1348 | #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) |
| @@ -3943,7 +3942,6 @@ build_string (const char *str) | |||
| 3943 | 3942 | ||
| 3944 | extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); | 3943 | extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); |
| 3945 | extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); | 3944 | extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); |
| 3946 | extern void make_byte_code (struct Lisp_Vector *); | ||
| 3947 | extern struct Lisp_Vector *allocate_vector (ptrdiff_t); | 3945 | extern struct Lisp_Vector *allocate_vector (ptrdiff_t); |
| 3948 | extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); | 3946 | extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); |
| 3949 | 3947 | ||
diff --git a/src/lread.c b/src/lread.c index 01f359ca581..46725d9b0ff 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -3030,8 +3030,26 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) | |||
| 3030 | struct Lisp_Vector *vec; | 3030 | struct Lisp_Vector *vec; |
| 3031 | tmp = read_vector (readcharfun, 1); | 3031 | tmp = read_vector (readcharfun, 1); |
| 3032 | vec = XVECTOR (tmp); | 3032 | vec = XVECTOR (tmp); |
| 3033 | if (vec->header.size == 0) | 3033 | if (! (COMPILED_STACK_DEPTH < vec->header.size |
| 3034 | invalid_syntax ("Empty byte-code object"); | 3034 | && (FIXNUMP (vec->contents[COMPILED_ARGLIST]) |
| 3035 | || CONSP (vec->contents[COMPILED_ARGLIST]) | ||
| 3036 | || NILP (vec->contents[COMPILED_ARGLIST])) | ||
| 3037 | && ((STRINGP (vec->contents[COMPILED_BYTECODE]) | ||
| 3038 | && VECTORP (vec->contents[COMPILED_CONSTANTS])) | ||
| 3039 | || CONSP (vec->contents[COMPILED_BYTECODE])) | ||
| 3040 | && FIXNATP (vec->contents[COMPILED_STACK_DEPTH]))) | ||
| 3041 | invalid_syntax ("Invalid byte-code object"); | ||
| 3042 | |||
| 3043 | if (STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE))) | ||
| 3044 | { | ||
| 3045 | /* BYTESTR must have been produced by Emacs 20.2 or earlier | ||
| 3046 | because it produced a raw 8-bit string for byte-code and | ||
| 3047 | now such a byte-code string is loaded as multibyte with | ||
| 3048 | raw 8-bit characters converted to multibyte form. | ||
| 3049 | Convert them back to the original unibyte form. */ | ||
| 3050 | ASET (tmp, COMPILED_BYTECODE, | ||
| 3051 | Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE))); | ||
| 3052 | } | ||
| 3035 | 3053 | ||
| 3036 | if (COMPILED_DOC_STRING < vec->header.size | 3054 | if (COMPILED_DOC_STRING < vec->header.size |
| 3037 | && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0))) | 3055 | && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0))) |
| @@ -3050,7 +3068,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) | |||
| 3050 | ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash)); | 3068 | ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash)); |
| 3051 | } | 3069 | } |
| 3052 | 3070 | ||
| 3053 | make_byte_code (vec); | 3071 | XSETPVECTYPE (vec, PVEC_COMPILED); |
| 3054 | return tmp; | 3072 | return tmp; |
| 3055 | } | 3073 | } |
| 3056 | if (c == '(') | 3074 | if (c == '(') |
| @@ -3888,8 +3906,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) | |||
| 3888 | { | 3906 | { |
| 3889 | Lisp_Object tem = read_list (1, readcharfun); | 3907 | Lisp_Object tem = read_list (1, readcharfun); |
| 3890 | ptrdiff_t size = list_length (tem); | 3908 | ptrdiff_t size = list_length (tem); |
| 3891 | if (bytecodeflag && size <= COMPILED_STACK_DEPTH) | ||
| 3892 | error ("Invalid byte code"); | ||
| 3893 | Lisp_Object vector = make_nil_vector (size); | 3909 | Lisp_Object vector = make_nil_vector (size); |
| 3894 | 3910 | ||
| 3895 | Lisp_Object *ptr = XVECTOR (vector)->contents; | 3911 | Lisp_Object *ptr = XVECTOR (vector)->contents; |
| @@ -6519,7 +6519,15 @@ acl_get_file (const char *fname, acl_type_t type) | |||
| 6519 | if (!get_file_security (fname, si, psd, sd_len, &sd_len)) | 6519 | if (!get_file_security (fname, si, psd, sd_len, &sd_len)) |
| 6520 | { | 6520 | { |
| 6521 | xfree (psd); | 6521 | xfree (psd); |
| 6522 | errno = EIO; | 6522 | err = GetLastError (); |
| 6523 | if (err == ERROR_NOT_SUPPORTED) | ||
| 6524 | errno = ENOTSUP; | ||
| 6525 | else if (err == ERROR_FILE_NOT_FOUND | ||
| 6526 | || err == ERROR_PATH_NOT_FOUND | ||
| 6527 | || err == ERROR_INVALID_NAME) | ||
| 6528 | errno = ENOENT; | ||
| 6529 | else | ||
| 6530 | errno = EIO; | ||
| 6523 | psd = NULL; | 6531 | psd = NULL; |
| 6524 | } | 6532 | } |
| 6525 | } | 6533 | } |
| @@ -6530,6 +6538,8 @@ acl_get_file (const char *fname, acl_type_t type) | |||
| 6530 | be encoded in the current ANSI codepage. */ | 6538 | be encoded in the current ANSI codepage. */ |
| 6531 | || err == ERROR_INVALID_NAME) | 6539 | || err == ERROR_INVALID_NAME) |
| 6532 | errno = ENOENT; | 6540 | errno = ENOENT; |
| 6541 | else if (err == ERROR_NOT_SUPPORTED) | ||
| 6542 | errno = ENOTSUP; | ||
| 6533 | else | 6543 | else |
| 6534 | errno = EIO; | 6544 | errno = EIO; |
| 6535 | } | 6545 | } |
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 56d1bdb110e..67f474cbd52 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el | |||
| @@ -547,6 +547,24 @@ baz\"\"" | |||
| 547 | (should (equal "" (buffer-string)))))) | 547 | (should (equal "" (buffer-string)))))) |
| 548 | 548 | ||
| 549 | 549 | ||
| 550 | ;;; Undoing | ||
| 551 | (ert-deftest electric-pair-undo-unrelated-state () | ||
| 552 | "Make sure `electric-pair-mode' does not confuse `undo' (bug#39680)." | ||
| 553 | (with-temp-buffer | ||
| 554 | (buffer-enable-undo) | ||
| 555 | (electric-pair-local-mode) | ||
| 556 | (let ((last-command-event ?\()) | ||
| 557 | (ert-simulate-command '(self-insert-command 1))) | ||
| 558 | (undo-boundary) | ||
| 559 | (let ((last-command-event ?a)) | ||
| 560 | (ert-simulate-command '(self-insert-command 1))) | ||
| 561 | (undo-boundary) | ||
| 562 | (ert-simulate-command '(undo)) | ||
| 563 | (let ((last-command-event ?\()) | ||
| 564 | (ert-simulate-command '(self-insert-command 1))) | ||
| 565 | (should (string= (buffer-string) "(())")))) | ||
| 566 | |||
| 567 | |||
| 550 | ;;; Electric newlines between pairs | 568 | ;;; Electric newlines between pairs |
| 551 | ;;; TODO: better tests | 569 | ;;; TODO: better tests |
| 552 | (ert-deftest electric-pair-open-extra-newline () | 570 | (ert-deftest electric-pair-open-extra-newline () |
diff --git a/test/lisp/emacs-lisp/syntax-tests.el b/test/lisp/emacs-lisp/syntax-tests.el new file mode 100644 index 00000000000..9d4c4113fdd --- /dev/null +++ b/test/lisp/emacs-lisp/syntax-tests.el | |||
| @@ -0,0 +1,67 @@ | |||
| 1 | ;;; syntax-tests.el --- tests for syntax.el -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Code: | ||
| 21 | |||
| 22 | (require 'ert) | ||
| 23 | (require 'syntax) | ||
| 24 | |||
| 25 | (ert-deftest syntax-propertize--shift-groups-and-backrefs () | ||
| 26 | "Test shifting of numbered groups and back-references in regexps." | ||
| 27 | ;; A numbered group must be shifted. | ||
| 28 | (should | ||
| 29 | (string= | ||
| 30 | (syntax-propertize--shift-groups-and-backrefs | ||
| 31 | "\\(?2:[abc]+\\)foobar" 2) | ||
| 32 | "\\(?4:[abc]+\\)foobar")) | ||
| 33 | ;; A back-reference \1 on a normal sub-regexp context must be | ||
| 34 | ;; shifted. | ||
| 35 | (should | ||
| 36 | (string= | ||
| 37 | (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\1" 2) | ||
| 38 | "\\(a\\)\\3")) | ||
| 39 | ;; Shifting must not happen if the \1 appears in a character class, | ||
| 40 | ;; or in a \{\} repetition construct (although \1 isn't valid there | ||
| 41 | ;; anyway). | ||
| 42 | (let ((rx-with-class "\\(a\\)[\\1-2]") | ||
| 43 | (rx-with-rep "\\(a\\)\\{1,\\1\\}")) | ||
| 44 | (should | ||
| 45 | (string= | ||
| 46 | (syntax-propertize--shift-groups-and-backrefs rx-with-class 2) | ||
| 47 | rx-with-class)) | ||
| 48 | (should | ||
| 49 | (string= | ||
| 50 | (syntax-propertize--shift-groups-and-backrefs rx-with-rep 2) | ||
| 51 | rx-with-rep))) | ||
| 52 | ;; Now numbered groups and back-references in combination. | ||
| 53 | (should | ||
| 54 | (string= | ||
| 55 | (syntax-propertize--shift-groups-and-backrefs | ||
| 56 | "\\(?2:[abc]+\\)foo\\(\\2\\)" 2) | ||
| 57 | "\\(?4:[abc]+\\)foo\\(\\4\\)")) | ||
| 58 | ;; Emacs supports only the back-references \1,...,\9, so when a | ||
| 59 | ;; shift would result in \10 or more, an error must be signalled. | ||
| 60 | (should-error | ||
| 61 | (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7))) | ||
| 62 | |||
| 63 | ;; Local Variables: | ||
| 64 | ;; no-byte-compile: t | ||
| 65 | ;; End: | ||
| 66 | |||
| 67 | ;;; syntax-tests.el ends here. | ||
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index ac9706a8ae7..a0e8c87c7b3 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el | |||
| @@ -21,11 +21,16 @@ | |||
| 21 | 21 | ||
| 22 | (require 'ert) | 22 | (require 'ert) |
| 23 | (require 'json) | 23 | (require 'json) |
| 24 | (require 'map) | ||
| 25 | (require 'seq) | ||
| 26 | |||
| 27 | (eval-when-compile | ||
| 28 | (require 'cl-lib)) | ||
| 24 | 29 | ||
| 25 | (defmacro json-tests--with-temp-buffer (content &rest body) | 30 | (defmacro json-tests--with-temp-buffer (content &rest body) |
| 26 | "Create a temporary buffer with CONTENT and evaluate BODY there. | 31 | "Create a temporary buffer with CONTENT and evaluate BODY there. |
| 27 | Point is moved to beginning of the buffer." | 32 | Point is moved to beginning of the buffer." |
| 28 | (declare (indent 1)) | 33 | (declare (debug t) (indent 1)) |
| 29 | `(with-temp-buffer | 34 | `(with-temp-buffer |
| 30 | (insert ,content) | 35 | (insert ,content) |
| 31 | (goto-char (point-min)) | 36 | (goto-char (point-min)) |
| @@ -33,66 +38,107 @@ Point is moved to beginning of the buffer." | |||
| 33 | 38 | ||
| 34 | ;;; Utilities | 39 | ;;; Utilities |
| 35 | 40 | ||
| 36 | (ert-deftest test-json-join () | ||
| 37 | (should (equal (json-join '() ", ") "")) | ||
| 38 | (should (equal (json-join '("a" "b" "c") ", ") "a, b, c"))) | ||
| 39 | |||
| 40 | (ert-deftest test-json-alist-p () | 41 | (ert-deftest test-json-alist-p () |
| 41 | (should (json-alist-p '())) | 42 | (should (json-alist-p '())) |
| 42 | (should (json-alist-p '((a 1) (b 2) (c 3)))) | 43 | (should (json-alist-p '((())))) |
| 43 | (should (json-alist-p '((:a 1) (:b 2) (:c 3)))) | 44 | (should (json-alist-p '((a)))) |
| 44 | (should (json-alist-p '(("a" 1) ("b" 2) ("c" 3)))) | 45 | (should (json-alist-p '((a . 1)))) |
| 46 | (should (json-alist-p '((a . 1) (b 2) (c)))) | ||
| 47 | (should (json-alist-p '((:a) (:b 2) (:c . 3)))) | ||
| 48 | (should (json-alist-p '(("a" . 1) ("b" 2) ("c")))) | ||
| 49 | (should-not (json-alist-p '(()))) | ||
| 50 | (should-not (json-alist-p '(a))) | ||
| 51 | (should-not (json-alist-p '(a . 1))) | ||
| 52 | (should-not (json-alist-p '((a . 1) . []))) | ||
| 53 | (should-not (json-alist-p '((a . 1) []))) | ||
| 45 | (should-not (json-alist-p '(:a :b :c))) | 54 | (should-not (json-alist-p '(:a :b :c))) |
| 46 | (should-not (json-alist-p '(:a 1 :b 2 :c 3))) | 55 | (should-not (json-alist-p '(:a 1 :b 2 :c 3))) |
| 47 | (should-not (json-alist-p '((:a 1) (:b 2) 3)))) | 56 | (should-not (json-alist-p '((:a 1) (:b 2) 3))) |
| 57 | (should-not (json-alist-p '((:a 1) (:b 2) ()))) | ||
| 58 | (should-not (json-alist-p '(((a) 1) (b 2) (c 3)))) | ||
| 59 | (should-not (json-alist-p [])) | ||
| 60 | (should-not (json-alist-p [(a . 1)])) | ||
| 61 | (should-not (json-alist-p #s(hash-table)))) | ||
| 48 | 62 | ||
| 49 | (ert-deftest test-json-plist-p () | 63 | (ert-deftest test-json-plist-p () |
| 50 | (should (json-plist-p '())) | 64 | (should (json-plist-p '())) |
| 65 | (should (json-plist-p '(:a 1))) | ||
| 51 | (should (json-plist-p '(:a 1 :b 2 :c 3))) | 66 | (should (json-plist-p '(:a 1 :b 2 :c 3))) |
| 67 | (should (json-plist-p '(:a :b))) | ||
| 68 | (should (json-plist-p '(:a :b :c :d))) | ||
| 69 | (should-not (json-plist-p '(a))) | ||
| 70 | (should-not (json-plist-p '(a 1))) | ||
| 52 | (should-not (json-plist-p '(a 1 b 2 c 3))) | 71 | (should-not (json-plist-p '(a 1 b 2 c 3))) |
| 53 | (should-not (json-plist-p '("a" 1 "b" 2 "c" 3))) | 72 | (should-not (json-plist-p '("a" 1 "b" 2 "c" 3))) |
| 73 | (should-not (json-plist-p '(:a))) | ||
| 54 | (should-not (json-plist-p '(:a :b :c))) | 74 | (should-not (json-plist-p '(:a :b :c))) |
| 55 | (should-not (json-plist-p '((:a 1) (:b 2) (:c 3))))) | 75 | (should-not (json-plist-p '(:a 1 :b 2 :c))) |
| 56 | 76 | (should-not (json-plist-p '((:a 1)))) | |
| 57 | (ert-deftest test-json-plist-reverse () | 77 | (should-not (json-plist-p '((:a 1) (:b 2) (:c 3)))) |
| 58 | (should (equal (json--plist-reverse '()) '())) | 78 | (should-not (json-plist-p [])) |
| 59 | (should (equal (json--plist-reverse '(:a 1)) '(:a 1))) | 79 | (should-not (json-plist-p [:a 1])) |
| 60 | (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3)) | 80 | (should-not (json-plist-p #s(hash-table)))) |
| 81 | |||
| 82 | (ert-deftest test-json-plist-nreverse () | ||
| 83 | (should (equal (json--plist-nreverse '()) '())) | ||
| 84 | (should (equal (json--plist-nreverse (list :a 1)) '(:a 1))) | ||
| 85 | (should (equal (json--plist-nreverse (list :a 1 :b 2)) '(:b 2 :a 1))) | ||
| 86 | (should (equal (json--plist-nreverse (list :a 1 :b 2 :c 3)) | ||
| 61 | '(:c 3 :b 2 :a 1)))) | 87 | '(:c 3 :b 2 :a 1)))) |
| 62 | 88 | ||
| 63 | (ert-deftest test-json-plist-to-alist () | ||
| 64 | (should (equal (json--plist-to-alist '()) '())) | ||
| 65 | (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1)))) | ||
| 66 | (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3)) | ||
| 67 | '((:a . 1) (:b . 2) (:c . 3))))) | ||
| 68 | |||
| 69 | (ert-deftest test-json-advance () | 89 | (ert-deftest test-json-advance () |
| 70 | (json-tests--with-temp-buffer "{ \"a\": 1 }" | 90 | (json-tests--with-temp-buffer "{ \"a\": 1 }" |
| 71 | (json-advance 0) | 91 | (json-advance 0) |
| 72 | (should (= (point) (point-min))) | 92 | (should (bobp)) |
| 93 | (json-advance) | ||
| 94 | (should (= (point) (1+ (point-min)))) | ||
| 95 | (json-advance 0) | ||
| 96 | (should (= (point) (1+ (point-min)))) | ||
| 97 | (json-advance 1) | ||
| 98 | (should (= (point) (+ (point-min) 2))) | ||
| 73 | (json-advance 3) | 99 | (json-advance 3) |
| 74 | (should (= (point) (+ (point-min) 3))))) | 100 | (should (= (point) (+ (point-min) 5))))) |
| 75 | 101 | ||
| 76 | (ert-deftest test-json-peek () | 102 | (ert-deftest test-json-peek () |
| 77 | (json-tests--with-temp-buffer "" | 103 | (json-tests--with-temp-buffer "" |
| 78 | (should (zerop (json-peek)))) | 104 | (should (zerop (json-peek)))) |
| 79 | (json-tests--with-temp-buffer "{ \"a\": 1 }" | 105 | (json-tests--with-temp-buffer "{ \"a\": 1 }" |
| 80 | (should (equal (json-peek) ?{)))) | 106 | (should (= (json-peek) ?\{)) |
| 107 | (goto-char (1- (point-max))) | ||
| 108 | (should (= (json-peek) ?\})) | ||
| 109 | (json-advance) | ||
| 110 | (should (zerop (json-peek))))) | ||
| 81 | 111 | ||
| 82 | (ert-deftest test-json-pop () | 112 | (ert-deftest test-json-pop () |
| 83 | (json-tests--with-temp-buffer "" | 113 | (json-tests--with-temp-buffer "" |
| 84 | (should-error (json-pop) :type 'json-end-of-file)) | 114 | (should-error (json-pop) :type 'json-end-of-file)) |
| 85 | (json-tests--with-temp-buffer "{ \"a\": 1 }" | 115 | (json-tests--with-temp-buffer "{ \"a\": 1 }" |
| 86 | (should (equal (json-pop) ?{)) | 116 | (should (= (json-pop) ?\{)) |
| 87 | (should (= (point) (+ (point-min) 1))))) | 117 | (should (= (point) (1+ (point-min)))) |
| 118 | (goto-char (1- (point-max))) | ||
| 119 | (should (= (json-pop) ?\})) | ||
| 120 | (should-error (json-pop) :type 'json-end-of-file))) | ||
| 88 | 121 | ||
| 89 | (ert-deftest test-json-skip-whitespace () | 122 | (ert-deftest test-json-skip-whitespace () |
| 123 | (json-tests--with-temp-buffer "" | ||
| 124 | (json-skip-whitespace) | ||
| 125 | (should (bobp)) | ||
| 126 | (should (eobp))) | ||
| 127 | (json-tests--with-temp-buffer "{}" | ||
| 128 | (json-skip-whitespace) | ||
| 129 | (should (bobp)) | ||
| 130 | (json-advance) | ||
| 131 | (json-skip-whitespace) | ||
| 132 | (should (= (point) (1+ (point-min)))) | ||
| 133 | (json-advance) | ||
| 134 | (json-skip-whitespace) | ||
| 135 | (should (eobp))) | ||
| 90 | (json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }" | 136 | (json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }" |
| 91 | (json-skip-whitespace) | 137 | (json-skip-whitespace) |
| 92 | (should (equal (char-after) ?\f))) | 138 | (should (= (json-peek) ?\f))) |
| 93 | (json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }" | 139 | (json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }" |
| 94 | (json-skip-whitespace) | 140 | (json-skip-whitespace) |
| 95 | (should (equal (char-after) ?{)))) | 141 | (should (= (json-peek) ?\{)))) |
| 96 | 142 | ||
| 97 | ;;; Paths | 143 | ;;; Paths |
| 98 | 144 | ||
| @@ -113,59 +159,243 @@ Point is moved to beginning of the buffer." | |||
| 113 | (ert-deftest test-json-path-to-position-no-match () | 159 | (ert-deftest test-json-path-to-position-no-match () |
| 114 | (let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}") | 160 | (let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}") |
| 115 | (matched-path (json-path-to-position 5 json-string))) | 161 | (matched-path (json-path-to-position 5 json-string))) |
| 116 | (should (null matched-path)))) | 162 | (should-not matched-path))) |
| 117 | 163 | ||
| 118 | ;;; Keywords | 164 | ;;; Keywords |
| 119 | 165 | ||
| 120 | (ert-deftest test-json-read-keyword () | 166 | (ert-deftest test-json-read-keyword () |
| 121 | (json-tests--with-temp-buffer "true" | 167 | (json-tests--with-temp-buffer "true" |
| 122 | (should (json-read-keyword "true"))) | 168 | (should (eq (json-read-keyword "true") t)) |
| 169 | (should (eobp))) | ||
| 170 | (json-tests--with-temp-buffer "true " | ||
| 171 | (should (eq (json-read-keyword "true") t)) | ||
| 172 | (should (eobp))) | ||
| 173 | (json-tests--with-temp-buffer "true}" | ||
| 174 | (should (eq (json-read-keyword "true") t)) | ||
| 175 | (should (= (point) (+ (point-min) 4)))) | ||
| 176 | (json-tests--with-temp-buffer "true false" | ||
| 177 | (should (eq (json-read-keyword "true") t)) | ||
| 178 | (should (= (point) (+ (point-min) 5)))) | ||
| 179 | (json-tests--with-temp-buffer "true }" | ||
| 180 | (should (eq (json-read-keyword "true") t)) | ||
| 181 | (should (= (point) (+ (point-min) 5)))) | ||
| 182 | (json-tests--with-temp-buffer "true |" | ||
| 183 | (should (eq (json-read-keyword "true") t)) | ||
| 184 | (should (= (point) (+ (point-min) 5)))) | ||
| 185 | (json-tests--with-temp-buffer "false" | ||
| 186 | (let ((json-false 'false)) | ||
| 187 | (should (eq (json-read-keyword "false") 'false))) | ||
| 188 | (should (eobp))) | ||
| 189 | (json-tests--with-temp-buffer "null" | ||
| 190 | (let ((json-null 'null)) | ||
| 191 | (should (eq (json-read-keyword "null") 'null))) | ||
| 192 | (should (eobp)))) | ||
| 193 | |||
| 194 | (ert-deftest test-json-read-keyword-invalid () | ||
| 195 | (json-tests--with-temp-buffer "" | ||
| 196 | (should (equal (should-error (json-read-keyword "")) | ||
| 197 | '(json-unknown-keyword ""))) | ||
| 198 | (should (equal (should-error (json-read-keyword "true")) | ||
| 199 | '(json-unknown-keyword ())))) | ||
| 123 | (json-tests--with-temp-buffer "true" | 200 | (json-tests--with-temp-buffer "true" |
| 124 | (should-error | 201 | (should (equal (should-error (json-read-keyword "false")) |
| 125 | (json-read-keyword "false") :type 'json-unknown-keyword)) | 202 | '(json-unknown-keyword "true")))) |
| 126 | (json-tests--with-temp-buffer "foo" | 203 | (json-tests--with-temp-buffer "foo" |
| 127 | (should-error | 204 | (should (equal (should-error (json-read-keyword "foo")) |
| 128 | (json-read-keyword "foo") :type 'json-unknown-keyword))) | 205 | '(json-unknown-keyword "foo"))) |
| 206 | (should (equal (should-error (json-read-keyword "bar")) | ||
| 207 | '(json-unknown-keyword "bar")))) | ||
| 208 | (json-tests--with-temp-buffer " true" | ||
| 209 | (should (equal (should-error (json-read-keyword "true")) | ||
| 210 | '(json-unknown-keyword ())))) | ||
| 211 | (json-tests--with-temp-buffer "truefalse" | ||
| 212 | (should (equal (should-error (json-read-keyword "true")) | ||
| 213 | '(json-unknown-keyword "truefalse")))) | ||
| 214 | (json-tests--with-temp-buffer "true|" | ||
| 215 | (should (equal (should-error (json-read-keyword "true")) | ||
| 216 | '(json-unknown-keyword "true"))))) | ||
| 129 | 217 | ||
| 130 | (ert-deftest test-json-encode-keyword () | 218 | (ert-deftest test-json-encode-keyword () |
| 131 | (should (equal (json-encode-keyword t) "true")) | 219 | (should (equal (json-encode-keyword t) "true")) |
| 132 | (should (equal (json-encode-keyword json-false) "false")) | 220 | (let ((json-false 'false)) |
| 133 | (should (equal (json-encode-keyword json-null) "null"))) | 221 | (should (equal (json-encode-keyword 'false) "false")) |
| 222 | (should (equal (json-encode-keyword json-false) "false"))) | ||
| 223 | (let ((json-null 'null)) | ||
| 224 | (should (equal (json-encode-keyword 'null) "null")) | ||
| 225 | (should (equal (json-encode-keyword json-null) "null")))) | ||
| 134 | 226 | ||
| 135 | ;;; Numbers | 227 | ;;; Numbers |
| 136 | 228 | ||
| 137 | (ert-deftest test-json-read-number () | 229 | (ert-deftest test-json-read-integer () |
| 138 | (json-tests--with-temp-buffer "3" | 230 | (json-tests--with-temp-buffer "0 " |
| 139 | (should (= (json-read-number) 3))) | 231 | (should (= (json-read-number) 0)) |
| 140 | (json-tests--with-temp-buffer "-5" | 232 | (should (eobp))) |
| 141 | (should (= (json-read-number) -5))) | 233 | (json-tests--with-temp-buffer "-0 " |
| 142 | (json-tests--with-temp-buffer "123.456" | 234 | (should (= (json-read-number) 0)) |
| 143 | (should (= (json-read-number) 123.456))) | 235 | (should (eobp))) |
| 144 | (json-tests--with-temp-buffer "1e3" | 236 | (json-tests--with-temp-buffer "3 " |
| 145 | (should (= (json-read-number) 1e3))) | 237 | (should (= (json-read-number) 3)) |
| 146 | (json-tests--with-temp-buffer "2e+3" | 238 | (should (eobp))) |
| 147 | (should (= (json-read-number) 2e3))) | 239 | (json-tests--with-temp-buffer "-10 " |
| 148 | (json-tests--with-temp-buffer "3E3" | 240 | (should (= (json-read-number) -10)) |
| 149 | (should (= (json-read-number) 3e3))) | 241 | (should (eobp))) |
| 150 | (json-tests--with-temp-buffer "1e-7" | 242 | (json-tests--with-temp-buffer (format "%d " (1+ most-positive-fixnum)) |
| 151 | (should (= (json-read-number) 1e-7))) | 243 | (should (= (json-read-number) (1+ most-positive-fixnum))) |
| 152 | (json-tests--with-temp-buffer "abc" | 244 | (should (eobp))) |
| 153 | (should-error (json-read-number) :type 'json-number-format))) | 245 | (json-tests--with-temp-buffer (format "%d " (1- most-negative-fixnum)) |
| 246 | (should (= (json-read-number) (1- most-negative-fixnum))) | ||
| 247 | (should (eobp)))) | ||
| 248 | |||
| 249 | (ert-deftest test-json-read-fraction () | ||
| 250 | (json-tests--with-temp-buffer "0.0 " | ||
| 251 | (should (= (json-read-number) 0.0)) | ||
| 252 | (should (eobp))) | ||
| 253 | (json-tests--with-temp-buffer "-0.0 " | ||
| 254 | (should (= (json-read-number) 0.0)) | ||
| 255 | (should (eobp))) | ||
| 256 | (json-tests--with-temp-buffer "0.01 " | ||
| 257 | (should (= (json-read-number) 0.01)) | ||
| 258 | (should (eobp))) | ||
| 259 | (json-tests--with-temp-buffer "-0.01 " | ||
| 260 | (should (= (json-read-number) -0.01)) | ||
| 261 | (should (eobp))) | ||
| 262 | (json-tests--with-temp-buffer "123.456 " | ||
| 263 | (should (= (json-read-number) 123.456)) | ||
| 264 | (should (eobp))) | ||
| 265 | (json-tests--with-temp-buffer "-123.456 " | ||
| 266 | (should (= (json-read-number) -123.456)) | ||
| 267 | (should (eobp)))) | ||
| 268 | |||
| 269 | (ert-deftest test-json-read-exponent () | ||
| 270 | (json-tests--with-temp-buffer "0e0 " | ||
| 271 | (should (= (json-read-number) 0e0)) | ||
| 272 | (should (eobp))) | ||
| 273 | (json-tests--with-temp-buffer "-0E0 " | ||
| 274 | (should (= (json-read-number) 0e0)) | ||
| 275 | (should (eobp))) | ||
| 276 | (json-tests--with-temp-buffer "-0E+0 " | ||
| 277 | (should (= (json-read-number) 0e0)) | ||
| 278 | (should (eobp))) | ||
| 279 | (json-tests--with-temp-buffer "0e-0 " | ||
| 280 | (should (= (json-read-number) 0e0)) | ||
| 281 | (should (eobp))) | ||
| 282 | (json-tests--with-temp-buffer "12e34 " | ||
| 283 | (should (= (json-read-number) 12e34)) | ||
| 284 | (should (eobp))) | ||
| 285 | (json-tests--with-temp-buffer "-12E34 " | ||
| 286 | (should (= (json-read-number) -12e34)) | ||
| 287 | (should (eobp))) | ||
| 288 | (json-tests--with-temp-buffer "-12E+34 " | ||
| 289 | (should (= (json-read-number) -12e34)) | ||
| 290 | (should (eobp))) | ||
| 291 | (json-tests--with-temp-buffer "12e-34 " | ||
| 292 | (should (= (json-read-number) 12e-34)) | ||
| 293 | (should (eobp)))) | ||
| 294 | |||
| 295 | (ert-deftest test-json-read-fraction-exponent () | ||
| 296 | (json-tests--with-temp-buffer "0.0e0 " | ||
| 297 | (should (= (json-read-number) 0.0e0)) | ||
| 298 | (should (eobp))) | ||
| 299 | (json-tests--with-temp-buffer "-0.0E0 " | ||
| 300 | (should (= (json-read-number) 0.0e0)) | ||
| 301 | (should (eobp))) | ||
| 302 | (json-tests--with-temp-buffer "0.12E-0 " | ||
| 303 | (should (= (json-read-number) 0.12e0)) | ||
| 304 | (should (eobp))) | ||
| 305 | (json-tests--with-temp-buffer "-12.34e+56 " | ||
| 306 | (should (= (json-read-number) -12.34e+56)) | ||
| 307 | (should (eobp)))) | ||
| 308 | |||
| 309 | (ert-deftest test-json-read-number-invalid () | ||
| 310 | (cl-flet ((read (str) | ||
| 311 | ;; Return error and point resulting from reading STR. | ||
| 312 | (json-tests--with-temp-buffer str | ||
| 313 | (cons (should-error (json-read-number)) (point))))) | ||
| 314 | ;; POS is where each of its STRINGS becomes invalid. | ||
| 315 | (pcase-dolist (`(,pos . ,strings) | ||
| 316 | '((1 "" "+" "-" "." "e" "e1" "abc" "++0" "++1" | ||
| 317 | "+0" "+0.0" "+12" "+12.34" "+12.34e56" | ||
| 318 | ".0" "+.0" "-.0" ".12" "+.12" "-.12" | ||
| 319 | ".e0" "+.e0" "-.e0" ".0e0" "+.0e0" "-.0e0") | ||
| 320 | (2 "01" "1ee1" "1e++1") | ||
| 321 | (3 "-01") | ||
| 322 | (4 "0.0.0" "1.1.1" "1e1e1") | ||
| 323 | (5 "-0.0.0" "-1.1.1"))) | ||
| 324 | ;; Expected error and point. | ||
| 325 | (let ((res `((json-number-format ,pos) . ,pos))) | ||
| 326 | (dolist (str strings) | ||
| 327 | (should (equal (read str) res))))))) | ||
| 154 | 328 | ||
| 155 | (ert-deftest test-json-encode-number () | 329 | (ert-deftest test-json-encode-number () |
| 330 | (should (equal (json-encode-number 0) "0")) | ||
| 331 | (should (equal (json-encode-number -0) "0")) | ||
| 156 | (should (equal (json-encode-number 3) "3")) | 332 | (should (equal (json-encode-number 3) "3")) |
| 157 | (should (equal (json-encode-number -5) "-5")) | 333 | (should (equal (json-encode-number -5) "-5")) |
| 158 | (should (equal (json-encode-number 123.456) "123.456"))) | 334 | (should (equal (json-encode-number 123.456) "123.456")) |
| 335 | (let ((bignum (1+ most-positive-fixnum))) | ||
| 336 | (should (equal (json-encode-number bignum) | ||
| 337 | (number-to-string bignum))))) | ||
| 159 | 338 | ||
| 160 | ;; Strings | 339 | ;;; Strings |
| 161 | 340 | ||
| 162 | (ert-deftest test-json-read-escaped-char () | 341 | (ert-deftest test-json-read-escaped-char () |
| 163 | (json-tests--with-temp-buffer "\\\"" | 342 | (json-tests--with-temp-buffer "\\\"" |
| 164 | (should (equal (json-read-escaped-char) ?\")))) | 343 | (should (= (json-read-escaped-char) ?\")) |
| 344 | (should (eobp))) | ||
| 345 | (json-tests--with-temp-buffer "\\\\ " | ||
| 346 | (should (= (json-read-escaped-char) ?\\)) | ||
| 347 | (should (= (point) (+ (point-min) 2)))) | ||
| 348 | (json-tests--with-temp-buffer "\\b " | ||
| 349 | (should (= (json-read-escaped-char) ?\b)) | ||
| 350 | (should (= (point) (+ (point-min) 2)))) | ||
| 351 | (json-tests--with-temp-buffer "\\f " | ||
| 352 | (should (= (json-read-escaped-char) ?\f)) | ||
| 353 | (should (= (point) (+ (point-min) 2)))) | ||
| 354 | (json-tests--with-temp-buffer "\\n " | ||
| 355 | (should (= (json-read-escaped-char) ?\n)) | ||
| 356 | (should (= (point) (+ (point-min) 2)))) | ||
| 357 | (json-tests--with-temp-buffer "\\r " | ||
| 358 | (should (= (json-read-escaped-char) ?\r)) | ||
| 359 | (should (= (point) (+ (point-min) 2)))) | ||
| 360 | (json-tests--with-temp-buffer "\\t " | ||
| 361 | (should (= (json-read-escaped-char) ?\t)) | ||
| 362 | (should (= (point) (+ (point-min) 2)))) | ||
| 363 | (json-tests--with-temp-buffer "\\x " | ||
| 364 | (should (= (json-read-escaped-char) ?x)) | ||
| 365 | (should (= (point) (+ (point-min) 2)))) | ||
| 366 | (json-tests--with-temp-buffer "\\ud800\\uDC00 " | ||
| 367 | (should (= (json-read-escaped-char) #x10000)) | ||
| 368 | (should (= (point) (+ (point-min) 12)))) | ||
| 369 | (json-tests--with-temp-buffer "\\ud7ff\\udc00 " | ||
| 370 | (should (= (json-read-escaped-char) #xd7ff)) | ||
| 371 | (should (= (point) (+ (point-min) 6)))) | ||
| 372 | (json-tests--with-temp-buffer "\\uffff " | ||
| 373 | (should (= (json-read-escaped-char) #xffff)) | ||
| 374 | (should (= (point) (+ (point-min) 6)))) | ||
| 375 | (json-tests--with-temp-buffer "\\ufffff " | ||
| 376 | (should (= (json-read-escaped-char) #xffff)) | ||
| 377 | (should (= (point) (+ (point-min) 6))))) | ||
| 378 | |||
| 379 | (ert-deftest test-json-read-escaped-char-invalid () | ||
| 380 | (json-tests--with-temp-buffer "" | ||
| 381 | (should-error (json-read-escaped-char))) | ||
| 382 | (json-tests--with-temp-buffer "\\" | ||
| 383 | (should-error (json-read-escaped-char) :type 'json-end-of-file)) | ||
| 384 | (json-tests--with-temp-buffer "\\ufff " | ||
| 385 | (should (equal (should-error (json-read-escaped-char)) | ||
| 386 | (list 'json-string-escape (+ (point-min) 2))))) | ||
| 387 | (json-tests--with-temp-buffer "\\ufffg " | ||
| 388 | (should (equal (should-error (json-read-escaped-char)) | ||
| 389 | (list 'json-string-escape (+ (point-min) 2)))))) | ||
| 165 | 390 | ||
| 166 | (ert-deftest test-json-read-string () | 391 | (ert-deftest test-json-read-string () |
| 392 | (json-tests--with-temp-buffer "" | ||
| 393 | (should-error (json-read-string))) | ||
| 167 | (json-tests--with-temp-buffer "\"formfeed\f\"" | 394 | (json-tests--with-temp-buffer "\"formfeed\f\"" |
| 168 | (should-error (json-read-string) :type 'json-string-format)) | 395 | (should (equal (should-error (json-read-string)) |
| 396 | '(json-string-format ?\f)))) | ||
| 397 | (json-tests--with-temp-buffer "\"\"" | ||
| 398 | (should (equal (json-read-string) ""))) | ||
| 169 | (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\"" | 399 | (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\"" |
| 170 | (should (equal (json-read-string) "foo \"bar\""))) | 400 | (should (equal (json-read-string) "foo \"bar\""))) |
| 171 | (json-tests--with-temp-buffer "\"abcαβγ\"" | 401 | (json-tests--with-temp-buffer "\"abcαβγ\"" |
| @@ -175,57 +405,117 @@ Point is moved to beginning of the buffer." | |||
| 175 | ;; Bug#24784 | 405 | ;; Bug#24784 |
| 176 | (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" | 406 | (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" |
| 177 | (should (equal (json-read-string) "\U0001D11E"))) | 407 | (should (equal (json-read-string) "\U0001D11E"))) |
| 408 | (json-tests--with-temp-buffer "f" | ||
| 409 | (should-error (json-read-string) :type 'json-end-of-file)) | ||
| 178 | (json-tests--with-temp-buffer "foo" | 410 | (json-tests--with-temp-buffer "foo" |
| 179 | (should-error (json-read-string) :type 'json-string-format))) | 411 | (should-error (json-read-string) :type 'json-end-of-file))) |
| 180 | 412 | ||
| 181 | (ert-deftest test-json-encode-string () | 413 | (ert-deftest test-json-encode-string () |
| 414 | (should (equal (json-encode-string "") "\"\"")) | ||
| 415 | (should (equal (json-encode-string "a") "\"a\"")) | ||
| 182 | (should (equal (json-encode-string "foo") "\"foo\"")) | 416 | (should (equal (json-encode-string "foo") "\"foo\"")) |
| 183 | (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) | 417 | (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) |
| 184 | (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") | 418 | (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") |
| 185 | "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) | 419 | "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) |
| 186 | 420 | ||
| 187 | (ert-deftest test-json-encode-key () | 421 | (ert-deftest test-json-encode-key () |
| 422 | (should (equal (json-encode-key "") "\"\"")) | ||
| 423 | (should (equal (json-encode-key '##) "\"\"")) | ||
| 424 | (should (equal (json-encode-key :) "\"\"")) | ||
| 188 | (should (equal (json-encode-key "foo") "\"foo\"")) | 425 | (should (equal (json-encode-key "foo") "\"foo\"")) |
| 189 | (should (equal (json-encode-key 'foo) "\"foo\"")) | 426 | (should (equal (json-encode-key 'foo) "\"foo\"")) |
| 190 | (should (equal (json-encode-key :foo) "\"foo\"")) | 427 | (should (equal (json-encode-key :foo) "\"foo\"")) |
| 191 | (should-error (json-encode-key 5) :type 'json-key-format) | 428 | (should (equal (should-error (json-encode-key 5)) |
| 192 | (should-error (json-encode-key ["foo"]) :type 'json-key-format) | 429 | '(json-key-format 5))) |
| 193 | (should-error (json-encode-key '("foo")) :type 'json-key-format)) | 430 | (should (equal (should-error (json-encode-key ["foo"])) |
| 431 | '(json-key-format ["foo"]))) | ||
| 432 | (should (equal (should-error (json-encode-key '("foo"))) | ||
| 433 | '(json-key-format ("foo"))))) | ||
| 194 | 434 | ||
| 195 | ;;; Objects | 435 | ;;; Objects |
| 196 | 436 | ||
| 197 | (ert-deftest test-json-new-object () | 437 | (ert-deftest test-json-new-object () |
| 198 | (let ((json-object-type 'alist)) | 438 | (let ((json-object-type 'alist)) |
| 199 | (should (equal (json-new-object) '()))) | 439 | (should-not (json-new-object))) |
| 200 | (let ((json-object-type 'plist)) | 440 | (let ((json-object-type 'plist)) |
| 201 | (should (equal (json-new-object) '()))) | 441 | (should-not (json-new-object))) |
| 202 | (let* ((json-object-type 'hash-table) | 442 | (let* ((json-object-type 'hash-table) |
| 203 | (json-object (json-new-object))) | 443 | (json-object (json-new-object))) |
| 204 | (should (hash-table-p json-object)) | 444 | (should (hash-table-p json-object)) |
| 205 | (should (= (hash-table-count json-object) 0)))) | 445 | (should (map-empty-p json-object)) |
| 446 | (should (eq (hash-table-test json-object) #'equal)))) | ||
| 206 | 447 | ||
| 207 | (ert-deftest test-json-add-to-object () | 448 | (ert-deftest test-json-add-to-alist () |
| 208 | (let* ((json-object-type 'alist) | 449 | (let* ((json-object-type 'alist) |
| 209 | (json-key-type nil) | ||
| 210 | (obj (json-new-object))) | 450 | (obj (json-new-object))) |
| 211 | (setq obj (json-add-to-object obj "a" 1)) | 451 | (let ((json-key-type nil)) |
| 212 | (setq obj (json-add-to-object obj "b" 2)) | 452 | (setq obj (json-add-to-object obj "a" 1)) |
| 213 | (should (equal (assq 'a obj) '(a . 1))) | 453 | (setq obj (json-add-to-object obj "b" 2)) |
| 214 | (should (equal (assq 'b obj) '(b . 2)))) | 454 | (should (equal (assq 'a obj) '(a . 1))) |
| 455 | (should (equal (assq 'b obj) '(b . 2)))) | ||
| 456 | (let ((json-key-type 'symbol)) | ||
| 457 | (setq obj (json-add-to-object obj "c" 3)) | ||
| 458 | (setq obj (json-add-to-object obj "d" 4)) | ||
| 459 | (should (equal (assq 'c obj) '(c . 3))) | ||
| 460 | (should (equal (assq 'd obj) '(d . 4)))) | ||
| 461 | (let ((json-key-type 'keyword)) | ||
| 462 | (setq obj (json-add-to-object obj "e" 5)) | ||
| 463 | (setq obj (json-add-to-object obj "f" 6)) | ||
| 464 | (should (equal (assq :e obj) '(:e . 5))) | ||
| 465 | (should (equal (assq :f obj) '(:f . 6)))) | ||
| 466 | (let ((json-key-type 'string)) | ||
| 467 | (setq obj (json-add-to-object obj "g" 7)) | ||
| 468 | (setq obj (json-add-to-object obj "h" 8)) | ||
| 469 | (should (equal (assoc "g" obj) '("g" . 7))) | ||
| 470 | (should (equal (assoc "h" obj) '("h" . 8)))))) | ||
| 471 | |||
| 472 | (ert-deftest test-json-add-to-plist () | ||
| 215 | (let* ((json-object-type 'plist) | 473 | (let* ((json-object-type 'plist) |
| 216 | (json-key-type nil) | ||
| 217 | (obj (json-new-object))) | 474 | (obj (json-new-object))) |
| 218 | (setq obj (json-add-to-object obj "a" 1)) | 475 | (let ((json-key-type nil)) |
| 219 | (setq obj (json-add-to-object obj "b" 2)) | 476 | (setq obj (json-add-to-object obj "a" 1)) |
| 220 | (should (= (plist-get obj :a) 1)) | 477 | (setq obj (json-add-to-object obj "b" 2)) |
| 221 | (should (= (plist-get obj :b) 2))) | 478 | (should (= (plist-get obj :a) 1)) |
| 479 | (should (= (plist-get obj :b) 2))) | ||
| 480 | (let ((json-key-type 'keyword)) | ||
| 481 | (setq obj (json-add-to-object obj "c" 3)) | ||
| 482 | (setq obj (json-add-to-object obj "d" 4)) | ||
| 483 | (should (= (plist-get obj :c) 3)) | ||
| 484 | (should (= (plist-get obj :d) 4))) | ||
| 485 | (let ((json-key-type 'symbol)) | ||
| 486 | (setq obj (json-add-to-object obj "e" 5)) | ||
| 487 | (setq obj (json-add-to-object obj "f" 6)) | ||
| 488 | (should (= (plist-get obj 'e) 5)) | ||
| 489 | (should (= (plist-get obj 'f) 6))) | ||
| 490 | (let ((json-key-type 'string)) | ||
| 491 | (setq obj (json-add-to-object obj "g" 7)) | ||
| 492 | (setq obj (json-add-to-object obj "h" 8)) | ||
| 493 | (should (= (lax-plist-get obj "g") 7)) | ||
| 494 | (should (= (lax-plist-get obj "h") 8))))) | ||
| 495 | |||
| 496 | (ert-deftest test-json-add-to-hash-table () | ||
| 222 | (let* ((json-object-type 'hash-table) | 497 | (let* ((json-object-type 'hash-table) |
| 223 | (json-key-type nil) | ||
| 224 | (obj (json-new-object))) | 498 | (obj (json-new-object))) |
| 225 | (setq obj (json-add-to-object obj "a" 1)) | 499 | (let ((json-key-type nil)) |
| 226 | (setq obj (json-add-to-object obj "b" 2)) | 500 | (setq obj (json-add-to-object obj "a" 1)) |
| 227 | (should (= (gethash "a" obj) 1)) | 501 | (setq obj (json-add-to-object obj "b" 2)) |
| 228 | (should (= (gethash "b" obj) 2)))) | 502 | (should (= (gethash "a" obj) 1)) |
| 503 | (should (= (gethash "b" obj) 2))) | ||
| 504 | (let ((json-key-type 'string)) | ||
| 505 | (setq obj (json-add-to-object obj "c" 3)) | ||
| 506 | (setq obj (json-add-to-object obj "d" 4)) | ||
| 507 | (should (= (gethash "c" obj) 3)) | ||
| 508 | (should (= (gethash "d" obj) 4))) | ||
| 509 | (let ((json-key-type 'symbol)) | ||
| 510 | (setq obj (json-add-to-object obj "e" 5)) | ||
| 511 | (setq obj (json-add-to-object obj "f" 6)) | ||
| 512 | (should (= (gethash 'e obj) 5)) | ||
| 513 | (should (= (gethash 'f obj) 6))) | ||
| 514 | (let ((json-key-type 'keyword)) | ||
| 515 | (setq obj (json-add-to-object obj "g" 7)) | ||
| 516 | (setq obj (json-add-to-object obj "h" 8)) | ||
| 517 | (should (= (gethash :g obj) 7)) | ||
| 518 | (should (= (gethash :h obj) 8))))) | ||
| 229 | 519 | ||
| 230 | (ert-deftest test-json-read-object () | 520 | (ert-deftest test-json-read-object () |
| 231 | (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }" | 521 | (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }" |
| @@ -238,94 +528,384 @@ Point is moved to beginning of the buffer." | |||
| 238 | (let* ((json-object-type 'hash-table) | 528 | (let* ((json-object-type 'hash-table) |
| 239 | (hash-table (json-read-object))) | 529 | (hash-table (json-read-object))) |
| 240 | (should (= (gethash "a" hash-table) 1)) | 530 | (should (= (gethash "a" hash-table) 1)) |
| 241 | (should (= (gethash "b" hash-table) 2)))) | 531 | (should (= (gethash "b" hash-table) 2))))) |
| 532 | |||
| 533 | (ert-deftest test-json-read-object-empty () | ||
| 534 | (json-tests--with-temp-buffer "{}" | ||
| 535 | (let ((json-object-type 'alist)) | ||
| 536 | (should-not (save-excursion (json-read-object)))) | ||
| 537 | (let ((json-object-type 'plist)) | ||
| 538 | (should-not (save-excursion (json-read-object)))) | ||
| 539 | (let* ((json-object-type 'hash-table) | ||
| 540 | (hash-table (json-read-object))) | ||
| 541 | (should (hash-table-p hash-table)) | ||
| 542 | (should (map-empty-p hash-table))))) | ||
| 543 | |||
| 544 | (ert-deftest test-json-read-object-invalid () | ||
| 545 | (json-tests--with-temp-buffer "{ \"a\" 1, \"b\": 2 }" | ||
| 546 | (should (equal (should-error (json-read-object)) | ||
| 547 | '(json-object-format ":" ?1)))) | ||
| 242 | (json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }" | 548 | (json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }" |
| 243 | (should-error (json-read-object) :type 'json-object-format))) | 549 | (should (equal (should-error (json-read-object)) |
| 550 | '(json-object-format "," ?\"))))) | ||
| 551 | |||
| 552 | (ert-deftest test-json-read-object-function () | ||
| 553 | (let* ((pre nil) | ||
| 554 | (post nil) | ||
| 555 | (keys '("b" "a")) | ||
| 556 | (json-pre-element-read-function | ||
| 557 | (lambda (key) | ||
| 558 | (setq pre 'pre) | ||
| 559 | (should (equal key (pop keys))))) | ||
| 560 | (json-post-element-read-function | ||
| 561 | (lambda () (setq post 'post)))) | ||
| 562 | (json-tests--with-temp-buffer "{ \"b\": 2, \"a\": 1 }" | ||
| 563 | (json-read-object) | ||
| 564 | (should (eq pre 'pre)) | ||
| 565 | (should (eq post 'post))))) | ||
| 244 | 566 | ||
| 245 | (ert-deftest test-json-encode-hash-table () | 567 | (ert-deftest test-json-encode-hash-table () |
| 246 | (let ((hash-table (make-hash-table)) | 568 | (let ((json-encoding-object-sort-predicate nil) |
| 247 | (json-encoding-object-sort-predicate 'string<) | ||
| 248 | (json-encoding-pretty-print nil)) | 569 | (json-encoding-pretty-print nil)) |
| 249 | (puthash :a 1 hash-table) | 570 | (should (equal (json-encode-hash-table #s(hash-table)) "{}")) |
| 250 | (puthash :b 2 hash-table) | 571 | (should (equal (json-encode-hash-table #s(hash-table data (a 1))) |
| 251 | (puthash :c 3 hash-table) | 572 | "{\"a\":1}")) |
| 252 | (should (equal (json-encode hash-table) | 573 | (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) |
| 253 | "{\"a\":1,\"b\":2,\"c\":3}")))) | 574 | '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) |
| 254 | 575 | (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) | |
| 255 | (ert-deftest json-encode-simple-alist () | 576 | '("{\"a\":1,\"b\":2,\"c\":3}" |
| 256 | (let ((json-encoding-pretty-print nil)) | 577 | "{\"a\":1,\"c\":3,\"b\":2}" |
| 257 | (should (equal (json-encode '((a . 1) (b . 2))) | 578 | "{\"b\":2,\"a\":1,\"c\":3}" |
| 258 | "{\"a\":1,\"b\":2}")))) | 579 | "{\"b\":2,\"c\":3,\"a\":1}" |
| 259 | 580 | "{\"c\":3,\"a\":1,\"b\":2}" | |
| 260 | (ert-deftest test-json-encode-plist () | 581 | "{\"c\":3,\"b\":2,\"a\":1}"))))) |
| 261 | (let ((plist '(:a 1 :b 2)) | 582 | |
| 583 | (ert-deftest test-json-encode-hash-table-pretty () | ||
| 584 | (let ((json-encoding-object-sort-predicate nil) | ||
| 585 | (json-encoding-pretty-print t) | ||
| 586 | (json-encoding-default-indentation " ") | ||
| 587 | (json-encoding-lisp-style-closings nil)) | ||
| 588 | (should (equal (json-encode-hash-table #s(hash-table)) "{}")) | ||
| 589 | (should (equal (json-encode-hash-table #s(hash-table data (a 1))) | ||
| 590 | "{\n \"a\": 1\n}")) | ||
| 591 | (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) | ||
| 592 | '("{\n \"a\": 1,\n \"b\": 2\n}" | ||
| 593 | "{\n \"b\": 2,\n \"a\": 1\n}"))) | ||
| 594 | (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) | ||
| 595 | '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}" | ||
| 596 | "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}" | ||
| 597 | "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}" | ||
| 598 | "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1\n}" | ||
| 599 | "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2\n}" | ||
| 600 | "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))) | ||
| 601 | |||
| 602 | (ert-deftest test-json-encode-hash-table-lisp-style () | ||
| 603 | (let ((json-encoding-object-sort-predicate nil) | ||
| 604 | (json-encoding-pretty-print t) | ||
| 605 | (json-encoding-default-indentation " ") | ||
| 606 | (json-encoding-lisp-style-closings t)) | ||
| 607 | (should (equal (json-encode-hash-table #s(hash-table)) "{}")) | ||
| 608 | (should (equal (json-encode-hash-table #s(hash-table data (a 1))) | ||
| 609 | "{\n \"a\": 1}")) | ||
| 610 | (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) | ||
| 611 | '("{\n \"a\": 1,\n \"b\": 2}" | ||
| 612 | "{\n \"b\": 2,\n \"a\": 1}"))) | ||
| 613 | (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) | ||
| 614 | '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}" | ||
| 615 | "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}" | ||
| 616 | "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}" | ||
| 617 | "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1}" | ||
| 618 | "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2}" | ||
| 619 | "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))) | ||
| 620 | |||
| 621 | (ert-deftest test-json-encode-hash-table-sort () | ||
| 622 | (let ((json-encoding-object-sort-predicate #'string<) | ||
| 262 | (json-encoding-pretty-print nil)) | 623 | (json-encoding-pretty-print nil)) |
| 263 | (should (equal (json-encode plist) "{\"a\":1,\"b\":2}")))) | 624 | (pcase-dolist (`(,in . ,out) |
| 264 | 625 | '((#s(hash-table) . "{}") | |
| 265 | (ert-deftest test-json-encode-plist-with-sort-predicate () | 626 | (#s(hash-table data (a 1)) . "{\"a\":1}") |
| 266 | (let ((plist '(:c 3 :a 1 :b 2)) | 627 | (#s(hash-table data (b 2 a 1)) . "{\"a\":1,\"b\":2}") |
| 267 | (json-encoding-object-sort-predicate 'string<) | 628 | (#s(hash-table data (c 3 b 2 a 1)) |
| 629 | . "{\"a\":1,\"b\":2,\"c\":3}"))) | ||
| 630 | (let ((copy (map-pairs in))) | ||
| 631 | (should (equal (json-encode-hash-table in) out)) | ||
| 632 | ;; Ensure sorting isn't destructive. | ||
| 633 | (should (seq-set-equal-p (map-pairs in) copy)))))) | ||
| 634 | |||
| 635 | (ert-deftest test-json-encode-alist () | ||
| 636 | (let ((json-encoding-object-sort-predicate nil) | ||
| 268 | (json-encoding-pretty-print nil)) | 637 | (json-encoding-pretty-print nil)) |
| 269 | (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}")))) | 638 | (should (equal (json-encode-alist ()) "{}")) |
| 639 | (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}")) | ||
| 640 | (should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) | ||
| 641 | (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) | ||
| 642 | "{\"c\":3,\"b\":2,\"a\":1}")))) | ||
| 643 | |||
| 644 | (ert-deftest test-json-encode-alist-pretty () | ||
| 645 | (let ((json-encoding-object-sort-predicate nil) | ||
| 646 | (json-encoding-pretty-print t) | ||
| 647 | (json-encoding-default-indentation " ") | ||
| 648 | (json-encoding-lisp-style-closings nil)) | ||
| 649 | (should (equal (json-encode-alist ()) "{}")) | ||
| 650 | (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1\n}")) | ||
| 651 | (should (equal (json-encode-alist '((b . 2) (a . 1))) | ||
| 652 | "{\n \"b\": 2,\n \"a\": 1\n}")) | ||
| 653 | (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) | ||
| 654 | "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))) | ||
| 655 | |||
| 656 | (ert-deftest test-json-encode-alist-lisp-style () | ||
| 657 | (let ((json-encoding-object-sort-predicate nil) | ||
| 658 | (json-encoding-pretty-print t) | ||
| 659 | (json-encoding-default-indentation " ") | ||
| 660 | (json-encoding-lisp-style-closings t)) | ||
| 661 | (should (equal (json-encode-alist ()) "{}")) | ||
| 662 | (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1}")) | ||
| 663 | (should (equal (json-encode-alist '((b . 2) (a . 1))) | ||
| 664 | "{\n \"b\": 2,\n \"a\": 1}")) | ||
| 665 | (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) | ||
| 666 | "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))) | ||
| 667 | |||
| 668 | (ert-deftest test-json-encode-alist-sort () | ||
| 669 | (let ((json-encoding-object-sort-predicate #'string<) | ||
| 670 | (json-encoding-pretty-print nil)) | ||
| 671 | (pcase-dolist (`(,in . ,out) | ||
| 672 | '((() . "{}") | ||
| 673 | (((a . 1)) . "{\"a\":1}") | ||
| 674 | (((b . 2) (a . 1)) . "{\"a\":1,\"b\":2}") | ||
| 675 | (((c . 3) (b . 2) (a . 1)) | ||
| 676 | . "{\"a\":1,\"b\":2,\"c\":3}"))) | ||
| 677 | (let ((copy (copy-alist in))) | ||
| 678 | (should (equal (json-encode-alist in) out)) | ||
| 679 | ;; Ensure sorting isn't destructive (bug#40693). | ||
| 680 | (should (equal in copy)))))) | ||
| 270 | 681 | ||
| 271 | (ert-deftest test-json-encode-alist-with-sort-predicate () | 682 | (ert-deftest test-json-encode-plist () |
| 272 | (let ((alist '((:c . 3) (:a . 1) (:b . 2))) | 683 | (let ((json-encoding-object-sort-predicate nil) |
| 273 | (json-encoding-object-sort-predicate 'string<) | ||
| 274 | (json-encoding-pretty-print nil)) | 684 | (json-encoding-pretty-print nil)) |
| 275 | (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}")))) | 685 | (should (equal (json-encode-plist ()) "{}")) |
| 686 | (should (equal (json-encode-plist '(:a 1)) "{\"a\":1}")) | ||
| 687 | (should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) | ||
| 688 | (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) | ||
| 689 | "{\"c\":3,\"b\":2,\"a\":1}")))) | ||
| 690 | |||
| 691 | (ert-deftest test-json-encode-plist-pretty () | ||
| 692 | (let ((json-encoding-object-sort-predicate nil) | ||
| 693 | (json-encoding-pretty-print t) | ||
| 694 | (json-encoding-default-indentation " ") | ||
| 695 | (json-encoding-lisp-style-closings nil)) | ||
| 696 | (should (equal (json-encode-plist ()) "{}")) | ||
| 697 | (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1\n}")) | ||
| 698 | (should (equal (json-encode-plist '(:b 2 :a 1)) | ||
| 699 | "{\n \"b\": 2,\n \"a\": 1\n}")) | ||
| 700 | (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) | ||
| 701 | "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))) | ||
| 702 | |||
| 703 | (ert-deftest test-json-encode-plist-lisp-style () | ||
| 704 | (let ((json-encoding-object-sort-predicate nil) | ||
| 705 | (json-encoding-pretty-print t) | ||
| 706 | (json-encoding-default-indentation " ") | ||
| 707 | (json-encoding-lisp-style-closings t)) | ||
| 708 | (should (equal (json-encode-plist ()) "{}")) | ||
| 709 | (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1}")) | ||
| 710 | (should (equal (json-encode-plist '(:b 2 :a 1)) | ||
| 711 | "{\n \"b\": 2,\n \"a\": 1}")) | ||
| 712 | (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) | ||
| 713 | "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))) | ||
| 714 | |||
| 715 | (ert-deftest test-json-encode-plist-sort () | ||
| 716 | (let ((json-encoding-object-sort-predicate #'string<) | ||
| 717 | (json-encoding-pretty-print nil)) | ||
| 718 | (pcase-dolist (`(,in . ,out) | ||
| 719 | '((() . "{}") | ||
| 720 | ((:a 1) . "{\"a\":1}") | ||
| 721 | ((:b 2 :a 1) . "{\"a\":1,\"b\":2}") | ||
| 722 | ((:c 3 :b 2 :a 1) . "{\"a\":1,\"b\":2,\"c\":3}"))) | ||
| 723 | (let ((copy (copy-sequence in))) | ||
| 724 | (should (equal (json-encode-plist in) out)) | ||
| 725 | ;; Ensure sorting isn't destructive. | ||
| 726 | (should (equal in copy)))))) | ||
| 276 | 727 | ||
| 277 | (ert-deftest test-json-encode-list () | 728 | (ert-deftest test-json-encode-list () |
| 278 | (let ((json-encoding-pretty-print nil)) | 729 | (let ((json-encoding-object-sort-predicate nil) |
| 279 | (should (equal (json-encode-list '(:a 1 :b 2)) | 730 | (json-encoding-pretty-print nil)) |
| 280 | "{\"a\":1,\"b\":2}")) | 731 | (should (equal (json-encode-list ()) "{}")) |
| 281 | (should (equal (json-encode-list '((:a . 1) (:b . 2))) | 732 | (should (equal (json-encode-list '(a)) "[\"a\"]")) |
| 282 | "{\"a\":1,\"b\":2}")) | 733 | (should (equal (json-encode-list '(:a)) "[\"a\"]")) |
| 283 | (should (equal (json-encode-list '(1 2 3 4)) "[1,2,3,4]")))) | 734 | (should (equal (json-encode-list '("a")) "[\"a\"]")) |
| 735 | (should (equal (json-encode-list '(a 1)) "[\"a\",1]")) | ||
| 736 | (should (equal (json-encode-list '("a" 1)) "[\"a\",1]")) | ||
| 737 | (should (equal (json-encode-list '(:a 1)) "{\"a\":1}")) | ||
| 738 | (should (equal (json-encode-list '((a . 1))) "{\"a\":1}")) | ||
| 739 | (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}")) | ||
| 740 | (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]")) | ||
| 741 | (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]")) | ||
| 742 | (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]")) | ||
| 743 | (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) | ||
| 744 | (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) | ||
| 745 | (should (equal (json-encode-list '((:b . 2) (:a . 1))) | ||
| 746 | "{\"b\":2,\"a\":1}")) | ||
| 747 | (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]")) | ||
| 748 | (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]")) | ||
| 749 | (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]")) | ||
| 750 | (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]")) | ||
| 751 | (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]")) | ||
| 752 | (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]")) | ||
| 753 | (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}")) | ||
| 754 | (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}")) | ||
| 755 | (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument) | ||
| 756 | (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument) | ||
| 757 | (should (equal (should-error (json-encode-list [])) | ||
| 758 | '(json-error []))) | ||
| 759 | (should (equal (should-error (json-encode-list [a])) | ||
| 760 | '(json-error [a]))))) | ||
| 284 | 761 | ||
| 285 | ;;; Arrays | 762 | ;;; Arrays |
| 286 | 763 | ||
| 287 | (ert-deftest test-json-read-array () | 764 | (ert-deftest test-json-read-array () |
| 288 | (let ((json-array-type 'vector)) | 765 | (let ((json-array-type 'vector)) |
| 766 | (json-tests--with-temp-buffer "[]" | ||
| 767 | (should (equal (json-read-array) []))) | ||
| 768 | (json-tests--with-temp-buffer "[ ]" | ||
| 769 | (should (equal (json-read-array) []))) | ||
| 770 | (json-tests--with-temp-buffer "[1]" | ||
| 771 | (should (equal (json-read-array) [1]))) | ||
| 289 | (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" | 772 | (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" |
| 290 | (should (equal (json-read-array) [1 2 "a" "b"])))) | 773 | (should (equal (json-read-array) [1 2 "a" "b"])))) |
| 291 | (let ((json-array-type 'list)) | 774 | (let ((json-array-type 'list)) |
| 775 | (json-tests--with-temp-buffer "[]" | ||
| 776 | (should-not (json-read-array))) | ||
| 777 | (json-tests--with-temp-buffer "[ ]" | ||
| 778 | (should-not (json-read-array))) | ||
| 779 | (json-tests--with-temp-buffer "[1]" | ||
| 780 | (should (equal (json-read-array) '(1)))) | ||
| 292 | (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" | 781 | (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" |
| 293 | (should (equal (json-read-array) '(1 2 "a" "b"))))) | 782 | (should (equal (json-read-array) '(1 2 "a" "b"))))) |
| 294 | (json-tests--with-temp-buffer "[1 2]" | 783 | (json-tests--with-temp-buffer "[1 2]" |
| 295 | (should-error (json-read-array) :type 'json-error))) | 784 | (should (equal (should-error (json-read-array)) |
| 785 | '(json-array-format "," ?2))))) | ||
| 786 | |||
| 787 | (ert-deftest test-json-read-array-function () | ||
| 788 | (let* ((pre nil) | ||
| 789 | (post nil) | ||
| 790 | (keys '(0 1)) | ||
| 791 | (json-pre-element-read-function | ||
| 792 | (lambda (key) | ||
| 793 | (setq pre 'pre) | ||
| 794 | (should (equal key (pop keys))))) | ||
| 795 | (json-post-element-read-function | ||
| 796 | (lambda () (setq post 'post)))) | ||
| 797 | (json-tests--with-temp-buffer "[1, 0]" | ||
| 798 | (json-read-array) | ||
| 799 | (should (eq pre 'pre)) | ||
| 800 | (should (eq post 'post))))) | ||
| 296 | 801 | ||
| 297 | (ert-deftest test-json-encode-array () | 802 | (ert-deftest test-json-encode-array () |
| 298 | (let ((json-encoding-pretty-print nil)) | 803 | (let ((json-encoding-object-sort-predicate nil) |
| 299 | (should (equal (json-encode-array [1 2 "a" "b"]) | 804 | (json-encoding-pretty-print nil)) |
| 300 | "[1,2,\"a\",\"b\"]")))) | 805 | (should (equal (json-encode-array ()) "[]")) |
| 806 | (should (equal (json-encode-array []) "[]")) | ||
| 807 | (should (equal (json-encode-array '(1)) "[1]")) | ||
| 808 | (should (equal (json-encode-array '[1]) "[1]")) | ||
| 809 | (should (equal (json-encode-array '(2 1)) "[2,1]")) | ||
| 810 | (should (equal (json-encode-array '[2 1]) "[2,1]")) | ||
| 811 | (should (equal (json-encode-array '[:b a 2 1]) "[\"b\",\"a\",2,1]")))) | ||
| 812 | |||
| 813 | (ert-deftest test-json-encode-array-pretty () | ||
| 814 | (let ((json-encoding-object-sort-predicate nil) | ||
| 815 | (json-encoding-pretty-print t) | ||
| 816 | (json-encoding-default-indentation " ") | ||
| 817 | (json-encoding-lisp-style-closings nil)) | ||
| 818 | (should (equal (json-encode-array ()) "[]")) | ||
| 819 | (should (equal (json-encode-array []) "[]")) | ||
| 820 | (should (equal (json-encode-array '(1)) "[\n 1\n]")) | ||
| 821 | (should (equal (json-encode-array '[1]) "[\n 1\n]")) | ||
| 822 | (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1\n]")) | ||
| 823 | (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1\n]")) | ||
| 824 | (should (equal (json-encode-array '[:b a 2 1]) | ||
| 825 | "[\n \"b\",\n \"a\",\n 2,\n 1\n]")))) | ||
| 826 | |||
| 827 | (ert-deftest test-json-encode-array-lisp-style () | ||
| 828 | (let ((json-encoding-object-sort-predicate nil) | ||
| 829 | (json-encoding-pretty-print t) | ||
| 830 | (json-encoding-default-indentation " ") | ||
| 831 | (json-encoding-lisp-style-closings t)) | ||
| 832 | (should (equal (json-encode-array ()) "[]")) | ||
| 833 | (should (equal (json-encode-array []) "[]")) | ||
| 834 | (should (equal (json-encode-array '(1)) "[\n 1]")) | ||
| 835 | (should (equal (json-encode-array '[1]) "[\n 1]")) | ||
| 836 | (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1]")) | ||
| 837 | (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1]")) | ||
| 838 | (should (equal (json-encode-array '[:b a 2 1]) | ||
| 839 | "[\n \"b\",\n \"a\",\n 2,\n 1]")))) | ||
| 301 | 840 | ||
| 302 | ;;; Reader | 841 | ;;; Reader |
| 303 | 842 | ||
| 304 | (ert-deftest test-json-read () | 843 | (ert-deftest test-json-read () |
| 305 | (json-tests--with-temp-buffer "{ \"a\": 1 }" | 844 | (pcase-dolist (`(,fn . ,contents) |
| 306 | ;; We don't care exactly what the return value is (that is tested | 845 | '((json-read-string "\"\"" "\"a\"") |
| 307 | ;; in `test-json-read-object'), but it should parse without error. | 846 | (json-read-array "[]" "[1]") |
| 308 | (should (json-read))) | 847 | (json-read-object "{}" "{\"a\":1}") |
| 848 | (json-read-keyword "null" "false" "true") | ||
| 849 | (json-read-number | ||
| 850 | "-0" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) | ||
| 851 | (dolist (content contents) | ||
| 852 | ;; Check that leading whitespace is skipped. | ||
| 853 | (dolist (str (list content (concat " " content))) | ||
| 854 | (cl-letf* ((called nil) | ||
| 855 | ((symbol-function fn) | ||
| 856 | (lambda (&rest _) (setq called t)))) | ||
| 857 | (json-tests--with-temp-buffer str | ||
| 858 | ;; We don't care exactly what the return value is (that is | ||
| 859 | ;; tested elsewhere), but it should parse without error. | ||
| 860 | (should (json-read)) | ||
| 861 | (should called))))))) | ||
| 862 | |||
| 863 | (ert-deftest test-json-read-invalid () | ||
| 309 | (json-tests--with-temp-buffer "" | 864 | (json-tests--with-temp-buffer "" |
| 310 | (should-error (json-read) :type 'json-end-of-file)) | 865 | (should-error (json-read) :type 'json-end-of-file)) |
| 311 | (json-tests--with-temp-buffer "xxx" | 866 | (json-tests--with-temp-buffer " " |
| 312 | (let ((err (should-error (json-read) :type 'json-readtable-error))) | 867 | (should-error (json-read) :type 'json-end-of-file)) |
| 313 | (should (equal (cdr err) '(?x)))))) | 868 | (json-tests--with-temp-buffer "x" |
| 869 | (should (equal (should-error (json-read)) | ||
| 870 | '(json-readtable-error ?x)))) | ||
| 871 | (json-tests--with-temp-buffer " x" | ||
| 872 | (should (equal (should-error (json-read)) | ||
| 873 | '(json-readtable-error ?x))))) | ||
| 314 | 874 | ||
| 315 | (ert-deftest test-json-read-from-string () | 875 | (ert-deftest test-json-read-from-string () |
| 316 | (let ((json-string "{ \"a\": 1 }")) | 876 | (dolist (str '("\"\"" "\"a\"" "[]" "[1]" "{}" "{\"a\":1}" |
| 317 | (json-tests--with-temp-buffer json-string | 877 | "null" "false" "true" "0" "123")) |
| 318 | (should (equal (json-read-from-string json-string) | 878 | (json-tests--with-temp-buffer str |
| 879 | (should (equal (json-read-from-string str) | ||
| 319 | (json-read)))))) | 880 | (json-read)))))) |
| 320 | 881 | ||
| 321 | ;;; JSON encoder | 882 | ;;; Encoder |
| 322 | 883 | ||
| 323 | (ert-deftest test-json-encode () | 884 | (ert-deftest test-json-encode () |
| 885 | (should (equal (json-encode t) "true")) | ||
| 886 | (let ((json-null 'null)) | ||
| 887 | (should (equal (json-encode json-null) "null"))) | ||
| 888 | (let ((json-false 'false)) | ||
| 889 | (should (equal (json-encode json-false) "false"))) | ||
| 890 | (should (equal (json-encode "") "\"\"")) | ||
| 324 | (should (equal (json-encode "foo") "\"foo\"")) | 891 | (should (equal (json-encode "foo") "\"foo\"")) |
| 892 | (should (equal (json-encode :) "\"\"")) | ||
| 893 | (should (equal (json-encode :foo) "\"foo\"")) | ||
| 894 | (should (equal (json-encode '(1)) "[1]")) | ||
| 895 | (should (equal (json-encode 'foo) "\"foo\"")) | ||
| 896 | (should (equal (json-encode 0) "0")) | ||
| 897 | (should (equal (json-encode 123) "123")) | ||
| 898 | (let ((json-encoding-object-sort-predicate nil) | ||
| 899 | (json-encoding-pretty-print nil)) | ||
| 900 | (should (equal (json-encode []) "[]")) | ||
| 901 | (should (equal (json-encode [1]) "[1]")) | ||
| 902 | (should (equal (json-encode #s(hash-table)) "{}")) | ||
| 903 | (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}"))) | ||
| 325 | (with-temp-buffer | 904 | (with-temp-buffer |
| 326 | (should-error (json-encode (current-buffer)) :type 'json-error))) | 905 | (should (equal (should-error (json-encode (current-buffer))) |
| 906 | (list 'json-error (current-buffer)))))) | ||
| 327 | 907 | ||
| 328 | ;;; Pretty-print | 908 | ;;; Pretty printing & minimizing |
| 329 | 909 | ||
| 330 | (defun json-tests-equal-pretty-print (original &optional expected) | 910 | (defun json-tests-equal-pretty-print (original &optional expected) |
| 331 | "Abort current test if pretty-printing ORIGINAL does not yield EXPECTED. | 911 | "Abort current test if pretty-printing ORIGINAL does not yield EXPECTED. |
| @@ -351,46 +931,45 @@ nil, ORIGINAL should stay unchanged by pretty-printing." | |||
| 351 | (json-tests-equal-pretty-print "0.123")) | 931 | (json-tests-equal-pretty-print "0.123")) |
| 352 | 932 | ||
| 353 | (ert-deftest test-json-pretty-print-object () | 933 | (ert-deftest test-json-pretty-print-object () |
| 354 | ;; empty (regression test for bug#24252) | 934 | ;; Empty (regression test for bug#24252). |
| 355 | (json-tests-equal-pretty-print | 935 | (json-tests-equal-pretty-print "{}") |
| 356 | "{}" | 936 | ;; One pair. |
| 357 | "{\n}") | ||
| 358 | ;; one pair | ||
| 359 | (json-tests-equal-pretty-print | 937 | (json-tests-equal-pretty-print |
| 360 | "{\"key\":1}" | 938 | "{\"key\":1}" |
| 361 | "{\n \"key\": 1\n}") | 939 | "{\n \"key\": 1\n}") |
| 362 | ;; two pairs | 940 | ;; Two pairs. |
| 363 | (json-tests-equal-pretty-print | 941 | (json-tests-equal-pretty-print |
| 364 | "{\"key1\":1,\"key2\":2}" | 942 | "{\"key1\":1,\"key2\":2}" |
| 365 | "{\n \"key1\": 1,\n \"key2\": 2\n}") | 943 | "{\n \"key1\": 1,\n \"key2\": 2\n}") |
| 366 | ;; embedded object | 944 | ;; Nested object. |
| 367 | (json-tests-equal-pretty-print | 945 | (json-tests-equal-pretty-print |
| 368 | "{\"foo\":{\"key\":1}}" | 946 | "{\"foo\":{\"key\":1}}" |
| 369 | "{\n \"foo\": {\n \"key\": 1\n }\n}") | 947 | "{\n \"foo\": {\n \"key\": 1\n }\n}") |
| 370 | ;; embedded array | 948 | ;; Nested array. |
| 371 | (json-tests-equal-pretty-print | 949 | (json-tests-equal-pretty-print |
| 372 | "{\"key\":[1,2]}" | 950 | "{\"key\":[1,2]}" |
| 373 | "{\n \"key\": [\n 1,\n 2\n ]\n}")) | 951 | "{\n \"key\": [\n 1,\n 2\n ]\n}")) |
| 374 | 952 | ||
| 375 | (ert-deftest test-json-pretty-print-array () | 953 | (ert-deftest test-json-pretty-print-array () |
| 376 | ;; empty | 954 | ;; Empty. |
| 377 | (json-tests-equal-pretty-print "[]") | 955 | (json-tests-equal-pretty-print "[]") |
| 378 | ;; one item | 956 | ;; One item. |
| 379 | (json-tests-equal-pretty-print | 957 | (json-tests-equal-pretty-print |
| 380 | "[1]" | 958 | "[1]" |
| 381 | "[\n 1\n]") | 959 | "[\n 1\n]") |
| 382 | ;; two items | 960 | ;; Two items. |
| 383 | (json-tests-equal-pretty-print | 961 | (json-tests-equal-pretty-print |
| 384 | "[1,2]" | 962 | "[1,2]" |
| 385 | "[\n 1,\n 2\n]") | 963 | "[\n 1,\n 2\n]") |
| 386 | ;; embedded object | 964 | ;; Nested object. |
| 387 | (json-tests-equal-pretty-print | 965 | (json-tests-equal-pretty-print |
| 388 | "[{\"key\":1}]" | 966 | "[{\"key\":1}]" |
| 389 | "[\n {\n \"key\": 1\n }\n]") | 967 | "[\n {\n \"key\": 1\n }\n]") |
| 390 | ;; embedded array | 968 | ;; Nested array. |
| 391 | (json-tests-equal-pretty-print | 969 | (json-tests-equal-pretty-print |
| 392 | "[[1,2]]" | 970 | "[[1,2]]" |
| 393 | "[\n [\n 1,\n 2\n ]\n]")) | 971 | "[\n [\n 1,\n 2\n ]\n]")) |
| 394 | 972 | ||
| 395 | (provide 'json-tests) | 973 | (provide 'json-tests) |
| 974 | |||
| 396 | ;;; json-tests.el ends here | 975 | ;;; json-tests.el ends here |
diff --git a/test/lisp/net/webjump-tests.el b/test/lisp/net/webjump-tests.el new file mode 100644 index 00000000000..47569c948f5 --- /dev/null +++ b/test/lisp/net/webjump-tests.el | |||
| @@ -0,0 +1,73 @@ | |||
| 1 | ;;; webjump-tests.el --- Tests for webjump.el -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simen Heggestøyl <simenheg@gmail.com> | ||
| 6 | ;; Keywords: | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | (require 'ert) | ||
| 30 | (require 'webjump) | ||
| 31 | |||
| 32 | (ert-deftest webjump-tests-builtin () | ||
| 33 | (should (equal (webjump-builtin '[name] "gnu.org") "gnu.org"))) | ||
| 34 | |||
| 35 | (ert-deftest webjump-tests-builtin-check-args () | ||
| 36 | (should (webjump-builtin-check-args [1 2 3] "Foo" 2)) | ||
| 37 | (should-error (webjump-builtin-check-args [1 2 3] "Foo" 3))) | ||
| 38 | |||
| 39 | (ert-deftest webjump-tests-mirror-default () | ||
| 40 | (should (equal (webjump-mirror-default | ||
| 41 | '("https://ftp.gnu.org/pub/gnu/" | ||
| 42 | "https://ftpmirror.gnu.org")) | ||
| 43 | "https://ftp.gnu.org/pub/gnu/"))) | ||
| 44 | |||
| 45 | (ert-deftest webjump-tests-null-or-blank-string-p () | ||
| 46 | (should (webjump-null-or-blank-string-p nil)) | ||
| 47 | (should (webjump-null-or-blank-string-p "")) | ||
| 48 | (should (webjump-null-or-blank-string-p " ")) | ||
| 49 | (should-not (webjump-null-or-blank-string-p " . "))) | ||
| 50 | |||
| 51 | (ert-deftest webjump-tests-url-encode () | ||
| 52 | (should (equal (webjump-url-encode "") "")) | ||
| 53 | (should (equal (webjump-url-encode "a b c") "a+b+c")) | ||
| 54 | (should (equal (webjump-url-encode "foo?") "foo%3F")) | ||
| 55 | (should (equal (webjump-url-encode "/foo\\") "/foo%5C")) | ||
| 56 | (should (equal (webjump-url-encode "f&o") "f%26o"))) | ||
| 57 | |||
| 58 | (ert-deftest webjump-tests-url-fix () | ||
| 59 | (should (equal (webjump-url-fix nil) "")) | ||
| 60 | (should (equal (webjump-url-fix "/tmp/") "file:///tmp/")) | ||
| 61 | (should (equal (webjump-url-fix "gnu.org") "http://gnu.org/")) | ||
| 62 | (should (equal (webjump-url-fix "ftp.x.org") "ftp://ftp.x.org/")) | ||
| 63 | (should (equal (webjump-url-fix "https://gnu.org") | ||
| 64 | "https://gnu.org/"))) | ||
| 65 | |||
| 66 | (ert-deftest webjump-tests-url-fix-trailing-slash () | ||
| 67 | (should (equal (webjump-url-fix-trailing-slash "https://gnu.org") | ||
| 68 | "https://gnu.org/")) | ||
| 69 | (should (equal (webjump-url-fix-trailing-slash "https://gnu.org/") | ||
| 70 | "https://gnu.org/"))) | ||
| 71 | |||
| 72 | (provide 'webjump-tests) | ||
| 73 | ;;; webjump-tests.el ends here | ||
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el index 57e685cd347..72c78d00e3e 100644 --- a/test/lisp/xml-tests.el +++ b/test/lisp/xml-tests.el | |||
| @@ -164,6 +164,16 @@ Parser is called with and without 'symbol-qnames argument.") | |||
| 164 | (should (equal (cdr xml-parse-test--namespace-attribute-qnames) | 164 | (should (equal (cdr xml-parse-test--namespace-attribute-qnames) |
| 165 | (xml-parse-region nil nil nil nil 'symbol-qnames))))) | 165 | (xml-parse-region nil nil nil nil 'symbol-qnames))))) |
| 166 | 166 | ||
| 167 | (ert-deftest xml-print-invalid-cdata () | ||
| 168 | "Check that Bug#41094 is fixed." | ||
| 169 | (with-temp-buffer | ||
| 170 | (should (equal (should-error (xml-print '((foo () "\0"))) | ||
| 171 | :type 'xml-invalid-character) | ||
| 172 | '(xml-invalid-character 0 1))) | ||
| 173 | (should (equal (should-error (xml-print '((foo () "\u00FF \xFF"))) | ||
| 174 | :type 'xml-invalid-character) | ||
| 175 | '(xml-invalid-character #x3FFFFF 3))))) | ||
| 176 | |||
| 167 | ;; Local Variables: | 177 | ;; Local Variables: |
| 168 | ;; no-byte-compile: t | 178 | ;; no-byte-compile: t |
| 169 | ;; End: | 179 | ;; End: |
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 6e87cb94897..6e9764625a9 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el | |||
| @@ -1327,4 +1327,10 @@ with parameters from the *Messages* buffer modification." | |||
| 1327 | (set-buffer-multibyte t) | 1327 | (set-buffer-multibyte t) |
| 1328 | (buffer-string))))))) | 1328 | (buffer-string))))))) |
| 1329 | 1329 | ||
| 1330 | ;; https://debbugs.gnu.org/33492 | ||
| 1331 | (ert-deftest buffer-tests-buffer-local-variables-undo () | ||
| 1332 | "Test that `buffer-undo-list' appears in `buffer-local-variables'." | ||
| 1333 | (with-temp-buffer | ||
| 1334 | (should (assq 'buffer-undo-list (buffer-local-variables))))) | ||
| 1335 | |||
| 1330 | ;;; buffer-tests.el ends here | 1336 | ;;; buffer-tests.el ends here |