Merge branch 'master' into feature/byte-switch
This commit is contained in:
Vibhav Pant
commit
c1a9b5db0e
33 changed files with 964 additions and 346 deletions
|
|
@ -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
|
||||
) >$@.tmp
|
||||
mv $@.tmp $@
|
||||
|
||||
INSTALL_DVI = install-emacs-dvi install-lispref-dvi \
|
||||
install-lispintro-dvi install-misc-dvi
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
10
etc/NEWS
10
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.
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 \(
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -2654,6 +2654,10 @@ such as a mark that says whether an article is stored in the cache
|
|||
"submit@debbugs.gnu.org (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")
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 "))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
144
lisp/xdg.el
Normal file
144
lisp/xdg.el
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mark Oteiza <mvoteiza@udel.edu>
|
||||
;; 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
|
||||
|
|
@ -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)
|
||||
{
|
||||
/* 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;
|
||||
}
|
||||
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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
262
src/fns.c
262
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,
|
||||
|
|
|
|||
16
src/image.c
16
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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
75
src/lisp.h
75
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. */
|
||||
|
||||
|
|
|
|||
52
src/xdisp.c
52
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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
86
test/lisp/progmodes/bat-mode-tests.el
Normal file
86
test/lisp/progmodes/bat-mode-tests.el
Normal file
|
|
@ -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 <vladimir@thecybershadow.net>
|
||||
;; 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
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue