emacs_el/tiny-tools/tiny/tinysearch.el

   1 ;;; tinysearch.el --- Grab and search word under cursor
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1994-2007 Jari Aalto
   8 ;; Keywords:        tools
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinysearch-version.
  13 ;; Look at the code with folding.el.
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;;; Intallation:
  38 ;; ....................................................... &t-install ...
  39 ;; Put this file on your Emacs-Lisp load path, add following into
  40 ;; ~/.emacs startup file.
  41 ;;
  42 ;;      (require 'tinysearch)
  43 ;;
  44 ;; or use autoload, and your ~/.emacs loads quicker
  45 ;;
  46 ;;      (autoload 'tinysearch-search-word-forward  "tinysearch" "" t)
  47 ;;      (autoload 'tinysearch-search-word-backward "tinysearch" "" t)
  48 ;;
  49 ;;      ;;  Install default keybindings: M-s (forward search), C-M-s
  50 ;;      ;;  (bbackward), M-Mouse-1 (forward), C-M-Mouse-1 (backward)
  51 ;;      (add-hook 'tinysearch-:load-hook 'tinysearch-install)
  52
  53 ;;}}}
  54 ;;{{{ Documentation
  55
  56 ;; ..................................................... &t-commentary ...
  57 ;;; Commentary:
  58
  59 ;;  Preface, 1994
  60 ;;
  61 ;;      In 7 Nov 1994 <aep@world.std.com> (Andrew E Page) posted
  62 ;;      interesting code by article name 'Script Example: Search for next
  63 ;;      word', which was interesting. The idea of the code was good, but it
  64 ;;      didn't work as expected at all. Gradually the idea was crystallized
  65 ;;      into this package.
  66 ;;
  67 ;;        "Why we need search word package, when in emacs I can do `C-s' to
  68 ;;        enter search mode: C-w C-w C-w to grap words immediately after
  69 ;;        point and finally C-s to start searching...?"
  70 ;;
  71 ;;      Well, people tend to forget, that life was out there when 19.xx
  72 ;;      wan't in hands of developers. This package was originally made for
  73 ;;      18. The advantage of this package is the variable
  74 ;;
  75 ;;          tinysearch-:word-boundary-set
  76 ;;
  77 ;;      which you can easily change whenever you need (e.g. thru
  78 ;;      functions). To do the same in emacs, you have to go and modify the
  79 ;;      syntax entries involved...then come back again when you're done. I
  80 ;;      never do that, I seldom touch the syntax entries. Besides all
  81 ;;      mode-xxx go crazy if I would do so. Now you see the advantage?
  82 ;;
  83 ;;      And of course I feel more comfortable to do just one keypress,
  84 ;;      like like `M-s' to search forward instead of cubersome C-s C-w C-w
  85 ;;      C-w [n times] and finally C-s
  86 ;;
  87 ;;  Description
  88 ;;
  89 ;;      Grab word under oint and searches fwd/back. The word is inserted
  90 ;;      into Emacs's search ring, so that you can later continue with `C-s'
  91 ;;      or with `C-r' call.
  92 ;;
  93 ;;  Why doesn't it find my C++ function class::InitClass() ??
  94 ;;
  95 ;;      User pressed the search function over the call:
  96 ;;
  97 ;;          InitClass();        << Here
  98 ;;          i = i +1;
  99 ;;
 100 ;;      Why isn't the function found? Remember that this searches
 101 ;;      'true' words, not parts of them. A word is surrounded by at
 102 ;;      least one whitespace, since it's not a word if it is concatenated
 103 ;;      together with something else.
 104 ;;
 105 ;;      The problem is, that if is you define ':' to belong to a
 106 ;;      character set in C++, [because you propably want to grab
 107 ;;      variables easily. including the scope operator
 108 ;;      'clss::variable' or '::global'], this package expects to
 109 ;;      find word a boundary:
 110 ;;
 111 ;;          nonWordWORDnonWord
 112 ;;         =======    =======
 113 ;;
 114 ;;      And as you can see, the if ':' belongs to word, it can't
 115 ;;      simultaneously belong to NonWord ! Summa summarum: Revert to
 116 ;;      emacs C-s for a moment, since the word is automatically added
 117 ;;      to the search buffer.
 118 ;;
 119 ;;  Word accept function note:
 120 ;;
 121 ;;      There is variable `tinysearch-:accept-word-function', which has
 122 ;;      default function
 123 ;;
 124 ;;          tinysearch-accept-word
 125 ;;
 126 ;;      The function's purpose is to check if the searched word is
 127 ;;      accepted and that search should be terminated. Currently there it
 128 ;;      contains some programming logic for C/C++ languages, so that
 129 ;;      certain hits are ignored. Consider following case:
 130 ;;
 131 ;;          struct *foo;   - 1
 132 ;;          foo->x;        - 2
 133 ;;          x->foo         - 3
 134 ;;
 135 ;;          int foo, x;    - 4
 136 ;;          foo = x;       - 5        * start of 'foo' and 'x' search backward
 137 ;;
 138 ;;      C/C++ mode, searching for 'foo' finds 4,2,1  -- Not 3
 139 ;;      C/C++ mode, searching for 'x'   finds 5,4,3  -- Not 2
 140 ;;      But in text-mode, you would find all occurrances.
 141 ;;
 142 ;;      The added logic to C++ ignores the struct's MEMBER matches so that
 143 ;;      you really can find the "main" variables. If you don't like
 144 ;;      this added feature, you can alwasy go to
 145 ;;
 146 ;;          M-x text-mode
 147 ;;
 148 ;;      For a while, or if want to permanently switch this feature off,
 149 ;;      you set the variable `tinysearch-:accept-word-function' to nil, which
 150 ;;      causes all hits to be accepted.
 151 ;;
 152 ;;      Needless to say, that you can use put your own checking
 153 ;;      function in that variable to control the accurrances better.
 154
 155 ;;}}}
 156
 157 ;;; Change Log:
 158
 159 ;;; Code:
 160
 161 ;;{{{ setup: require
 162
 163 (require 'tinylibm)
 164
 165 (eval-when-compile (ti::package-use-dynamic-compilation))
 166
 167 (ti::package-defgroup-tiny TinySearch tinysearch-: extensions
 168   "search word under cursor: backward, forward.")
 169
 170 ;;}}}
 171 ;;{{{ hooks
 172
 173 ;;; ......................................................... &v-hooks ...
 174
 175 (defcustom tinysearch-:before-hook nil
 176   "*Hook that is run at the BEG of search function.
 177 You can set this to point to function that alters the value of
 178 `tinysearch-:word-boundary-set' e.g. by looking at the file type."
 179   :type  'hook
 180   :group 'TinySearch)
 181
 182 (defcustom tinysearch-:final-hook nil
 183   "*Hook that is _always_ run at the END of search function.
 184 It doesn't care about word grabbings or search failures."
 185   :type  'hook
 186   :group 'TinySearch)
 187
 188 (defcustom tinysearch-:load-hook nil
 189   "*Run when package has been loaded.
 190 A good candidate could be `tinysearch-install-default-keybindings'."
 191   :type  'hook
 192   :group 'TinySearch)
 193
 194 ;;}}}
 195 ;;{{{ variables
 196
 197 ;;; ....................................................... &v-private ...
 198
 199 (defvar tinysearch-:direction nil
 200   "Tell direction of search. nil = forward.")
 201
 202 (defvar tinysearch-:search-status nil
 203   "Status of word search. t = successful.")
 204
 205 (defvar tinysearch-:overlay nil
 206   "Overlay used for highlighting.
 207 Created and killed during program execution.")
 208
 209 ;;; ........................................................ &v-public ...
 210 ;;; User configurable
 211
 212 (defcustom tinysearch-:word-boundary-set "-A-Za-z0-9_"
 213   "*Character set to conform a single word.
 214 You might want to set this to something else before doing search."
 215   :type  'hook
 216   :group 'TinySearch)
 217
 218 (defcustom tinysearch-:wrap-flag  nil
 219   "*Non-nil means wrap buffer if there is no more match."
 220   :type  'boolean
 221   :group 'TinySearch)
 222
 223 (defcustom tinysearch-:accept-word-function  'tinysearch-accept-word
 224   "*Function run after the search for word has been successful.
 225 If this variable contains non-existing function (like nil), the
 226 content of the variable is ignored.
 227
 228 Default function:
 229
 230   'tinysearch-accept-word'
 231
 232 Passed args to function:
 233
 234  string     word being searched
 235
 236 Return values of function:
 237
 238   t         accept search
 239   nil       do not accept search, continue searching next word."
 240   :type  'function
 241   :group 'TinySearch)
 242
 243 ;;; ....................................................... &v-version ...
 244
 245 (eval-and-compile
 246   (ti::macrof-version-bug-report
 247    "tinysearch.el"
 248    "tinysearch"
 249    tinysearch-:version-id
 250    "$Id: tinysearch.el,v 2.49 2007/05/07 10:50:14 jaalto Exp $"
 251    '(tinysearch-:version-id
 252      tinysearch-:before-hook
 253      tinysearch-:final-hook
 254      tinysearch-:load-hook
 255      tinysearch-:direction
 256      tinysearch-:search-status
 257      tinysearch-:overlay
 258      tinysearch-:word-boundary-set
 259      tinysearch-:wrap-flag)))
 260
 261 ;;}}}
 262
 263 ;;; ########################################################### &Funcs ###
 264
 265 ;;{{{ 19.xx isearch add
 266
 267 ;;; ----------------------------------------------------------------------
 268 ;;;
 269 (defun tinysearch-add-to-isearch-search-ring (isearch-string)
 270   "Add search pattern to ISEARCH-STRING in Emacs.
 271 This code is directly taken from function `isearch-done' By Daniel LaLiberte."
 272   (if (> (length isearch-string) 0)
 273       ;; Update the ring data.
 274       (if isearch-regexp
 275           (if (or (null regexp-search-ring)
 276                   (not (string= isearch-string (car regexp-search-ring))))
 277               (progn
 278                 (setq regexp-search-ring
 279                       (cons isearch-string regexp-search-ring))
 280                 (if (> (length regexp-search-ring) regexp-search-ring-max)
 281                     (setcdr (nthcdr (1- search-ring-max) regexp-search-ring)
 282                             nil))))
 283         (if (or (null search-ring)
 284                 (not (string= isearch-string (car search-ring))))
 285             (progn
 286               (setq search-ring (cons isearch-string search-ring))
 287               (if (> (length search-ring) search-ring-max)
 288                   (setcdr (nthcdr (1- search-ring-max) search-ring) nil)))))))
 289
 290 ;;}}}
 291 ;;{{{ main
 292
 293 ;;; ----------------------------------------------------------------------
 294 ;;;
 295 (defun tinysearch-accept-word  (word)
 296   "Determine if we accept searched WORD."
 297   (let* ((type      (symbol-name major-mode))
 298          (ret       t)                  ;default, accept search
 299          space-word)
 300     (cond
 301      ((string-match "^c-\\|^cc-\\|c[+]+" type)
 302       ;; Check C/C++ dependent variables, where rg. 'a' is
 303       ;; searched
 304       ;; a = 1                  , begin search with 'a'
 305       ;; a = a + 1              , accepted hit
 306       ;; struct->a              , not accepted hit, continue search
 307       (setq space-word
 308             (save-excursion
 309               (or (ti::buffer-read-space-word)
 310                   "")))
 311       (if (string-match (concat "\\(->\\|[.]\\)" (regexp-quote word))
 312                         space-word)
 313           ;;  discard this one.
 314           (setq ret nil))))
 315     ret))
 316
 317 ;;; ----------------------------------------------------------------------
 318 ;;;
 319 (defun tinysearch-grab-word (&optional charset beg end )
 320   "Gets word under cursor limited by CHARSET string.
 321 Optional BEG and END gives maximum search limits.
 322 Default boundary is line limit."
 323   (let* (re-word-boundary
 324          re-word
 325          ;;  We accept ':' and '-' , beasuse they are used in c++ and lisp
 326          (charset (or charset "-:A-Za-z0-9_"))
 327          (beg (or beg (line-beginning-position)))
 328          (end (or end (line-end-position)))
 329          pb
 330          pe
 331          p
 332          re
 333          ret)
 334     (setq re-word-boundary  (concat  "[^" charset "]"))
 335     (setq re-word (concat  "[" charset "]")) ;considered single word
 336     ;; Note:  the first search goes backwards to find the start of the
 337     ;;        word, which is one character in front of the character
 338     ;;        found by the search.  Then we go forward to the end of
 339     ;;        word which is one character behind the character found by the
 340     ;;        search.
 341     (save-excursion                     ;conceive original (point)
 342       (if (re-search-backward re-word-boundary beg t)
 343           (setq pb (1+ (point))))
 344       (if pb nil                        ;already found
 345         (setq p (point))
 346         (beginning-of-line)
 347         (if (eq p (point))              ;we were at the BEG
 348             (setq re re-word)
 349           (setq re (concat re-word "+")))       ;skip chars
 350         (if (re-search-forward re (1+ p) t)     ; word at the BEG
 351             (setq pb beg))))
 352     ;;  Then search end point
 353     (save-excursion
 354       (if (re-search-forward re-word-boundary end t)
 355           (setq pe (1- (point))))
 356       (if pe nil                               ;already found
 357         (if (looking-at (concat re-word "+$")) ; handle word at the END of ln
 358             (setq pe end))))
 359     (if (and pb pe)
 360         (setq ret (buffer-substring pb pe)))
 361     ;;  easier to debug this way
 362     ret))
 363
 364 ;;; ----------------------------------------------------------------------
 365 ;;; - There is lot of re-search-backward/fwd commands and it is intentional,
 366 ;;;   so that the code is totally emacs version independent. Newer emacs
 367 ;;;   has nice functions that shrink this code to 10 lines :->
 368 ;;; - Never grab word function is already coded in tinylib.el
 369 ;;;
 370 (defun tinysearch-search-word-main (&optional backward set)
 371   "Gets word under cursor and search next occurrence.
 372 If BACKWARD is non-nil, the search will be headed backward, the SET
 373 corresponds to `tinysearch-:word-boundary-set'.
 374
 375 Before searching is done the tinysearch-hooks is thrown. This is useful
 376 is you want someone to dynamically change the search-word's idea of
 377 the chars belonging to word. By setting `tinysearch-:word-boundary-set' you
 378 can set different sets for text and Lisp.  [In Lisp the '-' is part of
 379 word while in text it normally isn't].
 380
 381 NOTE:
 382
 383    You cannot search 1 char words with this due to internal
 384    behaviour of search method and cursor positioning."
 385   (interactive "P")
 386   (let ((wrap   tinysearch-:wrap-flag)
 387         (loop   0)
 388         (accept t)
 389         charset
 390         re-charset
 391         word found
 392         re-word-boundary  re-word
 393         prev-point
 394         no-msg
 395         mb
 396         me)
 397     (or tinysearch-:overlay
 398         (setq tinysearch-:overlay (ti::compat-overlay-some)))
 399     ;; ................................................... set charset ...
 400     (setq tinysearch-:direction backward ;inform possible hook func
 401           charset           (or set tinysearch-:word-boundary-set)
 402           re-word-boundary  (concat  "[^" charset "]")
 403           re-word           (concat  "[" charset "]") ;considered single word
 404           re-charset        re-word)
 405     ;;   Let the user set the word criteria
 406     (if tinysearch-:before-hook
 407         (run-hooks 'tinysearch-:before-hook))
 408     ;; ...................................................... set word ...
 409     (setq word (tinysearch-grab-word charset))
 410     (if (null word)
 411         (message "TinySearch: Word not grabbed.")
 412       ;;   enable C-s and C-r to use the word, look isearch.el
 413       ;;   NOTE: this doesn't put the WORD regexp there...
 414       (tinysearch-add-to-isearch-search-ring word)
 415       ;; post a message saying what we're looking for
 416       (message "searching for \`%s\`" word)
 417       (setq no-msg (concat "TinySearch: No more words [" word "]" ))
 418       (setq re-word
 419             (concat
 420              "\\(^" word  "\\|"
 421              re-word-boundary word "\\)" re-word-boundary))
 422       ;; ................................................... do search ...
 423       (while loop
 424         ;;  Record the point only if the word is accepted.
 425         (if accept
 426             (setq prev-point (point)))
 427         (if backward                    ;choose backward
 428             (progn
 429               (setq found (re-search-backward re-word nil t))
 430               (if (null found)
 431                   (message no-msg)
 432                 (save-match-data        ;highlight needs orig region
 433                   (unless (looking-at re-charset)
 434                     (re-search-forward re-charset) ;Goto first char
 435                     (backward-char 1)))))
 436           ;;  - This a little hard to explain: the search
 437           ;;    does not succeed, if the variable 'a' is at
 438           ;;    the beginning of line due to backward-char 2 correction
 439           (if (eq (current-column) 0)
 440               (ignore-errors (forward-char 1)))
 441           (setq found (re-search-forward re-word nil t))
 442           (if found
 443               (backward-char 2)))
 444         (if found
 445             ;;  - So that NEXT word will be grabbed, that's why 1 char words
 446             ;;    can't be found
 447             (setq mb (match-beginning 0)   me (match-end 0) )
 448           (message no-msg))
 449         ;; ........................................................ done ...
 450         (setq tinysearch-:search-status found) ;save status
 451         ;;  Should we continue searching ?
 452         (cond
 453          ((and (null found)
 454                wrap)
 455           (if (> loop 0)
 456               (setq loop nil)           ;No hits at all
 457             (if backward                ;start a new round
 458                 (ti::pmax)
 459               (ti::pmin))))
 460          ((and (null found)
 461                (> loop 0))
 462           ;;  Word accept function caused loop to run again, but
 463           ;;  there were no more hits. Back to prev position
 464           (goto-char prev-point)
 465           (setq loop nil))
 466          ((or (null found)
 467               (not (fboundp tinysearch-:accept-word-function)))
 468           (setq loop nil))
 469          ((and found
 470                ;;  Is this found word accepted in the context
 471                ;;  surrounding the text ?
 472                (setq accept (funcall tinysearch-:accept-word-function word)))
 473           ;;  Restore previous search point
 474           (setq loop nil)))
 475         ;; .................................................... do hilit ...
 476         (if (and tinysearch-:overlay found (null loop))
 477             (ti::compat-overlay-move tinysearch-:overlay  mb me nil 'highlight))
 478         (when tinysearch-:overlay       ;Hide overlay
 479           (sit-for 1)
 480           (ti::compat-overlay-move tinysearch-:overlay 1 1))
 481         (if loop
 482             (incf  loop))))
 483     ;; ---------------------- grabbed
 484     (if tinysearch-:final-hook
 485         (run-hooks 'tinysearch-:final-hook))))
 486
 487 ;;; ----------------------------------------------------------------------
 488 ;;;
 489 (defun tinysearch-charset-control ()
 490   "Dynamic character set change according to mode. This is example function."
 491   (let* ((type (symbol-name major-mode))
 492          set)
 493     (cond
 494      ((string-match  "^c-\\|^cc-\\|c[+]+" type)
 495       (setq set "A-Za-z0-9_"))
 496      ((string-match "lisp" type)
 497       ;;  Add ':' , which I use in variable names.
 498       (setq set "-:A-Za-z0-9_"))
 499      ((string-match "text\\|shell\\|perl" type)
 500       (setq set "A-Za-z0-9_")))
 501     set))
 502
 503 ;;; ----------------------------------------------------------------------
 504 ;;;
 505 ;;;###autoload
 506 (defun tinysearch-search-word-forward ()
 507   "Search word at point forward."
 508   (interactive)
 509   (tinysearch-search-word-main nil (tinysearch-charset-control)))
 510
 511 ;;; ----------------------------------------------------------------------
 512 ;;;
 513 ;;;###autoload
 514 (defun tinysearch-search-word-backward ()
 515   "Search word at point backward."
 516   (interactive)
 517   (tinysearch-search-word-main 'back (tinysearch-charset-control)))
 518
 519 ;;; ----------------------------------------------------------------------
 520 ;;;
 521 ;;;###autoload
 522 (defun tinysearch-install-default-keybindings (&optional uninstall)
 523   "Install default keybindings; M-s C-M-s, M-Mouse-1, C-M-Mouse-1."
 524   (interactive)
 525   (global-set-key [(meta ?s)] 'tinysearch-search-word-forward)
 526   (global-set-key [(control meta ?s)] 'tinysearch-search-word-backward)
 527   ;;  For mouse (under windowed system)
 528   (global-set-key [(meta control mouse-1)]
 529                   'tinysearch-search-word-forward)
 530   (global-set-key [(meta control shift mouse-1)]
 531                   'tinysearch-search-word-backward))
 532
 533 ;;; ----------------------------------------------------------------------
 534 ;;;
 535 ;;;###autoload
 536 (defun tinysearch-install (&optional arg)
 537   "Call `tinysearch-install-default-keybindings' with ARG."
 538   (interactive)
 539   (tinysearch-install-default-keybindings arg))
 540
 541 ;;}}}
 542
 543 (provide   'tinysearch)
 544 (run-hooks 'tinysearch-:load-hook)
 545
 546 ;;; tinysearch.el ends here