|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-ftr.el
|
|
|
4 ;; SUMMARY: OO-Browser feature browsing support.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
24
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 20-Aug-91 at 18:16:36
|
|
24
|
12 ;; LAST-MOD: 20-Feb-97 at 07:02:51 by Bob Weiner
|
|
0
|
13 ;;
|
|
24
|
14 ;; Copyright (C) 1991-1996, Free Software Foundation, Inc.
|
|
0
|
15 ;; See the file BR-COPY for license information.
|
|
|
16 ;;
|
|
|
17 ;; This file is part of the OO-Browser.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;; DESCRIP-END.
|
|
|
21
|
|
|
22 ;;; ************************************************************************
|
|
|
23 ;;; Public variables
|
|
|
24 ;;; ************************************************************************
|
|
|
25
|
|
|
26 (defconst br-feature-type-regexp "[-+=@%>1/]"
|
|
24
|
27 "Regular expression which matches the first non-whitespace character in an OO-Browser feature listing.")
|
|
0
|
28
|
|
|
29 ;;; ************************************************************************
|
|
|
30 ;;; Public functions
|
|
|
31 ;;; ************************************************************************
|
|
|
32
|
|
24
|
33 (defun br-edit-feature (class feature-name &optional other-win view-only)
|
|
|
34 "Edit the definition of CLASS' FEATURE-NAME, optionally in some OTHER-WIN if non-nil.
|
|
|
35 With optional VIEW-ONLY non-nil, view the feature definition instead of editing it.
|
|
|
36 Return the pathname of the feature definition if found, else nil."
|
|
|
37 (interactive
|
|
|
38 (list nil (br-feature-complete 'must-match "Edit feature definition:")
|
|
|
39 nil nil))
|
|
|
40 (let ((tag-and-file (br-feature-tag-and-file
|
|
|
41 (if (null class)
|
|
|
42 ;; Assume feature-name includes prepended class in
|
|
|
43 ;; proper format, e.g. when called interactively.
|
|
|
44 (regexp-quote feature-name)
|
|
|
45 (br-feature-tag-regexp class feature-name)))))
|
|
|
46 (if tag-and-file (br-edit-feature-from-tag
|
|
|
47 (car tag-and-file) (cdr tag-and-file) other-win view-only))))
|
|
0
|
48
|
|
24
|
49 (defun br-edit-feature-from-tag (tag-entry feature-path &optional other-win view-only)
|
|
|
50 "Edit feature for OO-Browser TAG-ENTRY of file FEATURE-PATH, optionally in OTHER-WIN if non-nil.
|
|
0
|
51 With optional VIEW-ONLY, view feature definition instead of editing it.
|
|
|
52 Return FEATURE-PATH if feature definition is found, else nil."
|
|
|
53 (let ((err))
|
|
|
54 (cond ((and feature-path (file-readable-p feature-path))
|
|
|
55 (cond ((br-feature-found-p feature-path tag-entry nil other-win)
|
|
|
56 (br-major-mode)
|
|
|
57 (if view-only
|
|
|
58 (setq buffer-read-only t)
|
|
|
59 ;; Handle case of already existing buffer in
|
|
|
60 ;; read only mode.
|
|
|
61 (and buffer-read-only
|
|
|
62 (file-writable-p feature-path)
|
|
|
63 (setq buffer-read-only nil)))
|
|
|
64 ;; Force mode-line redisplay
|
|
|
65 (set-buffer-modified-p (buffer-modified-p)))
|
|
|
66 ((interactive-p)
|
|
|
67 (setq err
|
|
|
68 (format
|
|
24
|
69 "(OO-Browser): No `%s' feature defined in Environment."
|
|
0
|
70 tag-entry)
|
|
|
71 feature-path nil))))
|
|
|
72 ((interactive-p)
|
|
|
73 (setq err
|
|
|
74 (format
|
|
24
|
75 "(OO-Browser): `%s' - src file not found or not readable, %s"
|
|
0
|
76 tag-entry feature-path)
|
|
|
77 feature-path nil)))
|
|
|
78 (if err (error err))
|
|
|
79 feature-path))
|
|
|
80
|
|
24
|
81 (defun br-find-feature (&optional feature-entry view-only other-win)
|
|
|
82 "Display feature definition for FEATURE-ENTRY in VIEW-ONLY mode if non-nil.
|
|
|
83 Return feature path if FEATURE-ENTRY is successfully displayed, nil
|
|
|
84 otherwise. Can also signal an error when called interactively."
|
|
|
85 (interactive)
|
|
|
86 (and (interactive-p) (setq view-only current-prefix-arg))
|
|
|
87 (let ((feature-path))
|
|
|
88 (setq feature-entry
|
|
|
89 (br-feature-signature-and-file
|
|
|
90 (or feature-entry
|
|
|
91 (br-feature-complete 'must-match
|
|
|
92 (if view-only
|
|
|
93 "View feature definition:"
|
|
|
94 "Edit feature definition:"))))
|
|
|
95 feature-path (cdr feature-entry)
|
|
|
96 feature-entry (car feature-entry))
|
|
|
97 (br-edit-feature-from-tag feature-entry feature-path other-win view-only)))
|
|
|
98
|
|
0
|
99 (defun br-find-feature-entry ()
|
|
|
100 "Return feature entry that point is within or nil."
|
|
|
101 (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
|
|
|
102 (save-excursion
|
|
|
103 (beginning-of-line)
|
|
|
104 (if (or
|
|
|
105 (progn (skip-chars-forward " \t")
|
|
|
106 (looking-at br-feature-entry))
|
|
|
107 ;; Get current feature signature, if any.
|
|
|
108 (br-feature-get-signature))
|
|
|
109 (let ((feature (buffer-substring
|
|
|
110 (point)
|
|
|
111 (progn (skip-chars-forward "^\t\n\r") (point)))))
|
|
|
112 (if (and (equal br-lang-prefix "objc-")
|
|
|
113 ;; Remove any trailing class from a category entry.
|
|
|
114 (string-match "@ ([^\)]+)" feature))
|
|
|
115 (substring feature 0 (match-end 0))
|
|
|
116 feature)))))
|
|
|
117
|
|
|
118 (defun br-feature-complete (&optional must-match prompt)
|
|
|
119 "Interactively completes feature entry if possible, and returns it.
|
|
|
120 Optional MUST-MATCH means must match a completion table entry.
|
|
|
121 Optional PROMPT is intial prompt string for user."
|
|
|
122 (interactive)
|
|
|
123 (let ((default (br-find-feature-entry))
|
|
|
124 (completion-ignore-case t)
|
|
|
125 completions
|
|
|
126 ftr-entry)
|
|
|
127 ;; Prompt with possible completions of ftr-entry.
|
|
|
128 (setq prompt (or prompt "Feature entry:")
|
|
|
129 completions (br-feature-completions)
|
|
|
130 ftr-entry
|
|
|
131 (if completions
|
|
|
132 (completing-read
|
|
|
133 (format "%s (default %s) " prompt default)
|
|
|
134 completions nil must-match)
|
|
|
135 (read-string
|
|
|
136 (format "%s (default %s) " prompt default))))
|
|
|
137 (if (equal ftr-entry "") default ftr-entry)))
|
|
|
138
|
|
|
139 (defun br-feature-completions ()
|
|
|
140 "Return completion alist of all current Environment elements."
|
|
|
141 (cond ((not (and br-feature-tags-file (file-exists-p br-feature-tags-file)
|
|
|
142 (file-readable-p br-feature-tags-file)))
|
|
|
143 nil)
|
|
|
144 ((and br-feature-tags-completions
|
|
|
145 (eq
|
|
|
146 (car (cdr br-feature-tags-completions)) ;; tags last mod time
|
|
|
147 (apply '+ (nth 5 (file-attributes br-feature-tags-file))))
|
|
|
148 (equal br-env-file (car br-feature-tags-completions)))
|
|
|
149 (car (cdr (cdr br-feature-tags-completions))))
|
|
|
150 (t
|
|
|
151 (let ((ftr-buf (get-buffer-create "*ftr-buf*"))
|
|
|
152 (ftr-alist))
|
|
|
153 (save-excursion
|
|
|
154 (br-feature-tags-init)
|
|
|
155 (copy-to-buffer ftr-buf 1 (point-max))
|
|
|
156 (set-buffer ftr-buf)
|
|
|
157 (goto-char 1)
|
|
|
158 (while (search-forward "\^L" nil t)
|
|
|
159 (forward-line 1)
|
|
|
160 ;; Skip past pathname where features are defined.
|
|
|
161 (while (and (= (forward-line 1) 0)
|
|
|
162 (not (looking-at "\^L\\|\\'")))
|
|
|
163 (setq ftr-alist (cons (cons (br-feature-signature-to-name
|
|
|
164 (br-feature-current)
|
|
24
|
165 t t)
|
|
0
|
166 nil)
|
|
|
167 ftr-alist)))))
|
|
|
168 (kill-buffer ftr-buf)
|
|
|
169 (setq br-feature-tags-completions
|
|
|
170 (list br-env-file
|
|
|
171 ;; tags last mod time
|
|
|
172 (apply '+ (nth 5 (file-attributes
|
|
|
173 br-feature-tags-file)))
|
|
|
174 ftr-alist))
|
|
|
175 ftr-alist))))
|
|
|
176
|
|
|
177 (defun br-feature-def-file (feature-regexp)
|
|
|
178 "Return file name in which feature matching FEATURE-REGEXP is, if any.
|
|
|
179 Assume feature tags file is current buffer and leave point at the start of
|
|
|
180 matching feature tag, if any."
|
|
|
181 (goto-char 1)
|
|
|
182 (and (re-search-forward feature-regexp nil t)
|
|
|
183 ;; This ensures that point is left on the same line as the feature tag
|
|
|
184 ;; which is found.
|
|
|
185 (goto-char (match-beginning 0))
|
|
|
186 (br-feature-file-of-tag)))
|
|
|
187
|
|
|
188 (defun br-feature-file (feature-sig)
|
|
|
189 "Return file name in which feature matching FEATURE-SIG is, if any."
|
|
|
190 (let ((obuf (current-buffer))
|
|
|
191 (file))
|
|
|
192 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
193 (goto-char 1)
|
|
|
194 (if (search-forward feature-sig nil t)
|
|
|
195 (setq file (br-feature-file-of-tag)))
|
|
|
196 (set-buffer obuf)
|
|
|
197 file))
|
|
|
198
|
|
|
199 (defun br-feature-found-p (buf-file feature-tag
|
|
|
200 &optional deferred-class other-win regexp-flag)
|
|
|
201 "Search BUF-FILE for FEATURE-TAG.
|
|
|
202 Return nil if not found, otherwise display it and return non-nil."
|
|
|
203 (if buf-file
|
|
|
204 (let ((found-def)
|
|
|
205 (opoint (point))
|
|
|
206 (prev-buf)
|
|
|
207 (prev-point)
|
|
|
208 (config (current-window-configuration)))
|
|
|
209 (setq prev-buf (get-file-buffer buf-file))
|
|
|
210 (funcall br-edit-file-function buf-file other-win)
|
|
|
211 (setq prev-point (point))
|
|
|
212 (widen)
|
|
|
213 (goto-char (point-min))
|
|
|
214 (setq found-def
|
|
|
215 (cond (deferred-class
|
|
24
|
216 (br-feature-locate-p feature-tag deferred-class))
|
|
0
|
217 (regexp-flag
|
|
|
218 (br-feature-locate-p feature-tag regexp-flag))
|
|
|
219 (t (br-feature-locate-p feature-tag))))
|
|
|
220 (if found-def
|
|
|
221 ;; Set appropriate mode for file.
|
|
|
222 (br-major-mode)
|
|
|
223 (setq buf-file (get-file-buffer buf-file))
|
|
|
224 (if prev-buf
|
|
|
225 (goto-char prev-point)
|
|
|
226 (if buf-file
|
|
|
227 (kill-buffer buf-file)
|
|
|
228 (goto-char prev-point)))
|
|
|
229 (set-window-configuration config)
|
|
|
230 (goto-char opoint))
|
|
|
231 found-def)))
|
|
|
232
|
|
|
233 (defun br-feature-name (ftr-entry)
|
|
|
234 "Return name part of FTR-ENTRY."
|
|
|
235 (if (equal (string-match br-feature-entry ftr-entry) 0)
|
|
|
236 (substring ftr-entry (match-beginning 1))
|
|
|
237 ""))
|
|
|
238
|
|
|
239 (defun br-feature-signature-and-file (class-and-feature-name)
|
|
|
240 "Return (feature signature . feature-def-file-name) of CLASS-AND-FEATURE-NAME."
|
|
|
241 (let ((obuf (current-buffer))
|
|
|
242 ;; Find only exact matches
|
|
|
243 (name-regexp (br-feature-name-to-regexp class-and-feature-name))
|
|
|
244 (result))
|
|
|
245 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
246 (goto-char 1)
|
|
|
247 (if (re-search-forward name-regexp nil t)
|
|
|
248 (progn (goto-char (match-beginning 0))
|
|
|
249 (setq result (cons (br-feature-current)
|
|
|
250 (br-feature-file-of-tag)))))
|
|
|
251 (set-buffer obuf)
|
|
|
252 result))
|
|
|
253
|
|
|
254 (defun br-feature-signature (&optional arg)
|
|
|
255 "Show full feature signature in the view window.
|
|
|
256 With optional prefix ARG, display signatures of all features from the current
|
|
|
257 buffer."
|
|
|
258 (interactive "P")
|
|
|
259 (let* ((buf (buffer-name))
|
|
|
260 (owind (selected-window))
|
|
|
261 (features (delq nil (if arg (br-feature-get-tags)
|
|
|
262 (list (br-feature-get-signature))))))
|
|
|
263 (if (null features)
|
|
|
264 (progn (beep) (message "No elements."))
|
|
|
265 (br-to-view-window)
|
|
|
266 (switch-to-buffer (get-buffer-create (concat buf "-Elements")))
|
|
|
267 (setq buffer-read-only nil)
|
|
|
268 (erase-buffer)
|
|
|
269 (mapcar (function (lambda (feature) (insert feature "\n")))
|
|
|
270 features)
|
|
|
271 (br-major-mode)
|
|
|
272 (goto-char 1)
|
|
|
273 (select-window owind)
|
|
|
274 (message ""))))
|
|
|
275
|
|
|
276 ;;; ************************************************************************
|
|
|
277 ;;; Listing buffer entry tag property handling.
|
|
|
278 ;;; ************************************************************************
|
|
|
279
|
|
|
280 (if (string-match "^19\." emacs-version)
|
|
|
281 (progn
|
|
|
282 ;;
|
|
|
283 ;; Emacs 19 buffer entry tags functions
|
|
|
284 ;;
|
|
|
285
|
|
|
286 (defun br-feature-clear-signatures (&optional buf-nm)
|
|
|
287 "Erase any feature signatures saved with current buffer or optional BUF-NM."
|
|
|
288 (save-excursion
|
|
|
289 (if buf-nm (set-buffer (get-buffer buf-nm)))
|
|
|
290 (save-restriction
|
|
|
291 (widen)
|
|
|
292 (remove-text-properties (point-min) (point-max) '(tag)))))
|
|
|
293
|
|
|
294 (defun br-feature-get-signature (&optional line-num-minus-one)
|
|
|
295 (save-excursion
|
|
|
296 (if (numberp line-num-minus-one)
|
|
|
297 (goto-line (1+ line-num-minus-one)))
|
|
|
298 (end-of-line)
|
|
|
299 (car (cdr (memq 'tag (text-properties-at (1- (point))))))))
|
|
|
300
|
|
|
301 (defun br-feature-get-tags ()
|
|
|
302 (save-excursion
|
|
|
303 (goto-char (point-max))
|
|
|
304 (let ((found t)
|
|
|
305 (tags)
|
|
|
306 tag)
|
|
|
307 (while found
|
|
|
308 (setq tag (get-text-property (1- (point)) 'tag))
|
|
|
309 (if tag (setq tags (cons tag tags)))
|
|
|
310 (setq found (= (forward-line -1) 0))
|
|
|
311 (end-of-line))
|
|
|
312 tags)))
|
|
|
313
|
|
|
314 ;; Tag property is placed at end of line in case leading indent is
|
|
|
315 ;; removed by an OO-Browser operation. In that case, we don't want to
|
|
|
316 ;; lose the tag property.
|
|
|
317 (defun br-feature-put-signatures (ftr-sigs)
|
|
|
318 (while ftr-sigs
|
|
|
319 (end-of-line)
|
|
|
320 (put-text-property (- (point) 2) (point) 'tag (car ftr-sigs))
|
|
|
321 (setq ftr-sigs (cdr ftr-sigs))
|
|
|
322 (if (and ftr-sigs (/= (forward-line 1) 0))
|
|
|
323 (error "(br-feature-put-signatures): Too few lines in this buffer"))))
|
|
|
324
|
|
|
325 )
|
|
|
326
|
|
|
327 ;;
|
|
|
328 ;; Emacs 18 buffer entry tags functions
|
|
|
329 ;;
|
|
|
330
|
|
|
331 (defun br-feature-clear-signatures (&optional buf-nm)
|
|
|
332 "Erase any feature signatures saved with current buffer or optional BUF-NM."
|
|
|
333 (put (intern (or buf-nm (buffer-name))) 'features nil))
|
|
|
334
|
|
|
335 (defun br-feature-get-signature (&optional line-num)
|
|
|
336 (or (numberp line-num)
|
|
|
337 (save-excursion
|
|
|
338 (beginning-of-line)
|
|
|
339 (setq line-num (count-lines 1 (point)))))
|
|
|
340 (cdr (assq line-num (get (intern-soft (buffer-name)) 'features))))
|
|
|
341
|
|
|
342 (defun br-feature-get-tags ()
|
|
|
343 (get (intern-soft (buffer-name)) 'features))
|
|
|
344
|
|
|
345 (defun br-feature-put-signatures (ftr-sigs)
|
|
|
346 (beginning-of-line)
|
|
|
347 (let* ((line (count-lines 1 (point)))
|
|
|
348 (meth-alist (mapcar (function
|
|
|
349 (lambda (meth)
|
|
|
350 (prog1 (cons line meth)
|
|
|
351 (setq line (1+ line)))))
|
|
|
352 ftr-sigs))
|
|
|
353 (buf-sym (intern (buffer-name))))
|
|
|
354 (put buf-sym 'features
|
|
|
355 (nconc (get buf-sym 'features) meth-alist))))
|
|
|
356 )
|
|
|
357
|
|
|
358 ;;; ************************************************************************
|
|
|
359 ;;; END - Listing buffer entry tag property handling.
|
|
|
360 ;;; ************************************************************************
|
|
|
361
|
|
|
362 (defun br-feature-tags-init ()
|
|
24
|
363 "Set up `br-feature-tags-file' for writing."
|
|
0
|
364 (setq br-feature-tags-completions nil
|
|
|
365 br-feature-tags-file (br-feature-tags-file-name br-env-file)
|
|
|
366 br-tags-file (concat br-env-file "-TAGS"))
|
|
|
367 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
368 (setq buffer-read-only nil))
|
|
|
369
|
|
|
370 (defun br-feature-tags-file-name (env-file)
|
|
|
371 (concat env-file "-FTR"))
|
|
|
372
|
|
|
373 (defun br-feature-tags-save ()
|
|
24
|
374 "Filter out extraneous lines and save `br-feature-tags-file'."
|
|
0
|
375 (let ((obuf (current-buffer)))
|
|
|
376 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
377 (goto-char (point-min))
|
|
|
378 (delete-matching-lines "^[ \t]*$")
|
|
|
379 (goto-char (point-min))
|
|
|
380 (replace-regexp "^[ \t]+\\|[ \t]+$" "")
|
|
|
381 (and br-c-tags-flag
|
|
|
382 (br-member br-lang-prefix '("c++-" "objc-"))
|
|
|
383 (progn (c-build-element-tags)
|
|
|
384 (goto-char (point-min))
|
|
|
385 (replace-regexp "[ \t]*//.*" "")))
|
|
|
386 (goto-char (point-min))
|
|
|
387 (delete-matching-lines "^$")
|
|
|
388 (save-buffer)
|
|
|
389 (set-buffer obuf)))
|
|
|
390
|
|
|
391 (defun br-insert-features (feature-tag-list &optional indent)
|
|
|
392 "Insert feature names from FEATURE-TAG-LIST in current buffer indented INDENT columns."
|
|
|
393 (let ((start (point)))
|
|
|
394 (mapcar (function
|
|
|
395 (lambda (feature-tag)
|
|
|
396 (if indent (indent-to indent))
|
|
|
397 (if feature-tag
|
|
|
398 (insert (br-feature-signature-to-name feature-tag nil t)
|
|
|
399 "\n"))))
|
|
|
400 feature-tag-list)
|
|
|
401 (save-excursion
|
|
|
402 (goto-char start)
|
|
|
403 (br-feature-put-signatures feature-tag-list))))
|
|
|
404
|
|
|
405 ;;; ************************************************************************
|
|
|
406 ;;; Private functions
|
|
|
407 ;;; ************************************************************************
|
|
|
408
|
|
|
409 (defun br-feature-current ()
|
|
|
410 "Extract current feature from tags file and leave point at the end of line."
|
|
|
411 (beginning-of-line)
|
|
|
412 (buffer-substring (point) (progn (end-of-line) (point))))
|
|
|
413
|
|
|
414 (defun br-feature-file-of-tag ()
|
|
|
415 "Return the file name of the file whose tag point is within.
|
|
|
416 Assumes the tag table is the current buffer."
|
|
|
417 (save-excursion
|
|
|
418 (search-backward " " nil t)
|
|
|
419 (forward-line 1)
|
|
|
420 (let ((start (point)))
|
|
|
421 (end-of-line)
|
|
|
422 (buffer-substring start (point)))))
|
|
|
423
|
|
24
|
424 (defun br-feature-tag-and-file (feature-tag-regexp)
|
|
|
425 "Return a cons (FEATURE-TAG . FEATURE-DEF-FILENAME) for the first tag match of FEATURE-TAG-REGEXP, or nil.
|
|
|
426 Use br-feature-tag-regexp to create FEATURE-TAG-REGEXP.
|
|
|
427 Feature tags come from the file named by br-feature-tags-file."
|
|
|
428 (let ((obuf (current-buffer))
|
|
|
429 result)
|
|
|
430 (unwind-protect
|
|
|
431 (progn
|
|
|
432 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
433 (setq result (br-feature-def-file feature-tag-regexp))
|
|
|
434 (if result (cons (br-feature-current) result)))
|
|
|
435 (set-buffer obuf))))
|
|
|
436
|
|
0
|
437 ;;; ************************************************************************
|
|
|
438 ;;; Private variables
|
|
|
439 ;;; ************************************************************************
|
|
|
440
|
|
|
441 (defconst br-feature-entry
|
|
|
442 (concat br-feature-type-regexp " \\([^\t\n\r]*[^ \t\n\r]\\)")
|
|
|
443 "Regexp matching a feature entry in a browser listing buffer.")
|
|
|
444
|
|
|
445 (defvar br-feature-tags-completions nil
|
|
|
446 "List of (envir-name tags-file-last-mod-time tags-completion-alist).")
|
|
|
447
|
|
|
448 (defvar br-feature-tags-file nil
|
|
|
449 "Pathname where current object-oriented feature tags are stored.")
|
|
|
450
|
|
|
451 (defvar br-tags-file nil
|
|
|
452 "Pathname where current non-object-oriented feature tags are stored.")
|
|
|
453
|
|
|
454 (provide 'br-ftr)
|
