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