comparison lisp/hyperbole/wrolo.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents c53a95d3c46d
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
6 ;; SUMMARY: Hierarchical, multi-file, easy to use rolodex system 6 ;; SUMMARY: Hierarchical, multi-file, easy to use rolodex system
7 ;; USAGE: GNU Emacs Lisp Library 7 ;; USAGE: GNU Emacs Lisp Library
8 ;; KEYWORDS: hypermedia, matching 8 ;; KEYWORDS: hypermedia, matching
9 ;; 9 ;;
10 ;; AUTHOR: Bob Weiner 10 ;; AUTHOR: Bob Weiner
11 ;; 11 ;; ORG: Motorola Inc.
12 ;; ORG: InfoDock Associates. We sell corporate support and development
13 ;; contracts for InfoDock, Emacs and XEmacs.
14 ;; E-mail: <info@infodock.com> Web: http://www.infodock.com
15 ;; Tel: +1 408-243-3300
16 ;; 12 ;;
17 ;; ORIG-DATE: 7-Jun-89 at 22:08:29 13 ;; ORIG-DATE: 7-Jun-89 at 22:08:29
18 ;; LAST-MOD: 14-Mar-97 at 01:32:23 by Bob Weiner 14 ;; LAST-MOD: 31-Oct-95 at 18:39:54 by Bob Weiner
19 ;; 15 ;;
20 ;; This file is part of Hyperbole. 16 ;; This file is part of Hyperbole.
21 ;; Available for use and distribution under the same terms as GNU Emacs. 17 ;; Available for use and distribution under the same terms as GNU Emacs.
22 ;; 18 ;;
23 ;; Copyright (C) 1989, '90, '91, '92, '95, '96, '97 Free Software Foundation, Inc. 19 ;; Copyright (C) 1989, '90, '91, '92, '95 Free Software Foundation, Inc.
20 ;; Developed with support from Motorola Inc.
24 ;; 21 ;;
25 ;; DESCRIPTION: 22 ;; DESCRIPTION:
26 ;; 23 ;;
27 ;; The `put whatever you feel like into it' rolodex. 24 ;; The `put whatever you feel like into it' rolodex.
28 ;; 25 ;;
60 ;; wrolo as part of Hyperbole, this file in unneeded and so not included.) 57 ;; wrolo as part of Hyperbole, this file in unneeded and so not included.)
61 ;; 58 ;;
62 ;; 59 ;;
63 ;; SETUP: 60 ;; SETUP:
64 ;; 61 ;;
65 ;; The variable `rolo-file-list' is a list of files to search for 62 ;; The variable 'rolo-file-list' is a list of files to search for
66 ;; matching rolodex entries. To add personal files to rolo-file-list, 63 ;; matching rolodex entries. To add personal files to rolo-file-list,
67 ;; when you find these functions are useful for any sort of list lookup, 64 ;; when you find these functions are useful for any sort of list lookup,
68 ;; add the following to your ~/.emacs file (substituting where you see 65 ;; add the following to your ~/.emacs file (substituting where you see
69 ;; <fileN>): 66 ;; <fileN>):
70 ;; 67 ;;
71 ;; (setq rolo-file-list (append rolo-file-list '("<file1>" "<file2>"))) 68 ;; (setq rolo-file-list (append rolo-file-list '("<file1>" "<file2>")))
72 ;; 69 ;;
73 ;; We recommend that entries in `rolo-file-list' have ".otl" suffixes 70 ;; We recommend that entries in 'rolo-file-list' have ".otl" suffixes
74 ;; so that they do not conflict with file names that other rolodex 71 ;; so that they do not conflict with file names that other rolodex
75 ;; programs might use and so that they are edited in `outline-mode' by 72 ;; programs might use and so that they are edited in 'outline-mode' by
76 ;; default. If you want the latter behavior, uncomment and add something 73 ;; default. If you want the latter behavior, uncomment and add something
77 ;; like the following to one of your GNU Emacs initialization files: 74 ;; like the following to one of your GNU Emacs initialization files:
78 ;; 75 ;;
79 ;; ;; Add to the list of suffixes that causes automatic mode invocation 76 ;; ;; Add to the list of suffixes that causes automatic mode invocation
80 ;; (setq auto-mode-alist 77 ;; (setq auto-mode-alist
95 ;; 92 ;;
96 ;; When adding an entry from within a buffer containing a mail 93 ;; When adding an entry from within a buffer containing a mail
97 ;; message, the rolodex add function will extract the sender's name 94 ;; message, the rolodex add function will extract the sender's name
98 ;; and e-mail address and prompt you with the name as a default. If 95 ;; and e-mail address and prompt you with the name as a default. If
99 ;; you accept it, it will enter the name and the email address using 96 ;; you accept it, it will enter the name and the email address using
100 ;; the format given by the `rolo-email-format' variable. See its 97 ;; the format given by the 'rolo-email-format' variable. See its
101 ;; documentation if you want to change its value. 98 ;; documentation if you want to change its value.
102 ;; 99 ;;
103 ;; 100 ;;
104 ;; If you use Hyperbole V2.3 or greater, then no other rolodex setup 101 ;; If you use Hyperbole V2.3 or greater, then no other rolodex setup
105 ;; is necessary, simply select the "Rolo/" menu item from the top 102 ;; is necessary, simply select the "Rolo/" menu item from the top
136 ;; 133 ;;
137 ;; For any of these commands that prompt you for a name, you may use the form 134 ;; For any of these commands that prompt you for a name, you may use the form
138 ;; parent/child to locate a child entry below a parent entry, e.g. 135 ;; parent/child to locate a child entry below a parent entry, e.g.
139 ;; from the example near the top, we could give Company/Manager/Underlings. 136 ;; from the example near the top, we could give Company/Manager/Underlings.
140 ;; 137 ;;
141 ;; Here is a snippet from our group rolodex file. The `;'s should be 138 ;; Here is a snippet from our group rolodex file. The ';'s should be
142 ;; removed of course and the `*'s should begin at the start of the 139 ;; removed of course and the '*'s should begin at the start of the
143 ;; line. If a rolodex file begins with two separator lines whose 140 ;; line. If a rolodex file begins with two separator lines whose
144 ;; first three characters are "===", then these lines and any text 141 ;; first three characters are "===", then these lines and any text
145 ;; between them are prepended to the output buffer whenever any 142 ;; between them are prepended to the output buffer whenever any
146 ;; entries are retrieved from that file. 143 ;; entries are retrieved from that file.
147 ;; 144 ;;
157 ;; 154 ;;
158 ;; 155 ;;
159 ;; FOR PROGRAMMERS: 156 ;; FOR PROGRAMMERS:
160 ;; 157 ;;
161 ;; Entries in rolodex files are separated by patterns matching 158 ;; Entries in rolodex files are separated by patterns matching
162 ;; `rolo-entry-regexp'. Each entry may have any number of sub-entries 159 ;; 'rolo-entry-regexp'. Each entry may have any number of sub-entries
163 ;; which represent the next level down in the entry hierarchy. 160 ;; which represent the next level down in the entry hierarchy.
164 ;; Sub-entries' separator patterns are always longer than their parents'. 161 ;; Sub-entries' separator patterns are always longer than their parents'.
165 ;; For example, if an entry began with `*' then its sub-entries would begin 162 ;; For example, if an entry began with '*' then its sub-entries would begin
166 ;; with `**' and so on. Blank lines in rolodex files will not end up where 163 ;; with '**' and so on. Blank lines in rolodex files will not end up where
167 ;; you want them if you use the rolo-sort commands; therefore, blank lines 164 ;; you want them if you use the rolo-sort commands; therefore, blank lines
168 ;; are not recommended. If you change the value of 165 ;; are not recommended. If you change the value of
169 ;; `rolo-entry-regexp', you will have to modify `rolo-sort'. 166 ;; 'rolo-entry-regexp', you will have to modify 'rolo-sort'.
170 ;; 167 ;;
171 ;; The following additional functions are provided: 168 ;; The following additional functions are provided:
172 ;; 169 ;;
173 ;; `rolo-sort-level' sorts a specific level of entries in a rolodex file; 170 ;; 'rolo-sort-level' sorts a specific level of entries in a rolodex file;
174 ;; `rolo-map-level' runs a user specified function on a specific level of 171 ;; 'rolo-map-level' runs a user specified function on a specific level of
175 ;; entries in a rolodex file; 172 ;; entries in a rolodex file;
176 ;; `rolo-fgrep-file', same as `rolo-fgrep' but operates on a single file; 173 ;; 'rolo-fgrep-file', same as 'rolo-fgrep' but operates on a single file;
177 ;; `rolo-grep-file', same as `rolo-grep' but operates on a single file; 174 ;; 'rolo-grep-file', same as 'rolo-grep' but operates on a single file;
178 ;; `rolo-display-matches', display last set of rolodex matches, if any; 175 ;; 'rolo-display-matches', display last set of rolodex matches, if any;
179 ;; `rolo-toggle-narrow-to-entry' toggles between display of current entry 176 ;; 'rolo-toggle-narrow-to-entry' toggles between display of current entry
180 ;; and display of all matching entries. 177 ;; and display of all matching entries.
181 ;; 178 ;;
182 ;; 179 ;;
183 ;; MOD HISTORY: 180 ;; MOD HISTORY:
184 ;; 181 ;;
185 ;; 12/17/89 182 ;; 12/17/89
186 ;; Added internal `rolo-shrink-window' function for use in 183 ;; Added internal 'rolo-shrink-window' function for use in
187 ;; compressing/uncompressing the rolo view window to/from a size just 184 ;; compressing/uncompressing the rolo view window to/from a size just
188 ;; large enough for the selected entry. This is useful when a search 185 ;; large enough for the selected entry. This is useful when a search
189 ;; turns up more entries than desired. 186 ;; turns up more entries than desired.
190 ;; 187 ;;
191 ;; 02/21/90 188 ;; 02/21/90
192 ;; Modified `rolo-grep-file' and `rolo-map-level' so they only set buffers 189 ;; Modified 'rolo-grep-file' and 'rolo-map-level' so they only set buffers
193 ;; read-only the first time they are read in. This way, if someone edits a 190 ;; read-only the first time they are read in. This way, if someone edits a
194 ;; rolodex file and then does a rolo-fgrep or other function, the buffer 191 ;; rolodex file and then does a rolo-fgrep or other function, the buffer
195 ;; will not be back in read-only mode. 192 ;; will not be back in read-only mode.
196 ;; 193 ;;
197 ;; 04/18/91 194 ;; 04/18/91
198 ;; Modified `rolo-grep-file' to expand any hidden entries in rolo file 195 ;; Modified 'rolo-grep-file' to expand any hidden entries in rolo file
199 ;; before doing a search. 196 ;; before doing a search.
200 ;; 197 ;;
201 ;; 12/24/91 198 ;; 12/24/91
202 ;; Added Hyperbole button support. 199 ;; Added Hyperbole button support.
203 ;; 200 ;;
224 "Format string to use when adding an entry with e-mail addr from a mail msg. 221 "Format string to use when adding an entry with e-mail addr from a mail msg.
225 It must contain a %s indicating where to put the entry name and a second 222 It must contain a %s indicating where to put the entry name and a second
226 %s indicating where to put the e-mail address.") 223 %s indicating where to put the e-mail address.")
227 224
228 (defvar rolo-file-list 225 (defvar rolo-file-list
229 (if hyperb:microcruft-os-p 226 (if (memq system-type '(ms-windows windows-nt ms-dos))
230 '("c:/_rolodex.otl") '("~/.rolodex.otl")) 227 '("c:/_rolodex.otl") '("~/.rolodex.otl"))
231 "*List of files containing rolodex entries. 228 "*List of files containing rolodex entries.
232 The first file should be a user-specific rolodex file, typically in the home 229 The first file should be a user-specific rolodex file, typically in the home
233 directory. The second file is often a shared, group-specific rolodex file. 230 directory. The second file is often a shared, group-specific rolodex file.
234 231
257 "*Non-nil means kill rolodex file buffers after searching them for entries. 254 "*Non-nil means kill rolodex file buffers after searching them for entries.
258 Only unmodified buffers are killed.") 255 Only unmodified buffers are killed.")
259 256
260 (defvar rolo-save-buffers-after-use t 257 (defvar rolo-save-buffers-after-use t
261 "*Non-nil means save rolodex file after an entry is killed.") 258 "*Non-nil means save rolodex file after an entry is killed.")
262
263 ;; Insert or update the entry date each time an entry is added or edited.
264 (add-hook 'wrolo-add-hook 'rolo-set-date)
265 (add-hook 'wrolo-edit-hook 'rolo-set-date)
266 259
267 (defvar wrolo-yank-reformat-function nil 260 (defvar wrolo-yank-reformat-function nil
268 "*Value is a function of two arguments, START and END, invoked after a rolo-yank. 261 "*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. 262 It should reformat the region given by the arguments to some preferred style.
270 Default value is nil, meaning no reformmating is done.") 263 Default value is nil, meaning no reformmating is done.")
291 (list (if (and email name 284 (list (if (and email name
292 (string-match (concat "\\`" (regexp-quote entry)) name)) 285 (string-match (concat "\\`" (regexp-quote entry)) name))
293 (format rolo-email-format entry email) entry) 286 (format rolo-email-format entry email) entry)
294 current-prefix-arg)))) 287 current-prefix-arg))))
295 (if (or (not (stringp name)) (string= name "")) 288 (if (or (not (stringp name)) (string= name ""))
296 (error "(rolo-add): Invalid name: `%s'" name)) 289 (error "(rolo-add): Invalid name: '%s'" name))
297 (if (and (interactive-p) file) 290 (if (and (interactive-p) file)
298 (setq file (completing-read "File to add to: " 291 (setq file (completing-read "File to add to: "
299 (mapcar 'list rolo-file-list)))) 292 (mapcar 'list rolo-file-list))))
300 (if (null file) (setq file (car rolo-file-list))) 293 (if (null file) (setq file (car rolo-file-list)))
301 (cond ((and file (or (not (stringp file)) (string= file ""))) 294 (cond ((and file (or (not (stringp file)) (string= file "")))
302 (error "(rolo-add): Invalid file: `%s'" file)) 295 (error "(rolo-add): Invalid file: '%s'" file))
303 ((and (file-exists-p file) (not (file-readable-p file))) 296 ((and (file-exists-p file) (not (file-readable-p file)))
304 (error "(rolo-add): File not readable: `%s'" file)) 297 (error "(rolo-add): File not readable: '%s'" file))
305 ((not (file-writable-p file)) 298 ((not (file-writable-p file))
306 (error "(rolo-add): File not writable: `%s'" file))) 299 (error "(rolo-add): File not writable: '%s'" file)))
307 (set-buffer (or (get-file-buffer file) (find-file-noselect file))) 300 (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
308 (if (interactive-p) (message "Locating insertion point for `%s'..." name)) 301 (if (interactive-p) (message "Locating insertion point for '%s'..." name))
309 (let ((parent "") (level "") end) 302 (let ((parent "") (level "") end)
310 (widen) (goto-char 1) 303 (widen) (goto-char 1)
311 (while (setq end (string-match "/" name)) 304 (while (setq end (string-match "/" name))
312 (setq parent (substring name 0 end) 305 (setq parent (substring name 0 end)
313 name (substring name (min (1+ end) (length name)))) 306 name (substring name (min (1+ end) (length name))))
314 (if (re-search-forward 307 (if (re-search-forward
315 (concat "\\(" rolo-entry-regexp "\\)[ \t]*" 308 (concat "\\(" rolo-entry-regexp "\\)[ \t]*"
316 (regexp-quote parent)) nil t) 309 (regexp-quote parent)) nil t)
317 (setq level (buffer-substring (match-beginning 1) 310 (setq level (buffer-substring (match-beginning 1)
318 (match-end 1))) 311 (match-end 1)))
319 (error "(rolo-add): `%s' category not found in \"%s\"." 312 (error "(rolo-add): '%s' category not found in \"%s\"."
320 parent file))) 313 parent file)))
321 (narrow-to-region (point) 314 (narrow-to-region (point)
322 (progn (rolo-to-entry-end t level) (point))) 315 (progn (rolo-to-entry-end t level) (point)))
323 (goto-char (point-min)) 316 (goto-char (point-min))
324 (let* ((len (length name)) 317 (let* ((len (length name))
351 nil 344 nil
352 (insert (or entry-level (concat level "*")) 345 (insert (or entry-level (concat level "*"))
353 (if (string= entry-spc "") " " entry-spc) 346 (if (string= entry-spc "") " " entry-spc)
354 name "\n") 347 name "\n")
355 (backward-char 1)) 348 (backward-char 1))
356 ;; Rolo-to-buffer may move point from its desired location, so 349 (widen)
357 ;; restore it. 350 (rolo-to-buffer (current-buffer))
358 (let ((opoint (point))) 351 ;; Fixes non-display update bug when buf is on screen before
359 (widen) 352 ;; interactive command invocation.
360 (rolo-to-buffer (current-buffer)) 353 (goto-char (point))
361 (goto-char opoint))
362 (run-hooks 'wrolo-add-hook)
363 (if (interactive-p) 354 (if (interactive-p)
364 (message "Edit entry at point."))))) 355 (message "Edit entry at point.")))))
365 356
366 ;;;###autoload 357 ;;;###autoload
367 (defun rolo-display-matches (&optional display-buf return-to-buffer) 358 (defun rolo-display-matches (&optional display-buf return-to-buffer)
368 "Display optional DISPLAY-BUF buffer of previously found rolodex matches. 359 "Display optional DISPLAY-BUF buffer of previously found rolodex matches.
369 If DISPLAY-BUF is nil, use the value in `rolo-display-buffer'. 360 If DISPLAY-BUF is nil, use the value in 'rolo-display-buffer'.
370 Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display." 361 Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display."
371 (interactive) 362 (interactive)
372 (or display-buf (setq display-buf (get-buffer rolo-display-buffer))) 363 (or display-buf (setq display-buf (get-buffer rolo-display-buffer)))
373 (if display-buf nil 364 (if display-buf nil
374 (error "(rolo-display-matches): Search the rolodex first.")) 365 (error "(rolo-display-matches): Search the rolodex first."))
393 ;; been specified. Use {q} to quit and restore display. 384 ;; been specified. Use {q} to quit and restore display.
394 (if return-to-buffer (rolo-to-buffer return-to-buffer t))) 385 (if return-to-buffer (rolo-to-buffer return-to-buffer t)))
395 386
396 ;;;###autoload 387 ;;;###autoload
397 (defun rolo-edit (&optional name file) 388 (defun rolo-edit (&optional name file)
398 "Edits a rolodex entry given by optional NAME within `rolo-file-list'. 389 "Edits a rolodex entry given by optional NAME within 'rolo-file-list'.
399 With prefix argument, prompts for optional FILE to locate entry within. 390 With prefix argument, prompts for optional FILE to locate entry within.
400 With no NAME arg, simply displays FILE or first entry in `rolo-file-list' in an 391 With no NAME arg, simply displays FILE or first entry in 'rolo-file-list' in an
401 editable mode. NAME may be of the form: parent/child to edit child below a 392 editable mode. NAME may be of the form: parent/child to edit child below a
402 parent entry which begins with the parent string." 393 parent entry which begins with the parent string."
403 (interactive "sName to edit in rolo: \nP") 394 (interactive "sName to edit in rolo: \nP")
404 (if (string-equal name "") (setq name nil)) 395 (if (string-equal name "") (setq name nil))
405 (and name (not (stringp name)) 396 (and name (not (stringp name))
406 (error "(rolo-edit): Invalid name: `%s'" name)) 397 (error "(rolo-edit): Invalid name: '%s'" name))
407 (if (and (interactive-p) current-prefix-arg) 398 (if (and (interactive-p) current-prefix-arg)
408 (if (= (length rolo-file-list) 1) 399 (if (= (length rolo-file-list) 1)
409 (setq file (car rolo-file-list)) 400 (setq file (car rolo-file-list))
410 (setq file (completing-read "Entry's File: " 401 (setq file (completing-read "Entry's File: "
411 (mapcar 'list rolo-file-list))))) 402 (mapcar 'list rolo-file-list)))))
412 (let ((found-point) (file-list (if file (list file) rolo-file-list))) 403 (let ((found-point) (file-list (if file (list file) rolo-file-list)))
413 (or file (setq file (car file-list))) 404 (or file (setq file (car file-list)))
414 (if (null name) 405 (if (null name)
415 (progn (if (not (file-writable-p file)) 406 (progn (if (not (file-writable-p file))
416 (error "(rolo-edit): File not writable: `%s'" file)) 407 (error "(rolo-edit): File not writable: '%s'" file))
417 (find-file-other-window file) (setq buffer-read-only nil)) 408 (find-file-other-window file) (setq buffer-read-only nil))
418 (if (setq found-point (rolo-to name file-list)) 409 (if (setq found-point (rolo-to name file-list))
419 (progn 410 (progn
420 (setq file buffer-file-name) 411 (setq file buffer-file-name)
421 (if (file-writable-p file) 412 (if (file-writable-p file)
422 (setq buffer-read-only nil) 413 (setq buffer-read-only nil)
423 (message 414 (message
424 "(rolo-edit): Entry found but file not writable: `%s'" file) 415 "(rolo-edit): Entry found but file not writable: '%s'" file)
425 (beep)) 416 (beep))
426 (rolo-to-buffer (current-buffer))) 417 (rolo-to-buffer (current-buffer)))
427 (message "(rolo-edit): `%s' not found." name) 418 (message "(rolo-edit): '%s' not found." name)
428 (beep) 419 (beep)
429 (rolo-to-buffer (or (get-file-buffer (car file-list)) 420 (rolo-to-buffer (or (get-file-buffer (car file-list))
430 (find-file-noselect (car file-list)))) 421 (find-file-noselect (car file-list))))
431 (setq buffer-read-only nil)) 422 (setq buffer-read-only nil))
432 (widen) 423 (widen)
433 ;; Rolo-to-buffer may have moved point from its desired location, so 424 ;; Fixes display update bug in some Emacs versions. When buf is
434 ;; restore it. 425 ;; on screen before interactive command invocation, point is not
435 (if found-point (goto-char found-point)) 426 ;; moved to proper location.
436 (run-hooks 'wrolo-edit-hook)))) 427 (if found-point (goto-char found-point)))))
437 428
438 (defun rolo-edit-entry () 429 (defun rolo-edit-entry ()
439 "Edit the source entry of the rolodex match buffer entry at point. 430 "Edit the source entry of the rolodex match buffer entry at point.
440 Returns entry name if found, else nil." 431 Returns entry name if found, else nil."
441 (interactive) 432 (interactive)
529 (error "(rolo-isearch): Use this command in the %s match buffer" 520 (error "(rolo-isearch): Use this command in the %s match buffer"
530 rolo-display-buffer))) 521 rolo-display-buffer)))
531 522
532 ;;;###autoload 523 ;;;###autoload
533 (defun rolo-kill (name &optional file) 524 (defun rolo-kill (name &optional file)
534 "Kills a rolodex entry given by NAME within `rolo-file-list'. 525 "Kills a rolodex entry given by NAME within 'rolo-file-list'.
535 With prefix argument, prompts for optional FILE to locate entry within. 526 With prefix argument, prompts for optional FILE to locate entry within.
536 NAME may be of the form: parent/child to kill child below a parent entry 527 NAME may be of the form: parent/child to kill child below a parent entry
537 which begins with the parent string. 528 which begins with the parent string.
538 Returns t if entry is killed, nil otherwise." 529 Returns t if entry is killed, nil otherwise."
539 (interactive "sName to kill in rolo: \nP") 530 (interactive "sName to kill in rolo: \nP")
540 (if (or (not (stringp name)) (string= name "")) 531 (if (or (not (stringp name)) (string= name ""))
541 (error "(rolo-kill): Invalid name: `%s'" name)) 532 (error "(rolo-kill): Invalid name: '%s'" name))
542 (if (and (interactive-p) current-prefix-arg) 533 (if (and (interactive-p) current-prefix-arg)
543 (setq file (completing-read "Entry's File: " 534 (setq file (completing-read "Entry's File: "
544 (mapcar 'list rolo-file-list)))) 535 (mapcar 'list rolo-file-list))))
545 (let ((file-list (if file (list file) rolo-file-list)) 536 (let ((file-list (if file (list file) rolo-file-list))
546 (killed)) 537 (killed))
575 (funcall kill-op start level) 566 (funcall kill-op start level)
576 (message "Killed")) 567 (message "Killed"))
577 (message "Aborted"))) 568 (message "Aborted")))
578 (funcall kill-op start level))) 569 (funcall kill-op start level)))
579 (message 570 (message
580 "(rolo-kill): Entry found but file not writable: `%s'" file) 571 "(rolo-kill): Entry found but file not writable: '%s'" file)
581 (beep))) 572 (beep)))
582 (message "(rolo-kill): `%s' not found." name) 573 (message "(rolo-kill): '%s' not found." name)
583 (beep)) 574 (beep))
584 killed)) 575 killed))
585 576
586 (defun rolo-mail-to () 577 (defun rolo-mail-to ()
587 "Start composing mail addressed to the first e-mail address at or after point." 578 "Start composing mail addressed to the first e-mail address at or after point."
633 (set-window-configuration *rolo-wconfig*))) 624 (set-window-configuration *rolo-wconfig*)))
634 625
635 ;;;###autoload 626 ;;;###autoload
636 (defun rolo-sort (&optional rolo-file) 627 (defun rolo-sort (&optional rolo-file)
637 "Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo). 628 "Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo).
638 Assumes entries are delimited by one or more `*'characters. 629 Assumes entries are delimited by one or more '*'characters.
639 Returns list of number of groupings at each entry level." 630 Returns list of number of groupings at each entry level."
640 (interactive 631 (interactive
641 (list (let ((default "") 632 (list (let ((default "")
642 (file)) 633 (file))
643 (setq file 634 (setq file
678 groupings at the given level. LEVEL-REGEXP should simply match the text of 669 groupings at the given level. LEVEL-REGEXP should simply match the text of
679 any rolodex entry of the given level, not the beginning of a line (^); an 670 any rolodex entry of the given level, not the beginning of a line (^); an
680 example, might be (regexp-quote \"**\") to match level two. Returns number 671 example, might be (regexp-quote \"**\") to match level two. Returns number
681 of groupings sorted." 672 of groupings sorted."
682 (interactive "sRolodex file to sort: \nRegexp for level's entries: \nP") 673 (interactive "sRolodex file to sort: \nRegexp for level's entries: \nP")
683 (let ((sort-fold-case t)) 674 (rolo-map-level
684 (rolo-map-level 675 (function (lambda (start end) (sort-lines nil start end)))
685 (function (lambda (start end) (sort-lines nil start end))) 676 rolo-file
686 rolo-file 677 level-regexp
687 level-regexp 678 max-groupings))
688 max-groupings)))
689
690 ;;;###autoload
691 (defun rolo-toggle-datestamps (&optional arg)
692 "Toggle whether datestamps are updated when rolodex entries are modified.
693 With optional ARG, turn them on iff ARG is positive."
694 (interactive "P")
695 (if (or (and arg (<= (prefix-numeric-value arg) 0))
696 (and (not (and arg (> (prefix-numeric-value arg) 0)))
697 (boundp 'wrolo-add-hook) (listp wrolo-add-hook)
698 (memq 'rolo-set-date wrolo-add-hook)))
699 (progn (remove-hook 'wrolo-add-hook 'rolo-set-date)
700 (remove-hook 'wrolo-edit-hook 'rolo-set-date)
701 (message "Rolodex date stamps are now turned off."))
702 (add-hook 'wrolo-add-hook 'rolo-set-date)
703 (add-hook 'wrolo-edit-hook 'rolo-set-date)
704 (message "Rolodex date stamps are now turned on.")))
705 679
706 (defun rolo-toggle-narrow-to-entry () 680 (defun rolo-toggle-narrow-to-entry ()
707 "Toggle between display of current entry and display of all matched entries. 681 "Toggle between display of current entry and display of all matched entries.
708 Useful when bound to a mouse key." 682 Useful when bound to a mouse key."
709 (interactive) 683 (interactive)
802 (save-excursion 776 (save-excursion
803 (save-restriction 777 (save-restriction
804 (widen) 778 (widen)
805 (goto-char 1) 779 (goto-char 1)
806 ;; Ensure no entries in outline mode are hidden. 780 ;; Ensure no entries in outline mode are hidden.
807 ;; Uses `show-all' function from outline.el. 781 ;; Uses 'show-all' function from outline.el.
808 (and (search-forward "\C-m" nil t) 782 (and (search-forward "\C-m" nil t)
809 (show-all)) 783 (show-all))
810 (if (re-search-forward rolo-hdr-regexp nil t 2) 784 (if (re-search-forward rolo-hdr-regexp nil t 2)
811 (progn (forward-line) 785 (progn (forward-line)
812 (setq hdr-pos (cons (point-min) (point))))) 786 (setq hdr-pos (cons (point-min) (point)))))
865 (let ((num-found 0) 839 (let ((num-found 0)
866 (exact-level-regexp (concat "^\\(" level-regexp "\\)[ \t\n]")) 840 (exact-level-regexp (concat "^\\(" level-regexp "\\)[ \t\n]"))
867 (outline-regexp rolo-entry-regexp) 841 (outline-regexp rolo-entry-regexp)
868 (buffer-read-only) 842 (buffer-read-only)
869 (level-len)) 843 (level-len))
870 ;; Load `outline' library since its functions are used here. 844 ;; Load 'outline' library since its functions are used here.
871 (if (not (boundp 'outline-mode-map)) 845 (if (not (boundp 'outline-mode-map))
872 (load-library "outline")) 846 (load-library "outline"))
873 (goto-char (point-min)) 847 (goto-char (point-min))
874 ;; Pass buffer header if it exists 848 ;; Pass buffer header if it exists
875 (if (re-search-forward rolo-hdr-regexp nil t 2) 849 (if (re-search-forward rolo-hdr-regexp nil t 2)
909 end 883 end
910 (if (re-search-forward 884 (if (re-search-forward
911 rolo-entry-regexp nil t) 885 rolo-entry-regexp nil t)
912 (progn (beginning-of-line) (point)) 886 (progn (beginning-of-line) (point))
913 (point-max)))) 887 (point-max))))
914 ;; Remember last expression in `progn' 888 ;; Remember last expression in 'progn'
915 ;; must always return non-nil. 889 ;; must always return non-nil.
916 (goto-char start))) 890 (goto-char start)))
917 (not grouping-end))) 891 (not grouping-end)))
918 (let ((end (point))) 892 (let ((end (point)))
919 (goto-char grouping-start) 893 (goto-char grouping-start)
944 (car (memq (get-buffer (or (and (stringp rolo-buf) 918 (car (memq (get-buffer (or (and (stringp rolo-buf)
945 (get-file-buffer rolo-buf)) 919 (get-file-buffer rolo-buf))
946 rolo-buf)) 920 rolo-buf))
947 (buffer-list)))) 921 (buffer-list))))
948 922
949 (defun rolo-current-date ()
950 "Return the current date (a string) in a form used for rolodex entry insertion."
951 (let ((year-month-day (htz:date-parse (current-time-string))))
952 (format "\t%02s/%02s/%s"
953 (aref year-month-day 1)
954 (aref year-month-day 2)
955 (aref year-month-day 0))))
956
957 (defun rolo-display-to-entry-end () 923 (defun rolo-display-to-entry-end ()
958 "Go to end of current entry, ignoring sub-entries." 924 "Go to end of current entry, ignoring sub-entries."
959 (if (re-search-forward (concat rolo-hdr-regexp "\\|" 925 (if (re-search-forward (concat rolo-hdr-regexp "\\|"
960 rolo-entry-regexp) nil t) 926 rolo-entry-regexp) nil t)
961 (progn (beginning-of-line) (point)) 927 (progn (beginning-of-line) (point))
979 (hproperty:but-add (match-beginning 0) (match-end 0) 945 (hproperty:but-add (match-beginning 0) (match-end 0)
980 (or rolo-highlight-face 946 (or rolo-highlight-face
981 hproperty:highlight-face))))))) 947 hproperty:highlight-face)))))))
982 948
983 (defun rolo-kill-buffer (&optional rolo-buf) 949 (defun rolo-kill-buffer (&optional rolo-buf)
984 "Kills optional ROLO-BUF if unchanged and `rolo-kill-buffers-after-use' is t. 950 "Kills optional ROLO-BUF if unchanged and 'rolo-kill-buffers-after-use' is t.
985 Default is current buffer." 951 Default is current buffer."
986 (or rolo-buf (setq rolo-buf (current-buffer))) 952 (or rolo-buf (setq rolo-buf (current-buffer)))
987 (and rolo-kill-buffers-after-use (not (buffer-modified-p rolo-buf)) 953 (and rolo-kill-buffers-after-use (not (buffer-modified-p rolo-buf))
988 (kill-buffer rolo-buf))) 954 (kill-buffer rolo-buf)))
989 955
990 (defun rolo-name-and-email () 956 (defun rolo-name-and-email ()
991 "If point is in a mail message, returns list of (name email-addr) of sender. 957 "If point is in a mail message, returns list of (name email-addr) of sender.
992 Name is returned as `last, first-and-middle'." 958 Name is returned as 'last, first-and-middle'."
993 (let ((email) (name) (from)) 959 (let ((email) (name) (from))
994 (save-window-excursion 960 (save-window-excursion
995 (if (or (hmail:lister-p) (hnews:lister-p)) 961 (if (or (hmail:lister-p) (hnews:lister-p))
996 (other-window 1)) 962 (other-window 1))
997 (save-excursion 963 (save-excursion
1023 (match-end 4))))))) 989 (match-end 4)))))))
1024 (if (or name email) 990 (if (or name email)
1025 (list name email)))) 991 (list name email))))
1026 992
1027 (defun rolo-name-at () 993 (defun rolo-name-at ()
1028 "If point is within an entry in `rolo-display-buffer', returns entry, else nil." 994 "If point is within an entry in 'rolo-display-buffer', returns entry, else nil."
1029 (if (string-equal (buffer-name) rolo-display-buffer) 995 (if (string-equal (buffer-name) rolo-display-buffer)
1030 (save-excursion 996 (save-excursion
1031 (if (or (looking-at rolo-entry-regexp) 997 (if (or (looking-at rolo-entry-regexp)
1032 (progn (end-of-line) 998 (progn (end-of-line)
1033 (re-search-backward rolo-entry-regexp nil t))) 999 (re-search-backward rolo-entry-regexp nil t)))
1040 1006
1041 (defun rolo-narrowed-p () 1007 (defun rolo-narrowed-p ()
1042 (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max)))) 1008 (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max))))
1043 1009
1044 (defun rolo-save-buffer (&optional rolo-buf) 1010 (defun rolo-save-buffer (&optional rolo-buf)
1045 "Saves optional ROLO-BUF if changed and `rolo-save-buffers-after-use' is t. 1011 "Saves optional ROLO-BUF if changed and 'rolo-save-buffers-after-use' is t.
1046 Default is current buffer. Used, for example, after a rolo entry is killed." 1012 Default is current buffer. Used, for example, after a rolo entry is killed."
1047 (or rolo-buf (setq rolo-buf (current-buffer))) 1013 (or rolo-buf (setq rolo-buf (current-buffer)))
1048 (and rolo-save-buffers-after-use (buffer-modified-p rolo-buf) 1014 (and rolo-save-buffers-after-use (buffer-modified-p rolo-buf)
1049 (set-buffer rolo-buf) (save-buffer))) 1015 (set-buffer rolo-buf) (save-buffer)))
1050
1051 (defun rolo-set-date ()
1052 "Add a line with the current date at the end of the current rolodex entry.
1053 Suitable for use as an entry in `wrolo-add-hook' and `wrolo-edit-hook'.
1054 The default date format is MM/DD/YYYY. Rewrite `rolo-current-date' to
1055 return a different format, if you prefer."
1056 (save-excursion
1057 (skip-chars-forward "*")
1058 (rolo-to-entry-end)
1059 (skip-chars-backward " \t\n\r\f")
1060 (skip-chars-backward "^\n\r\f")
1061 (if (looking-at "\\s-+[-0-9./]+\\s-*$") ;; a date
1062 (progn (delete-region (point) (match-end 0))
1063 (insert (rolo-current-date)))
1064 (end-of-line)
1065 (insert "\n" (rolo-current-date)))))
1066 1016
1067 (defun rolo-shrink-window () 1017 (defun rolo-shrink-window ()
1068 (let* ((lines (count-lines (point-min) (point-max))) 1018 (let* ((lines (count-lines (point-min) (point-max)))
1069 (height (window-height)) 1019 (height (window-height))
1070 (window-min-height 2) 1020 (window-min-height 2)
1077 (max desired-shrinkage (- height (/ (frame-height) 2))) 1027 (max desired-shrinkage (- height (/ (frame-height) 2)))
1078 (min desired-shrinkage (- height window-min-height))))))) 1028 (min desired-shrinkage (- height window-min-height)))))))
1079 1029
1080 (defun rolo-to (name &optional file-list) 1030 (defun rolo-to (name &optional file-list)
1081 "Moves point to entry for NAME within optional FILE-LIST. 1031 "Moves point to entry for NAME within optional FILE-LIST.
1082 `rolo-file-list' is used as default when FILE-LIST is nil. 1032 'rolo-file-list' is used as default when FILE-LIST is nil.
1083 Leaves point immediately after match for NAME within entry. 1033 Leaves point immediately after match for NAME within entry.
1084 Switches internal current buffer but does not alter the frame. 1034 Switches internal current buffer but does not alter the frame.
1085 Returns point where matching entry begins or nil if not found." 1035 Returns point where matching entry begins or nil if not found."
1086 (or file-list (setq file-list rolo-file-list)) 1036 (or file-list (setq file-list rolo-file-list))
1087 (let ((found) file) 1037 (let ((found) file)
1088 (while (and (not found) file-list) 1038 (while (and (not found) file-list)
1089 (setq file (car file-list) 1039 (setq file (car file-list)
1090 file-list (cdr file-list)) 1040 file-list (cdr file-list))
1091 (cond ((and file (or (not (stringp file)) (string= file ""))) 1041 (cond ((and file (or (not (stringp file)) (string= file "")))
1092 (error "(rolo-to): Invalid file: `%s'" file)) 1042 (error "(rolo-to): Invalid file: '%s'" file))
1093 ((and (file-exists-p file) (not (file-readable-p file))) 1043 ((and (file-exists-p file) (not (file-readable-p file)))
1094 (error "(rolo-to): File not readable: `%s'" file))) 1044 (error "(rolo-to): File not readable: '%s'" file)))
1095 (set-buffer (or (get-file-buffer file) (find-file-noselect file))) 1045 (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
1096 (let ((case-fold-search t) (real-name name) (parent "") (level) end) 1046 (let ((case-fold-search t) (real-name name) (parent "") (level) end)
1097 (widen) (goto-char 1) 1047 (widen) (goto-char 1)
1098 (while (setq end (string-match "/" name)) 1048 (while (setq end (string-match "/" name))
1099 (setq level nil 1049 (setq level nil
1111 level)) 1061 level))
1112 ((equal name real-name));; Try next file. 1062 ((equal name real-name));; Try next file.
1113 (t;; Found parent but not child 1063 (t;; Found parent but not child
1114 (setq buffer-read-only nil) 1064 (setq buffer-read-only nil)
1115 (rolo-to-buffer (current-buffer)) 1065 (rolo-to-buffer (current-buffer))
1116 (error "(rolo-to): `%s' part of name not found in \"%s\"." 1066 (error "(rolo-to): '%s' part of name not found in \"%s\"."
1117 parent file))) 1067 parent file)))
1118 (if level 1068 (if level
1119 (narrow-to-region (point) 1069 (narrow-to-region (point)
1120 (save-excursion 1070 (save-excursion
1121 (rolo-to-entry-end t level) (point))))) 1071 (rolo-to-entry-end t level) (point)))))
1164 (interactive) 1114 (interactive)
1165 (setq major-mode 'wrolo-mode 1115 (setq major-mode 'wrolo-mode
1166 mode-name "Rolodex") 1116 mode-name "Rolodex")
1167 (use-local-map wrolo-mode-map) 1117 (use-local-map wrolo-mode-map)
1168 ;; 1118 ;;
1169 (set-syntax-table wrolo-mode-syntax-table)
1170 ;;
1171 ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing 1119 ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing
1172 ;; otherwise. 1120 ;; otherwise.
1173 (and (not (featurep 'wrolo-menu)) hyperb:window-system 1121 (and (not (featurep 'wrolo-menu)) hyperb:window-system
1174 (or hyperb:lemacs-p hyperb:emacs19-p) (require 'wrolo-menu)) 1122 (or hyperb:lemacs-p hyperb:emacs19-p) (require 'wrolo-menu))
1175 ;; 1123 ;;
1209 Nil before a search is done. 1157 Nil before a search is done.
1210 String search expressions are converted to regular expressions.") 1158 String search expressions are converted to regular expressions.")
1211 1159
1212 (defvar *rolo-wconfig* nil 1160 (defvar *rolo-wconfig* nil
1213 "Saves frame's window configuration prior to a rolodex search.") 1161 "Saves frame's window configuration prior to a rolodex search.")
1214
1215 (defvar wrolo-mode-syntax-table nil
1216 "Syntax table used while in wrolo match mode.")
1217
1218 (if wrolo-mode-syntax-table
1219 ()
1220 (setq wrolo-mode-syntax-table (make-syntax-table text-mode-syntax-table))
1221 ;; Support syntactic selection of delimited e-mail addresses.
1222 (modify-syntax-entry ?< "(>" wrolo-mode-syntax-table)
1223 (modify-syntax-entry ?> ")<" wrolo-mode-syntax-table))
1224 1162
1225 (defvar wrolo-mode-map nil 1163 (defvar wrolo-mode-map nil
1226 "Keymap for the rolodex match buffer.") 1164 "Keymap for the rolodex match buffer.")
1227 1165
1228 (if wrolo-mode-map 1166 (if wrolo-mode-map