;;!emacs
;; $Id: 
;;
;; FILE:         hmouse-drv.el
;; SUMMARY:      Smart Key/Mouse driver functions.
;; USAGE:        GNU Emacs Lisp Library
;;
;; AUTHOR:       Bob Weiner
;; ORIG-DATE:    04-Feb-90
;; LAST-MOD:     10-May-93 at 12:29:55 by Bob Weiner
;;
;; This file is part of Hyperbole.
;;
;; Copyright (C) 1989, 1990, 1991, 1993, Brown University, Providence, RI
;; Available for use and distribution under the same terms as GNU Emacs.
;;
;; DESCRIPTION:  
;; DESCRIP-END.

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

(defvar smart-key-depress-window nil
  "The last window in which the Smart Key was depressed or nil.")
(defvar smart-key-meta-depress-window nil
  "The last window in which the secondary Smart Key was depressed or nil.")
(defvar smart-key-release-window nil
  "The last window in which the Smart Key was released or nil.")
(defvar smart-key-meta-release-window nil
  "The last window in which the secondary Smart Key was released or nil.")

(defvar smart-key-depress-prev-point nil
  "Marker at point prior to last primary Smart Key depress.
Note that this may be a buffer different than where the depress occurs.")
(defvar smart-key-meta-depress-prev-point nil
  "Marker at point prior to last secondary Smart Key depress.
Note that this may be a buffer different than where the depress occurs.")
(defvar smart-key-release-prev-point nil
  "Marker at point prior to last primary Smart Key release.
Note that this may be a buffer different than where the release occurs.")
(defvar smart-key-meta-release-prev-point nil
  "Marker at point prior to last secondary Smart Key release.
Note that this may be a buffer different than where the release occurs.")

(defvar *smart-key-cancelled* nil
  "When non-nil, cancels last Smart Key depress.")
(defvar *smart-key-meta-cancelled* nil
  "When non-nil, cancels last secondary Smart Key depress.")

(defvar *smart-key-help-p* nil
  "When non-nil, forces display of help for next Smart Key release.")
(defvar *smart-key-meta-help-p* nil
  "When non-nil, forces display of help for next secondary Smart Key release.")

;;; ************************************************************************
;;; smart-key driver functions
;;; ************************************************************************

(defun smart-key-mouse (&rest args)
  "Set point to the current mouse cursor position and execute 'smart-key'.
Any ARGS will be passed to 'smart-key-mouse-func'."
  (interactive)
  (let ((smart-key-alist smart-key-mouse-alist))
    (setq *smart-key-depressed* nil)
    (if *smart-key-cancelled*
	(setq *smart-key-cancelled* nil
	      *smart-key-meta-depressed* nil)
      (cond (*smart-key-meta-depressed*
	      (smart-key-mouse-func nil nil args))
	    ((smart-key-mouse-help nil args))
	    (t (smart-key-mouse-func 'smart-key nil args))))))

(defun smart-key-mouse-meta (&rest args)
  "Set point to the current mouse cursor position and execute 'smart-key-meta'.
Any ARGS will be passed to 'smart-key-mouse-func'."
  (interactive)
  (let ((smart-key-alist smart-key-mouse-alist))
    (setq *smart-key-meta-depressed* nil)
    (if *smart-key-meta-cancelled*
	(setq *smart-key-meta-cancelled* nil
	      *smart-key-depressed* nil)
      (cond (*smart-key-depressed*
	      (smart-key-mouse-func nil t args))
	    ((smart-key-mouse-help t args))
	    (t (smart-key-mouse-func 'smart-key-meta t args))))))

(defun smart-key-mouse-func (func meta set-point-arg-list)
  "Executes FUNC for META Smart Key and sets point from SET-POINT-ARG-LIST.
FUNC may be nil in which case no function is called.
SET-POINT-ARG-LIST is passed to the call of the command bound to
'mouse-set-point-command'.  Returns nil if 'mouse-set-point-command' variable
is not bound to a valid function."
  (if (fboundp mouse-set-point-command)
      (let ((release-args (smart-key-mouse-set-point set-point-arg-list)))
	(if meta
	    (setq smart-key-meta-release-window (selected-window)
		  *smart-key-meta-release-args* release-args
		  smart-key-meta-release-prev-point (point-marker))
	  (setq smart-key-release-window (selected-window)
		*smart-key-release-args* release-args
		smart-key-release-prev-point (point-marker)))
	(and (eq major-mode 'br-mode)
	     (setq *smart-key-mouse-prev-window* 
		   (if (br-in-view-window-p)
		       (save-window-excursion
			 (br-next-class-window)
			 (selected-window))
		     (selected-window))))
	(setq *smart-key-mouse-prefix-arg* current-prefix-arg)
	(if (null func)
	    nil
	  (funcall func)
	  (setq *smart-key-mouse-prev-window* nil
		*smart-key-mouse-prefix-arg* nil))
	t)))

(defun smart-key-mouse-help (secondary args)
  "If a Smart Key help flag is set and other Smart Key is not down, shows help.
Takes two args:  SECONDARY should be non-nil iff called from a secondary
Smart Key command, ARGS is a list of arguments passed to
'smart-key-mouse-func'.
Returns t if help is displayed, nil otherwise."
  (let ((help-shown)
	(other-key-released (not (if secondary
				     *smart-key-depressed*
				   *smart-key-meta-depressed*))))
    (unwind-protect
	(setq help-shown
	      (cond ((and  *smart-key-help-p* other-key-released)
		     (setq *smart-key-help-p* nil)
		     (smart-key-mouse-func 'smart-key-help secondary args)
		     t)
		    ((and  *smart-key-meta-help-p* other-key-released)
		     (setq *smart-key-meta-help-p* nil)
		     (smart-key-mouse-func 'smart-key-meta-help secondary args)
		     t)))
      (if help-shown
	  ;; Then both Smart Keys have been released. 
	  (progn (setq *smart-key-cancelled* nil
		       *smart-key-meta-cancelled* nil)
		 t)))))

(defun smart-key ()
  "Use one key to perform functions that vary by buffer.
Default function is given by 'smart-key-other-mode-cmd' variable.
Returns t unless 'smart-key-other-mode-cmd' variable is not bound to a valid
function."
  (interactive)
  (or (smart-key-execute nil)
      (if (fboundp smart-key-other-mode-cmd)
	 (progn (funcall smart-key-other-mode-cmd)
		t))))

(defun smart-key-meta ()
  "Use one meta-key to perform functions that vary by buffer.
Default function is given by 'smart-key-meta-other-mode-cmd' variable.
Returns non-nil unless 'smart-key-meta-other-mode-cmd' variable is not bound
to a valid function."
  (interactive)
  (or (smart-key-execute t)
      (if (fboundp smart-key-meta-other-mode-cmd)
	  (progn (funcall smart-key-meta-other-mode-cmd)
		 t))))

(defun smart-key-execute (meta)
  "Evaluate form (or META form) for first non-nil predicate from 'smart-key-alist'.
Non-nil META means evaluate second form, otherwise evaluate first form.
Returns non-nil iff a non-nil predicate is found."
    (let ((pred-forms smart-key-alist)
	  (pred-form) (pred-t))
      (while (and (null pred-t) (setq pred-form (car pred-forms)))
	(if (setq pred-t (eval (car pred-form)))
	    (eval (if meta (cdr (cdr pred-form)) (car (cdr pred-form))))
	  (setq pred-forms (cdr pred-forms))))
      pred-t))

(defun smart-key-help (&optional meta)
  "Display doc associated with Smart Key command in current context.
Non-nil optional META means use smart-key-meta command, otherwise evaluate
smart-key command.  Returns non-nil iff associated documentation is found."
  (interactive "P")
  (let ((pred-forms smart-key-alist)
	(pred-form) (pred-t) (call) (cmd-sym) (doc))
    (while (and (null pred-t) (setq pred-form (car pred-forms)))
      (or (setq pred-t (eval (car pred-form)))
	  (setq pred-forms (cdr pred-forms))))
    (if pred-t
	(setq call (if meta (cdr (cdr pred-form))
		     (car (cdr pred-form)))
	      cmd-sym (car call))
      (setq cmd-sym
	    (if meta smart-key-meta-other-mode-cmd smart-key-other-mode-cmd)
	    call cmd-sym))
    (setq *smart-key-help-msg*
	  (if (and cmd-sym (symbolp cmd-sym))
	      (progn
		(setq doc (documentation cmd-sym))
		(let* ((condition (car pred-form))
		       (temp-buffer-show-hook
			 (function
			   (lambda (buf)
			     (set-buffer buf)
			     (setq buffer-read-only t)
			     (if (and (fboundp 'br-in-browser) (br-in-browser))
				 (save-excursion
				   (br-to-view-window)
				   (select-window (previous-window))
				   (display-buffer buf 'other-win))
			       (display-buffer buf 'other-win)))))
		       (temp-buffer-show-function temp-buffer-show-hook))
		  (with-output-to-temp-buffer (hypb:help-buf-name "Smart")
		    (princ (format "A click of the %sSmart Key"
				   (if meta "secondary " "")))
		    (terpri)
		    (princ "WHEN  ")
		    (princ
		      (or condition
			  "there is no matching Smart Key entry"))
		    (terpri)
		    (princ "CALLS ") (princ call)
		    (if doc (progn (princ " WHICH:") (terpri) (terpri)
				   (princ doc)))
		    (if (memq cmd-sym '(hui:hbut-act hui:hbut-help))
			(progn
			  (princ (format "\n\nBUTTON SPECIFICS:\n\n%s\n"
					 (actype:doc 'hbut:current t)))
			  (hattr:report
			    (nthcdr 2 (hattr:list 'hbut:current)))))
		    (terpri)
		    ))
		"")
	    (message "No %sSmart Key command for current context."
		     (if meta "secondary " ""))))
    doc))

(defun smart-key-meta-help ()
  "Display doc associated with secondary Smart Key command in current context.
Returns non-nil iff associated documentation is found."
  (interactive "P")
  (smart-key-help 'meta))

(defun smart-key-help-hide ()
  "Restores display to configuration prior to help buffer display.
Point must be in the help buffer."
  (let ((buf (current-buffer)))
    (if *smart-key-screen-config*
	(set-window-configuration *smart-key-screen-config*)
      (switch-to-buffer (other-buffer)))
    (bury-buffer buf)
    (setq *smart-key-screen-config* nil)))

(defun smart-key-help-show (buffer &optional current-window)
  "Saves prior screen configuration if BUFFER displays help.  Displays BUFFER.
Also sets help buffer's mode to Emacs Lisp mode so smart-lisp function work
on it.

Optional second arg CURRENT-WINDOW non-nil forces display of buffer within
the current window.  By default, it is displayed in another window."
  (if (bufferp buffer) (setq buffer (buffer-name buffer)))
  (and (stringp buffer)
       (string-match "Help\\*$" buffer)
       (not (memq t (mapcar '(lambda (wind)
			       (string-match "Help\\*$" buffer))
			    (hypb:window-list 'no-mini))))
       (setq *smart-key-screen-config* (current-window-configuration)))
  (let* ((buf (get-buffer-create buffer))
	 (wind (if current-window
		   (progn (switch-to-buffer buf)
			  (selected-window))
		 (display-buffer buf))))
    (setq minibuffer-scroll-window wind)
    (if (string-match "Help\\*$" (buffer-name buf))
	(save-excursion (set-buffer buf) (emacs-lisp-mode)))))

(defun smart-key-operate (arg)
  "Uses the keyboard to emulate Smart Mouse Key drag actions.
Each invocation alternates between starting a drag and ending it.
Prefix ARG non-nil means emulate secondary Mouse Key rather than primary."
  (interactive "P")
  (if arg
      (if *smart-key-meta-depressed*
	  (progn (smart-key-mouse-meta)
		 (message "Secondary Smart Key released."))
	(sm-depress-meta)
	(message
	  "Secondary Smart Key depressed; go to release point and hit {%s %s}."
	  (substitute-command-keys "\\[universal-argument]")
	  (substitute-command-keys "\\[smart-key-operate]")
	  ))
    (if *smart-key-depressed*
	(progn (smart-key-mouse)
	       (message "Smart Key released."))
      (sm-depress)
      (message "Smart Key depressed; go to release point and hit {%s}."
	       (substitute-command-keys "\\[smart-key-operate]"))
      )))

(defun smart-key-summarize (&optional current-window)
  "Displays smart key operation summary in help buffer.
Optional arg CURRENT-WINDOW non-nil forces display of buffer within
the current window.  By default, it is displayed in another window."
  (let* ((doc-file (expand-file-name "hmouse-doc.txt" hyperb:dir))
	 (buf-name (hypb:help-buf-name "Smart"))
	 (wind (get-buffer-window buf-name))
	 owind)
    (if (file-readable-p doc-file)
	(progn
	  (if (and (fboundp 'br-in-browser) (br-in-browser))
	      (br-to-view-window))
	  (setq owind (selected-window))
	  (unwind-protect
	      (progn
		(if wind
		    (select-window wind)
		  (smart-key-help-show buf-name current-window)
		  (select-window (get-buffer-window buf-name)))
		(setq buffer-read-only nil) (erase-buffer)
		(insert-file-contents doc-file)
		(goto-char (point-min))
		(set-buffer-modified-p nil))
	    (select-window owind))))))

;; ************************************************************************
;; Private variables
;; ************************************************************************

(defvar *smart-key-depress-args* nil
  "List of event args from most recent depress of the Smart Mouse Key.")
(defvar *smart-key-meta-depress-args* nil
  "List of mouse event args from most recent secondary Smart Mouse Key depress.")

(defvar *smart-key-release-args* nil
  "List of event args from most recent release of the Smart Mouse Key.")
(defvar *smart-key-meta-release-args* nil
  "List of mouse event args from most recent secondary Smart Mouse Key release.")

(defvar *smart-key-mouse-prev-window* nil
  "Window point was in prior to current invocation of 'smart-key-mouse(-meta)'.")

(defvar *smart-key-mouse-prefix-arg* nil
  "Prefix argument to pass to 'smart-br-cmd-select'.")

(defvar *smart-key-depressed* nil "t while Smart key is depressed.")
(defvar *smart-key-meta-depressed* nil "t while Smart key is depressed.")
(defvar *smart-key-help-msg* "" "Holds last Smart key help message.")
(defvar *smart-key-screen-config* nil
  "Screen configuration prior to display of a help buffer.")

;;; ************************************************************************
;;; smart-key public support functions
;;; ************************************************************************

;; "hsite.el" contains documentation for this variable.
(or (boundp 'smart-scroll-proportional) (setq smart-scroll-proportional nil))

;; The smart keys scroll buffers when pressed at the ends of lines.
;; These next two functions do the scrolling and keep point at the end
;; of line to simplify repeated scrolls when using keyboard smart keys.
;;
;; These functions may also be used to test whether the scroll action would
;; be successful, no action is taken if it would fail (because the beginning
;; or end of a buffer is already showing) and nil is returned.
;; t is returned whenever scrolling is performed.

(defun scroll-down-eol ()
  "Scrolls down according to value of smart-scroll-proportional.
If smart-scroll-proportional is nil (the default) or if
point is on the bottom window line, scrolls down (backward) a windowful.
Otherwise, tries to bring current line to bottom of window.
Leaves point at end of line and returns t if scrolled, nil if not."
  (interactive)
  (let ((rtn t))
    (if smart-scroll-proportional
	(let ((wind-line (- (hypb:screen-line) (nth 1 (window-edges))))
	      (max-line (and (pos-visible-in-window-p (point-max))
			     (let ((mx (count-lines (window-start) (point-max))))
			       (save-excursion
				 (goto-char (point-max))
				 (if (bolp) mx (1- mx)))))))
	  ;; If selected line is already last in window, then scroll backward a
	  ;; windowful, otherwise make it last in window.
	  (if (or (and max-line (= wind-line max-line))
		  (= wind-line (- (window-height) 2)))
	      (if (pos-visible-in-window-p (point-min))
		  (setq rtn nil)
		(scroll-down))
	    (recenter -1)))
      (if (pos-visible-in-window-p (point-min))
	  (setq rtn nil)
	(scroll-down))
      )
    (end-of-line)
    (or rtn (progn (beep) (message "Beginning of buffer")))
    rtn))

(defun scroll-up-eol ()
  "Scrolls up according to value of smart-scroll-proportional.
If smart-scroll-proportional is nil (the default) or if
point is on the top window line, scrolls up (forward) a windowful.
Otherwise, tries to bring current line to top of window.
Leaves point at end of line and returns t if scrolled, nil if not."
  (interactive)
  (let ((rtn t))
    (if smart-scroll-proportional
	(let ((wind-line (- (hypb:screen-line) (nth 1 (window-edges)))))
	  ;; If selected line is already first in window, then scroll forward a
	  ;; windowful, otherwise make it first in window.
	  (if (= wind-line 0)
	      (if (pos-visible-in-window-p (point-max))
		  (setq rtn nil)
		(scroll-up))
	    (recenter 0)))
      (if (pos-visible-in-window-p (point-max))
	  (setq rtn nil)
	(scroll-up))
      )
    (end-of-line)
    (or rtn (progn (beep) (message "End of buffer")))
    rtn))

(require 'h-skip-bytec "h-skip-bytec.lsp")

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

(defun smart-key-set-point (set-point-arg-list)
  "Sets point to cursor position using SET-POINT-ARG-LIST and returns t.
If 'mouse-set-point-command' is not bound to a function, this does nothing
and returns nil."
  (if (fboundp mouse-set-point-command)
      (progn
	(if (and (boundp 'drag-zone) drag-zone)
	    (progn (delete-zone drag-zone)
		   (setq drag-zone nil))
	  (and (boundp 'drag-button) drag-button
	       (progn (delete-button drag-button)
		      (setq drag-button nil))))
	(or (if set-point-arg-list
		(funcall mouse-set-point-command set-point-arg-list)
	      (funcall mouse-set-point-command))
	    t))))
    
(provide 'hmouse-drv)