cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hmoccur.el

   1 ;;; hmoccur.el --- Multi-buffer or multi-file regexp occurrence location.
   2
   3 ;; Copyright (C) 1991 Markus Freericks
   4 ;; Copyright (C) 1991-1995, 2008 Free Software Foundation, Inc.
   5 ;; Developed with support from Motorola Inc.
   6
   7 ;; Author: Bob Weiner, Brown U.
   8 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   9 ;; Keywords: hypermedia, matching
  10
  11 ;; This file is part of GNU Hyperbole.
  12
  13 ;; GNU Hyperbole is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 3, or (at
  16 ;; your option) any later version.
  17
  18 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29 ;;
  30 ;; Modified by Bob Weiner to allow selection of a set of files within a
  31 ;; single directory to search.  By default, {M-x moccur RTN} searches
  32 ;; current buffers with files attached.
  33 ;;
  34 ;; Date: 1 Aug 91 15:47:27 GMT
  35 ;; From: mfx@cs.tu-berlin.de (Markus Freericks)
  36 ;; Subject: moccur - multibuffer occurences
  37 ;;
  38 ;; While editing some dozen or so files, i had the dire need for
  39 ;; something like 'occur' that can cope with multiple buffers. This has
  40 ;; probably been done before; but still, here is my try at it. It seems
  41 ;; to be very useful.
  42 ;;
  43 ;; How to use it: simple say
  44 ;;      M-x moccur <regexp>
  45 ;; moccur then searches through *all buffers* currently existing that are
  46 ;; bound to files and displays the occurences in a buffer that runs in
  47 ;; Moccur-mode. Change to that buffer, scroll around, and say C-c C-c
  48 ;; to jump to the occurrence. Quite simple.
  49 ;;
  50 ;; Incompatibilites to Occur mode:
  51 ;; a) it browses through *all* buffers that have a file name
  52 ;; associated with them; those may or may not include the current
  53 ;; buffer. Especially, while standard occur works
  54 ;; on 'all lines following point', Moccur does not.
  55 ;; b) there is no support for the 'NLINE' argument.
  56 ;;
  57 ;; Usage:
  58 ;; moccur <regexp> shows all occurences of <regexp> in all buffers
  59 ;; currently existing that refer to files.
  60 ;; the occurences are displayed in a buffer running in Moccur mode;
  61 ;; C-c C-c gets you to the occurence
  62 ;;
  63
  64 ;;; Code:
  65
  66 ;;;
  67 ;;; Public variables
  68 ;;;
  69
  70 (defconst moccur-source-prefix "@loc> "
  71   "Prefix for lines indicating source of matches.")
  72
  73 ;;;
  74 ;;; Public functions
  75 ;;;
  76
  77 (defun moccur (regexp &optional file-regexp no-fold-search)
  78   "Show all lines of all buffers containing a match for REGEXP.
  79 With optional FILE-REGEXP, a pattern matching to files in a single
  80 directory, search matching files rather than current buffers.
  81 The lines are shown in a buffer named *Moccur* which serves as a menu to
  82 find any of the occurrences in this buffer.
  83 \\[describe-mode] in that buffer explains how."
  84   (interactive "sRegexp to find occurrences of: \nsFiles to search (default current file buffers): ")
  85   (if (equal file-regexp "") (setq file-regexp nil))
  86   (let*  ((buffers (if file-regexp (directory-files
  87                                     (expand-file-name
  88                                      (or (file-name-directory
  89                                           file-regexp) "."))
  90                                     'full (file-name-nondirectory file-regexp))
  91                      (buffer-list)))
  92           (occbuf (get-buffer-create "*Moccur*"))
  93           (matches 0)
  94           (firstmatch t))
  95     (set-buffer occbuf)
  96     (setq buffer-read-only nil)
  97     (widen)
  98     (erase-buffer)
  99     (insert "Lines matching '" regexp "':\n\n")
 100     (let ((currbuf) (currfile) (kill-buf))
 101       (while buffers
 102         (setq currbuf (car buffers)
 103               currfile (if (stringp currbuf) currbuf)
 104               kill-buf (and currfile (not (get-file-buffer currfile)))
 105               buffers (cdr buffers))
 106         (if currfile
 107             (setq currbuf (find-file-noselect currfile))
 108           (setq currfile (buffer-file-name currbuf)))
 109         (if (or (not currfile) (not currbuf))
 110             nil
 111           (set-buffer currbuf)
 112           (let ((case-fold-search (not no-fold-search)))
 113             (save-excursion
 114               (goto-char (point-min))
 115               (setq firstmatch t)
 116               (while (re-search-forward regexp nil t)
 117                 (setq matches (+ matches 1))
 118                 (let* ((linenum (count-lines (point-min)(point)))
 119                        (tag (format "\n%4d:" linenum)))
 120                   (set-buffer occbuf)
 121                   (if firstmatch
 122                       (progn
 123                         (insert moccur-source-prefix currfile "\n")
 124                         (setq firstmatch nil)))
 125                   (insert tag)
 126                   (set-buffer currbuf)
 127                   (forward-word -1) ;; needed if match goes to eoline
 128                   (beginning-of-line)
 129                   (let ((beg (point)))
 130                     (end-of-line)
 131                     (append-to-buffer occbuf beg (point)))
 132                   (forward-line 1)))))
 133           (save-excursion
 134             (set-buffer occbuf)
 135             (if (not firstmatch) (insert "\n\n"))
 136             (if kill-buf (kill-buffer currbuf))))))
 137     (if (> matches 0)
 138         (progn
 139           (set-buffer occbuf)
 140           (moccur-mode)
 141           (if (fboundp 'outline-minor-mode)
 142               (and (progn (goto-char 1)
 143                           (search-forward "\C-m" nil t))
 144                    (outline-minor-mode 1)))
 145           (goto-char (point-min))
 146           (pop-to-buffer occbuf)
 147           (message "%d matches." matches)
 148           t)
 149       (message "No matches.")
 150       nil)))
 151
 152 (defun moccur-to ()
 153   "Go to the line where this occurrence was found."
 154   (interactive)
 155     (if (not (eq major-mode 'moccur-mode))
 156         (error "'moccur-to' must be called within a moccur buffer.")
 157         (let ((beg nil)
 158               (line nil)
 159               (lineno nil)
 160               (dstbuf nil))
 161           (save-excursion
 162             (beginning-of-line)
 163             (setq beg (point))
 164             (end-of-line)
 165             (setq line (buffer-substring beg (point)))
 166             (if (string-match "^[ ]*[0-9]+:" line)
 167                 (progn
 168                   (setq lineno (string-to-number (substring
 169                                                line 0 (match-end 0))))
 170                   (if (re-search-backward
 171                        (concat "^" moccur-source-prefix
 172                                "\"?\\([^\" \n]+\\)\"?") nil t)
 173                       (progn
 174                         (setq line (buffer-substring
 175                                     (match-beginning 1) (match-end 1))
 176                               dstbuf (find-file-noselect line))
 177                         (if (not dstbuf)
 178                             (message
 179                              "moccur-to: file '%s' is not readable" line)))
 180                     (error "No moccur header line for file.")))
 181               (error "Not an moccur occurrence line.")))
 182           (if (and lineno dstbuf)
 183               (progn
 184                 (message "Selection <%s> line %d." line lineno)
 185                 (pop-to-buffer dstbuf)
 186                 (goto-line lineno))))))
 187
 188 (fset 'moccur-mode-goto-occurrence 'moccur-to)
 189
 190
 191 ;;;
 192 ;;; Private functions
 193 ;;;
 194
 195 (defun moccur-mode ()
 196   "Major mode for output from \\[moccur].
 197 Move point to one of the occurrences in this buffer,
 198 then use \\[moccur-to] to go to the same occurrence
 199 in the buffer that the occurrenc was found in.
 200 \\{occur-mode-map}"
 201   (kill-all-local-variables)
 202   (use-local-map moccur-mode-map)
 203   (setq major-mode 'moccur-mode)
 204   (setq mode-name "Moccur"))
 205
 206 ;;;
 207 ;;; Private variables
 208 ;;;
 209
 210 (defvar moccur-mode-map ())
 211 (if moccur-mode-map
 212     ()
 213     (setq moccur-mode-map (make-sparse-keymap))
 214     (define-key moccur-mode-map "\C-c\C-c" 'moccur-to)
 215     (define-key moccur-mode-map " " 'moccur-to)
 216     (define-key moccur-mode-map "\C-m" 'moccur-to)
 217 )
 218
 219 (provide 'hmoccur)
 220
 221 ;;; hmoccur.el ends here