From: Stefan Monnier Date: Sat, 4 Aug 2012 22:31:04 +0000 (-0400) Subject: * lisp/isearch.el: Misc simplification; use defstruct. X-Git-Tag: emacs-24.2.90~856 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7c2dc8bd36acd9bee84354d052593b430d4ad527;p=emacs.git * lisp/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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ff28199d756..fb1f0868d5b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,21 @@ +2012-08-04 Stefan Monnier + + * 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 * simple.el (list-processes--refresh): For a server use :host or diff --git a/lisp/isearch.el b/lisp/isearch.el index 27185bf3fa6..9271ce32484 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -57,6 +57,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) ;; 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 ;; exit the search. (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. (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. (let ((meta-map (make-sparse-keymap))) (define-key map (char-to-string meta-prefix-char) meta-map) - (define-key map [escape] meta-map)) - (define-key map (vector meta-prefix-char t) 'isearch-other-meta-char) + (define-key map [escape] meta-map) + (define-key meta-map [t] 'isearch-other-meta-char)) ;; Several non-printing chars change the searching behavior. (define-key map "\C-s" 'isearch-repeat-forward) @@ -965,9 +959,10 @@ NOPUSH is t and EDIT is t." (before (if (bobp) nil (get-text-property (1- (point)) 'intangible)))) (when (and before after (eq before after)) - (if isearch-forward - (goto-char (next-single-property-change (point) 'intangible)) - (goto-char (previous-single-property-change (point) 'intangible))))) + (goto-char + (if isearch-forward + (next-single-property-change (point) 'intangible) + (previous-single-property-change (point) 'intangible))))) (if (and (> (length isearch-string) 0) (not nopush)) ;; Update the ring data. @@ -1007,73 +1002,58 @@ REGEXP if non-nil says use the regexp search ring." ;; The search status structure and stack. -(defsubst isearch-string-state (frame) - "Return the search string in FRAME." - (aref frame 0)) -(defsubst isearch-message-state (frame) - "Return the search string to display to the user in FRAME." - (aref frame 1)) -(defsubst isearch-point-state (frame) - "Return the point in FRAME." - (aref frame 2)) -(defsubst isearch-success-state (frame) - "Return the success flag in FRAME." - (aref frame 3)) -(defsubst isearch-forward-state (frame) - "Return the searching-forward flag in FRAME." - (aref frame 4)) -(defsubst isearch-other-end-state (frame) - "Return the other end of the match in FRAME." - (aref frame 5)) -(defsubst isearch-word-state (frame) - "Return the search-by-word flag in FRAME." - (aref frame 6)) -(defsubst isearch-error-state (frame) - "Return the regexp error message in FRAME, or nil if its regexp is valid." - (aref frame 7)) -(defsubst isearch-wrapped-state (frame) - "Return the search-wrapped flag in FRAME." - (aref frame 8)) -(defsubst isearch-barrier-state (frame) - "Return the barrier value in FRAME." - (aref frame 9)) -(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 () - (let ((cmd (car isearch-cmds))) - (setq isearch-string (isearch-string-state cmd) - isearch-message (isearch-message-state cmd) - isearch-success (isearch-success-state cmd) - isearch-forward (isearch-forward-state cmd) - isearch-other-end (isearch-other-end-state cmd) - isearch-word (isearch-word-state cmd) - isearch-error (isearch-error-state cmd) - isearch-wrapped (isearch-wrapped-state cmd) - isearch-barrier (isearch-barrier-state cmd) - isearch-case-fold-search (isearch-case-fold-search-state cmd)) - (if (functionp (isearch-pop-fun-state cmd)) - (funcall (isearch-pop-fun-state cmd) cmd)) - (goto-char (isearch-point-state cmd)))) +(cl-defstruct (isearch--state + (:constructor nil) + (:copier nil) + (:constructor isearch--get-state + (&aux + (string isearch-string) + (message isearch-message) + (point (point)) + (success isearch-success) + (forward isearch-forward) + (other-end isearch-other-end) + (word isearch-word) + (error isearch-error) + (wrapped isearch-wrapped) + (barrier isearch-barrier) + (case-fold-search isearch-case-fold-search) + (pop-fun (if isearch-push-state-function + (funcall isearch-push-state-function)))))) + (string :read-only t) + (message :read-only t) + (point :read-only t) + (success :read-only t) + (forward :read-only t) + (other-end :read-only t) + (word :read-only t) + (error :read-only t) + (wrapped :read-only t) + (barrier :read-only t) + (case-fold-search :read-only t) + (pop-fun :read-only t)) + +(defun isearch--set-state (cmd) + (setq isearch-string (isearch--state-string cmd) + isearch-message (isearch--state-message cmd) + isearch-success (isearch--state-success cmd) + isearch-forward (isearch--state-forward cmd) + isearch-other-end (isearch--state-other-end cmd) + isearch-word (isearch--state-word cmd) + isearch-error (isearch--state-error cmd) + isearch-wrapped (isearch--state-wrapped cmd) + isearch-barrier (isearch--state-barrier cmd) + isearch-case-fold-search (isearch--state-case-fold-search cmd)) + (if (functionp (isearch--state-pop-fun cmd)) + (funcall (isearch--state-pop-fun cmd) cmd)) + (goto-char (isearch--state-point cmd))) (defun isearch-pop-state () (setq isearch-cmds (cdr isearch-cmds)) - (isearch-top-state)) + (isearch--set-state (car isearch-cmds))) (defun isearch-push-state () - (setq 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))) + (push (isearch--get-state) isearch-cmds)) ;; 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)) succ-msg) (when (or (not isearch-success) isearch-error) - (while (or (not (isearch-success-state (car cmds))) - (isearch-error-state (car cmds))) + (while (or (not (isearch--state-success (car cmds))) + (isearch--state-error (car cmds))) (pop cmds)) - (setq succ-msg (and cmds (if msg (isearch-message-state (car cmds)) - (isearch-string-state (car cmds))))) + (setq succ-msg (and cmds (if msg (isearch--state-message (car cmds)) + (isearch--state-string (car cmds))))) (if (and (stringp succ-msg) (< (length succ-msg) (length curr-msg)) (equal succ-msg @@ -1201,7 +1181,7 @@ The following additional command keys are active while editing. (minibuffer-history-symbol)) (setq isearch-new-string (read-from-minibuffer - (isearch-message-prefix nil nil isearch-nonincremental) + (isearch-message-prefix nil isearch-nonincremental) (cons isearch-string (1+ (or (isearch-fail-pos) (length isearch-string)))) 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. ;; This calls pop-state function and restores original point. (let ((isearch-cmds (last isearch-cmds))) - (isearch-top-state)) + (isearch--set-state (car isearch-cmds))) (goto-char isearch-opoint)) - (isearch-done t) ; exit isearch + (isearch-done t) ; Exit isearch.. (isearch-clean-overlays) - (signal 'quit nil)) ; and pass on quit signal + (signal 'quit nil)) ; ..and pass on quit signal. (defun isearch-abort () "Abort incremental search mode if searching is successful, signaling quit. Otherwise, revert to previous successful search and continue searching. Use `isearch-exit' to quit without signaling." (interactive) -;; (ding) signal instead below, if quitting + ;; (ding) signal instead below, if quitting (discard-input) (if (and isearch-success (not isearch-error)) ;; 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)) (setq isearch-error "No previous search string") (setq isearch-string - (if isearch-regexp - (car regexp-search-ring) - (car search-ring)) + (car (if isearch-regexp regexp-search-ring search-ring)) isearch-message (mapconcat 'isearch-text-char-description isearch-string "") @@ -1391,8 +1369,10 @@ Use `isearch-exit' to quit without signaling." (defun isearch-toggle-word () "Toggle word searching on or off." + ;; The status stack is left unchanged. (interactive) (setq isearch-word (not isearch-word)) + (if isearch-word (setq isearch-regexp nil)) (setq isearch-success t isearch-adjusted t) (isearch-update)) @@ -1411,7 +1391,7 @@ Use `isearch-exit' to quit without signaling." (if isearch-case-fold-search nil 'yes)) (let ((message-log-max nil)) (message "%s%s [case %ssensitive]" - (isearch-message-prefix nil nil isearch-nonincremental) + (isearch-message-prefix nil isearch-nonincremental) isearch-message (if isearch-case-fold-search "in" ""))) (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 ;; invalid just because of a backslash. (or (not isearch-error) - (not (isearch-error-state (cadr isearch-cmds))) + (not (isearch--state-error (cadr isearch-cmds))) allow-invalid)) (if to-barrier (progn (goto-char isearch-barrier) @@ -1872,8 +1852,8 @@ to the barrier." ;; Also skip over postfix operators -- though horrid, ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly valid. (while (and previous - (or (isearch-error-state frame) - (let* ((string (isearch-string-state frame)) + (or (isearch--state-error frame) + (let* ((string (isearch--state-string frame)) (lchar (aref string (1- (length string))))) ;; The operators aren't always operators; check ;; backslashes. This doesn't handle the case of @@ -1881,7 +1861,7 @@ to the barrier." ;; being special, but then we should fall back to ;; the barrier anyway because it's all optional. (if (isearch-backslash - (isearch-string-state (car previous))) + (isearch--state-string (car previous))) (eq lchar ?\}) (memq lchar '(?* ?? ?+)))))) (setq stack previous previous (cdr previous) frame (car stack))) @@ -1891,7 +1871,7 @@ to the barrier." ;; what matched before that. (let ((last-other-end (or (and (car previous) - (isearch-other-end-state (car previous))) + (isearch--state-other-end (car previous))) isearch-barrier))) (goto-char (if isearch-forward (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) '(face trailing-whitespace) m))) (setq m (concat - (isearch-message-prefix c-q-hack ellipsis isearch-nonincremental) + (isearch-message-prefix ellipsis isearch-nonincremental) 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))))) -(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, ;; check that it still is. If it is valid now, ;; 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)) '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" "") (if 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) (let ((lax (not (or isearch-nonincremental (eq (length isearch-string) - (length (isearch-string-state (car isearch-cmds)))))))) + (length (isearch--state-string + (car isearch-cmds)))))))) (funcall (if isearch-forward #'re-search-forward #'re-search-backward) (if (functionp isearch-word) @@ -2501,6 +2482,7 @@ update the match data, and return point." (isearch-no-upper-case-p isearch-string isearch-regexp))) (condition-case lossage (let ((inhibit-point-motion-hooks + ;; FIXME: equality comparisons on functions is asking for trouble. (and (eq isearch-filter-predicate 'isearch-filter-visible) search-invisible)) (inhibit-quit nil) @@ -2545,11 +2527,12 @@ update the match data, and return point." (if isearch-success nil ;; Ding if failed this time after succeeding last time. - (and (isearch-success-state (car isearch-cmds)) + (and (isearch--state-success (car isearch-cmds)) (ding)) - (if (functionp (isearch-pop-fun-state (car isearch-cmds))) - (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds))) - (goto-char (isearch-point-state (car isearch-cmds))))) + (if (functionp (isearch--state-pop-fun (car isearch-cmds))) + (funcall (isearch--state-pop-fun (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.