summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/replace.el108
2 files changed, 94 insertions, 22 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 507a7bdf0ac..cf4297a9f99 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2011-05-28 Leo Liu <sdl.web@gmail.com>
+
+ * replace.el (occur-menu-map, occur-edit-mode-map): New vars.
+ (occur-mode-map): Bind occur-edit-mode. Use occur-menu-map.
+ (occur-edit-mode): New major mode (Bug#8463).
+ (occur-after-change-function): New function.
+ (occur-engine): Give Occur tags a read-only property.
+
2011-05-28 Kevin Ryde <user42@zip.com.au>
* subr.el (def-edebug-spec): Doc fix (Bug#8430).
diff --git a/lisp/replace.el b/lisp/replace.el
index 31a48d48960..0578ed09b1c 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -761,22 +761,8 @@ a previously found match."
count)))
-(defvar occur-mode-map
+(defvar occur-menu-map
(let ((map (make-sparse-keymap)))
- ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
- (define-key map [mouse-2] 'occur-mode-mouse-goto)
- (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
- (define-key map "\C-m" 'occur-mode-goto-occurrence)
- (define-key map "o" 'occur-mode-goto-occurrence-other-window)
- (define-key map "\C-o" 'occur-mode-display-occurrence)
- (define-key map "\M-n" 'occur-next)
- (define-key map "\M-p" 'occur-prev)
- (define-key map "r" 'occur-rename-buffer)
- (define-key map "c" 'clone-buffer)
- (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
- (define-key map [menu-bar] (make-sparse-keymap))
- (define-key map [menu-bar occur]
- (cons (purecopy "Occur") map))
(define-key map [next-error-follow-minor-mode]
`(menu-item ,(purecopy "Auto Occurrence Display")
next-error-follow-minor-mode
@@ -817,6 +803,24 @@ a previously found match."
`(menu-item ,(purecopy "Move to Previous Match") occur-prev
:help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
map)
+ "Menu keymap for `occur-mode'.")
+
+(defvar occur-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
+ (define-key map [mouse-2] 'occur-mode-mouse-goto)
+ (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
+ (define-key map "\C-x\C-q" 'occur-edit-mode)
+ (define-key map "\C-m" 'occur-mode-goto-occurrence)
+ (define-key map "o" 'occur-mode-goto-occurrence-other-window)
+ (define-key map "\C-o" 'occur-mode-display-occurrence)
+ (define-key map "\M-n" 'occur-next)
+ (define-key map "\M-p" 'occur-prev)
+ (define-key map "r" 'occur-rename-buffer)
+ (define-key map "c" 'clone-buffer)
+ (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
+ (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ map)
"Keymap for `occur-mode'.")
(defvar occur-revert-arguments nil
@@ -853,6 +857,63 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(setq next-error-function 'occur-next-error))
+
+;;; Occur Edit mode
+
+(defvar occur-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map text-mode-map)
+ (define-key map [mouse-2] 'occur-mode-mouse-goto)
+ (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
+ (define-key map "\C-x\C-q" 'occur-mode)
+ (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
+ (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ map)
+ "Keymap for `occur-edit-mode'.")
+
+(define-derived-mode occur-edit-mode occur-mode "Occur-Edit"
+ "Major mode for editing *Occur* buffers.
+In this mode, changes to the *Occur* buffer are also applied to
+the originating buffer.
+
+To return to ordinary Occur mode, use \\[occur-mode]."
+ (setq buffer-read-only nil)
+ (add-hook 'after-change-functions 'occur-after-change-function nil t))
+
+(defun occur-after-change-function (beg end length)
+ (save-excursion
+ (goto-char beg)
+ (let* ((m (get-text-property (line-beginning-position) 'occur-target))
+ (buf (marker-buffer m))
+ (col (current-column)))
+ (when (= length 0)
+ ;; Apply occur-target property to inserted (e.g. yanked) text.
+ (put-text-property beg end 'occur-target m)
+ ;; Did we insert a newline? Occur Edit mode can't create new
+ ;; Occur entries; just discard everything after the newline.
+ (save-excursion
+ (and (search-forward "\n" end t)
+ (delete-region (1- (point)) end))))
+ (let ((line (- (line-number-at-pos)
+ (line-number-at-pos (window-start))))
+ (readonly (with-current-buffer buf buffer-read-only))
+ (win (or (get-buffer-window buf)
+ (display-buffer buf t)))
+ (text (save-excursion
+ (forward-line 0)
+ (search-forward ":" nil t)
+ (setq col (- col (current-column)))
+ (buffer-substring-no-properties (point) (line-end-position)))))
+ (with-selected-window win
+ (goto-char m)
+ (recenter line)
+ (if readonly
+ (message "Buffer `%s' is read only." buf)
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert text))
+ (move-to-column col))))))
+
+
(defun occur-revert-function (_ignore1 _ignore2)
"Handle `revert-buffer' for Occur mode buffers."
(apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
@@ -1280,6 +1341,7 @@ See also `multi-occur'."
`(font-lock-face prefix-face))
`(occur-prefix t mouse-face (highlight)
occur-target ,marker follow-link t
+ read-only t
help-echo "mouse-2: go to this occurrence"))))
(match-str
;; We don't put `mouse-face' on the newline,
@@ -1339,13 +1401,15 @@ See also `multi-occur'."
(goto-char headerpt)
(let ((beg (point))
end)
- (insert (format "%d match%s%s in buffer: %s\n"
- matches (if (= matches 1) "" "es")
- ;; Don't display regexp for multi-buffer.
- (if (> (length buffers) 1)
- "" (format " for \"%s\""
- (query-replace-descr regexp)))
- (buffer-name buf)))
+ (insert (propertize
+ (format "%d match%s%s in buffer: %s\n"
+ matches (if (= matches 1) "" "es")
+ ;; Don't display regexp for multi-buffer.
+ (if (> (length buffers) 1)
+ "" (format " for \"%s\""
+ (query-replace-descr regexp)))
+ (buffer-name buf))
+ 'read-only t))
(setq end (point))
(add-text-properties beg end
(append