|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hmouse-drv.el
|
|
|
4 ;; SUMMARY: Smart Key/Mouse driver functions.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, mouse
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORIG-DATE: 04-Feb-90
|
|
70
|
10 ;; LAST-MOD: 1-Nov-95 at 21:44:52 by Bob Weiner
|
|
0
|
11 ;;
|
|
|
12 ;; This file is part of Hyperbole.
|
|
|
13 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
14 ;;
|
|
|
15 ;; Copyright (C) 1989-1995, Free Software Foundation, Inc.
|
|
|
16 ;; Developed with support from Motorola Inc.
|
|
|
17 ;;
|
|
|
18 ;; DESCRIPTION:
|
|
|
19 ;; DESCRIP-END.
|
|
|
20
|
|
|
21 ;;; ************************************************************************
|
|
|
22 ;;; Other required Elisp libraries
|
|
|
23 ;;; ************************************************************************
|
|
|
24
|
|
|
25 (require 'hypb)
|
|
|
26
|
|
|
27 ;;; ************************************************************************
|
|
|
28 ;;; Public variables
|
|
|
29 ;;; ************************************************************************
|
|
|
30
|
|
|
31 (defvar action-key-depress-window nil
|
|
|
32 "The last window in which the Action Key was depressed or nil.")
|
|
|
33 (defvar assist-key-depress-window nil
|
|
|
34 "The last window in which the Assist Key was depressed or nil.")
|
|
|
35 (defvar action-key-release-window nil
|
|
|
36 "The last window in which the Action Key was released or nil.")
|
|
|
37 (defvar assist-key-release-window nil
|
|
|
38 "The last window in which the Assist Key was released or nil.")
|
|
|
39
|
|
|
40 (defvar action-key-depress-prev-point nil
|
|
|
41 "Marker at point prior to last Action Key depress.
|
|
|
42 Note that this may be a buffer different than where the depress occurs.")
|
|
|
43 (defvar assist-key-depress-prev-point nil
|
|
|
44 "Marker at point prior to last Assist Key depress.
|
|
|
45 Note that this may be a buffer different than where the depress occurs.")
|
|
|
46 (defvar action-key-release-prev-point nil
|
|
|
47 "Marker at point prior to last Action Key release.
|
|
|
48 Note that this may be a buffer different than where the release occurs.")
|
|
|
49 (defvar assist-key-release-prev-point nil
|
|
|
50 "Marker at point prior to last Assist Key release.
|
|
|
51 Note that this may be a buffer different than where the release occurs.")
|
|
|
52
|
|
|
53 (defvar action-key-cancelled nil
|
|
|
54 "When non-nil, cancels last Action Key depress.")
|
|
|
55 (defvar assist-key-cancelled nil
|
|
|
56 "When non-nil, cancels last Assist Key depress.")
|
|
|
57
|
|
|
58 (defvar action-key-help-flag nil
|
|
|
59 "When non-nil, forces display of help for next Action Key release.")
|
|
|
60 (defvar assist-key-help-flag nil
|
|
|
61 "When non-nil, forces display of help for next Assist Key release.")
|
|
|
62
|
|
|
63 ;;; ************************************************************************
|
|
|
64 ;;; Hyperbole context-sensitive key driver functions
|
|
|
65 ;;; ************************************************************************
|
|
|
66
|
|
|
67 (defun action-mouse-key (&rest args)
|
|
|
68 "Set point to the current mouse cursor position and execute 'action-key'.
|
|
|
69 Any ARGS will be passed to 'hmouse-function'."
|
|
|
70 (interactive)
|
|
|
71 (require 'hsite)
|
|
|
72 ;; Make this a no-op if some local mouse key binding overrode the global
|
|
|
73 ;; action-key-depress command invocation.
|
|
|
74 (if action-key-depressed-flag
|
|
|
75 (let ((hkey-alist hmouse-alist))
|
|
|
76 (setq action-key-depressed-flag nil)
|
|
|
77 (cond (action-key-cancelled
|
|
|
78 (setq action-key-cancelled nil
|
|
|
79 assist-key-depressed-flag nil))
|
|
|
80 (assist-key-depressed-flag
|
|
|
81 (hmouse-function nil nil args))
|
|
|
82 ((action-mouse-key-help nil args))
|
|
|
83 (t (hmouse-function 'action-key nil args))))))
|
|
|
84
|
|
|
85 (defun assist-mouse-key (&rest args)
|
|
|
86 "Set point to the current mouse cursor position and execute 'assist-key'.
|
|
|
87 Any ARGS will be passed to 'hmouse-function'."
|
|
|
88 (interactive)
|
|
|
89 (require 'hsite)
|
|
|
90 ;; Make this a no-op if some local mouse key binding overrode the global
|
|
|
91 ;; assist-key-depress command invocation.
|
|
|
92 (if assist-key-depressed-flag
|
|
|
93 (let ((hkey-alist hmouse-alist))
|
|
|
94 (setq assist-key-depressed-flag nil)
|
|
|
95 (cond (assist-key-cancelled
|
|
|
96 (setq assist-key-cancelled nil
|
|
|
97 action-key-depressed-flag nil))
|
|
|
98 (action-key-depressed-flag
|
|
|
99 (hmouse-function nil t args))
|
|
|
100 ((action-mouse-key-help t args))
|
|
|
101 (t (hmouse-function 'assist-key t args))))))
|
|
|
102
|
|
|
103 (defun hmouse-function (func assist-flag set-point-arg-list)
|
|
|
104 "Executes FUNC for Action Key (Assist Key with ASSIST-FLAG non-nil) and sets point from SET-POINT-ARG-LIST.
|
|
|
105 FUNC may be nil in which case no function is called.
|
|
|
106 SET-POINT-ARG-LIST is passed to the call of the command bound to
|
|
|
107 'hmouse-set-point-command'. Returns nil if 'hmouse-set-point-command' variable
|
|
|
108 is not bound to a valid function."
|
|
|
109 (if (fboundp hmouse-set-point-command)
|
|
|
110 (let ((release-args (hmouse-set-point set-point-arg-list)))
|
|
|
111 (if assist-flag
|
|
|
112 (setq assist-key-release-window (selected-window)
|
|
|
113 assist-key-release-args release-args
|
|
|
114 assist-key-release-prev-point (point-marker))
|
|
|
115 (setq action-key-release-window (selected-window)
|
|
|
116 action-key-release-args release-args
|
|
|
117 action-key-release-prev-point (point-marker)))
|
|
|
118 (and (eq major-mode 'br-mode)
|
|
|
119 (setq action-mouse-key-prev-window
|
|
|
120 (if (br-in-view-window-p)
|
|
|
121 (save-window-excursion
|
|
|
122 (br-next-listing-window)
|
|
|
123 (selected-window))
|
|
|
124 (selected-window))))
|
|
|
125 (setq action-mouse-key-prefix-arg current-prefix-arg)
|
|
|
126 (if (null func)
|
|
|
127 nil
|
|
|
128 (funcall func)
|
|
|
129 (setq action-mouse-key-prev-window nil
|
|
|
130 action-mouse-key-prefix-arg nil))
|
|
|
131 t)))
|
|
|
132
|
|
|
133 (defun action-mouse-key-help (assist-flag args)
|
|
|
134 "If a Smart Key help flag is set and the other Smart Key is not down, shows help.
|
|
|
135 Takes two args: ASSIST-FLAG should be non-nil iff command applies to the Assist Key.
|
|
|
136 ARGS is a list of arguments passed to 'hmouse-function'.
|
|
|
137 Returns t if help is displayed, nil otherwise."
|
|
|
138 (let ((help-shown)
|
|
|
139 (other-key-released (not (if assist-flag
|
|
|
140 action-key-depressed-flag
|
|
|
141 assist-key-depressed-flag))))
|
|
|
142 (unwind-protect
|
|
|
143 (setq help-shown
|
|
|
144 (cond ((and action-key-help-flag other-key-released)
|
|
|
145 (setq action-key-help-flag nil)
|
|
|
146 (hmouse-function 'hkey-help assist-flag args)
|
|
|
147 t)
|
|
|
148 ((and assist-key-help-flag other-key-released)
|
|
|
149 (setq assist-key-help-flag nil)
|
|
|
150 (hmouse-function 'assist-key-help assist-flag args)
|
|
|
151 t)))
|
|
|
152 (if help-shown
|
|
|
153 ;; Then both Smart Keys have been released.
|
|
|
154 (progn (setq action-key-cancelled nil
|
|
|
155 assist-key-cancelled nil)
|
|
|
156 t)))))
|
|
|
157
|
|
|
158 (defun action-key ()
|
|
|
159 "Use one key to perform functions that vary by buffer.
|
|
|
160 Default function is given by 'action-key-default-function' variable.
|
|
|
161 Returns t unless 'action-key-default-function' variable is not bound to a valid
|
|
|
162 function."
|
|
|
163 (interactive)
|
|
|
164 (require 'hsite)
|
|
|
165 (or (hkey-execute nil)
|
|
|
166 (if (fboundp action-key-default-function)
|
|
|
167 (progn (funcall action-key-default-function)
|
|
|
168 t))))
|
|
|
169
|
|
|
170 (defun assist-key ()
|
|
|
171 "Use one assist-key to perform functions that vary by buffer.
|
|
|
172 Default function is given by 'assist-key-default-function' variable.
|
|
|
173 Returns non-nil unless 'assist-key-default-function' variable is not bound
|
|
|
174 to a valid function."
|
|
|
175 (interactive)
|
|
|
176 (require 'hsite)
|
|
|
177 (or (hkey-execute t)
|
|
|
178 (if (fboundp assist-key-default-function)
|
|
|
179 (progn (funcall assist-key-default-function)
|
|
|
180 t))))
|
|
|
181
|
|
|
182 (defun hkey-execute (assist-flag)
|
|
|
183 "Evaluate Action Key form (or Assist Key form with ASSIST-FLAG non-nil) for first non-nil predicate from 'hkey-alist'.
|
|
|
184 Non-nil ASSIST-FLAG means evaluate second form, otherwise evaluate first form.
|
|
|
185 Returns non-nil iff a non-nil predicate is found."
|
|
|
186 (let ((pred-forms hkey-alist)
|
|
|
187 (pred-form) (pred-t))
|
|
|
188 (while (and (null pred-t) (setq pred-form (car pred-forms)))
|
|
|
189 (if (setq pred-t (eval (car pred-form)))
|
|
|
190 (eval (if assist-flag (cdr (cdr pred-form)) (car (cdr pred-form))))
|
|
|
191 (setq pred-forms (cdr pred-forms))))
|
|
|
192 pred-t))
|
|
|
193
|
|
|
194 (defun hkey-help (&optional assist-flag)
|
|
|
195 "Display help for the Action Key command in current context.
|
|
|
196 With optional ASSIST-FLAG non-nil, display help for the Assist Key command.
|
|
|
197 Returns non-nil iff associated help documentation is found."
|
|
|
198 (interactive "P")
|
|
|
199 (require 'hsite)
|
|
|
200 (let ((pred-forms hkey-alist)
|
|
|
201 (pred-form) (pred-t) (call) (cmd-sym) (doc))
|
|
|
202 (while (and (null pred-t) (setq pred-form (car pred-forms)))
|
|
|
203 (or (setq pred-t (eval (car pred-form)))
|
|
|
204 (setq pred-forms (cdr pred-forms))))
|
|
|
205 (if pred-t
|
|
|
206 (setq call (if assist-flag (cdr (cdr pred-form))
|
|
|
207 (car (cdr pred-form)))
|
|
|
208 cmd-sym (car call))
|
|
|
209 (setq cmd-sym
|
|
|
210 (if assist-flag assist-key-default-function action-key-default-function)
|
|
|
211 call cmd-sym))
|
|
|
212 (setq hkey-help-msg
|
|
|
213 (if (and cmd-sym (symbolp cmd-sym))
|
|
|
214 (progn
|
|
|
215 (setq doc (documentation cmd-sym))
|
|
|
216 (let* ((condition (car pred-form))
|
|
|
217 (temp-buffer-show-hook
|
|
|
218 (function
|
|
|
219 (lambda (buf)
|
|
|
220 (set-buffer buf)
|
|
|
221 (setq buffer-read-only t)
|
|
|
222 (if (br-in-browser)
|
|
|
223 (save-excursion
|
|
|
224 (let ((owind (selected-window)))
|
|
|
225 (br-to-view-window)
|
|
|
226 (select-window (previous-window))
|
|
|
227 (display-buffer buf 'other-win)
|
|
|
228 (select-window owind)))
|
|
|
229 (display-buffer buf 'other-win)))))
|
|
|
230 (temp-buffer-show-function temp-buffer-show-hook))
|
|
|
231 (with-output-to-temp-buffer (hypb:help-buf-name "Smart")
|
|
|
232 (princ (format "A click of the %s Key"
|
|
|
233 (if assist-flag "Assist" "Action")))
|
|
|
234 (terpri)
|
|
|
235 (princ "WHEN ")
|
|
|
236 (princ
|
|
|
237 (or condition
|
|
|
238 "there is no matching context"))
|
|
|
239 (terpri)
|
|
|
240 (princ "CALLS ") (princ call)
|
|
|
241 (if doc (progn (princ " WHICH:") (terpri) (terpri)
|
|
|
242 (princ doc)))
|
|
|
243 (if (memq cmd-sym '(hui:hbut-act hui:hbut-help))
|
|
|
244 (progn
|
|
|
245 (princ (format "\n\nBUTTON SPECIFICS:\n\n%s\n"
|
|
|
246 (actype:doc 'hbut:current t)))
|
|
|
247 (hattr:report
|
|
|
248 (nthcdr 2 (hattr:list 'hbut:current)))))
|
|
|
249 (terpri)
|
|
|
250 ))
|
|
|
251 "")
|
|
|
252 (message "No %s Key command for current context."
|
|
|
253 (if assist-flag "Assist" "Action"))))
|
|
|
254 doc))
|
|
|
255
|
|
|
256 (defun assist-key-help ()
|
|
|
257 "Display doc associated with Assist Key command in current context.
|
|
|
258 Returns non-nil iff associated documentation is found."
|
|
|
259 (interactive)
|
|
|
260 (hkey-help 'assist))
|
|
|
261
|
|
|
262 (defun hkey-help-hide ()
|
|
|
263 "Restores frame to configuration prior to help buffer display.
|
|
|
264 Point must be in the help buffer."
|
|
|
265 (let ((buf (current-buffer)))
|
|
|
266 (if *hkey-wconfig*
|
|
|
267 (set-window-configuration *hkey-wconfig*)
|
|
|
268 (switch-to-buffer (other-buffer)))
|
|
|
269 (bury-buffer buf)
|
|
|
270 (setq *hkey-wconfig* nil)))
|
|
|
271
|
|
|
272 (defun hkey-help-show (buffer &optional current-window)
|
|
|
273 "Saves prior frame configuration if BUFFER displays help. Displays BUFFER.
|
|
|
274
|
|
|
275 Optional second arg CURRENT-WINDOW non-nil forces display of buffer within
|
|
|
276 the current window. By default, it is displayed in another window."
|
|
|
277 (if (bufferp buffer) (setq buffer (buffer-name buffer)))
|
|
|
278 (and (stringp buffer)
|
|
|
279 (string-match "Help\\*$" buffer)
|
|
|
280 (not (memq t (mapcar (function
|
|
|
281 (lambda (wind)
|
|
|
282 (string-match
|
|
|
283 "Help\\*$"
|
|
|
284 (buffer-name (window-buffer wind)))))
|
|
|
285 (hypb:window-list 'no-mini))))
|
|
|
286 (setq *hkey-wconfig* (current-window-configuration)))
|
|
|
287 (let* ((buf (get-buffer-create buffer))
|
|
|
288 (wind (if current-window
|
|
|
289 (progn (switch-to-buffer buf)
|
|
|
290 (selected-window))
|
|
|
291 (display-buffer buf))))
|
|
|
292 (setq minibuffer-scroll-window wind)))
|
|
|
293
|
|
|
294 (defun hkey-operate (arg)
|
|
|
295 "Uses the keyboard to emulate Smart Mouse Key drag actions.
|
|
|
296 Each invocation alternates between starting a drag and ending it.
|
|
|
297 Prefix ARG non-nil means emulate Assist Key rather than the Action Key.
|
|
|
298
|
|
|
299 Only works when running under a window system, not from a dumb terminal."
|
|
|
300 (interactive "P")
|
|
|
301 (or hyperb:window-system
|
|
|
302 (hypb:error "(hkey-operate): Drag actions require mouse support"))
|
|
|
303 (if arg
|
|
|
304 (if assist-key-depressed-flag
|
|
|
305 (progn (assist-mouse-key)
|
|
|
306 (message "Assist Key released."))
|
|
|
307 (assist-key-depress)
|
|
|
308 (message
|
|
|
309 "Assist Key depressed; go to release point and hit {%s %s}."
|
|
|
310 (substitute-command-keys "\\[universal-argument]")
|
|
|
311 (substitute-command-keys "\\[hkey-operate]")
|
|
|
312 ))
|
|
|
313 (if action-key-depressed-flag
|
|
|
314 (progn (action-mouse-key)
|
|
|
315 (message "Action Key released."))
|
|
|
316 (action-key-depress)
|
|
|
317 (message "Action Key depressed; go to release point and hit {%s}."
|
|
|
318 (substitute-command-keys "\\[hkey-operate]"))
|
|
|
319 )))
|
|
|
320
|
|
|
321 (defun hkey-summarize (&optional current-window)
|
|
|
322 "Displays smart key operation summary in help buffer.
|
|
|
323 Optional arg CURRENT-WINDOW non-nil forces display of buffer within
|
|
|
324 the current window. By default, it is displayed in another window."
|
|
|
325 (let* ((doc-file (hypb:mouse-help-file))
|
|
|
326 (buf-name (hypb:help-buf-name "Smart"))
|
|
|
327 (wind (get-buffer-window buf-name))
|
|
|
328 owind)
|
|
|
329 (if (file-readable-p doc-file)
|
|
|
330 (progn
|
|
|
331 (if (br-in-browser)
|
|
|
332 (br-to-view-window))
|
|
|
333 (setq owind (selected-window))
|
|
|
334 (unwind-protect
|
|
|
335 (progn
|
|
|
336 (if wind
|
|
|
337 (select-window wind)
|
|
|
338 (hkey-help-show buf-name current-window)
|
|
|
339 (select-window (get-buffer-window buf-name)))
|
|
|
340 (setq buffer-read-only nil) (erase-buffer)
|
|
|
341 (insert-file-contents doc-file)
|
|
|
342 (goto-char (point-min))
|
|
|
343 (set-buffer-modified-p nil))
|
|
|
344 (select-window owind))))))
|
|
|
345
|
|
|
346 ;; ************************************************************************
|
|
|
347 ;; Private variables
|
|
|
348 ;; ************************************************************************
|
|
|
349
|
|
|
350 (defvar action-key-depress-args nil
|
|
|
351 "List of mouse event args from most recent depress of the Action Key.")
|
|
|
352 (defvar assist-key-depress-args nil
|
|
|
353 "List of mouse event args from most recent depress of the Assist Key.")
|
|
|
354
|
|
|
355 (defvar action-key-release-args nil
|
|
|
356 "List of mouse event args from most recent release of the Action Key.")
|
|
|
357 (defvar assist-key-release-args nil
|
|
|
358 "List of mouse event args from most recent release of the Assist Key.")
|
|
|
359
|
|
|
360 (defvar action-mouse-key-prev-window nil
|
|
|
361 "Window point was in prior to current invocation of 'action/assist-mouse-key'.")
|
|
|
362
|
|
|
363 (defvar action-mouse-key-prefix-arg nil
|
|
|
364 "Prefix argument to pass to 'smart-br-cmd-select'.")
|
|
|
365
|
|
|
366 (defvar action-key-depressed-flag nil "t while Action Key is depressed.")
|
|
|
367 (defvar assist-key-depressed-flag nil "t while Assist Key is depressed.")
|
|
|
368 (defvar hkey-help-msg "" "Holds last Smart Key help message.")
|
|
|
369 (defvar *hkey-wconfig* nil
|
|
|
370 "Screen configuration prior to display of a help buffer.")
|
|
|
371
|
|
|
372 ;;; ************************************************************************
|
|
|
373 ;;; public support functions
|
|
|
374 ;;; ************************************************************************
|
|
|
375
|
|
|
376 ;; "hsite.el" contains documentation for this variable.
|
|
|
377 (or (boundp 'smart-scroll-proportional) (setq smart-scroll-proportional nil))
|
|
|
378
|
|
|
379 ;; The smart keys scroll buffers when pressed at the ends of lines.
|
|
|
380 ;; These next two functions do the scrolling and keep point at the end
|
|
|
381 ;; of line to simplify repeated scrolls when using keyboard smart keys.
|
|
|
382 ;;
|
|
|
383 ;; These functions may also be used to test whether the scroll action would
|
|
|
384 ;; be successful, no action is taken if it would fail (because the beginning
|
|
|
385 ;; or end of a buffer is already showing) and nil is returned.
|
|
|
386 ;; t is returned whenever scrolling is performed.
|
|
|
387
|
|
|
388 (defun smart-scroll-down ()
|
|
|
389 "Scrolls down according to value of smart-scroll-proportional.
|
|
|
390 If smart-scroll-proportional is nil or if point is on the bottom window line,
|
|
|
391 scrolls down (backward) a windowful. Otherwise, tries to bring current line
|
|
|
392 to bottom of window. Leaves point at end of line and returns t if scrolled,
|
|
|
393 nil if not."
|
|
|
394 (interactive)
|
|
|
395 (let ((rtn t))
|
|
|
396 (if smart-scroll-proportional
|
|
|
397 ;; If selected line is already last in window, then scroll backward
|
|
|
398 ;; a windowful, otherwise make it last in window.
|
|
|
399 (if (>= (point) (save-excursion
|
|
|
400 (goto-char (1- (window-end)))
|
|
|
401 (beginning-of-line) (point)))
|
|
|
402 (if (pos-visible-in-window-p (point-min))
|
|
|
403 (setq rtn nil)
|
|
|
404 (scroll-down))
|
|
|
405 (recenter -1))
|
|
|
406 (if (pos-visible-in-window-p (point-min))
|
|
|
407 (setq rtn nil)
|
|
|
408 (scroll-down)))
|
|
|
409 (end-of-line)
|
|
|
410 (or rtn (progn (beep) (message "Beginning of buffer")))
|
|
|
411 rtn))
|
|
|
412
|
|
|
413 (defun smart-scroll-up ()
|
|
|
414 "Scrolls up according to value of smart-scroll-proportional.
|
|
|
415 If smart-scroll-proportional is nil or if point is on the top window line,
|
|
|
416 scrolls up (forward) a windowful. Otherwise, tries to bring current line to
|
|
|
417 top of window. Leaves point at end of line and returns t if scrolled, nil if
|
|
|
418 not."
|
|
|
419 (interactive)
|
|
|
420 (let ((rtn t))
|
|
|
421 (if smart-scroll-proportional
|
|
|
422 ;; If selected line is already first in window, then scroll forward a
|
|
|
423 ;; windowful, otherwise make it first in window.
|
|
|
424 (if (<= (point) (save-excursion
|
|
|
425 (goto-char (window-start))
|
|
|
426 (end-of-line) (point)))
|
|
|
427 (if (pos-visible-in-window-p (point-max))
|
|
|
428 (setq rtn nil)
|
|
|
429 (scroll-up))
|
|
|
430 (recenter 0))
|
|
|
431 (if (pos-visible-in-window-p (point-max))
|
|
|
432 (setq rtn nil)
|
|
|
433 (scroll-up)))
|
|
|
434 (end-of-line)
|
|
|
435 (or rtn (progn (beep) (message "End of buffer")))
|
|
|
436 rtn))
|
|
|
437
|
|
|
438 (provide 'hmouse-drv)
|
