Mercurial > hg > xemacs-beta
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 |