[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/byte-switch c1a9b5d: Merge branch 'master' into fe
|
From: |
Vibhav Pant |
|
Subject: |
[Emacs-diffs] feature/byte-switch c1a9b5d: Merge branch 'master' into feature/byte-switch |
|
Date: |
Sat, 11 Feb 2017 09:25:16 -0500 (EST) |
branch: feature/byte-switch
commit c1a9b5db0e2985e7c46fb3b1e50e9d17785f7fa3
Merge: a75d080 ac83b2d
Author: Vibhav Pant <address@hidden>
Commit: Vibhav Pant <address@hidden>
Merge branch 'master' into feature/byte-switch
---
Makefile.in | 8 +-
doc/emacs/search.texi | 8 +-
etc/NEWS | 10 +-
etc/themes/tsdh-light-theme.el | 21 ++-
lisp/descr-text.el | 16 +-
lisp/emacs-lisp/edebug.el | 6 +-
lisp/eshell/esh-proc.el | 16 +-
lisp/gnus/gnus-msg.el | 6 +-
lisp/gnus/gnus.el | 4 +
lisp/gnus/mm-decode.el | 19 ++-
lisp/ibuf-ext.el | 46 ++++--
lisp/ibuf-macs.el | 10 +-
lisp/ibuffer.el | 10 +-
lisp/info.el | 7 +-
lisp/isearch.el | 8 +-
lisp/progmodes/bat-mode.el | 11 +-
lisp/progmodes/grep.el | 26 ++-
lisp/simple.el | 3 +
lisp/textmodes/css-mode.el | 2 +-
lisp/xdg.el | 144 ++++++++++++++++
src/composite.c | 89 +++++-----
src/data.c | 6 +
src/dispextern.h | 2 +-
src/fns.c | 262 ++++++++++++------------------
src/image.c | 16 +-
src/keyboard.c | 25 +++
src/lisp.h | 75 ++++++---
src/xdisp.c | 52 +++---
src/xfaces.c | 2 +-
src/xwidget.c | 12 +-
test/lisp/filenotify-tests.el | 4 +
test/lisp/progmodes/bat-mode-tests.el | 86 ++++++++++
test/src/fns-tests.el | 298 ++++++++++++++++++++++++++++++++++
33 files changed, 964 insertions(+), 346 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index 60f30b9..807a40a 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -1011,12 +1011,10 @@ info_dir_deps = \
## slow down parallelization.
${srcdir}/info/dir: ${info_dir_deps}
$(AM_V_at)${MKDIR_P} ${srcdir}/info
- $(AM_V_GEN)tempfile=info-dir.$$$$; \
- rm -f $${tempfile}; \
- (cd ${srcdir}/doc && \
+ $(AM_V_GEN)(cd ${srcdir}/doc && \
AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \
- ) >$$tempfile && \
- ${srcdir}/build-aux/move-if-change $${tempfile} ${srcdir}/info/dir
+ ) >address@hidden
+ mv address@hidden $@
INSTALL_DVI = install-emacs-dvi install-lispref-dvi \
install-lispintro-dvi install-misc-dvi
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index fa69ba4..77baae2 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
so that the matching can proceed incrementally as you type. This
additional laxity does not apply to the lazy highlight
(@pxref{Incremental Search}), which always matches whole words.
+While you are typing the search string, @samp{Pending} appears in the
+search prompt until you use a search repeating key like @kbd{C-s}.
The word search commands don't perform character folding, and
toggling lax whitespace matching (@pxref{Lax Search, lax space
@@ -661,8 +663,10 @@ search is not already active, this runs the command
active, @kbd{M-s _} switches to a symbol search, preserving the
direction of the search and the current search string; you can disable
symbol search by typing @kbd{M-s _} again. In incremental symbol
-search, only the beginning of the search string is required to match
-the beginning of a symbol.
+search, while you are typing the search string, only the beginning
+of the search string is required to match the beginning of a symbol,
+and @samp{Pending} appears in the search prompt until you use a search
+repeating key like @kbd{C-s}.
To begin a nonincremental symbol search, type @kbd{M-s _ @key{RET}}
for a forward search, or @kbd{M-s _ C-r @key{RET}} or a backward
diff --git a/etc/NEWS b/etc/NEWS
index cbf2b70..cba4e4d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -617,8 +617,9 @@ Drive onsite repositories.
manual documents how to configure ssh and PuTTY accordingly.
+++
-Setting the "ENV" environment variable in 'tramp-remote-process-environment'
-enables reading of shell initialization files.
+*** Setting the "ENV" environment variable in
+'tramp-remote-process-environment' enables reading of shell
+initialization files.
---
** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'.
@@ -702,6 +703,8 @@ processes on exit.
** New Elisp data-structure library 'radix-tree'.
+** New library 'xdg' with utilities for some XDG standards and specs.
+
* Incompatible Lisp Changes in Emacs 26.1
@@ -900,6 +903,9 @@ collection).
** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el.
The incumbent 'if-let' and 'when-let' are now aliases.
+** Low-level list functions like 'length' and 'member' now do a better
+job of signaling list cycles instead of looping indefinitely.
+
+++
** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
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 f57bf92..dac7ab8 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -20,11 +20,12 @@
;;; Code:
(deftheme tsdh-light
- "Minor tweaks to the Emacs white-background defaults.
+ "A light Emacs theme.
Used and created by Tassilo Horn.")
(custom-theme-set-faces
'tsdh-light
+ '(default ((t (:background "#fafafa" :foreground "#383a42"))))
'(Info-quoted ((t (:underline "gray40" :weight bold))))
'(aw-leading-char-face ((t (:background "red" :foreground "white" :weight
bold))))
'(default ((t (:background "white" :foreground "black"))))
@@ -35,8 +36,18 @@ Used and created by Tassilo Horn.")
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
+ '(font-lock-builtin-face ((t (:foreground "#e44649"))))
+ '(font-lock-comment-delimiter-face ((t (:inherit font-lock-comment-face
:weight bold))))
+ '(font-lock-comment-face ((t (:foreground "#a0a1a7"))))
+ '(font-lock-doc-face ((t (:inherit font-lock-string-face :slant italic))))
+ '(font-lock-function-name-face ((t (:foreground "#0184bc"))))
+ '(font-lock-keyword-face ((t (:foreground "#a626a4"))))
+ '(font-lock-negation-char-face ((t (:weight bold))))
'(font-lock-regexp-grouping-backslash ((t (:inherit bold :foreground
"black"))))
'(font-lock-regexp-grouping-construct ((t (:inherit bold :foreground
"black"))))
+ '(font-lock-string-face ((t (:foreground "#50a14f"))))
+ '(font-lock-type-face ((t (:foreground "#c18401"))))
+ '(font-lock-variable-name-face ((t (:foreground "#e45649"))))
'(gnus-button ((t (:inherit button))))
'(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight
bold))))
'(gnus-group-mail-1 ((t (:inherit gnus-group-mail-1-empty :weight bold))))
@@ -51,11 +62,11 @@ Used and created by Tassilo Horn.")
'(gnus-group-news-2-empty ((t (:foreground "tomato3"))))
'(gnus-group-news-3 ((t (:inherit gnus-group-news-3-empty :weight bold))))
'(gnus-group-news-3-empty ((t (:foreground "tomato2")))) '(header-line ((t
(:inherit mode-line :inverse-video t))))
- '(hl-line ((t (:background "grey95"))))
+ '(hl-line ((t (:background "#f0f0f1"))))
'(hl-paren-face ((t (:weight bold))) t)
- '(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box
(:line-width -1 :color "red" :style released-button) :weight bold))))
- '(mode-line ((t (:background "wheat" :foreground "black" :box (:line-width 1
:color "tan") :family "DejaVu Sans"))))
- '(mode-line-inactive ((t (:inherit mode-line :foreground "dark gray"))))
+ '(minibuffer-prompt ((t (:foreground "#0184bc" :family "DeJaVu" :box
(:line-width -1 :style released-button) :weight bold))))
+ '(mode-line ((t (:background "#f0f0f1" :box (:line-width 1 :color
"#383a42")))))
+ '(mode-line-inactive ((t (:inherit mode-line :foreground "#a0a1a7"))))
'(org-agenda-date ((t (:inherit org-agenda-structure))))
'(org-agenda-date-today ((t (:inherit org-agenda-date :underline t))))
'(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 3971dbb..6a6a8ea 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -616,10 +616,18 @@ relevant to POS."
'help-args '(,current-input-method))
"input method")
(list
- (let ((name
- (or (get-char-code-property char 'name)
- (get-char-code-property char 'old-name))))
- (if (and name (assoc-string name (ucs-names)))
+ (let* ((names (ucs-names))
+ (name
+ (or (when (= char 7)
+ ;; Special case for "BELL" which is
+ ;; apparently the only char which
+ ;; doesn't have a new name and whose
+ ;; old-name is shadowed by a newer char
+ ;; with that name (bug#25641).
+ (car (rassoc char names)))
+ (get-char-code-property char 'name)
+ (get-char-code-property char
'old-name))))
+ (if (and name (assoc-string name names))
(format
"type \"C-x 8 RET %x\" or \"C-x 8 RET %s\""
char name)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index ec0f08d..a883804 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?"
(list
(edebug-storing-offsets (- (point) 2) 'function)
(edebug-read-storing-offsets stream)))
- ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
- ?7 ?8 ?9 ?0))
+ (t
(backward-char 1)
- (read stream))
- (t (edebug-syntax-error "Bad char after #"))))
+ (read stream))))
(defun edebug-read-list (stream)
(forward-char 1) ; skip \(
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index b0dbb22..ba5cb5c 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."
(unless (string= string "run")
(unless (string-match "^\\(finished\\|exited\\)" string)
(eshell-insertion-filter proc string))
- (eshell-close-handles (process-exit-status proc) 'nil
- (cadr entry))))
+ (let ((handles (nth 1 entry))
+ (str (prog1 (nth 3 entry)
+ (setf (nth 3 entry) nil)))
+ (status (process-exit-status proc)))
+ ;; If we're in the middle of handling output
+ ;; from this process then schedule the EOF for
+ ;; later.
+ (letrec ((finish-io
+ (lambda ()
+ (if (nth 4 entry)
+ (run-at-time 0 nil finish-io)
+ (when str (eshell-output-object str nil
handles))
+ (eshell-close-handles status 'nil
handles)))))
+ (funcall finish-io)))))
(eshell-remove-process-entry entry))))
(eshell-kill-process-function proc string)))))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index a193ab4..85969ed 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."
(message-pop-to-buffer "*Gnus Bug*"))
(let ((message-this-is-mail t))
(message-setup `((To . ,gnus-maintainer)
- (Subject . ""))))
+ (Subject . "")
+ (X-Debbugs-Package
+ . ,(format "%s" gnus-bug-package))
+ (X-Debbugs-Version
+ . ,(format "%s" (gnus-continuum-version))))))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index bbf85fe..d3edcd0 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
"address@hidden (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
+(defconst gnus-bug-package
+ "emacs,gnus"
+ "The package to use in the bug submission.")
+
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)Group Buffer")
(gnus-summary-mode "(gnus)Summary Buffer")
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 579222f..989d4b8 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1793,22 +1793,23 @@ If RECURSIVE, search recursively."
(buffer-string))))))
(shr-inhibit-images mm-html-inhibit-images)
(shr-blocked-images mm-html-blocked-images)
- charset char)
+ charset coding char)
(unless handle
(setq handle (mm-dissect-buffer t)))
- (setq charset (mail-content-type-get (mm-handle-type handle) 'charset))
+ (and (setq charset
+ (or (mail-content-type-get (mm-handle-type handle) 'charset)
+ mail-parse-charset))
+ (setq coding (mm-charset-to-coding-system charset nil t))
+ (eq coding 'ascii)
+ (setq coding nil))
(save-restriction
(narrow-to-region (point) (point))
(shr-insert-document
(mm-with-part handle
(insert (prog1
- (if (and charset
- (setq charset
- (mm-charset-to-coding-system charset
- nil t))
- (not (eq charset 'ascii)))
- (decode-coding-string (buffer-string) charset)
- (string-as-multibyte (buffer-string)))
+ (if coding
+ (decode-coding-string (buffer-string) coding)
+ (buffer-string))
(erase-buffer)
(mm-enable-multibyte)))
(goto-char (point-min))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 058eaec..2a68f77 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -506,14 +506,24 @@ the mode if ARG is omitted or nil."
(ibuffer-backward-filter-group 1))
(ibuffer-forward-line 0))
+(defun ibuffer--maybe-erase-shell-cmd-output ()
+ (let ((buf (get-buffer "*Shell Command Output*")))
+ (when (and (buffer-live-p buf)
+ (not shell-command-dont-erase-buffer)
+ (not (zerop (buffer-size buf))))
+ (with-current-buffer buf (erase-buffer)))))
+
;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
(define-ibuffer-op shell-command-pipe (command)
"Pipe the contents of each marked buffer to shell command COMMAND."
(:interactive "sPipe to shell command: "
:opstring "Shell command executed on"
+ :before (ibuffer--maybe-erase-shell-cmd-output)
:modifier-p nil)
- (shell-command-on-region
- (point-min) (point-max) command))
+ (let ((out-buf (get-buffer-create "*Shell Command Output*")))
+ (with-current-buffer out-buf (goto-char (point-max)))
+ (call-shell-region (point-min) (point-max)
+ command nil out-buf)))
;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
(define-ibuffer-op shell-command-pipe-replace (command)
@@ -523,26 +533,32 @@ the mode if ARG is omitted or nil."
:active-opstring "replace buffer contents in"
:dangerous t
:modifier-p t)
- (with-current-buffer buf
- (shell-command-on-region (point-min) (point-max)
- command nil t)))
+ (call-shell-region (point-min) (point-max)
+ command 'delete buf))
;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
(define-ibuffer-op shell-command-file (command)
"Run shell command COMMAND separately on files of marked buffers."
(:interactive "sShell command on buffer's file: "
:opstring "Shell command executed on"
+ :before (ibuffer--maybe-erase-shell-cmd-output)
:modifier-p nil)
- (shell-command (concat command " "
- (shell-quote-argument
- (or buffer-file-name
- (let ((file
- (make-temp-file
- (substring
- (buffer-name) 0
- (min 10 (length (buffer-name)))))))
- (write-region nil nil file nil 0)
- file))))))
+ (let ((file (and (not (buffer-modified-p))
+ buffer-file-name))
+ (out-buf (get-buffer-create "*Shell Command Output*")))
+ (unless (and file (file-exists-p file))
+ (setq file
+ (make-temp-file
+ (substring
+ (buffer-name) 0
+ (min 10 (length (buffer-name))))))
+ (write-region nil nil file nil 0))
+ (with-current-buffer out-buf (goto-char (point-max)))
+ (call-process-shell-command
+ (format "%s %s"
+ command
+ (shell-quote-argument file))
+ nil out-buf nil)))
;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
(define-ibuffer-op eval (form)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 05e568e..2e751ce 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'.
dangerous
(opstring "operated on")
(active-opstring "Operate on")
+ before
+ after
complex)
&rest body)
"Generate a function which operates on a buffer.
@@ -198,6 +200,8 @@ operation is complete, in the form:
ACTIVE-OPSTRING is a string which will be displayed to the user in a
confirmation message, in the form:
\"Really ACTIVE-OPSTRING x buffers?\"
+BEFORE is a form to evaluate before start the operation.
+AFTER is a form to evaluate once the operation is complete.
COMPLEX means this function is special; if COMPLEX is nil BODY
evaluates once for each marked buffer, MBUF, with MBUF current
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
marked buffer. BODY is evaluated with `buf' bound to the
buffer object.
-\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS
OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
+\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS
OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)"
(declare (indent 2) (doc-string 3))
`(progn
(defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
@@ -238,6 +242,7 @@ buffer object.
(if (eq modifier-p t)
'((setq ibuffer-did-modification t))
())
+ (and after `(,after)) ; post-operation form.
`((ibuffer-redisplay t)
(message ,(concat "Operation finished; " opstring "
%s buffers") count))))
(inner-body (if complex
@@ -247,7 +252,8 @@ buffer object.
(save-excursion
,@body))
t)))
- (body `(let ((count
+ (body `(let ((_ ,before) ; pre-operation form.
+ (count
(,(pcase mark
(:deletion
'ibuffer-map-deletion-lines)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 71bf1d6..eb821b2 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2564,18 +2564,26 @@ Marking commands:
Filtering commands:
+ `\\[ibuffer-filter-chosen-by-completion]' - Select and apply filter chosen
by completion.
`\\[ibuffer-filter-by-mode]' - Add a filter by any major mode.
`\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use.
`\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode.
`\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
`\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
+ `\\[ibuffer-filter-by-basename]' - Add a filter by basename.
+ `\\[ibuffer-filter-by-directory]' - Add a filter by directory name.
`\\[ibuffer-filter-by-filename]' - Add a filter by filename.
+ `\\[ibuffer-filter-by-file-extension]' - Add a filter by file extension.
+ `\\[ibuffer-filter-by-modified]' - Add a filter by modified buffers.
+ `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp
predicate.
`\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size.
`\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size.
- `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp
predicate.
+ `\\[ibuffer-filter-by-starred-name]' - Add a filter by special buffers.
+ `\\[ibuffer-filter-by-visiting-file]' - Add a filter by buffers visiting
files.
`\\[ibuffer-save-filters]' - Save the current filters with a name.
`\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters.
`\\[ibuffer-add-saved-filters]' - Add saved filters to current filters.
+ `\\[ibuffer-and-filter]' - Replace the top two filters with their logical
AND.
`\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR.
`\\[ibuffer-pop-filter]' - Remove the top filter.
`\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter.
diff --git a/lisp/info.el b/lisp/info.el
index 0cfcec3..5f4ae5f 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2118,10 +2118,9 @@ If DIRECTION is `backward', search in the reverse
direction."
(cond
(isearch-regexp-function
;; Lax version of word search
- (let ((lax (not (or isearch-nonincremental
- (eq (length string)
- (length (isearch--state-string
- (car isearch-cmds))))))))
+ (let ((lax (and (not bound) (isearch--lax-regexp-function-p))))
+ (when lax
+ (setq isearch-adjusted t))
(if (functionp isearch-regexp-function)
(funcall isearch-regexp-function string lax)
(word-search-regexp string lax))))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 5c48c30..4b35f25 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1621,7 +1621,7 @@ Used in `word-search-forward', `word-search-backward',
((string-match-p "\\`\\W+\\'" string) "\\W+")
(t (concat
(if (string-match-p "\\`\\W" string) "\\W+"
- (unless lax "\\<"))
+ "\\<")
(mapconcat 'regexp-quote (split-string string "\\W+" t) "\\W+")
(if (string-match-p "\\W\\'" string) "\\W+"
(unless lax "\\>"))))))
@@ -1749,7 +1749,7 @@ the beginning or the end of the string need not match a
symbol boundary."
((string-match-p (format "\\`%s\\'" not-word-symbol-re) string)
not-word-symbol-re)
(t (concat
(if (string-match-p (format "\\`%s" not-word-symbol-re) string)
not-word-symbol-re
- (unless lax "\\_<"))
+ "\\_<")
(mapconcat 'regexp-quote (split-string string not-word-symbol-re t)
not-word-symbol-re)
(if (string-match-p (format "%s\\'" not-word-symbol-re) string)
not-word-symbol-re
(unless lax "\\_>")))))))
@@ -2740,7 +2740,9 @@ Can be changed via `isearch-search-fun-function' for
special needs."
(funcall
(if isearch-forward #'re-search-forward #'re-search-backward)
(cond (isearch-regexp-function
- (let ((lax (isearch--lax-regexp-function-p)))
+ (let ((lax (and (not bound)
(isearch--lax-regexp-function-p))))
+ (when lax
+ (setq isearch-adjusted t))
(if (functionp isearch-regexp-function)
(funcall isearch-regexp-function string lax)
(word-search-regexp string lax))))
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 156331c..1dd2e37 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -82,12 +82,15 @@
(2 font-lock-constant-face t))
("^:[^:].*"
. 'bat-label-face)
- ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\w+\\)"
+ ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
(2 font-lock-variable-name-face))
- ("%\\(\\w+\\)%?"
+ ("%\\(\\(\\sw\\|\\s_\\)+\\)%"
(1 font-lock-variable-name-face))
- ("!\\(\\w+\\)!?" ; delayed-expansion !variable!
+ ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable!
(1 font-lock-variable-name-face))
+
("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
+ (1 font-lock-variable-name-face nil t) ; PATH expansion
+ (2 font-lock-variable-name-face)) ; iteration variable or positional
parameter
("[ =][-/]+\\(\\w+\\)"
(1 font-lock-type-face append))
(,(concat "\\_<" (regexp-opt COMMANDS) "\\_>") .
font-lock-builtin-face)
@@ -130,6 +133,7 @@
(modify-syntax-entry ?{ "_" table)
(modify-syntax-entry ?} "_" table)
(modify-syntax-entry ?\\ "." table)
+ (modify-syntax-entry ?= "." table)
table))
(defconst bat--syntax-propertize
@@ -175,6 +179,7 @@ with `bat-cmd-help'. Navigate between sections using
`imenu'.
Run script using `bat-run' and `bat-run-args'.\n
\\{bat-mode-map}"
(setq-local comment-start "rem ")
+ (setq-local comment-start-skip "rem[ \t]+")
(setq-local syntax-propertize-function bat--syntax-propertize)
(setq-local font-lock-defaults
'(bat-font-lock-keywords nil t)) ; case-insensitive keywords
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 22d4f2a..b3d8a51 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1045,6 +1045,15 @@ to specify a command to run."
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir)))))))
+(defun rgrep-find-ignored-directories (dir)
+ "Return the list of ignored directories applicable to `dir'."
+ (delq nil (mapcar
+ (lambda (ignore)
+ (cond ((stringp ignore) ignore)
+ ((consp ignore)
+ (and (funcall (car ignore) dir) (cdr ignore)))))
+ grep-find-ignored-directories)))
+
(defun rgrep-default-command (regexp files dir)
"Compute the command for \\[rgrep] to use by default."
(require 'find-dired) ; for `find-name-arg'
@@ -1066,20 +1075,9 @@ to specify a command to run."
(shell-quote-argument "(")
;; we should use shell-quote-argument here
" -path "
- (mapconcat
- 'identity
- (delq nil (mapcar
- #'(lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument
- (concat "*/" ignore)))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (concat "*/"
- (cdr ignore)))))))
- grep-find-ignored-directories))
- " -o -path ")
+ (mapconcat (lambda (d) (shell-quote-argument (concat "*/" d)))
+ (rgrep-find-ignored-directories dir)
+ " -o -path ")
" "
(shell-quote-argument ")")
" -prune -o "))
diff --git a/lisp/simple.el b/lisp/simple.el
index 441713a..c0dad2d 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1733,6 +1733,9 @@ invoking, give a prefix argument to
`execute-extended-command'."
(where-is-internal function overriding-local-map t))))
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
+ ;; Some features, such as novice.el, rely on this-command-keys
+ ;; including M-x COMMAND-NAME RET.
+ (set--this-command-keys (concat "\M-x" (symbol-name function) "\r"))
(setq this-command function)
;; Normally `real-this-command' should never be changed, but here we really
;; 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 0c7d76f..19746c6 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -36,7 +36,7 @@
(require 'seq)
(require 'sgml-mode)
(require 'smie)
-(require 'subr-x)
+(eval-when-compile (require 'subr-x))
(defgroup css nil
"Cascading Style Sheets (CSS) editing mode."
diff --git a/lisp/xdg.el b/lisp/xdg.el
new file mode 100644
index 0000000..b11e104
--- /dev/null
+++ b/lisp/xdg.el
@@ -0,0 +1,144 @@
+;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Mark Oteiza <address@hidden>
+;; Created: 27 January 2017
+;; Keywords: files, data
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 3 of the License,
+;; or (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Library providing some convenience functions for the following XDG
+;; standards and specifications
+;;
+;; - XDG Base Directory Specification
+;; - Thumbnail Managing Standard
+;; - xdg-user-dirs configuration
+
+;;; Code:
+
+
+;; XDG Base Directory Specification
+;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
+
+(defmacro xdg--dir-home (environ default-path)
+ (declare (debug (stringp stringp)))
+ (let ((env (make-symbol "env")))
+ `(let ((,env (getenv ,environ)))
+ (if (or (null ,env) (not (file-name-absolute-p ,env)))
+ (expand-file-name ,default-path)
+ ,env))))
+
+(defun xdg-config-home ()
+ "Return the base directory for user specific configuration files."
+ (xdg--dir-home "XDG_CONFIG_HOME" "~/.config"))
+
+(defun xdg-cache-home ()
+ "Return the base directory for user specific cache files."
+ (xdg--dir-home "XDG_CACHE_HOME" "~/.cache"))
+
+(defun xdg-data-home ()
+ "Return the base directory for user specific data files."
+ (xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))
+
+(defun xdg-runtime-dir ()
+ "Return the value of $XDG_RUNTIME_DIR."
+ (getenv "XDG_RUNTIME_DIR"))
+
+(defun xdg-config-dirs ()
+ "Return the config directory search path as a list."
+ (let ((env (getenv "XDG_CONFIG_DIRS")))
+ (if (or (null env) (string= env ""))
+ '("/etc/xdg")
+ (parse-colon-path env))))
+
+(defun xdg-data-dirs ()
+ "Return the data directory search path as a list."
+ (let ((env (getenv "XDG_DATA_DIRS")))
+ (if (or (null env) (string= env ""))
+ '("/usr/local/share/" "/usr/share/")
+ (parse-colon-path env))))
+
+
+;; Thumbnail Managing Standard
+;;
https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html
+
+(defun xdg-thumb-uri (filename)
+ "Return the canonical URI for FILENAME.
+If FILENAME has absolute path /foo/bar.jpg, its canonical URI is
+file:///foo/bar.jpg"
+ (concat "file://" (expand-file-name filename)))
+
+(defun xdg-thumb-name (filename)
+ "Return the appropriate thumbnail filename for FILENAME."
+ (concat (md5 (xdg-thumb-uri filename)) ".png"))
+
+(defun xdg-thumb-mtime (filename)
+ "Return modification time of FILENAME as integral seconds from the epoch."
+ (floor (float-time (nth 5 (file-attributes filename)))))
+
+
+;; XDG User Directories
+;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/
+
+(defconst xdg-line-regexp
+ (eval-when-compile
+ (rx "XDG_"
+ (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
+ "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
+ "_DIR=\""
+ (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
+ "\""))
+ "Regexp matching non-comment lines in xdg-user-dirs config files.")
+
+(defvar xdg-user-dirs nil
+ "Alist of directory keys and values.")
+
+(defun xdg--user-dirs-parse-line ()
+ "Return pair of user-dirs key to directory value in LINE, otherwise nil.
+This should be called at the beginning of a line."
+ (skip-chars-forward "[:blank:]")
+ (when (and (/= (following-char) ?#)
+ (looking-at xdg-line-regexp))
+ (let ((k (match-string 1))
+ (v (match-string 2)))
+ (when (and k v) (cons k v)))))
+
+(defun xdg--user-dirs-parse-file (filename)
+ "Return alist of xdg-user-dirs from FILENAME."
+ (let (elt res)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq elt (xdg--user-dirs-parse-line))
+ (when (consp elt) (push elt res))
+ (forward-line)))
+ res))
+
+(defun xdg-user-dir (name)
+ "Return the path of user directory referred to by NAME."
+ (when (null xdg-user-dirs)
+ (setq xdg-user-dirs
+ (xdg--user-dirs-parse-file
+ (expand-file-name "user-dirs.dirs" (xdg-config-home)))))
+ (cdr (assoc name xdg-user-dirs)))
+
+(provide 'xdg)
+
+;;; xdg.el ends here
diff --git a/src/composite.c b/src/composite.c
index f23bb17..b673c53 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,
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
if (! NILP (val))
{
- for (int ridx = 0; CONSP (val); val = XCDR (val), ridx++)
+ for (EMACS_INT ridx = 0; CONSP (val); val = XCDR (val), ridx++)
{
Lisp_Object elt = XCAR (val);
if (VECTORP (elt) && ASIZE (elt) == 3
@@ -1063,54 +1063,48 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
while (char_composable_p (c))
{
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
- if (! NILP (val))
+ for (EMACS_INT ridx = 0; CONSP (val); val = XCDR (val), ridx++)
{
- Lisp_Object elt;
- int ridx, blen;
-
- for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
+ Lisp_Object elt = XCAR (val);
+ if (VECTORP (elt) && ASIZE (elt) == 3
+ && NATNUMP (AREF (elt, 1))
+ && charpos - XFASTINT (AREF (elt, 1)) > endpos)
{
- elt = XCAR (val);
- if (VECTORP (elt) && ASIZE (elt) == 3
- && NATNUMP (AREF (elt, 1))
- && charpos - XFASTINT (AREF (elt, 1)) > endpos)
- {
- ptrdiff_t back = XFASTINT (AREF (elt, 1));
- ptrdiff_t cpos = charpos - back, bpos;
+ ptrdiff_t back = XFASTINT (AREF (elt, 1));
+ ptrdiff_t cpos = charpos - back, bpos;
- if (back == 0)
- bpos = bytepos;
- else
- bpos = (NILP (string) ? CHAR_TO_BYTE (cpos)
- : string_char_to_byte (string, cpos));
- if (STRINGP (AREF (elt, 0)))
- blen = fast_looking_at (AREF (elt, 0), cpos, bpos,
- start + 1, limit, string);
- else
- blen = 1;
- if (blen > 0)
+ if (back == 0)
+ bpos = bytepos;
+ else
+ bpos = (NILP (string) ? CHAR_TO_BYTE (cpos)
+ : string_char_to_byte (string, cpos));
+ ptrdiff_t blen
+ = (STRINGP (AREF (elt, 0))
+ ? fast_looking_at (AREF (elt, 0), cpos, bpos,
+ start + 1, limit, string)
+ : 1);
+ if (blen > 0)
+ {
+ /* Make CPOS point to the last character of
+ match. Note that BLEN is byte-length. */
+ if (blen > 1)
+ {
+ bpos += blen;
+ if (NILP (string))
+ cpos = BYTE_TO_CHAR (bpos) - 1;
+ else
+ cpos = string_byte_to_char (string, bpos) - 1;
+ }
+ back = cpos - (charpos - back);
+ if (cmp_it->stop_pos < cpos
+ || (cmp_it->stop_pos == cpos
+ && cmp_it->lookback < back))
{
- /* Make CPOS point to the last character of
- match. Note that BLEN is byte-length. */
- if (blen > 1)
- {
- bpos += blen;
- if (NILP (string))
- cpos = BYTE_TO_CHAR (bpos) - 1;
- else
- cpos = string_byte_to_char (string, bpos) - 1;
- }
- back = cpos - (charpos - back);
- if (cmp_it->stop_pos < cpos
- || (cmp_it->stop_pos == cpos
- && cmp_it->lookback < back))
- {
- cmp_it->rule_idx = ridx;
- cmp_it->stop_pos = cpos;
- cmp_it->ch = c;
- cmp_it->lookback = back;
- cmp_it->nchars = back + 1;
- }
+ cmp_it->rule_idx = ridx;
+ cmp_it->stop_pos = cpos;
+ cmp_it->ch = c;
+ cmp_it->lookback = back;
+ cmp_it->nchars = back + 1;
}
}
}
@@ -1203,10 +1197,10 @@ composition_reseat_it (struct composition_it *cmp_it,
ptrdiff_t charpos,
{
Lisp_Object lgstring = Qnil;
Lisp_Object val, elt;
- ptrdiff_t i;
val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
- for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
+ for (EMACS_INT i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val))
+ continue;
if (charpos < endpos)
{
for (; CONSP (val); val = XCDR (val))
@@ -1255,6 +1249,7 @@ composition_reseat_it (struct composition_it *cmp_it,
ptrdiff_t charpos,
if (NILP (LGSTRING_ID (lgstring)))
lgstring = composition_gstring_put_cache (lgstring, -1);
cmp_it->id = XINT (LGSTRING_ID (lgstring));
+ int i;
for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++)
if (NILP (LGSTRING_GLYPH (lgstring, i)))
break;
diff --git a/src/data.c b/src/data.c
index 8e07bf0..12dc2df 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)
xsignal3 (Qargs_out_of_range, a1, a2, a3);
}
+void
+circular_list (Lisp_Object list)
+{
+ xsignal1 (Qcircular_list, list);
+}
+
/* Data type predicates. */
diff --git a/src/dispextern.h b/src/dispextern.h
index eb71a82..e030618 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2215,7 +2215,7 @@ struct composition_it
the automatic composition. Provided that ELT is an element of
Vcomposition_function_table for CH, (nth ELT RULE_IDX) is the
rule for the composition. */
- int rule_idx;
+ EMACS_INT rule_idx;
/* If this is an automatic composition, how many characters to look
back from the position where a character triggering the
composition exists. */
diff --git a/src/fns.c b/src/fns.c
index ac7c1f2..ffe3218 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -108,23 +108,12 @@ To get the number of bytes, use `string-bytes'. */)
XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (sequence))
{
- EMACS_INT i = 0;
-
- do
- {
- ++i;
- if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
- {
- if (MOST_POSITIVE_FIXNUM < i)
- error ("List too long");
- maybe_quit ();
- }
- sequence = XCDR (sequence);
- }
- while (CONSP (sequence));
-
+ intptr_t i = 0;
+ FOR_EACH_TAIL (sequence)
+ i++;
CHECK_LIST_END (sequence, sequence);
-
+ if (MOST_POSITIVE_FIXNUM < i)
+ error ("List too long");
val = make_number (i);
}
else if (NILP (sequence))
@@ -142,38 +131,10 @@ it returns 0. If LIST is circular, it returns a finite
value
which is at least the number of distinct elements. */)
(Lisp_Object list)
{
- Lisp_Object tail, halftail;
- double hilen = 0;
- uintmax_t lolen = 1;
-
- if (! CONSP (list))
- return make_number (0);
-
- /* halftail is used to detect circular lists. */
- for (tail = halftail = list; ; )
- {
- tail = XCDR (tail);
- if (! CONSP (tail))
- break;
- if (EQ (tail, halftail))
- break;
- lolen++;
- if ((lolen & 1) == 0)
- {
- halftail = XCDR (halftail);
- if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
- {
- maybe_quit ();
- if (lolen == 0)
- hilen += UINTMAX_MAX + 1.0;
- }
- }
- }
-
- /* If the length does not fit into a fixnum, return a float.
- On all known practical machines this returns an upper bound on
- the true length. */
- return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
+ intptr_t len = 0;
+ FOR_EACH_TAIL_SAFE (list)
+ len++;
+ return make_fixnum_or_float (len);
}
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@@ -1383,14 +1344,10 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
- {
- if (! NILP (Fequal (elt, XCAR (tail))))
- return tail;
- rarely_quit (++quit_count);
- }
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
+ if (! NILP (Fequal (elt, XCAR (tail))))
+ return tail;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1400,14 +1357,10 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
- {
- if (EQ (XCAR (tail), elt))
- return tail;
- rarely_quit (++quit_count);
- }
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
+ if (EQ (XCAR (tail), elt))
+ return tail;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1420,14 +1373,12 @@ The value is actually the tail of LIST whose car is
ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
{
Lisp_Object tem = XCAR (tail);
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
return tail;
- rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1439,14 +1390,10 @@ The value is actually the first element of LIST whose
car is KEY.
Elements of LIST that are not conses are ignored. */)
(Lisp_Object key, Lisp_Object list)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
- {
- if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
- return XCAR (tail);
- rarely_quit (++quit_count);
- }
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
+ if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
+ return XCAR (tail);
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1468,15 +1415,13 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
The value is actually the first element of LIST whose car equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
if (CONSP (car)
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
return car;
- rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1503,14 +1448,10 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
The value is actually the first element of LIST whose cdr is KEY. */)
(Lisp_Object key, Lisp_Object list)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
- {
- if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
- return XCAR (tail);
- rarely_quit (++quit_count);
- }
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
+ if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
+ return XCAR (tail);
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1520,15 +1461,13 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
The value is actually the first element of LIST whose cdr equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ Lisp_Object tail = list;
+ FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
if (CONSP (car)
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
return car;
- rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1544,12 +1483,11 @@ list.
Write `(setq foo (delq element foo))' to be sure of correctly changing
the value of a list `foo'. See also `remq', which does not modify the
argument. */)
- (register Lisp_Object elt, Lisp_Object list)
+ (Lisp_Object elt, Lisp_Object list)
{
- Lisp_Object tail, tortoise, prev = Qnil;
- bool skip;
+ Lisp_Object prev = Qnil, tail = list;
- FOR_EACH_TAIL (tail, list, tortoise, skip)
+ FOR_EACH_TAIL (tail)
{
Lisp_Object tem = XCAR (tail);
if (EQ (elt, tem))
@@ -1670,10 +1608,9 @@ changing the value of a sequence `foo'. */)
}
else
{
- unsigned short int quit_count = 0;
- Lisp_Object tail, prev;
+ Lisp_Object prev = Qnil, tail = seq;
- for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_TAIL (tail)
{
if (!NILP (Fequal (elt, XCAR (tail))))
{
@@ -1684,7 +1621,6 @@ changing the value of a sequence `foo'. */)
}
else
prev = tail;
- rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
}
@@ -1704,15 +1640,17 @@ This function may destructively modify SEQ to produce
the value. */)
return Freverse (seq);
else if (CONSP (seq))
{
- unsigned short int quit_count = 0;
Lisp_Object prev, tail, next;
for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
{
next = XCDR (tail);
+ /* If SEQ contains a cycle, attempting to reverse it
+ in-place will inevitably come back to SEQ. */
+ if (EQ (next, seq))
+ circular_list (seq);
Fsetcdr (tail, prev);
prev = tail;
- rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
seq = prev;
@@ -1755,12 +1693,9 @@ See also the function `nreverse', which is used more
often. */)
return Qnil;
else if (CONSP (seq))
{
- unsigned short int quit_count = 0;
- for (new = Qnil; CONSP (seq); seq = XCDR (seq))
- {
- new = Fcons (XCAR (seq), new);
- rarely_quit (++quit_count);
- }
+ new = Qnil;
+ FOR_EACH_TAIL (seq)
+ new = Fcons (XCAR (seq), new);
CHECK_LIST_END (seq, seq);
}
else if (VECTORP (seq))
@@ -2013,18 +1948,15 @@ corresponding to the given PROP, or nil if PROP is not
one of the
properties on the list. This function never signals an error. */)
(Lisp_Object plist, Lisp_Object prop)
{
- Lisp_Object tail, halftail;
-
- /* halftail is used to detect circular lists. */
- tail = halftail = plist;
- while (CONSP (tail) && CONSP (XCDR (tail)))
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL_SAFE (tail)
{
+ if (! CONSP (XCDR (tail)))
+ break;
if (EQ (prop, XCAR (tail)))
return XCAR (XCDR (tail));
-
- tail = XCDR (XCDR (tail));
- halftail = XCDR (halftail);
- if (EQ (tail, halftail))
+ tail = XCDR (tail);
+ if (EQ (tail, li.tortoise))
break;
}
@@ -2050,11 +1982,12 @@ use `(setq x (plist-put x prop val))' to be sure to use
the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- unsigned short int quit_count = 0;
- Lisp_Object prev = Qnil;
- for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
- tail = XCDR (XCDR (tail)))
+ Lisp_Object prev = Qnil, tail = plist;
+ FOR_EACH_TAIL (tail)
{
+ if (! CONSP (XCDR (tail)))
+ break;
+
if (EQ (prop, XCAR (tail)))
{
Fsetcar (XCDR (tail), val);
@@ -2062,8 +1995,11 @@ The PLIST is modified by side effects. */)
}
prev = tail;
- rarely_quit (++quit_count);
+ tail = XCDR (tail);
+ if (EQ (tail, li.tortoise))
+ circular_list (plist);
}
+ CHECK_LIST_END (tail, plist);
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
@@ -2091,19 +2027,19 @@ corresponding to the given PROP, or nil if PROP is not
one of the properties on the list. */)
(Lisp_Object plist, Lisp_Object prop)
{
- unsigned short int quit_count = 0;
- Lisp_Object tail;
-
- for (tail = plist;
- CONSP (tail) && CONSP (XCDR (tail));
- tail = XCDR (XCDR (tail)))
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL (tail)
{
+ if (! CONSP (XCDR (tail)))
+ break;
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
- rarely_quit (++quit_count);
+ tail = XCDR (tail);
+ if (EQ (tail, li.tortoise))
+ circular_list (plist);
}
- CHECK_LIST_END (tail, prop);
+ CHECK_LIST_END (tail, plist);
return Qnil;
}
@@ -2118,11 +2054,12 @@ use `(setq x (lax-plist-put x prop val))' to be sure to
use the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- unsigned short int quit_count = 0;
- Lisp_Object prev = Qnil;
- for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
- tail = XCDR (XCDR (tail)))
+ Lisp_Object prev = Qnil, tail = plist;
+ FOR_EACH_TAIL (tail)
{
+ if (! CONSP (XCDR (tail)))
+ break;
+
if (! NILP (Fequal (prop, XCAR (tail))))
{
Fsetcar (XCDR (tail), val);
@@ -2130,8 +2067,11 @@ The PLIST is modified by side effects. */)
}
prev = tail;
- rarely_quit (++quit_count);
+ tail = XCDR (tail);
+ if (EQ (tail, li.tortoise))
+ circular_list (plist);
}
+ CHECK_LIST_END (tail, plist);
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
@@ -2180,6 +2120,7 @@ static bool
internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
Lisp_Object ht)
{
+ tail_recurse:
if (depth > 10)
{
if (depth > 200)
@@ -2208,9 +2149,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int
depth, bool props,
}
}
- unsigned short int quit_count = 0;
- tail_recurse:
- rarely_quit (++quit_count);
if (EQ (o1, o2))
return 1;
if (XTYPE (o1) != XTYPE (o2))
@@ -2230,12 +2168,20 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int
depth, bool props,
}
case Lisp_Cons:
- if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
- return 0;
- o1 = XCDR (o1);
- o2 = XCDR (o2);
- /* FIXME: This inf-loops in a circular list! */
- goto tail_recurse;
+ {
+ FOR_EACH_TAIL (o1)
+ {
+ if (! CONSP (o2))
+ return false;
+ if (! internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
+ return false;
+ o2 = XCDR (o2);
+ if (EQ (XCDR (o1), o2))
+ return true;
+ }
+ depth++;
+ goto tail_recurse;
+ }
case Lisp_Misc:
if (XMISCTYPE (o1) != XMISCTYPE (o2))
@@ -2249,6 +2195,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int
depth, bool props,
return 0;
o1 = XOVERLAY (o1)->plist;
o2 = XOVERLAY (o2)->plist;
+ depth++;
goto tail_recurse;
}
if (MARKERP (o1))
@@ -2399,7 +2346,6 @@ Only the last argument is not altered, and need not be a
list.
usage: (nconc &rest LISTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- unsigned short int quit_count = 0;
Lisp_Object val = Qnil;
for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
@@ -2415,13 +2361,8 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
Lisp_Object tail;
- do
- {
- tail = tem;
- tem = XCDR (tail);
- rarely_quit (++quit_count);
- }
- while (CONSP (tem));
+ FOR_EACH_TAIL (tem)
+ tail = tem;
tem = args[argnum + 1];
Fsetcdr (tail, tem);
@@ -2843,14 +2784,19 @@ property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
(Lisp_Object plist, Lisp_Object prop)
{
- unsigned short int quit_count = 0;
- while (CONSP (plist) && !EQ (XCAR (plist), prop))
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL (tail)
{
- plist = XCDR (plist);
- plist = CDR (plist);
- rarely_quit (++quit_count);
+ if (EQ (XCAR (tail), prop))
+ return tail;
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
+ if (EQ (tail, li.tortoise))
+ circular_list (tail);
}
- return plist;
+ CHECK_LIST_END (tail, plist);
+ return Qnil;
}
DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
diff --git a/src/image.c b/src/image.c
index ad0143b..1e8ebfd 100644
--- a/src/image.c
+++ b/src/image.c
@@ -3110,8 +3110,8 @@ xbm_load (struct frame *f, struct image *img)
int nbytes, i;
/* Windows mono bitmaps are reversed compared with X. */
invertedBits = bits;
- nbytes = (img->width + CHAR_BIT - 1) / CHAR_BIT;
- SAFE_NALLOCA (bits, nbytes, img->height);
+ nbytes = (img->width + CHAR_BIT - 1) / CHAR_BIT * img->height;
+ SAFE_NALLOCA (bits, 1, nbytes);
for (i = 0; i < nbytes; i++)
bits[i] = XBM_BIT_SHUFFLE (invertedBits[i]);
}
@@ -5465,7 +5465,17 @@ pbm_load (struct frame *f, struct image *img)
c <<= 1;
}
else
- g = pbm_scan_number (&p, end);
+ {
+ int c = 0;
+ /* Skip white-space and comments. */
+ while ((c = pbm_next_char (&p, end)) != -1 && c_isspace (c))
+ ;
+
+ if (c == '0' || c == '1')
+ g = c - '0';
+ else
+ g = 0;
+ }
#ifdef USE_CAIRO
*dataptr++ = g ? fga32 : bga32;
diff --git a/src/keyboard.c b/src/keyboard.c
index a86e7c5..ed8e71f 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10001,6 +10001,30 @@ See also `this-command-keys-vector'. */)
XVECTOR (this_command_keys)->contents);
}
+DEFUN ("set--this-command-keys", Fset__this_command_keys,
+ Sset__this_command_keys, 1, 1, 0,
+ doc: /* Set the vector to be returned by `this-command-keys'.
+The argument KEYS must be a string.
+Internal use only. */)
+ (Lisp_Object keys)
+{
+ CHECK_STRING (keys);
+
+ this_command_key_count = 0;
+ this_single_command_key_start = 0;
+ int key0 = SREF (keys, 0);
+
+ /* Kludge alert: this makes M-x be in the form expected by
+ novice.el. Any better ideas? */
+ if (key0 == 248)
+ add_command_key (make_number ('x' | meta_modifier));
+ else
+ add_command_key (make_number (key0));
+ for (ptrdiff_t i = 1; i < SCHARS (keys); i++)
+ add_command_key (make_number (SREF (keys, i)));
+ return Qnil;
+}
+
DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,
Sthis_command_keys_vector, 0, 0, 0,
doc: /* Return the key sequence that invoked this command, as a vector.
However, if the command has called `read-key-sequence', it returns
@@ -11211,6 +11235,7 @@ syms_of_keyboard (void)
defsubr (&Sthis_command_keys_vector);
defsubr (&Sthis_single_command_keys);
defsubr (&Sthis_single_command_raw_keys);
+ defsubr (&Sset__this_command_keys);
defsubr (&Sclear_this_command_keys);
defsubr (&Ssuspend_emacs);
defsubr (&Sabort_recursive_edit);
diff --git a/src/lisp.h b/src/lisp.h
index a9011b4..f1e2685 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3129,20 +3129,14 @@ extern void maybe_quit (void);
#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
-/* Heuristic on how many iterations of a tight loop can be safely done
- before it's time to do a quit. This must be a power of 2. It
- is nice but not necessary for it to equal USHRT_MAX + 1. */
-
-enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-
/* Process a quit rarely, based on a counter COUNT, for efficiency.
- "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
- times, whichever is smaller (somewhat arbitrary, but often faster). */
+ "Rarely" means once per USHRT_MAX + 1 times; this is somewhat
+ arbitrary, but efficient. */
INLINE void
rarely_quit (unsigned short int count)
{
- if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
+ if (! count)
maybe_quit ();
}
@@ -3317,6 +3311,7 @@ extern struct Lisp_Symbol *indirect_variable (struct
Lisp_Symbol *);
extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
Lisp_Object);
+extern _Noreturn void circular_list (Lisp_Object);
extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
enum Set_Internal_Bind {
SET_INTERNAL_SET,
@@ -4585,20 +4580,54 @@ enum
Lisp_String)) \
: make_unibyte_string (str, len))
-/* Loop over all tails of a list, checking for cycles.
- FIXME: Make tortoise and n internal declarations.
- FIXME: Unroll the loop body so we don't need `n'. */
-#define FOR_EACH_TAIL(hare, list, tortoise, n) \
- for ((tortoise) = (hare) = (list), (n) = true; \
- CONSP (hare); \
- (hare = XCDR (hare), (n) = !(n), \
- ((n) \
- ? (EQ (hare, tortoise) \
- ? xsignal1 (Qcircular_list, list) \
- : (void) 0) \
- /* Move tortoise before the next iteration, in case */ \
- /* the next iteration does an Fsetcdr. */ \
- : (void) ((tortoise) = XCDR (tortoise)))))
+/* Loop over conses of the list TAIL, signaling if a cycle is found,
+ and possibly quitting after each loop iteration. In the loop body,
+ set TAIL to the current cons. If the loop exits normally,
+ set TAIL to the terminating non-cons, typically nil. The loop body
+ should not modify the list’s top level structure other than by
+ perhaps deleting the current cons. */
+
+#define FOR_EACH_TAIL(tail) \
+ FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true)
+
+/* Like FOR_EACH_TAIL (LIST), except do not signal or quit.
+ If the loop exits due to a cycle, TAIL’s value is undefined. */
+
+#define FOR_EACH_TAIL_SAFE(tail) \
+ FOR_EACH_TAIL_INTERNAL (tail, (void) ((tail) = Qnil), false)
+
+/* Iterator intended for use only within FOR_EACH_TAIL_INTERNAL. */
+struct for_each_tail_internal
+{
+ Lisp_Object tortoise;
+ intptr_t max, n;
+ unsigned short int q;
+};
+
+/* Like FOR_EACH_TAIL (LIST), except evaluate CYCLE if a cycle is
+ found, and check for quit if CHECK_QUIT. This is an internal macro
+ intended for use only by the above macros.
+
+ Use Brent’s teleporting tortoise-hare algorithm. See:
+ Brent RP. BIT. 1980;20(2):176-84. doi:10.1007/BF01933190
+ http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf
+
+ This macro uses maybe_quit because of an excess of caution. The
+ call to maybe_quit should not be needed in practice, as a very long
+ list, whether circular or not, will cause Emacs to be so slow in
+ other noninterruptible areas (e.g., garbage collection) that there
+ is little point to calling maybe_quit here. */
+
+#define FOR_EACH_TAIL_INTERNAL(tail, cycle, check_quit)
\
+ for (struct for_each_tail_internal li = { tail, 2, 0, 2 }; \
+ CONSP (tail); \
+ ((tail) = XCDR (tail), \
+ ((--li.q != 0 \
+ || ((check_quit) ? maybe_quit () : (void) 0, 0 < --li.n) \
+ || (li.q = li.n = li.max <<= 1, li.n >>= USHRT_WIDTH, \
+ li.tortoise = (tail), false)) \
+ && EQ (tail, li.tortoise)) \
+ ? (cycle) : (void) 0))
/* Do a `for' loop over alist values. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 0e329df..e59934d 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -18972,7 +18972,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph,
int area)
glyph->pixel_width,
glyph->u.ch,
(glyph->u.ch < 0x80 && glyph->u.ch >= ' '
- ? glyph->u.ch
+ ? (int) glyph->u.ch
: '.'),
glyph->face_id,
glyph->left_box_line_p,
@@ -18993,7 +18993,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph,
int area)
? '0'
: '-'))),
glyph->pixel_width,
- 0,
+ 0u,
' ',
glyph->face_id,
glyph->left_box_line_p,
@@ -19014,7 +19014,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph,
int area)
? '0'
: '-'))),
glyph->pixel_width,
- glyph->u.img_id,
+ (unsigned int) glyph->u.img_id,
'.',
glyph->face_id,
glyph->left_box_line_p,
@@ -19035,7 +19035,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph,
int area)
? '0'
: '-'))),
glyph->pixel_width,
- glyph->u.cmp.id);
+ (unsigned int) glyph->u.cmp.id);
if (glyph->u.cmp.automatic)
fprintf (stderr,
"[%d-%d]",
@@ -20995,7 +20995,10 @@ display_line (struct it *it)
up to the right margin of the window. */
extend_face_to_end_of_line (it);
}
- else if (it->c == '\t' && FRAME_WINDOW_P (it->f))
+ else if ((it->what == IT_CHARACTER
+ || it->what == IT_STRETCH
+ || it->what == IT_COMPOSITION)
+ && it->c == '\t' && FRAME_WINDOW_P (it->f))
{
/* A TAB that extends past the right edge of the
window. This produces a single glyph on
@@ -23033,30 +23036,19 @@ display_mode_element (struct it *it, int depth, int
field_width, int precision,
goto tail_recurse;
}
else if (STRINGP (car) || CONSP (car))
- {
- Lisp_Object halftail = elt;
- int len = 0;
-
- while (CONSP (elt)
- && (precision <= 0 || n < precision))
- {
- n += display_mode_element (it, depth,
- /* Do padding only after the last
- element in the list. */
- (! CONSP (XCDR (elt))
- ? field_width - n
- : 0),
- precision - n, XCAR (elt),
- props, risky);
- elt = XCDR (elt);
- len++;
- if ((len & 1) == 0)
- halftail = XCDR (halftail);
- /* Check for cycle. */
- if (EQ (halftail, elt))
- break;
- }
- }
+ FOR_EACH_TAIL_SAFE (elt)
+ {
+ if (0 < precision && precision <= n)
+ break;
+ n += display_mode_element (it, depth,
+ /* Pad after only the last
+ list element. */
+ (! CONSP (XCDR (elt))
+ ? field_width - n
+ : 0),
+ precision - n, XCAR (elt),
+ props, risky);
+ }
}
break;
@@ -24624,7 +24616,7 @@ dump_glyph_string (struct glyph_string *s)
fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n",
s->x, s->y, s->width, s->height);
fprintf (stderr, " ybase = %d\n", s->ybase);
- fprintf (stderr, " hl = %d\n", s->hl);
+ fprintf (stderr, " hl = %u\n", s->hl);
fprintf (stderr, " left overhang = %d, right = %d\n",
s->left_overhang, s->right_overhang);
fprintf (stderr, " nchars = %d\n", s->nchars);
diff --git a/src/xfaces.c b/src/xfaces.c
index 830106d..b5dbb53 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6251,7 +6251,7 @@ dump_realized_face (struct face *face)
fprintf (stderr, "underline: %d (%s)\n",
face->underline_p,
SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
- fprintf (stderr, "hash: %d\n", face->hash);
+ fprintf (stderr, "hash: %u\n", face->hash);
}
diff --git a/src/xwidget.c b/src/xwidget.c
index 4ba1617..5c276b1 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -301,13 +301,13 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value)
{
JSStringRef pname = JSStringCreateWithUTF8CString("length");
JSValueRef len = JSObjectGetProperty (context, (JSObjectRef)
value, pname, NULL);
- int n = JSValueToNumber (context, len, NULL);
+ EMACS_INT n = JSValueToNumber (context, len, NULL);
JSStringRelease(pname);
Lisp_Object obj;
struct Lisp_Vector *p = allocate_vector (n);
- for (int i = 0; i < n; ++i)
+ for (ptrdiff_t i = 0; i < n; ++i)
{
p->contents[i] =
webkit_js_to_lisp (context,
@@ -323,13 +323,13 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value)
JSPropertyNameArrayRef properties =
JSObjectCopyPropertyNames (context, (JSObjectRef) value);
- int n = JSPropertyNameArrayGetCount (properties);
+ ptrdiff_t n = JSPropertyNameArrayGetCount (properties);
Lisp_Object obj;
/* TODO: can we use a regular list here? */
struct Lisp_Vector *p = allocate_vector (n);
- for (int i = 0; i < n; ++i)
+ for (ptrdiff_t i = 0; i < n; ++i)
{
JSStringRef name = JSPropertyNameArrayGetNameAtIndex
(properties, i);
JSValueRef property = JSObjectGetProperty (context,
@@ -733,8 +733,8 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize,
3, 3, 0,
(Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height)
{
CHECK_XWIDGET (xwidget);
- CHECK_NATNUM (new_width);
- CHECK_NATNUM (new_height);
+ CHECK_RANGED_INTEGER (new_width, 0, INT_MAX);
+ CHECK_RANGED_INTEGER (new_height, 0, INT_MAX);
struct xwidget *xw = XXWIDGET (xwidget);
int w = XFASTINT (new_width);
int h = XFASTINT (new_height);
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 27434bc..dcd83a3 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -676,6 +676,9 @@ delivered."
buf)
(unwind-protect
(progn
+ ;; In the remote case, `vc-refresh-state' returns undesired
+ ;; error messages. Let's suppress them.
+ (advice-add 'vc-refresh-state :around 'ignore)
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -745,6 +748,7 @@ delivered."
(file-notify--test-cleanup-p))
;; Cleanup.
+ (advice-remove 'vc-refresh-state 'ignore)
(ignore-errors (kill-buffer buf))
(file-notify--test-cleanup))))
diff --git a/test/lisp/progmodes/bat-mode-tests.el
b/test/lisp/progmodes/bat-mode-tests.el
new file mode 100644
index 0000000..565718e
--- /dev/null
+++ b/test/lisp/progmodes/bat-mode-tests.el
@@ -0,0 +1,86 @@
+;;; bat-mode-tests.el --- Tests for bat-mode.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Vladimir Panteleev <address@hidden>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'bat-mode)
+(require 'htmlfontify)
+
+(defun bat-test-fontify (str)
+ "Fontify STR in `bat-mode' to a HTML string using `htmlfontify' and return
it."
+ (with-temp-buffer
+ (insert str)
+ (bat-mode)
+ (let ((hfy-optimizations '(body-text-only merge-adjacent-tags)))
+ (with-current-buffer (htmlfontify-buffer) (buffer-string)))))
+
+(ert-deftest bat-test-fontification-var-decl ()
+ "Test fontification of variable declarations."
+ (should
+ (equal
+ (bat-test-fontify "set a_b-c{d}e=f")
+ "<span class=\"builtin\">set</span> <span
class=\"variable-name\">a_b-c{d}e</span>=f")))
+
+(ert-deftest bat-test-fontification-var-exp ()
+ "Test fontification of variable expansions."
+ (should
+ (equal
+ (bat-test-fontify "echo %a_b-c{d}e%")
+ "<span class=\"builtin\">echo</span> %<span
class=\"variable-name\">a_b-c{d}e</span>%")))
+
+(ert-deftest bat-test-fontification-var-delayed-exp ()
+ "Test fontification of delayed variable expansions."
+ (should
+ (equal
+ (bat-test-fontify "echo !a_b-c{d}e!")
+ "<span class=\"builtin\">echo</span> !<span
class=\"variable-name\">a_b-c{d}e</span>!")))
+
+(ert-deftest bat-test-fontification-iter-var-1 ()
+ "Test fontification of iteration variables."
+ (should
+ (equal
+ (bat-test-fontify "echo %%a\necho %%~dp1\necho %%~$PATH:I")
+ "<span class=\"builtin\">echo</span> %%<span
class=\"variable-name\">a</span>
+<span class=\"builtin\">echo</span> %%~dp<span class=\"variable-name\">1</span>
+<span class=\"builtin\">echo</span> %%~$<span
class=\"variable-name\">PATH</span>:<span class=\"variable-name\">I</span>")))
+
+(defun bat-test-fill-paragraph (str)
+ "Return the result of invoking `fill-paragraph' on STR in a `bat-mode'
buffer."
+ (with-temp-buffer
+ (bat-mode)
+ (insert str)
+ (goto-char 1)
+ (font-lock-ensure)
+ (fill-paragraph)
+ (buffer-string)))
+
+(ert-deftest bat-test-fill-paragraph-comment ()
+ "Test `fill-paragraph' in a comment block."
+ (should (equal (bat-test-fill-paragraph "rem foo\nrem bar\n") "rem foo
bar\n")))
+
+(provide 'bat-tests)
+;;; bat-mode-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index ee3c5dc..160d0f1 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -245,3 +245,301 @@
(let ((data '((foo) (bar))))
(should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar))))))
+
+;; Test handling of cyclic and dotted lists.
+
+(defun cyc1 (a)
+ (let ((ls (make-list 10 a)))
+ (nconc ls ls)
+ ls))
+
+(defun cyc2 (a b)
+ (let ((ls1 (make-list 10 a))
+ (ls2 (make-list 1000 b)))
+ (nconc ls2 ls2)
+ (nconc ls1 ls2)
+ ls1))
+
+(defun dot1 (a)
+ (let ((ls (make-list 10 a)))
+ (nconc ls 'tail)
+ ls))
+
+(defun dot2 (a b)
+ (let ((ls1 (make-list 10 a))
+ (ls2 (make-list 10 b)))
+ (nconc ls1 ls2)
+ (nconc ls2 'tail)
+ ls1))
+
+(ert-deftest test-cycle-length ()
+ (should-error (length (cyc1 1)) :type 'circular-list)
+ (should-error (length (cyc2 1 2)) :type 'circular-list)
+ (should-error (length (dot1 1)) :type 'wrong-type-argument)
+ (should-error (length (dot2 1 2)) :type 'wrong-type-argument))
+
+(ert-deftest test-cycle-safe-length ()
+ (should (<= 10 (safe-length (cyc1 1))))
+ (should (<= 1010 (safe-length (cyc2 1 2))))
+ (should (= 10 (safe-length (dot1 1))))
+ (should (= 20 (safe-length (dot2 1 2)))))
+
+(ert-deftest test-cycle-member ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (member 1 c1))
+ (should (member 1 c2))
+ (should (member 1 d1))
+ (should (member 1 d2))
+ (should-error (member 2 c1) :type 'circular-list)
+ (should (member 2 c2))
+ (should-error (member 2 d1) :type 'wrong-type-argument)
+ (should (member 2 d2))
+ (should-error (member 3 c1) :type 'circular-list)
+ (should-error (member 3 c2) :type 'circular-list)
+ (should-error (member 3 d1) :type 'wrong-type-argument)
+ (should-error (member 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-memq ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (memq 1 c1))
+ (should (memq 1 c2))
+ (should (memq 1 d1))
+ (should (memq 1 d2))
+ (should-error (memq 2 c1) :type 'circular-list)
+ (should (memq 2 c2))
+ (should-error (memq 2 d1) :type 'wrong-type-argument)
+ (should (memq 2 d2))
+ (should-error (memq 3 c1) :type 'circular-list)
+ (should-error (memq 3 c2) :type 'circular-list)
+ (should-error (memq 3 d1) :type 'wrong-type-argument)
+ (should-error (memq 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-memql ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (memql 1 c1))
+ (should (memql 1 c2))
+ (should (memql 1 d1))
+ (should (memql 1 d2))
+ (should-error (memql 2 c1) :type 'circular-list)
+ (should (memql 2 c2))
+ (should-error (memql 2 d1) :type 'wrong-type-argument)
+ (should (memql 2 d2))
+ (should-error (memql 3 c1) :type 'circular-list)
+ (should-error (memql 3 c2) :type 'circular-list)
+ (should-error (memql 3 d1) :type 'wrong-type-argument)
+ (should-error (memql 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-assq ()
+ (let ((c1 (cyc1 '(1)))
+ (c2 (cyc2 '(1) '(2)))
+ (d1 (dot1 '(1)))
+ (d2 (dot2 '(1) '(2))))
+ (should (assq 1 c1))
+ (should (assq 1 c2))
+ (should (assq 1 d1))
+ (should (assq 1 d2))
+ (should-error (assq 2 c1) :type 'circular-list)
+ (should (assq 2 c2))
+ (should-error (assq 2 d1) :type 'wrong-type-argument)
+ (should (assq 2 d2))
+ (should-error (assq 3 c1) :type 'circular-list)
+ (should-error (assq 3 c2) :type 'circular-list)
+ (should-error (assq 3 d1) :type 'wrong-type-argument)
+ (should-error (assq 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-assoc ()
+ (let ((c1 (cyc1 '(1)))
+ (c2 (cyc2 '(1) '(2)))
+ (d1 (dot1 '(1)))
+ (d2 (dot2 '(1) '(2))))
+ (should (assoc 1 c1))
+ (should (assoc 1 c2))
+ (should (assoc 1 d1))
+ (should (assoc 1 d2))
+ (should-error (assoc 2 c1) :type 'circular-list)
+ (should (assoc 2 c2))
+ (should-error (assoc 2 d1) :type 'wrong-type-argument)
+ (should (assoc 2 d2))
+ (should-error (assoc 3 c1) :type 'circular-list)
+ (should-error (assoc 3 c2) :type 'circular-list)
+ (should-error (assoc 3 d1) :type 'wrong-type-argument)
+ (should-error (assoc 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-rassq ()
+ (let ((c1 (cyc1 '(0 . 1)))
+ (c2 (cyc2 '(0 . 1) '(0 . 2)))
+ (d1 (dot1 '(0 . 1)))
+ (d2 (dot2 '(0 . 1) '(0 . 2))))
+ (should (rassq 1 c1))
+ (should (rassq 1 c2))
+ (should (rassq 1 d1))
+ (should (rassq 1 d2))
+ (should-error (rassq 2 c1) :type 'circular-list)
+ (should (rassq 2 c2))
+ (should-error (rassq 2 d1) :type 'wrong-type-argument)
+ (should (rassq 2 d2))
+ (should-error (rassq 3 c1) :type 'circular-list)
+ (should-error (rassq 3 c2) :type 'circular-list)
+ (should-error (rassq 3 d1) :type 'wrong-type-argument)
+ (should-error (rassq 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-rassoc ()
+ (let ((c1 (cyc1 '(0 . 1)))
+ (c2 (cyc2 '(0 . 1) '(0 . 2)))
+ (d1 (dot1 '(0 . 1)))
+ (d2 (dot2 '(0 . 1) '(0 . 2))))
+ (should (rassoc 1 c1))
+ (should (rassoc 1 c2))
+ (should (rassoc 1 d1))
+ (should (rassoc 1 d2))
+ (should-error (rassoc 2 c1) :type 'circular-list)
+ (should (rassoc 2 c2))
+ (should-error (rassoc 2 d1) :type 'wrong-type-argument)
+ (should (rassoc 2 d2))
+ (should-error (rassoc 3 c1) :type 'circular-list)
+ (should-error (rassoc 3 c2) :type 'circular-list)
+ (should-error (rassoc 3 d1) :type 'wrong-type-argument)
+ (should-error (rassoc 3 d2) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-delq ()
+ (should-error (delq 1 (cyc1 1)) :type 'circular-list)
+ (should-error (delq 1 (cyc2 1 2)) :type 'circular-list)
+ (should-error (delq 1 (dot1 1)) :type 'wrong-type-argument)
+ (should-error (delq 1 (dot2 1 2)) :type 'wrong-type-argument)
+ (should-error (delq 2 (cyc1 1)) :type 'circular-list)
+ (should-error (delq 2 (cyc2 1 2)) :type 'circular-list)
+ (should-error (delq 2 (dot1 1)) :type 'wrong-type-argument)
+ (should-error (delq 2 (dot2 1 2)) :type 'wrong-type-argument)
+ (should-error (delq 3 (cyc1 1)) :type 'circular-list)
+ (should-error (delq 3 (cyc2 1 2)) :type 'circular-list)
+ (should-error (delq 3 (dot1 1)) :type 'wrong-type-argument)
+ (should-error (delq 3 (dot2 1 2)) :type 'wrong-type-argument))
+
+(ert-deftest test-cycle-delete ()
+ (should-error (delete 1 (cyc1 1)) :type 'circular-list)
+ (should-error (delete 1 (cyc2 1 2)) :type 'circular-list)
+ (should-error (delete 1 (dot1 1)) :type 'wrong-type-argument)
+ (should-error (delete 1 (dot2 1 2)) :type 'wrong-type-argument)
+ (should-error (delete 2 (cyc1 1)) :type 'circular-list)
+ (should-error (delete 2 (cyc2 1 2)) :type 'circular-list)
+ (should-error (delete 2 (dot1 1)) :type 'wrong-type-argument)
+ (should-error (delete 2 (dot2 1 2)) :type 'wrong-type-argument)
+ (should-error (delete 3 (cyc1 1)) :type 'circular-list)
+ (should-error (delete 3 (cyc2 1 2)) :type 'circular-list)
+ (should-error (delete 3 (dot1 1)) :type 'wrong-type-argument)
+ (should-error (delete 3 (dot2 1 2)) :type 'wrong-type-argument))
+
+(ert-deftest test-cycle-reverse ()
+ (should-error (reverse (cyc1 1)) :type 'circular-list)
+ (should-error (reverse (cyc2 1 2)) :type 'circular-list)
+ (should-error (reverse (dot1 1)) :type 'wrong-type-argument)
+ (should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
+
+(ert-deftest test-cycle-plist-get ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (plist-get c1 1))
+ (should (plist-get c2 1))
+ (should (plist-get d1 1))
+ (should (plist-get d2 1))
+ (should-not (plist-get c1 2))
+ (should (plist-get c2 2))
+ (should-not (plist-get d1 2))
+ (should (plist-get d2 2))
+ (should-not (plist-get c1 3))
+ (should-not (plist-get c2 3))
+ (should-not (plist-get d1 3))
+ (should-not (plist-get d2 3))))
+
+(ert-deftest test-cycle-lax-plist-get ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (lax-plist-get c1 1))
+ (should (lax-plist-get c2 1))
+ (should (lax-plist-get d1 1))
+ (should (lax-plist-get d2 1))
+ (should-error (lax-plist-get c1 2) :type 'circular-list)
+ (should (lax-plist-get c2 2))
+ (should-not (lax-plist-get d1 2))
+ (should (lax-plist-get d2 2))
+ (should-error (lax-plist-get c1 3) :type 'circular-list)
+ (should-error (lax-plist-get c2 3) :type 'circular-list)
+ (should-not (lax-plist-get d1 3))
+ (should-not (lax-plist-get d2 3))))
+
+(ert-deftest test-cycle-plist-member ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (plist-member c1 1))
+ (should (plist-member c2 1))
+ (should (plist-member d1 1))
+ (should (plist-member d2 1))
+ (should-error (plist-member c1 2) :type 'circular-list)
+ (should (plist-member c2 2))
+ (should-error (plist-member d1 2) :type 'wrong-type-argument)
+ (should (plist-member d2 2))
+ (should-error (plist-member c1 3) :type 'circular-list)
+ (should-error (plist-member c2 3) :type 'circular-list)
+ (should-error (plist-member d1 3) :type 'wrong-type-argument)
+ (should-error (plist-member d2 3) :type 'wrong-type-argument)))
+
+(ert-deftest test-cycle-plist-put ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (plist-put c1 1 1))
+ (should (plist-put c2 1 1))
+ (should (plist-put d1 1 1))
+ (should (plist-put d2 1 1))
+ (should-error (plist-put c1 2 2) :type 'circular-list)
+ (should (plist-put c2 2 2))
+ (should (plist-put d1 2 2))
+ (should (plist-put d2 2 2))
+ (should-error (plist-put c1 3 3) :type 'circular-list)
+ (should-error (plist-put c2 3 3) :type 'circular-list)
+ (should (plist-put d1 3 3))
+ (should (plist-put d2 3 3))))
+
+(ert-deftest test-cycle-lax-plist-put ()
+ (let ((c1 (cyc1 1))
+ (c2 (cyc2 1 2))
+ (d1 (dot1 1))
+ (d2 (dot2 1 2)))
+ (should (lax-plist-put c1 1 1))
+ (should (lax-plist-put c2 1 1))
+ (should (lax-plist-put d1 1 1))
+ (should (lax-plist-put d2 1 1))
+ (should-error (lax-plist-put c1 2 2) :type 'circular-list)
+ (should (lax-plist-put c2 2 2))
+ (should (lax-plist-put d1 2 2))
+ (should (lax-plist-put d2 2 2))
+ (should-error (lax-plist-put c1 3 3) :type 'circular-list)
+ (should-error (lax-plist-put c2 3 3) :type 'circular-list)
+ (should (lax-plist-put d1 3 3))
+ (should (lax-plist-put d2 3 3))))
+
+(ert-deftest test-cycle-equal ()
+ (should-error (equal (cyc1 1) (cyc1 1)))
+ (should-error (equal (cyc2 1 2) (cyc2 1 2))))
+
+(ert-deftest test-cycle-nconc ()
+ (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
+ (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
+
+(provide 'fns-tests)