aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorVibhav Pant2017-02-11 19:54:37 +0530
committerVibhav Pant2017-02-11 19:54:37 +0530
commitc1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3 (patch)
treea33cb8c57d628541baee88bef5b0907327056e88
parenta75d080b17a6b6c6296ff4e24d8129d77bb3bb6b (diff)
parentac83b2dfe4504babfbafc5efb37dbde4bed34fed (diff)
downloademacs-c1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3.tar.gz
emacs-c1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3.zip
Merge branch 'master' into feature/byte-switch
-rw-r--r--Makefile.in8
-rw-r--r--doc/emacs/search.texi8
-rw-r--r--etc/NEWS10
-rw-r--r--etc/themes/tsdh-light-theme.el21
-rw-r--r--lisp/descr-text.el16
-rw-r--r--lisp/emacs-lisp/edebug.el6
-rw-r--r--lisp/eshell/esh-proc.el16
-rw-r--r--lisp/gnus/gnus-msg.el6
-rw-r--r--lisp/gnus/gnus.el4
-rw-r--r--lisp/gnus/mm-decode.el19
-rw-r--r--lisp/ibuf-ext.el46
-rw-r--r--lisp/ibuf-macs.el10
-rw-r--r--lisp/ibuffer.el10
-rw-r--r--lisp/info.el7
-rw-r--r--lisp/isearch.el8
-rw-r--r--lisp/progmodes/bat-mode.el11
-rw-r--r--lisp/progmodes/grep.el26
-rw-r--r--lisp/simple.el3
-rw-r--r--lisp/textmodes/css-mode.el2
-rw-r--r--lisp/xdg.el144
-rw-r--r--src/composite.c89
-rw-r--r--src/data.c6
-rw-r--r--src/dispextern.h2
-rw-r--r--src/fns.c262
-rw-r--r--src/image.c16
-rw-r--r--src/keyboard.c25
-rw-r--r--src/lisp.h75
-rw-r--r--src/xdisp.c52
-rw-r--r--src/xfaces.c2
-rw-r--r--src/xwidget.c12
-rw-r--r--test/lisp/filenotify-tests.el4
-rw-r--r--test/lisp/progmodes/bat-mode-tests.el86
-rw-r--r--test/src/fns-tests.el298
33 files changed, 964 insertions, 346 deletions
diff --git a/Makefile.in b/Makefile.in
index 60f30b993a3..807a40a2844 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -1011,12 +1011,10 @@ info_dir_deps = \
1011## slow down parallelization. 1011## slow down parallelization.
1012${srcdir}/info/dir: ${info_dir_deps} 1012${srcdir}/info/dir: ${info_dir_deps}
1013 $(AM_V_at)${MKDIR_P} ${srcdir}/info 1013 $(AM_V_at)${MKDIR_P} ${srcdir}/info
1014 $(AM_V_GEN)tempfile=info-dir.$$$$; \ 1014 $(AM_V_GEN)(cd ${srcdir}/doc && \
1015 rm -f $${tempfile}; \
1016 (cd ${srcdir}/doc && \
1017 AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \ 1015 AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \
1018 ) >$$tempfile && \ 1016 ) >$@.tmp
1019 ${srcdir}/build-aux/move-if-change $${tempfile} ${srcdir}/info/dir 1017 mv $@.tmp $@
1020 1018
1021INSTALL_DVI = install-emacs-dvi install-lispref-dvi \ 1019INSTALL_DVI = install-emacs-dvi install-lispref-dvi \
1022 install-lispintro-dvi install-misc-dvi 1020 install-lispintro-dvi install-misc-dvi
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index fa69ba48f6a..77baae2a8f7 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -609,6 +609,8 @@ string, its first and last words need not match whole words. This is
609so that the matching can proceed incrementally as you type. This 609so that the matching can proceed incrementally as you type. This
610additional laxity does not apply to the lazy highlight 610additional laxity does not apply to the lazy highlight
611(@pxref{Incremental Search}), which always matches whole words. 611(@pxref{Incremental Search}), which always matches whole words.
612While you are typing the search string, @samp{Pending} appears in the
613search prompt until you use a search repeating key like @kbd{C-s}.
612 614
613 The word search commands don't perform character folding, and 615 The word search commands don't perform character folding, and
614toggling lax whitespace matching (@pxref{Lax Search, lax space 616toggling lax whitespace matching (@pxref{Lax Search, lax space
@@ -661,8 +663,10 @@ search is not already active, this runs the command
661active, @kbd{M-s _} switches to a symbol search, preserving the 663active, @kbd{M-s _} switches to a symbol search, preserving the
662direction of the search and the current search string; you can disable 664direction of the search and the current search string; you can disable
663symbol search by typing @kbd{M-s _} again. In incremental symbol 665symbol search by typing @kbd{M-s _} again. In incremental symbol
664search, only the beginning of the search string is required to match 666search, while you are typing the search string, only the beginning
665the beginning of a symbol. 667of the search string is required to match the beginning of a symbol,
668and @samp{Pending} appears in the search prompt until you use a search
669repeating key like @kbd{C-s}.
666 670
667 To begin a nonincremental symbol search, type @kbd{M-s _ @key{RET}} 671 To begin a nonincremental symbol search, type @kbd{M-s _ @key{RET}}
668for a forward search, or @kbd{M-s _ C-r @key{RET}} or a backward 672for a forward search, or @kbd{M-s _ C-r @key{RET}} or a backward
diff --git a/etc/NEWS b/etc/NEWS
index cbf2b70c821..cba4e4d9a8c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -617,8 +617,9 @@ Drive onsite repositories.
617manual documents how to configure ssh and PuTTY accordingly. 617manual documents how to configure ssh and PuTTY accordingly.
618 618
619+++ 619+++
620Setting the "ENV" environment variable in 'tramp-remote-process-environment' 620*** Setting the "ENV" environment variable in
621enables reading of shell initialization files. 621'tramp-remote-process-environment' enables reading of shell
622initialization files.
622 623
623--- 624---
624** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'. 625** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'.
@@ -702,6 +703,8 @@ processes on exit.
702 703
703** New Elisp data-structure library 'radix-tree'. 704** New Elisp data-structure library 'radix-tree'.
704 705
706** New library 'xdg' with utilities for some XDG standards and specs.
707
705 708
706* Incompatible Lisp Changes in Emacs 26.1 709* Incompatible Lisp Changes in Emacs 26.1
707 710
@@ -900,6 +903,9 @@ collection).
900** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. 903** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el.
901The incumbent 'if-let' and 'when-let' are now aliases. 904The incumbent 'if-let' and 'when-let' are now aliases.
902 905
906** Low-level list functions like 'length' and 'member' now do a better
907job of signaling list cycles instead of looping indefinitely.
908
903+++ 909+++
904** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' 910** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
905can be used for creation of temporary files of remote or mounted directories. 911can be used for creation of temporary files of remote or mounted directories.
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index f57bf92560a..dac7ab888b5 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -20,11 +20,12 @@
20;;; Code: 20;;; Code:
21 21
22(deftheme tsdh-light 22(deftheme tsdh-light
23 "Minor tweaks to the Emacs white-background defaults. 23 "A light Emacs theme.
24Used and created by Tassilo Horn.") 24Used and created by Tassilo Horn.")
25 25
26(custom-theme-set-faces 26(custom-theme-set-faces
27 'tsdh-light 27 'tsdh-light
28 '(default ((t (:background "#fafafa" :foreground "#383a42"))))
28 '(Info-quoted ((t (:underline "gray40" :weight bold)))) 29 '(Info-quoted ((t (:underline "gray40" :weight bold))))
29 '(aw-leading-char-face ((t (:background "red" :foreground "white" :weight bold)))) 30 '(aw-leading-char-face ((t (:background "red" :foreground "white" :weight bold))))
30 '(default ((t (:background "white" :foreground "black")))) 31 '(default ((t (:background "white" :foreground "black"))))
@@ -35,8 +36,18 @@ Used and created by Tassilo Horn.")
35 '(diff-indicator-removed ((t (:inherit diff-indicator-changed)))) 36 '(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
36 '(diff-removed ((t (:inherit diff-changed :background "sandy brown")))) 37 '(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
37 '(dired-directory ((t (:inherit font-lock-function-name-face :weight bold)))) 38 '(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
39 '(font-lock-builtin-face ((t (:foreground "#e44649"))))
40 '(font-lock-comment-delimiter-face ((t (:inherit font-lock-comment-face :weight bold))))
41 '(font-lock-comment-face ((t (:foreground "#a0a1a7"))))
42 '(font-lock-doc-face ((t (:inherit font-lock-string-face :slant italic))))
43 '(font-lock-function-name-face ((t (:foreground "#0184bc"))))
44 '(font-lock-keyword-face ((t (:foreground "#a626a4"))))
45 '(font-lock-negation-char-face ((t (:weight bold))))
38 '(font-lock-regexp-grouping-backslash ((t (:inherit bold :foreground "black")))) 46 '(font-lock-regexp-grouping-backslash ((t (:inherit bold :foreground "black"))))
39 '(font-lock-regexp-grouping-construct ((t (:inherit bold :foreground "black")))) 47 '(font-lock-regexp-grouping-construct ((t (:inherit bold :foreground "black"))))
48 '(font-lock-string-face ((t (:foreground "#50a14f"))))
49 '(font-lock-type-face ((t (:foreground "#c18401"))))
50 '(font-lock-variable-name-face ((t (:foreground "#e45649"))))
40 '(gnus-button ((t (:inherit button)))) 51 '(gnus-button ((t (:inherit button))))
41 '(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight bold)))) 52 '(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight bold))))
42 '(gnus-group-mail-1 ((t (:inherit gnus-group-mail-1-empty :weight bold)))) 53 '(gnus-group-mail-1 ((t (:inherit gnus-group-mail-1-empty :weight bold))))
@@ -51,11 +62,11 @@ Used and created by Tassilo Horn.")
51 '(gnus-group-news-2-empty ((t (:foreground "tomato3")))) 62 '(gnus-group-news-2-empty ((t (:foreground "tomato3"))))
52 '(gnus-group-news-3 ((t (:inherit gnus-group-news-3-empty :weight bold)))) 63 '(gnus-group-news-3 ((t (:inherit gnus-group-news-3-empty :weight bold))))
53 '(gnus-group-news-3-empty ((t (:foreground "tomato2")))) '(header-line ((t (:inherit mode-line :inverse-video t)))) 64 '(gnus-group-news-3-empty ((t (:foreground "tomato2")))) '(header-line ((t (:inherit mode-line :inverse-video t))))
54 '(hl-line ((t (:background "grey95")))) 65 '(hl-line ((t (:background "#f0f0f1"))))
55 '(hl-paren-face ((t (:weight bold))) t) 66 '(hl-paren-face ((t (:weight bold))) t)
56 '(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold)))) 67 '(minibuffer-prompt ((t (:foreground "#0184bc" :family "DeJaVu" :box (:line-width -1 :style released-button) :weight bold))))
57 '(mode-line ((t (:background "wheat" :foreground "black" :box (:line-width 1 :color "tan") :family "DejaVu Sans")))) 68 '(mode-line ((t (:background "#f0f0f1" :box (:line-width 1 :color "#383a42")))))
58 '(mode-line-inactive ((t (:inherit mode-line :foreground "dark gray")))) 69 '(mode-line-inactive ((t (:inherit mode-line :foreground "#a0a1a7"))))
59 '(org-agenda-date ((t (:inherit org-agenda-structure)))) 70 '(org-agenda-date ((t (:inherit org-agenda-structure))))
60 '(org-agenda-date-today ((t (:inherit org-agenda-date :underline t)))) 71 '(org-agenda-date-today ((t (:inherit org-agenda-date :underline t))))
61 '(org-agenda-date-weekend ((t (:inherit org-agenda-date :foreground "dark green")))) 72 '(org-agenda-date-weekend ((t (:inherit org-agenda-date :foreground "dark green"))))
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 3971dbb86b2..6a6a8ea4479 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -616,10 +616,18 @@ relevant to POS."
616 'help-args '(,current-input-method)) 616 'help-args '(,current-input-method))
617 "input method") 617 "input method")
618 (list 618 (list
619 (let ((name 619 (let* ((names (ucs-names))
620 (or (get-char-code-property char 'name) 620 (name
621 (get-char-code-property char 'old-name)))) 621 (or (when (= char 7)
622 (if (and name (assoc-string name (ucs-names))) 622 ;; Special case for "BELL" which is
623 ;; apparently the only char which
624 ;; doesn't have a new name and whose
625 ;; old-name is shadowed by a newer char
626 ;; with that name (bug#25641).
627 (car (rassoc char names)))
628 (get-char-code-property char 'name)
629 (get-char-code-property char 'old-name))))
630 (if (and name (assoc-string name names))
623 (format 631 (format
624 "type \"C-x 8 RET %x\" or \"C-x 8 RET %s\"" 632 "type \"C-x 8 RET %x\" or \"C-x 8 RET %s\""
625 char name) 633 char name)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index ec0f08de356..a8838046a4d 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -880,11 +880,9 @@ Maybe clear the markers and delete the symbol's edebug property?"
880 (list 880 (list
881 (edebug-storing-offsets (- (point) 2) 'function) 881 (edebug-storing-offsets (- (point) 2) 'function)
882 (edebug-read-storing-offsets stream))) 882 (edebug-read-storing-offsets stream)))
883 ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6 883 (t
884 ?7 ?8 ?9 ?0))
885 (backward-char 1) 884 (backward-char 1)
886 (read stream)) 885 (read stream))))
887 (t (edebug-syntax-error "Bad char after #"))))
888 886
889(defun edebug-read-list (stream) 887(defun edebug-read-list (stream)
890 (forward-char 1) ; skip \( 888 (forward-char 1) ; skip \(
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index b0dbb229152..ba5cb5c2db7 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -393,8 +393,20 @@ PROC is the process that's exiting. STRING is the exit message."
393 (unless (string= string "run") 393 (unless (string= string "run")
394 (unless (string-match "^\\(finished\\|exited\\)" string) 394 (unless (string-match "^\\(finished\\|exited\\)" string)
395 (eshell-insertion-filter proc string)) 395 (eshell-insertion-filter proc string))
396 (eshell-close-handles (process-exit-status proc) 'nil 396 (let ((handles (nth 1 entry))
397 (cadr entry)))) 397 (str (prog1 (nth 3 entry)
398 (setf (nth 3 entry) nil)))
399 (status (process-exit-status proc)))
400 ;; If we're in the middle of handling output
401 ;; from this process then schedule the EOF for
402 ;; later.
403 (letrec ((finish-io
404 (lambda ()
405 (if (nth 4 entry)
406 (run-at-time 0 nil finish-io)
407 (when str (eshell-output-object str nil handles))
408 (eshell-close-handles status 'nil handles)))))
409 (funcall finish-io)))))
398 (eshell-remove-process-entry entry)))) 410 (eshell-remove-process-entry entry))))
399 (eshell-kill-process-function proc string))))) 411 (eshell-kill-process-function proc string)))))
400 412
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index a193ab41348..85969edc81b 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1535,7 +1535,11 @@ If YANK is non-nil, include the original article."
1535 (message-pop-to-buffer "*Gnus Bug*")) 1535 (message-pop-to-buffer "*Gnus Bug*"))
1536 (let ((message-this-is-mail t)) 1536 (let ((message-this-is-mail t))
1537 (message-setup `((To . ,gnus-maintainer) 1537 (message-setup `((To . ,gnus-maintainer)
1538 (Subject . "")))) 1538 (Subject . "")
1539 (X-Debbugs-Package
1540 . ,(format "%s" gnus-bug-package))
1541 (X-Debbugs-Version
1542 . ,(format "%s" (gnus-continuum-version))))))
1539 (when gnus-bug-create-help-buffer 1543 (when gnus-bug-create-help-buffer
1540 (push `(gnus-bug-kill-buffer) message-send-actions)) 1544 (push `(gnus-bug-kill-buffer) message-send-actions))
1541 (goto-char (point-min)) 1545 (goto-char (point-min))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index bbf85fe584a..d3edcd08513 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2654,6 +2654,10 @@ such as a mark that says whether an article is stored in the cache
2654 "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)" 2654 "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)"
2655 "The mail address of the Gnus maintainers.") 2655 "The mail address of the Gnus maintainers.")
2656 2656
2657(defconst gnus-bug-package
2658 "emacs,gnus"
2659 "The package to use in the bug submission.")
2660
2657(defvar gnus-info-nodes 2661(defvar gnus-info-nodes
2658 '((gnus-group-mode "(gnus)Group Buffer") 2662 '((gnus-group-mode "(gnus)Group Buffer")
2659 (gnus-summary-mode "(gnus)Summary Buffer") 2663 (gnus-summary-mode "(gnus)Summary Buffer")
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 579222f0f65..989d4b8ea17 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1793,22 +1793,23 @@ If RECURSIVE, search recursively."
1793 (buffer-string)))))) 1793 (buffer-string))))))
1794 (shr-inhibit-images mm-html-inhibit-images) 1794 (shr-inhibit-images mm-html-inhibit-images)
1795 (shr-blocked-images mm-html-blocked-images) 1795 (shr-blocked-images mm-html-blocked-images)
1796 charset char) 1796 charset coding char)
1797 (unless handle 1797 (unless handle
1798 (setq handle (mm-dissect-buffer t))) 1798 (setq handle (mm-dissect-buffer t)))
1799 (setq charset (mail-content-type-get (mm-handle-type handle) 'charset)) 1799 (and (setq charset
1800 (or (mail-content-type-get (mm-handle-type handle) 'charset)
1801 mail-parse-charset))
1802 (setq coding (mm-charset-to-coding-system charset nil t))
1803 (eq coding 'ascii)
1804 (setq coding nil))
1800 (save-restriction 1805 (save-restriction
1801 (narrow-to-region (point) (point)) 1806 (narrow-to-region (point) (point))
1802 (shr-insert-document 1807 (shr-insert-document
1803 (mm-with-part handle 1808 (mm-with-part handle
1804 (insert (prog1 1809 (insert (prog1
1805 (if (and charset 1810 (if coding
1806 (setq charset 1811 (decode-coding-string (buffer-string) coding)
1807 (mm-charset-to-coding-system charset 1812 (buffer-string))
1808 nil t))
1809 (not (eq charset 'ascii)))
1810 (decode-coding-string (buffer-string) charset)
1811 (string-as-multibyte (buffer-string)))
1812 (erase-buffer) 1813 (erase-buffer)
1813 (mm-enable-multibyte))) 1814 (mm-enable-multibyte)))
1814 (goto-char (point-min)) 1815 (goto-char (point-min))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 058eaecb365..2a68f777d95 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -506,14 +506,24 @@ the mode if ARG is omitted or nil."
506 (ibuffer-backward-filter-group 1)) 506 (ibuffer-backward-filter-group 1))
507 (ibuffer-forward-line 0)) 507 (ibuffer-forward-line 0))
508 508
509(defun ibuffer--maybe-erase-shell-cmd-output ()
510 (let ((buf (get-buffer "*Shell Command Output*")))
511 (when (and (buffer-live-p buf)
512 (not shell-command-dont-erase-buffer)
513 (not (zerop (buffer-size buf))))
514 (with-current-buffer buf (erase-buffer)))))
515
509;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext") 516;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
510(define-ibuffer-op shell-command-pipe (command) 517(define-ibuffer-op shell-command-pipe (command)
511 "Pipe the contents of each marked buffer to shell command COMMAND." 518 "Pipe the contents of each marked buffer to shell command COMMAND."
512 (:interactive "sPipe to shell command: " 519 (:interactive "sPipe to shell command: "
513 :opstring "Shell command executed on" 520 :opstring "Shell command executed on"
521 :before (ibuffer--maybe-erase-shell-cmd-output)
514 :modifier-p nil) 522 :modifier-p nil)
515 (shell-command-on-region 523 (let ((out-buf (get-buffer-create "*Shell Command Output*")))
516 (point-min) (point-max) command)) 524 (with-current-buffer out-buf (goto-char (point-max)))
525 (call-shell-region (point-min) (point-max)
526 command nil out-buf)))
517 527
518;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext") 528;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
519(define-ibuffer-op shell-command-pipe-replace (command) 529(define-ibuffer-op shell-command-pipe-replace (command)
@@ -523,26 +533,32 @@ the mode if ARG is omitted or nil."
523 :active-opstring "replace buffer contents in" 533 :active-opstring "replace buffer contents in"
524 :dangerous t 534 :dangerous t
525 :modifier-p t) 535 :modifier-p t)
526 (with-current-buffer buf 536 (call-shell-region (point-min) (point-max)
527 (shell-command-on-region (point-min) (point-max) 537 command 'delete buf))
528 command nil t)))
529 538
530;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext") 539;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
531(define-ibuffer-op shell-command-file (command) 540(define-ibuffer-op shell-command-file (command)
532 "Run shell command COMMAND separately on files of marked buffers." 541 "Run shell command COMMAND separately on files of marked buffers."
533 (:interactive "sShell command on buffer's file: " 542 (:interactive "sShell command on buffer's file: "
534 :opstring "Shell command executed on" 543 :opstring "Shell command executed on"
544 :before (ibuffer--maybe-erase-shell-cmd-output)
535 :modifier-p nil) 545 :modifier-p nil)
536 (shell-command (concat command " " 546 (let ((file (and (not (buffer-modified-p))
537 (shell-quote-argument 547 buffer-file-name))
538 (or buffer-file-name 548 (out-buf (get-buffer-create "*Shell Command Output*")))
539 (let ((file 549 (unless (and file (file-exists-p file))
540 (make-temp-file 550 (setq file
541 (substring 551 (make-temp-file
542 (buffer-name) 0 552 (substring
543 (min 10 (length (buffer-name))))))) 553 (buffer-name) 0
544 (write-region nil nil file nil 0) 554 (min 10 (length (buffer-name))))))
545 file)))))) 555 (write-region nil nil file nil 0))
556 (with-current-buffer out-buf (goto-char (point-max)))
557 (call-process-shell-command
558 (format "%s %s"
559 command
560 (shell-quote-argument file))
561 nil out-buf nil)))
546 562
547;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext") 563;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
548(define-ibuffer-op eval (form) 564(define-ibuffer-op eval (form)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 05e568efeb2..2e751cebd6e 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -169,6 +169,8 @@ value if and only if `a' is \"less than\" `b'.
169 dangerous 169 dangerous
170 (opstring "operated on") 170 (opstring "operated on")
171 (active-opstring "Operate on") 171 (active-opstring "Operate on")
172 before
173 after
172 complex) 174 complex)
173 &rest body) 175 &rest body)
174 "Generate a function which operates on a buffer. 176 "Generate a function which operates on a buffer.
@@ -198,6 +200,8 @@ operation is complete, in the form:
198ACTIVE-OPSTRING is a string which will be displayed to the user in a 200ACTIVE-OPSTRING is a string which will be displayed to the user in a
199confirmation message, in the form: 201confirmation message, in the form:
200 \"Really ACTIVE-OPSTRING x buffers?\" 202 \"Really ACTIVE-OPSTRING x buffers?\"
203BEFORE is a form to evaluate before start the operation.
204AFTER is a form to evaluate once the operation is complete.
201COMPLEX means this function is special; if COMPLEX is nil BODY 205COMPLEX means this function is special; if COMPLEX is nil BODY
202evaluates once for each marked buffer, MBUF, with MBUF current 206evaluates once for each marked buffer, MBUF, with MBUF current
203and saving the point. If COMPLEX is non-nil, BODY evaluates 207and saving the point. If COMPLEX is non-nil, BODY evaluates
@@ -206,7 +210,7 @@ BODY define the operation; they are forms to evaluate per each
206marked buffer. BODY is evaluated with `buf' bound to the 210marked buffer. BODY is evaluated with `buf' bound to the
207buffer object. 211buffer object.
208 212
209\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" 213\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)"
210 (declare (indent 2) (doc-string 3)) 214 (declare (indent 2) (doc-string 3))
211 `(progn 215 `(progn
212 (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op)) 216 (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
@@ -238,6 +242,7 @@ buffer object.
238 (if (eq modifier-p t) 242 (if (eq modifier-p t)
239 '((setq ibuffer-did-modification t)) 243 '((setq ibuffer-did-modification t))
240 ()) 244 ())
245 (and after `(,after)) ; post-operation form.
241 `((ibuffer-redisplay t) 246 `((ibuffer-redisplay t)
242 (message ,(concat "Operation finished; " opstring " %s buffers") count)))) 247 (message ,(concat "Operation finished; " opstring " %s buffers") count))))
243 (inner-body (if complex 248 (inner-body (if complex
@@ -247,7 +252,8 @@ buffer object.
247 (save-excursion 252 (save-excursion
248 ,@body)) 253 ,@body))
249 t))) 254 t)))
250 (body `(let ((count 255 (body `(let ((_ ,before) ; pre-operation form.
256 (count
251 (,(pcase mark 257 (,(pcase mark
252 (:deletion 258 (:deletion
253 'ibuffer-map-deletion-lines) 259 'ibuffer-map-deletion-lines)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 71bf1d6dcc2..eb821b257b3 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2564,18 +2564,26 @@ Marking commands:
2564 2564
2565Filtering commands: 2565Filtering commands:
2566 2566
2567 `\\[ibuffer-filter-chosen-by-completion]' - Select and apply filter chosen by completion.
2567 `\\[ibuffer-filter-by-mode]' - Add a filter by any major mode. 2568 `\\[ibuffer-filter-by-mode]' - Add a filter by any major mode.
2568 `\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use. 2569 `\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use.
2569 `\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode. 2570 `\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode.
2570 `\\[ibuffer-filter-by-name]' - Add a filter by buffer name. 2571 `\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
2571 `\\[ibuffer-filter-by-content]' - Add a filter by buffer content. 2572 `\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
2573 `\\[ibuffer-filter-by-basename]' - Add a filter by basename.
2574 `\\[ibuffer-filter-by-directory]' - Add a filter by directory name.
2572 `\\[ibuffer-filter-by-filename]' - Add a filter by filename. 2575 `\\[ibuffer-filter-by-filename]' - Add a filter by filename.
2576 `\\[ibuffer-filter-by-file-extension]' - Add a filter by file extension.
2577 `\\[ibuffer-filter-by-modified]' - Add a filter by modified buffers.
2578 `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate.
2573 `\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size. 2579 `\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size.
2574 `\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size. 2580 `\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size.
2575 `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate. 2581 `\\[ibuffer-filter-by-starred-name]' - Add a filter by special buffers.
2582 `\\[ibuffer-filter-by-visiting-file]' - Add a filter by buffers visiting files.
2576 `\\[ibuffer-save-filters]' - Save the current filters with a name. 2583 `\\[ibuffer-save-filters]' - Save the current filters with a name.
2577 `\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters. 2584 `\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters.
2578 `\\[ibuffer-add-saved-filters]' - Add saved filters to current filters. 2585 `\\[ibuffer-add-saved-filters]' - Add saved filters to current filters.
2586 `\\[ibuffer-and-filter]' - Replace the top two filters with their logical AND.
2579 `\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR. 2587 `\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR.
2580 `\\[ibuffer-pop-filter]' - Remove the top filter. 2588 `\\[ibuffer-pop-filter]' - Remove the top filter.
2581 `\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter. 2589 `\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter.
diff --git a/lisp/info.el b/lisp/info.el
index 0cfcec32f82..5f4ae5f0b09 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2118,10 +2118,9 @@ If DIRECTION is `backward', search in the reverse direction."
2118 (cond 2118 (cond
2119 (isearch-regexp-function 2119 (isearch-regexp-function
2120 ;; Lax version of word search 2120 ;; Lax version of word search
2121 (let ((lax (not (or isearch-nonincremental 2121 (let ((lax (and (not bound) (isearch--lax-regexp-function-p))))
2122 (eq (length string) 2122 (when lax
2123 (length (isearch--state-string 2123 (setq isearch-adjusted t))
2124 (car isearch-cmds))))))))
2125 (if (functionp isearch-regexp-function) 2124 (if (functionp isearch-regexp-function)
2126 (funcall isearch-regexp-function string lax) 2125 (funcall isearch-regexp-function string lax)
2127 (word-search-regexp string lax)))) 2126 (word-search-regexp string lax))))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 5c48c30daa9..4b35f256644 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1621,7 +1621,7 @@ Used in `word-search-forward', `word-search-backward',
1621 ((string-match-p "\\`\\W+\\'" string) "\\W+") 1621 ((string-match-p "\\`\\W+\\'" string) "\\W+")
1622 (t (concat 1622 (t (concat
1623 (if (string-match-p "\\`\\W" string) "\\W+" 1623 (if (string-match-p "\\`\\W" string) "\\W+"
1624 (unless lax "\\<")) 1624 "\\<")
1625 (mapconcat 'regexp-quote (split-string string "\\W+" t) "\\W+") 1625 (mapconcat 'regexp-quote (split-string string "\\W+" t) "\\W+")
1626 (if (string-match-p "\\W\\'" string) "\\W+" 1626 (if (string-match-p "\\W\\'" string) "\\W+"
1627 (unless lax "\\>")))))) 1627 (unless lax "\\>"))))))
@@ -1749,7 +1749,7 @@ the beginning or the end of the string need not match a symbol boundary."
1749 ((string-match-p (format "\\`%s\\'" not-word-symbol-re) string) not-word-symbol-re) 1749 ((string-match-p (format "\\`%s\\'" not-word-symbol-re) string) not-word-symbol-re)
1750 (t (concat 1750 (t (concat
1751 (if (string-match-p (format "\\`%s" not-word-symbol-re) string) not-word-symbol-re 1751 (if (string-match-p (format "\\`%s" not-word-symbol-re) string) not-word-symbol-re
1752 (unless lax "\\_<")) 1752 "\\_<")
1753 (mapconcat 'regexp-quote (split-string string not-word-symbol-re t) not-word-symbol-re) 1753 (mapconcat 'regexp-quote (split-string string not-word-symbol-re t) not-word-symbol-re)
1754 (if (string-match-p (format "%s\\'" not-word-symbol-re) string) not-word-symbol-re 1754 (if (string-match-p (format "%s\\'" not-word-symbol-re) string) not-word-symbol-re
1755 (unless lax "\\_>"))))))) 1755 (unless lax "\\_>")))))))
@@ -2740,7 +2740,9 @@ Can be changed via `isearch-search-fun-function' for special needs."
2740 (funcall 2740 (funcall
2741 (if isearch-forward #'re-search-forward #'re-search-backward) 2741 (if isearch-forward #'re-search-forward #'re-search-backward)
2742 (cond (isearch-regexp-function 2742 (cond (isearch-regexp-function
2743 (let ((lax (isearch--lax-regexp-function-p))) 2743 (let ((lax (and (not bound) (isearch--lax-regexp-function-p))))
2744 (when lax
2745 (setq isearch-adjusted t))
2744 (if (functionp isearch-regexp-function) 2746 (if (functionp isearch-regexp-function)
2745 (funcall isearch-regexp-function string lax) 2747 (funcall isearch-regexp-function string lax)
2746 (word-search-regexp string lax)))) 2748 (word-search-regexp string lax))))
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 156331cf86d..1dd2e3757ed 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -82,12 +82,15 @@
82 (2 font-lock-constant-face t)) 82 (2 font-lock-constant-face t))
83 ("^:[^:].*" 83 ("^:[^:].*"
84 . 'bat-label-face) 84 . 'bat-label-face)
85 ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\w+\\)" 85 ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
86 (2 font-lock-variable-name-face)) 86 (2 font-lock-variable-name-face))
87 ("%\\(\\w+\\)%?" 87 ("%\\(\\(\\sw\\|\\s_\\)+\\)%"
88 (1 font-lock-variable-name-face)) 88 (1 font-lock-variable-name-face))
89 ("!\\(\\w+\\)!?" ; delayed-expansion !variable! 89 ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable!
90 (1 font-lock-variable-name-face)) 90 (1 font-lock-variable-name-face))
91 ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
92 (1 font-lock-variable-name-face nil t) ; PATH expansion
93 (2 font-lock-variable-name-face)) ; iteration variable or positional parameter
91 ("[ =][-/]+\\(\\w+\\)" 94 ("[ =][-/]+\\(\\w+\\)"
92 (1 font-lock-type-face append)) 95 (1 font-lock-type-face append))
93 (,(concat "\\_<" (regexp-opt COMMANDS) "\\_>") . font-lock-builtin-face) 96 (,(concat "\\_<" (regexp-opt COMMANDS) "\\_>") . font-lock-builtin-face)
@@ -130,6 +133,7 @@
130 (modify-syntax-entry ?{ "_" table) 133 (modify-syntax-entry ?{ "_" table)
131 (modify-syntax-entry ?} "_" table) 134 (modify-syntax-entry ?} "_" table)
132 (modify-syntax-entry ?\\ "." table) 135 (modify-syntax-entry ?\\ "." table)
136 (modify-syntax-entry ?= "." table)
133 table)) 137 table))
134 138
135(defconst bat--syntax-propertize 139(defconst bat--syntax-propertize
@@ -175,6 +179,7 @@ with `bat-cmd-help'. Navigate between sections using `imenu'.
175Run script using `bat-run' and `bat-run-args'.\n 179Run script using `bat-run' and `bat-run-args'.\n
176\\{bat-mode-map}" 180\\{bat-mode-map}"
177 (setq-local comment-start "rem ") 181 (setq-local comment-start "rem ")
182 (setq-local comment-start-skip "rem[ \t]+")
178 (setq-local syntax-propertize-function bat--syntax-propertize) 183 (setq-local syntax-propertize-function bat--syntax-propertize)
179 (setq-local font-lock-defaults 184 (setq-local font-lock-defaults
180 '(bat-font-lock-keywords nil t)) ; case-insensitive keywords 185 '(bat-font-lock-keywords nil t)) ; case-insensitive keywords
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 22d4f2abd98..b3d8a51ceeb 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1045,6 +1045,15 @@ to specify a command to run."
1045 (if (eq next-error-last-buffer (current-buffer)) 1045 (if (eq next-error-last-buffer (current-buffer))
1046 (setq default-directory dir))))))) 1046 (setq default-directory dir)))))))
1047 1047
1048(defun rgrep-find-ignored-directories (dir)
1049 "Return the list of ignored directories applicable to `dir'."
1050 (delq nil (mapcar
1051 (lambda (ignore)
1052 (cond ((stringp ignore) ignore)
1053 ((consp ignore)
1054 (and (funcall (car ignore) dir) (cdr ignore)))))
1055 grep-find-ignored-directories)))
1056
1048(defun rgrep-default-command (regexp files dir) 1057(defun rgrep-default-command (regexp files dir)
1049 "Compute the command for \\[rgrep] to use by default." 1058 "Compute the command for \\[rgrep] to use by default."
1050 (require 'find-dired) ; for `find-name-arg' 1059 (require 'find-dired) ; for `find-name-arg'
@@ -1066,20 +1075,9 @@ to specify a command to run."
1066 (shell-quote-argument "(") 1075 (shell-quote-argument "(")
1067 ;; we should use shell-quote-argument here 1076 ;; we should use shell-quote-argument here
1068 " -path " 1077 " -path "
1069 (mapconcat 1078 (mapconcat (lambda (d) (shell-quote-argument (concat "*/" d)))
1070 'identity 1079 (rgrep-find-ignored-directories dir)
1071 (delq nil (mapcar 1080 " -o -path ")
1072 #'(lambda (ignore)
1073 (cond ((stringp ignore)
1074 (shell-quote-argument
1075 (concat "*/" ignore)))
1076 ((consp ignore)
1077 (and (funcall (car ignore) dir)
1078 (shell-quote-argument
1079 (concat "*/"
1080 (cdr ignore)))))))
1081 grep-find-ignored-directories))
1082 " -o -path ")
1083 " " 1081 " "
1084 (shell-quote-argument ")") 1082 (shell-quote-argument ")")
1085 " -prune -o ")) 1083 " -prune -o "))
diff --git a/lisp/simple.el b/lisp/simple.el
index 441713a18b8..c0dad2d36e7 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1733,6 +1733,9 @@ invoking, give a prefix argument to `execute-extended-command'."
1733 (where-is-internal function overriding-local-map t)))) 1733 (where-is-internal function overriding-local-map t))))
1734 (unless (commandp function) 1734 (unless (commandp function)
1735 (error "`%s' is not a valid command name" command-name)) 1735 (error "`%s' is not a valid command name" command-name))
1736 ;; Some features, such as novice.el, rely on this-command-keys
1737 ;; including M-x COMMAND-NAME RET.
1738 (set--this-command-keys (concat "\M-x" (symbol-name function) "\r"))
1736 (setq this-command function) 1739 (setq this-command function)
1737 ;; Normally `real-this-command' should never be changed, but here we really 1740 ;; Normally `real-this-command' should never be changed, but here we really
1738 ;; want to pretend that M-x <cmd> RET is nothing more than a "key 1741 ;; want to pretend that M-x <cmd> RET is nothing more than a "key
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 0c7d76f7924..19746c68e6a 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -36,7 +36,7 @@
36(require 'seq) 36(require 'seq)
37(require 'sgml-mode) 37(require 'sgml-mode)
38(require 'smie) 38(require 'smie)
39(require 'subr-x) 39(eval-when-compile (require 'subr-x))
40 40
41(defgroup css nil 41(defgroup css nil
42 "Cascading Style Sheets (CSS) editing mode." 42 "Cascading Style Sheets (CSS) editing mode."
diff --git a/lisp/xdg.el b/lisp/xdg.el
new file mode 100644
index 00000000000..b11e104e2b7
--- /dev/null
+++ b/lisp/xdg.el
@@ -0,0 +1,144 @@
1;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Mark Oteiza <mvoteiza@udel.edu>
6;; Created: 27 January 2017
7;; Keywords: files, data
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
13;; by the Free Software Foundation; either version 3 of the License,
14;; or (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful, but
17;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19;; 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 <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; Library providing some convenience functions for the following XDG
27;; standards and specifications
28;;
29;; - XDG Base Directory Specification
30;; - Thumbnail Managing Standard
31;; - xdg-user-dirs configuration
32
33;;; Code:
34
35
36;; XDG Base Directory Specification
37;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
38
39(defmacro xdg--dir-home (environ default-path)
40 (declare (debug (stringp stringp)))
41 (let ((env (make-symbol "env")))
42 `(let ((,env (getenv ,environ)))
43 (if (or (null ,env) (not (file-name-absolute-p ,env)))
44 (expand-file-name ,default-path)
45 ,env))))
46
47(defun xdg-config-home ()
48 "Return the base directory for user specific configuration files."
49 (xdg--dir-home "XDG_CONFIG_HOME" "~/.config"))
50
51(defun xdg-cache-home ()
52 "Return the base directory for user specific cache files."
53 (xdg--dir-home "XDG_CACHE_HOME" "~/.cache"))
54
55(defun xdg-data-home ()
56 "Return the base directory for user specific data files."
57 (xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))
58
59(defun xdg-runtime-dir ()
60 "Return the value of $XDG_RUNTIME_DIR."
61 (getenv "XDG_RUNTIME_DIR"))
62
63(defun xdg-config-dirs ()
64 "Return the config directory search path as a list."
65 (let ((env (getenv "XDG_CONFIG_DIRS")))
66 (if (or (null env) (string= env ""))
67 '("/etc/xdg")
68 (parse-colon-path env))))
69
70(defun xdg-data-dirs ()
71 "Return the data directory search path as a list."
72 (let ((env (getenv "XDG_DATA_DIRS")))
73 (if (or (null env) (string= env ""))
74 '("/usr/local/share/" "/usr/share/")
75 (parse-colon-path env))))
76
77
78;; Thumbnail Managing Standard
79;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html
80
81(defun xdg-thumb-uri (filename)
82 "Return the canonical URI for FILENAME.
83If FILENAME has absolute path /foo/bar.jpg, its canonical URI is
84file:///foo/bar.jpg"
85 (concat "file://" (expand-file-name filename)))
86
87(defun xdg-thumb-name (filename)
88 "Return the appropriate thumbnail filename for FILENAME."
89 (concat (md5 (xdg-thumb-uri filename)) ".png"))
90
91(defun xdg-thumb-mtime (filename)
92 "Return modification time of FILENAME as integral seconds from the epoch."
93 (floor (float-time (nth 5 (file-attributes filename)))))
94
95
96;; XDG User Directories
97;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/
98
99(defconst xdg-line-regexp
100 (eval-when-compile
101 (rx "XDG_"
102 (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
103 "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
104 "_DIR=\""
105 (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
106 "\""))
107 "Regexp matching non-comment lines in xdg-user-dirs config files.")
108
109(defvar xdg-user-dirs nil
110 "Alist of directory keys and values.")
111
112(defun xdg--user-dirs-parse-line ()
113 "Return pair of user-dirs key to directory value in LINE, otherwise nil.
114This should be called at the beginning of a line."
115 (skip-chars-forward "[:blank:]")
116 (when (and (/= (following-char) ?#)
117 (looking-at xdg-line-regexp))
118 (let ((k (match-string 1))
119 (v (match-string 2)))
120 (when (and k v) (cons k v)))))
121
122(defun xdg--user-dirs-parse-file (filename)
123 "Return alist of xdg-user-dirs from FILENAME."
124 (let (elt res)
125 (with-temp-buffer
126 (insert-file-contents filename)
127 (goto-char (point-min))
128 (while (not (eobp))
129 (setq elt (xdg--user-dirs-parse-line))
130 (when (consp elt) (push elt res))
131 (forward-line)))
132 res))
133
134(defun xdg-user-dir (name)
135 "Return the path of user directory referred to by NAME."
136 (when (null xdg-user-dirs)
137 (setq xdg-user-dirs
138 (xdg--user-dirs-parse-file
139 (expand-file-name "user-dirs.dirs" (xdg-config-home)))))
140 (cdr (assoc name xdg-user-dirs)))
141
142(provide 'xdg)
143
144;;; xdg.el ends here
diff --git a/src/composite.c b/src/composite.c
index f23bb17c57a..b673c53ac83 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1012,7 +1012,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
1012 val = CHAR_TABLE_REF (Vcomposition_function_table, c); 1012 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1013 if (! NILP (val)) 1013 if (! NILP (val))
1014 { 1014 {
1015 for (int ridx = 0; CONSP (val); val = XCDR (val), ridx++) 1015 for (EMACS_INT ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1016 { 1016 {
1017 Lisp_Object elt = XCAR (val); 1017 Lisp_Object elt = XCAR (val);
1018 if (VECTORP (elt) && ASIZE (elt) == 3 1018 if (VECTORP (elt) && ASIZE (elt) == 3
@@ -1063,54 +1063,48 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
1063 while (char_composable_p (c)) 1063 while (char_composable_p (c))
1064 { 1064 {
1065 val = CHAR_TABLE_REF (Vcomposition_function_table, c); 1065 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1066 if (! NILP (val)) 1066 for (EMACS_INT ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1067 { 1067 {
1068 Lisp_Object elt; 1068 Lisp_Object elt = XCAR (val);
1069 int ridx, blen; 1069 if (VECTORP (elt) && ASIZE (elt) == 3
1070 1070 && NATNUMP (AREF (elt, 1))
1071 for (ridx = 0; CONSP (val); val = XCDR (val), ridx++) 1071 && charpos - XFASTINT (AREF (elt, 1)) > endpos)
1072 { 1072 {
1073 elt = XCAR (val); 1073 ptrdiff_t back = XFASTINT (AREF (elt, 1));
1074 if (VECTORP (elt) && ASIZE (elt) == 3 1074 ptrdiff_t cpos = charpos - back, bpos;
1075 && NATNUMP (AREF (elt, 1))
1076 && charpos - XFASTINT (AREF (elt, 1)) > endpos)
1077 {
1078 ptrdiff_t back = XFASTINT (AREF (elt, 1));
1079 ptrdiff_t cpos = charpos - back, bpos;
1080 1075
1081 if (back == 0) 1076 if (back == 0)
1082 bpos = bytepos; 1077 bpos = bytepos;
1083 else 1078 else
1084 bpos = (NILP (string) ? CHAR_TO_BYTE (cpos) 1079 bpos = (NILP (string) ? CHAR_TO_BYTE (cpos)
1085 : string_char_to_byte (string, cpos)); 1080 : string_char_to_byte (string, cpos));
1086 if (STRINGP (AREF (elt, 0))) 1081 ptrdiff_t blen
1087 blen = fast_looking_at (AREF (elt, 0), cpos, bpos, 1082 = (STRINGP (AREF (elt, 0))
1088 start + 1, limit, string); 1083 ? fast_looking_at (AREF (elt, 0), cpos, bpos,
1089 else 1084 start + 1, limit, string)
1090 blen = 1; 1085 : 1);
1091 if (blen > 0) 1086 if (blen > 0)
1087 {
1088 /* Make CPOS point to the last character of
1089 match. Note that BLEN is byte-length. */
1090 if (blen > 1)
1091 {
1092 bpos += blen;
1093 if (NILP (string))
1094 cpos = BYTE_TO_CHAR (bpos) - 1;
1095 else
1096 cpos = string_byte_to_char (string, bpos) - 1;
1097 }
1098 back = cpos - (charpos - back);
1099 if (cmp_it->stop_pos < cpos
1100 || (cmp_it->stop_pos == cpos
1101 && cmp_it->lookback < back))
1092 { 1102 {
1093 /* Make CPOS point to the last character of 1103 cmp_it->rule_idx = ridx;
1094 match. Note that BLEN is byte-length. */ 1104 cmp_it->stop_pos = cpos;
1095 if (blen > 1) 1105 cmp_it->ch = c;
1096 { 1106 cmp_it->lookback = back;
1097 bpos += blen; 1107 cmp_it->nchars = back + 1;
1098 if (NILP (string))
1099 cpos = BYTE_TO_CHAR (bpos) - 1;
1100 else
1101 cpos = string_byte_to_char (string, bpos) - 1;
1102 }
1103 back = cpos - (charpos - back);
1104 if (cmp_it->stop_pos < cpos
1105 || (cmp_it->stop_pos == cpos
1106 && cmp_it->lookback < back))
1107 {
1108 cmp_it->rule_idx = ridx;
1109 cmp_it->stop_pos = cpos;
1110 cmp_it->ch = c;
1111 cmp_it->lookback = back;
1112 cmp_it->nchars = back + 1;
1113 }
1114 } 1108 }
1115 } 1109 }
1116 } 1110 }
@@ -1203,10 +1197,10 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1203 { 1197 {
1204 Lisp_Object lgstring = Qnil; 1198 Lisp_Object lgstring = Qnil;
1205 Lisp_Object val, elt; 1199 Lisp_Object val, elt;
1206 ptrdiff_t i;
1207 1200
1208 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch); 1201 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1209 for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val)); 1202 for (EMACS_INT i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val))
1203 continue;
1210 if (charpos < endpos) 1204 if (charpos < endpos)
1211 { 1205 {
1212 for (; CONSP (val); val = XCDR (val)) 1206 for (; CONSP (val); val = XCDR (val))
@@ -1255,6 +1249,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1255 if (NILP (LGSTRING_ID (lgstring))) 1249 if (NILP (LGSTRING_ID (lgstring)))
1256 lgstring = composition_gstring_put_cache (lgstring, -1); 1250 lgstring = composition_gstring_put_cache (lgstring, -1);
1257 cmp_it->id = XINT (LGSTRING_ID (lgstring)); 1251 cmp_it->id = XINT (LGSTRING_ID (lgstring));
1252 int i;
1258 for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++) 1253 for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++)
1259 if (NILP (LGSTRING_GLYPH (lgstring, i))) 1254 if (NILP (LGSTRING_GLYPH (lgstring, i)))
1260 break; 1255 break;
diff --git a/src/data.c b/src/data.c
index 8e07bf01b44..12dc2df0bac 100644
--- a/src/data.c
+++ b/src/data.c
@@ -170,6 +170,12 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
170 xsignal3 (Qargs_out_of_range, a1, a2, a3); 170 xsignal3 (Qargs_out_of_range, a1, a2, a3);
171} 171}
172 172
173void
174circular_list (Lisp_Object list)
175{
176 xsignal1 (Qcircular_list, list);
177}
178
173 179
174/* Data type predicates. */ 180/* Data type predicates. */
175 181
diff --git a/src/dispextern.h b/src/dispextern.h
index eb71a82311c..e030618a9b7 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2215,7 +2215,7 @@ struct composition_it
2215 the automatic composition. Provided that ELT is an element of 2215 the automatic composition. Provided that ELT is an element of
2216 Vcomposition_function_table for CH, (nth ELT RULE_IDX) is the 2216 Vcomposition_function_table for CH, (nth ELT RULE_IDX) is the
2217 rule for the composition. */ 2217 rule for the composition. */
2218 int rule_idx; 2218 EMACS_INT rule_idx;
2219 /* If this is an automatic composition, how many characters to look 2219 /* If this is an automatic composition, how many characters to look
2220 back from the position where a character triggering the 2220 back from the position where a character triggering the
2221 composition exists. */ 2221 composition exists. */
diff --git a/src/fns.c b/src/fns.c
index ac7c1f265a4..ffe3218ca7d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -108,23 +108,12 @@ To get the number of bytes, use `string-bytes'. */)
108 XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); 108 XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
109 else if (CONSP (sequence)) 109 else if (CONSP (sequence))
110 { 110 {
111 EMACS_INT i = 0; 111 intptr_t i = 0;
112 112 FOR_EACH_TAIL (sequence)
113 do 113 i++;
114 {
115 ++i;
116 if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
117 {
118 if (MOST_POSITIVE_FIXNUM < i)
119 error ("List too long");
120 maybe_quit ();
121 }
122 sequence = XCDR (sequence);
123 }
124 while (CONSP (sequence));
125
126 CHECK_LIST_END (sequence, sequence); 114 CHECK_LIST_END (sequence, sequence);
127 115 if (MOST_POSITIVE_FIXNUM < i)
116 error ("List too long");
128 val = make_number (i); 117 val = make_number (i);
129 } 118 }
130 else if (NILP (sequence)) 119 else if (NILP (sequence))
@@ -142,38 +131,10 @@ it returns 0. If LIST is circular, it returns a finite value
142which is at least the number of distinct elements. */) 131which is at least the number of distinct elements. */)
143 (Lisp_Object list) 132 (Lisp_Object list)
144{ 133{
145 Lisp_Object tail, halftail; 134 intptr_t len = 0;
146 double hilen = 0; 135 FOR_EACH_TAIL_SAFE (list)
147 uintmax_t lolen = 1; 136 len++;
148 137 return make_fixnum_or_float (len);
149 if (! CONSP (list))
150 return make_number (0);
151
152 /* halftail is used to detect circular lists. */
153 for (tail = halftail = list; ; )
154 {
155 tail = XCDR (tail);
156 if (! CONSP (tail))
157 break;
158 if (EQ (tail, halftail))
159 break;
160 lolen++;
161 if ((lolen & 1) == 0)
162 {
163 halftail = XCDR (halftail);
164 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
165 {
166 maybe_quit ();
167 if (lolen == 0)
168 hilen += UINTMAX_MAX + 1.0;
169 }
170 }
171 }
172
173 /* If the length does not fit into a fixnum, return a float.
174 On all known practical machines this returns an upper bound on
175 the true length. */
176 return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
177} 138}
178 139
179DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, 140DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@@ -1383,14 +1344,10 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0,
1383The value is actually the tail of LIST whose car is ELT. */) 1344The value is actually the tail of LIST whose car is ELT. */)
1384 (Lisp_Object elt, Lisp_Object list) 1345 (Lisp_Object elt, Lisp_Object list)
1385{ 1346{
1386 unsigned short int quit_count = 0; 1347 Lisp_Object tail = list;
1387 Lisp_Object tail; 1348 FOR_EACH_TAIL (tail)
1388 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1349 if (! NILP (Fequal (elt, XCAR (tail))))
1389 { 1350 return tail;
1390 if (! NILP (Fequal (elt, XCAR (tail))))
1391 return tail;
1392 rarely_quit (++quit_count);
1393 }
1394 CHECK_LIST_END (tail, list); 1351 CHECK_LIST_END (tail, list);
1395 return Qnil; 1352 return Qnil;
1396} 1353}
@@ -1400,14 +1357,10 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1400The value is actually the tail of LIST whose car is ELT. */) 1357The value is actually the tail of LIST whose car is ELT. */)
1401 (Lisp_Object elt, Lisp_Object list) 1358 (Lisp_Object elt, Lisp_Object list)
1402{ 1359{
1403 unsigned short int quit_count = 0; 1360 Lisp_Object tail = list;
1404 Lisp_Object tail; 1361 FOR_EACH_TAIL (tail)
1405 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1362 if (EQ (XCAR (tail), elt))
1406 { 1363 return tail;
1407 if (EQ (XCAR (tail), elt))
1408 return tail;
1409 rarely_quit (++quit_count);
1410 }
1411 CHECK_LIST_END (tail, list); 1364 CHECK_LIST_END (tail, list);
1412 return Qnil; 1365 return Qnil;
1413} 1366}
@@ -1420,14 +1373,12 @@ The value is actually the tail of LIST whose car is ELT. */)
1420 if (!FLOATP (elt)) 1373 if (!FLOATP (elt))
1421 return Fmemq (elt, list); 1374 return Fmemq (elt, list);
1422 1375
1423 unsigned short int quit_count = 0; 1376 Lisp_Object tail = list;
1424 Lisp_Object tail; 1377 FOR_EACH_TAIL (tail)
1425 for (tail = list; CONSP (tail); tail = XCDR (tail))
1426 { 1378 {
1427 Lisp_Object tem = XCAR (tail); 1379 Lisp_Object tem = XCAR (tail);
1428 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) 1380 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
1429 return tail; 1381 return tail;
1430 rarely_quit (++quit_count);
1431 } 1382 }
1432 CHECK_LIST_END (tail, list); 1383 CHECK_LIST_END (tail, list);
1433 return Qnil; 1384 return Qnil;
@@ -1439,14 +1390,10 @@ The value is actually the first element of LIST whose car is KEY.
1439Elements of LIST that are not conses are ignored. */) 1390Elements of LIST that are not conses are ignored. */)
1440 (Lisp_Object key, Lisp_Object list) 1391 (Lisp_Object key, Lisp_Object list)
1441{ 1392{
1442 unsigned short int quit_count = 0; 1393 Lisp_Object tail = list;
1443 Lisp_Object tail; 1394 FOR_EACH_TAIL (tail)
1444 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1395 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1445 { 1396 return XCAR (tail);
1446 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1447 return XCAR (tail);
1448 rarely_quit (++quit_count);
1449 }
1450 CHECK_LIST_END (tail, list); 1397 CHECK_LIST_END (tail, list);
1451 return Qnil; 1398 return Qnil;
1452} 1399}
@@ -1468,15 +1415,13 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
1468The value is actually the first element of LIST whose car equals KEY. */) 1415The value is actually the first element of LIST whose car equals KEY. */)
1469 (Lisp_Object key, Lisp_Object list) 1416 (Lisp_Object key, Lisp_Object list)
1470{ 1417{
1471 unsigned short int quit_count = 0; 1418 Lisp_Object tail = list;
1472 Lisp_Object tail; 1419 FOR_EACH_TAIL (tail)
1473 for (tail = list; CONSP (tail); tail = XCDR (tail))
1474 { 1420 {
1475 Lisp_Object car = XCAR (tail); 1421 Lisp_Object car = XCAR (tail);
1476 if (CONSP (car) 1422 if (CONSP (car)
1477 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) 1423 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1478 return car; 1424 return car;
1479 rarely_quit (++quit_count);
1480 } 1425 }
1481 CHECK_LIST_END (tail, list); 1426 CHECK_LIST_END (tail, list);
1482 return Qnil; 1427 return Qnil;
@@ -1503,14 +1448,10 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1503The value is actually the first element of LIST whose cdr is KEY. */) 1448The value is actually the first element of LIST whose cdr is KEY. */)
1504 (Lisp_Object key, Lisp_Object list) 1449 (Lisp_Object key, Lisp_Object list)
1505{ 1450{
1506 unsigned short int quit_count = 0; 1451 Lisp_Object tail = list;
1507 Lisp_Object tail; 1452 FOR_EACH_TAIL (tail)
1508 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1453 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1509 { 1454 return XCAR (tail);
1510 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1511 return XCAR (tail);
1512 rarely_quit (++quit_count);
1513 }
1514 CHECK_LIST_END (tail, list); 1455 CHECK_LIST_END (tail, list);
1515 return Qnil; 1456 return Qnil;
1516} 1457}
@@ -1520,15 +1461,13 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
1520The value is actually the first element of LIST whose cdr equals KEY. */) 1461The value is actually the first element of LIST whose cdr equals KEY. */)
1521 (Lisp_Object key, Lisp_Object list) 1462 (Lisp_Object key, Lisp_Object list)
1522{ 1463{
1523 unsigned short int quit_count = 0; 1464 Lisp_Object tail = list;
1524 Lisp_Object tail; 1465 FOR_EACH_TAIL (tail)
1525 for (tail = list; CONSP (tail); tail = XCDR (tail))
1526 { 1466 {
1527 Lisp_Object car = XCAR (tail); 1467 Lisp_Object car = XCAR (tail);
1528 if (CONSP (car) 1468 if (CONSP (car)
1529 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) 1469 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
1530 return car; 1470 return car;
1531 rarely_quit (++quit_count);
1532 } 1471 }
1533 CHECK_LIST_END (tail, list); 1472 CHECK_LIST_END (tail, list);
1534 return Qnil; 1473 return Qnil;
@@ -1544,12 +1483,11 @@ list.
1544Write `(setq foo (delq element foo))' to be sure of correctly changing 1483Write `(setq foo (delq element foo))' to be sure of correctly changing
1545the value of a list `foo'. See also `remq', which does not modify the 1484the value of a list `foo'. See also `remq', which does not modify the
1546argument. */) 1485argument. */)
1547 (register Lisp_Object elt, Lisp_Object list) 1486 (Lisp_Object elt, Lisp_Object list)
1548{ 1487{
1549 Lisp_Object tail, tortoise, prev = Qnil; 1488 Lisp_Object prev = Qnil, tail = list;
1550 bool skip;
1551 1489
1552 FOR_EACH_TAIL (tail, list, tortoise, skip) 1490 FOR_EACH_TAIL (tail)
1553 { 1491 {
1554 Lisp_Object tem = XCAR (tail); 1492 Lisp_Object tem = XCAR (tail);
1555 if (EQ (elt, tem)) 1493 if (EQ (elt, tem))
@@ -1670,10 +1608,9 @@ changing the value of a sequence `foo'. */)
1670 } 1608 }
1671 else 1609 else
1672 { 1610 {
1673 unsigned short int quit_count = 0; 1611 Lisp_Object prev = Qnil, tail = seq;
1674 Lisp_Object tail, prev;
1675 1612
1676 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) 1613 FOR_EACH_TAIL (tail)
1677 { 1614 {
1678 if (!NILP (Fequal (elt, XCAR (tail)))) 1615 if (!NILP (Fequal (elt, XCAR (tail))))
1679 { 1616 {
@@ -1684,7 +1621,6 @@ changing the value of a sequence `foo'. */)
1684 } 1621 }
1685 else 1622 else
1686 prev = tail; 1623 prev = tail;
1687 rarely_quit (++quit_count);
1688 } 1624 }
1689 CHECK_LIST_END (tail, seq); 1625 CHECK_LIST_END (tail, seq);
1690 } 1626 }
@@ -1704,15 +1640,17 @@ This function may destructively modify SEQ to produce the value. */)
1704 return Freverse (seq); 1640 return Freverse (seq);
1705 else if (CONSP (seq)) 1641 else if (CONSP (seq))
1706 { 1642 {
1707 unsigned short int quit_count = 0;
1708 Lisp_Object prev, tail, next; 1643 Lisp_Object prev, tail, next;
1709 1644
1710 for (prev = Qnil, tail = seq; CONSP (tail); tail = next) 1645 for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
1711 { 1646 {
1712 next = XCDR (tail); 1647 next = XCDR (tail);
1648 /* If SEQ contains a cycle, attempting to reverse it
1649 in-place will inevitably come back to SEQ. */
1650 if (EQ (next, seq))
1651 circular_list (seq);
1713 Fsetcdr (tail, prev); 1652 Fsetcdr (tail, prev);
1714 prev = tail; 1653 prev = tail;
1715 rarely_quit (++quit_count);
1716 } 1654 }
1717 CHECK_LIST_END (tail, seq); 1655 CHECK_LIST_END (tail, seq);
1718 seq = prev; 1656 seq = prev;
@@ -1755,12 +1693,9 @@ See also the function `nreverse', which is used more often. */)
1755 return Qnil; 1693 return Qnil;
1756 else if (CONSP (seq)) 1694 else if (CONSP (seq))
1757 { 1695 {
1758 unsigned short int quit_count = 0; 1696 new = Qnil;
1759 for (new = Qnil; CONSP (seq); seq = XCDR (seq)) 1697 FOR_EACH_TAIL (seq)
1760 { 1698 new = Fcons (XCAR (seq), new);
1761 new = Fcons (XCAR (seq), new);
1762 rarely_quit (++quit_count);
1763 }
1764 CHECK_LIST_END (seq, seq); 1699 CHECK_LIST_END (seq, seq);
1765 } 1700 }
1766 else if (VECTORP (seq)) 1701 else if (VECTORP (seq))
@@ -2013,18 +1948,15 @@ corresponding to the given PROP, or nil if PROP is not one of the
2013properties on the list. This function never signals an error. */) 1948properties on the list. This function never signals an error. */)
2014 (Lisp_Object plist, Lisp_Object prop) 1949 (Lisp_Object plist, Lisp_Object prop)
2015{ 1950{
2016 Lisp_Object tail, halftail; 1951 Lisp_Object tail = plist;
2017 1952 FOR_EACH_TAIL_SAFE (tail)
2018 /* halftail is used to detect circular lists. */
2019 tail = halftail = plist;
2020 while (CONSP (tail) && CONSP (XCDR (tail)))
2021 { 1953 {
1954 if (! CONSP (XCDR (tail)))
1955 break;
2022 if (EQ (prop, XCAR (tail))) 1956 if (EQ (prop, XCAR (tail)))
2023 return XCAR (XCDR (tail)); 1957 return XCAR (XCDR (tail));
2024 1958 tail = XCDR (tail);
2025 tail = XCDR (XCDR (tail)); 1959 if (EQ (tail, li.tortoise))
2026 halftail = XCDR (halftail);
2027 if (EQ (tail, halftail))
2028 break; 1960 break;
2029 } 1961 }
2030 1962
@@ -2050,11 +1982,12 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
2050The PLIST is modified by side effects. */) 1982The PLIST is modified by side effects. */)
2051 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) 1983 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2052{ 1984{
2053 unsigned short int quit_count = 0; 1985 Lisp_Object prev = Qnil, tail = plist;
2054 Lisp_Object prev = Qnil; 1986 FOR_EACH_TAIL (tail)
2055 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2056 tail = XCDR (XCDR (tail)))
2057 { 1987 {
1988 if (! CONSP (XCDR (tail)))
1989 break;
1990
2058 if (EQ (prop, XCAR (tail))) 1991 if (EQ (prop, XCAR (tail)))
2059 { 1992 {
2060 Fsetcar (XCDR (tail), val); 1993 Fsetcar (XCDR (tail), val);
@@ -2062,8 +1995,11 @@ The PLIST is modified by side effects. */)
2062 } 1995 }
2063 1996
2064 prev = tail; 1997 prev = tail;
2065 rarely_quit (++quit_count); 1998 tail = XCDR (tail);
1999 if (EQ (tail, li.tortoise))
2000 circular_list (plist);
2066 } 2001 }
2002 CHECK_LIST_END (tail, plist);
2067 Lisp_Object newcell 2003 Lisp_Object newcell
2068 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); 2004 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
2069 if (NILP (prev)) 2005 if (NILP (prev))
@@ -2091,19 +2027,19 @@ corresponding to the given PROP, or nil if PROP is not
2091one of the properties on the list. */) 2027one of the properties on the list. */)
2092 (Lisp_Object plist, Lisp_Object prop) 2028 (Lisp_Object plist, Lisp_Object prop)
2093{ 2029{
2094 unsigned short int quit_count = 0; 2030 Lisp_Object tail = plist;
2095 Lisp_Object tail; 2031 FOR_EACH_TAIL (tail)
2096
2097 for (tail = plist;
2098 CONSP (tail) && CONSP (XCDR (tail));
2099 tail = XCDR (XCDR (tail)))
2100 { 2032 {
2033 if (! CONSP (XCDR (tail)))
2034 break;
2101 if (! NILP (Fequal (prop, XCAR (tail)))) 2035 if (! NILP (Fequal (prop, XCAR (tail))))
2102 return XCAR (XCDR (tail)); 2036 return XCAR (XCDR (tail));
2103 rarely_quit (++quit_count); 2037 tail = XCDR (tail);
2038 if (EQ (tail, li.tortoise))
2039 circular_list (plist);
2104 } 2040 }
2105 2041
2106 CHECK_LIST_END (tail, prop); 2042 CHECK_LIST_END (tail, plist);
2107 2043
2108 return Qnil; 2044 return Qnil;
2109} 2045}
@@ -2118,11 +2054,12 @@ use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
2118The PLIST is modified by side effects. */) 2054The PLIST is modified by side effects. */)
2119 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) 2055 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2120{ 2056{
2121 unsigned short int quit_count = 0; 2057 Lisp_Object prev = Qnil, tail = plist;
2122 Lisp_Object prev = Qnil; 2058 FOR_EACH_TAIL (tail)
2123 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2124 tail = XCDR (XCDR (tail)))
2125 { 2059 {
2060 if (! CONSP (XCDR (tail)))
2061 break;
2062
2126 if (! NILP (Fequal (prop, XCAR (tail)))) 2063 if (! NILP (Fequal (prop, XCAR (tail))))
2127 { 2064 {
2128 Fsetcar (XCDR (tail), val); 2065 Fsetcar (XCDR (tail), val);
@@ -2130,8 +2067,11 @@ The PLIST is modified by side effects. */)
2130 } 2067 }
2131 2068
2132 prev = tail; 2069 prev = tail;
2133 rarely_quit (++quit_count); 2070 tail = XCDR (tail);
2071 if (EQ (tail, li.tortoise))
2072 circular_list (plist);
2134 } 2073 }
2074 CHECK_LIST_END (tail, plist);
2135 Lisp_Object newcell = list2 (prop, val); 2075 Lisp_Object newcell = list2 (prop, val);
2136 if (NILP (prev)) 2076 if (NILP (prev))
2137 return newcell; 2077 return newcell;
@@ -2180,6 +2120,7 @@ static bool
2180internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, 2120internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2181 Lisp_Object ht) 2121 Lisp_Object ht)
2182{ 2122{
2123 tail_recurse:
2183 if (depth > 10) 2124 if (depth > 10)
2184 { 2125 {
2185 if (depth > 200) 2126 if (depth > 200)
@@ -2208,9 +2149,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2208 } 2149 }
2209 } 2150 }
2210 2151
2211 unsigned short int quit_count = 0;
2212 tail_recurse:
2213 rarely_quit (++quit_count);
2214 if (EQ (o1, o2)) 2152 if (EQ (o1, o2))
2215 return 1; 2153 return 1;
2216 if (XTYPE (o1) != XTYPE (o2)) 2154 if (XTYPE (o1) != XTYPE (o2))
@@ -2230,12 +2168,20 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2230 } 2168 }
2231 2169
2232 case Lisp_Cons: 2170 case Lisp_Cons:
2233 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht)) 2171 {
2234 return 0; 2172 FOR_EACH_TAIL (o1)
2235 o1 = XCDR (o1); 2173 {
2236 o2 = XCDR (o2); 2174 if (! CONSP (o2))
2237 /* FIXME: This inf-loops in a circular list! */ 2175 return false;
2238 goto tail_recurse; 2176 if (! internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
2177 return false;
2178 o2 = XCDR (o2);
2179 if (EQ (XCDR (o1), o2))
2180 return true;
2181 }
2182 depth++;
2183 goto tail_recurse;
2184 }
2239 2185
2240 case Lisp_Misc: 2186 case Lisp_Misc:
2241 if (XMISCTYPE (o1) != XMISCTYPE (o2)) 2187 if (XMISCTYPE (o1) != XMISCTYPE (o2))
@@ -2249,6 +2195,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2249 return 0; 2195 return 0;
2250 o1 = XOVERLAY (o1)->plist; 2196 o1 = XOVERLAY (o1)->plist;
2251 o2 = XOVERLAY (o2)->plist; 2197 o2 = XOVERLAY (o2)->plist;
2198 depth++;
2252 goto tail_recurse; 2199 goto tail_recurse;
2253 } 2200 }
2254 if (MARKERP (o1)) 2201 if (MARKERP (o1))
@@ -2399,7 +2346,6 @@ Only the last argument is not altered, and need not be a list.
2399usage: (nconc &rest LISTS) */) 2346usage: (nconc &rest LISTS) */)
2400 (ptrdiff_t nargs, Lisp_Object *args) 2347 (ptrdiff_t nargs, Lisp_Object *args)
2401{ 2348{
2402 unsigned short int quit_count = 0;
2403 Lisp_Object val = Qnil; 2349 Lisp_Object val = Qnil;
2404 2350
2405 for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) 2351 for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
@@ -2415,13 +2361,8 @@ usage: (nconc &rest LISTS) */)
2415 CHECK_CONS (tem); 2361 CHECK_CONS (tem);
2416 2362
2417 Lisp_Object tail; 2363 Lisp_Object tail;
2418 do 2364 FOR_EACH_TAIL (tem)
2419 { 2365 tail = tem;
2420 tail = tem;
2421 tem = XCDR (tail);
2422 rarely_quit (++quit_count);
2423 }
2424 while (CONSP (tem));
2425 2366
2426 tem = args[argnum + 1]; 2367 tem = args[argnum + 1];
2427 Fsetcdr (tail, tem); 2368 Fsetcdr (tail, tem);
@@ -2843,14 +2784,19 @@ property and a property with the value nil.
2843The value is actually the tail of PLIST whose car is PROP. */) 2784The value is actually the tail of PLIST whose car is PROP. */)
2844 (Lisp_Object plist, Lisp_Object prop) 2785 (Lisp_Object plist, Lisp_Object prop)
2845{ 2786{
2846 unsigned short int quit_count = 0; 2787 Lisp_Object tail = plist;
2847 while (CONSP (plist) && !EQ (XCAR (plist), prop)) 2788 FOR_EACH_TAIL (tail)
2848 { 2789 {
2849 plist = XCDR (plist); 2790 if (EQ (XCAR (tail), prop))
2850 plist = CDR (plist); 2791 return tail;
2851 rarely_quit (++quit_count); 2792 tail = XCDR (tail);
2793 if (! CONSP (tail))
2794 break;
2795 if (EQ (tail, li.tortoise))
2796 circular_list (tail);
2852 } 2797 }
2853 return plist; 2798 CHECK_LIST_END (tail, plist);
2799 return Qnil;
2854} 2800}
2855 2801
2856DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, 2802DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
diff --git a/src/image.c b/src/image.c
index ad0143be48b..1e8ebfd40d5 100644
--- a/src/image.c
+++ b/src/image.c
@@ -3110,8 +3110,8 @@ xbm_load (struct frame *f, struct image *img)
3110 int nbytes, i; 3110 int nbytes, i;
3111 /* Windows mono bitmaps are reversed compared with X. */ 3111 /* Windows mono bitmaps are reversed compared with X. */
3112 invertedBits = bits; 3112 invertedBits = bits;
3113 nbytes = (img->width + CHAR_BIT - 1) / CHAR_BIT; 3113 nbytes = (img->width + CHAR_BIT - 1) / CHAR_BIT * img->height;
3114 SAFE_NALLOCA (bits, nbytes, img->height); 3114 SAFE_NALLOCA (bits, 1, nbytes);
3115 for (i = 0; i < nbytes; i++) 3115 for (i = 0; i < nbytes; i++)
3116 bits[i] = XBM_BIT_SHUFFLE (invertedBits[i]); 3116 bits[i] = XBM_BIT_SHUFFLE (invertedBits[i]);
3117 } 3117 }
@@ -5465,7 +5465,17 @@ pbm_load (struct frame *f, struct image *img)
5465 c <<= 1; 5465 c <<= 1;
5466 } 5466 }
5467 else 5467 else
5468 g = pbm_scan_number (&p, end); 5468 {
5469 int c = 0;
5470 /* Skip white-space and comments. */
5471 while ((c = pbm_next_char (&p, end)) != -1 && c_isspace (c))
5472 ;
5473
5474 if (c == '0' || c == '1')
5475 g = c - '0';
5476 else
5477 g = 0;
5478 }
5469 5479
5470#ifdef USE_CAIRO 5480#ifdef USE_CAIRO
5471 *dataptr++ = g ? fga32 : bga32; 5481 *dataptr++ = g ? fga32 : bga32;
diff --git a/src/keyboard.c b/src/keyboard.c
index a86e7c5f8e4..ed8e71fd0a7 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10001,6 +10001,30 @@ See also `this-command-keys-vector'. */)
10001 XVECTOR (this_command_keys)->contents); 10001 XVECTOR (this_command_keys)->contents);
10002} 10002}
10003 10003
10004DEFUN ("set--this-command-keys", Fset__this_command_keys,
10005 Sset__this_command_keys, 1, 1, 0,
10006 doc: /* Set the vector to be returned by `this-command-keys'.
10007The argument KEYS must be a string.
10008Internal use only. */)
10009 (Lisp_Object keys)
10010{
10011 CHECK_STRING (keys);
10012
10013 this_command_key_count = 0;
10014 this_single_command_key_start = 0;
10015 int key0 = SREF (keys, 0);
10016
10017 /* Kludge alert: this makes M-x be in the form expected by
10018 novice.el. Any better ideas? */
10019 if (key0 == 248)
10020 add_command_key (make_number ('x' | meta_modifier));
10021 else
10022 add_command_key (make_number (key0));
10023 for (ptrdiff_t i = 1; i < SCHARS (keys); i++)
10024 add_command_key (make_number (SREF (keys, i)));
10025 return Qnil;
10026}
10027
10004DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0, 10028DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10005 doc: /* Return the key sequence that invoked this command, as a vector. 10029 doc: /* Return the key sequence that invoked this command, as a vector.
10006However, if the command has called `read-key-sequence', it returns 10030However, if the command has called `read-key-sequence', it returns
@@ -11211,6 +11235,7 @@ syms_of_keyboard (void)
11211 defsubr (&Sthis_command_keys_vector); 11235 defsubr (&Sthis_command_keys_vector);
11212 defsubr (&Sthis_single_command_keys); 11236 defsubr (&Sthis_single_command_keys);
11213 defsubr (&Sthis_single_command_raw_keys); 11237 defsubr (&Sthis_single_command_raw_keys);
11238 defsubr (&Sset__this_command_keys);
11214 defsubr (&Sclear_this_command_keys); 11239 defsubr (&Sclear_this_command_keys);
11215 defsubr (&Ssuspend_emacs); 11240 defsubr (&Ssuspend_emacs);
11216 defsubr (&Sabort_recursive_edit); 11241 defsubr (&Sabort_recursive_edit);
diff --git a/src/lisp.h b/src/lisp.h
index a9011b4a8be..f1e2685702d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3129,20 +3129,14 @@ extern void maybe_quit (void);
3129 3129
3130#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) 3130#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
3131 3131
3132/* Heuristic on how many iterations of a tight loop can be safely done
3133 before it's time to do a quit. This must be a power of 2. It
3134 is nice but not necessary for it to equal USHRT_MAX + 1. */
3135
3136enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
3137
3138/* Process a quit rarely, based on a counter COUNT, for efficiency. 3132/* Process a quit rarely, based on a counter COUNT, for efficiency.
3139 "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 3133 "Rarely" means once per USHRT_MAX + 1 times; this is somewhat
3140 times, whichever is smaller (somewhat arbitrary, but often faster). */ 3134 arbitrary, but efficient. */
3141 3135
3142INLINE void 3136INLINE void
3143rarely_quit (unsigned short int count) 3137rarely_quit (unsigned short int count)
3144{ 3138{
3145 if (! (count & (QUIT_COUNT_HEURISTIC - 1))) 3139 if (! count)
3146 maybe_quit (); 3140 maybe_quit ();
3147} 3141}
3148 3142
@@ -3317,6 +3311,7 @@ extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
3317extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); 3311extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
3318extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, 3312extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
3319 Lisp_Object); 3313 Lisp_Object);
3314extern _Noreturn void circular_list (Lisp_Object);
3320extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); 3315extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
3321enum Set_Internal_Bind { 3316enum Set_Internal_Bind {
3322 SET_INTERNAL_SET, 3317 SET_INTERNAL_SET,
@@ -4585,20 +4580,54 @@ enum
4585 Lisp_String)) \ 4580 Lisp_String)) \
4586 : make_unibyte_string (str, len)) 4581 : make_unibyte_string (str, len))
4587 4582
4588/* Loop over all tails of a list, checking for cycles. 4583/* Loop over conses of the list TAIL, signaling if a cycle is found,
4589 FIXME: Make tortoise and n internal declarations. 4584 and possibly quitting after each loop iteration. In the loop body,
4590 FIXME: Unroll the loop body so we don't need `n'. */ 4585 set TAIL to the current cons. If the loop exits normally,
4591#define FOR_EACH_TAIL(hare, list, tortoise, n) \ 4586 set TAIL to the terminating non-cons, typically nil. The loop body
4592 for ((tortoise) = (hare) = (list), (n) = true; \ 4587 should not modify the list’s top level structure other than by
4593 CONSP (hare); \ 4588 perhaps deleting the current cons. */
4594 (hare = XCDR (hare), (n) = !(n), \ 4589
4595 ((n) \ 4590#define FOR_EACH_TAIL(tail) \
4596 ? (EQ (hare, tortoise) \ 4591 FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true)
4597 ? xsignal1 (Qcircular_list, list) \ 4592
4598 : (void) 0) \ 4593/* Like FOR_EACH_TAIL (LIST), except do not signal or quit.
4599 /* Move tortoise before the next iteration, in case */ \ 4594 If the loop exits due to a cycle, TAIL’s value is undefined. */
4600 /* the next iteration does an Fsetcdr. */ \ 4595
4601 : (void) ((tortoise) = XCDR (tortoise))))) 4596#define FOR_EACH_TAIL_SAFE(tail) \
4597 FOR_EACH_TAIL_INTERNAL (tail, (void) ((tail) = Qnil), false)
4598
4599/* Iterator intended for use only within FOR_EACH_TAIL_INTERNAL. */
4600struct for_each_tail_internal
4601{
4602 Lisp_Object tortoise;
4603 intptr_t max, n;
4604 unsigned short int q;
4605};
4606
4607/* Like FOR_EACH_TAIL (LIST), except evaluate CYCLE if a cycle is
4608 found, and check for quit if CHECK_QUIT. This is an internal macro
4609 intended for use only by the above macros.
4610
4611 Use Brent’s teleporting tortoise-hare algorithm. See:
4612 Brent RP. BIT. 1980;20(2):176-84. doi:10.1007/BF01933190
4613 http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf
4614
4615 This macro uses maybe_quit because of an excess of caution. The
4616 call to maybe_quit should not be needed in practice, as a very long
4617 list, whether circular or not, will cause Emacs to be so slow in
4618 other noninterruptible areas (e.g., garbage collection) that there
4619 is little point to calling maybe_quit here. */
4620
4621#define FOR_EACH_TAIL_INTERNAL(tail, cycle, check_quit) \
4622 for (struct for_each_tail_internal li = { tail, 2, 0, 2 }; \
4623 CONSP (tail); \
4624 ((tail) = XCDR (tail), \
4625 ((--li.q != 0 \
4626 || ((check_quit) ? maybe_quit () : (void) 0, 0 < --li.n) \
4627 || (li.q = li.n = li.max <<= 1, li.n >>= USHRT_WIDTH, \
4628 li.tortoise = (tail), false)) \
4629 && EQ (tail, li.tortoise)) \
4630 ? (cycle) : (void) 0))
4602 4631
4603/* Do a `for' loop over alist values. */ 4632/* Do a `for' loop over alist values. */
4604 4633
diff --git a/src/xdisp.c b/src/xdisp.c
index 0e329dfe6e9..e59934d2d5a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -18972,7 +18972,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
18972 glyph->pixel_width, 18972 glyph->pixel_width,
18973 glyph->u.ch, 18973 glyph->u.ch,
18974 (glyph->u.ch < 0x80 && glyph->u.ch >= ' ' 18974 (glyph->u.ch < 0x80 && glyph->u.ch >= ' '
18975 ? glyph->u.ch 18975 ? (int) glyph->u.ch
18976 : '.'), 18976 : '.'),
18977 glyph->face_id, 18977 glyph->face_id,
18978 glyph->left_box_line_p, 18978 glyph->left_box_line_p,
@@ -18993,7 +18993,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
18993 ? '0' 18993 ? '0'
18994 : '-'))), 18994 : '-'))),
18995 glyph->pixel_width, 18995 glyph->pixel_width,
18996 0, 18996 0u,
18997 ' ', 18997 ' ',
18998 glyph->face_id, 18998 glyph->face_id,
18999 glyph->left_box_line_p, 18999 glyph->left_box_line_p,
@@ -19014,7 +19014,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
19014 ? '0' 19014 ? '0'
19015 : '-'))), 19015 : '-'))),
19016 glyph->pixel_width, 19016 glyph->pixel_width,
19017 glyph->u.img_id, 19017 (unsigned int) glyph->u.img_id,
19018 '.', 19018 '.',
19019 glyph->face_id, 19019 glyph->face_id,
19020 glyph->left_box_line_p, 19020 glyph->left_box_line_p,
@@ -19035,7 +19035,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
19035 ? '0' 19035 ? '0'
19036 : '-'))), 19036 : '-'))),
19037 glyph->pixel_width, 19037 glyph->pixel_width,
19038 glyph->u.cmp.id); 19038 (unsigned int) glyph->u.cmp.id);
19039 if (glyph->u.cmp.automatic) 19039 if (glyph->u.cmp.automatic)
19040 fprintf (stderr, 19040 fprintf (stderr,
19041 "[%d-%d]", 19041 "[%d-%d]",
@@ -20995,7 +20995,10 @@ display_line (struct it *it)
20995 up to the right margin of the window. */ 20995 up to the right margin of the window. */
20996 extend_face_to_end_of_line (it); 20996 extend_face_to_end_of_line (it);
20997 } 20997 }
20998 else if (it->c == '\t' && FRAME_WINDOW_P (it->f)) 20998 else if ((it->what == IT_CHARACTER
20999 || it->what == IT_STRETCH
21000 || it->what == IT_COMPOSITION)
21001 && it->c == '\t' && FRAME_WINDOW_P (it->f))
20999 { 21002 {
21000 /* A TAB that extends past the right edge of the 21003 /* A TAB that extends past the right edge of the
21001 window. This produces a single glyph on 21004 window. This produces a single glyph on
@@ -23033,30 +23036,19 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
23033 goto tail_recurse; 23036 goto tail_recurse;
23034 } 23037 }
23035 else if (STRINGP (car) || CONSP (car)) 23038 else if (STRINGP (car) || CONSP (car))
23036 { 23039 FOR_EACH_TAIL_SAFE (elt)
23037 Lisp_Object halftail = elt; 23040 {
23038 int len = 0; 23041 if (0 < precision && precision <= n)
23039 23042 break;
23040 while (CONSP (elt) 23043 n += display_mode_element (it, depth,
23041 && (precision <= 0 || n < precision)) 23044 /* Pad after only the last
23042 { 23045 list element. */
23043 n += display_mode_element (it, depth, 23046 (! CONSP (XCDR (elt))
23044 /* Do padding only after the last 23047 ? field_width - n
23045 element in the list. */ 23048 : 0),
23046 (! CONSP (XCDR (elt)) 23049 precision - n, XCAR (elt),
23047 ? field_width - n 23050 props, risky);
23048 : 0), 23051 }
23049 precision - n, XCAR (elt),
23050 props, risky);
23051 elt = XCDR (elt);
23052 len++;
23053 if ((len & 1) == 0)
23054 halftail = XCDR (halftail);
23055 /* Check for cycle. */
23056 if (EQ (halftail, elt))
23057 break;
23058 }
23059 }
23060 } 23052 }
23061 break; 23053 break;
23062 23054
@@ -24624,7 +24616,7 @@ dump_glyph_string (struct glyph_string *s)
24624 fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n", 24616 fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n",
24625 s->x, s->y, s->width, s->height); 24617 s->x, s->y, s->width, s->height);
24626 fprintf (stderr, " ybase = %d\n", s->ybase); 24618 fprintf (stderr, " ybase = %d\n", s->ybase);
24627 fprintf (stderr, " hl = %d\n", s->hl); 24619 fprintf (stderr, " hl = %u\n", s->hl);
24628 fprintf (stderr, " left overhang = %d, right = %d\n", 24620 fprintf (stderr, " left overhang = %d, right = %d\n",
24629 s->left_overhang, s->right_overhang); 24621 s->left_overhang, s->right_overhang);
24630 fprintf (stderr, " nchars = %d\n", s->nchars); 24622 fprintf (stderr, " nchars = %d\n", s->nchars);
diff --git a/src/xfaces.c b/src/xfaces.c
index 830106d64c0..b5dbb53ca20 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6251,7 +6251,7 @@ dump_realized_face (struct face *face)
6251 fprintf (stderr, "underline: %d (%s)\n", 6251 fprintf (stderr, "underline: %d (%s)\n",
6252 face->underline_p, 6252 face->underline_p,
6253 SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX]))); 6253 SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
6254 fprintf (stderr, "hash: %d\n", face->hash); 6254 fprintf (stderr, "hash: %u\n", face->hash);
6255} 6255}
6256 6256
6257 6257
diff --git a/src/xwidget.c b/src/xwidget.c
index 4ba1617d8df..5c276b1371c 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -301,13 +301,13 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value)
301 { 301 {
302 JSStringRef pname = JSStringCreateWithUTF8CString("length"); 302 JSStringRef pname = JSStringCreateWithUTF8CString("length");
303 JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, pname, NULL); 303 JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, pname, NULL);
304 int n = JSValueToNumber (context, len, NULL); 304 EMACS_INT n = JSValueToNumber (context, len, NULL);
305 JSStringRelease(pname); 305 JSStringRelease(pname);
306 306
307 Lisp_Object obj; 307 Lisp_Object obj;
308 struct Lisp_Vector *p = allocate_vector (n); 308 struct Lisp_Vector *p = allocate_vector (n);
309 309
310 for (int i = 0; i < n; ++i) 310 for (ptrdiff_t i = 0; i < n; ++i)
311 { 311 {
312 p->contents[i] = 312 p->contents[i] =
313 webkit_js_to_lisp (context, 313 webkit_js_to_lisp (context,
@@ -323,13 +323,13 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value)
323 JSPropertyNameArrayRef properties = 323 JSPropertyNameArrayRef properties =
324 JSObjectCopyPropertyNames (context, (JSObjectRef) value); 324 JSObjectCopyPropertyNames (context, (JSObjectRef) value);
325 325
326 int n = JSPropertyNameArrayGetCount (properties); 326 ptrdiff_t n = JSPropertyNameArrayGetCount (properties);
327 Lisp_Object obj; 327 Lisp_Object obj;
328 328
329 /* TODO: can we use a regular list here? */ 329 /* TODO: can we use a regular list here? */
330 struct Lisp_Vector *p = allocate_vector (n); 330 struct Lisp_Vector *p = allocate_vector (n);
331 331
332 for (int i = 0; i < n; ++i) 332 for (ptrdiff_t i = 0; i < n; ++i)
333 { 333 {
334 JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i); 334 JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i);
335 JSValueRef property = JSObjectGetProperty (context, 335 JSValueRef property = JSObjectGetProperty (context,
@@ -733,8 +733,8 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0,
733 (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height) 733 (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height)
734{ 734{
735 CHECK_XWIDGET (xwidget); 735 CHECK_XWIDGET (xwidget);
736 CHECK_NATNUM (new_width); 736 CHECK_RANGED_INTEGER (new_width, 0, INT_MAX);
737 CHECK_NATNUM (new_height); 737 CHECK_RANGED_INTEGER (new_height, 0, INT_MAX);
738 struct xwidget *xw = XXWIDGET (xwidget); 738 struct xwidget *xw = XXWIDGET (xwidget);
739 int w = XFASTINT (new_width); 739 int w = XFASTINT (new_width);
740 int h = XFASTINT (new_height); 740 int h = XFASTINT (new_height);
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 27434bcef20..dcd83a3ef3b 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -676,6 +676,9 @@ delivered."
676 buf) 676 buf)
677 (unwind-protect 677 (unwind-protect
678 (progn 678 (progn
679 ;; In the remote case, `vc-refresh-state' returns undesired
680 ;; error messages. Let's suppress them.
681 (advice-add 'vc-refresh-state :around 'ignore)
679 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) 682 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
680 (write-region 683 (write-region
681 "any text" nil file-notify--test-tmpfile nil 'no-message) 684 "any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -745,6 +748,7 @@ delivered."
745 (file-notify--test-cleanup-p)) 748 (file-notify--test-cleanup-p))
746 749
747 ;; Cleanup. 750 ;; Cleanup.
751 (advice-remove 'vc-refresh-state 'ignore)
748 (ignore-errors (kill-buffer buf)) 752 (ignore-errors (kill-buffer buf))
749 (file-notify--test-cleanup)))) 753 (file-notify--test-cleanup))))
750 754
diff --git a/test/lisp/progmodes/bat-mode-tests.el b/test/lisp/progmodes/bat-mode-tests.el
new file mode 100644
index 00000000000..565718eea41
--- /dev/null
+++ b/test/lisp/progmodes/bat-mode-tests.el
@@ -0,0 +1,86 @@
1;;; bat-mode-tests.el --- Tests for bat-mode.el -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Vladimir Panteleev <vladimir@thecybershadow.net>
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 <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;;
26
27;;; Code:
28
29(require 'ert)
30(require 'bat-mode)
31(require 'htmlfontify)
32
33(defun bat-test-fontify (str)
34 "Fontify STR in `bat-mode' to a HTML string using `htmlfontify' and return it."
35 (with-temp-buffer
36 (insert str)
37 (bat-mode)
38 (let ((hfy-optimizations '(body-text-only merge-adjacent-tags)))
39 (with-current-buffer (htmlfontify-buffer) (buffer-string)))))
40
41(ert-deftest bat-test-fontification-var-decl ()
42 "Test fontification of variable declarations."
43 (should
44 (equal
45 (bat-test-fontify "set a_b-c{d}e=f")
46 "<span class=\"builtin\">set</span> <span class=\"variable-name\">a_b-c{d}e</span>=f")))
47
48(ert-deftest bat-test-fontification-var-exp ()
49 "Test fontification of variable expansions."
50 (should
51 (equal
52 (bat-test-fontify "echo %a_b-c{d}e%")
53 "<span class=\"builtin\">echo</span> %<span class=\"variable-name\">a_b-c{d}e</span>%")))
54
55(ert-deftest bat-test-fontification-var-delayed-exp ()
56 "Test fontification of delayed variable expansions."
57 (should
58 (equal
59 (bat-test-fontify "echo !a_b-c{d}e!")
60 "<span class=\"builtin\">echo</span> !<span class=\"variable-name\">a_b-c{d}e</span>!")))
61
62(ert-deftest bat-test-fontification-iter-var-1 ()
63 "Test fontification of iteration variables."
64 (should
65 (equal
66 (bat-test-fontify "echo %%a\necho %%~dp1\necho %%~$PATH:I")
67 "<span class=\"builtin\">echo</span> %%<span class=\"variable-name\">a</span>
68<span class=\"builtin\">echo</span> %%~dp<span class=\"variable-name\">1</span>
69<span class=\"builtin\">echo</span> %%~$<span class=\"variable-name\">PATH</span>:<span class=\"variable-name\">I</span>")))
70
71(defun bat-test-fill-paragraph (str)
72 "Return the result of invoking `fill-paragraph' on STR in a `bat-mode' buffer."
73 (with-temp-buffer
74 (bat-mode)
75 (insert str)
76 (goto-char 1)
77 (font-lock-ensure)
78 (fill-paragraph)
79 (buffer-string)))
80
81(ert-deftest bat-test-fill-paragraph-comment ()
82 "Test `fill-paragraph' in a comment block."
83 (should (equal (bat-test-fill-paragraph "rem foo\nrem bar\n") "rem foo bar\n")))
84
85(provide 'bat-tests)
86;;; bat-mode-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index ee3c5dc77e4..160d0f106e9 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -245,3 +245,301 @@
245 (let ((data '((foo) (bar)))) 245 (let ((data '((foo) (bar))))
246 (should (equal (mapcan #'identity data) '(foo bar))) 246 (should (equal (mapcan #'identity data) '(foo bar)))
247 (should (equal data '((foo bar) (bar)))))) 247 (should (equal data '((foo bar) (bar))))))
248
249;; Test handling of cyclic and dotted lists.
250
251(defun cyc1 (a)
252 (let ((ls (make-list 10 a)))
253 (nconc ls ls)
254 ls))
255
256(defun cyc2 (a b)
257 (let ((ls1 (make-list 10 a))
258 (ls2 (make-list 1000 b)))
259 (nconc ls2 ls2)
260 (nconc ls1 ls2)
261 ls1))
262
263(defun dot1 (a)
264 (let ((ls (make-list 10 a)))
265 (nconc ls 'tail)
266 ls))
267
268(defun dot2 (a b)
269 (let ((ls1 (make-list 10 a))
270 (ls2 (make-list 10 b)))
271 (nconc ls1 ls2)
272 (nconc ls2 'tail)
273 ls1))
274
275(ert-deftest test-cycle-length ()
276 (should-error (length (cyc1 1)) :type 'circular-list)
277 (should-error (length (cyc2 1 2)) :type 'circular-list)
278 (should-error (length (dot1 1)) :type 'wrong-type-argument)
279 (should-error (length (dot2 1 2)) :type 'wrong-type-argument))
280
281(ert-deftest test-cycle-safe-length ()
282 (should (<= 10 (safe-length (cyc1 1))))
283 (should (<= 1010 (safe-length (cyc2 1 2))))
284 (should (= 10 (safe-length (dot1 1))))
285 (should (= 20 (safe-length (dot2 1 2)))))
286
287(ert-deftest test-cycle-member ()
288 (let ((c1 (cyc1 1))
289 (c2 (cyc2 1 2))
290 (d1 (dot1 1))
291 (d2 (dot2 1 2)))
292 (should (member 1 c1))
293 (should (member 1 c2))
294 (should (member 1 d1))
295 (should (member 1 d2))
296 (should-error (member 2 c1) :type 'circular-list)
297 (should (member 2 c2))
298 (should-error (member 2 d1) :type 'wrong-type-argument)
299 (should (member 2 d2))
300 (should-error (member 3 c1) :type 'circular-list)
301 (should-error (member 3 c2) :type 'circular-list)
302 (should-error (member 3 d1) :type 'wrong-type-argument)
303 (should-error (member 3 d2) :type 'wrong-type-argument)))
304
305(ert-deftest test-cycle-memq ()
306 (let ((c1 (cyc1 1))
307 (c2 (cyc2 1 2))
308 (d1 (dot1 1))
309 (d2 (dot2 1 2)))
310 (should (memq 1 c1))
311 (should (memq 1 c2))
312 (should (memq 1 d1))
313 (should (memq 1 d2))
314 (should-error (memq 2 c1) :type 'circular-list)
315 (should (memq 2 c2))
316 (should-error (memq 2 d1) :type 'wrong-type-argument)
317 (should (memq 2 d2))
318 (should-error (memq 3 c1) :type 'circular-list)
319 (should-error (memq 3 c2) :type 'circular-list)
320 (should-error (memq 3 d1) :type 'wrong-type-argument)
321 (should-error (memq 3 d2) :type 'wrong-type-argument)))
322
323(ert-deftest test-cycle-memql ()
324 (let ((c1 (cyc1 1))
325 (c2 (cyc2 1 2))
326 (d1 (dot1 1))
327 (d2 (dot2 1 2)))
328 (should (memql 1 c1))
329 (should (memql 1 c2))
330 (should (memql 1 d1))
331 (should (memql 1 d2))
332 (should-error (memql 2 c1) :type 'circular-list)
333 (should (memql 2 c2))
334 (should-error (memql 2 d1) :type 'wrong-type-argument)
335 (should (memql 2 d2))
336 (should-error (memql 3 c1) :type 'circular-list)
337 (should-error (memql 3 c2) :type 'circular-list)
338 (should-error (memql 3 d1) :type 'wrong-type-argument)
339 (should-error (memql 3 d2) :type 'wrong-type-argument)))
340
341(ert-deftest test-cycle-assq ()
342 (let ((c1 (cyc1 '(1)))
343 (c2 (cyc2 '(1) '(2)))
344 (d1 (dot1 '(1)))
345 (d2 (dot2 '(1) '(2))))
346 (should (assq 1 c1))
347 (should (assq 1 c2))
348 (should (assq 1 d1))
349 (should (assq 1 d2))
350 (should-error (assq 2 c1) :type 'circular-list)
351 (should (assq 2 c2))
352 (should-error (assq 2 d1) :type 'wrong-type-argument)
353 (should (assq 2 d2))
354 (should-error (assq 3 c1) :type 'circular-list)
355 (should-error (assq 3 c2) :type 'circular-list)
356 (should-error (assq 3 d1) :type 'wrong-type-argument)
357 (should-error (assq 3 d2) :type 'wrong-type-argument)))
358
359(ert-deftest test-cycle-assoc ()
360 (let ((c1 (cyc1 '(1)))
361 (c2 (cyc2 '(1) '(2)))
362 (d1 (dot1 '(1)))
363 (d2 (dot2 '(1) '(2))))
364 (should (assoc 1 c1))
365 (should (assoc 1 c2))
366 (should (assoc 1 d1))
367 (should (assoc 1 d2))
368 (should-error (assoc 2 c1) :type 'circular-list)
369 (should (assoc 2 c2))
370 (should-error (assoc 2 d1) :type 'wrong-type-argument)
371 (should (assoc 2 d2))
372 (should-error (assoc 3 c1) :type 'circular-list)
373 (should-error (assoc 3 c2) :type 'circular-list)
374 (should-error (assoc 3 d1) :type 'wrong-type-argument)
375 (should-error (assoc 3 d2) :type 'wrong-type-argument)))
376
377(ert-deftest test-cycle-rassq ()
378 (let ((c1 (cyc1 '(0 . 1)))
379 (c2 (cyc2 '(0 . 1) '(0 . 2)))
380 (d1 (dot1 '(0 . 1)))
381 (d2 (dot2 '(0 . 1) '(0 . 2))))
382 (should (rassq 1 c1))
383 (should (rassq 1 c2))
384 (should (rassq 1 d1))
385 (should (rassq 1 d2))
386 (should-error (rassq 2 c1) :type 'circular-list)
387 (should (rassq 2 c2))
388 (should-error (rassq 2 d1) :type 'wrong-type-argument)
389 (should (rassq 2 d2))
390 (should-error (rassq 3 c1) :type 'circular-list)
391 (should-error (rassq 3 c2) :type 'circular-list)
392 (should-error (rassq 3 d1) :type 'wrong-type-argument)
393 (should-error (rassq 3 d2) :type 'wrong-type-argument)))
394
395(ert-deftest test-cycle-rassoc ()
396 (let ((c1 (cyc1 '(0 . 1)))
397 (c2 (cyc2 '(0 . 1) '(0 . 2)))
398 (d1 (dot1 '(0 . 1)))
399 (d2 (dot2 '(0 . 1) '(0 . 2))))
400 (should (rassoc 1 c1))
401 (should (rassoc 1 c2))
402 (should (rassoc 1 d1))
403 (should (rassoc 1 d2))
404 (should-error (rassoc 2 c1) :type 'circular-list)
405 (should (rassoc 2 c2))
406 (should-error (rassoc 2 d1) :type 'wrong-type-argument)
407 (should (rassoc 2 d2))
408 (should-error (rassoc 3 c1) :type 'circular-list)
409 (should-error (rassoc 3 c2) :type 'circular-list)
410 (should-error (rassoc 3 d1) :type 'wrong-type-argument)
411 (should-error (rassoc 3 d2) :type 'wrong-type-argument)))
412
413(ert-deftest test-cycle-delq ()
414 (should-error (delq 1 (cyc1 1)) :type 'circular-list)
415 (should-error (delq 1 (cyc2 1 2)) :type 'circular-list)
416 (should-error (delq 1 (dot1 1)) :type 'wrong-type-argument)
417 (should-error (delq 1 (dot2 1 2)) :type 'wrong-type-argument)
418 (should-error (delq 2 (cyc1 1)) :type 'circular-list)
419 (should-error (delq 2 (cyc2 1 2)) :type 'circular-list)
420 (should-error (delq 2 (dot1 1)) :type 'wrong-type-argument)
421 (should-error (delq 2 (dot2 1 2)) :type 'wrong-type-argument)
422 (should-error (delq 3 (cyc1 1)) :type 'circular-list)
423 (should-error (delq 3 (cyc2 1 2)) :type 'circular-list)
424 (should-error (delq 3 (dot1 1)) :type 'wrong-type-argument)
425 (should-error (delq 3 (dot2 1 2)) :type 'wrong-type-argument))
426
427(ert-deftest test-cycle-delete ()
428 (should-error (delete 1 (cyc1 1)) :type 'circular-list)
429 (should-error (delete 1 (cyc2 1 2)) :type 'circular-list)
430 (should-error (delete 1 (dot1 1)) :type 'wrong-type-argument)
431 (should-error (delete 1 (dot2 1 2)) :type 'wrong-type-argument)
432 (should-error (delete 2 (cyc1 1)) :type 'circular-list)
433 (should-error (delete 2 (cyc2 1 2)) :type 'circular-list)
434 (should-error (delete 2 (dot1 1)) :type 'wrong-type-argument)
435 (should-error (delete 2 (dot2 1 2)) :type 'wrong-type-argument)
436 (should-error (delete 3 (cyc1 1)) :type 'circular-list)
437 (should-error (delete 3 (cyc2 1 2)) :type 'circular-list)
438 (should-error (delete 3 (dot1 1)) :type 'wrong-type-argument)
439 (should-error (delete 3 (dot2 1 2)) :type 'wrong-type-argument))
440
441(ert-deftest test-cycle-reverse ()
442 (should-error (reverse (cyc1 1)) :type 'circular-list)
443 (should-error (reverse (cyc2 1 2)) :type 'circular-list)
444 (should-error (reverse (dot1 1)) :type 'wrong-type-argument)
445 (should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
446
447(ert-deftest test-cycle-plist-get ()
448 (let ((c1 (cyc1 1))
449 (c2 (cyc2 1 2))
450 (d1 (dot1 1))
451 (d2 (dot2 1 2)))
452 (should (plist-get c1 1))
453 (should (plist-get c2 1))
454 (should (plist-get d1 1))
455 (should (plist-get d2 1))
456 (should-not (plist-get c1 2))
457 (should (plist-get c2 2))
458 (should-not (plist-get d1 2))
459 (should (plist-get d2 2))
460 (should-not (plist-get c1 3))
461 (should-not (plist-get c2 3))
462 (should-not (plist-get d1 3))
463 (should-not (plist-get d2 3))))
464
465(ert-deftest test-cycle-lax-plist-get ()
466 (let ((c1 (cyc1 1))
467 (c2 (cyc2 1 2))
468 (d1 (dot1 1))
469 (d2 (dot2 1 2)))
470 (should (lax-plist-get c1 1))
471 (should (lax-plist-get c2 1))
472 (should (lax-plist-get d1 1))
473 (should (lax-plist-get d2 1))
474 (should-error (lax-plist-get c1 2) :type 'circular-list)
475 (should (lax-plist-get c2 2))
476 (should-not (lax-plist-get d1 2))
477 (should (lax-plist-get d2 2))
478 (should-error (lax-plist-get c1 3) :type 'circular-list)
479 (should-error (lax-plist-get c2 3) :type 'circular-list)
480 (should-not (lax-plist-get d1 3))
481 (should-not (lax-plist-get d2 3))))
482
483(ert-deftest test-cycle-plist-member ()
484 (let ((c1 (cyc1 1))
485 (c2 (cyc2 1 2))
486 (d1 (dot1 1))
487 (d2 (dot2 1 2)))
488 (should (plist-member c1 1))
489 (should (plist-member c2 1))
490 (should (plist-member d1 1))
491 (should (plist-member d2 1))
492 (should-error (plist-member c1 2) :type 'circular-list)
493 (should (plist-member c2 2))
494 (should-error (plist-member d1 2) :type 'wrong-type-argument)
495 (should (plist-member d2 2))
496 (should-error (plist-member c1 3) :type 'circular-list)
497 (should-error (plist-member c2 3) :type 'circular-list)
498 (should-error (plist-member d1 3) :type 'wrong-type-argument)
499 (should-error (plist-member d2 3) :type 'wrong-type-argument)))
500
501(ert-deftest test-cycle-plist-put ()
502 (let ((c1 (cyc1 1))
503 (c2 (cyc2 1 2))
504 (d1 (dot1 1))
505 (d2 (dot2 1 2)))
506 (should (plist-put c1 1 1))
507 (should (plist-put c2 1 1))
508 (should (plist-put d1 1 1))
509 (should (plist-put d2 1 1))
510 (should-error (plist-put c1 2 2) :type 'circular-list)
511 (should (plist-put c2 2 2))
512 (should (plist-put d1 2 2))
513 (should (plist-put d2 2 2))
514 (should-error (plist-put c1 3 3) :type 'circular-list)
515 (should-error (plist-put c2 3 3) :type 'circular-list)
516 (should (plist-put d1 3 3))
517 (should (plist-put d2 3 3))))
518
519(ert-deftest test-cycle-lax-plist-put ()
520 (let ((c1 (cyc1 1))
521 (c2 (cyc2 1 2))
522 (d1 (dot1 1))
523 (d2 (dot2 1 2)))
524 (should (lax-plist-put c1 1 1))
525 (should (lax-plist-put c2 1 1))
526 (should (lax-plist-put d1 1 1))
527 (should (lax-plist-put d2 1 1))
528 (should-error (lax-plist-put c1 2 2) :type 'circular-list)
529 (should (lax-plist-put c2 2 2))
530 (should (lax-plist-put d1 2 2))
531 (should (lax-plist-put d2 2 2))
532 (should-error (lax-plist-put c1 3 3) :type 'circular-list)
533 (should-error (lax-plist-put c2 3 3) :type 'circular-list)
534 (should (lax-plist-put d1 3 3))
535 (should (lax-plist-put d2 3 3))))
536
537(ert-deftest test-cycle-equal ()
538 (should-error (equal (cyc1 1) (cyc1 1)))
539 (should-error (equal (cyc2 1 2) (cyc2 1 2))))
540
541(ert-deftest test-cycle-nconc ()
542 (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
543 (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
544
545(provide 'fns-tests)