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