changelog shortlog tags changeset files revisions annotate raw

joccur.el

changeset 66: 5b737eefe5ea
author: kim.vanwyk
date: Wed Nov 10 15:19:03 2010 +0200 (18 months ago)
permissions: -rw-r--r--
description: Adding CSharp Mode and Google Weather 
     1;;; joccur.el --- An improved 'occur' implementation.

     2

     3;; Author: Javier Oviedo <email_joviedo@yahoo.com>

     4;; Created:  17 Feb 2004

     5

     6;; This program is free software; you can redistribute it and/or

     7;; modify it under the terms of the GNU General Public License as

     8;; published by the Free Software Foundation; either version 2 of

     9;; the License, or (at your option) any later version.

    10

    11;; This program is distributed in the hope that it will be

    12;; useful, but WITHOUT ANY WARRANTY; without even the implied

    13;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR

    14;; PURPOSE.  See the GNU General Public License for more details.

    15

    16;; You should have received a copy of the GNU General Public

    17;; License along with this program; if not, write to the Free

    18;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,

    19;; MA 02111-1307 USA

    20

    21;;; Commentary:

    22;;

    23;; This package implements the functionality of "occur" but with some

    24;; modifications. The *JOccur* buffer will display the lines containing

    25;; the matching regexp with the original text properties.

    26;;

    27;; I used the occur-mode code in replace.el(GNU Emacs 21.3.50.8) as the model

    28;; for this package. Indeed, a few helper functions are copied directly from

    29;; replace.el and renamed. The remaining helper functions I have reimplemented.

    30;; In addition, the actual "occur" engine has been modified extensively.

    31;;

    32;; Comments and/or constructive criticism is always welcome.

    33;;

    34

    35;; Installation:

    36;;

    37;; 1. Place joccur.el in your emacs load-path

    38;; 2. Add (require 'joccur) to your .emacs file

    39;;

    40

    41;; Usage:

    42;;

    43;; M-x joccur regexp

    44;;

    45

    46;;; Change Log:

    47;;

    48;; Version 1.3.1 03/11/2004  Javier Oviedo

    49;; - Fixed a joccur-mode-mouse-goto/joccur-mode-goto-occurrence bug. 

    50;;   These functions are bound to enter, mouse-2, etc.

    51;; - Added marker and text property for the entire line in the joccur buffer.

    52;;   Previously there were only markers in the joccur buffer on the matches.

    53;;   Now it is possible to jump to the line when the cursor is not on an

    54;;   exact regexp match.

    55;; - Added additional key definitions to the joccur-mode-map.

    56;;

    57;; Version 1.3 03/08/2004  Javier Oviedo

    58;; - Restructered joccur-engine using markers for each individual occurance

    59;;   of REGEXP...modified to better support multiple occurances per line.

    60;;

    61;; Version 1.2.3 03/04/2004  Javier Oviedo

    62;; - Cleaned up byte compiler. Added let-bindings and defvars.

    63;;

    64;; Version 1.2.2 02/25/2004  Javier Oviedo

    65;; - Made a joccur-regexp buffer-local variable. This allows switching between

    66;;   multiple joccur buffers with different regexp.

    67;; - Made a joccur-input-buffer buffer-local variable.

    68;; - Made overlays buffer-local. This allows each buffer to maintain the

    69;;   current highlighted/overlay match when switching between multiple joccur

    70;;   buffers.

    71;;

    72;; Version 1.2.1 02/24/2004  Javier Oviedo

    73;; - Joccur now handles the generic case of any font-lock-support-mode,

    74;;   instead of just lazy-lock-mode.

    75;;

    76;; Version 1.2 02/23/2004  Javier Oviedo

    77;; - Implemented multi-occur for joccur...called multi-joccur

    78;; - Handle multiple occurances of REGEXP in a line

    79;; - Various functionality improvements(additional overlays, etc.)

    80;;

    81;; Version 1.1 02/18/2004  Javier Oviedo

    82;; - Adding highlight of regexp when displaying occurance in originating buffer.

    83;; - Changed joccur-match-face.

    84;; - Added joccur-display-face and joccur-title-face

    85;; - Overlays are destroyed on killing/deleting of window/buffer

    86;; - Unique Joccur buffer created every time...based on search buffer and regexp.

    87;; - Introduced "Change Log" and "Usage" sections.

    88;;

    89;; Version 1.0 02/17/2004

    90;; - Introduced joccur package.

    91;;

    92

    93

    94(defconst joccur-version "1.3.1"

    95  "This version of joccur.el.")

    96

    97(defconst joccur-buf "*JOccur*"

    98  "Name of joccur buffer to use.")

    99

   100(defvar joccur-buf-cur nil

   101  "Name of current joccur buffer to use.")

   102

   103(defvar joccur-input-buffer nil

   104  "Name of input buffer to run joccur on.")

   105

   106(defvar joccur-input-buffer-local nil

   107  "Name of input buffer for the current joccur buffer.")

   108

   109(defvar joccur-match-overlay nil

   110  "The overlay used to highlight matched text in the *JOccur* buffer.")

   111

   112(defvar joccur-cur-match-overlay nil

   113  "The overlay used to highlight matched text in the *JOccur* buffer.")

   114

   115(defvar joccur-display-overlay nil

   116  "The overlay used to highlight matched text in the originating buffer.")

   117

   118(defvar joccur-regexp nil

   119  "The current joccur regexp.")

   120

   121(defvar joccur-regexp-local nil

   122  "The regexp for the current joccur buffer.")

   123

   124

   125(defvar joccur-mode-map

   126  (let ((map (make-sparse-keymap)))

   127    (define-key map "v" 'joccur-mode-display-occurrence)

   128    (define-key map "p" 'joccur-prev)

   129    (define-key map "n" 'joccur-next)

   130    (define-key map [mouse-2] 'joccur-mode-mouse-goto)

   131    (define-key map "\C-c\C-c" 'joccur-mode-goto-occurrence)

   132    (define-key map "\C-m" 'joccur-mode-goto-occurrence)

   133    (define-key map "o" 'joccur-mode-goto-occurrence-other-window)

   134    (define-key map "\C-o" 'joccur-mode-display-occurrence)

   135    (define-key map "\M-n" 'joccur-next)

   136    (define-key map "\M-p" 'joccur-prev)

   137    (define-key map "r" 'joccur-rename-buffer)

   138    (define-key map "c" 'clone-buffer)

   139    (define-key map "g" 'revert-buffer)

   140    (define-key map "q" 'joccur-delete-window)

   141    (define-key map "z" 'joccur-kill-this-buffer)

   142    map)

   143  "Keymap for `joccur-mode'.")

   144

   145(defface joccur-title-face

   146  '((t (:slant italic :underline t)))

   147  "Face for Joccur mode."

   148  :group 'joccur)

   149

   150(defface joccur-match-face

   151  '((t (:weight bold :slant italic :foreground "black" :background "SteelBlue1")))

   152  "Face for Joccur mode."

   153  :group 'joccur)

   154

   155(defface joccur-cur-match-face

   156  '((t (:weight bold :slant italic :foreground "black" :background "yellow")))

   157  "Face for Joccur mode."

   158  :group 'joccur)

   159

   160(defface joccur-display-face

   161  '((t (:weight bold :slant italic :foreground "black" :background "pink")))

   162  "Face for Joccur mode."

   163  :group 'joccur)

   164

   165(defcustom joccur-title-highlight 'joccur-title-face

   166  "*Face used for title line in the *JOccur* buffer.

   167If the value is nil, don't highlight."

   168  :type 'face

   169  :group 'matching)

   170

   171(defcustom joccur-match-highlight 'joccur-match-face

   172  "*Face used to higlight regexp matches in the *JOccur* buffer.

   173If the value is nil, don't highlight."

   174  :type 'face

   175  :group 'matching)

   176

   177(defcustom joccur-cur-match-highlight 'joccur-cur-match-face

   178  "*Face used to higlight regexp matches in the *JOccur* buffer.

   179If the value is nil, don't highlight."

   180  :type 'face

   181  :group 'matching)

   182

   183(defcustom joccur-display-highlight 'joccur-display-face

   184  "*Face used to higlight regexp matches in the *JOccur* buffer.

   185If the value is nil, don't highlight."

   186  :type 'face

   187  :group 'matching)

   188

   189(defcustom joccur-mode-hook '(turn-on-font-lock)

   190  "Hook run when entering JOccur mode."

   191  :type 'hook

   192  :group 'matching)

   193

   194

   195(put 'joccur-mode 'mode-class 'special)

   196(defun joccur-mode ()

   197  "Major mode for output from \\[joccur].

   198\\<joccur-mode-map>Move point to one of the items in this buffer, then use

   199\\[joccur-mode-goto-joccurrence] to go to the joccurrence that the item refers to.

   200Alternatively, click \\[joccur-mode-mouse-goto] on an item to go to it.

   201\\{joccur-mode-map}"

   202  (interactive)

   203  (kill-all-local-variables)

   204  (use-local-map joccur-mode-map)

   205  (setq major-mode 'joccur-mode)

   206  (setq mode-name "Joccur")

   207  (setq case-fold-search t)

   208  (run-hooks 'joccur-mode-hook))

   209

   210(defun joccur-mode-mouse-goto (event)

   211  "In JOccur mode, go to the occurrence whose line you click on."

   212  (interactive "e")

   213  (let (pos)

   214    (save-excursion

   215      (set-buffer (window-buffer (posn-window (event-end event))))

   216      (save-excursion

   217	(goto-char (posn-point (event-end event)))

   218	(setq pos (joccur-mode-find-occurrence))))

   219    (pop-to-buffer (marker-buffer pos))

   220    (goto-char pos)))

   221

   222(defun joccur-mode-find-occurrence ()

   223  (let ((pos (get-text-property (point) 'joccur-target)))

   224    (unless pos

   225      (error "No occurrence on this line"))

   226    (unless (buffer-live-p (marker-buffer pos))

   227      (error "Buffer for this occurrence was killed"))

   228    (setq joccur-buf-cur (buffer-name))

   229    (joccur-mode-display-highlight pos)

   230    pos))

   231

   232(defun joccur-mode-goto-occurrence ()

   233  "Go to the occurrence the current line describes."

   234  (interactive)

   235  (let ((pos (joccur-mode-find-occurrence)))

   236    (pop-to-buffer (marker-buffer pos))

   237    (goto-char pos)))

   238

   239(defun joccur-mode-goto-occurrence-other-window ()

   240  "Go to the occurrence the current line describes, in another window."

   241  (interactive)

   242  (let ((pos (joccur-mode-find-occurrence)))

   243    (switch-to-buffer-other-window (marker-buffer pos))

   244    (goto-char pos)))

   245

   246(defun joccur-mode-display-occurrence ()

   247  "Display in another window the occurrence the current line describes."

   248  (interactive)

   249  (let ((pos (joccur-mode-find-occurrence))

   250	window

   251	;; Bind these to ensure `display-buffer' puts it in another window.

   252	same-window-buffer-names

   253	same-window-regexps)

   254    (setq window (display-buffer (marker-buffer pos)))

   255    ;; This is the way to set point in the proper window.

   256    (save-selected-window

   257      (select-window window)

   258      (goto-char pos))))

   259

   260(defun joccur-mode-display-highlight(pos)

   261  "Create or move the `joccur-display-highlight' overlay."

   262  (interactive)

   263  (save-excursion

   264    (with-current-buffer (marker-buffer pos)

   265      (goto-char pos)

   266      (with-current-buffer joccur-buf-cur

   267        (setq joccur-regexp joccur-regexp-local))

   268      (re-search-forward joccur-regexp nil t)

   269      (let ((matchbeg (match-beginning 0))

   270            (matchend (match-end 0)))

   271        (if joccur-display-overlay

   272            (move-overlay joccur-display-overlay matchbeg matchend)

   273          (set (make-local-variable 'joccur-display-overlay) t)

   274          (setq joccur-display-overlay (make-overlay matchbeg matchend))

   275          (overlay-put joccur-display-overlay 'face joccur-display-highlight)

   276          (overlay-put joccur-display-overlay 'priority 1))))))

   277

   278(defun joccur-mode-display-unhighlight ()

   279  "Delete the `joccur-display-highlight' overlay."

   280  (interactive)

   281  (with-current-buffer joccur-input-buffer-local

   282    (if joccur-display-overlay

   283        (delete-overlay joccur-display-overlay))

   284    (setq joccur-display-overlay nil)))

   285

   286(defun joccur-mode-match-unhighlight ()

   287  "Delete the `joccur-display-highlight' overlay."

   288  (interactive)

   289  (if joccur-match-overlay

   290      (delete-overlay joccur-match-overlay))

   291  (setq joccur-match-overlay nil))

   292

   293(defun joccur-delete-window ()

   294  (interactive)

   295  (joccur-mode-display-unhighlight)

   296  (delete-window))

   297

   298(defun joccur-kill-this-buffer ()

   299  (interactive)

   300  (joccur-mode-display-unhighlight)

   301  (kill-buffer-and-window))

   302

   303(defun joccur-next ()

   304  "Move to the next match in a JOccur mode buffer."

   305  (interactive)

   306  (let (joccur-next-match)

   307    (if (eq (count-lines (point-min) (point)) 0)

   308        (forward-line 1))

   309    (setq joccur-regexp joccur-regexp-local)

   310    (setq joccur-next-match (re-search-forward joccur-regexp nil t))

   311    (if (not joccur-next-match)

   312        (let ()

   313          (error "No more matches"))

   314      (let ((matchbeg (match-beginning 0))

   315            (matchend (match-end 0)))

   316        (goto-char (1- (point)))

   317        (setq joccur-buf-cur (current-buffer))

   318        (if joccur-cur-match-overlay

   319            (move-overlay joccur-cur-match-overlay

   320                          matchbeg matchend joccur-buf-cur)

   321          (set (make-local-variable 'joccur-cur-match-overlay) t)

   322          (setq joccur-cur-match-overlay

   323                (make-overlay matchbeg matchend joccur-buf-cur))

   324          (overlay-put joccur-cur-match-overlay

   325                       'face joccur-cur-match-highlight)

   326          (overlay-put joccur-cur-match-overlay 'priority 2))))))

   327

   328(defun joccur-prev ()

   329  "Move to the previous match in a JOccur mode buffer."

   330  (interactive)

   331  (setq joccur-regexp joccur-regexp-local)

   332  (re-search-backward joccur-regexp nil t)

   333  (if (eq (count-lines (point-min) (point)) 1)

   334      (let ()

   335        (forward-line 1)

   336        (joccur-next)

   337        (error "No earlier Matches"))

   338    (let ((matchbeg (match-beginning 0))

   339          (matchend (match-end 0)))

   340      (setq joccur-buf-cur (current-buffer))

   341      (if joccur-cur-match-overlay

   342          (move-overlay joccur-cur-match-overlay

   343                        matchbeg matchend joccur-buf-cur)

   344        (set (make-local-variable 'joccur-cur-match-overlay) t)

   345        (setq joccur-cur-match-overlay

   346              (make-overlay matchbeg matchend joccur-buf-cur))

   347        (overlay-put joccur-cur-match-overlay

   348                     'face joccur-cur-match-highlight)

   349        (overlay-put joccur-cur-match-overlay 'priority 2)))))

   350

   351(defun joccur-read-primary-args ()

   352  (list (let* ((default (car regexp-history))

   353	       (input

   354		(read-from-minibuffer

   355		 (if default

   356		     (format "List lines matching regexp (default `%s'): "

   357			     default)

   358		   "List lines matching regexp: ")

   359		 nil

   360		 nil

   361		 nil

   362		 'regexp-history)))

   363	  (if (equal input "")

   364	      default

   365	    input))

   366	(when current-prefix-arg

   367	  (prefix-numeric-value current-prefix-arg))))

   368

   369(defun joccur-rename-buffer (&optional unique-p)

   370  "Rename the current *JOccur* buffer to *JOccur: original-buffer-name*.

   371Here `original-buffer-name' is the buffer name were occur was originally run.

   372When given the prefix argument, the renaming will not clobber the existing

   373buffer(s) of that name, but use `generate-new-buffer-name' instead.

   374You can add this to `joccur-hook' if you always want a separate *JOccur*

   375buffer for each buffer where you invoke `joccur'."

   376  (interactive "P")

   377  (with-current-buffer

   378      (if (eq major-mode 'joccur-mode)

   379          (current-buffer)

   380        (get-buffer "*JOccur*"))

   381    (let (joccur-buf-unique)

   382      (setq joccur-buf-unique (concat "*JOccur: "

   383                                      joccur-input-buffer

   384                                      " - "

   385                                      joccur-regexp

   386                                      "*"))

   387      (rename-buffer joccur-buf-unique unique-p))))

   388

   389(defun joccur (regexp &optional nlines)

   390  "Show all lines in the current buffer containing a match for REGEXP.

   391

   392If a match spreads across multiple lines, all those lines are shown.

   393

   394The lines are shown in a buffer named `*JOccur*'.

   395It serves as a menu to find any of the occurrences in this buffer.

   396\\<joccur-mode-map>\\[describe-mode] in that buffer will explain how.

   397

   398Searches are done in a case-insensitive manner"

   399  (interactive (joccur-read-primary-args))

   400  (joccur-1 regexp (list (current-buffer)) t))

   401

   402

   403(defun joccur-1 (regexp bufs-list joccur-unique-buffer)

   404  (setq joccur-regexp regexp)

   405  (get-buffer-create joccur-buf)

   406  (let (active-bufs)

   407    (setq active-bufs (delq nil (mapcar #'(lambda (buf)

   408                                            (when (buffer-live-p buf) buf))

   409                                        bufs-list)))

   410    (dolist (input-buf active-bufs)

   411      (joccur-engine input-buf))

   412    (display-buffer joccur-buf)

   413    (pop-to-buffer joccur-buf)

   414    (setq truncate-lines t)

   415    (set (make-local-variable 'joccur-regexp-local) joccur-regexp)

   416    (set (make-local-variable 'joccur-input-buffer-local) joccur-input-buffer)

   417    (beginning-of-buffer)

   418    (if joccur-unique-buffer

   419        (joccur-rename-buffer joccur-unique-buffer))))

   420

   421  

   422(defun joccur-engine (input-buf &optional unique-buf)

   423  (setq joccur-input-buffer (buffer-name input-buf))

   424  (let ((lines 1)

   425        (matches 0)

   426        (marker nil)

   427        (match-line-marker nil)

   428        (joccur-font-lock-support-mode nil)

   429        (joccur-buf-start 0)

   430        (matchpt nil)

   431        (matchbeg-input nil)

   432        (matchend-input nil)

   433        (matchbeg-output nil)

   434        (matchend-output nil)

   435        (beg-output nil)

   436        (end-output nil)

   437        (curMatch nil)

   438        (joccur-buf-output nil))

   439    (save-excursion

   440      (with-current-buffer joccur-buf

   441        (joccur-mode)

   442        (setq buffer-read-only nil)

   443        (if unique-buf

   444            (erase-buffer))

   445        (goto-char (setq joccur-buf-start (point-max)))

   446        (with-current-buffer joccur-input-buffer

   447          (setq joccur-font-lock-support-mode font-lock-support-mode)

   448          (if joccur-font-lock-support-mode

   449              (let ()

   450                (setq font-lock-support-mode nil)

   451                (font-lock-mode)

   452                (font-lock-mode)))

   453          (goto-char (point-min)) ;; begin searching in the buffer

   454          (while (not (eobp))

   455            (when (setq matchpt (re-search-forward joccur-regexp nil t))

   456              (setq matches (1+ matches)) ;; increment match count

   457              (setq curMatch (buffer-substring (line-beginning-position)

   458                                               (line-end-position)))

   459              (setq lines (count-lines (point-min) matchpt))

   460              (setq joccur-buf-output

   461                    (concat (format "%7d: " lines) curMatch "\n"))

   462              (setq match-line-marker (make-marker))

   463              (set-marker match-line-marker (point-at-bol))

   464              (with-current-buffer joccur-buf

   465                (setq beg-output (point))

   466                (insert joccur-buf-output)

   467                (setq end-output (point))

   468                (add-text-properties

   469                 beg-output (1- (point)) '(mouse-face highlight))

   470                (add-text-properties

   471                 beg-output end-output

   472                 `(joccur-target ,match-line-marker

   473                                 help-echo

   474                                 "mouse-2: go to this occurrence"))

   475                (goto-char beg-output))

   476              (save-excursion

   477                (goto-char (point-at-bol))

   478                (while (re-search-forward joccur-regexp (point-at-eol) t)

   479                  (setq matchbeg-input (match-beginning 0)

   480                        matchend-input (match-end 0))

   481                  (setq marker (make-marker))

   482                  (set-marker marker matchbeg-input)

   483                  (with-current-buffer joccur-buf

   484                    (re-search-forward joccur-regexp (point-at-eol) t)

   485                    (setq matchbeg-output (match-beginning 0)

   486                          matchend-output (match-end 0))

   487                    (add-text-properties

   488                     matchbeg-output matchend-output

   489                     `(joccur-target ,marker

   490                                     help-echo

   491                                     "mouse-2: go to this occurrence"))

   492                    (set (make-local-variable 'joccur-match-overlay) t)

   493                    (setq joccur-match-overlay

   494                          (make-overlay matchbeg-output matchend-output))

   495                    (overlay-put joccur-match-overlay

   496                                 'face joccur-match-highlight)

   497                    (overlay-put joccur-match-overlay 'priority 1))))

   498              (with-current-buffer joccur-buf

   499                (goto-char end-output)))

   500            (forward-line 1))

   501          (if joccur-font-lock-support-mode

   502              (setq font-lock-support-mode joccur-font-lock-support-mode)))

   503        (insert "\n")

   504        (goto-char joccur-buf-start)

   505        (save-excursion

   506          (let ((beg joccur-buf-start)

   507                end)

   508            (insert (format "%d lines matching \"%s\" in buffer: %s\n"

   509                            matches joccur-regexp joccur-input-buffer))

   510            (setq end (point))

   511            (add-text-properties

   512             beg end

   513             (append `(font-lock-face ,joccur-title-highlight)))))

   514        (setq buffer-read-only t)))))

   515

   516(defun multi-joccur (bufs regexp &optional nlines)

   517  "Show all lines in buffers BUFS containing a match for REGEXP.

   518This function acts on multiple buffers; otherwise, it is exactly like

   519`joccur'."

   520  (interactive

   521   (cons

   522    (let* ((bufs (list (read-buffer "First buffer to search: "

   523				    (current-buffer) t)))

   524	   (buf nil)

   525	   (ido-ignore-item-temp-list bufs))

   526      (while (not (string-equal

   527		   (setq buf (read-buffer

   528			      (if (eq read-buffer-function 'ido-read-buffer)

   529				  "Next buffer to search (C-j to end): "

   530				"Next buffer to search (RET to end): ")

   531			      nil t))

   532		   ""))

   533	(add-to-list 'bufs buf)

   534	(setq ido-ignore-item-temp-list bufs))

   535      (nreverse (mapcar #'get-buffer bufs)))

   536    (joccur-read-primary-args)))

   537  (joccur-1 regexp bufs nil))

   538

   539

   540(provide 'joccur)

   541

   542;;; joccur.el ends here