comparison lisp/oobr/br-ftr.el @ 24:4103f0995bd7 r19-15b95

Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
4 ;; SUMMARY: OO-Browser feature browsing support. 4 ;; SUMMARY: OO-Browser feature browsing support.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: oop, tools 6 ;; KEYWORDS: oop, tools
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola Inc. 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 20-Aug-91 at 18:16:36 11 ;; ORIG-DATE: 20-Aug-91 at 18:16:36
12 ;; LAST-MOD: 25-Aug-95 at 16:54:53 by Bob Weiner 12 ;; LAST-MOD: 20-Feb-97 at 07:02:51 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc. 14 ;; Copyright (C) 1991-1996, Free Software Foundation, Inc.
15 ;; See the file BR-COPY for license information. 15 ;; See the file BR-COPY for license information.
16 ;; 16 ;;
17 ;; This file is part of the OO-Browser. 17 ;; This file is part of the OO-Browser.
18 ;; 18 ;;
19 ;; DESCRIPTION: 19 ;; DESCRIPTION:
22 ;;; ************************************************************************ 22 ;;; ************************************************************************
23 ;;; Public variables 23 ;;; Public variables
24 ;;; ************************************************************************ 24 ;;; ************************************************************************
25 25
26 (defconst br-feature-type-regexp "[-+=@%>1/]" 26 (defconst br-feature-type-regexp "[-+=@%>1/]"
27 "Regular expression which matches the first non-whitespace characters in an OO-Browser feature listing.") 27 "Regular expression which matches the first non-whitespace character in an OO-Browser feature listing.")
28 28
29 ;;; ************************************************************************ 29 ;;; ************************************************************************
30 ;;; Public functions 30 ;;; Public functions
31 ;;; ************************************************************************ 31 ;;; ************************************************************************
32 32
33 (defun br-find-feature (&optional feature-entry view-only other-win) 33 (defun br-edit-feature (class feature-name &optional other-win view-only)
34 "Display feature definition for FEATURE-ENTRY in VIEW-ONLY mode if non-nil. 34 "Edit the definition of CLASS' FEATURE-NAME, optionally in some OTHER-WIN if non-nil.
35 Return feature path if FEATURE-ENTRY is successfully displayed, nil 35 With optional VIEW-ONLY non-nil, view the feature definition instead of editing it.
36 otherwise. Can also signal an error when called interactively." 36 Return the pathname of the feature definition if found, else nil."
37 (interactive) 37 (interactive
38 (and (interactive-p) (setq view-only current-prefix-arg)) 38 (list nil (br-feature-complete 'must-match "Edit feature definition:")
39 (let ((feature-path)) 39 nil nil))
40 (setq feature-entry 40 (let ((tag-and-file (br-feature-tag-and-file
41 (br-feature-signature-and-file 41 (if (null class)
42 (or feature-entry 42 ;; Assume feature-name includes prepended class in
43 (br-feature-complete 'must-match "Show feature definition:"))) 43 ;; proper format, e.g. when called interactively.
44 feature-path (cdr feature-entry) 44 (regexp-quote feature-name)
45 feature-entry (car feature-entry)) 45 (br-feature-tag-regexp class feature-name)))))
46 (br-edit-feature feature-entry feature-path other-win view-only))) 46 (if tag-and-file (br-edit-feature-from-tag
47 47 (car tag-and-file) (cdr tag-and-file) other-win view-only))))
48 (defun br-edit-feature (tag-entry feature-path &optional other-win view-only) 48
49 "Edit feature for OO-Browser TAG-ENTRY of file FEATURE-PATH, optionally in OTHER-WIN. 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.
50 With optional VIEW-ONLY, view feature definition instead of editing it. 51 With optional VIEW-ONLY, view feature definition instead of editing it.
51 Return FEATURE-PATH if feature definition is found, else nil." 52 Return FEATURE-PATH if feature definition is found, else nil."
52 (let ((err)) 53 (let ((err))
53 (cond ((and feature-path (file-readable-p feature-path)) 54 (cond ((and feature-path (file-readable-p feature-path))
54 (cond ((br-feature-found-p feature-path tag-entry nil other-win) 55 (cond ((br-feature-found-p feature-path tag-entry nil other-win)
63 ;; Force mode-line redisplay 64 ;; Force mode-line redisplay
64 (set-buffer-modified-p (buffer-modified-p))) 65 (set-buffer-modified-p (buffer-modified-p)))
65 ((interactive-p) 66 ((interactive-p)
66 (setq err 67 (setq err
67 (format 68 (format
68 "(OO-Browser): No '%s' feature defined in Environment." 69 "(OO-Browser): No `%s' feature defined in Environment."
69 tag-entry) 70 tag-entry)
70 feature-path nil)))) 71 feature-path nil))))
71 ((interactive-p) 72 ((interactive-p)
72 (setq err 73 (setq err
73 (format 74 (format
74 "(OO-Browser): '%s' - src file not found or not readable, %s" 75 "(OO-Browser): `%s' - src file not found or not readable, %s"
75 tag-entry feature-path) 76 tag-entry feature-path)
76 feature-path nil))) 77 feature-path nil)))
77 (if err (error err)) 78 (if err (error err))
78 feature-path)) 79 feature-path))
80
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)))
79 98
80 (defun br-find-feature-entry () 99 (defun br-find-feature-entry ()
81 "Return feature entry that point is within or nil." 100 "Return feature entry that point is within or nil."
82 (if (= (point) (point-max)) (skip-chars-backward " \t\n")) 101 (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
83 (save-excursion 102 (save-excursion
141 ;; Skip past pathname where features are defined. 160 ;; Skip past pathname where features are defined.
142 (while (and (= (forward-line 1) 0) 161 (while (and (= (forward-line 1) 0)
143 (not (looking-at "\^L\\|\\'"))) 162 (not (looking-at "\^L\\|\\'")))
144 (setq ftr-alist (cons (cons (br-feature-signature-to-name 163 (setq ftr-alist (cons (cons (br-feature-signature-to-name
145 (br-feature-current) 164 (br-feature-current)
146 t) 165 t t)
147 nil) 166 nil)
148 ftr-alist))))) 167 ftr-alist)))))
149 (kill-buffer ftr-buf) 168 (kill-buffer ftr-buf)
150 (setq br-feature-tags-completions 169 (setq br-feature-tags-completions
151 (list br-env-file 170 (list br-env-file
192 (setq prev-point (point)) 211 (setq prev-point (point))
193 (widen) 212 (widen)
194 (goto-char (point-min)) 213 (goto-char (point-min))
195 (setq found-def 214 (setq found-def
196 (cond (deferred-class 215 (cond (deferred-class
197 (br-feature-locate-p feature-tag deferred-class)) 216 (br-feature-locate-p feature-tag deferred-class))
198 (regexp-flag 217 (regexp-flag
199 (br-feature-locate-p feature-tag regexp-flag)) 218 (br-feature-locate-p feature-tag regexp-flag))
200 (t (br-feature-locate-p feature-tag)))) 219 (t (br-feature-locate-p feature-tag))))
201 (if found-def 220 (if found-def
202 ;; Set appropriate mode for file. 221 ;; Set appropriate mode for file.
339 ;;; ************************************************************************ 358 ;;; ************************************************************************
340 ;;; END - Listing buffer entry tag property handling. 359 ;;; END - Listing buffer entry tag property handling.
341 ;;; ************************************************************************ 360 ;;; ************************************************************************
342 361
343 (defun br-feature-tags-init () 362 (defun br-feature-tags-init ()
344 "Set up 'br-feature-tags-file' for writing." 363 "Set up `br-feature-tags-file' for writing."
345 (setq br-feature-tags-completions nil 364 (setq br-feature-tags-completions nil
346 br-feature-tags-file (br-feature-tags-file-name br-env-file) 365 br-feature-tags-file (br-feature-tags-file-name br-env-file)
347 br-tags-file (concat br-env-file "-TAGS")) 366 br-tags-file (concat br-env-file "-TAGS"))
348 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) 367 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
349 (setq buffer-read-only nil)) 368 (setq buffer-read-only nil))
350 369
351 (defun br-feature-tags-file-name (env-file) 370 (defun br-feature-tags-file-name (env-file)
352 (concat env-file "-FTR")) 371 (concat env-file "-FTR"))
353 372
354 (defun br-feature-tags-save () 373 (defun br-feature-tags-save ()
355 "Filter out extraneous lines and save 'br-feature-tags-file'." 374 "Filter out extraneous lines and save `br-feature-tags-file'."
356 (let ((obuf (current-buffer))) 375 (let ((obuf (current-buffer)))
357 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) 376 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
358 (goto-char (point-min)) 377 (goto-char (point-min))
359 (delete-matching-lines "^[ \t]*$") 378 (delete-matching-lines "^[ \t]*$")
360 (goto-char (point-min)) 379 (goto-char (point-min))
400 (forward-line 1) 419 (forward-line 1)
401 (let ((start (point))) 420 (let ((start (point)))
402 (end-of-line) 421 (end-of-line)
403 (buffer-substring start (point))))) 422 (buffer-substring start (point)))))
404 423
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
405 ;;; ************************************************************************ 437 ;;; ************************************************************************
406 ;;; Private variables 438 ;;; Private variables
407 ;;; ************************************************************************ 439 ;;; ************************************************************************
408 440
409 (defconst br-feature-entry 441 (defconst br-feature-entry