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

   1 ;;; wrolo.el --- Hierarchical, multi-file, easy to use rolodex system
   2
   3 ;; Copyright (C) 1989, 1990, 1991, 1992, 1995, 2006 Free Software
   4 ;; 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 ;;  The `put whatever you feel like into it' rolodex.
  31 ;;
  32 ;;  FEATURES:
  33 ;;
  34 ;;   1.  Multiple rolodex files with free text lookup.  No structured
  35 ;;       fields are used.
  36 ;;
  37 ;;   2.  Hierarchical rolodex entries as in:
  38 ;;        *    Company
  39 ;;        **     Manager
  40 ;;        ***      Underlings
  41 ;;
  42 ;;       Searching for Manager turns up all Underlings.  Searching for
  43 ;;       Company retrieves all listed employees.
  44 ;;
  45 ;;       This hierarchical system has proved very effective for retrieving
  46 ;;       computer system administration problem reports by vendor name,
  47 ;;       problem number or by subject area, without having to resort to a
  48 ;;       database system, and also for extraction of relevant text
  49 ;;       sections from reports.
  50 ;;
  51 ;;   3.  String and regular expression searching capabilities.  Matches are
  52 ;;       found anywhere within entries, so entries may be of any format you
  53 ;;       like without the bother of fixed field restrictions.
  54 ;;       Ability to restrict number of matches or to report number of matches
  55 ;;       without displaying entries.
  56 ;;
  57 ;;   4.  Smart addition, editing and sorting of entries by hierarchy level.
  58 ;;
  59 ;;   5.  Support for Hyperbole buttons within rolodex entries.
  60 ;;
  61 ;;   See "wrolo-logic.el" for logical search functions (and, or, not, xor).
  62 ;;   See "wrolo-menu.el" for menu handling functions.  (If you received
  63 ;;   wrolo as part of Hyperbole, this file in unneeded and so not included.)
  64 ;;
  65 ;;
  66 ;;  SETUP:
  67 ;;
  68 ;;   The variable 'rolo-file-list' is a list of files to search for
  69 ;;   matching rolodex entries.  To add personal files to rolo-file-list,
  70 ;;   when you find these functions are useful for any sort of list lookup,
  71 ;;   add the following to your ~/.emacs file (substituting where you see
  72 ;;   <fileN>):
  73 ;;
  74 ;;      (setq rolo-file-list (append rolo-file-list '("<file1>" "<file2>")))
  75 ;;
  76 ;;   We recommend that entries in 'rolo-file-list' have ".otl" suffixes
  77 ;;   so that they do not conflict with file names that other rolodex
  78 ;;   programs might use and so that they are edited in 'outline-mode' by
  79 ;;   default.  If you want the latter behavior, uncomment and add something
  80 ;;   like the following to one of your GNU Emacs initialization files:
  81 ;;
  82 ;;     ;; Add to the list of suffixes that causes automatic mode invocation
  83 ;;     (setq auto-mode-alist
  84 ;;        (append '(("\\.otl$" . outline-mode)) auto-mode-alist))
  85 ;;
  86 ;;   The buffers containing the rolodex files are not killed after a search
  87 ;;   on the assumption that another search is likely to follow within this
  88 ;;   Emacs session.  You may wish to change this behavior with the following
  89 ;;   setting:
  90 ;;
  91 ;;     (setq rolo-kill-buffers-after-use t)
  92 ;;
  93 ;;   After an entry is killed, the modified rolodex file is automatically
  94 ;;   saved.  If you would rather always save files yourself, use this
  95 ;;   setting:
  96 ;;
  97 ;;     (setq rolo-save-buffers-after-use nil)
  98 ;;
  99 ;;   When adding an entry from within a buffer containing a mail
 100 ;;   message, the rolodex add function will extract the sender's name
 101 ;;   and e-mail address and prompt you with the name as a default.  If
 102 ;;   you accept it, it will enter the name and the email address using
 103 ;;   the format given by the 'rolo-email-format' variable.  See its
 104 ;;   documentation if you want to change its value.
 105 ;;
 106 ;;
 107 ;;   If you use Hyperbole V2.3 or greater, then no other rolodex setup
 108 ;;   is necessary, simply select the "Rolo/" menu item from the top
 109 ;;   level Hyperbole menu.  Otherwise, add the following to your
 110 ;;   "~/.emacs" file:
 111 ;;
 112 ;;     (autoload 'rolo-menu "rolo-menu" "Load wrolo system." t)
 113 ;;     (global-set-key "\C-x4r" 'rolo-menu)
 114 ;;
 115 ;;   And then simply invoke the rolodex menu with {C-x 4 r} after Emacs
 116 ;;   has read those lines in your init file.
 117 ;;
 118 ;;
 119 ;;  SUMMARY OF USE:
 120 ;;
 121 ;;   The rolo menu provides access to the following commands:
 122 ;;
 123 ;;     Menu Item       Function              Description
 124 ;;     ====================================================================
 125 ;;     Add             rolo-add              Adds a rolodex entry
 126 ;;     Display         rolo-display-matches  Displays last matches again
 127 ;;     Edit            rolo-edit             Edits an existing rolodex entry
 128 ;;     Info                                  Displays Rolodex manual entry
 129 ;;     Kill            rolo-kill             Removes an entry from the rolodex
 130 ;;     Order           rolo-sort             Sorts all levels in rolodex
 131 ;;     RegexFind       rolo-grep             Finds all entries containing
 132 ;;                                             a regular expression
 133 ;;     StringFind      rolo-fgrep            Finds all entries containing
 134 ;;                                             a string
 135 ;;     WordFind        rolo-word             Finds all entries containing
 136 ;;                                             a string of whole words
 137 ;;     Yank            rolo-yank             Inserts first matching rolodex
 138 ;;                                             entry at point
 139 ;;
 140 ;;   For any of these commands that prompt you for a name, you may use the form
 141 ;;   parent/child to locate a child entry below a parent entry, e.g.
 142 ;;   from the example near the top, we could give Company/Manager/Underlings.
 143 ;;
 144 ;;   Here is a snippet from our group rolodex file.  The ';'s should be
 145 ;;   removed of course and the '*'s should begin at the start of the
 146 ;;   line.  If a rolodex file begins with two separator lines whose
 147 ;;   first three characters are "===", then these lines and any text
 148 ;;   between them are prepended to the output buffer whenever any
 149 ;;   entries are retrieved from that file.
 150 ;;
 151 ;;=============================================================================
 152 ;;                            GROUP ROLODEX
 153 ;; <Last Name>, <First Name>  <Co/Categ>   W<Work #>   H<Home #>  P<Pager #>
 154 ;;                                         F<Fax #>    M<Modem #> C<Cellular #>
 155 ;;        <Address>        <Miscellaneous Info, Key Words>
 156 ;;=============================================================================
 157 ;;*   EX594, Digital-Systems-Research
 158 ;;**  Weiner, Bob             Motorola     W2087                  P7-7489
 159 ;;        FL19, L-1035
 160 ;;
 161 ;;
 162 ;;  FOR PROGRAMMERS:
 163 ;;
 164 ;;   Entries in rolodex files are separated by patterns matching
 165 ;;   'rolo-entry-regexp'.  Each entry may have any number of sub-entries
 166 ;;   which represent the next level down in the entry hierarchy.
 167 ;;   Sub-entries' separator patterns are always longer than their parents'.
 168 ;;   For example, if an entry began with '*' then its sub-entries would begin
 169 ;;   with '**' and so on.  Blank lines in rolodex files will not end up where
 170 ;;   you want them if you use the rolo-sort commands; therefore, blank lines
 171 ;;   are not recommended.  If you change the value of
 172 ;;   'rolo-entry-regexp', you will have to modify 'rolo-sort'.
 173 ;;
 174 ;;   The following additional functions are provided:
 175 ;;
 176 ;;     'rolo-sort-level' sorts a specific level of entries in a rolodex file;
 177 ;;     'rolo-map-level' runs a user specified function on a specific level of
 178 ;;       entries in a rolodex file;
 179 ;;     'rolo-fgrep-file', same as 'rolo-fgrep' but operates on a single file;
 180 ;;     'rolo-grep-file', same as 'rolo-grep' but operates on a single file;
 181 ;;     'rolo-display-matches', display last set of rolodex matches, if any;
 182 ;;     'rolo-toggle-narrow-to-entry' toggles between display of current entry
 183 ;;       and display of all matching entries.
 184 ;;
 185 ;;
 186 ;;  MOD HISTORY:
 187 ;;
 188 ;;   12/17/89
 189 ;;     Added internal 'rolo-shrink-window' function for use in
 190 ;;     compressing/uncompressing the rolo view window to/from a size just
 191 ;;     large enough for the selected entry.  This is useful when a search
 192 ;;     turns up more entries than desired.
 193 ;;
 194 ;;   02/21/90
 195 ;;     Modified 'rolo-grep-file' and 'rolo-map-level' so they only set buffers
 196 ;;     read-only the first time they are read in.  This way, if someone edits a
 197 ;;     rolodex file and then does a rolo-fgrep or other function, the buffer
 198 ;;     will not be back in read-only mode.
 199 ;;
 200 ;;   04/18/91
 201 ;;     Modified 'rolo-grep-file' to expand any hidden entries in rolo file
 202 ;;     before doing a search.
 203 ;;
 204 ;;   12/24/91
 205 ;;     Added Hyperbole button support.
 206 ;;
 207 ;;   12/30/91
 208 ;;     Added convenient support for entry add, edit, kill and yank.
 209 ;;
 210 ;;   01/10/91
 211 ;;     Fixed bug in rolo-to that ended search too early.
 212 ;;
 213
 214 ;;; Code:
 215
 216 ;;;
 217 ;;; Other required Elisp libraries
 218 ;;;
 219
 220 (require 'hversion)
 221 (require 'hmail)
 222
 223 ;;;
 224 ;;; Public variables
 225 ;;;
 226
 227 (defvar rolo-email-format "%s\t\t<%s>"
 228   "Format string to use when adding an entry with e-mail addr from a mail msg.
 229 It must contain a %s indicating where to put the entry name and a second
 230 %s indicating where to put the e-mail address.")
 231
 232 (defvar rolo-file-list
 233   (if (memq system-type '(ms-windows windows-nt ms-dos))
 234       '("c:/_rolodex.otl") '("~/.rolodex.otl"))
 235   "*List of files containing rolodex entries.
 236 The first file should be a user-specific rolodex file, typically in the home
 237 directory.  The second file is often a shared, group-specific rolodex file.
 238
 239 A rolo-file consists of:
 240    (1) an optional header beginning with and ending with a line which matches
 241        rolo-hdr-regexp;
 242    (2) one or more rolodex entries which each begin with
 243        rolo-entry-regexp and may be nested.")
 244
 245 (defvar rolo-highlight-face nil
 246   "*Face used to highlight rolodex search matches.")
 247 (if rolo-highlight-face
 248     nil
 249   (setq rolo-highlight-face
 250         (cond (hyperb:emacs19-p
 251                (if (fboundp 'make-face)
 252                    (progn (make-face 'rolo-highlight-face)
 253                           'rolo-highlight-face)))
 254               (hyperb:epoch-p (make-style))
 255               (t (if (fboundp 'make-face)
 256                      (face-name (make-face 'rolo-highlight-face))))))
 257   (if (fboundp 'hproperty:set-item-highlight)
 258       (hproperty:set-item-highlight)))
 259
 260 (defvar rolo-kill-buffers-after-use nil
 261   "*Non-nil means kill rolodex file buffers after searching them for entries.
 262 Only unmodified buffers are killed.")
 263
 264 (defvar rolo-save-buffers-after-use t
 265   "*Non-nil means save rolodex file after an entry is killed.")
 266
 267 (defvar wrolo-yank-reformat-function nil
 268   "*Value is a function of two arguments, START and END, invoked after a rolo-yank.
 269 It should reformat the region given by the arguments to some preferred style.
 270 Default value is nil, meaning no reformmating is done.")
 271
 272 ;;;
 273 ;;; Commands
 274 ;;;
 275
 276 ;;;###autoload
 277 (defun rolo-add (name &optional file)
 278   "Adds a new entry in personal rolodex for NAME.
 279 Last name first is best, e.g. \"Smith, John\".
 280 With prefix argument, prompts for optional FILE to add entry within.
 281 NAME may be of the form: parent/child to insert child below a parent
 282 entry which begins with the parent string."
 283   (interactive
 284    (progn
 285      (or (fboundp 'mail-fetch-field) (require 'mail-utils))
 286      (let* ((lst (rolo-name-and-email))
 287             (name (car lst))
 288             (email (car (cdr lst)))
 289             (entry (read-string "Name to add to rolo: "
 290                                 (or name email))))
 291        (list (if (and email name
 292                       (string-match (concat "\\`" (regexp-quote entry)) name))
 293                  (format rolo-email-format entry email) entry)
 294              current-prefix-arg))))
 295   (if (or (not (stringp name)) (string= name ""))
 296       (error "(rolo-add): Invalid name: '%s'" name))
 297   (if (and (interactive-p) file)
 298       (setq file (completing-read "File to add to: "
 299                                   (mapcar 'list rolo-file-list))))
 300   (if (null file) (setq file (car rolo-file-list)))
 301   (cond ((and file (or (not (stringp file)) (string= file "")))
 302          (error "(rolo-add): Invalid file: '%s'" file))
 303         ((and (file-exists-p file) (not (file-readable-p file)))
 304          (error "(rolo-add): File not readable: '%s'" file))
 305         ((not (file-writable-p file))
 306          (error "(rolo-add): File not writable: '%s'" file)))
 307   (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
 308   (if (interactive-p) (message "Locating insertion point for '%s'..." name))
 309   (let ((parent "") (level "") end)
 310     (widen) (goto-char 1)
 311     (while (setq end (string-match "/" name))
 312       (setq parent (substring name 0 end)
 313             name (substring name (min (1+ end) (length name))))
 314       (if (re-search-forward
 315            (concat "\\(" rolo-entry-regexp "\\)[ \t]*"
 316                    (regexp-quote parent)) nil t)
 317           (setq level (buffer-substring (match-beginning 1)
 318                                         (match-end 1)))
 319         (error "(rolo-add): '%s' category not found in \"%s\"."
 320                parent file)))
 321     (narrow-to-region (point)
 322                       (progn (rolo-to-entry-end t level) (point)))
 323     (goto-char (point-min))
 324     (let* ((len (length name))
 325            (name-level (concat level "*"))
 326            (level-len (length name-level))
 327            (entry "")
 328            (entry-spc "")
 329            (entry-level)
 330            (match)
 331            (again t))
 332       (while (and again
 333                   (re-search-forward
 334                    (concat "\\(" rolo-entry-regexp "\\)\\([ \t]*\\)")
 335                    nil 'end))
 336         (setq entry-level (buffer-substring (match-beginning 1)
 337                                             (match-end 1)))
 338         (if (/= (length entry-level) level-len)
 339             (rolo-to-entry-end t entry-level)
 340           (setq entry (buffer-substring (point) (+ (point) len))
 341                 entry-spc (buffer-substring (match-beginning 2)
 342                                             (match-end 2)))
 343           (cond ((string< entry name)
 344                  (rolo-to-entry-end t entry-level))
 345                 ((string< name entry)
 346                  (setq again nil) (beginning-of-line))
 347                 (t ;; found existing entry matching name
 348                  (setq again nil match t)))))
 349       (setq buffer-read-only nil)
 350       (if match
 351           nil
 352         (insert (or entry-level (concat level "*"))
 353                 (if (string= entry-spc "") "   " entry-spc)
 354                 name "\n")
 355         (backward-char 1))
 356       (widen)
 357       (rolo-to-buffer (current-buffer))
 358       ;; Fixes non-display update bug when buf is on screen before
 359       ;; interactive command invocation.
 360       (goto-char (point))
 361       (if (interactive-p)
 362           (message "Edit entry at point.")))))
 363
 364 ;;;###autoload
 365 (defun rolo-display-matches (&optional display-buf return-to-buffer)
 366   "Display optional DISPLAY-BUF buffer of previously found rolodex matches.
 367 If DISPLAY-BUF is nil, use the value in 'rolo-display-buffer'.
 368 Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display."
 369   (interactive)
 370   (or display-buf (setq display-buf (get-buffer rolo-display-buffer)))
 371   (if display-buf nil
 372     (error "(rolo-display-matches): Search the rolodex first."))
 373   ;; Save current window configuration if rolodex match buffer is not
 374   ;; displayed in one of the windows already.
 375   (or
 376    ;; Handle both Emacs V18 and V19 versions of get-buffer-window.
 377    (condition-case ()
 378        (get-buffer-window display-buf (selected-frame))
 379      (error (get-buffer-window display-buf)))
 380    (setq *rolo-wconfig* (current-window-configuration)))
 381   (rolo-to-buffer display-buf t)
 382   (if (eq major-mode 'wrolo-mode) nil (wrolo-mode))
 383   (setq buffer-read-only nil)
 384   (if (fboundp 'hproperty:but-create) (hproperty:but-create))
 385   (rolo-shrink-window)
 386   (goto-char (point-min))
 387   (set-buffer-modified-p nil)
 388   (setq buffer-read-only t)
 389   (run-hooks 'wrolo-display-hook)
 390   ;; Leave point in match buffer unless a specific RETURN-TO-BUFFER has
 391   ;; been specified.  Use {q} to quit and restore display.
 392   (if return-to-buffer (rolo-to-buffer return-to-buffer t)))
 393
 394 ;;;###autoload
 395 (defun rolo-edit (&optional name file)
 396   "Edits a rolodex entry given by optional NAME within 'rolo-file-list'.
 397 With prefix argument, prompts for optional FILE to locate entry within.
 398 With no NAME arg, simply displays FILE or first entry in 'rolo-file-list' in an
 399 editable mode.  NAME may be of the form: parent/child to edit child below a
 400 parent entry which begins with the parent string."
 401   (interactive "sName to edit in rolo: \nP")
 402   (if (string-equal name "") (setq name nil))
 403   (and name (not (stringp name))
 404        (error "(rolo-edit): Invalid name: '%s'" name))
 405   (if (and (interactive-p) current-prefix-arg)
 406       (if (= (length rolo-file-list) 1)
 407           (setq file (car rolo-file-list))
 408         (setq file (completing-read "Entry's File: "
 409                                     (mapcar 'list rolo-file-list)))))
 410   (let ((found-point) (file-list (if file (list file) rolo-file-list)))
 411     (or file (setq file (car file-list)))
 412     (if (null name)
 413         (progn (if (not (file-writable-p file))
 414                   (error "(rolo-edit): File not writable: '%s'" file))
 415                (find-file-other-window file) (setq buffer-read-only nil))
 416       (if (setq found-point (rolo-to name file-list))
 417           (progn
 418             (setq file buffer-file-name)
 419             (if (file-writable-p file)
 420                 (setq buffer-read-only nil)
 421               (message
 422                "(rolo-edit): Entry found but file not writable: '%s'" file)
 423               (beep))
 424             (rolo-to-buffer (current-buffer)))
 425         (message "(rolo-edit): '%s' not found." name)
 426         (beep)
 427         (rolo-to-buffer (or (get-file-buffer (car file-list))
 428                             (find-file-noselect (car file-list))))
 429         (setq buffer-read-only nil))
 430       (widen)
 431       ;; Fixes display update bug in some Emacs versions.  When buf is
 432       ;; on screen before interactive command invocation, point is not
 433       ;; moved to proper location.
 434       (if found-point (goto-char found-point)))))
 435
 436 (defun rolo-edit-entry ()
 437   "Edit the source entry of the rolodex match buffer entry at point.
 438 Returns entry name if found, else nil."
 439   (interactive)
 440   (let ((name (rolo-name-at)))
 441     (if name (progn (rolo-edit name (hbut:key-src))
 442                     name))))
 443
 444 ;;;###autoload
 445 (defun rolo-fgrep (string
 446                     &optional max-matches rolo-file count-only no-display)
 447   "Display rolodex entries matching STRING.
 448 To a maximum of optional prefix arg MAX-MATCHES, in file(s) from optional
 449 ROLO-FILE or rolo-file-list.  Default is to find all matching entries.  Each
 450 entry is displayed with all of its sub-entries.  Optional COUNT-ONLY non-nil
 451 means don't retrieve and don't display matching entries.  Optional NO-DISPLAY
 452 non-nil means retrieve entries but don't display.
 453
 454 Nil value of MAX-MATCHES means find all matches, t value means find all matches
 455 but omit file headers, negative values mean find up to the inverse of that
 456 number of entries and omit file headers.
 457
 458 Returns number of entries matched.  See also documentation for the variable
 459 rolo-file-list."
 460   (interactive "sRolodex string to match: \nP")
 461   (let ((total-matches (rolo-grep (regexp-quote string) max-matches
 462                                   rolo-file count-only no-display)))
 463     (if (interactive-p)
 464         (message "%s matching entr%s found in rolodex."
 465                  (if (= total-matches 0) "No" total-matches)
 466                  (if (= total-matches 1) "y" "ies")))
 467     total-matches))
 468
 469 ;;;###autoload
 470 (defun rolo-grep (regexp &optional max-matches rolo-bufs count-only no-display)
 471   "Display rolodex entries matching REGEXP.
 472 To a maximum of prefix arg MAX-MATCHES, in buffer(s) from optional ROLO-BUFS or
 473 rolo-file-list.  Default is to find all matching entries.  Each entry is
 474 displayed with all of its sub-entries.  Optional COUNT-ONLY non-nil means don't
 475 retrieve and don't display matching entries.  Optional NO-DISPLAY non-nil
 476 means retrieve entries but don't display.
 477
 478 Nil value of MAX-MATCHES means find all matches, t value means find all matches
 479 but omit file headers, negative values mean find up to the inverse of that
 480 number of entries and omit file headers.
 481
 482 Returns number of entries matched.  See also documentation for the variable
 483 rolo-file-list."
 484   (interactive "sRolodex regular expression to match: \nP")
 485   (let ((rolo-file-list
 486          (cond ((null rolo-bufs) rolo-file-list)
 487                ((listp rolo-bufs) rolo-bufs)
 488                ((list rolo-bufs))))
 489         (display-buf (if count-only
 490                          nil
 491                        (set-buffer (get-buffer-create rolo-display-buffer))))
 492         (total-matches 0)
 493         (num-matched 0)
 494         (inserting (or (eq max-matches t)
 495                        (and (integerp max-matches) (< max-matches 0))))
 496         (file))
 497     (if count-only nil
 498       (setq buffer-read-only nil)
 499       (or inserting (erase-buffer)))
 500     (while (and (setq file (car rolo-file-list))
 501                 (or (not (integerp max-matches))
 502                     (< total-matches (max max-matches (- max-matches)))))
 503       (setq rolo-file-list (cdr rolo-file-list)
 504             num-matched (rolo-grep-file file regexp max-matches count-only)
 505             total-matches (+ total-matches num-matched))
 506       (if (integerp max-matches)
 507           (setq max-matches
 508                 (if (>= max-matches 0)
 509                     (- max-matches num-matched)
 510                   (+ max-matches num-matched)))))
 511     (if (or count-only no-display inserting (= total-matches 0))
 512         nil
 513       (rolo-display-matches display-buf))
 514     (if (interactive-p)
 515         (message "%s matching entr%s found in rolodex."
 516                  (if (= total-matches 0) "No" total-matches)
 517                  (if (= total-matches 1) "y" "ies")
 518                  ))
 519     total-matches))
 520
 521 (defun rolo-isearch ()
 522   "Interactively search forward for next occurrence of current match regexp.
 523 Use this to add characters to further narrow the search."
 524   (interactive)
 525   (if (equal (buffer-name) rolo-display-buffer)
 526       (execute-kbd-macro (concat "\e\C-s" rolo-match-regexp))
 527     (error "(rolo-isearch): Use this command in the %s match buffer"
 528            rolo-display-buffer)))
 529
 530 ;;;###autoload
 531 (defun rolo-kill (name &optional file)
 532   "Kills a rolodex entry given by NAME within 'rolo-file-list'.
 533 With prefix argument, prompts for optional FILE to locate entry within.
 534 NAME may be of the form: parent/child to kill child below a parent entry
 535 which begins with the parent string.
 536 Returns t if entry is killed, nil otherwise."
 537   (interactive "sName to kill in rolo: \nP")
 538   (if (or (not (stringp name)) (string= name ""))
 539       (error "(rolo-kill): Invalid name: '%s'" name))
 540   (if (and (interactive-p) current-prefix-arg)
 541       (setq file (completing-read "Entry's File: "
 542                                   (mapcar 'list rolo-file-list))))
 543   (let ((file-list (if file (list file) rolo-file-list))
 544         (killed))
 545     (or file (setq file (car file-list)))
 546     (if (rolo-to name file-list)
 547         (progn
 548           (setq file buffer-file-name)
 549           (if (file-writable-p file)
 550               (let ((kill-op
 551                      (function (lambda (start level)
 552                                  (kill-region
 553                                   start (rolo-to-entry-end t level))
 554                                  (setq killed t)
 555                                  (rolo-save-buffer)
 556                                  (rolo-kill-buffer))))
 557                     start end level)
 558                 (setq buffer-read-only nil)
 559                 (re-search-backward rolo-entry-regexp nil t)
 560                 (setq end (match-end 0))
 561                 (beginning-of-line)
 562                 (setq start (point)
 563                       level (buffer-substring start end))
 564                 (goto-char end)
 565                 (skip-chars-forward " \t")
 566                 (if (interactive-p)
 567                     (let ((entry-line (buffer-substring
 568                                        (point)
 569                                        (min (+ (point) 60)
 570                                             (progn (end-of-line) (point))))))
 571                       (if (y-or-n-p (format "Kill `%s...' " entry-line))
 572                           (progn
 573                             (funcall kill-op start level)
 574                             (message "Killed"))
 575                         (message "Aborted")))
 576                   (funcall kill-op start level)))
 577             (message
 578              "(rolo-kill): Entry found but file not writable: '%s'" file)
 579             (beep)))
 580       (message "(rolo-kill): '%s' not found." name)
 581       (beep))
 582     killed))
 583
 584 (defun rolo-mail-to ()
 585   "Start composing mail addressed to the first e-mail address at or after point."
 586   (interactive)
 587   (let ((opoint (point)) button)
 588     (skip-chars-backward "^ \t\n\r<>")
 589     (if (and (re-search-forward mail-address-regexp nil t)
 590              (goto-char (match-beginning 1))
 591              (setq button (ibut:at-p)))
 592         (hui:hbut-act button)
 593       (goto-char opoint)
 594       (beep)
 595       (message "(rolo-mail-to): Invalid buffer or no e-mail address found"))))
 596
 597 (defun rolo-next-match ()
 598   "Move point forward to the start of the next rolodex search match."
 599   (interactive)
 600   (if (not (stringp rolo-match-regexp))
 601       (error "(rolo-next-match): Invoke a rolodex search expression first"))
 602   (let ((start (point))
 603         (case-fold-search t))
 604     (if (looking-at rolo-match-regexp)
 605         (goto-char (match-end 0)))
 606     (if (re-search-forward rolo-match-regexp nil t)
 607         (goto-char (match-beginning 0))
 608       (goto-char start)
 609       (error
 610        "(rolo-next-match): No following matches for \"%s\"" rolo-match-regexp))))
 611
 612 (defun rolo-previous-match ()
 613   "Move point back to the start of the previous rolodex search match."
 614   (interactive)
 615   (if (not (stringp rolo-match-regexp))
 616       (error "(rolo-previous-match): Invoke a rolodex search expression first"))
 617   (let ((case-fold-search t))
 618     (if (re-search-backward rolo-match-regexp nil t)
 619         nil
 620       (error
 621        "(rolo-previous-match): No prior matches for \"%s\"" rolo-match-regexp))))
 622
 623 (defun rolo-quit ()
 624   "Quit from the rolodex match buffer and restore the prior frame display."
 625   (interactive)
 626   (bury-buffer)
 627   (if (and *rolo-wconfig*
 628            (if (fboundp 'window-configuration-p)
 629                (window-configuration-p *rolo-wconfig*)
 630              t))
 631       (set-window-configuration *rolo-wconfig*)))
 632
 633 ;;;###autoload
 634 (defun rolo-sort (&optional rolo-file)
 635   "Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo).
 636 Assumes entries are delimited by one or more '*'characters.
 637 Returns list of number of groupings at each entry level."
 638   (interactive
 639    (list (let ((default "")
 640                (file))
 641          (setq file
 642                (completing-read
 643                 (format "Sort rolo file (default %s): "
 644                         (file-name-nondirectory
 645                          (setq default
 646                                (if (and buffer-file-name
 647                                         (memq
 648                                          t (mapcar
 649                                             (function
 650                                              (lambda (file)
 651                                                (equal buffer-file-name
 652                                                       (expand-file-name file))))
 653                                             rolo-file-list)))
 654                                    buffer-file-name
 655                                  (car rolo-file-list)))))
 656                 (mapcar 'list rolo-file-list)))
 657          (if (string= file "") default file))))
 658   (if (or (not rolo-file) (equal rolo-file ""))
 659       (setq rolo-file (car rolo-file-list)))
 660   (if (not (and (stringp rolo-file) (file-readable-p rolo-file)))
 661       (error "(rolo-sort): Invalid or unreadable file: %s" rolo-file))
 662   (let ((level-regexp (regexp-quote "**************"))
 663         (entries-per-level-list)
 664         (n))
 665     (while (not (equal level-regexp ""))
 666       (setq n (rolo-sort-level rolo-file level-regexp))
 667       (if (or (/= n 0) entries-per-level-list)
 668           (setq entries-per-level-list
 669                 (append (list n) entries-per-level-list)))
 670       (setq level-regexp (substring level-regexp 0 (- (length level-regexp) 2))))
 671     entries-per-level-list))
 672
 673 (defun rolo-sort-level (rolo-file level-regexp &optional max-groupings)
 674   "Sorts groupings of entries in ROLO-FILE at hierarchy level LEVEL-REGEXP.
 675 To a maximum of optional MAX-GROUPINGS.  Nil value of MAX-GROUPINGS means all
 676 groupings at the given level.  LEVEL-REGEXP should simply match the text of
 677 any rolodex entry of the given level, not the beginning of a line (^); an
 678 example, might be (regexp-quote \"**\") to match level two.  Returns number
 679 of groupings sorted."
 680   (interactive "sRolodex file to sort: \nRegexp for level's entries: \nP")
 681   (rolo-map-level
 682    (function (lambda (start end) (sort-lines nil start end)))
 683    rolo-file
 684    level-regexp
 685    max-groupings))
 686
 687 (defun rolo-toggle-narrow-to-entry ()
 688   "Toggle between display of current entry and display of all matched entries.
 689 Useful when bound to a mouse key."
 690   (interactive)
 691   (if (rolo-narrowed-p)
 692       (widen)
 693     (if (or (looking-at rolo-entry-regexp)
 694             (re-search-backward rolo-entry-regexp nil t))
 695         (progn (forward-char)
 696                (narrow-to-region (1- (point)) (rolo-display-to-entry-end)))))
 697   (rolo-shrink-window)
 698   (goto-char (point-min)))
 699
 700 (defun rolo-word (string
 701                   &optional max-matches rolo-file count-only no-display)
 702   "Display rolodex entries with whole word matches for STRING.
 703 To a maximum of optional prefix arg MAX-MATCHES, in file(s) from optional
 704 ROLO-FILE or rolo-file-list.  Default is to find all matching entries.  Each
 705 entry is displayed with all of its sub-entries.  Optional COUNT-ONLY non-nil
 706 means don't retrieve and don't display matching entries.  Optional NO-DISPLAY
 707 non-nil means retrieve entries but don't display.
 708
 709 Nil value of MAX-MATCHES means find all matches, t value means find all matches
 710 but omit file headers, negative values mean find up to the inverse of that
 711 number of entries and omit file headers.
 712
 713 Returns number of entries matched.  See also documentation for the variable
 714 rolo-file-list."
 715   (interactive "sRolodex whole words to match: \nP")
 716   (let ((total-matches (rolo-grep (format "\\b%s\\b" (regexp-quote string))
 717                                   max-matches
 718                                   rolo-file count-only no-display)))
 719     (if (interactive-p)
 720         (message "%s matching entr%s found in rolodex."
 721                  (if (= total-matches 0) "No" total-matches)
 722                  (if (= total-matches 1) "y" "ies")))
 723     total-matches))
 724
 725 ;;;###autoload
 726 (defun rolo-yank (name &optional regexp-p)
 727   "Inserts at point the first rolodex entry matching NAME.
 728 With optional prefix arg, REGEXP-P, treats NAME as a regular expression instead
 729 of a string."
 730   (interactive "sName to insert record for: \nP")
 731   (let ((rolo-display-buffer (current-buffer))
 732         (start (point))
 733         found)
 734     (save-excursion
 735       (setq found (if regexp-p
 736                       (rolo-grep name -1)
 737                     (rolo-grep (regexp-quote name) -1))))
 738     ;; Let user reformat the region just yanked.
 739     (if (and (= found 1) (fboundp wrolo-yank-reformat-function))
 740         (funcall wrolo-yank-reformat-function start (point)))
 741     found))
 742
 743 ;;;
 744 ;;; Public functions
 745 ;;;
 746
 747 (defun rolo-fgrep-file (rolo-buf string &optional max-matches count-only)
 748   "Retrieve entries in ROLO-BUF matching STRING to a maximum of optional MAX-MATCHES.
 749 Nil value of MAX-MATCHES means find all matches, t value means find all matches
 750 but omit file headers, negative values mean find up to the inverse of that
 751 number of entries and omit file headers.  Optional COUNT-ONLY non-nil
 752 means don't retrieve matching entries.
 753 Returns number of matching entries found."
 754   (rolo-grep-file rolo-buf (regexp-quote string) max-matches count-only))
 755
 756 (defun rolo-grep-file (rolo-buf regexp &optional max-matches count-only)
 757   "Retrieve entries in ROLO-BUF matching REGEXP to a maximum of optional MAX-MATCHES.
 758 Nil value of MAX-MATCHES means find all matches, t value means find all matches
 759 but omit file headers, negative values mean find up to the inverse of that
 760 number of entries and omit file headers.  Optional COUNT-ONLY non-nil
 761 means don't retrieve matching entries.
 762 Returns number of matching entries found."
 763   ;;
 764   ;; Save regexp as last rolodex search expression.
 765   (setq rolo-match-regexp regexp)
 766   ;;
 767   (let ((new-buf-p) (actual-buf))
 768     (if (and (or (null max-matches) (eq max-matches t) (integerp max-matches))
 769              (or (setq actual-buf (rolo-buffer-exists-p rolo-buf))
 770                  (if (file-exists-p rolo-buf)
 771                      (setq actual-buf (find-file-noselect rolo-buf t)
 772                            new-buf-p t))))
 773         (let ((hdr-pos) (num-found 0) (curr-entry-level)
 774               (incl-hdr t))
 775           (if max-matches
 776               (cond ((eq max-matches t)
 777                      (setq incl-hdr nil max-matches nil))
 778                     ((< max-matches 0)
 779                      (setq incl-hdr nil
 780                            max-matches (- max-matches)))))
 781           (set-buffer actual-buf)
 782           (if new-buf-p (setq buffer-read-only t))
 783           (save-excursion
 784             (save-restriction
 785               (widen)
 786               (goto-char 1)
 787               ;; Ensure no entries in outline mode are hidden.
 788               ;; Uses 'show-all' function from outline.el.
 789               (and (search-forward "\C-m" nil t)
 790                    (show-all))
 791               (if (re-search-forward rolo-hdr-regexp nil t 2)
 792                   (progn (forward-line)
 793                          (setq hdr-pos (cons (point-min) (point)))))
 794               (re-search-forward rolo-entry-regexp nil t)
 795               (while (and (or (null max-matches) (< num-found max-matches))
 796                           (re-search-forward regexp nil t))
 797                 (re-search-backward rolo-entry-regexp nil t)
 798                 (let ((start (point))
 799                       (next-entry-exists))
 800                   (re-search-forward rolo-entry-regexp nil t)
 801                   (setq curr-entry-level (buffer-substring start (point)))
 802                   (rolo-to-entry-end t curr-entry-level)
 803                   (or count-only
 804                       (if (and (= num-found 0) incl-hdr)
 805                           (let* ((src (or (buffer-file-name actual-buf)
 806                                           actual-buf))
 807                                  (src-line
 808                                    (format
 809                                      (concat (if (boundp 'hbut:source-prefix)
 810                                                  hbut:source-prefix
 811                                                "@loc> ")
 812                                              "%s")
 813                                      (prin1-to-string src))))
 814                             (set-buffer rolo-display-buffer)
 815                             (goto-char (point-max))
 816                             (if hdr-pos
 817                                 (progn
 818                                   (insert-buffer-substring
 819                                     actual-buf (car hdr-pos) (cdr hdr-pos))
 820                                   (insert src-line "\n\n"))
 821                               (insert (format rolo-hdr-format src-line)))
 822                             (set-buffer actual-buf))))
 823                   (setq num-found (1+ num-found))
 824                   (or count-only
 825                       (rolo-add-match rolo-display-buffer regexp start (point)))))))
 826           (rolo-kill-buffer actual-buf)
 827           num-found)
 828       0)))
 829
 830 (defun rolo-map-level (func rolo-buf level-regexp &optional max-groupings)
 831   "Perform FUNC on groupings of ROLO-BUF entries at level LEVEL-REGEXP,
 832 to a maximum of optional argument MAX-GROUPINGS.  Nil value of MAX-GROUPINGS
 833 means all groupings at the given level.  FUNC should take two arguments, the
 834 start and the end of the region that it should manipulate.  LEVEL-REGEXP
 835 should simply match the text of any rolodex entry of the given level, not the
 836 beginning of a line (^); an example, might be (regexp-quote \"**\") to match
 837 level two.  Returns number of groupings matched."
 838   (let ((actual-buf))
 839     (if (and (or (null max-groupings) (< 0 max-groupings))
 840              (or (setq actual-buf (rolo-buffer-exists-p rolo-buf))
 841                  (if (file-exists-p rolo-buf)
 842                      (progn (setq actual-buf (find-file-noselect rolo-buf t))
 843                             t))))
 844         (progn
 845           (set-buffer actual-buf)
 846           (let ((num-found 0)
 847                 (exact-level-regexp (concat "^\\(" level-regexp "\\)[ \t\n]"))
 848                 (outline-regexp rolo-entry-regexp)
 849                 (buffer-read-only)
 850                 (level-len))
 851             ;; Load 'outline' library since its functions are used here.
 852             (if (not (boundp 'outline-mode-map))
 853                 (load-library "outline"))
 854             (goto-char (point-min))
 855             ;; Pass buffer header if it exists
 856             (if (re-search-forward rolo-hdr-regexp nil t 2)
 857                 (forward-line))
 858             (while (and (or (null max-groupings) (< num-found max-groupings))
 859                         (re-search-forward exact-level-regexp nil t))
 860               (setq num-found (1+ num-found))
 861               (let* ((opoint (prog1 (point) (beginning-of-line)))
 862                      (grouping-start (point))
 863                      (start grouping-start)
 864                      (level-len (or level-len (- (1- opoint) start)))
 865                      (next-level-len)
 866                      (next-entry-exists)
 867                      (grouping-end)
 868                      (no-subtree))
 869                 (while (and (progn
 870                               (if (setq next-entry-exists
 871                                         (re-search-forward
 872                                          rolo-entry-regexp nil t 2))
 873                                   (setq next-level-len
 874                                         (- (point)
 875                                            (progn (beginning-of-line)
 876                                                   (point)))
 877                                         grouping-end
 878                                         (< next-level-len level-len)
 879                                         no-subtree
 880                                         (<= next-level-len level-len))
 881                                 (setq grouping-end t no-subtree t)
 882                                 (goto-char (point-max)))
 883                               (let ((end (point)))
 884                                 (goto-char start)
 885                                 (hide-subtree) ; And hide multiple entry lines
 886                                 ;; Move to start of next entry at equal
 887                                 ;; or higher level.
 888                                 (setq start
 889                                       (if no-subtree
 890                                           end
 891                                         (if (re-search-forward
 892                                              rolo-entry-regexp nil t)
 893                                             (progn (beginning-of-line) (point))
 894                                           (point-max))))
 895                                 ;; Remember last expression in 'progn'
 896                                 ;; must always return non-nil.
 897                                 (goto-char start)))
 898                             (not grouping-end)))
 899                 (let ((end (point)))
 900                   (goto-char grouping-start)
 901                   (funcall func grouping-start end)
 902                   (goto-char end))))
 903             (show-all)
 904             (rolo-kill-buffer actual-buf)
 905             num-found))
 906       0)))
 907
 908 ;;;
 909 ;;; Private functions
 910 ;;;
 911
 912 (defun rolo-add-match (rolo-matches-buffer regexp start end)
 913   "Insert before point in ROLO-MATCHES-BUFFER an entry matching REGEXP from the current region between START to END."
 914   (let ((rolo-buf (current-buffer))
 915         opoint)
 916     (set-buffer (get-buffer-create rolo-matches-buffer))
 917     (setq opoint (point))
 918     (insert-buffer-substring rolo-buf start end)
 919     (rolo-highlight-matches regexp opoint (point))
 920     (set-buffer rolo-buf)))
 921
 922 (defun rolo-buffer-exists-p (rolo-buf)
 923   "Returns buffer given by ROLO-BUF or nil.
 924 ROLO-BUF may be a file-name, buffer-name, or buffer."
 925   (car (memq (get-buffer (or (and (stringp rolo-buf)
 926                                   (get-file-buffer rolo-buf))
 927                              rolo-buf))
 928              (buffer-list))))
 929
 930 (defun rolo-display-to-entry-end ()
 931   "Go to end of current entry, ignoring sub-entries."
 932   (if (re-search-forward (concat rolo-hdr-regexp "\\|"
 933                                  rolo-entry-regexp) nil t)
 934       (progn (beginning-of-line) (point))
 935     (goto-char (point-max))))
 936
 937
 938 (defun rolo-format-name (name-str first last)
 939   "Reverse order of NAME-STR field given my regexp match field FIRST and LAST."
 940   (if (match-beginning last)
 941       (concat (substring name-str (match-beginning last) (match-end last))
 942               ", "
 943               (substring name-str (match-beginning first) (match-end first)))))
 944
 945 (defun rolo-highlight-matches (regexp start end)
 946   "Highlight matches for REGEXP in region from START to END."
 947   (if (fboundp 'hproperty:but-add)
 948       (let ((hproperty:but-emphasize-p))
 949         (save-excursion
 950           (goto-char start)
 951           (while (re-search-forward regexp nil t)
 952             (hproperty:but-add (match-beginning 0) (match-end 0)
 953                                (or rolo-highlight-face
 954                                    hproperty:highlight-face)))))))
 955
 956 (defun rolo-kill-buffer (&optional rolo-buf)
 957   "Kills optional ROLO-BUF if unchanged and 'rolo-kill-buffers-after-use' is t.
 958 Default is current buffer."
 959   (or rolo-buf (setq rolo-buf (current-buffer)))
 960   (and rolo-kill-buffers-after-use (not (buffer-modified-p rolo-buf))
 961        (kill-buffer rolo-buf)))
 962
 963 (defun rolo-name-and-email ()
 964   "If point is in a mail message, returns list of (name email-addr) of sender.
 965 Name is returned as 'last, first-and-middle'."
 966   (let ((email) (name) (from))
 967     (save-window-excursion
 968       (if (or (hmail:lister-p) (hnews:lister-p))
 969           (other-window 1))
 970       (save-excursion
 971         (save-restriction
 972           (goto-char (point-min))
 973           (if (search-forward "\n\n" nil t)
 974               (narrow-to-region (point-min) (point)))
 975           (setq email (mail-fetch-field "reply-to")
 976                 from  (mail-fetch-field "from")))))
 977     (if from
 978         (cond
 979          ;; Match: email, email (name), email "name"
 980          ((string-match
 981            (concat "^\\([^\"<>() \t\n]+\\)"
 982                    "\\([ \t]*[(\"][ \t]*\\([^\"()]+\\)[ \t]+"
 983                    "\\([^\" \t()]+\\)[ \t]*[)\"]\\)?[ \t]*$")
 984            from)
 985           (setq name (rolo-format-name from 3 4))
 986           (or email (setq email (substring from (match-beginning 1)
 987                                            (match-end 1)))))
 988          ;; Match: <email>, name <email>, "name" <email>
 989          ((string-match
 990            (concat "^\\(\"?\\([^\"<>()\n]+\\)[ \t]+"
 991                    "\\([^\" \t()<>]+\\)\"?[ \t]+\\)?"
 992                    "<\\([^\"<>() \t\n]+\\)>[ \t]*$")
 993            from)
 994           (setq name (rolo-format-name from 2 3))
 995           (or email (setq email (substring from (match-beginning 4)
 996                                            (match-end 4)))))))
 997     (if (or name email)
 998         (list name email))))
 999
1000 (defun rolo-name-at ()
1001   "If point is within an entry in 'rolo-display-buffer', returns entry, else nil."
1002   (if (string-equal (buffer-name) rolo-display-buffer)
1003       (save-excursion
1004         (if (or (looking-at rolo-entry-regexp)
1005                 (progn (end-of-line)
1006                        (re-search-backward rolo-entry-regexp nil t)))
1007             (progn (goto-char (match-end 0))
1008                    (skip-chars-forward " \t")
1009                    (if (or (looking-at "[^ \t\n\^M]+ ?, ?[^ \t\n\^M]+")
1010                            (looking-at "\\( ?[^ \t\n\^M]+\\)+"))
1011                        (buffer-substring (match-beginning 0)
1012                                          (match-end 0))))))))
1013
1014 (defun rolo-narrowed-p ()
1015   (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max))))
1016
1017 (defun rolo-save-buffer (&optional rolo-buf)
1018   "Saves optional ROLO-BUF if changed and 'rolo-save-buffers-after-use' is t.
1019 Default is current buffer.  Used, for example, after a rolo entry is killed."
1020   (or rolo-buf (setq rolo-buf (current-buffer)))
1021   (and rolo-save-buffers-after-use (buffer-modified-p rolo-buf)
1022        (set-buffer rolo-buf) (save-buffer)))
1023
1024 (defun rolo-shrink-window ()
1025   (let* ((lines (count-lines (point-min) (point-max)))
1026          (height (window-height))
1027          (window-min-height 2)
1028          (desired-shrinkage (1- (min (- height lines)))))
1029     (and (>= lines 0)
1030          (/= desired-shrinkage 0)
1031          (> (frame-height) (1+ height))
1032          (shrink-window
1033            (if (< desired-shrinkage 0)
1034                (max desired-shrinkage (- height (/ (frame-height) 2)))
1035   (min desired-shrinkage (- height window-min-height)))))))
1036
1037 (defun rolo-to (name &optional file-list)
1038   "Moves point to entry for NAME within optional FILE-LIST.
1039 'rolo-file-list' is used as default when FILE-LIST is nil.
1040 Leaves point immediately after match for NAME within entry.
1041 Switches internal current buffer but does not alter the frame.
1042 Returns point where matching entry begins or nil if not found."
1043   (or file-list (setq file-list rolo-file-list))
1044   (let ((found) file)
1045     (while (and (not found) file-list)
1046       (setq file (car file-list)
1047             file-list (cdr file-list))
1048       (cond ((and file (or (not (stringp file)) (string= file "")))
1049              (error "(rolo-to): Invalid file: '%s'" file))
1050             ((and (file-exists-p file) (not (file-readable-p file)))
1051              (error "(rolo-to): File not readable: '%s'" file)))
1052       (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
1053       (let ((case-fold-search t) (real-name name) (parent "") (level) end)
1054         (widen) (goto-char 1)
1055         (while (setq end (string-match "/" name))
1056           (setq level nil
1057                 parent (substring name 0 end)
1058                 name (substring name (min (1+ end) (length name))))
1059           (cond ((progn
1060                    (while (and (not level) (search-forward parent nil t))
1061                      (save-excursion
1062                        (beginning-of-line)
1063                        (if (looking-at
1064                             (concat "\\(" rolo-entry-regexp "\\)[ \t]*"
1065                                     (regexp-quote parent)))
1066                            (setq level (buffer-substring (match-beginning 1)
1067                                                          (match-end 1))))))
1068                    level))
1069                 ((equal name real-name));; Try next file.
1070                 (t;; Found parent but not child
1071                  (setq buffer-read-only nil)
1072                  (rolo-to-buffer (current-buffer))
1073                  (error "(rolo-to): '%s' part of name not found in \"%s\"."
1074                         parent file)))
1075           (if level
1076               (narrow-to-region (point)
1077                                 (save-excursion
1078                                   (rolo-to-entry-end t level) (point)))))
1079         (goto-char (point-min))
1080         (while (and (search-forward name nil t)
1081                     (not (save-excursion
1082                            (beginning-of-line)
1083                            (setq found
1084                                  (if (looking-at
1085                                       (concat "\\(" rolo-entry-regexp
1086                                               "\\)[ \t]*"
1087                                               (regexp-quote name)))
1088                                      (point))))))))
1089       (or found (rolo-kill-buffer))) ;; conditionally kill
1090     (widen)
1091     found))
1092
1093 (defun rolo-to-buffer (buffer &optional other-window-flag frame)
1094   "Pop to BUFFER."
1095   (cond (hyperb:xemacs-p
1096           (pop-to-buffer buffer other-window-flag
1097                          ;; default is to use selected frame
1098                          (or frame (selected-frame))))
1099         (t (pop-to-buffer buffer other-window-flag))))
1100
1101 (defun rolo-to-entry-end (&optional include-sub-entries curr-entry-level)
1102 "Goes to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil.
1103 CURR-ENTRY-LEVEL is a string whose length is the same as the last found entry
1104 header.  If INCLUDE-SUB-ENTRIES is nil, CURR-ENTRY-LEVEL is not needed.
1105 Returns current point."
1106   (while (and (setq next-entry-exists
1107                     (re-search-forward rolo-entry-regexp nil t))
1108               include-sub-entries
1109               (> (- (point) (save-excursion
1110                               (beginning-of-line)
1111                               (point)))
1112                  (length curr-entry-level))))
1113   (if next-entry-exists
1114       (progn (beginning-of-line) (point))
1115     (goto-char (point-max))))
1116
1117 (defun wrolo-mode ()
1118   "Major mode for the rolodex match buffer.
1119 Calls the functions given by `wrolo-mode-hook'.
1120 \\{wrolo-mode-map}"
1121   (interactive)
1122   (setq major-mode 'wrolo-mode
1123         mode-name "Rolodex")
1124   (use-local-map wrolo-mode-map)
1125   ;;
1126   ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing
1127   ;; otherwise.
1128   (and (not (featurep 'wrolo-menu)) hyperb:window-system
1129        (or hyperb:xemacs-p hyperb:emacs19-p) (require 'wrolo-menu))
1130   ;;
1131   (if (not (fboundp 'outline-minor-mode))
1132       nil
1133     (outline-minor-mode 1))
1134   (run-hooks 'wrolo-mode-hook))
1135
1136 ;;;
1137 ;;; Private variables
1138 ;;;
1139
1140 (defvar rolo-display-buffer "*Rolodex*"
1141   "Buffer used to display set of last matching rolodex entries.")
1142
1143 (defvar rolo-entry-regexp "^\\*+"
1144   "Regular expression to match the beginning of a rolodex entry.
1145 This pattern must match the beginning of the line.  Entries may be nested
1146 through the use of increasingly longer beginning patterns.")
1147
1148 (defconst rolo-hdr-format
1149   (concat
1150    "======================================================================\n"
1151    "%s\n"
1152    "======================================================================\n")
1153   "Header to insert preceding a file's first rolodex entry match when
1154 file has none of its own.  Used with one argument, the file name."
1155 )
1156
1157 (defconst rolo-hdr-regexp "^==="
1158   "Regular expression to match the first and last lines of rolodex file headers.
1159 This header is inserted into rolo-display-buffer before any entries from the
1160 file are added.")
1161
1162 (defconst rolo-match-regexp nil
1163   "Last regular expression used to search the rolodex.
1164 Nil before a search is done.
1165 String search expressions are converted to regular expressions.")
1166
1167 (defvar *rolo-wconfig* nil
1168   "Saves frame's window configuration prior to a rolodex search.")
1169
1170 (defvar wrolo-mode-map nil
1171   "Keymap for the rolodex match buffer.")
1172
1173 (if wrolo-mode-map
1174     nil
1175   (setq wrolo-mode-map (make-keymap))
1176   (if (fboundp 'set-keymap-name)
1177       (set-keymap-name wrolo-mode-map 'wrolo-mode-map))
1178   (suppress-keymap wrolo-mode-map)
1179   (define-key wrolo-mode-map "<"        'beginning-of-buffer)
1180   (define-key wrolo-mode-map ">"        'end-of-buffer)
1181   (define-key wrolo-mode-map "."        'beginning-of-buffer)
1182   (define-key wrolo-mode-map ","        'end-of-buffer)
1183   (define-key wrolo-mode-map "?"        'describe-mode)
1184   (define-key wrolo-mode-map "\177"     'scroll-down)
1185   (define-key wrolo-mode-map " "        'scroll-up)
1186   (define-key wrolo-mode-map "a"        'show-all)
1187   (define-key wrolo-mode-map "b"        'outline-backward-same-level)
1188   (define-key wrolo-mode-map "e"        'rolo-edit-entry)
1189   (define-key wrolo-mode-map "f"        'outline-forward-same-level)
1190   (define-key wrolo-mode-map "h"        'hide-subtree)
1191   (define-key wrolo-mode-map "m"        'rolo-mail-to)
1192   (define-key wrolo-mode-map "n"        'outline-next-visible-heading)
1193   (define-key wrolo-mode-map "p"        'outline-previous-visible-heading)
1194   (define-key wrolo-mode-map "q"        'rolo-quit)
1195   (define-key wrolo-mode-map "r"        'rolo-previous-match)
1196   (define-key wrolo-mode-map "s"        'show-subtree)
1197   (define-key wrolo-mode-map "\M-s"     'rolo-isearch)
1198   (define-key wrolo-mode-map "t"        'hide-body)
1199   (define-key wrolo-mode-map "\C-i"     'rolo-next-match)      ;; {TAB}
1200   (define-key wrolo-mode-map "\M-\C-i"  'rolo-previous-match)  ;; {M-TAB}
1201   (define-key wrolo-mode-map "u"        'outline-up-heading)
1202   )
1203
1204 (provide 'wrolo)
1205
1206 ;;; wrolo.el ends here