;;!emacs
;;
;; FILE:         hui-mouse.el
;; SUMMARY:      Use key or mouse key for many functions, e.g. Hypb menus.
;;               See the "hmouse-doc" file and the doc strings for
;;               functions herein.
;; USAGE:        GNU Emacs Lisp Library
;;
;; AUTHOR:       Bob Weiner
;; ORG:          Brown U.
;;
;; ORIG-DATE:    04-Feb-89
;; LAST-MOD:     10-May-93 at 12:10:31 by Bob Weiner
;;
;; This file is part of Hyperbole.
;;
;; Copyright (C) 1989-1993  Brown University
;; Available for use and distribution under the same terms as GNU Emacs.
;;
;;  This code is machine independent.  It works best with a pointing device but
;;  may also be used from a keyboard.  When used with a pointing device it
;;  requires an Emacs command that sets point to the location of the pointing
;;  device's cursor.
;;
;;  If you want to use your middle mouse button to select Hyperbole menu
;;  items, follow these instructions.
;;
;;  If you plan to use a mouse only with X windows, SunView, Apollo's DM,
;;  or under Epoch (X-Windowed version of Emacs from U of Illinois)
;;  and you want to use the middle and right buttons, you need not do
;;  any mouse configuration.  Your Emacs executable must have been built so
;;  as to include the mouse support files for your window system, however.
;;  These are in the Emacs "src" directory: for X "x*.c", for SunView
;;  "sunfns.c", and for Apollo DM "apollo.c" and "apollo.el".
;;
;;  To use a different mouse key or a different window system, modify the
;;  'sm-mouse-setup' in "hmouse-key.el".
;;
;; Using the smart-key with a mouse to browse through and delete files from
;; Dired listings is exceptionally nice, just as it is when reading mail.
;;
;; DESCRIP-END.

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

(defvar mouse-set-point-command nil
  "*Command that sets point to mouse cursor position.")

(defvar smart-key-other-mode-cmd 'hui:menu
  "*Symbol name of command run by the Smart Key in an unspecified context.")

(defvar smart-key-meta-other-mode-cmd 'smart-key-summarize
  "*Symbol name of command run by the secondary Smart Key in an unspecified context.")

;;; ************************************************************************
;;; smart-key dispatch table
;;; ************************************************************************

(defvar smart-key-value nil
  "Communicates a value between a Smart Key predicate and its actions.")

(defvar smart-key-alist
  '(
    ;;
    ;; If click in the minibuffer and reading an argument,
    ;; accept argument or give completion help.
    ((and (> (minibuffer-depth) 0)
	  (eq (selected-window) (minibuffer-window))
	  (not (eq hargs:reading-p 'hmenu))) .
     ((exit-minibuffer) . (smart-completion-help)))
    ;;
    ;; If reading a Hyperbole menu item or a Hyperbole completion-based
    ;; argument, allow selection of an item at point.
    ((and (> (minibuffer-depth) 0) (setq smart-key-value (hargs:at-p))) .
     ((hargs:select-p smart-key-value) .
      (hargs:select-p smart-key-value 'meta)))
    ;;
    ((and (not (eobp))
	  (or (eolp) (and selective-display
			  (= (following-char) ?\^M)))) .
     ((scroll-up-eol) . (scroll-down-eol)))
    ;;
    ;; Possibly edit or create a Hyperbole button.
    ;; Falses too often, so commented out for now.
    ;; ((and (fboundp 'hui:ebut-edit) (hui:ebut-edit)) . (nil . nil))
    ;;
    ;; If on a Hyperbole button, perform action or give help.
    ((and (fboundp 'hbut:at-p) (or (hbut:at-p) (hbut:label-p))) .
     ((hui:hbut-act 'hbut:current) . (hui:hbut-help 'hbut:current)))
    ;;
    ((eq major-mode 'smart-menu-mode) . 
     ((smart-menu-select) . (smart-menu-help)))
    ;;
    ;; Support direct selection and viewing on in-memory relational databases.
    ;; Rdb-mode may not be publicly released for quite awhile
    ;; due to time constraints.
    ;; ((eq major-mode 'rdb-mode) . ((smart-rdb) . (smart-rdb-meta)))
    ;;
    ;; Restore screen and hide help buffer when click at buffer end
    ((and (= (point) (point-max)) (string-match "Help\\*$" (buffer-name))) .
     ((smart-key-help-hide) . (smart-key-help-hide)))
    ;;
    ;; The OO-Browser is not publicly available at this time.
    ;; If it becomes so, it will be announced.
    ((and (fboundp 'br-in-browser) (br-in-browser)) .
     ((smart-br-dispatch) . (smart-br-meta-dispatch)))
    ;;
    ((and (memq major-mode '(c-mode c++-c-mode))
	  buffer-file-name (setq smart-key-value (smart-c-at-tag-p))) .
     ((smart-c) . (smart-c nil 'next-tag)))
    ;;
    ((and (smart-lisp-mode-p) (smart-lisp-at-tag-p)) .
     ((smart-lisp) . (smart-lisp 'next-tag)))
    ;;
    ((and (eq major-mode 'c++-mode) buffer-file-name
	  (setq smart-key-value
		(or 
		  ;; Only t if OO-Browser has been loaded.
		  (fboundp 'c++-to-definition)
		  (smart-c++-at-tag-p)))) .
     ((if (eq smart-key-value t) (smart-c++-oobr)
	(smart-c++)) .
      (if (eq smart-key-value t) (smart-c++-oobr)
	(smart-c++ nil 'next-tag))))
    ;;
    ((eq major-mode 'occur-mode) .
     ((occur-mode-goto-occurrence) . (occur-mode-goto-occurrence)))
    ;;
    ((eq major-mode 'moccur-mode) .
     ((moccur-mode-goto-occurrence) . (moccur-mode-goto-occurrence)))
    ;;
    ((eq major-mode 'calendar-mode) .
     ((smart-calendar) . (smart-calendar-meta)))
    ;;
    ((eq major-mode 'unix-apropos-mode) .
     ((smart-apropos) . (smart-apropos-meta)))
    ;;
    ;; The Smart Menu system is not ready for public release yet.
    ;; When it becomes so, it will be announced.
    ((and (fboundp 'smart-menu-choose-menu)
	  (setq smart-key-value (and smart-key-always-display-menu
				     (smart-menu-choose-menu)))
	  (not (and (get-buffer-window *smart-menu-buffer*)
		    (eq smart-key-value *smart-menu-curr*)))) .
     ((smart-menu smart-key-value) .
      (smart-menu smart-key-value)))
    ;;
    ((eq major-mode 'outline-mode) .
     ((smart-outline) . (smart-outline-meta)))
    ;;
    ((eq major-mode 'Info-mode) .
     ((smart-info) .  (smart-info-meta)))
    ;;
    ((and (boundp 'hmail:reader)
	  (or (eq major-mode hmail:reader)
	      (eq major-mode hmail:lister))) .
     ((smart-hmail) . (smart-hmail-meta)))
    ;;
    ((eq major-mode 'gnus-Group-mode)
     (smart-gnus-Group) . (smart-gnus-Group-meta))
    ;;
    ((eq major-mode 'gnus-Subject-mode)
     (smart-gnus-Subject) . (smart-gnus-Subject-meta))
    ;;
    ((eq major-mode 'gnus-Article-mode)
     (smart-gnus-Article) . (smart-gnus-Article-meta))
    ;;
    ((eq major-mode 'Buffer-menu-mode) .
     ((smart-buffer-menu) . (smart-buffer-menu-meta)))
    ;;
    ((eq major-mode 'dired-mode) . 
     ((smart-dired) . (smart-dired-meta)))
    ;;
    ((equal mode-name "View") .
     ((View-scroll-lines-forward) . (View-scroll-lines-backward)))
    ;;
    ;; Follow references in man pages.
    ((setq smart-key-value (smart-man-entry-ref)) .
     ((smart-man-display smart-key-value) .
      (smart-man-display smart-key-value)))
    ;;
    ((and (boundp 'rolo-display-buffer)
	  (equal (buffer-name) rolo-display-buffer)) .
     ((smart-wrolo) . (smart-wrolo-meta)))
    ;;
    ;; Outline minor mode is on.
    (selective-display .
     ((smart-outline) . (smart-outline-meta)))
    )
  "Alist of predicates and form-conses for context-sensitive smart key actions.
When the smart-key or the smart-key-meta is pressed, the first or
second form, respectively, associated with the first non-nil predicate is
evaluated."
  )

;;; ************************************************************************
;;; smart-key driver code
;;; ************************************************************************

(require 'hargs)
(require 'hmouse-key)
(require 'hmouse-drv)
(if hyperb:window-system
    (progn
      (defvar smart-key-mouse-alist smart-key-alist
	"Alist of predicates and form-conses for context-sensitive smart key mouse actions.
When the smart-key or the smart-key-meta is pressed, the first or
second form, respectively, associated with the first non-nil predicate is
evaluated.")
      (load "hui-window")))

;;; ************************************************************************
;;; smart-key support code
;;; ************************************************************************

;; The 'load' line below loads any available local definitions apropos
;; the Smart Key support.  The public distribution contains none.
;; You may comment it out if you prefer.
(load "smart-local" t)

(autoload 'smart-c-at-tag-p "hmouse-tag" "Jumps to C identifier definitions.")
(autoload 'smart-lisp-mode-p "hmouse-tag"
	  "Jumps to Lisp identifier definitions.")
;; Does nothing unless OO-Browser C++ support has been loaded.
(autoload 'smart-c++ "hmouse-tag" "Jumps to C++ identifier definitions.")
(autoload 'smart-c++-oobr "hmouse-tag" "Jumps to C++ identifier definitions.")
(autoload 'smart-tags-file "hmouse-tag" "Determines nearest etags file.")

(defun smart-completion-help ()
  "Offer completion help for current minibuffer argument, if any."
  (and (where-is-internal 'minibuffer-completion-help (current-local-map))
       (minibuffer-completion-help)))

(defun smart-symlink-expand (path)
  "Returns referent for possible symbolic link, PATH."
  (if (not (fboundp 'symlink-referent))
      path
    (let ((start 0) (len (length path)) (ref) (part))
      (while (and (< start len) (setq part (string-match "/[^/]*" path start)))
	(setq part (concat ref
			   (substring path start (setq start (match-end 0))))
	      ref (symlink-referent part)))
      ref)))

;;; ************************************************************************
;;; smart-buffer-menu functions
;;; ************************************************************************

(defun smart-buffer-menu (&optional in-browser)
  "Uses a single key or mouse key to manipulate buffer-menu entries.

Invoked via a key press when in Buffer-menu-mode.  It assumes that its
caller has already checked that the key was pressed in an appropriate buffer
and has moved the cursor there.

Optional non-nil IN-BROWSER indicates use within the OO-Browser.

If key is pressed:
 (1) on the first column of an entry, the selected buffer is marked for
     display; 
 (2) on the second column of an entry, the selected buffer is marked to be
     saved;
 (3) anywhere else within an entry line, all saves and deletes are done, and
     selected buffers are displayed, including the one just clicked on (if
     IN-BROWSER, only the selected buffer is displayed);
 (4) on or after the last line in the buffer, all saves and deletes are done."

  (interactive)
  (cond ((last-line-p) (Buffer-menu-execute))
	((bolp) (Buffer-menu-mark))
        ((save-excursion
             (goto-char (1- (point)))
	     (bolp))
	 (Buffer-menu-save))
	(t (if in-browser
	       (br-buffer-menu-select)
	     (Buffer-menu-select)))))

(defun smart-buffer-menu-meta ()
  "Uses a single meta-key or mouse meta-key to manipulate buffer-menu entries.

Invoked via a meta-key press when in Buffer-menu-mode.  It assumes that its
caller has already checked that the meta-key was pressed in an appropriate
buffer and has moved the cursor there.

If meta-key is pressed:
 (1) on the first or second column of an entry, the selected buffer is unmarked
     for display and for saving or deletion; 
 (2) anywhere else within an entry line, the selected buffer is marked for
     deletion;
 (3) on or after the last line in the buffer, all display, save, and delete
     marks on all entries are undone."

  (interactive)
  (cond ((last-line-p) (progn (list-buffers) (forward-line 3)))
	((bolp) (Buffer-menu-unmark))
        ((save-excursion
             (goto-char (1- (point)))
	     (bolp))
	 (Buffer-menu-unmark))
	((Buffer-menu-delete))))

;;; ************************************************************************
;;; smart-calendar functions
;;; ************************************************************************

(defun smart-calendar ()
  "Uses a single key or mouse key to manipulate the scrolling calendar.

Invoked via a key press when in calendar-mode.  It assumes that its
caller has already checked that the key was pressed in an appropriate buffer
and has moved the cursor there.

If key is pressed:
 (1) at the end of the buffer, the calendar is scrolled forward 3 months;
 (2) to the left of any dates on a calendar line, the calendar is scrolled
     backward 3 months;
 (3) on a date, the diary entries for the date, if any, are displayed."

  (interactive)
  (cond ((eobp) (calendar-cursor-to-nearest-date)
	 (scroll-calendar-left-three-months 1))
	((< (current-column) 5) (calendar-cursor-to-nearest-date)
	 (scroll-calendar-right-three-months 1))
	((progn (calendar-cursor-to-nearest-date)
		(view-diary-entries 1)))))

(defun smart-calendar-meta ()
  "Uses a single meta-key or mouse meta-key to manipulate the scrolling calendar.

Invoked via a meta-key press when in calendar-mode.  It assumes that its
caller has already checked that the meta-key was pressed in an appropriate
buffer and has moved the cursor there.

If meta-key is pressed:
 (1) at the end of the buffer, the calendar is scrolled backward 3 months;
 (2) to the left of any dates on a calendar line, the calendar is scrolled
     forward 3 months;
 (3) anywhere else, all dates with marking diary entries are marked in the
     calendar window."

  (interactive)
  (cond ((eobp) (calendar-cursor-to-nearest-date)
	 (scroll-calendar-right-three-months 1))
	((< (current-column) 5) (calendar-cursor-to-nearest-date)
	 (scroll-calendar-left-three-months 1))
	((mark-diary-entries))))


;;; ************************************************************************
;;; smart-dired functions
;;; ************************************************************************

(defun smart-dired ()
  "Uses a single key or mouse key to manipulate directory entries.

Invoked via a key press when in dired-mode.  It assumes that its
caller has already checked that the key was pressed in an appropriate buffer
and has moved the cursor there.

If key is pressed:
 (1) within an entry line, the selected file/directory is displayed for editing;
 (2) on or after the last line in the buffer, if any deletes are to be
     performed, they are executed after user verification, otherwise, this
     dired invocation is quit."

  (interactive)
  (cond ((last-line-p)
	 (let (flagged)
	   (save-excursion
	     (goto-char 1)
	     (setq flagged (re-search-forward "^D" nil t)))
	   (if flagged
	       (cond ((fboundp 'dired-do-deletions)
		      (dired-do-deletions))
		     ;; For Tree-dired compatibility
		     ((fboundp 'dired-do-flagged-delete)
		      (dired-do-flagged-delete))
		     (t (error "(smart-dired): No Dired expunge function.")))
	     (dired-quit))
	   ))
	((hpath:find-other-window (dired-get-filename)))))

(defun smart-dired-meta ()
  "Uses a single meta-key or mouse meta-key to manipulate directory entries.

Invoked via a meta-key press when in dired-mode.  It assumes that its
caller has already checked that the meta-key was pressed in an appropriate
buffer and has moved the cursor there.

If meta-key is pressed:
 (1) on a '~' character, all backup files in the directory are marked for
     deletion;
 (2) on a '#' character, all auto-save files in the directory are marked for
     deletion;
 (3) anywhere else within an entry line, the selected buffer is marked for
     deletion;
 (4) on or after the last line in the buffer, all delete marks on all entries
     are undone."

  (interactive)
  (cond ((last-line-p)
	 (progn (dired-unflag (- (goto-char (point-max))))
		(goto-char (point-max))))
	((looking-at "~") (dired-flag-backup-files))
	((looking-at "#") (dired-flag-auto-save-files))
	((dired-flag-file-deleted 1))))

;;; ************************************************************************
;;; smart-gnus functions
;;; ************************************************************************

(defun smart-gnus-Group ()
  "Uses a key or mouse key to move through Gnus Newsgroup listings.
Invoked via a key press when in gnus-Group-mode.  It assumes that its caller
has already checked that the key was pressed in an appropriate buffer and has
moved the cursor to the selected buffer.

If key is pressed within:
 (1) a GNUS-GROUP line, that newsgroup is read;
 (2) to the left of any GNUS-GROUP line, on any of the whitespace, the current
     group is unsubscribed or resubscribed;
 (3) at the end of the GNUS-GROUP buffer, after all lines, checks for new
     news."

  (interactive)
  (cond ((last-line-p) (gnus-Group-get-new-news))
	((progn (skip-chars-backward " U") (bolp))
	 (gnus-Group-unsubscribe-current-group))
	((gnus-Group-read-group nil))))

(defun smart-gnus-Group-meta ()
  "Uses a meta-key or meta-mouse key to move through Gnus Newsgroup listings.
Invoked via a meta-key press when in gnus-Group-mode.  It assumes that its
caller has already checked that the key was pressed in an appropriate buffer
and has moved the cursor to the selected buffer.

If key is pressed within:
 (1) a GNUS-GROUP line, that newsgroup is read;
 (2) to the left of any GNUS-GROUP line, on any of the whitespace, the user is
     prompted for a group name to subscribe or unsubscribe to;
 (3) at the end of the GNUS-GROUP buffer, after all lines, quits from the
     newsreader."

  (interactive)
  (cond ((last-line-p) (gnus-Group-exit))
	((progn (skip-chars-backward " U") (bolp))
	 (call-interactively 'gnus-Group-unsubscribe-group))
	((gnus-Group-read-group nil))))

(defun smart-gnus-Subject ()
  "Uses a key or mouse key to move through Gnus News article listings.
Invoked via a key press when in gnus-Subject-mode.  It assumes that its caller
has already checked that the key was pressed in an appropriate buffer and has
moved the cursor to the selected buffer.

If key is pressed within:
 (1) a GNUS-SUBJECT line, that article is read, marked deleted, and scrolled
     forward;
 (2) at the end of the GNUS-SUBJECT buffer, the next undeleted article
     is read or the next group is entered."

  (interactive)
  (cond ((last-line-p)
	 (if gnus-current-article
	     (progn (goto-char (point-min))
		    (re-search-forward
		      (format "^.[ ]+%d:" gnus-current-article) nil t)
		    (setq this-command 'gnus-Subject-next-page)
		    (call-interactively 'gnus-Subject-next-page))
	   (goto-char (point-min))
	   (setq this-command 'gnus-Subject-first-unread-article)
	   (call-interactively 'gnus-Subject-first-unread-article)))
	((progn (skip-chars-backward " D") (bolp))
	 (gnus-Subject-mark-as-unread-forward 1))
	(t (setq this-command 'gnus-Subject-next-page)
	   (call-interactively 'gnus-Subject-next-page))))

(defun smart-gnus-Subject-meta ()
  "Uses a meta-key or meta-mouse key to move through Gnus News articles.
Invoked via a meta-key press when in gnus-Subject-mode.  It assumes that its
caller has already checked that the key was pressed in an appropriate buffer
and has moved the cursor to the selected buffer.

If key is pressed within:
 (1) a GNUS-SUBJECT line, that article is read and scrolled backward;
 (2) at the end of the GNUS-SUBJECT buffer, the subject is exited, the user
     is returned to group mode."

  (interactive)
  (cond ((last-line-p)
	 (setq this-command 'gnus-Subject-prev-page)
	 (call-interactively 'gnus-Subject-exit))
	((progn (skip-chars-backward " D") (bolp))
	 (gnus-Subject-mark-as-unread-backward 1))
	(t (setq this-command 'gnus-Subject-prev-page)
	   (call-interactively 'gnus-Subject-prev-page))))

(defun smart-gnus-Article ()
  "Uses a key or mouse key to move through Gnus netnews articles.

Invoked via a key press when in gnus-Article-mode.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.

If key is pressed within:
 (1) the first line or end of an article, the next unread message is displayed;
 (2) the first line of an Info cross reference, the reference is followed;
 (3) anywhere else, the window is scrolled up one screen."
  (interactive)
  (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
	 (unwind-protect
	     (progn (set-buffer gnus-Subject-buffer)
		    (setq this-command 'gnus-Subject-next-unread-article)
		    (gnus-Subject-next-unread-article)
		    (gnus-Subject-goto-subject gnus-current-article)
		    )
	   (let ((artic (get-buffer-window gnus-Article-buffer)))
	     (if artic (select-window artic)))))
	((and (not (eolp)) (Info-handle-in-note)))
	((scroll-up-eol))))

(defun smart-gnus-Article-meta ()
  "Uses a meta-key or mouse meta-key to move through Gnus netnews articles.

Invoked via a meta-key press when in gnus-Article-mode.
It assumes that its caller has already checked that the meta-key was pressed in
an appropriate buffer and has moved the cursor to the selected buffer.

If meta-key is pressed within:
 (1) the first line or end of an article, the previous message is displayed;
 (2) the first line of an Info cross reference, the reference is followed;
 (3) anywhere else, the window is scrolled down one screen."
  (interactive)
  (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
	 (unwind-protect
	     (progn (set-buffer gnus-Subject-buffer)
		    (setq this-command 'gnus-Subject-prev-article)
		    (gnus-Subject-prev-article nil)
		    (gnus-Subject-goto-subject gnus-current-article)
		    )
	   (let ((artic (get-buffer-window gnus-Article-buffer)))
	     (if artic (select-window artic)))))
	((and (not (eolp)) (Info-handle-in-note)))
	((scroll-down-eol))))

;;; ************************************************************************
;;; smart-hmail functions
;;; ************************************************************************

(defun smart-hmail ()
  "Uses a key or mouse key to move through e-mail messages and summaries.

Invoked via a key press when in hmail:reader or hmail:lister mode.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.

If key is pressed within:
 (1) a msg buffer, within the first line or at the end of a message,
     the next undeleted message is displayed;
 (2) a msg buffer within the first line of an Info cross reference, the
     reference is followed;
 (3) anywhere else in a msg buffer, the window is scrolled up one screen; 
 (4) a msg summary buffer on a header entry, the message corresponding to
     the header is displayed in the msg window;
 (5) a msg summary buffer, on or after the last line, the messages marked
     for deletion are expunged."

  (interactive)
  ;;
  ;; Branch on buffer type
  ;;
  (cond ((eq major-mode hmail:reader)
	 (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
		(rmail:msg-next))
	       ((and (not (eolp)) (Info-handle-in-note)))
	       ((scroll-up-eol))))
	;;
	;; Assume are in msg summary buffer
	;;
	((last-line-p) (lmail:expunge))
	((lmail:goto))))

(defun smart-hmail-meta ()
  "Uses a meta key or mouse key to move through e-mail messages and summaries.

Invoked via a meta key press when in hmail:reader or hmail:lister mode.
It assumes that its caller has already checked that the meta-key was pressed in
an appropriate buffer and has moved the cursor to the selected buffer.

If meta-key is pressed within:
 (1) a msg buffer, within the first line or at the end of a message,
     the previous undeleted message is displayed;
 (2) a msg buffer within the first line of an Info cross reference, the
     reference is followed;
 (3) anywhere else in a msg buffer, the window is scrolled down one screen; 
 (4) a msg summary buffer on a header entry, the message corresponding to
     the header is marked as deleted;
 (5) a msg summary buffer, on or after the last line, all messages are
     marked undeleted."

  (interactive)
  ;;
  ;; Branch on buffer type
  ;;
  (cond ((eq major-mode hmail:reader)
	 (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
		(rmail:msg-prev))
	       ((and (not (eolp)) (Info-handle-in-note)))
	       ((scroll-down-eol))))
	;;
	;; Assume are in msg summary buffer
	;;
	((last-line-p) (lmail:undelete-all))
	((lmail:delete))))


;;; ************************************************************************
;;; smart-info functions
;;; ************************************************************************

(autoload 'Info-handle-in-note "hmous-info" "Follows Info documentation references.")
(autoload 'smart-info "hmous-info" "Follows Info documentation references.")
(autoload 'smart-info-meta "hmous-info"
	  "Follows Info documentation references.")

;;; ************************************************************************
;;; smart-man functions
;;; ************************************************************************

;; "unix-apropos.el" is a publicly available Emacs Lisp package that
;; allows man page browsing from apropos listings.  "superman.el" is a
;; newer, much more complete package that you would probably prefer at
;; this point, but there is no Smart Key apropos support for it.  There
;; is smart key support within the man page buffers it produces, however.
;;

(defun smart-apropos ()
  "Moves through UNIX man apropos listings by using one key or mouse key.

Invoked via a key press when in unix-apropos-mode.  It assumes that
its caller has already checked that the key was pressed in an appropriate
buffer and has moved the cursor to the selected buffer.

If key is pressed:
 (1) on a UNIX man apropos entry, the man page for that entry is displayed in
     another window;
 (2) on or after the last line, the buffer in the other window is scrolled up
     one screen."

  (interactive)
  (cond ((last-line-p) (scroll-other-window))
	((unix-apropos-get-man))))

(defun smart-apropos-meta ()
  "Moves through UNIX man apropos listings by using one meta-key or mouse meta-key.

Invoked via a meta-key press when in unix-apropos-mode.  It assumes that
its caller has already checked that the meta-key was pressed in an appropriate
buffer and has moved the cursor to the selected buffer.

If meta-key is pressed:
 (1) on a UNIX man apropos entry, the man page for that entry is displayed in
     another window;
 (2) on or after the last line, the buffer in the other window is scrolled down
     one screen."

  (interactive)
  (cond ((last-line-p) (scroll-other-window (- 3 (window-height))))
	((unix-apropos-get-man))))

(defun smart-man-display (lisp-form)
  "Evaluates LISP-FORM returned from 'smart-man-entry-ref' to display a man page."
  (eval lisp-form))

(defun smart-man-entry-ref ()
  "Returns form which displays referenced manual entry that point is on or nil.
Handles references in sections: NAME, SEE ALSO, or PACKAGES USED.  Also can
display C routine definitions selected in a man page, see
'smart-man-c-routine-ref'.

Man page buffer must either have an attached file or else a `man-path'
local variable containing its pathname."
  (interactive)
  (let ((ref ""))
    (if (not (or (if (string-match "Manual Entry\\|\\*man "
				   (buffer-name (current-buffer)))
		     (progn (and (boundp 'man-path) man-path
				 (setq ref (smart-symlink-expand man-path)))
			    t))
		 (if buffer-file-name
		     (string-match "/man/" (setq ref (smart-symlink-expand
						      buffer-file-name))))))
	(setq ref nil)
      (or (setq ref (or (smart-man-file-ref)
			(and (string-match "/interviews\\|/iv"
					   (downcase ref))
			     (boundp 'br-env-dir)
			     br-env-dir
			     (setq ref (car (directory-files
					     br-env-dir 'full
					     "interviews\\|iv")))
			     (list 'c++-man-ftr-to-def ref))
			(smart-man-c-routine-ref)
			))
	  (save-excursion
	    (let ((opoint (point))
		  (case-fold-search))
	      (and
	       (re-search-backward "^[.A-Z]" nil t)
	       (looking-at
		"\\(\\.SH[ \t]+\\)?\\(SEE ALSO\\|NAME\\|PACKAGES USED\\)")
	       (progn (goto-char opoint)
		      (skip-chars-backward "-_a-zA-Z0-9?.(")
		      (let ((start (point)))
			(skip-chars-forward "-_a-zA-Z0-9?.()")
			(setq ref (buffer-substring start (point)))
			;; Leave only one char within ref parens
			(if ref
			    (if (string-match "(\\(.\\)\\(.+\\))" ref)
				;; !! Ignore section for Interviews for now
				(setq ref
				      (if (string=
					    "I" (substring ref
							   (match-beginning 2)
							   (match-end 2)))
					  (substring ref 0
						     (match-beginning 0))
					(concat
					  (substring ref 0
						     (match-end 1))
					  "\)")))))
			)))))))
    (cond ((equal ref "") nil)
	  ((stringp ref) (list 'manual-entry ref))
	  (t ref))))

(defun smart-man-c-routine-ref ()
  "Returns form to jump to def of C function whose name is at point, if any.
Valid sections within the man page are: ROUTINES, MACROS or FUNCTIONS.
Uses (smart-tags-file) function to determine etags file from which to
locate the definition.

Returns etags file name if point is on an identifier in the appropriate
section and the jump is done, otherwise, returns nil."
  (let ((ref)
	(tags-file-name (smart-tags-file (if (and (boundp 'man-path) man-path)
					     man-path
					   default-directory)))
	(opoint (point))
	(case-fold-search))
    (save-excursion
      (and (re-search-backward "^[.A-Z]" nil t)
	   (looking-at "^\\(FUNCTIONS\\|ROUTINES\\|MACROS\\)[ \t\n]")
	   (progn (goto-char opoint)
		  (skip-chars-backward "_~<>:a-zA-Z0-9(")
		  (if (or (looking-at "\\([_~<>:a-zA-Z0-9]+\\)[ \t\n]*(")
			  (looking-at "\\([_~<:A-Z][_<>:A-Z0-9]+\\)"))
		      (setq ref (buffer-substring
				 (match-beginning 1) (match-end 1))
			    )))))
    (and ref
	 (file-exists-p tags-file-name)
	 (file-readable-p tags-file-name)
	 (list 'let (list (list 'tags-file-name tags-file-name))
	       (list (if (and (fboundp 'br-in-browser) (br-in-browser))
			 'find-tag 'find-tag-other-window)
		     ref)))))

(defun smart-man-file-ref ()
  "Returns form to eval to display file whose name point is on, within a FILES man page section.
If not on a file name, returns nil."
  (let ((ref)
	(opoint (point))
	(case-fold-search))
    (save-excursion
      (and (re-search-backward "^[.A-Z]" nil t)
	   (looking-at "^FILES[ \t\n]")
	     (progn (goto-char opoint)
		    (skip-chars-backward "^ \t")
		    (if (looking-at "/[^ \t\n]+")
			(setq ref (buffer-substring
				   (match-beginning 0) (match-end 0))
			      )))))
    (if ref
	(list (if (and (fboundp 'br-in-browser) (br-in-browser))
		  'find-file 'find-file-other-window)
	      ref))))

;;; ************************************************************************
;;; smart-outline functions
;;; ************************************************************************

;; THE FUNCTIONS IN THIS SECTION REQUIRE MY CHANGES OF 12/22/89 TO
;; "outline.el" IN ORDER TO WORK PROPERLY.

(defvar smart-outline-cut nil
  "Non-nil means outline region was cut and is ready to be pasted at point.")

(let ((proc
	'((lambda ()
	    (make-local-variable 'smart-outline-cut)
	    ;; Non-nil means outline region was cut and is available to be
	    ;; pasted at point.
	    (setq smart-outline-cut nil)
	    ))))
  (if (boundp 'outline-mode-map)
      (eval proc)
    (var:append 'outline-mode-hook proc)))

(defun smart-outline ()
  "Collapses, expands, and moves outline entries.
Invoked via a key press when in outline-mode.  It assumes that
its caller has already checked that the key was pressed in an appropriate
buffer and has moved the cursor to the selected buffer.

If key is pressed:
 (1) after an outline heading has been cut via the smart-key, then paste the
     cut heading at point;
 (2) at the end of buffer, show all buffer text 
 (3) at the beginning of a heading line, cut the headings subtree from the
     buffer;
 (4) on a header line but not at the beginning or end, if headings subtree is
     hidden then show it, otherwise hide it;
 (5) anywhere else, scroll up one screen."

  (interactive)
  (cond (smart-outline-cut
	  (progn (setq smart-outline-cut nil) (yank)))
	((eobp) (show-all))
	((and (bolp) (looking-at outline-regexp))
	 (progn
	   (setq smart-outline-cut t)
	   (kill-region
	    (point)
	    (or (outline-get-next-sibling)
		;; Skip past start of current entry
		(progn (re-search-forward outline-regexp nil t)
		       (smart-outline-to-entry-end t (outline-level)))))))
	((and (not (eolp)) (/= (save-excursion (beginning-of-line)
					       (outline-level))
			       0))
	 ;; On an outline header line but not at the start/end of line.
	 (if (smart-outline-subtree-hidden-p) (show-subtree) (hide-subtree)))
	((scroll-up-eol))
	))

(defun smart-outline-meta ()
  "Collapses, expands, and moves outline entries.
Invoked via a meta-key press when in outline-mode.  It assumes that
its caller has already checked that the meta-key was pressed in an appropriate
buffer and has moved the cursor to the selected buffer.

If meta-key is pressed:
 (1) after an outline heading has been cut via the smart-key, allow multiple
     pastes throughout the buffer (last paste should be done with smart key,
     not meta smart key);
 (2) at the end of buffer, hide all bodies in buffer;
 (3) at the beginning of a heading line, cut the current heading (sans
     subtree) from the buffer;
 (4) on a header line but not at the beginning or end, if heading body is
     hidden then show it, otherwise hide it;
 (5) anywhere else, scroll down one screen."

  (interactive)
  (cond (smart-outline-cut (yank))
	((eobp) (hide-body ))
	((and (bolp) (looking-at outline-regexp))
	 (progn
	   (setq smart-outline-cut t)
	   (kill-region (point) 
			;; Skip past start of current entry
			(progn (re-search-forward outline-regexp nil t)
			       (smart-outline-to-entry-end
				nil (outline-level))))
	   ))
	((and (not (eolp)) (/= (save-excursion (beginning-of-line)
					       (outline-level))
			       0))
	 ;; On an outline header line but not at the start/end of line.
	 (if (smart-outline-subtree-hidden-p) (show-entry) (hide-entry)))
	((scroll-down-eol))
	))

(defun smart-outline-to-entry-end
  (&optional include-sub-entries curr-entry-level)
"Goes to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil.
CURR-ENTRY-LEVEL is an integer representing the length of the current level
string which matched to 'outline-regexp'.  If INCLUDE-SUB-ENTRIES is nil,
CURR-ENTRY-LEVEL is not needed."
  (while (and (setq next-entry-exists
		    (re-search-forward outline-regexp nil t))
	      include-sub-entries
	      (save-excursion
		(beginning-of-line)
		(> (outline-level)
		   curr-entry-level))))
  (if next-entry-exists
      (progn (beginning-of-line) (point))
    (goto-char (point-max))))

(defun smart-outline-subtree-hidden-p ()
  "Returns t if at least initial subtree of heading is hidden, else nil."
  (save-excursion
    (and (re-search-forward "[\n\^M]" nil t) (= (preceding-char) ?\^M))))

;;; ************************************************************************
;;; smart-wrolo functions
;;; ************************************************************************

(defun smart-wrolo ()
  "In wrolo match buffer, either narrows to selected entry or expands to all.
Uses one key or mouse key.

Invoked via a key press when in the 'rolo-display-buffer'.  It assumes that
its caller has already checked that the key was pressed in an appropriate
buffer and has moved the cursor to the selected buffer.

If key is pressed:
 (1) At the start of a rolodex match entry, the entry is edited in the
     other window;
 (2) anywhere else within an entry line, toggles between displaying only
     the selected rolodex item and displaying all matches."

  (interactive)
  (let (name)
    (cond ((setq name (rolo-name-at))
	   (rolo-edit name (hbut:key-src)))
	  ((rolo-toggle-narrow-to-entry)))))

(fset 'smart-wrolo-meta 'smart-wrolo)

(provide 'hui-mouse)
