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