mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-20 18:17:20 +00:00
Code Issues Releases Activity

Merge from origin/emacs-29

Browse Source 
ede3535051 ; Fix last change
8ec786349e Fix apostrophe handling in rust-ts-mode and go-ts-mode (B...
0eba9cf651 * test/infra/Dockerfile.emba (emacs-base): Install also g...
4897c98b6c Fix 'python-util-clone-local-variables'
6b2c8dc905 Revert "Enhance Python font-lock to support multilines"
348e4504c6 Fix typo in calc.texi
03663b8798 Update to Transient v0.4.1
dc7acb1aaf Avoid errors in 'delete-forward-char' deleting static com...
2f94f6de9d Make VS-15 and VS-16 compositions work correctly
753f8aa1f1 Fix project-name for vc-aware backend in non-file buffers
17c7915ab9 ; Fix 'package-install-upgrade-built-in' check for packag...
e252ce26ea Add type_predicate 'is' as keyword in typescript-ts-mode ...
0a354d6578 Fix infloop in info-look.el
83b22139e4 Fix several todo-mode.el item editing bugs (bug#63811)
ed4cd3eddf dockerfile-ts-mode: Prevent empty categories in imenu (Bu...
2e20e318da Brush up doc strings and terminology in plstore.el
372bc1278c Add internal documentation on plstore.el
23a14e7b90 Add compact_constructor_declaration font-locking to java-...
500abc4dc3 * lisp/tmm.el (tmm-completion-delete-prompt): Add more ch...
afc1f32935 Allow to disable the DWIMish behavior of 'x' in package menu
08104c0150 Allow dired to invoke secondary browser
a3063f0bc8 Add a binding for enriched-toggle-markup
d8ba28fa39 Fix order of tmm-menubar when 'tmm-mid-prompt' is nil

# Conflicts:
#	etc/NEWS
This commit is contained in:
Eli Zaretskii 2023-06-03 05:50:58 -04:00
commit 970f94a2dd
23 changed files with 465 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
admin/unidata/emoji-zwj.awk
View File

@ -106,7 +106,8 @@ END {
for (elt in ch)
{
printf("(#x%s .\n,(eval-when-compile (regexp-opt\n'(\n%s\n))))\n", elt, vec[elt])
entries = sprintf("%s\n\"\\N{U+%s}\\N{U+FE0E}\"\n\"\\N{U+%s}\\N{U+FE0F}\"", vec[elt], elt, elt)
printf("(#x%s .\n,(eval-when-compile (regexp-opt\n'(\n%s\n))))\n", elt, entries)
}
print "))"
print " (set-char-table-range composition-function-table"

2
doc/misc/calc.texi
View File

@ -6217,7 +6217,7 @@ method when it is able. @xref{Programming Answer 8, 8}. (@bullet{})
@cindex Gamma constant, Euler's
@cindex Euler's gamma constant
(@bullet{}) @strong{Exercise 9.} The @dfn{digamma} function
@texline @math{\psi(z) (``psi'')}
@texline @math{\psi(z)} (``psi'')
@infoline @expr{psi(z)}
is defined as the derivative of
@texline @math{\ln \Gamma(z)}.

6
doc/misc/transient.texi
View File

@ -31,7 +31,7 @@ General Public License for more details.
@finalout
@titlepage
@title Transient User and Developer Manual
@subtitle for version 0.4.0
@subtitle for version 0.4.1
@author Jonas Bernoulli
@page
@vskip 0pt plus 1filll
@ -74,7 +74,7 @@ that hurdle is Psionic K's interactive tutorial, available at
@end quotation
@noindent
This manual is for Transient version 0.4.0.
This manual is for Transient version 0.4.1.
@insertcopying
@end ifnottex
@ -2150,7 +2150,7 @@ default value of a prefix using the same format as returned by
@item
@code{always-read} For options, whether to read a value on every invocation.
If this is nil, then options that have a value are simply unset and
If this is @code{nil}, then options that have a value are simply unset and
have to be invoked a second time to set a new value.
@item

13
etc/NEWS.29
View File

@ -1692,6 +1692,13 @@ the following to your Init file:
*** New command 'dired-do-eww'.
This command visits the file on the current line with EWW.
---
*** 'browse-url-of-dired-file' can now call the secondary browser.
When invoked with a prefix arg, this will now call
'browse-url-secondary-browser-function' instead of the default
browser. 'browse-url-of-dired-file' is bound to 'W' by default in
dired mode.
---
*** New user option 'dired-omit-lines'.
This is used by 'dired-omit-mode', and now allows you to hide based on
@ -1769,7 +1776,7 @@ or can take a long time to render.
+++
*** New command 'enriched-toggle-markup'.
This allows you to see the markup in 'enriched-mode' buffers (e.g.,
the "HELLO" file).
the "HELLO" file). Bound to 'M-o m' by default.
** Shell Script Mode
@ -1879,7 +1886,9 @@ These commands can be useful if the ".elc" files are out of date
+++
*** New DWIM action on 'x' in "*Packages*" buffer.
If no packages are marked, 'x' will install the package under point if
it isn't already, and remove it if it is installed.
it isn't already, and remove it if it is installed. Customize the new
option 'package-menu-use-current-if-no-marks' to the nil value to get
back the old behavior of signaling an error in that case.
+++
*** New command 'package-vc-install'.

298
lisp/calendar/todo-mode.el
View File

@ -1985,7 +1985,13 @@ their associated keys and their effects."
(setq done-only t)
(todo-toggle-view-done-only))
(if here
(todo-insert-with-overlays new-item)
(progn
;; Ensure item is inserted where command was invoked.
(unless (= (point) opoint)
(todo-category-number ocat)
(todo-category-select)
(goto-char opoint))
(todo-insert-with-overlays new-item))
(todo-set-item-priority new-item cat t))
(setq item-added t))
;; If user cancels before setting priority, restore
@ -2119,6 +2125,9 @@ the item at point."
((or marked (todo-item-string))
(todo-edit-item--next-key 'todo arg)))))
(defvar todo-edit-item--cat nil)
(defvar todo-edit-item--pos nil)
(defun todo-edit-item--text (&optional arg)
"Function providing the text editing facilities of `todo-edit-item'."
(let ((full-item (todo-item-string)))
@ -2127,6 +2136,7 @@ the item at point."
;; 1+ signals an error, so just make this a noop.
(when full-item
(let* ((opoint (point))
(ocat (todo-current-category))
(start (todo-item-start))
(end (save-excursion (todo-item-end)))
(item-beg (progn
@ -2151,8 +2161,7 @@ the item at point."
(concat " \\[" (regexp-quote todo-comment-string)
": \\([^]]+\\)\\]")
end t)))
(prompt (if comment "Edit comment: " "Enter a comment: "))
(buffer-read-only nil))
(prompt (if comment "Edit comment: " "Enter a comment: ")))
;; When there are marked items, user can invoke todo-edit-item
;; even if point is not on an item, but text editing only
;; applies to the item at point.
@ -2170,22 +2179,43 @@ the item at point."
end t)
(if comment-delete
(when (todo-y-or-n-p "Delete comment? ")
(delete-region (match-beginning 0) (match-end 0)))
(replace-match (save-match-data
(read-string prompt
(cons (match-string 1) 1)))
nil nil nil 1))
(let ((buffer-read-only nil))
(delete-region (match-beginning 0) (match-end 0))))
(let ((buffer-read-only nil))
(replace-match (save-match-data
(prog1 (let ((buffer-read-only t))
(read-string
prompt
(cons (match-string 1) 1)))
;; If user moved point while editing
;; a comment, restore it and ensure
;; done items section is displayed.
(unless (= (point) opoint)
(todo-category-number ocat)
(let ((todo-show-with-done t))
(todo-category-select)
(goto-char opoint)))))
nil nil nil 1)))
(if comment-delete
(user-error "There is no comment to delete")
(insert " [" todo-comment-string ": "
(prog1 (read-string prompt)
;; If user moved point during editing,
;; make sure it moves back.
(goto-char opoint)
(todo-item-end))
"]")))))
(let ((buffer-read-only nil))
(insert " [" todo-comment-string ": "
(prog1 (let ((buffer-read-only t))
(read-string prompt))
;; If user moved point while inserting a
;; comment, restore it and ensure done items
;; section is displayed.
(unless (= (point) opoint)
(todo-category-number ocat)
(let ((todo-show-with-done t))
(todo-category-select)
(goto-char opoint)))
(todo-item-end))
"]"))))))
(multiline
(let ((buf todo-edit-buffer))
(setq todo-edit-item--cat ocat)
(setq todo-edit-item--pos opoint)
(set-window-buffer (selected-window)
(set-buffer (make-indirect-buffer
(buffer-name) buf)))
@ -2208,10 +2238,14 @@ the item at point."
;; Ensure lines following hard newlines are indented.
(setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]"
"\n\t" new nil nil 1))
;; If user moved point during editing, make sure it moves back.
(goto-char opoint)
(todo-remove-item)
(todo-insert-with-overlays new)
;; If user moved point while editing item, restore it.
(unless (= (point) opoint)
(todo-category-number ocat)
(todo-category-select)
(goto-char opoint))
(let ((buffer-read-only nil))
(todo-remove-item)
(todo-insert-with-overlays new))
(move-to-column item-beg)))))))))
(defun todo-edit-quit ()
@ -2243,6 +2277,9 @@ made in the number or names of categories."
(kill-buffer)
(unless (eq (current-buffer) buf)
(set-window-buffer (selected-window) (set-buffer buf)))
(todo-category-number todo-edit-item--cat)
(todo-category-select)
(goto-char todo-edit-item--pos)
(if transient-mark-mode (deactivate-mark)))
;; We got here via `F e'.
(when (todo-check-format)
@ -2315,117 +2352,118 @@ made in the number or names of categories."
;; If there are marked items, use only the first to set
;; header changes, and apply these to all marked items.
(when first
(cond
((eq what 'date)
(setq ndate (todo-read-date)))
((eq what 'calendar)
(setq ndate (save-match-data (todo-set-date-from-calendar))))
((eq what 'today)
(setq ndate (calendar-date-string (calendar-current-date) t t)))
((eq what 'dayname)
(setq ndate (todo-read-dayname)))
((eq what 'time)
(setq ntime (save-match-data (todo-read-time)))
(when (> (length ntime) 0)
(setq ntime (concat " " ntime))))
;; When date string consists only of a day name,
;; passing other date components is a noop.
((and odayname (memq what '(year month day))))
((eq what 'year)
(setq day oday
monthname omonthname
month omonth
year (cond ((not current-prefix-arg)
(todo-read-date 'year))
((string= oyear "*")
(user-error "Cannot increment *"))
(t
(number-to-string (+ yy inc))))))
((eq what 'month)
(setf day oday
year oyear
(if (memq 'month calendar-date-display-form)
month
monthname)
(cond ((not current-prefix-arg)
(todo-read-date 'month))
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
(let* ((mmo mm)
;; Change by 12 or more months?
(bigincp (>= (abs inc) 12))
;; Month number is in range 1..12.
(mminc (+ mm (% inc 12)))
(mm (% (+ mminc 12) 12))
;; 12n mod 12 = 0, so 0 is December.
(mm (if (= mm 0) 12 mm))
;; Does change in month cross year?
(mmcmp (cond ((< inc 0) (> mm mmo))
((> inc 0) (< mm mmo))))
(yyadjust (if bigincp
(+ (abs (/ inc 12))
(if mmcmp 1 0))
1)))
;; Adjust year if necessary.
(setq yy (cond ((and (< inc 0)
(or mmcmp bigincp))
(- yy yyadjust))
((and (> inc 0)
(or mmcmp bigincp))
(+ yy yyadjust))
(t yy)))
(setq year (number-to-string yy))
;; Return the changed numerical month as
;; a string or the corresponding month name.
(if omonth
(number-to-string mm)
(aref tma-array (1- mm)))))))
;; Since the number corresponding to the arbitrary
;; month name "*" is out of the range of
;; calendar-last-day-of-month, set it to 1
;; (corresponding to January) to allow 31 days.
(let ((mm (if (= mm 13) 1 mm)))
(if (> (string-to-number day)
(calendar-last-day-of-month mm yy))
(user-error "%s %s does not have %s days"
(aref tmn-array (1- mm))
(if (= mm 2) yy "") day))))
((eq what 'day)
(setq year oyear
month omonth
monthname omonthname
day (cond
((not current-prefix-arg)
(todo-read-date 'day mm yy))
((string= oday "*")
(user-error "Cannot increment *"))
((or (string= omonth "*") (string= omonthname "*"))
(setq dd (+ dd inc))
(if (> dd 31)
(user-error
"A month cannot have more than 31 days")
(number-to-string dd)))
;; Increment or decrement day by INC,
;; adjusting month and year if necessary
;; (if year is "*" assume current year to
;; calculate adjustment).
(t
(let* ((yy (or yy (calendar-extract-year
(calendar-current-date))))
(date (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian
(list mm dd yy))
inc)))
(adjmm (nth 0 date)))
;; Set year and month(name) to adjusted values.
(unless (string= year "*")
(setq year (number-to-string (nth 2 date))))
(if month
(setq month (number-to-string adjmm))
(setq monthname (aref tma-array (1- adjmm))))
;; Return changed numerical day as a string.
(number-to-string (nth 1 date)))))))))
(save-match-data
(cond
((eq what 'date)
(setq ndate (todo-read-date)))
((eq what 'calendar)
(setq ndate (todo-set-date-from-calendar)))
((eq what 'today)
(setq ndate (calendar-date-string (calendar-current-date) t t)))
((eq what 'dayname)
(setq ndate (todo-read-dayname)))
((eq what 'time)
(setq ntime (todo-read-time))
(when (> (length ntime) 0)
(setq ntime (concat " " ntime))))
;; When date string consists only of a day name,
;; passing other date components is a noop.
((and odayname (memq what '(year month day))))
((eq what 'year)
(setq day oday
monthname omonthname
month omonth
year (cond ((not current-prefix-arg)
(todo-read-date 'year))
((string= oyear "*")
(user-error "Cannot increment *"))
(t
(number-to-string (+ yy inc))))))
((eq what 'month)
(setf day oday
year oyear
(if (memq 'month calendar-date-display-form)
month
monthname)
(cond ((not current-prefix-arg)
(todo-read-date 'month))
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
(let* ((mmo mm)
;; Change by 12 or more months?
(bigincp (>= (abs inc) 12))
;; Month number is in range 1..12.
(mminc (+ mm (% inc 12)))
(mm (% (+ mminc 12) 12))
;; 12n mod 12 = 0, so 0 is December.
(mm (if (= mm 0) 12 mm))
;; Does change in month cross year?
(mmcmp (cond ((< inc 0) (> mm mmo))
((> inc 0) (< mm mmo))))
(yyadjust (if bigincp
(+ (abs (/ inc 12))
(if mmcmp 1 0))
1)))
;; Adjust year if necessary.
(setq yy (cond ((and (< inc 0)
(or mmcmp bigincp))
(- yy yyadjust))
((and (> inc 0)
(or mmcmp bigincp))
(+ yy yyadjust))
(t yy)))
(setq year (number-to-string yy))
;; Return the changed numerical month as
;; a string or the corresponding month name.
(if omonth
(number-to-string mm)
(aref tma-array (1- mm)))))))
;; Since the number corresponding to the arbitrary
;; month name "*" is out of the range of
;; calendar-last-day-of-month, set it to 1
;; (corresponding to January) to allow 31 days.
(let ((mm (if (= mm 13) 1 mm)))
(if (> (string-to-number day)
(calendar-last-day-of-month mm yy))
(user-error "%s %s does not have %s days"
(aref tmn-array (1- mm))
(if (= mm 2) yy "") day))))
((eq what 'day)
(setq year oyear
month omonth
monthname omonthname
day (cond
((not current-prefix-arg)
(todo-read-date 'day mm yy))
((string= oday "*")
(user-error "Cannot increment *"))
((or (string= omonth "*") (string= omonthname "*"))
(setq dd (+ dd inc))
(if (> dd 31)
(user-error
"A month cannot have more than 31 days")
(number-to-string dd)))
;; Increment or decrement day by INC,
;; adjusting month and year if necessary
;; (if year is "*" assume current year to
;; calculate adjustment).
(t
(let* ((yy (or yy (calendar-extract-year
(calendar-current-date))))
(date (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian
(list mm dd yy))
inc)))
(adjmm (nth 0 date)))
;; Set year and month(name) to adjusted values.
(unless (string= year "*")
(setq year (number-to-string (nth 2 date))))
(if month
(setq month (number-to-string adjmm))
(setq monthname (aref tma-array (1- adjmm))))
;; Return changed numerical day as a string.
(number-to-string (nth 1 date))))))))))
(unless odayname
;; If year, month or day date string components were
;; changed, rebuild the date string.

2
lisp/composite.el
View File

@ -861,7 +861,7 @@ and the second is a glyph for a variation selector."
;; handled in font_range, we end up choosing the Emoji presentation
;; rather than the Text presentation.
(let ((elt '([".." 1 compose-gstring-for-variation-glyph])))
(set-char-table-range composition-function-table '(#xFE00 . #xFE0E) elt)
(set-char-table-range composition-function-table '(#xFE00 . #xFE0D) elt)
(set-char-table-range composition-function-table '(#xE0100 . #xE01EF) elt))
(defun auto-compose-chars (func from to font-object string direction)

19
lisp/emacs-lisp/package.el
View File

@ -3317,6 +3317,18 @@ Values can be interactively added to this list by typing
:version "25.1"
:type '(repeat (regexp :tag "Hide packages with name matching")))
(defcustom package-menu-use-current-if-no-marks t
"Whether \\<package-menu-mode-map>\\[package-menu-execute] in package menu operates on current package if none are marked.
If non-nil, and no packages are marked for installation or
deletion, \\<package-menu-mode-map>\\[package-menu-execute] will operate on the current package at point,
see `package-menu-execute' for details.
The default is t. Set to nil to get back the original behavior
of having `package-menu-execute' signal an error when no packages
are marked for installation or deletion."
:version "29.1"
:type 'boolean)
(defun package-menu--refresh (&optional packages keywords)
"Re-populate the `tabulated-list-entries'.
PACKAGES should be nil or t, which means to display all known packages.
@ -3760,8 +3772,8 @@ object corresponding to the newer version."
(and avail-pkg
(version-list-< (package-desc-priority-version pkg-desc)
(package-desc-priority-version avail-pkg))
(xor (not package-install-upgrade-built-in)
(package--active-built-in-p pkg-desc))
(or (not (package--active-built-in-p pkg-desc))
package-install-upgrade-built-in)
(push (cons name avail-pkg) upgrades))))
upgrades))
@ -3946,7 +3958,8 @@ invocations."
;; Nothing marked.
(unless (or delete-list install-list)
;; Not on a package line.
(unless (tabulated-list-get-id)
(unless (and (tabulated-list-get-id)
package-menu-use-current-if-no-marks)
(user-error "No operations specified"))
(let* ((id (tabulated-list-get-id))
(status (package-menu-get-status)))

6
lisp/info-look.el
View File

@ -733,7 +733,11 @@ Return nil if there is nothing appropriate in the buffer near point."
(let ((str (string-join str-list " ")))
(when (assoc str completions)
(throw 'result str))
(nbutlast str-list)))))))
;; 'nbutlast' will not destructively set its argument
;; to nil when the argument is a list of 1 element.
(if (= (length str-list) 1)
(setq str-list nil)
(nbutlast str-list))))))))
(error nil)))
;;;###autoload

13
lisp/net/browse-url.el
View File

@ -825,10 +825,17 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
(&optional localp no-error-if-not-filep))
;;;###autoload
(defun browse-url-of-dired-file ()
"In Dired, ask a WWW browser to display the file named on this line."
(interactive)
(defun browse-url-of-dired-file (&optional secondary)
"In Dired, ask a WWW browser to display the file named on this line.
With prefix arg, use the secondary browser instead (e.g. EWW if
`browse-url-secondary-browser-function' is set to
`eww-browse-url'."
(interactive "P")
(let ((tem (dired-get-filename t t))
(browse-url-browser-function
(if secondary
browse-url-secondary-browser-function
browse-url-browser-function))
;; Some URL handlers open files in Emacs. We want to always
;; open in a browser, so disable those.
(browse-url-default-handlers nil))

203
lisp/plstore.el
View File

@ -24,6 +24,14 @@
;; Plist based data store providing search and partial encryption.
;;
;; By default, this package uses symmetric encryption, which means
;; that you have to enter the password protecting your store more
;; often than you probably expect to. To use public key encryption
;; with this package, create a GnuPG key and customize user option
;; `plstore-encrypt-to' to use it. You can then configure the GnuPG
;; agent to adjust caching and expiration of the passphrase for your
;; store.
;;
;; Creating:
;;
;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
@ -43,12 +51,16 @@
;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
;; (plstore-close store)
;;
;; Avoid marking one property both as public *and* secret, as the
;; behavior of this package with respect to such duplicate properties
;; is not (yet) defined.
;;
;; Searching:
;;
;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
;;
;; ;; As the entry "foo" associated with "foo.example.org" has no
;; ;; secret properties, no need to decryption.
;; ;; secret properties, no need for decryption.
;; (plstore-find store '(:host ("foo.example.org")))
;;
;; ;; As the entry "bar" associated with "bar.example.org" has a
@ -66,17 +78,119 @@
;; Editing:
;;
;; This file also provides `plstore-mode', a major mode for editing
;; the PLSTORE format file. Visit a non-existing file and put the
;; the plstore format file. Visit a non-existing file and put the
;; following line:
;;
;; (("foo" :host "foo.example.org" :secret-user "user"))
;;
;; where the prefixing `:secret-' means the property (without
;; `:secret-' prefix) is marked as secret. Thus, when you save the
;; buffer, the `:secret-user' property is encrypted as `:user'.
;; buffer, the `:secret-user' property is encrypted as `:user'. Do
;; not use a property consisting solely of the prefix, as the behavior
;; of this package with respect to such properties is not (yet)
;; defined.
;;
;; You can toggle the view between encrypted form and the decrypted
;; form with C-c C-c.
;;
;; If you have opened a plstore with `plstore-open' you should not
;; edit its underlying buffer in `plstore-mode' or in any other way at
;; the same time, since your manual changes will be overwritten when
;; `plstore-save' is called on that plstore.
;;
;; Internals:
;;
;; This is information on the internal data structure and functions of
;; this package. None of it should be necessary to actually use it.
;; For easier reading, we usually do not distinguish in this internal
;; documentation between a Lisp object and its printed representation.
;;
;; A plstore corresponds to an alist mapping strings to property
;; lists. Internally, that alist is organized as two alists, one
;; mapping to the non-secret properties and placeholders for the
;; secret properties (called "template alist" with identifier ALIST)
;; and one mapping to the secret properties ("secret alist",
;; SECRET-ALIST). The secret alist is read from and written to file
;; as pgp-encrypted printed representation of the alist ("encrypted
;; data", ENCRYPTED-DATA).
;;
;; During the lifetime of a plstore, a third type of alist may pop up,
;; which maps to the merged non-secret properties and plain-text
;; secret properties ("merged alist", MERGED-ALIST).
;;
;; After executing the "foo", "bar", "baz" example from above the
;; alists described above look like the following:
;;
;; Template Alist:
;;
;; (("foo" :host "foo.example.org" :port 80)
;; ("bar" :secret-user t :host "bar.example.org")
;; ("baz" :secret-password t :host "baz.example.org"))
;;
;; Secret Alist:
;;
;; (("bar" :user "test")
;; ("baz" :password "test"))
;;
;; Merged Alist:
;;
;; (("foo" :host "foo.example.org" :port 80)
;; ("bar" :user "test" :host "bar.example.org")
;; ("baz" :password "test" :host "baz.example.org"))
;;
;; Finally, a plstore requires a buffer ("plstore buffer", BUFFER) for
;; conversion between its Lisp objects and its file representation.
;; It is important to note that this buffer is *not* continuously
;; synchronized as the plstore changes. During the lifetime of a
;; plstore, its buffer is read from in function `plstore-open' and
;; (destructively) written to in `plstore-save', but not touched
;; otherwise. We call the file visited by the plstore buffer the
;; associated file of the plstore.
;;
;; With the identifiers defined above a plstore is a vector with the
;; following elements and accessor functions:
;;
;; [
;; BUFFER ; plstore--get/set-buffer
;; ALIST ; plstore--get/set-alist
;; ENCRYPTED-DATA ; plstore--get/set-encrypted-data
;; SECRET-ALIST ; plstore--get/set-secret-alist
;; MERGED-ALIST ; plstore--get/set-merged-alist
;; ]
;;
;; When a plstore is created through `plstore-open', its ALIST and
;; ENCRYPTED-DATA are initialized from the contents of BUFFER without
;; any decryption taking place, and MERGED-ALIST is initialized as a
;; copy of ALIST. (Which means that at that stage the merged alist
;; still contains the secret property placeholders!)
;;
;; During on-demand decryption of a plstore through function
;; `plstore--decrypt', SECRET-ALIST is populated from ENCRYPTED-DATA,
;; which is in turn replaced by value nil. (Which further serves as
;; an indicator that the plstore has been decrypted already.) In
;; addition, MERGED-ALIST is recomputed by function
;; `plstore--merge-secret' to replace the secret property placeholders
;; by their plain-text secret property equivalents.
;;
;; The file representation of a plstore consists of two Lisp forms plus
;; markers to introduce them:
;;
;; ;;; public entries
;; ALIST
;; ;;; secret entries
;; ENCRYPTED-DATA
;;
;; Both of these are optional, but the first section must be present
;; if the second one is. If both sections are missing, the plstore is
;; empty. If the second section is missing, it contains only
;; non-secret data. If present, the printed representation of the
;; encrypted data includes the delimiting double quotes.
;;
;; The plstore API (`plstore-open', `plstore-put', etc.) and the
;; plstore mode implemented by `plstore-mode' are orthogonal to each
;; other and should not be mixed up. In particular, encoding and
;; decoding a plstore mode buffer with `plstore-mode-toggle-display'
;; is not related in any way to the state of the plstore buffer.
;;; Code:
@ -121,10 +235,13 @@ symmetric encryption will be used."
(put 'plstore-encrypt-to 'permanent-local t)
(defvar plstore-encoded nil)
(defvar plstore-encoded nil
"Non-nil if the current buffer shows the decoded alist.") ; [sic!]
(put 'plstore-encoded 'permanent-local t)
;;; EasyPG callback functions.
(defvar plstore-cache-passphrase-for-symmetric-encryption nil)
(defvar plstore-passphrase-alist nil)
@ -141,11 +258,11 @@ symmetric encryption will be used."
(cons entry
plstore-passphrase-alist)))
(setq passphrase
(read-passwd (format "Passphrase for PLSTORE %s: "
(read-passwd (format "Passphrase for plstore %s: "
(plstore--get-buffer plstore))))
(setcdr entry (copy-sequence passphrase))
passphrase)))
(read-passwd (format "Passphrase for PLSTORE %s: "
(read-passwd (format "Passphrase for plstore %s: "
(plstore--get-buffer plstore)))))
(defun plstore-progress-callback-function (_context _what _char current total
@ -155,6 +272,8 @@ symmetric encryption will be used."
(message "%s...%d%%" handback
(if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
;;; Core functions.
(defun plstore--get-buffer (arg)
(aref arg 0))
@ -193,6 +312,7 @@ symmetric encryption will be used."
(vector buffer alist encrypted-data secret-alist merged-alist))
(defun plstore--init-from-buffer (plstore)
"Parse current buffer and initialize PLSTORE from it."
(goto-char (point-min))
(when (looking-at ";;; public entries")
(forward-line)
@ -223,16 +343,20 @@ symmetric encryption will be used."
store)))
(defun plstore-revert (plstore)
"Replace current data in PLSTORE with the file on disk."
"Replace current data in PLSTORE from its associated file."
(with-current-buffer (plstore--get-buffer plstore)
(revert-buffer t t)
(plstore--init-from-buffer plstore)))
(defun plstore-close (plstore)
"Destroy a plstore instance PLSTORE."
"Destroy plstore instance PLSTORE."
(kill-buffer (plstore--get-buffer plstore)))
(defun plstore--merge-secret (plstore)
"Determine the merged alist of PLSTORE.
Create the merged alist as a copy of the template alist with all
placeholder properties that have corresponding properties in the
secret alist replaced by their plain-text secret properties."
(let ((alist (plstore--get-secret-alist plstore))
modified-alist
modified-plist
@ -251,19 +375,26 @@ symmetric encryption will be used."
modified-entry (assoc (car entry) modified-alist)
modified-plist (cdr modified-entry))
(while plist
;; Search for a placeholder property in the merged alist
;; corresponding to the current secret property.
(setq placeholder
(plist-member
modified-plist
(intern (concat ":secret-"
(substring (symbol-name (car plist)) 1)))))
;; Replace its name with the real, secret property name.
(if placeholder
(setcar placeholder (car plist)))
;; Update its value to the plain-text secret property value.
(setq modified-plist
(plist-put modified-plist (car plist) (car (cdr plist))))
(setq plist (nthcdr 2 plist)))
(setcdr modified-entry modified-plist))))
(defun plstore--decrypt (plstore)
"Decrypt the encrypted data of PLSTORE.
Update its internal alists and other data structures
accordingly."
(if (plstore--get-encrypted-data plstore)
(let ((context (epg-make-context 'OpenPGP))
plain)
@ -290,6 +421,11 @@ symmetric encryption will be used."
(plstore--set-encrypted-data plstore nil))))
(defun plstore--match (entry keys skip-if-secret-found)
"Return whether plist KEYS matches ENTRY.
ENTRY should be a key of the merged alist of a PLSTORE. This
function returns nil if KEYS do not match ENTRY, t if they match,
and symbol `secret' if the secret alist needs to be consulted to
perform a match."
(let ((result t) key-name key-value prop-value secret-name)
(while keys
(setq key-name (car keys)
@ -311,11 +447,10 @@ symmetric encryption will be used."
result))
(defun plstore-find (plstore keys)
"Perform search on PLSTORE with KEYS.
KEYS is a plist."
"Return all PLSTORE entries matching plist KEYS."
(let (entries alist entry match decrypt plist)
;; First, go through the merged plist alist and collect entries
;; matched with keys.
;; First, go through the merged alist and collect entries matched
;; by the keys.
(setq alist (plstore--get-merged-alist plstore))
(while alist
(setq entry (car alist)
@ -331,7 +466,7 @@ KEYS is a plist."
plist nil))
(setq plist (nthcdr 2 plist)))
(setq entries (cons entry entries)))))
;; Second, decrypt the encrypted plist and try again.
;; Second, decrypt the plstore and try again.
(when decrypt
(setq entries nil)
(plstore--decrypt plstore)
@ -345,7 +480,8 @@ KEYS is a plist."
(nreverse entries)))
(defun plstore-get (plstore name)
"Get an entry with NAME in PLSTORE."
"Return the entry named NAME in PLSTORE.
Return nil if there is none."
(let ((entry (assoc name (plstore--get-merged-alist plstore)))
plist)
(setq plist (cdr entry))
@ -359,7 +495,7 @@ KEYS is a plist."
entry))
(defun plstore-put (plstore name keys secret-keys)
"Put an entry with NAME in PLSTORE.
"Put an entry named NAME in PLSTORE.
KEYS is a plist containing non-secret data.
SECRET-KEYS is a plist containing secret data."
(let (entry
@ -398,7 +534,7 @@ SECRET-KEYS is a plist containing secret data."
(plstore--merge-secret plstore)))
(defun plstore-delete (plstore name)
"Delete an entry with NAME from PLSTORE."
"Delete the first entry named NAME from PLSTORE."
(let ((entry (assoc name (plstore--get-alist plstore))))
(if entry
(plstore--set-alist
@ -417,6 +553,8 @@ SECRET-KEYS is a plist containing secret data."
(defvar pp-escape-newlines)
(defun plstore--insert-buffer (plstore)
"Insert the file representation of PLSTORE at point.
Assumes that PLSTORE has been decrypted."
(insert ";;; public entries -*- mode: plstore -*- \n"
(pp-to-string (plstore--get-alist plstore)))
(if (plstore--get-secret-alist plstore)
@ -451,13 +589,31 @@ If no one is selected, symmetric encryption will be performed. "
(insert ";;; secret entries\n" (pp-to-string cipher)))))
(defun plstore-save (plstore)
"Save the contents of PLSTORE associated with a FILE."
"Save PLSTORE to its associated file."
(with-current-buffer (plstore--get-buffer plstore)
(erase-buffer)
(plstore--insert-buffer plstore)
(save-buffer)))
;;; plstore mode.
;; The functions related to plstore mode unfortunately introduce yet
;; another alist format ("decoded alist"). After executing the "foo",
;; "bar", "baz" example from above the decoded alist of the plstore
;; would look like the following:
;;
;; (("foo" :host "foo.example.org" :port 80)
;; ("bar" :secret-user "test" :host "bar.example.org")
;; ("baz" :secret-password "test" :host "baz.example.org"))
;;
;; Even more unfortunately, variable and function names of the
;; following are a bit mixed up IMHO: With the current names, the
;; result of function `plstore--encode' is used to create what is
;; presented as "decoded form of a plstore" to the user. And variable
;; `plstore-encoded' is non-nil if a buffer shows the decoded form.
(defun plstore--encode (plstore)
"Return the printed representation of the decoded alist of PLSTORE."
(plstore--decrypt plstore)
(let ((merged-alist (plstore--get-merged-alist plstore)))
(concat "("
@ -482,6 +638,9 @@ If no one is selected, symmetric encryption will be performed. "
")")))
(defun plstore--decode (string)
"Create a plstore instance from STRING.
STRING should be the printed representation of a decoded alist of
some plstore."
(let* ((alist (car (read-from-string string)))
(pointer alist)
secret-alist
@ -489,7 +648,7 @@ If no one is selected, symmetric encryption will be performed. "
entry)
(while pointer
(unless (stringp (car (car pointer)))
(error "Invalid PLSTORE format %s" string))
(error "Invalid plstore format %s" string))
(setq plist (cdr (car pointer)))
(while plist
(when (string-match "\\`:secret-" (symbol-name (car plist)))
@ -509,6 +668,10 @@ If no one is selected, symmetric encryption will be performed. "
(plstore--make nil alist nil secret-alist)))
(defun plstore--write-contents-functions ()
"Convert the decoded form of a plstore in the current buffer.
Convert it to the regular file representation of a plstore if
needed. This function is used on hook `write-contents-functions'
in plstore mode buffers."
(when plstore-encoded
(let ((store (plstore--decode (buffer-string)))
(file (buffer-file-name)))
@ -546,7 +709,7 @@ If no one is selected, symmetric encryption will be performed. "
(erase-buffer)
(insert
(substitute-command-keys "\
;;; You are looking at the decoded form of the PLSTORE file.\n\
;;; You are looking at the decoded form of the plstore file.\n\
;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n"))
(insert (plstore--encode store))
(set-buffer-modified-p nil)
@ -561,7 +724,7 @@ If no one is selected, symmetric encryption will be performed. "
;;;###autoload
(define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE"
"Major mode for editing PLSTORE files."
"Major mode for editing plstore files."
(make-local-variable 'plstore-encoded)
(add-hook 'write-contents-functions #'plstore--write-contents-functions)
(define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display)

5
lisp/progmodes/dockerfile-ts-mode.el
View File

@ -123,8 +123,9 @@ continuation to the previous entry."
(let* ((node (treesit-buffer-root-node))
(stage-tree (treesit-induce-sparse-tree
node "from_instruction"
nil 1000)))
`(("Stage" . ,(dockerfile-ts-mode--imenu-1 stage-tree)))))
nil 1000))
(stage-index (dockerfile-ts-mode--imenu-1 stage-tree)))
(when stage-index `(("Stage" . ,stage-index)))))
(defun dockerfile-ts-mode--imenu-1 (node)
"Helper for `dockerfile-ts-mode--imenu'.

1
lisp/progmodes/go-ts-mode.el
View File

@ -59,6 +59,7 @@
(modify-syntax-entry ?< "." table)
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?/ ". 124b" table)
(modify-syntax-entry ?* ". 23" table)
(modify-syntax-entry ?\n "> b" table)

3
lisp/progmodes/java-ts-mode.el
View File

@ -226,6 +226,9 @@ the available version of Tree-sitter for java."
(constructor_declaration
name: (identifier) @font-lock-type-face)
(compact_constructor_declaration
name: (identifier) @font-lock-type-face)
(field_access
object: (identifier) @font-lock-type-face)

4
lisp/progmodes/project.el
View File

@ -816,8 +816,8 @@ DIRS must contain directory names."
(push buf bufs)))
(nreverse bufs)))
(cl-defmethod project-name ((_project (head vc)))
(or project-vc-name
(cl-defmethod project-name ((project (head vc)))
(or (project--value-in-dir 'project-vc-name (project-root project))
(cl-call-next-method)))

52
lisp/progmodes/python.el
View File

@ -415,7 +415,6 @@ instead."
"Python mode specialized rx macro.
This variant of `rx' supports common Python named REGEXPS."
`(rx-let ((sp-bsnl (or space (and ?\\ ?\n)))
(sp-nl (or space (and (? ?\\) ?\n)))
(block-start (seq symbol-start
(or "def" "class" "if" "elif" "else" "try"
"except" "finally" "for" "while" "with"
@ -650,9 +649,9 @@ the {...} holes that appear within f-strings."
finally return (and result-valid result))))
(defvar python-font-lock-keywords-level-1
`((,(python-rx symbol-start "def" (1+ sp-bsnl) (group symbol-name))
`((,(python-rx symbol-start "def" (1+ space) (group symbol-name))
(1 font-lock-function-name-face))
(,(python-rx symbol-start "class" (1+ sp-bsnl) (group symbol-name))
(,(python-rx symbol-start "class" (1+ space) (group symbol-name))
(1 font-lock-type-face)))
"Font lock keywords to use in `python-mode' for level 1 decoration.
@ -792,12 +791,12 @@ sign in chained assignment."
;; [*a] = 5, 6
;; are handled separately below
(,(python-font-lock-assignment-matcher
(python-rx (? (or "[" "(") (* sp-nl))
grouped-assignment-target (* sp-nl) ?, (* sp-nl)
(* assignment-target (* sp-nl) ?, (* sp-nl))
(? assignment-target (* sp-nl))
(? ?, (* sp-nl))
(? (or ")" "]") (* sp-bsnl))
(python-rx (? (or "[" "(") (* space))
grouped-assignment-target (* space) ?, (* space)
(* assignment-target (* space) ?, (* space))
(? assignment-target (* space))
(? ?, (* space))
(? (or ")" "]") (* space))
(group assignment-operator)))
(1 font-lock-variable-name-face)
(2 'font-lock-operator-face)
@ -813,9 +812,9 @@ sign in chained assignment."
;; c: Collection = {1, 2, 3}
;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'}
(,(python-font-lock-assignment-matcher
(python-rx (or line-start ?\;) (* sp-bsnl)
grouped-assignment-target (* sp-bsnl)
(? ?: (* sp-bsnl) (+ not-simple-operator) (* sp-bsnl))
(python-rx (or line-start ?\;) (* space)
grouped-assignment-target (* space)
(? ?: (* space) (+ not-simple-operator) (* space))
(group assignment-operator)))
(1 font-lock-variable-name-face)
(2 'font-lock-operator-face))
@ -824,10 +823,10 @@ sign in chained assignment."
;; [a] = 5,
;; [*a] = 5, 6
(,(python-font-lock-assignment-matcher
(python-rx (or line-start ?\; ?=) (* sp-bsnl)
(or "[" "(") (* sp-nl)
grouped-assignment-target (* sp-nl)
(or ")" "]") (* sp-bsnl)
(python-rx (or line-start ?\; ?=) (* space)
(or "[" "(") (* space)
grouped-assignment-target (* space)
(or ")" "]") (* space)
(group assignment-operator)))
(1 font-lock-variable-name-face)
(2 'font-lock-operator-face))
@ -869,22 +868,6 @@ decorators, exceptions, and assignments.")
Which one will be chosen depends on the value of
`font-lock-maximum-decoration'.")
(defvar font-lock-beg)
(defvar font-lock-end)
(defun python-font-lock-extend-region ()
"Extend font-lock region to statement boundaries."
(let ((beg font-lock-beg)
(end font-lock-end))
(goto-char beg)
(python-nav-beginning-of-statement)
(beginning-of-line)
(when (< (point) beg)
(setq font-lock-beg (point)))
(goto-char end)
(python-nav-end-of-statement)
(when (< end (point))
(setq font-lock-end (point)))
(or (/= beg font-lock-beg) (/= end font-lock-end))))
(defconst python-syntax-propertize-function
(syntax-propertize-rules
@ -6171,7 +6154,8 @@ Optional argument REGEXP selects variables to clone and defaults
to \"^python-\"."
(mapc
(lambda (pair)
(and (symbolp (car pair))
(and (consp pair)
(symbolp (car pair))
(string-match (or regexp "^python-")
(symbol-name (car pair)))
(set (make-local-variable (car pair))
@ -6769,8 +6753,6 @@ implementations: `python-mode' and `python-ts-mode'."
nil nil nil nil
(font-lock-syntactic-face-function
. python-font-lock-syntactic-face-function)))
(add-hook 'font-lock-extend-region-functions
#'python-font-lock-extend-region nil t)
(setq-local syntax-propertize-function
python-syntax-propertize-function)
(setq-local imenu-create-index-function

16
lisp/progmodes/rust-ts-mode.el
View File

@ -350,7 +350,12 @@ Return nil if there is no name or if NODE is not a defun node."
(treesit-node-child-by-field-name node "name") t))))
(defun rust-ts-mode--syntax-propertize (beg end)
"Apply syntax text property to template delimiters between BEG and END.
"Apply syntax properties to special characters between BEG and END.
Apply syntax properties to various special characters with
contextual meaning between BEG and END.
The apostrophe \\=' should be treated as string when used for char literals.
< and > are usually punctuation, e.g., as greater/less-than. But
when used for types, they should be considered pairs.
@ -359,11 +364,18 @@ This function checks for < and > in the changed RANGES and apply
appropriate text property to alter the syntax of template
delimiters < and >'s."
(goto-char beg)
(while (search-forward "'" end t)
(when (string-equal "char_literal"
(treesit-node-type
(treesit-node-at (match-beginning 0))))
(put-text-property (match-beginning 0) (match-end 0)
'syntax-table (string-to-syntax "\""))))
(goto-char beg)
(while (re-search-forward (rx (or "<" ">")) end t)
(pcase (treesit-node-type
(treesit-node-parent
(treesit-node-at (match-beginning 0))))
("type_arguments"
((or "type_arguments" "type_parameters")
(put-text-property (match-beginning 0)
(match-end 0)
'syntax-table

2
lisp/progmodes/typescript-ts-mode.el
View File

@ -128,7 +128,7 @@ Argument LANGUAGE is either `typescript' or `tsx'."
"case" "catch" "class" "const" "continue" "debugger"
"declare" "default" "delete" "do" "else" "enum"
"export" "extends" "finally" "for" "from" "function"
"get" "if" "implements" "import" "in" "instanceof" "interface"
"get" "if" "implements" "import" "in" "instanceof" "interface" "is"
"keyof" "let" "namespace" "new" "of" "private" "protected"
"public" "readonly" "return" "set" "static" "switch"
"target" "throw" "try" "type" "typeof" "var" "void"

3
lisp/simple.el
View File

@ -1520,7 +1520,8 @@ the actual saved text might be different from what was killed."
(let ((from (car cmp))
(to (cadr cmp)))
(cond
((= (length cmp) 2) ; static composition
((and (= (length cmp) 3) ; static composition
(booleanp (nth 2 cmp)))
to)
;; TO can be at POS, in which case we want
;; to make sure we advance at least by 1

1
lisp/textmodes/enriched.el
View File

@ -192,6 +192,7 @@ The value is a list of \(VAR VALUE VAR VALUE...).")
(define-key map "\C-c[" #'set-left-margin)
(define-key map "\C-c]" #'set-right-margin)
(define-key map "\M-o" #'facemenu-keymap)
(define-key map "\M-om" #'enriched-toggle-markup)
map)
"Keymap for Enriched mode.")

11
lisp/tmm.el
View File

@ -170,9 +170,11 @@ instead of executing it."
(error "Empty menu reached"))
(and tmm-km-list
(let ((index-of-default 0))
(if tmm-mid-prompt
(setq tmm-km-list (tmm-add-shortcuts tmm-km-list))
t)
(setq tmm-km-list
(if tmm-mid-prompt
(tmm-add-shortcuts tmm-km-list)
;; tmm-add-shortcuts reverses tmm-km-list internally.
(reverse tmm-km-list)))
;; Find the default item's index within the menu bar.
;; We use this to decide the initial minibuffer contents
;; and initial history position.
@ -327,7 +329,8 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(with-current-buffer standard-output
(goto-char (point-min))
(let* (;; First candidate: first string with mouse-face
(menu-start-1 (next-single-char-property-change (point) 'mouse-face))
(menu-start-1 (or (and (get-text-property (point) 'mouse-face) (point))
(next-single-char-property-change (point) 'mouse-face)))
;; Second candidate: an inactive menu item with tmm-inactive face
(tps-result (save-excursion
(text-property-search-forward 'face 'tmm-inactive t)))

19
lisp/transient.el
View File

@ -6,7 +6,7 @@
;; URL: https://github.com/magit/transient
;; Keywords: extensions
;; Package-Version: 0.4.0
;; Package-Version: 0.4.1
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@ -1643,6 +1643,7 @@ of the corresponding object."
"<transient-history-prev>" #'transient--do-stay
"<transient-history-next>" #'transient--do-stay
"<universal-argument>" #'transient--do-stay
"<universal-argument-more>" #'transient--do-stay
"<negative-argument>" #'transient--do-minus
"<digit-argument>" #'transient--do-stay
"<top-level>" #'transient--do-quit-all
@ -3043,10 +3044,12 @@ prompt."
(progn
(cl-call-next-method obj value)
(dolist (arg incomp)
(when-let ((obj (cl-find-if (lambda (obj)
(and (slot-boundp obj 'argument)
(equal (oref obj argument) arg)))
transient--suffixes)))
(when-let ((obj (cl-find-if
(lambda (obj)
(and (slot-exists-p obj 'argument)
(slot-boundp obj 'argument)
(equal (oref obj argument) arg)))
transient--suffixes)))
(let ((transient--unset-incompatible nil))
(transient-infix-set obj nil)))))
(cl-call-next-method obj value))))
@ -3253,6 +3256,8 @@ have a history of their own.")
(with-current-buffer buf
(when transient-enable-popup-navigation
(setq focus (or (button-get (point) 'command)
(and (not (bobp))
(button-get (1- (point)) 'command))
(transient--heading-at-point))))
(erase-buffer)
(setq window-size-fixed t)
@ -3384,7 +3389,9 @@ have a history of their own.")
(insert ?\n)
(insert (propertize " " 'display
`(space :align-to (,(nth (1+ c) cc)))))))
(insert (make-string (max 1 (- (nth c cc) (current-column))) ?\s))
(when (> c 0)
(insert (make-string (max 1 (- (nth c cc) (current-column)))
?\s)))
(when-let ((cell (nth r (nth c columns))))
(insert cell))
(when (= c (1- cs))

2
test/infra/Dockerfile.emba
View File

@ -29,7 +29,7 @@ FROM debian:bullseye as emacs-base
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \
libdbus-1-dev libacl1-dev acl git texinfo gdb \
libdbus-1-dev libacl1-dev acl git texinfo gawk gdb \
&& rm -rf /var/lib/apt/lists/*
FROM emacs-base as emacs-inotify

144
test/lisp/progmodes/python-tests.el
View File

@ -136,20 +136,6 @@ STRING, it is skipped so the next STRING occurrence is selected."
while pos
collect (cons pos (get-text-property pos 'face))))
(defun python-tests-assert-faces-after-change (content faces search replace)
"Assert that font faces for CONTENT are equal to FACES after change.
All occurrences of SEARCH are changed to REPLACE."
(python-tests-with-temp-buffer
content
;; Force enable font-lock mode without jit-lock.
(rename-buffer "*python-font-lock-test*" t)
(let (noninteractive font-lock-support-mode)
(font-lock-mode))
(while
(re-search-forward search nil t)
(replace-match replace))
(should (equal faces (python-tests-get-buffer-faces)))))
(defun python-tests-self-insert (char-or-str)
"Call `self-insert-command' for chars in CHAR-OR-STR."
(let ((chars
@ -297,13 +283,6 @@ p = (1 + 2)
"def 1func():"
'((1 . font-lock-keyword-face) (4))))
(ert-deftest python-font-lock-keywords-level-1-3 ()
(python-tests-assert-faces
"def \\
func():"
'((1 . font-lock-keyword-face) (4)
(15 . font-lock-function-name-face) (19))))
(ert-deftest python-font-lock-assignment-statement-1 ()
(python-tests-assert-faces
"a, b, c = 1, 2, 3"
@ -495,129 +474,6 @@ def f(x: CustomInt) -> CustomInt:
(136 . font-lock-operator-face) (137)
(144 . font-lock-keyword-face) (150))))
(ert-deftest python-font-lock-assignment-statement-multiline-1 ()
(python-tests-assert-faces-after-change
"
[
a,
b
] # (
1,
2
)
"
'((1)
(8 . font-lock-variable-name-face) (9)
(15 . font-lock-variable-name-face) (16)
(19 . font-lock-operator-face) (20))
"#" "="))
(ert-deftest python-font-lock-assignment-statement-multiline-2 ()
(python-tests-assert-faces-after-change
"
[
*a
] # 5, 6
"
'((1)
(8 . font-lock-operator-face)
(9 . font-lock-variable-name-face) (10)
(13 . font-lock-operator-face) (14))
"#" "="))
(ert-deftest python-font-lock-assignment-statement-multiline-3 ()
(python-tests-assert-faces-after-change
"a\\
,\\
b\\
,\\
c\\
#\\
1\\
,\\
2\\
,\\
3"
'((1 . font-lock-variable-name-face) (2)
(15 . font-lock-variable-name-face) (16)
(29 . font-lock-variable-name-face) (30)
(36 . font-lock-operator-face) (37))
"#" "="))
(ert-deftest python-font-lock-assignment-statement-multiline-4 ()
(python-tests-assert-faces-after-change
"a\\
:\\
int\\
#\\
5"
'((1 . font-lock-variable-name-face) (2)
(15 . font-lock-builtin-face) (18)
(24 . font-lock-operator-face) (25))
"#" "="))
(ert-deftest python-font-lock-assignment-statement-multiline-5 ()
(python-tests-assert-faces-after-change
"(\\
a\\
)\\
#\\
5\\
;\\
(\\
b\\
)\\
#\\
6"
'((1)
(8 . font-lock-variable-name-face) (9)
(18 . font-lock-operator-face) (19)
(46 . font-lock-variable-name-face) (47)
(60 . font-lock-operator-face) (61))
"#" "="))
(ert-deftest python-font-lock-assignment-statement-multiline-6 ()
(python-tests-assert-faces-after-change
"(
a
)\\
#\\
5\\
;\\
(
b
)\\
#\\
6"
'((1)
(7 . font-lock-variable-name-face) (8)
(16 . font-lock-operator-face) (17)
(43 . font-lock-variable-name-face) (44)
(56 . font-lock-operator-face) (57))
"#" "="))
(ert-deftest python-font-lock-operator-1 ()
(python-tests-assert-faces
"1 << 2 ** 3 == +4%-5|~6&7^8%9"
'((1)
(3 . font-lock-operator-face) (5)
(8 . font-lock-operator-face) (10)
(13 . font-lock-operator-face) (15)
(16 . font-lock-operator-face) (17)
(18 . font-lock-operator-face) (20)
(21 . font-lock-operator-face) (23)
(24 . font-lock-operator-face) (25)
(26 . font-lock-operator-face) (27)
(28 . font-lock-operator-face) (29))))
(ert-deftest python-font-lock-operator-2 ()
"Keyword operators are font-locked as keywords."
(python-tests-assert-faces
"is_ is None"
'((1)
(5 . font-lock-keyword-face) (7)
(8 . font-lock-constant-face))))
(ert-deftest python-font-lock-escape-sequence-string-newline ()
(python-tests-assert-faces
"'\\n'