Mercurial > hg > xemacs-beta

comparison lisp/oobr/hmouse-br.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
9 ;; ORG: Motorola Inc.
10 ;;
11 ;; ORIG-DATE: Sep-04-90
12 ;; LAST-MOD: 1-Nov-95 at 20:32:56 by Bob Weiner
13 ;;
14 ;; Copyright (C) 1990-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 ;;; 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)