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

* lisp/isearch.el: Misc simplification; use defstruct.

Browse Source 
(isearch-mode-map): Dense maps now work like sparse ones.
(isearch--state): New defstruct.
(isearch-string-state, isearch-message-state, isearch-point-state)
(isearch-success-state, isearch-forward-state)
(isearch-other-end-state, isearch-word-state, isearch-error-state)
(isearch-wrapped-state, isearch-barrier-state)
(isearch-case-fold-search-state, isearch-pop-fun-state): Remove,
replaced by defstruct's accessors.
(isearch--set-state): Rename from isearch-top-state and change
calling convention.
(isearch-push-state): Use new isearch--get-state.
(isearch-toggle-word): Disable regexp when enabling word.
(isearch-message-prefix): Remove unused arg _c-q-hack.
(isearch-message-suffix): Remove unused arg _ellipsis.
This commit is contained in:
Stefan Monnier 2012-08-04 18:31:04 -04:00
parent ce555168d9
commit 7c2dc8bd36
2 changed files with 101 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lisp/ChangeLog
View File

@ -1,3 +1,21 @@
2012-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
* isearch.el: Misc simplification; use defstruct.
(isearch-mode-map): Dense maps now work like sparse ones.
(isearch--state): New defstruct.
(isearch-string-state, isearch-message-state, isearch-point-state)
(isearch-success-state, isearch-forward-state)
(isearch-other-end-state, isearch-word-state, isearch-error-state)
(isearch-wrapped-state, isearch-barrier-state)
(isearch-case-fold-search-state, isearch-pop-fun-state): Remove,
replaced by defstruct's accessors.
(isearch--set-state): Rename from isearch-top-state and change
calling convention.
(isearch-push-state): Use new isearch--get-state.
(isearch-toggle-word): Disable regexp when enabling word.
(isearch-message-prefix): Remove unused arg _c-q-hack.
(isearch-message-suffix): Remove unused arg _ellipsis.
2012-08-04 Andreas Schwab <schwab@linux-m68k.org> 2012-08-04 Andreas Schwab <schwab@linux-m68k.org>
* simple.el (list-processes--refresh): For a server use :host or * simple.el (list-processes--refresh): For a server use :host or

183
lisp/isearch.el
View File

@ -57,6 +57,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib))
;; Some additional options and constants. ;; Some additional options and constants.
@ -413,13 +414,6 @@ This is like `describe-bindings', but displays only Isearch keys."
;; Make function keys, etc, which aren't bound to a scrolling-function ;; Make function keys, etc, which aren't bound to a scrolling-function
;; exit the search. ;; exit the search.
(define-key map [t] 'isearch-other-control-char) (define-key map [t] 'isearch-other-control-char)
;; Control chars, by default, end isearch mode transparently.
;; We need these explicit definitions because, in a dense keymap,
;; the binding for t does not affect characters.
;; We use a dense keymap to save space.
(while (< i ?\s)
(define-key map (make-string 1 i) 'isearch-other-control-char)
(setq i (1+ i)))
;; Single-byte printing chars extend the search string by default. ;; Single-byte printing chars extend the search string by default.
(setq i ?\s) (setq i ?\s)
@ -434,8 +428,8 @@ This is like `describe-bindings', but displays only Isearch keys."
;; default local key binding for any key not otherwise bound. ;; default local key binding for any key not otherwise bound.
(let ((meta-map (make-sparse-keymap))) (let ((meta-map (make-sparse-keymap)))
(define-key map (char-to-string meta-prefix-char) meta-map) (define-key map (char-to-string meta-prefix-char) meta-map)
(define-key map [escape] meta-map)) (define-key map [escape] meta-map)
(define-key map (vector meta-prefix-char t) 'isearch-other-meta-char) (define-key meta-map [t] 'isearch-other-meta-char))
;; Several non-printing chars change the searching behavior. ;; Several non-printing chars change the searching behavior.
(define-key map "\C-s" 'isearch-repeat-forward) (define-key map "\C-s" 'isearch-repeat-forward)
@ -965,9 +959,10 @@ NOPUSH is t and EDIT is t."
(before (if (bobp) nil (before (if (bobp) nil
(get-text-property (1- (point)) 'intangible)))) (get-text-property (1- (point)) 'intangible))))
(when (and before after (eq before after)) (when (and before after (eq before after))
(if isearch-forward (goto-char
(goto-char (next-single-property-change (point) 'intangible)) (if isearch-forward
(goto-char (previous-single-property-change (point) 'intangible))))) (next-single-property-change (point) 'intangible)
(previous-single-property-change (point) 'intangible)))))
(if (and (> (length isearch-string) 0) (not nopush)) (if (and (> (length isearch-string) 0) (not nopush))
;; Update the ring data. ;; Update the ring data.
@ -1007,73 +1002,58 @@ REGEXP if non-nil says use the regexp search ring."
;; The search status structure and stack. ;; The search status structure and stack.
(defsubst isearch-string-state (frame) (cl-defstruct (isearch--state
"Return the search string in FRAME." (:constructor nil)
(aref frame 0)) (:copier nil)
(defsubst isearch-message-state (frame) (:constructor isearch--get-state
"Return the search string to display to the user in FRAME." (&aux
(aref frame 1)) (string isearch-string)
(defsubst isearch-point-state (frame) (message isearch-message)
"Return the point in FRAME." (point (point))
(aref frame 2)) (success isearch-success)
(defsubst isearch-success-state (frame) (forward isearch-forward)
"Return the success flag in FRAME." (other-end isearch-other-end)
(aref frame 3)) (word isearch-word)
(defsubst isearch-forward-state (frame) (error isearch-error)
"Return the searching-forward flag in FRAME." (wrapped isearch-wrapped)
(aref frame 4)) (barrier isearch-barrier)
(defsubst isearch-other-end-state (frame) (case-fold-search isearch-case-fold-search)
"Return the other end of the match in FRAME." (pop-fun (if isearch-push-state-function
(aref frame 5)) (funcall isearch-push-state-function))))))
(defsubst isearch-word-state (frame) (string :read-only t)
"Return the search-by-word flag in FRAME." (message :read-only t)
(aref frame 6)) (point :read-only t)
(defsubst isearch-error-state (frame) (success :read-only t)
"Return the regexp error message in FRAME, or nil if its regexp is valid." (forward :read-only t)
(aref frame 7)) (other-end :read-only t)
(defsubst isearch-wrapped-state (frame) (word :read-only t)
"Return the search-wrapped flag in FRAME." (error :read-only t)
(aref frame 8)) (wrapped :read-only t)
(defsubst isearch-barrier-state (frame) (barrier :read-only t)
"Return the barrier value in FRAME." (case-fold-search :read-only t)
(aref frame 9)) (pop-fun :read-only t))
(defsubst isearch-case-fold-search-state (frame)
"Return the case-folding flag in FRAME."
(aref frame 10))
(defsubst isearch-pop-fun-state (frame)
"Return the function restoring the mode-specific Isearch state in FRAME."
(aref frame 11))
(defun isearch-top-state () (defun isearch--set-state (cmd)
(let ((cmd (car isearch-cmds))) (setq isearch-string (isearch--state-string cmd)
(setq isearch-string (isearch-string-state cmd) isearch-message (isearch--state-message cmd)
isearch-message (isearch-message-state cmd) isearch-success (isearch--state-success cmd)
isearch-success (isearch-success-state cmd) isearch-forward (isearch--state-forward cmd)
isearch-forward (isearch-forward-state cmd) isearch-other-end (isearch--state-other-end cmd)
isearch-other-end (isearch-other-end-state cmd) isearch-word (isearch--state-word cmd)
isearch-word (isearch-word-state cmd) isearch-error (isearch--state-error cmd)
isearch-error (isearch-error-state cmd) isearch-wrapped (isearch--state-wrapped cmd)
isearch-wrapped (isearch-wrapped-state cmd) isearch-barrier (isearch--state-barrier cmd)
isearch-barrier (isearch-barrier-state cmd) isearch-case-fold-search (isearch--state-case-fold-search cmd))
isearch-case-fold-search (isearch-case-fold-search-state cmd)) (if (functionp (isearch--state-pop-fun cmd))
(if (functionp (isearch-pop-fun-state cmd)) (funcall (isearch--state-pop-fun cmd) cmd))
(funcall (isearch-pop-fun-state cmd) cmd)) (goto-char (isearch--state-point cmd)))
(goto-char (isearch-point-state cmd))))
(defun isearch-pop-state () (defun isearch-pop-state ()
(setq isearch-cmds (cdr isearch-cmds)) (setq isearch-cmds (cdr isearch-cmds))
(isearch-top-state)) (isearch--set-state (car isearch-cmds)))
(defun isearch-push-state () (defun isearch-push-state ()
(setq isearch-cmds (push (isearch--get-state) isearch-cmds))
(cons (vector isearch-string isearch-message (point)
isearch-success isearch-forward isearch-other-end
isearch-word
isearch-error isearch-wrapped isearch-barrier
isearch-case-fold-search
(if isearch-push-state-function
(funcall isearch-push-state-function)))
isearch-cmds)))
;; Commands active while inside of the isearch minor mode. ;; Commands active while inside of the isearch minor mode.
@ -1100,11 +1080,11 @@ If MSG is non-nil, use `isearch-message', otherwise `isearch-string'."
(curr-msg (if msg isearch-message isearch-string)) (curr-msg (if msg isearch-message isearch-string))
succ-msg) succ-msg)
(when (or (not isearch-success) isearch-error) (when (or (not isearch-success) isearch-error)
(while (or (not (isearch-success-state (car cmds))) (while (or (not (isearch--state-success (car cmds)))
(isearch-error-state (car cmds))) (isearch--state-error (car cmds)))
(pop cmds)) (pop cmds))
(setq succ-msg (and cmds (if msg (isearch-message-state (car cmds)) (setq succ-msg (and cmds (if msg (isearch--state-message (car cmds))
(isearch-string-state (car cmds))))) (isearch--state-string (car cmds)))))
(if (and (stringp succ-msg) (if (and (stringp succ-msg)
(< (length succ-msg) (length curr-msg)) (< (length succ-msg) (length curr-msg))
(equal succ-msg (equal succ-msg
@ -1201,7 +1181,7 @@ The following additional command keys are active while editing.
(minibuffer-history-symbol)) (minibuffer-history-symbol))
(setq isearch-new-string (setq isearch-new-string
(read-from-minibuffer (read-from-minibuffer
(isearch-message-prefix nil nil isearch-nonincremental) (isearch-message-prefix nil isearch-nonincremental)
(cons isearch-string (1+ (or (isearch-fail-pos) (cons isearch-string (1+ (or (isearch-fail-pos)
(length isearch-string)))) (length isearch-string))))
minibuffer-local-isearch-map nil minibuffer-local-isearch-map nil
@ -1294,18 +1274,18 @@ The following additional command keys are active while editing.
;; For defined push-state function, restore the first state. ;; For defined push-state function, restore the first state.
;; This calls pop-state function and restores original point. ;; This calls pop-state function and restores original point.
(let ((isearch-cmds (last isearch-cmds))) (let ((isearch-cmds (last isearch-cmds)))
(isearch-top-state)) (isearch--set-state (car isearch-cmds)))
(goto-char isearch-opoint)) (goto-char isearch-opoint))
(isearch-done t) ; exit isearch (isearch-done t) ; Exit isearch..
(isearch-clean-overlays) (isearch-clean-overlays)
(signal 'quit nil)) ; and pass on quit signal (signal 'quit nil)) ; ..and pass on quit signal.
(defun isearch-abort () (defun isearch-abort ()
"Abort incremental search mode if searching is successful, signaling quit. "Abort incremental search mode if searching is successful, signaling quit.
Otherwise, revert to previous successful search and continue searching. Otherwise, revert to previous successful search and continue searching.
Use `isearch-exit' to quit without signaling." Use `isearch-exit' to quit without signaling."
(interactive) (interactive)
;; (ding) signal instead below, if quitting ;; (ding) signal instead below, if quitting
(discard-input) (discard-input)
(if (and isearch-success (not isearch-error)) (if (and isearch-success (not isearch-error))
;; If search is successful and has no incomplete regexp, ;; If search is successful and has no incomplete regexp,
@ -1328,9 +1308,7 @@ Use `isearch-exit' to quit without signaling."
(if (null (if isearch-regexp regexp-search-ring search-ring)) (if (null (if isearch-regexp regexp-search-ring search-ring))
(setq isearch-error "No previous search string") (setq isearch-error "No previous search string")
(setq isearch-string (setq isearch-string
(if isearch-regexp (car (if isearch-regexp regexp-search-ring search-ring))
(car regexp-search-ring)
(car search-ring))
isearch-message isearch-message
(mapconcat 'isearch-text-char-description (mapconcat 'isearch-text-char-description
isearch-string "") isearch-string "")
@ -1391,8 +1369,10 @@ Use `isearch-exit' to quit without signaling."
(defun isearch-toggle-word () (defun isearch-toggle-word ()
"Toggle word searching on or off." "Toggle word searching on or off."
;; The status stack is left unchanged.
(interactive) (interactive)
(setq isearch-word (not isearch-word)) (setq isearch-word (not isearch-word))
(if isearch-word (setq isearch-regexp nil))
(setq isearch-success t isearch-adjusted t) (setq isearch-success t isearch-adjusted t)
(isearch-update)) (isearch-update))
@ -1411,7 +1391,7 @@ Use `isearch-exit' to quit without signaling."
(if isearch-case-fold-search nil 'yes)) (if isearch-case-fold-search nil 'yes))
(let ((message-log-max nil)) (let ((message-log-max nil))
(message "%s%s [case %ssensitive]" (message "%s%s [case %ssensitive]"
(isearch-message-prefix nil nil isearch-nonincremental) (isearch-message-prefix nil isearch-nonincremental)
isearch-message isearch-message
(if isearch-case-fold-search "in" ""))) (if isearch-case-fold-search "in" "")))
(setq isearch-success t isearch-adjusted t) (setq isearch-success t isearch-adjusted t)
@ -1857,7 +1837,7 @@ to the barrier."
;; We have to check 2 stack frames because the last might be ;; We have to check 2 stack frames because the last might be
;; invalid just because of a backslash. ;; invalid just because of a backslash.
(or (not isearch-error) (or (not isearch-error)
(not (isearch-error-state (cadr isearch-cmds))) (not (isearch--state-error (cadr isearch-cmds)))
allow-invalid)) allow-invalid))
(if to-barrier (if to-barrier
(progn (goto-char isearch-barrier) (progn (goto-char isearch-barrier)
@ -1872,8 +1852,8 @@ to the barrier."
;; Also skip over postfix operators -- though horrid, ;; Also skip over postfix operators -- though horrid,
;; 'ab?\{5,6\}+\{1,2\}*' is perfectly valid. ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly valid.
(while (and previous (while (and previous
(or (isearch-error-state frame) (or (isearch--state-error frame)
(let* ((string (isearch-string-state frame)) (let* ((string (isearch--state-string frame))
(lchar (aref string (1- (length string))))) (lchar (aref string (1- (length string)))))
;; The operators aren't always operators; check ;; The operators aren't always operators; check
;; backslashes. This doesn't handle the case of ;; backslashes. This doesn't handle the case of
@ -1881,7 +1861,7 @@ to the barrier."
;; being special, but then we should fall back to ;; being special, but then we should fall back to
;; the barrier anyway because it's all optional. ;; the barrier anyway because it's all optional.
(if (isearch-backslash (if (isearch-backslash
(isearch-string-state (car previous))) (isearch--state-string (car previous)))
(eq lchar ?\}) (eq lchar ?\})
(memq lchar '(?* ?? ?+)))))) (memq lchar '(?* ?? ?+))))))
(setq stack previous previous (cdr previous) frame (car stack))) (setq stack previous previous (cdr previous) frame (car stack)))
@ -1891,7 +1871,7 @@ to the barrier."
;; what matched before that. ;; what matched before that.
(let ((last-other-end (let ((last-other-end
(or (and (car previous) (or (and (car previous)
(isearch-other-end-state (car previous))) (isearch--state-other-end (car previous)))
isearch-barrier))) isearch-barrier)))
(goto-char (if isearch-forward (goto-char (if isearch-forward
(max last-other-end isearch-barrier) (max last-other-end isearch-barrier)
@ -2355,12 +2335,12 @@ If there is no completion possible, say so and continue searching."
(add-text-properties (match-beginning 0) (match-end 0) (add-text-properties (match-beginning 0) (match-end 0)
'(face trailing-whitespace) m))) '(face trailing-whitespace) m)))
(setq m (concat (setq m (concat
(isearch-message-prefix c-q-hack ellipsis isearch-nonincremental) (isearch-message-prefix ellipsis isearch-nonincremental)
m m
(isearch-message-suffix c-q-hack ellipsis))) (isearch-message-suffix c-q-hack)))
(if c-q-hack m (let ((message-log-max nil)) (message "%s" m))))) (if c-q-hack m (let ((message-log-max nil)) (message "%s" m)))))
(defun isearch-message-prefix (&optional _c-q-hack ellipsis nonincremental) (defun isearch-message-prefix (&optional ellipsis nonincremental)
;; If about to search, and previous search regexp was invalid, ;; If about to search, and previous search regexp was invalid,
;; check that it still is. If it is valid now, ;; check that it still is. If it is valid now,
;; let the message we display while searching say that it is valid. ;; let the message we display while searching say that it is valid.
@ -2401,7 +2381,7 @@ If there is no completion possible, say so and continue searching."
(propertize (concat (upcase (substring m 0 1)) (substring m 1)) (propertize (concat (upcase (substring m 0 1)) (substring m 1))
'face 'minibuffer-prompt))) 'face 'minibuffer-prompt)))
(defun isearch-message-suffix (&optional c-q-hack _ellipsis) (defun isearch-message-suffix (&optional c-q-hack)
(concat (if c-q-hack "^Q" "") (concat (if c-q-hack "^Q" "")
(if isearch-error (if isearch-error
(concat " [" isearch-error "]") (concat " [" isearch-error "]")
@ -2435,7 +2415,8 @@ Can be changed via `isearch-search-fun-function' for special needs."
;; (or when using nonincremental word isearch) ;; (or when using nonincremental word isearch)
(let ((lax (not (or isearch-nonincremental (let ((lax (not (or isearch-nonincremental
(eq (length isearch-string) (eq (length isearch-string)
(length (isearch-string-state (car isearch-cmds)))))))) (length (isearch--state-string
(car isearch-cmds))))))))
(funcall (funcall
(if isearch-forward #'re-search-forward #'re-search-backward) (if isearch-forward #'re-search-forward #'re-search-backward)
(if (functionp isearch-word) (if (functionp isearch-word)
@ -2501,6 +2482,7 @@ update the match data, and return point."
(isearch-no-upper-case-p isearch-string isearch-regexp))) (isearch-no-upper-case-p isearch-string isearch-regexp)))
(condition-case lossage (condition-case lossage
(let ((inhibit-point-motion-hooks (let ((inhibit-point-motion-hooks
;; FIXME: equality comparisons on functions is asking for trouble.
(and (eq isearch-filter-predicate 'isearch-filter-visible) (and (eq isearch-filter-predicate 'isearch-filter-visible)
search-invisible)) search-invisible))
(inhibit-quit nil) (inhibit-quit nil)
@ -2545,11 +2527,12 @@ update the match data, and return point."
(if isearch-success (if isearch-success
nil nil
;; Ding if failed this time after succeeding last time. ;; Ding if failed this time after succeeding last time.
(and (isearch-success-state (car isearch-cmds)) (and (isearch--state-success (car isearch-cmds))
(ding)) (ding))
(if (functionp (isearch-pop-fun-state (car isearch-cmds))) (if (functionp (isearch--state-pop-fun (car isearch-cmds)))
(funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds))) (funcall (isearch--state-pop-fun (car isearch-cmds))
(goto-char (isearch-point-state (car isearch-cmds))))) (car isearch-cmds)))
(goto-char (isearch--state-point (car isearch-cmds)))))
;; Called when opening an overlay, and we are still in isearch. ;; Called when opening an overlay, and we are still in isearch.