|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: wrolo-logic.el
|
|
|
4 ;; SUMMARY: Performs logical retrievals on rolodex files
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, matching
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Motorola Inc.
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 13-Jun-89 at 22:57:33
|
|
|
12 ;; LAST-MOD: 14-Apr-95 at 16:27:43 by Bob Weiner
|
|
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1989-1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;;
|
|
|
22 ;; INSTALLATION:
|
|
|
23 ;;
|
|
|
24 ;; See also wrolo.el. These functions are separated from wrolo.el since many
|
|
|
25 ;; users may never want or need them. They can be automatically loaded when
|
|
|
26 ;; desired by adding the following to one of your Emacs init files:
|
|
|
27 ;;
|
|
|
28 ;; (autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t)
|
|
|
29 ;;
|
|
|
30 ;; FEATURES:
|
|
|
31 ;;
|
|
|
32 ;; 1. One command, 'rolo-logic' which takes a logical search expression as
|
|
|
33 ;; an argument and displays any matching entries.
|
|
|
34 ;;
|
|
|
35 ;; 2. Logical 'and', 'or', 'not', and 'xor' rolodex entry retrieval filter
|
|
|
36 ;; functions. They take any number of string or boolean arguments and
|
|
|
37 ;; may be nested. NOTE THAT THESE FUNCTIONS SHOULD NEVER BE CALLED
|
|
|
38 ;; DIRECTLY UNLESS THE FREE VARIABLES 'start' and 'end' ARE BOUND
|
|
|
39 ;; BEFOREHAND.
|
|
|
40 ;;
|
|
|
41 ;; EXAMPLE:
|
|
|
42 ;;
|
|
|
43 ;; (rolo-logic (function
|
|
|
44 ;; (lambda ()
|
|
|
45 ;; (rolo-and
|
|
|
46 ;; (rolo-not "Tool-And-Die")
|
|
|
47 ;; "secretary"))))
|
|
|
48 ;;
|
|
|
49 ;; would find all non-Tool-And-Die Corp. secretaries in your rolodex.
|
|
|
50 ;;
|
|
|
51 ;; The logical matching routines are not at all optimal, but then most
|
|
|
52 ;; rolodex files are not terribly lengthy either.
|
|
|
53 ;;
|
|
|
54 ;; DESCRIP-END.
|
|
|
55
|
|
|
56 (require 'wrolo)
|
|
|
57
|
|
|
58 ;;;###autoload
|
|
|
59 (defun rolo-logic (func &optional in-bufs count-only include-sub-entries
|
|
|
60 no-sub-entries-out)
|
|
|
61 "Apply FUNC to all entries in optional IN-BUFS, display entries where FUNC is non-nil.
|
|
|
62 If IN-BUFS is nil, 'rolo-file-list' is used. If optional COUNT-ONLY is
|
|
|
63 non-nil, don't display entries, return count of matching entries only. If
|
|
|
64 optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC will be applied across all
|
|
|
65 sub-entries at once. Default is to apply FUNC to each entry and sub-entry
|
|
|
66 separately. Entries are displayed with all of their sub-entries unless
|
|
|
67 INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil.
|
|
|
68 FUNC should use the free variables 'start' and 'end' which contain the limits
|
|
|
69 of the region on which it should operate. Returns number of applications of
|
|
|
70 FUNC that return non-nil."
|
|
|
71 (interactive "xLogic function of no arguments, (lambda () (<function calls>): ")
|
|
|
72 (let ((obuf (current-buffer))
|
|
|
73 (display-buf (if count-only
|
|
|
74 nil
|
|
|
75 (prog1 (set-buffer (get-buffer-create rolo-display-buffer))
|
|
|
76 (setq buffer-read-only nil)
|
|
|
77 (erase-buffer)))))
|
|
|
78 (let ((result
|
|
|
79 (mapcar
|
|
|
80 (function
|
|
|
81 (lambda (in-bufs)
|
|
|
82 (rolo-map-logic func in-bufs count-only include-sub-entries
|
|
|
83 no-sub-entries-out)))
|
|
|
84 (cond ((null in-bufs) rolo-file-list)
|
|
|
85 ((listp in-bufs) in-bufs)
|
|
|
86 ((list in-bufs))))))
|
|
|
87 (let ((total-matches (apply '+ result)))
|
|
|
88 (if (or count-only (= total-matches 0))
|
|
|
89 nil
|
|
|
90 (pop-to-buffer display-buf)
|
|
|
91 (goto-char (point-min))
|
|
|
92 (set-buffer-modified-p nil)
|
|
|
93 (setq buffer-read-only t)
|
|
|
94 (let ((buf (get-buffer-window obuf)))
|
|
|
95 (if buf (select-window buf) (switch-to-buffer buf))))
|
|
|
96 (if (interactive-p)
|
|
|
97 (message (concat (if (= total-matches 0) "No" total-matches)
|
|
|
98 " matching entr"
|
|
|
99 (if (= total-matches 1) "y" "ies")
|
|
|
100 " found in rolodex.")))
|
|
|
101 total-matches))))
|
|
|
102
|
|
|
103 (defun rolo-map-logic (func rolo-buf &optional count-only
|
|
|
104 include-sub-entries no-sub-entries-out)
|
|
|
105 "Apply FUNC to all entries in ROLO-BUF, write to buffer entries where FUNC is non-nil.
|
|
|
106 If optional COUNT-ONLY is non-nil, don't display entries, return count of
|
|
|
107 matching entries only. If optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC
|
|
|
108 will be applied across all sub-entries at once. Default is to apply FUNC to
|
|
|
109 each entry and sub-entry separately. Entries are displayed with all of their
|
|
|
110 sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT
|
|
|
111 flag is non-nil. FUNC should use the free variables 'start' and 'end' which
|
|
|
112 contain the limits of the region on which it should operate. Returns number
|
|
|
113 of applications of FUNC that return non-nil."
|
|
|
114 (if (or (bufferp rolo-buf)
|
|
|
115 (if (file-exists-p rolo-buf)
|
|
|
116 (setq rolo-buf (find-file-noselect rolo-buf t))))
|
|
|
117 (let* ((display-buf (set-buffer (get-buffer-create rolo-display-buffer)))
|
|
|
118 (buffer-read-only))
|
|
|
119 (let ((hdr-pos) (num-found 0))
|
|
|
120 (set-buffer rolo-buf)
|
|
|
121 (goto-char (point-min))
|
|
|
122 (if (re-search-forward rolo-hdr-regexp nil t 2)
|
|
|
123 (progn (forward-line)
|
|
|
124 (setq hdr-pos (cons (point-min) (point)))))
|
|
|
125 (let* ((start)
|
|
|
126 (end)
|
|
|
127 (end-entry-hdr)
|
|
|
128 (curr-entry-level))
|
|
|
129 (while (re-search-forward rolo-entry-regexp nil t)
|
|
|
130 (setq start (save-excursion (beginning-of-line) (point))
|
|
|
131 next-entry-exists nil
|
|
|
132 end-entry-hdr (point)
|
|
|
133 curr-entry-level (buffer-substring start end-entry-hdr)
|
|
|
134 end (rolo-to-entry-end include-sub-entries curr-entry-level))
|
|
|
135 (let ((fun (funcall func)))
|
|
|
136 (or count-only
|
|
|
137 (and fun (= num-found 0) hdr-pos
|
|
|
138 (append-to-buffer display-buf
|
|
|
139 (car hdr-pos) (cdr hdr-pos))))
|
|
|
140 (if fun
|
|
|
141 (progn (goto-char end)
|
|
|
142 (setq num-found (1+ num-found)
|
|
|
143 end (if (or include-sub-entries
|
|
|
144 no-sub-entries-out)
|
|
|
145 end
|
|
|
146 (goto-char (rolo-to-entry-end
|
|
|
147 t curr-entry-level))))
|
|
|
148 (or count-only
|
|
|
149 (append-to-buffer display-buf start end)))
|
|
|
150 (goto-char end-entry-hdr)))))
|
|
|
151 (rolo-kill-buffer rolo-buf)
|
|
|
152 num-found))
|
|
|
153 0))
|
|
|
154
|
|
|
155
|
|
|
156 ;;
|
|
|
157 ;; INTERNAL FUNCTIONS.
|
|
|
158 ;;
|
|
|
159
|
|
|
160 ;; Do NOT call the following functions directly.
|
|
|
161 ;; Send them as parts of a lambda expression to 'rolo-logic'.
|
|
|
162
|
|
|
163 (defun rolo-not (&rest pat-list)
|
|
|
164 "Logical <not> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
165 Each element may be t, nil, or a string."
|
|
|
166 (let ((pat))
|
|
|
167 (while (and pat-list
|
|
|
168 (or (not (setq pat (car pat-list)))
|
|
|
169 (and (not (eq pat t))
|
|
|
170 (goto-char start)
|
|
|
171 (not (search-forward pat end t)))))
|
|
|
172 (setq pat-list (cdr pat-list)))
|
|
|
173 (if pat-list nil t)))
|
|
|
174
|
|
|
175 (defun rolo-or (&rest pat-list)
|
|
|
176 "Logical <or> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
177 Each element may be t, nil, or a string."
|
|
|
178 (if (memq t pat-list)
|
|
|
179 t
|
|
|
180 (let ((pat))
|
|
|
181 (while (and pat-list
|
|
|
182 (or (not (setq pat (car pat-list)))
|
|
|
183 (and (not (eq pat t))
|
|
|
184 (goto-char start)
|
|
|
185 (not (search-forward pat end t)))))
|
|
|
186 (setq pat-list (cdr pat-list)))
|
|
|
187 (if pat-list t nil))))
|
|
|
188
|
|
|
189 (defun rolo-xor (&rest pat-list)
|
|
|
190 "Logical <xor> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
191 Each element may be t, nil, or a string."
|
|
|
192 (let ((pat)
|
|
|
193 (matches 0))
|
|
|
194 (while (and pat-list
|
|
|
195 (or (not (setq pat (car pat-list)))
|
|
|
196 (and (or (eq pat t)
|
|
|
197 (not (goto-char start))
|
|
|
198 (search-forward pat end t))
|
|
|
199 (setq matches (1+ matches)))
|
|
|
200 t)
|
|
|
201 (< matches 2))
|
|
|
202 (setq pat-list (cdr pat-list)))
|
|
|
203 (= matches 1)))
|
|
|
204
|
|
|
205 (defun rolo-and (&rest pat-list)
|
|
|
206 "Logical <and> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
207 Each element may be t, nil, or a string."
|
|
|
208 (if (memq nil pat-list)
|
|
|
209 nil
|
|
|
210 (let ((pat))
|
|
|
211 (while (and pat-list
|
|
|
212 (setq pat (car pat-list))
|
|
|
213 (or (eq pat t)
|
|
|
214 (not (goto-char start))
|
|
|
215 (search-forward pat end t)))
|
|
|
216 (setq pat-list (cdr pat-list)))
|
|
|
217 (if pat-list nil t))))
|
|
|
218
|
|
|
219 ;; Work with regular expression patterns rather than strings
|
|
|
220
|
|
|
221 (defun rolo-r-not (&rest pat-list)
|
|
|
222 "Logical <not> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
223 Each element may be t, nil, or a string."
|
|
|
224 (let ((pat))
|
|
|
225 (while (and pat-list
|
|
|
226 (or (not (setq pat (car pat-list)))
|
|
|
227 (and (not (eq pat t))
|
|
|
228 (goto-char start)
|
|
|
229 (not (re-search-forward pat end t)))))
|
|
|
230 (setq pat-list (cdr pat-list)))
|
|
|
231 (if pat-list nil t)))
|
|
|
232
|
|
|
233 (defun rolo-r-or (&rest pat-list)
|
|
|
234 "Logical <or> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
235 Each element may be t, nil, or a string."
|
|
|
236 (if (memq t pat-list)
|
|
|
237 t
|
|
|
238 (let ((pat))
|
|
|
239 (while (and pat-list
|
|
|
240 (or (not (setq pat (car pat-list)))
|
|
|
241 (and (not (eq pat t))
|
|
|
242 (goto-char start)
|
|
|
243 (not (re-search-forward pat end t)))))
|
|
|
244 (setq pat-list (cdr pat-list)))
|
|
|
245 (if pat-list t nil))))
|
|
|
246
|
|
|
247 (defun rolo-r-xor (&rest pat-list)
|
|
|
248 "Logical <xor> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
249 Each element may be t, nil, or a string."
|
|
|
250 (let ((pat)
|
|
|
251 (matches 0))
|
|
|
252 (while (and pat-list
|
|
|
253 (or (not (setq pat (car pat-list)))
|
|
|
254 (and (or (eq pat t)
|
|
|
255 (not (goto-char start))
|
|
|
256 (re-search-forward pat end t))
|
|
|
257 (setq matches (1+ matches)))
|
|
|
258 t)
|
|
|
259 (< matches 2))
|
|
|
260 (setq pat-list (cdr pat-list)))
|
|
|
261 (= matches 1)))
|
|
|
262
|
|
|
263 (defun rolo-r-and (&rest pat-list)
|
|
|
264 "Logical <and> rolodex entry filter. PAT-LIST is a list of pattern elements.
|
|
|
265 Each element may be t, nil, or a string."
|
|
|
266 (if (memq nil pat-list)
|
|
|
267 nil
|
|
|
268 (let ((pat))
|
|
|
269 (while (and pat-list
|
|
|
270 (setq pat (car pat-list))
|
|
|
271 (or (eq pat t)
|
|
|
272 (not (goto-char start))
|
|
|
273 (re-search-forward pat end t)))
|
|
|
274 (setq pat-list (cdr pat-list)))
|
|
|
275 (if pat-list nil t))))
|
|
|
276
|
|
|
277 (provide 'wrolo-logic)
|
