diff options
| author | Vibhav Pant | 2017-02-11 19:54:37 +0530 |
|---|---|---|
| committer | Vibhav Pant | 2017-02-11 19:54:37 +0530 |
| commit | c1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3 (patch) | |
| tree | a33cb8c57d628541baee88bef5b0907327056e88 | |
| parent | a75d080b17a6b6c6296ff4e24d8129d77bb3bb6b (diff) | |
| parent | ac83b2dfe4504babfbafc5efb37dbde4bed34fed (diff) | |
| download | emacs-c1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3.tar.gz emacs-c1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3.zip | |
Merge branch 'master' into feature/byte-switch
| -rw-r--r-- | Makefile.in | 8 | ||||
| -rw-r--r-- | doc/emacs/search.texi | 8 | ||||
| -rw-r--r-- | etc/NEWS | 10 | ||||
| -rw-r--r-- | etc/themes/tsdh-light-theme.el | 21 | ||||
| -rw-r--r-- | lisp/descr-text.el | 16 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 6 | ||||
| -rw-r--r-- | lisp/eshell/esh-proc.el | 16 | ||||
| -rw-r--r-- | lisp/gnus/gnus-msg.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/mm-decode.el | 19 | ||||
| -rw-r--r-- | lisp/ibuf-ext.el | 46 | ||||
| -rw-r--r-- | lisp/ibuf-macs.el | 10 | ||||
| -rw-r--r-- | lisp/ibuffer.el | 10 | ||||
| -rw-r--r-- | lisp/info.el | 7 | ||||
| -rw-r--r-- | lisp/isearch.el | 8 | ||||
| -rw-r--r-- | lisp/progmodes/bat-mode.el | 11 | ||||
| -rw-r--r-- | lisp/progmodes/grep.el | 26 | ||||
| -rw-r--r-- | lisp/simple.el | 3 | ||||
| -rw-r--r-- | lisp/textmodes/css-mode.el | 2 | ||||
| -rw-r--r-- | lisp/xdg.el | 144 | ||||
| -rw-r--r-- | src/composite.c | 89 | ||||
| -rw-r--r-- | src/data.c | 6 | ||||
| -rw-r--r-- | src/dispextern.h | 2 | ||||
| -rw-r--r-- | src/fns.c | 262 | ||||
| -rw-r--r-- | src/image.c | 16 | ||||
| -rw-r--r-- | src/keyboard.c | 25 | ||||
| -rw-r--r-- | src/lisp.h | 75 | ||||
| -rw-r--r-- | src/xdisp.c | 52 | ||||
| -rw-r--r-- | src/xfaces.c | 2 | ||||
| -rw-r--r-- | src/xwidget.c | 12 | ||||
| -rw-r--r-- | test/lisp/filenotify-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/progmodes/bat-mode-tests.el | 86 | ||||
| -rw-r--r-- | test/src/fns-tests.el | 298 |
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 | ||
| 1021 | INSTALL_DVI = install-emacs-dvi install-lispref-dvi \ | 1019 | INSTALL_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 | |||
| 609 | so that the matching can proceed incrementally as you type. This | 609 | so that the matching can proceed incrementally as you type. This |
| 610 | additional laxity does not apply to the lazy highlight | 610 | additional 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. |
| 612 | While you are typing the search string, @samp{Pending} appears in the | ||
| 613 | search 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 |
| 614 | toggling lax whitespace matching (@pxref{Lax Search, lax space | 616 | toggling lax whitespace matching (@pxref{Lax Search, lax space |
| @@ -661,8 +663,10 @@ search is not already active, this runs the command | |||
| 661 | active, @kbd{M-s _} switches to a symbol search, preserving the | 663 | active, @kbd{M-s _} switches to a symbol search, preserving the |
| 662 | direction of the search and the current search string; you can disable | 664 | direction of the search and the current search string; you can disable |
| 663 | symbol search by typing @kbd{M-s _} again. In incremental symbol | 665 | symbol search by typing @kbd{M-s _} again. In incremental symbol |
| 664 | search, only the beginning of the search string is required to match | 666 | search, while you are typing the search string, only the beginning |
| 665 | the beginning of a symbol. | 667 | of the search string is required to match the beginning of a symbol, |
| 668 | and @samp{Pending} appears in the search prompt until you use a search | ||
| 669 | repeating 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}} |
| 668 | for a forward search, or @kbd{M-s _ C-r @key{RET}} or a backward | 672 | for a forward search, or @kbd{M-s _ C-r @key{RET}} or a backward |
| @@ -617,8 +617,9 @@ Drive onsite repositories. | |||
| 617 | manual documents how to configure ssh and PuTTY accordingly. | 617 | manual documents how to configure ssh and PuTTY accordingly. |
| 618 | 618 | ||
| 619 | +++ | 619 | +++ |
| 620 | Setting the "ENV" environment variable in 'tramp-remote-process-environment' | 620 | *** Setting the "ENV" environment variable in |
| 621 | enables reading of shell initialization files. | 621 | 'tramp-remote-process-environment' enables reading of shell |
| 622 | initialization 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. |
| 901 | The incumbent 'if-let' and 'when-let' are now aliases. | 904 | The incumbent 'if-let' and 'when-let' are now aliases. |
| 902 | 905 | ||
| 906 | ** Low-level list functions like 'length' and 'member' now do a better | ||
| 907 | job 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' |
| 905 | can be used for creation of temporary files of remote or mounted directories. | 911 | can 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. |
| 24 | Used and created by Tassilo Horn.") | 24 | Used 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: | |||
| 198 | ACTIVE-OPSTRING is a string which will be displayed to the user in a | 200 | ACTIVE-OPSTRING is a string which will be displayed to the user in a |
| 199 | confirmation message, in the form: | 201 | confirmation message, in the form: |
| 200 | \"Really ACTIVE-OPSTRING x buffers?\" | 202 | \"Really ACTIVE-OPSTRING x buffers?\" |
| 203 | BEFORE is a form to evaluate before start the operation. | ||
| 204 | AFTER is a form to evaluate once the operation is complete. | ||
| 201 | COMPLEX means this function is special; if COMPLEX is nil BODY | 205 | COMPLEX means this function is special; if COMPLEX is nil BODY |
| 202 | evaluates once for each marked buffer, MBUF, with MBUF current | 206 | evaluates once for each marked buffer, MBUF, with MBUF current |
| 203 | and saving the point. If COMPLEX is non-nil, BODY evaluates | 207 | and 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 | |||
| 206 | marked buffer. BODY is evaluated with `buf' bound to the | 210 | marked buffer. BODY is evaluated with `buf' bound to the |
| 207 | buffer object. | 211 | buffer 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 | ||
| 2565 | Filtering commands: | 2565 | Filtering 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'. | |||
| 175 | Run script using `bat-run' and `bat-run-args'.\n | 179 | Run 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. | ||
| 83 | If FILENAME has absolute path /foo/bar.jpg, its canonical URI is | ||
| 84 | file:///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. | ||
| 114 | This 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 | ||
| 173 | void | ||
| 174 | circular_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. */ |
| @@ -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 | |||
| 142 | which is at least the number of distinct elements. */) | 131 | which 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 | ||
| 179 | DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, | 140 | DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, |
| @@ -1383,14 +1344,10 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0, | |||
| 1383 | The value is actually the tail of LIST whose car is ELT. */) | 1344 | The 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, | |||
| 1400 | The value is actually the tail of LIST whose car is ELT. */) | 1357 | The 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. | |||
| 1439 | Elements of LIST that are not conses are ignored. */) | 1390 | Elements 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, | |||
| 1468 | The value is actually the first element of LIST whose car equals KEY. */) | 1415 | The 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, | |||
| 1503 | The value is actually the first element of LIST whose cdr is KEY. */) | 1448 | The 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, | |||
| 1520 | The value is actually the first element of LIST whose cdr equals KEY. */) | 1461 | The 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. | |||
| 1544 | Write `(setq foo (delq element foo))' to be sure of correctly changing | 1483 | Write `(setq foo (delq element foo))' to be sure of correctly changing |
| 1545 | the value of a list `foo'. See also `remq', which does not modify the | 1484 | the value of a list `foo'. See also `remq', which does not modify the |
| 1546 | argument. */) | 1485 | argument. */) |
| 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 | |||
| 2013 | properties on the list. This function never signals an error. */) | 1948 | properties 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. | |||
| 2050 | The PLIST is modified by side effects. */) | 1982 | The 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 | |||
| 2091 | one of the properties on the list. */) | 2027 | one 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. | |||
| 2118 | The PLIST is modified by side effects. */) | 2054 | The 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 | |||
| 2180 | internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, | 2120 | internal_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. | |||
| 2399 | usage: (nconc &rest LISTS) */) | 2346 | usage: (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. | |||
| 2843 | The value is actually the tail of PLIST whose car is PROP. */) | 2784 | The 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 | ||
| 2856 | DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, | 2802 | DEFUN ("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 | ||
| 10004 | DEFUN ("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'. | ||
| 10007 | The argument KEYS must be a string. | ||
| 10008 | Internal 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 | |||
| 10004 | DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0, | 10028 | DEFUN ("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. |
| 10006 | However, if the command has called `read-key-sequence', it returns | 10030 | However, 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 | |||
| 3136 | enum { 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 | ||
| 3142 | INLINE void | 3136 | INLINE void |
| 3143 | rarely_quit (unsigned short int count) | 3137 | rarely_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 *); | |||
| 3317 | extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); | 3311 | extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); |
| 3318 | extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, | 3312 | extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, |
| 3319 | Lisp_Object); | 3313 | Lisp_Object); |
| 3314 | extern _Noreturn void circular_list (Lisp_Object); | ||
| 3320 | extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); | 3315 | extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); |
| 3321 | enum Set_Internal_Bind { | 3316 | enum 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. */ | ||
| 4600 | struct 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) | ||