4 ;; SUMMARY: Hyperbole Key control for the OO-Browser.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: mouse, oop, tools
11 ;; ORIG-DATE: Sep-04-90
12 ;; LAST-MOD: 10-May-01 at 13:32:59 by Bob Weiner
14 ;; Copyright (C) 1990-1995, 1997, 1998 BeOpen.com
15 ;; See the file BR-COPY for license information.
17 ;; This file is part of the OO-Browser.
22 ;;; ************************************************************************
23 ;;; Other required Elisp libraries
24 ;;; ************************************************************************
28 ;;; ************************************************************************
29 ;;; smart-br functions
30 ;;; ************************************************************************
32 ;;; Unused unless the "br.el" library, part of the OO-Browser package, has
36 "Controls OO-Browser listing buffers with one key or mouse key.
38 Invoked via a key press when in an OO-Browser listing window. It assumes
39 that its caller has already checked that the key was pressed in an
40 appropriate buffer and has moved the cursor to the selected buffer.
43 (1) in a blank buffer or at the end of a buffer, browser help
44 information is displayed in the viewer window;
45 (2) on a default class name, the statically defined instances of the default
47 (3) at the beginning of a (non-single character) class name, the class'
49 (4) at the end of an entry line, the listing is scrolled up;
50 (5) on the `...', following a class name, point is moved to the class
51 descendency expansion;
52 (6) before an element entry, the element's implementors are listed;
53 (7) anywhere else on an entry line, the entry's source is displayed for
60 (and action-mouse-key-prev-window
61 (select-window action-mouse-key-prev-window)))
62 ((eolp) (smart-scroll-up))
63 ((br-at-default-class-p) (br-features 1))
66 (skip-chars-backward " \t")
70 (if (br-in-browser) (br-to-from-viewer))))
72 (skip-chars-backward " \t")
74 (let ((cl (br-find-class-name)))
75 (and cl (/= (length cl) 1))))
79 (if (br-in-browser) (br-to-from-viewer))
82 (defun smart-br-assist ()
83 "Controls OO-Browser listing buffers with one assist-key or mouse assist-key.
85 Invoked via an assist-key press when in an OO-Browser listing window. It
86 assumes that its caller has already checked that the assist-key was pressed in
87 an appropriate buffer and has moved the cursor to the selected buffer.
89 If assist-key is pressed:
90 (1) in a blank buffer, a selection list of buffer files is displayed;
91 (2) on a default class name, the statically defined instances of
92 the default class are listed;
93 (3) at the beginning of a (non-single character) class, the class'
94 descendants are listed;
95 (4) at the end of an entry line, the listing is scrolled down;
96 (5) on the `...', following a class name, point is moved to the class
98 (6) anywhere else on a class line, the class' elements are listed;
99 (7) anywhere else on an element line, the element's implementors
101 (8) on a blank line following all entries, the current listing buffer
106 (cond ((equal 0 (string-match br-buffer-prefix-blank (buffer-name)))
108 ((eobp) (br-exit-level 1))
109 ((eolp) (smart-scroll-down))
110 ((br-at-default-class-p) (br-features 1))
111 ((br-at-feature-p) (br-implementors))
112 ((and (save-excursion
113 (skip-chars-backward " \t")
115 (let ((cl (br-find-class-name)))
116 (and cl (/= (length cl) 1))))
119 (t (br-features 1))))
121 (defun smart-br-dispatch ()
122 (cond ((or (br-listing-window-p) (eq major-mode 'br-mode))
123 ;; In an OO-Browser listing window.
125 ((eq major-mode 'Info-mode) (smart-info))
126 ((eolp) (smart-scroll-up))
127 ((and (boundp 'br-src-file-regexp)
129 (fboundp (symbol-function 'br-to-definition))
130 (string-match br-src-file-regexp buffer-file-name))
132 ((and action-mouse-key-prev-window
133 (or (smart-br-cmd-select nil)
134 (error "(Action Key): No command bound to key."))))
137 (defun smart-br-assist-dispatch ()
138 (if (or (br-listing-window-p) (eq major-mode 'br-mode))
139 ;; In an OO-Browser listing window.
141 (cond ((eq major-mode 'Info-mode)
143 ((eolp) (smart-scroll-down))
144 ((and action-mouse-key-prev-window
145 (or (smart-br-cmd-select 'assist)
146 (error "(Assist Key): No command bound to key."))))
149 (defun smart-br-cmd-select (&optional assist-flag)
150 "Selects an OO-Browser command with its key binding at point.
151 By default executes the command, with optional ASSIST-FLAG non-nil, shows help for
152 command. Returns t if a command is selected. Nil indicates no key binding was
153 found on the current line. Key bindings are delimited by {}."
154 (let ((start) (end) (tmp-buf) (tmp-buf-nm) (obuf (current-buffer)))
156 (or (eobp) (forward-char))
159 (setq start (point)))
160 (and (re-search-backward "\\(^\\|[^\\]\\){" start t)
162 (goto-char (match-end 0))
167 (and (re-search-forward "[^\\]}" end t)
168 (setq end (1- (point)))))))
170 (setq tmp-buf-nm "*smart-br-tmp*"
171 tmp-buf (progn (if (get-buffer tmp-buf-nm)
172 (kill-buffer tmp-buf-nm))
173 (get-buffer-create tmp-buf-nm)))
176 "(Action Key): (smart-br-cmd-select) - Can't create tmp-buf."))
177 (copy-to-buffer tmp-buf start end)
179 (let ((case-fold-search nil) (case-replace t)
181 (pref-arg action-mouse-key-prefix-arg))
182 ;; Quote Control and Meta key names
183 (goto-char (point-min))
184 (replace-regexp "[ \t]+" "")
185 (goto-char (point-min))
186 (replace-string "SPC" "\040")
187 (goto-char (point-min))
188 (replace-string "DEL" "\177")
189 (goto-char (point-min))
190 (replace-regexp "ESC" "M-")
191 (goto-char (point-min))
192 ;; Unqote special {} chars.
193 (replace-regexp "\\\\\\([{}]\\)" "\\1")
194 (goto-char (point-min))
195 (if (looking-at "C-u")
196 (progn (delete-char 3)
197 (and (or (null pref-arg)
199 (setq pref-arg '(4)))))
200 (while (search-forward "C-" nil t)
202 (setq keys (1+ (- (downcase (following-char)) ?a)))
205 (goto-char (point-min))
206 (while (search-forward "M-" nil t)
208 (setq keys (+ 128 (downcase (following-char))))
211 (setq keys (buffer-string))
212 (kill-buffer tmp-buf-nm)
214 (and (boundp 'action-mouse-key-prev-window)
215 action-mouse-key-prev-window
216 (select-window action-mouse-key-prev-window))
217 (let ((current-prefix-arg pref-arg)
218 (binding (key-binding keys)))
223 (call-interactively binding))
226 (defun smart-element ()
227 "Jumps to the source line associated with an interim OOBR-FTR feature tags file entry.
228 Assumes caller has checked that point is within an OOBR-FTR buffer, an
229 *Implementors* listing buffer, or an Element signatures listing buffer from
230 the OO-Browser. If on a tag entry line, jumps to the source line for the
231 tag. If on a class name line, jumps to the class definition. If on a
232 pathname line or line preceding it, jumps to the associated file."
236 ;; On a file separator or file entry line, display the file.
238 (and (or (and (eq (following-char) ?\^L)
239 (zerop (forward-line 1)))
240 (and (zerop (forward-line -1))
241 (eq (following-char) ?\^L)
242 (zerop (forward-line 1))))
243 (looking-at "\"?\\([^,\n\r\"]+\\)\"?$")))
244 (let ((file (buffer-substring (match-beginning 1) (match-end 1))))
245 (if (and (fboundp 'ibut:label-set) (fboundp 'hproperty:but-flash))
246 (progn (ibut:label-set file (match-beginning 1) (match-end 1))
247 (hproperty:but-flash)))
250 ;; On an OO-Browser V3 element tag line, display its source code definition.
251 ((save-excursion (beginning-of-line) (looking-at br-tag-fields-regexp))
252 (let* ((bol (progn (back-to-indentation) (point)))
253 (eol (progn (end-of-line) (point)))
254 (ftr-tag (buffer-substring bol eol))
256 (setq def-file (br-feature-v3-def-file (regexp-quote ftr-tag)))
258 (progn (if (and (fboundp 'ibut:label-set)
259 (fboundp 'hproperty:but-flash))
260 (progn (ibut:label-set ftr-tag bol eol)
261 (hproperty:but-flash)))
262 (if (br-edit-feature-from-tag ftr-tag def-file)
264 (error "(Action Key): (smart-element) - `%s' def not found in \"%s\""
265 (br-feature-signature-to-name ftr-tag) def-file)))
266 (error "(Action Key): (smart-element) - No implementor definitions for `%s'"
267 (br-feature-signature-to-name ftr-tag)))))
269 ;; On an OO-Browser V4 element tag line, display its source code definition.
270 ((save-excursion (beginning-of-line) (looking-at "\\s-*\\["))
271 (let* ((eol (progn (end-of-line) (point)))
272 (bol (progn (back-to-indentation) (point)))
273 (ftr-str (br-buffer-substring eol bol))
274 (ftr-tag (read (current-buffer)))
275 (def-file (br-feature-tag-path ftr-tag)))
277 (progn (if (and (fboundp 'ibut:label-set)
278 (fboundp 'hproperty:but-flash))
279 (progn (ibut:label-set ftr-str bol eol)
280 (hproperty:but-flash)))
281 (if (br-edit-feature-from-tag ftr-tag def-file)
283 (error "(Action Key): (smart-element) - `%s' def not found in \"%s\""
284 (br-feature-tag-name ftr-tag) def-file)))
285 (error "(Action Key): (smart-element) - No implementor definitions for `%s'"
286 (br-feature-tag-name ftr-tag)))))
288 ;; On a OO-Browser V4 feature signature line, indented below its class
289 ;; name line (e.g. Implementors buffer)
290 ((save-excursion (back-to-indentation) (looking-at ".*[ \t|,\{\;]"))
291 (let* ((ftr-tag (br-feature-get-tag))
292 (bol (progn (back-to-indentation) (point)))
293 (eol (progn (end-of-line) (point)))
294 (ftr-sig (if ftr-tag (br-feature-tag-signature ftr-tag)
295 (buffer-substring bol eol)))
296 (def-file (if ftr-tag (br-feature-tag-path ftr-tag)))
297 (ftr-name (if ftr-tag (br-feature-tag-name ftr-tag))))
299 (progn (if (and (fboundp 'ibut:label-set)
300 (fboundp 'hproperty:but-flash))
301 (progn (ibut:label-set ftr-sig bol eol)
302 (hproperty:but-flash)))
303 (if (br-edit-feature-from-tag ftr-tag def-file)
306 "(Action Key): (smart-element) - `%s' def not found in \"%s\""
310 "(Action Key): (smart-element) - No implementor definitions for `%s'"
313 "(Action Key): (smart-element) - Select a class or feature line")))))
315 ;; Assume this is a class name entry, display the class def.
316 (t (let* ((bol (progn (back-to-indentation) (point)))
317 (eol (progn (end-of-line) (point)))
318 (class (br-buffer-substring bol eol)))
319 (if (and (fboundp 'ibut:label-set) (fboundp 'hproperty:but-flash))
320 (progn (ibut:label-set class bol eol) (hproperty:but-flash)))
321 (br-edit nil class))))))
323 ;;; ************************************************************************
324 ;;; Hyperbole info browsing functions
325 ;;; ************************************************************************
327 (autoload 'Info-handle-in-note "hmous-info"
328 "Follows Info documentation references.")
329 (autoload 'smart-info "hmous-info" "Follows Info documentation references." t)
330 (autoload 'smart-info-assist "hmous-info"
331 "Follows Info documentation references." t)