Mercurial > hg > xemacs-beta
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 |