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