|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hmouse-br.el
|
|
|
4 ;; SUMMARY: Hyperbole Key control for the OO-Browser.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: mouse, oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: Sep-04-90
|
|
100
|
12 ;; LAST-MOD: 20-Feb-97 at 07:05:21 by Bob Weiner
|
|
0
|
13 ;;
|
|
100
|
14 ;; Copyright (C) 1990-1995, 1997 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 ;;; Other required Elisp libraries
|
|
|
24 ;;; ************************************************************************
|
|
|
25
|
|
|
26 (require 'br)
|
|
|
27
|
|
|
28 ;;; ************************************************************************
|
|
|
29 ;;; smart-br functions
|
|
|
30 ;;; ************************************************************************
|
|
|
31
|
|
|
32 ;;; Unused unless the "br.el" library, part of the OO-Browser package, has
|
|
|
33 ;;; been loaded.
|
|
|
34
|
|
|
35 (defun smart-br ()
|
|
|
36 "Controls OO-Browser listing buffers with one key or mouse key.
|
|
|
37
|
|
|
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.
|
|
|
41
|
|
|
42 If key is pressed:
|
|
|
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) at the beginning of a (non-single character) class name, the class'
|
|
|
46 ancestors are listed;
|
|
|
47 (3) at the end of an entry line, the listing is scrolled up;
|
|
|
48 (4) on the `...', following a class name, point is moved to the class
|
|
|
49 descendency expansion;
|
|
|
50 (5) before an element name, the implementor classes of the name are listed;
|
|
|
51 (6) anywhere else on an entry line, the entry's source is displayed for
|
|
|
52 editing."
|
|
|
53
|
|
|
54 (interactive)
|
|
|
55 (br-browse)
|
|
|
56 (cond ((eobp)
|
|
|
57 (br-help)
|
|
|
58 (and action-mouse-key-prev-window
|
|
|
59 (select-window action-mouse-key-prev-window)))
|
|
|
60 ((eolp) (smart-scroll-up))
|
|
|
61 ((br-find-feature-entry)
|
|
|
62 (if (bolp) (br-implementors) (br-feature)))
|
|
|
63 ((and (bolp)
|
|
|
64 (let ((cl (br-find-class-name)))
|
|
|
65 (and cl (not (= (length cl) 1)))))
|
|
|
66 (br-ancestors))
|
|
|
67 ((br-to-tree))
|
|
|
68 ((br-edit))))
|
|
|
69
|
|
|
70 (defun smart-br-assist ()
|
|
|
71 "Controls OO-Browser listing buffers with one assist-key or mouse assist-key.
|
|
|
72
|
|
|
73 Invoked via an assist-key press when in an OO-Browser listing window. It
|
|
|
74 assumes that its caller has already checked that the assist-key was pressed in
|
|
|
75 an appropriate buffer and has moved the cursor to the selected buffer.
|
|
|
76
|
|
|
77 If assist-key is pressed:
|
|
|
78 (1) in a blank buffer, a selection list of buffer files is displayed;
|
|
|
79 (2) at the beginning of a (non-single character) class, the class'
|
|
|
80 descendants are listed;
|
|
|
81 (3) at the end of an entry line, the listing is scrolled down;
|
|
|
82 (4) on the `...', following a class name, point is moved to the class
|
|
|
83 expansion;
|
|
|
84 (5) anywhere else on a class line, the class' elements are listed;
|
|
|
85 (6) anywhere else on an element line, the element's implementor
|
|
|
86 classes are listed;
|
|
|
87 (7) on a blank line following all entries, the current listing buffer
|
|
|
88 is exited."
|
|
|
89
|
|
|
90 (interactive)
|
|
|
91 (br-browse)
|
|
|
92 (cond ((equal 0 (string-match br-buffer-prefix-blank (buffer-name)))
|
|
|
93 (br-buffer-menu))
|
|
|
94 ((eobp) (br-exit-level 1))
|
|
|
95 ((eolp) (smart-scroll-down))
|
|
|
96 ((br-find-feature-entry) (br-implementors))
|
|
|
97 ((and (bolp)
|
|
|
98 (let ((cl (br-find-class-name)))
|
|
|
99 (and cl (not (= (length cl) 1)))))
|
|
|
100 (br-descendants))
|
|
|
101 ((br-to-tree))
|
|
|
102 (t (br-features 1))))
|
|
|
103
|
|
|
104
|
|
|
105 (defun smart-br-dispatch ()
|
|
|
106 (if (or (br-listing-window-p) (eq major-mode 'br-mode))
|
|
|
107 ;; In an OO-Browser listing window.
|
|
|
108 (smart-br)
|
|
|
109 (cond ((eq major-mode 'Info-mode)
|
|
|
110 (smart-info))
|
|
|
111 ((eq major-mode 'Buffer-menu-mode)
|
|
|
112 (smart-buffer-menu t))
|
|
|
113 ((eolp) (smart-scroll-up))
|
|
|
114 ((and (boundp 'br-src-file-regexp)
|
|
|
115 buffer-file-name
|
|
|
116 (fboundp (symbol-function 'br-to-definition))
|
|
|
117 (string-match br-src-file-regexp buffer-file-name))
|
|
|
118 (br-to-definition))
|
|
|
119 ((and action-mouse-key-prev-window
|
|
|
120 (or (smart-br-cmd-select nil)
|
|
|
121 (error "(Action Key): No command bound to key."))))
|
|
|
122 (t (scroll-up)))))
|
|
|
123
|
|
|
124 (defun smart-br-assist-dispatch ()
|
|
|
125 (if (or (br-listing-window-p) (eq major-mode 'br-mode))
|
|
|
126 ;; In an OO-Browser listing window.
|
|
|
127 (smart-br-assist)
|
|
|
128 (cond ((eq major-mode 'Info-mode)
|
|
|
129 (smart-info-assist))
|
|
|
130 ((eq major-mode 'Buffer-menu-mode)
|
|
|
131 (smart-buffer-menu-assist))
|
|
|
132 ((eolp) (smart-scroll-down))
|
|
|
133 ((and action-mouse-key-prev-window
|
|
|
134 (or (smart-br-cmd-select 'assist)
|
|
|
135 (error "(Assist Key): No command bound to key."))))
|
|
|
136 (t (scroll-down)))))
|
|
|
137
|
|
|
138 (defun smart-br-cmd-select (&optional assist-flag)
|
|
|
139 "Selects an OO-Browser command with its key binding at point.
|
|
|
140 By default executes the command, with optional ASSIST-FLAG non-nil, shows help for
|
|
|
141 command. Returns t if a command is selected. Nil indicates no key binding was
|
|
|
142 found on the current line. Key bindings are delimited by {}."
|
|
|
143 (let ((start) (end) (tmp-buf) (tmp-buf-nm) (obuf (current-buffer)))
|
|
|
144 (and (save-excursion
|
|
|
145 (or (eobp) (forward-char))
|
|
|
146 (save-excursion
|
|
|
147 (beginning-of-line)
|
|
|
148 (setq start (point)))
|
|
|
149 (and (re-search-backward "\\(^\\|[^\\]\\){" start t)
|
|
|
150 (progn
|
|
|
151 (goto-char (match-end 0))
|
|
|
152 (setq start (point))
|
|
|
153 (save-excursion
|
|
|
154 (end-of-line)
|
|
|
155 (setq end (point)))
|
|
|
156 (and (re-search-forward "[^\\]}" end t)
|
|
|
157 (setq end (1- (point)))))))
|
|
|
158 (progn
|
|
|
159 (setq tmp-buf-nm "*smart-br-tmp*"
|
|
|
160 tmp-buf (progn (if (get-buffer tmp-buf-nm)
|
|
|
161 (kill-buffer tmp-buf-nm))
|
|
|
162 (get-buffer-create tmp-buf-nm)))
|
|
|
163 (or tmp-buf
|
|
|
164 (error
|
|
|
165 "(Action Key): (smart-br-cmd-select) - Can't create tmp-buf."))
|
|
|
166 (copy-to-buffer tmp-buf start end)
|
|
|
167 (set-buffer tmp-buf)
|
|
|
168 (let ((case-fold-search nil) (case-replace t)
|
|
|
169 (keys)
|
|
|
170 (pref-arg action-mouse-key-prefix-arg))
|
|
|
171 ;; Quote Control and Meta key names
|
|
|
172 (goto-char (point-min))
|
|
|
173 (replace-regexp "[ \t]+" "")
|
|
|
174 (goto-char (point-min))
|
|
|
175 (replace-string "SPC" "\040")
|
|
|
176 (goto-char (point-min))
|
|
|
177 (replace-string "DEL" "\177")
|
|
|
178 (goto-char (point-min))
|
|
|
179 (replace-regexp "ESC" "M-")
|
|
|
180 (goto-char (point-min))
|
|
|
181 ;; Unqote special {} chars.
|
|
|
182 (replace-regexp "\\\\\\([{}]\\)" "\\1")
|
|
|
183 (goto-char (point-min))
|
|
|
184 (if (looking-at "C-u")
|
|
|
185 (progn (delete-char 3)
|
|
|
186 (and (or (null pref-arg)
|
|
|
187 (equal pref-arg 1))
|
|
|
188 (setq pref-arg '(4)))))
|
|
|
189 (while (search-forward "C-" nil t)
|
|
|
190 (replace-match "")
|
|
|
191 (setq keys (1+ (- (downcase (following-char)) ?a)))
|
|
|
192 (delete-char 1)
|
|
|
193 (insert keys))
|
|
|
194 (goto-char (point-min))
|
|
|
195 (while (search-forward "M-" nil t)
|
|
|
196 (replace-match "")
|
|
|
197 (setq keys (+ 128 (downcase (following-char))))
|
|
|
198 (delete-char 1)
|
|
|
199 (insert keys))
|
|
|
200 (setq keys (buffer-string))
|
|
|
201 (kill-buffer tmp-buf-nm)
|
|
|
202 (set-buffer obuf)
|
|
|
203 (and (boundp 'action-mouse-key-prev-window)
|
|
|
204 action-mouse-key-prev-window
|
|
|
205 (select-window action-mouse-key-prev-window))
|
|
|
206 (let ((current-prefix-arg pref-arg)
|
|
|
207 (binding (key-binding keys)))
|
|
|
208 (if binding
|
|
|
209 (progn
|
|
|
210 (if assist-flag
|
|
|
211 (br-cmd-help keys)
|
|
|
212 (call-interactively binding))
|
|
|
213 t))))))))
|
|
|
214
|
|
|
215 ;;; ************************************************************************
|
|
|
216 ;;; Hyperbole info browsing functions
|
|
|
217 ;;; ************************************************************************
|
|
|
218
|
|
|
219 (autoload 'Info-handle-in-note "hmous-info"
|
|
|
220 "Follows Info documentation references.")
|
|
|
221 (autoload 'smart-info "hmous-info" "Follows Info documentation references." t)
|
|
|
222 (autoload 'smart-info-assist "hmous-info"
|
|
|
223 "Follows Info documentation references." t)
|
|
|
224
|
|
|
225 (provide 'hmouse-br)
|
