diary-mail-entries calls exit-calendar when finished.
[bpt/emacs.git] / lisp / isearch.el
index 587b214..91a0d97 100644 (file)
@@ -140,7 +140,7 @@ apply to chars in regexps that are prefixed with `\\'.
 If this value is `not-yanks', yanked text is always downcased."
   :type '(choice (const :tag "off" nil)
                 (const not-yanks)
-                (sexp :tag "on" :format "%t\n" t))
+                (other :tag "on" t))
   :group 'isearch)
 
 (defcustom search-nonincremental-instead t
@@ -152,18 +152,36 @@ string, and RET terminates editing and does a nonincremental search."
 
 (defcustom search-whitespace-regexp "\\s-+"
   "*If non-nil, regular expression to match a sequence of whitespace chars.
+This applies to regular expression incremental search.
 You might want to use something like \"[ \\t\\r\\n]+\" instead."
   :type 'regexp
   :group 'isearch)
 
-(defcustom search-highlight nil
+(defcustom search-highlight t
   "*Non-nil means incremental search highlights the current match."
   :type 'boolean
   :group 'isearch)
 
-(defvar search-invisible nil
-  "*Non-nil means incremental search can match text hidden by an overlay.
-\(This applies when using `noutline.el'.)")
+(defcustom search-invisible 'open
+  "If t incremental search can match hidden text.
+nil means don't match invisible text.
+If the value is `open', if the text matched is made invisible by
+an overlay having an `invisible' property and that overlay has a property
+`isearch-open-invisible', then incremental search will show the contents.
+\(This applies when using `outline.el' and `hideshow.el'.)"
+  :type '(choice (const :tag "Match hidden text" t)
+                (const :tag "Open overlays" open)
+                (const :tag "Don't match hidden text" nil))
+  :group 'isearch)
+
+(defcustom isearch-hide-immediately t
+  "If non-nil, re-hide an invisible match right away.
+This variable makes a difference when `search-invisible' is set to `open'.
+It means that after search makes some invisible text visible
+to show the match, it makes the text invisible again when the match moves.
+Ordinarily the text becomes invisible again at the end of the search."  
+  :type 'boolean 
+  :group 'isearch)
 
 (defvar isearch-mode-hook nil
   "Function(s) to call after starting up an incremental search.")
@@ -211,11 +229,13 @@ Default value, nil, means edit the string instead."
       (or (vectorp (nth 1 map))
          (char-table-p (nth 1 map))
          (error "The initialization of isearch-mode-map must be updated"))
-      ;; Make Latin-1, Latin-2 and Latin-3 characters
+      ;; Make Latin-1, Latin-2, Latin-3 and Latin-4 characters
       ;; search for themselves.
-      (set-char-table-range (nth 1 map) [129] 'isearch-printing-char)
-      (set-char-table-range (nth 1 map) [130] 'isearch-printing-char)
-      (set-char-table-range (nth 1 map) [131] 'isearch-printing-char)
+      (aset (nth 1 map) (make-char 'latin-iso8859-1) 'isearch-printing-char)
+      (aset (nth 1 map) (make-char 'latin-iso8859-2) 'isearch-printing-char)
+      (aset (nth 1 map) (make-char 'latin-iso8859-3) 'isearch-printing-char)
+      (aset (nth 1 map) (make-char 'latin-iso8859-4) 'isearch-printing-char)
+      (aset (nth 1 map) (make-char 'latin-iso8859-9) 'isearch-printing-char)
       ;; Make function keys, etc, exit the search.
       (define-key map [t] 'isearch-other-control-char)
       ;; Control chars, by default, end isearch mode transparently.
@@ -226,9 +246,9 @@ Default value, nil, means edit the string instead."
        (define-key map (make-string 1 i) 'isearch-other-control-char)
        (setq i (1+ i)))
 
-      ;; Printing chars extend the search string by default.
+      ;; Single-byte printing chars extend the search string by default.
       (setq i ?\ )
-      (while (< i (length (nth 1 map)))
+      (while (< i 256)
        (define-key map (vector i) 'isearch-printing-char)
        (setq i (1+ i)))
 
@@ -259,6 +279,7 @@ Default value, nil, means edit the string instead."
       (define-key map "\C-j" 'isearch-printing-char)
       (define-key map "\t" 'isearch-printing-char)
       (define-key map " " 'isearch-whitespace-chars)
+      (define-key map [?\S-\ ] 'isearch-whitespace-chars)
     
       (define-key map "\C-w" 'isearch-yank-word)
       (define-key map "\C-y" 'isearch-yank-line)
@@ -350,9 +371,6 @@ Default value, nil, means edit the string instead."
 ;; Flag to indicate a yank occurred, so don't move the cursor.
 (defvar isearch-yank-flag nil)
 
-;; Flag to indicate that we are searching multibyte characaters.
-(defvar isearch-multibyte-characters-flag nil)
-
 ;;; A function to be called after each input character is processed.
 ;;; (It is not called after characters that exit the search.)
 ;;; It is only set from an optional argument to `isearch-mode'.
@@ -367,6 +385,8 @@ Default value, nil, means edit the string instead."
 ;; New value of isearch-forward after isearch-edit-string.
 (defvar isearch-new-forward nil)
 
+;; Accumulate here the overlays opened during searching.
+(defvar isearch-opened-overlays nil)
 
 ;; Minor-mode-alist changes - kind of redundant with the
 ;; echo area, but if isearching in multiple windows, it can be useful.
@@ -500,10 +520,10 @@ is treated as a regexp.  See \\[isearch-forward] for more info."
        isearch-other-end nil
        isearch-small-window nil
        isearch-just-started t
-       isearch-multibyte-characters-flag nil
 
        isearch-opoint (point)
        search-ring-yank-pointer nil
+       isearch-opened-overlays nil
        regexp-search-ring-yank-pointer nil)
   (looking-at "")
   (setq isearch-window-configuration
@@ -639,6 +659,7 @@ REGEXP says which ring to use."
   (interactive) ;; Is this necessary?
   ;; First terminate isearch-mode.
   (isearch-done)
+  (isearch-clean-overlays) 
   (handle-switch-frame (car (cdr (isearch-last-command-char)))))
 
 \f
@@ -654,7 +675,8 @@ nonincremental search instead via `isearch-edit-string'."
           (= 0 (length isearch-string)))
       (let ((isearch-nonincremental t))
        (isearch-edit-string)))
-  (isearch-done))
+  (isearch-done)
+  (isearch-clean-overlays))
 
 
 (defun isearch-edit-string ()
@@ -814,6 +836,7 @@ If first char entered is \\[isearch-yank-word], then do word search instead."
   (interactive)
   (goto-char isearch-opoint)
   (isearch-done t)
+  (isearch-clean-overlays)
   (signal 'quit nil))  ; and pass on quit signal
 
 (defun isearch-abort ()
@@ -829,6 +852,7 @@ Use `isearch-exit' to quit without signaling."
       (progn (goto-char isearch-opoint)
             (setq isearch-success nil)
             (isearch-done t)   ; exit isearch
+            (isearch-clean-overlays)
             (signal 'quit nil))  ; and pass on quit signal
     ;; If search is failing, or has an incomplete regexp,
     ;; rub out until it is once more successful.
@@ -920,55 +944,53 @@ If no previous match was done, just beep."
   (isearch-update))
 
 
-(defun isearch-yank (chunk)
-  ;; Helper for isearch-yank-word and isearch-yank-line
-  ;; CHUNK should be word, line, kill, or x-sel.
-  (let ((string (cond
-                 ((eq chunk 'kill)
-                  (current-kill 0))
-                 ((eq chunk 'x-sel)
-                  (x-get-selection))
-                 (t
-                 (save-excursion
-                   (and (not isearch-forward) isearch-other-end
-                        (goto-char isearch-other-end))
-                   (buffer-substring
-                    (point)
-                    (save-excursion
-                      (cond
-                       ((eq chunk 'word)
-                        (forward-word 1))
-                       ((eq chunk 'line)
-                        (end-of-line)))
-                      (point))))))))
-    ;; Downcase the string if not supposed to case-fold yanked strings.
-    (if (and isearch-case-fold-search
-            (eq 'not-yanks search-upper-case))
-       (setq string (downcase string)))
-    (if isearch-regexp (setq string (regexp-quote string)))
-    (setq isearch-string (concat isearch-string string)
-         isearch-message
-         (concat isearch-message
-                 (mapconcat 'isearch-text-char-description
-                            string ""))
-         ;; Don't move cursor in reverse search.
-         isearch-yank-flag t))
+(defun isearch-yank-string (string)
+  "Pull STRING into search string."
+  ;; Downcase the string if not supposed to case-fold yanked strings.
+  (if (and isearch-case-fold-search
+          (eq 'not-yanks search-upper-case))
+      (setq string (downcase string)))
+  (if isearch-regexp (setq string (regexp-quote string)))
+  (setq isearch-string (concat isearch-string string)
+       isearch-message
+       (concat isearch-message
+               (mapconcat 'isearch-text-char-description
+                          string ""))
+       ;; Don't move cursor in reverse search.
+       isearch-yank-flag t)
   (isearch-search-and-update))
 
 (defun isearch-yank-kill ()
   "Pull string from kill ring into search string."
   (interactive)
-  (isearch-yank 'kill))
+  (isearch-yank-string (current-kill 0)))
+
+(defun isearch-yank-x-selection ()
+  "Pull current X selection into search string.
+Some users like to put this command on Mouse-2.
+To do that, evaluate these expressions:
+    (define-key isearch-mode-map [down-mouse-2] nil)
+    (define-key isearch-mode-map [mouse-2] 'isearch-yank-x-selection)"
+  (interactive)
+  (isearch-yank-string (x-get-selection)))
 
 (defun isearch-yank-word ()
   "Pull next word from buffer into search string."
   (interactive)
-  (isearch-yank 'word))
+  (isearch-yank-string
+   (save-excursion
+     (and (not isearch-forward) isearch-other-end
+         (goto-char isearch-other-end))
+     (buffer-substring (point) (progn (forward-word 1) (point))))))
 
 (defun isearch-yank-line ()
   "Pull rest of line from buffer into search string."
   (interactive)
-  (isearch-yank 'line))
+  (isearch-yank-string
+   (save-excursion
+     (and (not isearch-forward) isearch-other-end
+         (goto-char isearch-other-end))
+     (buffer-substring (point) (line-end-position)))))
 
 
 (defun isearch-search-and-update ()
@@ -990,13 +1012,17 @@ If no previous match was done, just beep."
                   (looking-at (if isearch-regexp isearch-string
                                 (regexp-quote isearch-string))))
               (error nil))
-              (or isearch-yank-flag
-                  (<= (match-end 0) 
-                      (min isearch-opoint isearch-barrier))))
-       (setq isearch-success t 
-             isearch-invalid-regexp nil
-             isearch-within-brackets nil
-             isearch-other-end (match-end 0))
+            (or isearch-yank-flag
+                (<= (match-end 0) 
+                    (min isearch-opoint isearch-barrier))))
+       (progn
+         (setq isearch-success t 
+               isearch-invalid-regexp nil
+               isearch-within-brackets nil
+               isearch-other-end (match-end 0))
+         (if (and (eq isearch-case-fold-search t) search-upper-case)
+             (setq isearch-case-fold-search
+                   (isearch-no-upper-case-p isearch-string isearch-regexp))))
       ;; Not regexp, not reverse, or no match at point.
       (if (and isearch-other-end (not isearch-adjusted))
          (goto-char (if isearch-forward isearch-other-end
@@ -1020,20 +1046,23 @@ If no previous match was done, just beep."
   "Handle * and ? specially in regexps."
   (interactive)
   (if isearch-regexp 
-
-      (progn
-       (setq isearch-adjusted t)
-       ;; Get the isearch-other-end from before the last search.
-       ;; We want to start from there,
-       ;; so that we don't retreat farther than that.
-       ;; (car isearch-cmds) is after last search;
-       ;; (car (cdr isearch-cmds)) is from before it.
-       (let ((cs (nth 5 (car (cdr isearch-cmds)))))
-         (setq cs (or cs isearch-barrier))
-         (goto-char
-          (if isearch-forward
-              (max cs isearch-barrier)
-            (min cs isearch-barrier))))))
+      (let ((idx (length isearch-string)))
+       (while (and (> idx 0)
+                   (eq (aref isearch-string (1- idx)) ?\\))
+         (setq idx (1- idx)))
+       (when (= (mod (- (length isearch-string) idx) 2) 0)
+         (setq isearch-adjusted t)
+         ;; Get the isearch-other-end from before the last search.
+         ;; We want to start from there,
+         ;; so that we don't retreat farther than that.
+         ;; (car isearch-cmds) is after last search;
+         ;; (car (cdr isearch-cmds)) is from before it.
+         (let ((cs (nth 5 (car (cdr isearch-cmds)))))
+           (setq cs (or cs isearch-barrier))
+           (goto-char
+            (if isearch-forward
+                (max cs isearch-barrier)
+              (min cs isearch-barrier)))))))
   (isearch-process-search-char (isearch-last-command-char)))
   
 
@@ -1118,18 +1147,30 @@ and the meta character is unread so that it applies to editing the string."
             ;; is in isearch mode.  So end the search in that buffer.
             (if (and (listp main-event)
                      (setq window (posn-window (event-start main-event)))
-                     (windowp window))
+                     (windowp window)
+                     (or (> (minibuffer-depth) 0)
+                         (not (window-minibuffer-p window))))
                 (save-excursion
                   (set-buffer (window-buffer window))
-                  (isearch-done))
-              (isearch-done))))
+                  (isearch-done)
+                  (isearch-clean-overlays))
+              (isearch-done)
+              (isearch-clean-overlays))))
          (t;; otherwise nil
           (isearch-process-search-string key key)))))
 
 (defun isearch-quote-char ()
   "Quote special characters for incremental search."
   (interactive)
-  (isearch-process-search-char (read-quoted-char (isearch-message t))))
+  (let ((char (read-quoted-char (isearch-message t))))
+    ;; Assume character codes 0200 - 0377 stand for 
+    ;; European characters in Latin-1, and convert them
+    ;; to Emacs characters.
+    (and enable-multibyte-characters
+        (>= char ?\200)
+        (<= char ?\377)
+        (setq char (+ char nonascii-insert-offset)))
+    (isearch-process-search-char char)))
 
 (defun isearch-return-char ()
   "Convert return into newline for incremental search.
@@ -1140,9 +1181,16 @@ Obsolete."
 (defun isearch-printing-char ()
   "Add this ordinary printing character to the search string and search."
   (interactive)
-  (if isearch-multibyte-characters-flag
-      (isearch-process-search-multibyte-characters (isearch-last-command-char))
-    (isearch-process-search-char (isearch-last-command-char))))
+  (let ((char (isearch-last-command-char)))
+    (if (= char ?\S-\ )
+       (setq char ?\ ))
+    (if (and enable-multibyte-characters
+            (>= char ?\200)
+            (<= char ?\377))
+       (isearch-process-search-char (+ char nonascii-insert-offset))
+      (if current-input-method
+         (isearch-process-search-multibyte-characters char)
+       (isearch-process-search-char char)))))
 
 (defun isearch-whitespace-chars ()
   "Match all whitespace chars, if in regexp mode.
@@ -1164,7 +1212,9 @@ If you want to search for just a space, type C-q SPC."
   ;; Append the char to the search string, update the message and re-search.
   (isearch-process-search-string 
    (isearch-char-to-string char) 
-   (isearch-text-char-description char)))
+   (if (>= char 0200)
+       (char-to-string char)
+     (isearch-text-char-description char))))
 
 (defun isearch-process-search-string (string message)
   (setq isearch-string (concat isearch-string string)
@@ -1374,8 +1424,8 @@ If there is no completion possible, say so and continue searching."
                   (if isearch-regexp "regexp " "")
                   (if nonincremental "search" "I-search")
                   (if isearch-forward "" " backward")
-                  (if isearch-multibyte-characters-flag
-                      (concat " [" default-input-method-title "]: ")
+                  (if current-input-method
+                      (concat " [" current-input-method-title "]: ")
                     ": ")
                   )))
     (aset m 0 (upcase (aref m 0)))
@@ -1398,7 +1448,8 @@ If there is no completion possible, say so and continue searching."
       (setq isearch-case-fold-search
            (isearch-no-upper-case-p isearch-string isearch-regexp)))
   (condition-case lossage
-      (let ((inhibit-quit nil)
+      (let ((inhibit-point-motion-hooks search-invisible)
+           (inhibit-quit nil)
            (case-fold-search isearch-case-fold-search)
            (retry t))
        (if isearch-regexp (setq isearch-invalid-regexp nil))
@@ -1417,7 +1468,7 @@ If there is no completion possible, say so and continue searching."
                 isearch-string nil t))
          ;; Clear RETRY unless we matched some invisible text
          ;; and we aren't supposed to do that.
-         (if (or search-invisible
+         (if (or (eq search-invisible t)
                  (not isearch-success)
                  (bobp) (eobp)
                  (= (match-beginning 0) (match-end 0))
@@ -1451,28 +1502,151 @@ If there is no completion possible, say so and continue searching."
         (ding))
     (goto-char (nth 2 (car isearch-cmds)))))
 
+
+;;; Called when opening an overlay, and we are still in isearch.
+(defun isearch-open-overlay-temporary (ov)
+  (if (not (null (overlay-get ov 'isearch-open-invisible-temporary))) 
+      ;; Some modes would want to open the overlays temporary during
+      ;; isearch in their own way, they should set the
+      ;; `isearch-open-invisible-temporary' to a function doing this.
+      (funcall  (overlay-get ov 'isearch-open-invisible-temporary)  ov nil)
+    ;; Store the values for the `invisible' and `intangible'
+    ;; properties, and then set them to nil. This way the text hidden
+    ;; by this overlay becomes visible.
+
+    ;; Do we realy need to set the `intangible' property to t? Can we
+    ;; have the point inside an overlay with an `intangible' property?
+    ;; In 19.34 this does not exist so I cannot test it.
+    (overlay-put ov 'isearch-invisible (overlay-get ov 'invisible))
+    (overlay-put ov 'isearch-intangible (overlay-get ov 'intangible))
+    (overlay-put ov 'invisible nil)
+    (overlay-put ov 'intangible nil)))
+
+
+;;; This is called at the end of isearch. I will open the overlays
+;;; that contain the latest match. Obviously in case of a C-g the
+;;; point returns to the original location which surely is not contain
+;;; in any of these overlays, se we are safe in this case too.
+(defun isearch-open-necessary-overlays (ov)
+  (let ((inside-overlay (and  (> (point) (overlay-start ov)) 
+                             (< (point) (overlay-end ov))))
+       ;; If this exists it means that the overlay was opened using
+       ;; this function, not by us tweaking the overlay properties.
+       (fct-temp (overlay-get ov 'isearch-open-invisible-temporary)))
+    (when (or inside-overlay (not fct-temp))
+      ;; restore the values for the `invisible' and `intangible'
+      ;; properties
+      (overlay-put ov 'invisible (overlay-get ov 'isearch-invisible))
+      (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible))
+      (overlay-put ov 'isearch-invisible nil)
+      (overlay-put ov 'isearch-intangible nil))
+    (if inside-overlay
+       (funcall (overlay-get ov 'isearch-open-invisible)  ov)
+      (if fct-temp
+         (funcall fct-temp ov t)))))
+
+;;; This is called when exiting isearch. It closes the temporary
+;;; opened overlays, except the ones that contain the latest match.
+(defun isearch-clean-overlays ()
+  (when isearch-opened-overlays
+    ;; Use a cycle instead of a mapcar here?
+    (mapcar 
+     (function isearch-open-necessary-overlays) isearch-opened-overlays)
+    (setq isearch-opened-overlays nil)))
+
+;;; Verify if the current match is outside of each element of
+;;; `isearch-opened-overlays', if so close that overlay.
+(defun isearch-close-unecessary-overlays (begin end)
+  (let ((ov-list isearch-opened-overlays)
+       ov
+       inside-overlay
+       fct-temp)
+    (setq isearch-opened-overlays nil)
+    (while ov-list
+      (setq ov (car ov-list))
+      (setq ov-list (cdr ov-list))
+      (setq inside-overlay (or (and  (> begin (overlay-start ov)) 
+                                    (< begin (overlay-end ov)))
+                              (and  (> end (overlay-start ov)) 
+                                    (< end (overlay-end ov)))))
+      ;; If this exists it means that the overlay was opened using
+      ;; this function, not by us tweaking the overlay properties.
+      (setq fct-temp (overlay-get ov 'isearch-open-invisible-temporary))
+      (if inside-overlay
+       (setq isearch-opened-overlays (cons ov isearch-opened-overlays))
+       (if fct-temp
+           (funcall fct-temp ov t)
+         (overlay-put ov 'invisible (overlay-get ov 'isearch-invisible))
+         (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible))
+         (overlay-put ov 'isearch-invisible nil)
+         (overlay-put ov 'isearch-intangible nil))))))
+
 (defun isearch-range-invisible (beg end)
-  "Return t if all the bext from BEG to END is invisible."
+  "Return t if all the text from BEG to END is invisible."
   (and (/= beg end)
        ;; Check that invisibility runs up to END.
        (save-excursion
         (goto-char beg)
-        ;; If the following character is currently invisible,
-        ;; skip all characters with that same `invisible' property value.
-        ;; Do that over and over.
-        (while (and (< (point) end)
-                    (let ((prop
-                           (get-char-property (point) 'invisible)))
-                      (if (eq buffer-invisibility-spec t)
-                          prop
-                        (or (memq prop buffer-invisibility-spec)
-                            (assq prop buffer-invisibility-spec)))))
-          (if (get-text-property (point) 'invisible)
-              (goto-char (next-single-property-change (point) 'invisible
-                                                      nil end))
-            (goto-char (next-overlay-change (point)))))
+        (let 
+            ;; can-be-opened keeps track if we can open some overlays.
+            ((can-be-opened (eq search-invisible 'open))
+             ;; the list of overlays that could be opened
+             (crt-overlays nil))
+          (when (and can-be-opened isearch-hide-immediately) 
+              (isearch-close-unecessary-overlays beg end))
+          ;; If the following character is currently invisible,
+          ;; skip all characters with that same `invisible' property value.
+          ;; Do that over and over.
+          (while (and (< (point) end)
+                      (let ((prop
+                             (get-char-property (point) 'invisible)))
+                        (if (eq buffer-invisibility-spec t)
+                            prop
+                          (or (memq prop buffer-invisibility-spec)
+                              (assq prop buffer-invisibility-spec)))))
+            (if (get-text-property (point) 'invisible)
+                (progn 
+                  (goto-char (next-single-property-change (point) 'invisible
+                                                          nil end))
+                  ;; if text is hidden by an `invisible' text property
+                  ;; we cannot open it at all.
+                  (setq can-be-opened nil))
+              (unless (null can-be-opened)
+                (let ((overlays (overlays-at (point)))
+                      ov-list
+                      o
+                      invis-prop)
+                  (while overlays
+                    (setq o (car overlays)
+                          invis-prop (overlay-get o 'invisible))
+                    (if (if (eq buffer-invisibility-spec t)
+                            invis-prop
+                          (or (memq invis-prop buffer-invisibility-spec)
+                              (assq invis-prop buffer-invisibility-spec)))
+                        (if (overlay-get o 'isearch-open-invisible)
+                            (setq ov-list (cons o ov-list))
+                          ;; We found one overlay that cannot be
+                          ;; opened, that means the whole chunk
+                          ;; cannot be opened.
+                          (setq can-be-opened nil)))
+                    (setq overlays (cdr overlays)))
+                  (if can-be-opened 
+                      ;; It makes sense to append to the open
+                      ;; overlays list only if we know that this is
+                      ;; t.
+                      (setq crt-overlays (append ov-list crt-overlays)))))
+              (goto-char (next-overlay-change (point)))))
         ;; See if invisibility reaches up thru END.
-        (>= (point) end))))
+        (if (>= (point) end)
+            (if (and (not (null can-be-opened)) (consp crt-overlays))
+                (progn
+                  (setq isearch-opened-overlays
+                        (append isearch-opened-overlays crt-overlays))
+                  ;; maybe use a cycle instead of mapcar?
+                  (mapcar (function isearch-open-overlay-temporary)
+                          crt-overlays)
+                  nil)
+              t))))))
 
 \f
 ;;; Highlighting
@@ -1512,7 +1686,7 @@ since they have special meaning in a regexp."
 ;; Portability functions to support various Emacs versions.
 
 (defun isearch-char-to-string (c)
-  (make-string 1 c))
+  (char-to-string c))
 
 (defun isearch-text-char-description (c)
   (if (and (integerp c) (or (< c ?\ ) (= c ?\^?)))