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