[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
replace+.el - extensions to GNU `replace.el'
|
From: |
Drew Adams |
|
Subject: |
replace+.el - extensions to GNU `replace.el' |
|
Date: |
Tue, 16 Jan 2001 21:35:20 -0500 |
;;; replace+.el --- Extensions to `replace.el'.
;;
;; Filename: replace+.el
;; Description: Extensions to `replace.el'.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Created: Tue Jan 30 15:01:06 1996
;; Version: $Id: replace+.el,v 1.6 2001/01/09 22:12:25 dadams Exp $
;; Last-Updated: Tue Jan 9 14:12:14 2001
;; By: dadams
;; Update #: 571
;; Keywords: matching, help, internal, tools, local
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Extensions to `replace.el'.
;;
;; New functions here:
;;
;; `query-replace-w-options', `toggle-replace-w-completion'.
;;
;; New user options (variables) here:
;;
;; `list-matching-lines-face', `replace-w-completion',
;; `search/replace-default-fn'.
;;
;; Other variable defined here: `occur-regexp'.
;;
;;
;; ***** NOTE: The following functions defined in `replace.el' have
;; been REDEFINED HERE:
;;
;; `flush-lines' - 1. The prompt has been changed, to mention that
;; only lines after point are affected.
;; 2. The default regexp is provided by
;; `search/replace-default-fn'.
;; 3. An in-progress message has been added.
;; `how-many' - 1. Prompt changed: lines after point are affected.
;; 2. Default regexp: `search/replace-default-fn'.
;; 3. An in-progress message has been added.
;; `keep-lines' - Same as `flush-lines'.
;; `occur' - Default regexp is given by `search/replace-default-fn'.
;; `occur-mode-goto-occurrence' - Highlights regexp in source buffer.
;; `occur-mode-mouse-goto' - Highlights regexp in source buffer.
;; `query-replace-read-args' - 1. Uses `completing-read' if
;; `replace-w-completion' is non-nil.
;; 2. Default regexps are obtained via
;; `search/replace-default-fn'.
;;
;;
;; This file should be loaded after loading the standard GNU file
;; `replace.el'. So, in your `~/.emacs' file, do this:
;; (eval-after-load "replace" '(progn (require 'replace+)))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; RCS $Log: replace+.el,v $
;; RCS Revision 1.6 2001/01/09 22:12:25 dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.5 2001/01/03 17:44:29 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.4 2001/01/03 01:05:53 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3 2000/12/07 19:52:25 dadams
;; RCS Added require of shrink-fit.el.
;; RCS
;; RCS Revision 1.2 2000/11/28 20:31:12 dadams
;; RCS Optional require's via 3rd arg=t now.
;; RCS
;; RCS Revision 1.1 2000/09/14 17:23:42 dadams
;; RCS Initial revision
;; RCS
; Revision 1.1 1997/03/20 14:32:29 dadams
; Initial revision
;
; Revision 1.21 1996/07/01 13:21:23 dadams
; (trivial)
;
; Revision 1.20 1996/06/20 12:02:54 dadams
; flush-lines, keep-lines: Default regexp from search/replace-default-fn.
;
; Revision 1.19 1996/06/14 12:26:19 dadams
; 1. Added: replace-w-completion, toggle-replace-w-completion.
; 2. query-replace-read-args, query-replace-w-options: Now sensitive to
; replace-w-completion.
;
; Revision 1.18 1996/06/06 14:34:38 dadams
; 1. Require font-lock+.el and frame-cmds.el. (show-a-frame-on is a defsubst)
; 2. Update of file dependency comments (e.g. "Autoloaded from...").
;
; Revision 1.17 1996/04/26 09:59:18 dadams
; Put escaped newlines on long-line strings.
;
; Revision 1.16 1996/04/22 09:25:18 dadams
; Added: flush-lines, keep-lines.
;
; Revision 1.15 1996/04/15 08:15:18 dadams
; occur: Explicitly call shrink-frame-to-fit each time, after displaying.
;
; Revision 1.14 1996/04/05 14:34:11 dadams
; Improved Commentary: List redefinitions.
;
; Revision 1.13 1996/03/26 16:03:37 dadams
; 1. Added redefinition of query-replace-read-args.
; 2. perform-replace: cond -> case.
; 3. query-replace-w-options: message -> display-in-minibuffer (STRING).
;
; Revision 1.12 1996/03/20 17:55:27 dadams
; 1. perform-replace: Added msgs for leaving recursive edit.
; 2. query-replace-w-options: Defaults for new and old are the same.
;
; Revision 1.11 1996/03/20 09:52:18 dadams
; 1. Added search/replace-default-fn.
; 2. query-replace-w-options, occur:
; symbol-name-nearest-point -> search/replace-default-fn.
;
; Revision 1.10 1996/03/14 10:21:10 dadams
; Added perform-replace: When change markers to numbers, ensure markerp.
;
; Revision 1.9 1996/03/08 14:01:00 dadams
; 1. Copyright.
; 2. drew-faces.el -> std-faces.el, drew-window-cmds.el -> frame-cmds.el,
; drew-strings.el -> thingatpt+.el plus strings.el.
;
; Revision 1.8 1996/02/28 16:49:00 dadams
; Renamed query-replace -> query-replace-w-options. It calls query-replace,
; not perform-replace (was bugged when unread-command-events).
;
; Revision 1.7 1996/02/15 14:41:40 dadams
; occur: Minor correction of last change.
;
; Revision 1.6 1996/02/15 14:27:23 dadams
; occur: Don't raise Occur frame if no occurrences.
;
; Revision 1.5 1996/02/14 17:56:35 dadams
; symbol-around-point -> symbol-name-nearest-point
;
; Revision 1.4 1996/02/12 10:04:56 dadams
; Updated header keywords (for finder).
;
; Revision 1.3 1996/02/06 11:02:58 dadams
; (trivial)
;
; Revision 1.2 1996/02/05 15:56:25 dadams
; occur-mode-goto-occurrence, occur-mode-mouse-goto:
; Highlight last goto lineno.
;
; Revision 1.1 1996/02/05 15:23:30 dadams
; Initial revision
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program 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 2, or (at your option)
;; any later version.
;; This program 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 this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;; Cannot do (require 'replace), because `replace.el' does no `provide'.
;; Don't want to do a (load-library "replace") either, because it wouldn't
;; allow doing (eval-after-load "replace" '(progn (require 'replace+)))
(require 'cl) ;; when, unless, incf, push, pop
(require 'thingatpt nil t) ;; (no error if not found): word-at-point
(require 'thingatpt+ nil t) ;; (no error if not found):
symbol-name-nearest-point
(require 'strings nil t) ;; (no error if not found): display-in-minibuffer
(require 'frame-cmds nil t) ;; (no error if not found): show-a-frame-on
(require 'frame-fns nil t) ;; (no error if not found): get-a-frame
(require 'shrink-fit nil t) ;; (no error if not found): shrink-frame-to-fit
(require 'highlight nil t) ;; (no error if not found): highlight-regexp-region
;; Get macro `define-face-const' when this is compiled,
;; or run interpreted, but not when the compiled code is loaded.
(eval-when-compile (require 'def-face-const))
(provide 'replace+)
;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defvar replace-w-completion nil
"*Non-nil <=> Use minibuffer completion for replacement commands
such as `query-replace'. With completion, to insert a SPC or TAB char,
you will need to preceed it by `\\[quoted-insert]'. If this is
inconvenient, set this variable to nil.")
;;;###autoload
(defun toggle-replace-w-completion (force-p)
"Toggle whether to use minibuffer completion for replacement commands
such as `query-replace'. (This just sets var `replace-w-completion'.)
Non-nil prefix arg FORCE-P => Use completion iff FORCE-P >= 0.
Note that with completion, to insert a SPC or TAB character you will
need to preceed it by `\\[quoted-insert]'."
(interactive "P")
(if force-p ; Force.
(if (natnump (prefix-numeric-value force-p))
(setq replace-w-completion t)
(setq replace-w-completion nil))
(setq replace-w-completion (not replace-w-completion)))) ; Toggle.
;;;###autoload
(defvar search/replace-default-fn
(if (fboundp 'symbol-name-nearest-point)
'symbol-name-nearest-point
'word-at-point)
"*Fn of 0 args called to provide default input for search/replacement
functions such as \\[query-replace-w-options] and \\[occur].
Some reasonable choices are defined in `thingatpt+.el':
`word-nearest-point', `symbol-name-nearest-point', `sexp-nearest-point'")
;; REPLACES ORIGINAL in `replace.el'.
;; 1. Uses `completing-read' if `replace-w-completion' is non-nil.
;; 2. The default regexps are provided by `search/replace-default-fn'.
;;;###autoload
(defun query-replace-read-args (string regexp-flag)
"Read arguments for replacement functions such as `\\[query-replace]'.
The variable `replace-w-completion', if non-nil, provides for
minibuffer completion while you type the arguments. In that case, to
insert a SPC or TAB character, you will need to preceed it by \
`\\[quoted-insert]'."
(let* ((default (if (fboundp search/replace-default-fn)
(funcall search/replace-default-fn)
(car regexp-history)))
(old-prompt (concat string ". OLD (to be replaced): "))
(oldx (if replace-w-completion
(completing-read old-prompt obarray nil nil default
query-replace-from-history-variable default
t)
(if query-replace-interactive
(car (if regexp-flag regexp-search-ring search-ring))
(read-from-minibuffer old-prompt default nil nil
query-replace-from-history-variable
default t))))
(new-prompt (format "NEW (replacing %s): " oldx))
(newx (if replace-w-completion
(completing-read new-prompt obarray nil nil default
query-replace-to-history-variable default t)
(read-from-minibuffer new-prompt default nil nil
query-replace-to-history-variable
default t))))
(list oldx newx current-prefix-arg)))
;; The main difference between this and `query-replace' is in the
;; treatment of the PREFIX arg. Only a positive (or nil) PREFIX value
;; gives the same behavior. A negative PREFIX value does a regexp
;; query replace.
;; Also, unlike the standard GNU `query-replace', this has the same
;; behavior as the version of `query-replace-read-args' defined here:
;; 1. It uses `completing-read' if `replace-w-completion' is non-nil.
;; 2. The default regexps are provided by `search/replace-default-fn'.
;;;###autoload
(defun query-replace-w-options (old new &optional prefix display-msgs)
"Replace some occurrences of OLD text with NEW one.
No PREFIX arg (nil) => replace literal string matches.
Positive PREFIX arg => replace word matches.
Negative PREFIX arg => replace regexp matches.
As each match is found, you type a character saying what to do.
For more info, type \\[help-command] at that time.
Preserves case in each replacement if variables `case-replace' and
`case-fold-search' are non-nil and OLD has no uppercase letters.
Fourth arg DISPLAY-MSGS non-nil (interactive-p) =>
Display an in-progress msg.
To customize possible responses, change `query-replace-map' \"bindings\".
The variable `replace-w-completion', if non-nil, provides for
minibuffer completion while you type OLD and NEW. In that case, to
insert a SPC or TAB character, you will need to preceed it by \
`\\[quoted-insert]'."
(interactive
(let* ((kind (and current-prefix-arg
(if (natnump (prefix-numeric-value current-prefix-arg))
"WORD "
"REGEXP ")))
(default (if (fboundp search/replace-default-fn)
(funcall search/replace-default-fn)
(car regexp-history)))
(old-prompt (concat "OLD (" kind "to be replaced) : "))
(oldx (if replace-w-completion
(completing-read old-prompt obarray nil nil default
query-replace-from-history-variable)
(if query-replace-interactive
(car
(if (and prefix
(not (natnump (prefix-numeric-value
current-prefix-arg))))
regexp-search-ring
search-ring))
(read-from-minibuffer old-prompt default nil nil
query-replace-from-history-variable))))
(new-prompt (format "NEW (replacing %s): " oldx))
(newx (if replace-w-completion
(completing-read new-prompt obarray nil nil default
query-replace-to-history-variable)
(read-from-minibuffer new-prompt default nil nil
query-replace-to-history-variable))))
(list oldx newx current-prefix-arg 'display-msgs)))
(let ((face (and (fboundp 'display-in-minibuffer)
(or (and (boundp 'blue-foreground-face)
blue-foreground-face)
(define-face-const "Blue" nil)))))
(if prefix
(cond ((natnump (prefix-numeric-value prefix))
(when face
(display-in-minibuffer
1 "(" (list face "WORD") " replacement.)"))
(query-replace old new t))
(t
(when face
(display-in-minibuffer
1 "(" (list face "REGEXP") " replacement.)"))
(query-replace-regexp old new)))
(when face
(display-in-minibuffer 1 "(" (list face "STRING")
" replacement.)"))
(query-replace old new))
(when display-msgs ; interactive-p
(if face
(display-in-minibuffer 'event "query-replace `"
(list face old) "' by `"
(list face new) "' ... done.")
(message "query-replace `%s' by `%s' ... done." old new)))))
;;;###autoload
(defalias 'delete-non-matching-lines 'keep-lines)
;; REPLACES ORIGINAL in `replace.el':
;; 1. Prompt changed, to mention that lines after point are affected.
;; 2. The default regexp is provided by `search/replace-default-fn'.
;; 3. An in-progress message has been added.
;;;###autoload
(defun keep-lines (regexp)
"Delete all lines after point except those with a match for REGEXP.
A match split across lines preserves all the lines it lies in.
Note that the lines are deleted, not killed to the kill-ring.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive."
(interactive
(list (read-from-minibuffer
"Keep lines after cursor that contain a match for REGEXP: "
(if (fboundp search/replace-default-fn)
(funcall search/replace-default-fn)
(car regexp-history))
nil nil 'regexp-history nil t)))
(when (interactive-p) (message "Deleting non-matching lines ..."))
(save-excursion
(unless (bolp) (forward-line 1))
(let ((start (point))
(case-fold-search (and case-fold-search
(isearch-no-upper-case-p regexp t))))
(while (not (eobp))
;; Start is first char not preserved by previous match.
(if (not (re-search-forward regexp nil 'move))
(delete-region start (point-max))
(let ((end (save-excursion (goto-char (match-beginning 0))
(beginning-of-line) (point))))
;; Now end is first char preserved by the new match.
(when (< start end) (delete-region start end))))
(setq start (save-excursion (forward-line 1) (point)))
;; If the match was empty, avoid matching again at same place.
(and (not (eobp)) (= (match-beginning 0) (match-end 0))
(forward-char 1)))))
(when (interactive-p) (message "Deleting non-matching lines ... done.")))
;;;###autoload
(defalias 'delete-matching-lines 'flush-lines)
;; REPLACES ORIGINAL in `replace.el':
;; 1. Prompt changed, to mention that lines after point are affected.
;; 2. The default regexp is provided by `search/replace-default-fn'.
;; 3. An in-progress message has been added.
;;;###autoload
(defun flush-lines (regexp)
"Delete lines after point that contain a match for REGEXP.
If a match is split across lines, all the lines it lies in are deleted.
Note that the lines are deleted, not killed to the kill-ring.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive."
(interactive
(list (read-from-minibuffer
"Delete lines after cursor that contain a match for REGEXP: "
(if (fboundp search/replace-default-fn)
(funcall search/replace-default-fn)
(car regexp-history))
nil nil 'regexp-history nil t)))
(when (interactive-p) (message "Deleting matching lines ..."))
(let ((case-fold-search (and case-fold-search
(isearch-no-upper-case-p regexp t))))
(save-excursion
(while (and (not (eobp)) (re-search-forward regexp nil t))
(delete-region (save-excursion (goto-char (match-beginning 0))
(beginning-of-line) (point))
(progn (forward-line 1) (point))))))
(when (interactive-p) (message "Deleting matching lines ... done.")))
;;;###autoload
(defalias 'count-matches 'how-many)
;; REPLACES ORIGINAL in `replace.el':
;; 1. Prompt changed, to mention that lines after point are affected.
;; 2. The default regexp is provided by `search/replace-default-fn'.
;; 3. An in-progress message has been added.
;;;###autoload
(defun how-many (regexp)
"Print number of matches for REGEXP following point.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive."
(interactive (list (read-from-minibuffer
"Count matches after point for REGEXP: "
(if (fboundp search/replace-default-fn)
(funcall search/replace-default-fn)
(car regexp-history)) nil nil 'regexp-history nil t)))
(when (interactive-p) (message "Counting matches after point ..."))
(let ((count 0)
(case-fold-search (and case-fold-search
(isearch-no-upper-case-p regexp t)))
opoint)
(save-excursion
(while (and (not (eobp))
(progn (setq opoint (point))
(re-search-forward regexp nil t)))
(if (= opoint (point))
(forward-char 1)
(setq count (1+ count))))
(message "%d matches after point." count))))
(defconst list-matching-lines-face
(or (and (boundp 'skyblue-background-face)
skyblue-background-face)
(define-face-const nil "SkyBlue"))
"*Face used by `list-matching-lines' to show text matching regexp.
If nil, matches are not highlighted.")
;;;###autoload
(defvar occur-regexp nil "Search pattern used by `occur' command.")
;;;###autoload
(defalias 'list-matching-lines 'occur)
;; REPLACES ORIGINAL in `replace.el':
;; The default regexp is provided by `search/replace-default-fn'.
;;;###autoload
(defun occur (regexp &optional nlines)
"Show all lines in the current buffer containing a match for REGEXP.
If a match spreads across multiple lines, all those lines are shown.
Each line is displayed with NLINES lines before and after,
or -NLINES before if NLINES is negative. NLINES defaults to
`list-matching-lines-default-context-lines'.
Interactively it is the prefix arg.
The lines are shown in a buffer named `*Occur*'. This serves as a
menu to find any of the occurrences in the current buffer.
\\<occur-mode-map>\\[describe-mode] in the `*Occur*' buffer will explain how.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive."
(interactive
(list (let ((default (if (fboundp search/replace-default-fn)
(funcall search/replace-default-fn)
(car regexp-history))))
(read-from-minibuffer
"List lines matching regexp: "
default nil nil 'regexp-history default t))
current-prefix-arg))
(setq occur-regexp regexp) ; Save for highlighting.
(let ((nlines (if nlines
(prefix-numeric-value nlines)
list-matching-lines-default-context-lines))
(first t)
;;flag to prevent printing separator for first match
(occur-num-matches 0)
(buffer (current-buffer))
(dir default-directory)
(linenum 1)
(prevpos
;;position of most recent match
(point-min))
(case-fold-search (and case-fold-search
(isearch-no-upper-case-p regexp t)))
(final-context-start
;; Marker to the start of context immediately following
;; the matched text in *Occur*.
(make-marker)))
;;; (save-excursion
;;; (beginning-of-line)
;;; (setq linenum (1+ (count-lines (point-min) (point))))
;;; (setq prevpos (point)))
(save-excursion
(goto-char (point-min))
;; Check first whether there are any matches at all.
(if (not (re-search-forward regexp nil t))
(message "No matches for `%s'" regexp)
;; Back up, so the search loop below will find the first match.
(goto-char (match-beginning 0))
(with-output-to-temp-buffer "*Occur*"
(save-excursion
(set-buffer standard-output)
(setq default-directory dir)
;; We will insert the number of lines, and "lines", later.
(insert " matching ")
(let ((print-escape-newlines t)) (prin1 regexp))
(insert " in buffer `" (buffer-name buffer) "'." ?\n)
(occur-mode)
(setq occur-buffer buffer)
(setq occur-nlines nlines)
(setq occur-command-arguments
(list regexp nlines)))
(when (eq buffer standard-output) (goto-char (point-max)))
(save-excursion
;; Find next match, but give up if prev match was at end of buffer.
(while (and (not (= prevpos (point-max)))
(re-search-forward regexp nil t))
(goto-char (match-beginning 0))
(beginning-of-line)
(save-match-data
(setq linenum (+ linenum (count-lines prevpos (point)))))
(setq prevpos (point))
(goto-char (match-end 0))
(let* ((start
;;start point of text in source buffer to be put
;;into *Occur*
(save-excursion
(goto-char (match-beginning 0))
(forward-line (if (< nlines 0) nlines (- nlines)))
(point)))
(end
;; end point of text in source buffer to be put
;; into *Occur*
(save-excursion
(goto-char (match-end 0))
(if (> nlines 0)
(forward-line (1+ nlines))
(forward-line 1))
(point)))
(match-beg
;; Amount of context before matching text
(- (match-beginning 0) start))
(match-len
;; Length of matching text
(- (match-end 0) (match-beginning 0)))
(tag (format "%5d" linenum))
(empty (make-string (length tag) ?\ ))
tem
insertion-start
;; Number of lines of context to show for current match.
occur-marker
;; Marker pointing to end of match in source buffer.
(text-beg
;; Marker pointing to start of text for one
;; match in *Occur*.
(make-marker))
(text-end
;; Marker pointing to end of text for one match
;; in *Occur*.
(make-marker))
)
(save-excursion
(setq occur-marker (make-marker))
(set-marker occur-marker (point))
(set-buffer standard-output)
(setq occur-num-matches (1+ occur-num-matches))
(or first (zerop nlines)
(insert "--------\n"))
(setq first nil)
;; Insert matching text including context lines from
;; source buffer into *Occur*
(set-marker text-beg (point))
(setq insertion-start (point))
(insert-buffer-substring buffer start end)
(or (and (/= (+ start match-beg) end)
(with-current-buffer buffer
(eq (char-before end) ?\n)))
(insert "\n"))
(set-marker final-context-start
(+ (- (point) (- end (match-end 0)))
(if (save-excursion
(set-buffer buffer)
(save-excursion
(goto-char (match-end 0))
(end-of-line)
(bolp)))
1 0)))
(set-marker text-end (point))
;; Highlight text that was matched.
(when list-matching-lines-face
(put-text-property
(+ (marker-position text-beg) match-beg)
(+ (marker-position text-beg) match-beg match-len)
'face list-matching-lines-face))
;; `occur-point' property is used by occur-next and
;; occur-prev to move between matching lines.
(put-text-property
(+ (marker-position text-beg) match-beg match-len)
(+ (marker-position text-beg) match-beg match-len 1)
'occur-point t)
;; Now go back to the start of the matching text
;; adding the space and colon to the start of each line.
(goto-char insertion-start)
;; Insert space and colon for lines of context before match.
(setq tem (if (< linenum nlines)
(- nlines linenum)
nlines))
(while (> tem 0)
(insert empty ?:)
(forward-line 1)
(setq tem (1- tem)))
;; Insert line number and colon for the lines of
;; matching text.
(let ((this-linenum linenum))
(while (< (point) final-context-start)
(when (null tag)
(setq tag (format "%5d" this-linenum)))
(insert tag ?:)
;;; ;; DDA: Add mouse-face to line
;;; (put-text-property (save-excursion
;;; (beginning-of-line) (point))
;;; (save-excursion (end-of-line)
(point))
;;; 'mouse-face 'underline)
;;; ;; DDA: Highlight `grep-pattern' in compilation
buffer, if possible.
;;; (when (fboundp 'highlight-regexp-region)
;;; (highlight-regexp-region
;;; (save-excursion (beginning-of-line) (point))
;;; (save-excursion (end-of-line) (point))
;;; occur-regexp list-matching-lines-face))
(forward-line 1)
(setq tag nil)
(incf this-linenum))
(while (and (not (eobp)) (<= (point) final-context-start))
(insert empty ?:)
(forward-line 1)
(setq this-linenum (1+ this-linenum))))
;; Insert space and colon for lines of context after match.
(while (and (< (point) (point-max)) (< tem nlines))
(insert empty ?:)
(forward-line 1)
(setq tem (1+ tem)))
;; Add text properties. The `occur' prop is used to
;; store the marker of the matching text in the
;; source buffer.
(put-text-property (marker-position text-beg)
(- (marker-position text-end) 1)
'mouse-face 'underline)
(put-text-property (marker-position text-beg)
(marker-position text-end)
'occur occur-marker)
(goto-char (point-max)))
(forward-line 1)))
(set-buffer standard-output)
;; Go back to top of *Occur* and finish off by printing the
;; number of matching lines.
(goto-char (point-min))
(let ((message-string
(if (= occur-num-matches 1)
"1 line"
(format "%d lines" occur-num-matches))))
(insert message-string)
(when (interactive-p)
(message "%s matched" message-string)))
(setq buffer-read-only t)))
(when (fboundp 'show-a-frame-on) ; Defined in `frame-cmds.el'.
(show-a-frame-on "*Occur*"))
(let ((fr (and (fboundp 'get-a-frame) ; Defined in `frame-fns.el'.
(get-a-frame "*Occur*"))))
(when (and fr (fboundp 'shrink-frame-to-fit)) ; Defined in
`shrink-fit.el'.
(shrink-frame-to-fit fr)))))))
;; REPLACES ORIGINAL in `replace.el':
;; Highlights regexp in source buffer.
;;;###autoload
(defun occur-mode-mouse-goto (event)
"In Occur mode, go to the occurrence whose line you click on."
(interactive "e")
(let (buffer pos)
(save-excursion
(set-buffer (window-buffer (posn-window (event-end event))))
(save-excursion
(goto-char (posn-point (event-end event)))
(when (fboundp 'highlight-regexp-region) ; Highlight goto lineno.
(let ((bol (save-excursion (beginning-of-line) (point))))
(highlight-regexp-region
bol
(save-excursion (beginning-of-line) (search-forward ":" (+ bol 20)
t) (point))
"[0-9]+:"
(or (and (boundp 'red-foreground-face)
red-foreground-face)
(define-face-const "Red" nil)))))
(setq pos (occur-mode-find-occurrence))
(setq buffer occur-buffer)))
(pop-to-buffer buffer)
(goto-char (marker-position pos)))
(when (fboundp 'highlight-regexp-region)
(highlight-regexp-region (save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point))
occur-regexp list-matching-lines-face)))
;; REPLACES ORIGINAL in `replace.el':
;; Highlights regexp in source buffer.
;;;###autoload
(defun occur-mode-goto-occurrence ()
"Go to the occurrence the current line describes."
(interactive)
(when (fboundp 'highlight-regexp-region) ; Highlight goto lineno.
(let ((bol (save-excursion (beginning-of-line) (point))))
(highlight-regexp-region
bol
(save-excursion (beginning-of-line) (search-forward ":" (+ bol 20) t)
(point))
"[0-9]+:"
(or (and (boundp 'red-foreground-face)
red-foreground-face)
(define-face-const "Red" nil)))))
(let ((pos (occur-mode-find-occurrence)))
(pop-to-buffer occur-buffer)
(goto-char (marker-position pos)))
;; If possible, highlight regexp in buffer, and lineno in *Occur* buffer.
(when (fboundp 'highlight-regexp-region)
(highlight-regexp-region (save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point))
occur-regexp list-matching-lines-face)))
;;;@@@Emacs20 ;; REPLACES ORIGINAL in `replace.el':
;;;@@@Emacs20 ;; When change markers to numbers (after query loop), ensure they
are markers.
;;;@@@Emacs20 ;;;###autoload
;;;@@@Emacs20 (defun perform-replace (from-string replacements query-flag
regexp-flag
;;;@@@Emacs20 delimited-flag &optional
repeat-count map)
;;;@@@Emacs20 "Subroutine of `query-replace'. Its complexity handles
interactive queries.
;;;@@@Emacs20 Don't use this in your own program unless you want to query and
set the mark
;;;@@@Emacs20 just as `query-replace' does. Instead, write a simple loop like
this:
;;;@@@Emacs20 (while (re-search-forward \"foo[ \t]+bar\" nil t)
;;;@@@Emacs20 (replace-match \"foobar\" nil nil))
;;;@@@Emacs20 which will run faster and probably do what you want."
;;;@@@Emacs20 (unless map (setq map query-replace-map))
;;;@@@Emacs20 (let ((nocasify (not (and case-fold-search case-replace
;;;@@@Emacs20 (string-equal from-string
;;;@@@Emacs20 (downcase
from-string)))))
;;;@@@Emacs20 (literal (not regexp-flag))
;;;@@@Emacs20 (search-function (if regexp-flag 're-search-forward
'search-forward))
;;;@@@Emacs20 (search-string from-string)
;;;@@@Emacs20 (real-match-data nil) ; The match data for the
current match.
;;;@@@Emacs20 (next-replacement nil)
;;;@@@Emacs20 (replacement-index 0)
;;;@@@Emacs20 (keep-going t)
;;;@@@Emacs20 (stack nil)
;;;@@@Emacs20 (next-rotate-count 0)
;;;@@@Emacs20 (replace-count 0)
;;;@@@Emacs20 (lastrepl nil) ; Position after last
match considered.
;;;@@@Emacs20 (match-again t)
;;;@@@Emacs20 (message (and query-flag (substitute-command-keys "Query
replacing %s \
;;;@@@Emacs20 with %s: (\\<query-replace-map>\\[help] for help) "))))
;;;@@@Emacs20 (if (stringp replacements)
;;;@@@Emacs20 (setq next-replacement replacements)
;;;@@@Emacs20 (unless repeat-count (setq repeat-count 1)))
;;;@@@Emacs20 (when delimited-flag
;;;@@@Emacs20 (setq search-function 're-search-forward)
;;;@@@Emacs20 (setq search-string (concat "\\b" (if regexp-flag
;;;@@@Emacs20 from-string
;;;@@@Emacs20 (regexp-quote
from-string))
;;;@@@Emacs20 "\\b")))
;;;@@@Emacs20 (push-mark)
;;;@@@Emacs20 (undo-boundary)
;;;@@@Emacs20 (unwind-protect
;;;@@@Emacs20 ;; Loop finding occurrences that perhaps should be
replaced.
;;;@@@Emacs20 (while (and keep-going
;;;@@@Emacs20 (not (eobp))
;;;@@@Emacs20 (funcall search-function search-string nil t)
;;;@@@Emacs20 ;; If the search string matches immediately
after
;;;@@@Emacs20 ;; the previous match, but it did not match
there
;;;@@@Emacs20 ;; before the replacement was done, ignore
the match.
;;;@@@Emacs20 (or (not (or (eq lastrepl (point))
;;;@@@Emacs20 (and regexp-flag
;;;@@@Emacs20 (eq lastrepl
(match-beginning 0))
;;;@@@Emacs20 (not match-again))))
;;;@@@Emacs20 (and (not (eobp))
;;;@@@Emacs20 ;; Don't replace the null string
;;;@@@Emacs20 ;; right after end of previous
replacement.
;;;@@@Emacs20 (progn (forward-char 1)
;;;@@@Emacs20 (funcall search-function
search-string
;;;@@@Emacs20 nil t)))))
;;;@@@Emacs20 ;; Save the data associated with the real match.
;;;@@@Emacs20 (setq real-match-data (match-data))
;;;@@@Emacs20 ;; Before we make the replacement, decide whether the
search string
;;;@@@Emacs20 ;; can match again just after this match.
;;;@@@Emacs20 (when regexp-flag (setq match-again (looking-at
search-string)))
;;;@@@Emacs20 ;; If time for a change, advance to next replacement
string.
;;;@@@Emacs20 (when (and (listp replacements) (= next-rotate-count
replace-count))
;;;@@@Emacs20 (incf next-rotate-count repeat-count)
;;;@@@Emacs20 (setq next-replacement (nth replacement-index
replacements))
;;;@@@Emacs20 (setq replacement-index (% (1+ replacement-index)
;;;@@@Emacs20 (length replacements))))
;;;@@@Emacs20 (if (not query-flag)
;;;@@@Emacs20 (progn (store-match-data real-match-data)
;;;@@@Emacs20 (replace-match next-replacement nocasify
literal)
;;;@@@Emacs20 (incf replace-count))
;;;@@@Emacs20 (undo-boundary)
;;;@@@Emacs20 (let (done replaced key def)
;;;@@@Emacs20 ;; Loop reading commands until one of them sets
DONE,
;;;@@@Emacs20 ;; which means it has finished handling this
occurrence.
;;;@@@Emacs20 (while (not done)
;;;@@@Emacs20 (store-match-data real-match-data)
;;;@@@Emacs20 (replace-highlight (match-beginning 0) (match-end
0))
;;;@@@Emacs20 ;; Bind message-log-max so we don't fill up the message
log
;;;@@@Emacs20 ;; with a bunch of identical messages.
;;;@@@Emacs20 (let ((message-log-max nil))
;;;@@@Emacs20 (message message from-string next-replacement))
;;;@@@Emacs20 (setq key (read-event))
;;;@@@Emacs20 (setq key (vector key))
;;;@@@Emacs20 (setq def (lookup-key map key))
;;;@@@Emacs20 ;; Restore the match data while we process the command.
;;;@@@Emacs20 (cond ((eq def 'help)
;;;@@@Emacs20 (with-output-to-temp-buffer "*Help*"
;;;@@@Emacs20 (princ
;;;@@@Emacs20 (concat "Query replacing "
;;;@@@Emacs20 (if regexp-flag "regexp " "")
;;;@@@Emacs20 from-string " by "
;;;@@@Emacs20 next-replacement ".\n\n"
;;;@@@Emacs20 (substitute-command-keys
;;;@@@Emacs20 query-replace-help)))
;;;@@@Emacs20 (save-excursion
;;;@@@Emacs20 (set-buffer standard-output)
;;;@@@Emacs20 (help-mode))))
;;;@@@Emacs20 ((eq def 'exit)
;;;@@@Emacs20 (setq keep-going nil)
;;;@@@Emacs20 (setq done t))
;;;@@@Emacs20 ((eq def 'backup)
;;;@@@Emacs20 (if stack
;;;@@@Emacs20 (let ((elt (car stack)))
;;;@@@Emacs20 (goto-char (car elt))
;;;@@@Emacs20 (setq replaced (eq t (cdr elt)))
;;;@@@Emacs20 (unless replaced
;;;@@@Emacs20 (store-match-data (cdr elt)))
;;;@@@Emacs20 (pop stack))
;;;@@@Emacs20 (message "No previous match")
;;;@@@Emacs20 (ding 'no-terminate)
;;;@@@Emacs20 (sit-for 1)))
;;;@@@Emacs20 ((eq def 'act)
;;;@@@Emacs20 (unless replaced
;;;@@@Emacs20 (replace-match next-replacement nocasify
literal))
;;;@@@Emacs20 (setq done t) (setq replaced t))
;;;@@@Emacs20 ((eq def 'act-and-exit)
;;;@@@Emacs20 (unless replaced
;;;@@@Emacs20 (replace-match next-replacement nocasify
literal))
;;;@@@Emacs20 (setq keep-going nil)
;;;@@@Emacs20 (setq done t) (setq replaced t))
;;;@@@Emacs20 ((eq def 'act-and-show)
;;;@@@Emacs20 (unless replaced
;;;@@@Emacs20 (replace-match next-replacement nocasify
literal)
;;;@@@Emacs20 (setq replaced t)))
;;;@@@Emacs20 ((eq def 'automatic)
;;;@@@Emacs20 (unless replaced
;;;@@@Emacs20 (replace-match next-replacement nocasify
literal))
;;;@@@Emacs20 (setq done t)
;;;@@@Emacs20 (setq query-flag nil)
;;;@@@Emacs20 (setq replaced t))
;;;@@@Emacs20 ((eq def 'skip)
;;;@@@Emacs20 (setq done t))
;;;@@@Emacs20 ((eq def 'recenter)
;;;@@@Emacs20 (recenter nil))
;;;@@@Emacs20 ((eq def 'edit)
;;;@@@Emacs20 (message (substitute-command-keys
;;;@@@Emacs20 "Recursive edit. Type
\\[exit-recursive-edit] \
;;;@@@Emacs20 to return to top level."))
;;;@@@Emacs20 (store-match-data
;;;@@@Emacs20 (prog1 (match-data)
;;;@@@Emacs20 (save-excursion (recursive-edit))))
;;;@@@Emacs20 ;; Before we make the replacement,
;;;@@@Emacs20 ;; decide whether the search string
;;;@@@Emacs20 ;; can match again just after this match.
;;;@@@Emacs20 (when regexp-flag
;;;@@@Emacs20 (setq match-again (looking-at
search-string))))
;;;@@@Emacs20 ((eq def 'delete-and-edit)
;;;@@@Emacs20 (message (substitute-command-keys
;;;@@@Emacs20 "Recursive edit. Type
\\[exit-recursive-edit] \
;;;@@@Emacs20 to return to top level."))
;;;@@@Emacs20 (delete-region (match-beginning 0) (match-end 0))
;;;@@@Emacs20 (store-match-data
;;;@@@Emacs20 (prog1 (match-data)
;;;@@@Emacs20 (save-excursion (recursive-edit))))
;;;@@@Emacs20 (setq replaced t))
;;;@@@Emacs20 ;; Note: we do not need to treat `exit-prefix'
;;;@@@Emacs20 ;; specially here, since we reread
;;;@@@Emacs20 ;; any unrecognized character.
;;;@@@Emacs20 (t
;;;@@@Emacs20 (setq this-command 'mode-exited)
;;;@@@Emacs20 (setq keep-going nil)
;;;@@@Emacs20 (setq unread-command-events
;;;@@@Emacs20 (append (listify-key-sequence key)
;;;@@@Emacs20 unread-command-events))
;;;@@@Emacs20 (setq done t))))
;;;@@@Emacs20 ;; Record previous position for ^ when we move on.
;;;@@@Emacs20 ;; Change markers to numbers in the match data
;;;@@@Emacs20 ;; since lots of markers slow down editing.
;;;@@@Emacs20 (push (cons (point)
;;;@@@Emacs20 (or replaced
;;;@@@Emacs20 (mapcar (lambda (elt)
;;;@@@Emacs20 (and (markerp elt)
;;;@@@Emacs20 (prog1
(marker-position elt)
;;;@@@Emacs20 (set-marker elt
nil))))
;;;@@@Emacs20 (match-data))))
;;;@@@Emacs20 stack)
;;;@@@Emacs20 (when replaced (incf replace-count))))
;;;@@@Emacs20 (setq lastrepl (point)))
;;;@@@Emacs20 (replace-dehighlight))
;;;@@@Emacs20 (or unread-command-events
;;;@@@Emacs20 (message "Replaced %d occurrence%s"
;;;@@@Emacs20 replace-count
;;;@@@Emacs20 (if (= replace-count 1) "" "s")))
;;;@@@Emacs20 (and keep-going stack)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `replace+.el' ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- replace+.el - extensions to GNU `replace.el',
Drew Adams <=