home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / hui-mouse.el < prev    next >
Encoding:
Text File  |  1995-08-11  |  37.0 KB  |  996 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hui-mouse.el
  4. ;; SUMMARY:      Use key or mouse key for many functions, e.g. Hypb menus.
  5. ;;               See the "${data-directory}/hypb-mouse.txt" file and the
  6. ;;               documentation strings for functions herein.
  7. ;; USAGE:        GNU Emacs Lisp Library
  8. ;; KEYWORDS:     hypermedia, mouse
  9. ;;
  10. ;; AUTHOR:       Bob Weiner
  11. ;; ORG:          Brown U.
  12. ;;
  13. ;; ORIG-DATE:    04-Feb-89
  14. ;; LAST-MOD:     25-Jul-95 at 16:26:03 by Bob Weiner
  15. ;;
  16. ;; This file is part of Hyperbole.
  17. ;; Available for use and distribution under the same terms as GNU Emacs.
  18. ;;
  19. ;; Copyright (C) 1989-1995, Free Software Foundation, Inc.
  20. ;; Developed with support from Motorola Inc.
  21. ;;
  22. ;; DESCRIPTION:  
  23. ;;
  24. ;;  This code is machine independent.  It works best with a pointing device but
  25. ;;  may also be used from a keyboard.  When used with a pointing device it
  26. ;;  requires an Emacs command that sets point to the location of the pointing
  27. ;;  device's cursor.
  28. ;;
  29. ;;  If you want to use your shift-middle mouse button to select Hyperbole menu
  30. ;;  items and Hyperbole buttons, follow these instructions.
  31. ;;
  32. ;;  If you plan to use a mouse only with X windows (Lucid Emacs, GNU Emacs
  33. ;;  19, or Epoch), NEXTSTEP, SunView, Apollo's DM, and you want to use the
  34. ;;  shift-middle and shift-right buttons, you need not do any mouse
  35. ;;  configuration.  Your Emacs executable must have been built so as to
  36. ;;  include the mouse support files for your window system, however.  These
  37. ;;  are in the Emacs "src" directory: for X "x*.c", for SunView "sunfns.c",
  38. ;;  and for Apollo DM "apollo.c" and "apollo.el".
  39. ;;
  40. ;;  To use a different mouse key or a different window system, modify the
  41. ;;  mouse key bindings in "hmouse-key.el".
  42. ;;
  43. ;; Using the Action Mouse Key to browse through and delete files from
  44. ;; Dired listings is exceptionally nice, just as it is when reading mail.
  45. ;;
  46. ;; DESCRIP-END.
  47.  
  48. ;;; ************************************************************************
  49. ;;; Public variables
  50. ;;; ************************************************************************
  51.  
  52. (defvar hmouse-set-point-command nil
  53.   "*Command that sets point to mouse cursor position.")
  54.  
  55. (defvar action-key-default-function 'hui:menu
  56.   "*Symbol name of function run by the Action Key in an unspecified context.")
  57.  
  58. (defvar assist-key-default-function 'hkey-summarize
  59.   "*Symbol name of function run by the Assist Key in an unspecified context.")
  60.  
  61. ;;; ************************************************************************
  62. ;;; Hyperbole context-sensitive keys dispatch table
  63. ;;; ************************************************************************
  64.  
  65. (defvar hkey-value nil
  66.   "Communicates a value between a Smart Key predicate and its actions.")
  67.  
  68. (defvar hkey-alist
  69.   '(
  70.     ;;
  71.     ;; If click in the minibuffer and reading an argument,
  72.     ;; accept argument or give completion help.
  73.     ((and (> (minibuffer-depth) 0)
  74.       (eq (selected-window) (minibuffer-window))
  75.       (not (eq hargs:reading-p 'hmenu))) .
  76.      ((exit-minibuffer) . (smart-completion-help)))
  77.     ;;
  78.     ;; If reading a Hyperbole menu item or a Hyperbole completion-based
  79.     ;; argument, allow selection of an item at point.
  80.     ((if (> (minibuffer-depth) 0) (setq hkey-value (hargs:at-p))) .
  81.      ((hargs:select-p hkey-value) .
  82.       (hargs:select-p hkey-value 'assist)))
  83.     ;;
  84.     ((if (not (eobp))
  85.       (or (eolp) (if selective-display
  86.              (= (following-char) ?\^M)))) .
  87.      ((scroll-up-eol) . (scroll-down-eol)))
  88.     ;;
  89.     ;; If on a Hyperbole button, perform action or give help.
  90.     ((if (fboundp 'hbut:at-p) (or (hbut:at-p) (hbut:label-p))) .
  91.      ((hui:hbut-act 'hbut:current) . (hui:hbut-help 'hbut:current)))
  92.     ;;
  93.     ;;
  94.     ;; View minor mode
  95.     ((if (boundp 'view-minor-mode) view-minor-mode) .
  96.      ((cond ((last-line-p)
  97.          (view-quit))
  98.         ((pos-visible-in-window-p (point-max))
  99.          (goto-char (point-max)))
  100.         (t (scroll-up))) .
  101.       (scroll-down)))
  102.     ;;
  103.     ;; View major mode
  104.     ((eq major-mode 'view-mode) .
  105.      ((View-scroll-lines-forward) . (View-scroll-lines-backward)))
  106.     ;;
  107.     ((eq major-mode 'kotl-mode) . 
  108.      ((kotl-mode:action-key) . (kotl-mode:help-key)))
  109.     ;;
  110.     ((eq major-mode 'smart-menu-mode) . 
  111.      ((smart-menu-select) . (smart-menu-help)))
  112.     ;;
  113.     ;; Support direct selection and viewing on in-memory relational databases.
  114.     ;; Rdb-mode has not been publicly released.
  115.     ;; It is not included with Hyperbole.
  116.     ((eq major-mode 'rdb-mode) . ((smart-rdb) . (smart-rdb-assist)))
  117.     ;;
  118.     ;; Restore window config and hide help buffer when click at buffer end.
  119.     ((if (= (point) (point-max)) (string-match "Help\\*$" (buffer-name))) .
  120.      ((hkey-help-hide) . (hkey-help-hide)))
  121.     ;;
  122.     ;; Support the OO-Browser, a part of InfoDock, XEmacs, and soon to be a
  123.     ;; part of Emacs.
  124.     ((or (br-in-browser) (eq major-mode 'br-mode)) .
  125.      ((smart-br-dispatch) . (smart-br-assist-dispatch)))
  126.     ;;
  127.     ((and (memq major-mode '(c-mode c++-c-mode))
  128.       buffer-file-name (setq hkey-value (smart-c-at-tag-p))) .
  129.      ((smart-c) . (smart-c nil 'next-tag)))
  130.     ;;
  131.     ((and (eq major-mode 'asm-mode)
  132.       buffer-file-name (setq hkey-value (smart-asm-at-tag-p))) .
  133.      ((smart-asm) . (smart-asm nil 'next-tag)))
  134.     ;;
  135.     ((if (smart-lisp-mode-p) (smart-lisp-at-tag-p)) .
  136.      ((smart-lisp) . (smart-lisp 'next-tag)))
  137.     ;;
  138.     ((and (eq major-mode 'c++-mode) buffer-file-name
  139.       ;; Don't use smart-c++-at-tag-p here since it will prevent #include
  140.       ;; lines from matching.
  141.       (setq hkey-value (smart-c-at-tag-p))) .
  142.      ( ;; Only fboundp if OO-Browser has been loaded.
  143.       (if (fboundp 'c++-to-definition)
  144.       (smart-c++-oobr) (smart-c++)) .
  145.       (if (fboundp 'c++-to-definition)
  146.       (smart-c++-oobr)
  147.     (smart-c++ nil 'next-tag))))
  148.     ;;
  149.     ((and (eq major-mode 'objc-mode) buffer-file-name
  150.       (setq hkey-value (smart-objc-at-tag-p))) .
  151.      ( ;; Only fboundp if OO-Browser has been loaded.
  152.       (if (fboundp 'objc-to-definition)
  153.       (smart-objc-oobr) (smart-objc)) .
  154.       (if (fboundp 'objc-to-definition)
  155.       (smart-objc-oobr)
  156.     (smart-objc nil 'next-tag))))
  157.     ;;
  158.     ((and (eq major-mode 'fortran-mode)
  159.       buffer-file-name (setq hkey-value (smart-fortran-at-tag-p))) .
  160.      ((smart-fortran) . (smart-fortran nil 'next-tag)))
  161.     ;;
  162.     ((eq major-mode 'occur-mode) .
  163.      ((occur-mode-goto-occurrence) . (occur-mode-goto-occurrence)))
  164.     ;;
  165.     ((eq major-mode 'moccur-mode) .
  166.      ((moccur-mode-goto-occurrence) . (moccur-mode-goto-occurrence)))
  167.     ;;
  168.     ((eq major-mode 'calendar-mode) .
  169.      ((smart-calendar) . (smart-calendar-assist)))
  170.     ;;
  171.     ((eq major-mode 'unix-apropos-mode) .
  172.      ((smart-apropos) . (smart-apropos-assist)))
  173.     ;;
  174.     ;; The Smart Menu system provides menus within Emacs running on a dumb
  175.     ;; terminal.  It is part of InfoDock and is not available separately.
  176.     ((and (fboundp 'smart-menu-choose-menu)
  177.       (setq hkey-value (and hkey-always-display-menu
  178.                 (smart-menu-choose-menu)))
  179.       (not (and (get-buffer-window *smart-menu-buffer*)
  180.             (eq hkey-value *smart-menu-curr*)))) .
  181.      ((smart-menu hkey-value) .
  182.       (smart-menu hkey-value)))
  183.     ;;
  184.     ((eq major-mode 'outline-mode) .
  185.      ((smart-outline) . (smart-outline-assist)))
  186.     ;;
  187.     ((eq major-mode 'Info-mode) .
  188.      ((smart-info) .  (smart-info-assist)))
  189.     ;;
  190.     ((if (boundp 'hmail:reader)
  191.      (or (eq major-mode hmail:reader)
  192.          (eq major-mode hmail:lister))) .
  193.      ((smart-hmail) . (smart-hmail-assist)))
  194.     ;;
  195.     ((eq major-mode 'gnus-group-mode)
  196.      (smart-gnus-group) . (smart-gnus-group-assist))
  197.     ;;
  198.     ((eq major-mode 'gnus-summary-mode)
  199.      (smart-gnus-summary) . (smart-gnus-summary-assist))
  200.     ;;
  201.     ((eq major-mode 'gnus-article-mode)
  202.      (smart-gnus-article) . (smart-gnus-article-assist))
  203.     ;;
  204.     ((eq major-mode 'Buffer-menu-mode) .
  205.      ((smart-buffer-menu) . (smart-buffer-menu-assist)))
  206.     ;;
  207.     ((eq major-mode 'dired-mode) . 
  208.      ((smart-dired) . (smart-dired-assist)))
  209.     ;;
  210.     ((eq major-mode 'tar-mode) . 
  211.      ((smart-tar) . (smart-tar-assist)))
  212.     ;;
  213.     ;; Follow references in man pages.
  214.     ((setq hkey-value (smart-man-entry-ref)) .
  215.      ((smart-man-display hkey-value) .
  216.       (smart-man-display hkey-value)))
  217.     ;;
  218.     ((eq major-mode 'w3-mode) . 
  219.      ((w3-follow-link) . (w3-goto-last-buffer)))
  220.     ;;
  221.     ((if (boundp 'rolo-display-buffer)
  222.      (equal (buffer-name) rolo-display-buffer)) .
  223.      ((smart-wrolo) . (smart-wrolo-assist)))
  224.     ;;
  225.     ;; Outline minor mode is on and usable.
  226.     (selective-display .
  227.      ((smart-outline) . (smart-outline-assist)))
  228.     )
  229.   "Alist of predicates and form-conses for Action and Assist Keys.
  230. When the Action or Assist Key is pressed, the first or second form,
  231. respectively, associated with the first non-nil predicate is evaluated.")
  232.  
  233. ;;; ************************************************************************
  234. ;;; driver code
  235. ;;; ************************************************************************
  236.  
  237. ;; The following autoload is needed if another subsystem besides
  238. ;; Hyperbole uses this mouse handling code.
  239. (autoload 'var:append "hvar" "Append to a list variable." nil)
  240.  
  241. (require 'hargs)
  242. (require 'hmouse-key)
  243. (if hyperb:window-system
  244.     (progn
  245.       (defvar hmouse-alist hkey-alist
  246.     "Alist of predicates and form-conses for context-sensitive smart key mouse actions.
  247. When the action-key or the assist-key is pressed, the first or
  248. second form, respectively, associated with the first non-nil predicate is
  249. evaluated.")
  250.       (load "hui-window")))
  251.  
  252. ;;; ************************************************************************
  253. ;;; support code
  254. ;;; ************************************************************************
  255.  
  256. ;; The 'load' line below loads any local Smart Key function definitions.
  257. ;; The public distribution contains none.  You may leave it commented out if
  258. ;; you prefer.
  259. ;; (load "smart-local" t)
  260.  
  261. ;;; ************************************************************************
  262. ;;; Required Init functions
  263. ;;; ************************************************************************
  264.  
  265. (defun first-line-p ()
  266.   "Returns true if point is on the first line of the buffer."
  267.   (save-excursion (beginning-of-line) (bobp)))
  268.  
  269. (defun last-line-p ()
  270.   "Returns true if point is on the last line of the buffer."
  271.   (save-excursion (end-of-line) (eobp)))
  272.  
  273. (defun smart-completion-help ()
  274.   "Offer completion help for current minibuffer argument, if any."
  275.   (if (where-is-internal 'minibuffer-completion-help (current-local-map))
  276.       (minibuffer-completion-help)))
  277.  
  278. (defun smart-symlink-expand (path)
  279.   "Returns referent for possible symbolic link, PATH."
  280.   (if (not (fboundp 'symlink-referent))
  281.       path
  282.     (let ((start 0) (len (length path)) (ref) (part))
  283.       (while (and (< start len) (setq part (string-match "/[^/]*" path start)))
  284.     (setq part (concat ref
  285.                (substring path start (setq start (match-end 0))))
  286.           ref (symlink-referent part)))
  287.       ref)))
  288.  
  289. ;;; ************************************************************************
  290. ;;; smart-buffer-menu functions
  291. ;;; ************************************************************************
  292.  
  293. (defun smart-buffer-menu (&optional in-browser)
  294.   "Uses a single key or mouse key to manipulate buffer-menu entries.
  295.  
  296. Invoked via a key press when in Buffer-menu-mode.  It assumes that its
  297. caller has already checked that the key was pressed in an appropriate buffer
  298. and has moved the cursor there.
  299.  
  300. Optional non-nil IN-BROWSER indicates use within the OO-Browser.
  301.  
  302. If key is pressed:
  303.  (1) on the first column of an entry, the selected buffer is marked for
  304.      display; 
  305.  (2) on the second column of an entry, the selected buffer is marked to be
  306.      saved;
  307.  (3) anywhere else within an entry line, all saves and deletes are done, and
  308.      selected buffers are displayed, including the one just clicked on (if
  309.      IN-BROWSER, only the selected buffer is displayed);
  310.  (4) on or after the last line in the buffer, all saves and deletes are done."
  311.  
  312.   (interactive)
  313.   (cond ((last-line-p) (Buffer-menu-execute))
  314.     ((bolp) (Buffer-menu-mark))
  315.         ((save-excursion
  316.              (goto-char (1- (point)))
  317.          (bolp))
  318.      (Buffer-menu-save))
  319.     (in-browser (br-buffer-menu-select))
  320.     (t (Buffer-menu-select))))
  321.  
  322. (defun smart-buffer-menu-assist ()
  323.   "Uses a single assist-key or mouse assist-key to manipulate buffer-menu entries.
  324.  
  325. Invoked via an assist-key press when in Buffer-menu-mode.  It assumes that its
  326. caller has already checked that the assist-key was pressed in an appropriate
  327. buffer and has moved the cursor there.
  328.  
  329. If assist-key is pressed:
  330.  (1) on the first or second column of an entry, the selected buffer is unmarked
  331.      for display and for saving or deletion; 
  332.  (2) anywhere else within an entry line, the selected buffer is marked for
  333.      deletion;
  334.  (3) on or after the last line in the buffer, all display, save, and delete
  335.      marks on all entries are undone."
  336.  
  337.   (interactive)
  338.   (cond ((last-line-p) (progn (list-buffers) (forward-line 3)))
  339.     ((bolp) (Buffer-menu-unmark))
  340.         ((save-excursion
  341.              (goto-char (1- (point)))
  342.          (bolp))
  343.      (Buffer-menu-unmark))
  344.     (t (Buffer-menu-delete))))
  345.  
  346. ;;; ************************************************************************
  347. ;;; smart-calendar functions
  348. ;;; ************************************************************************
  349.  
  350. (defun smart-calendar ()
  351.   "Uses a single key or mouse key to manipulate the scrolling calendar.
  352.  
  353. Invoked via a key press when in calendar-mode.  It assumes that its
  354. caller has already checked that the key was pressed in an appropriate buffer
  355. and has moved the cursor there.
  356.  
  357. If key is pressed:
  358.  (1) at the end of the buffer, the calendar is scrolled forward 3 months;
  359.  (2) to the left of any dates on a calendar line, the calendar is scrolled
  360.      backward 3 months;
  361.  (3) on a date, the diary entries for the date, if any, are displayed."
  362.  
  363.   (interactive)
  364.   (cond ((eobp) (calendar-cursor-to-nearest-date)
  365.      (scroll-calendar-left-three-months 1))
  366.     ((< (current-column) 5) (calendar-cursor-to-nearest-date)
  367.      (scroll-calendar-right-three-months 1))
  368.     (t (calendar-cursor-to-nearest-date)
  369.        (view-diary-entries 1))))
  370.  
  371. (defun smart-calendar-assist ()
  372.   "Uses a single assist-key or mouse assist-key to manipulate the scrolling calendar.
  373.  
  374. Invoked via an assist-key press when in calendar-mode.  It assumes that its
  375. caller has already checked that the assist-key was pressed in an appropriate
  376. buffer and has moved the cursor there.
  377.  
  378. If assist-key is pressed:
  379.  (1) at the end of the buffer, the calendar is scrolled backward 3 months;
  380.  (2) to the left of any dates on a calendar line, the calendar is scrolled
  381.      forward 3 months;
  382.  (3) anywhere else, all dates with marking diary entries are marked in the
  383.      calendar window."
  384.  
  385.   (interactive)
  386.   (cond ((eobp) (calendar-cursor-to-nearest-date)
  387.      (scroll-calendar-right-three-months 1))
  388.     ((< (current-column) 5) (calendar-cursor-to-nearest-date)
  389.      (scroll-calendar-left-three-months 1))
  390.     (t (mark-diary-entries))))
  391.  
  392.  
  393. ;;; ************************************************************************
  394. ;;; smart-dired functions
  395. ;;; ************************************************************************
  396.  
  397. (defun smart-dired ()
  398.   "Uses a single key or mouse key to manipulate directory entries.
  399.  
  400. Invoked via a key press when in dired-mode.  It assumes that its
  401. caller has already checked that the key was pressed in an appropriate buffer
  402. and has moved the cursor there.
  403.  
  404. If key is pressed:
  405.  (1) within an entry line, the selected file/directory is displayed for
  406.      editing in the other window;
  407.  (2) on or after the last line in the buffer, if any deletes are to be
  408.      performed, they are executed after user verification, otherwise, this
  409.      dired invocation is quit."
  410.  
  411.   (interactive)
  412.   (cond ((last-line-p)
  413.      (let (flagged)
  414.        (save-excursion
  415.          (goto-char 1)
  416.          (setq flagged (re-search-forward "^D" nil t)))
  417.        (if flagged
  418.            (cond ((fboundp 'dired-do-deletions)
  419.               (dired-do-deletions))
  420.              ;; For Tree-dired compatibility
  421.              ((fboundp 'dired-do-flagged-delete)
  422.               (dired-do-flagged-delete))
  423.              (t (error "(smart-dired): No Dired expunge function.")))
  424.          (dired-quit))))
  425.     (t (hpath:find-other-window (dired-get-filename)))))
  426.  
  427. (defun smart-dired-assist ()
  428.   "Uses a single assist-key or mouse assist-key to manipulate directory entries.
  429.  
  430. Invoked via an assist-key press when in dired-mode.  It assumes that its
  431. caller has already checked that the assist-key was pressed in an appropriate
  432. buffer and has moved the cursor there.
  433.  
  434. If assist-key is pressed:
  435.  (1) on a '~' character, all backup files in the directory are marked for
  436.      deletion;
  437.  (2) on a '#' character, all auto-save files in the directory are marked for
  438.      deletion;
  439.  (3) anywhere else within an entry line, the current entry is marked for
  440.      deletion;
  441.  (4) on or after the last line in the buffer, all delete marks on all entries
  442.      are undone."
  443.  
  444.   (interactive)
  445.   (cond ((last-line-p)
  446.      (dired-unflag (- (count-lines (point-min) (point-max))))
  447.      (goto-char (point-max)))
  448.     ((looking-at "~") (dired-flag-backup-files))
  449.     ((looking-at "#") (dired-flag-auto-save-files))
  450.     (t (dired-flag-file-deleted 1))))
  451.  
  452. ;;; ************************************************************************
  453. ;;; smart-gnus functions
  454. ;;; ************************************************************************
  455.  
  456. (defun smart-gnus-group ()
  457.   "Uses a key or mouse key to move through Gnus Newsgroup listings.
  458. Invoked via a key press when in gnus-group-mode.  It assumes that its caller
  459. has already checked that the key was pressed in an appropriate buffer and has
  460. moved the cursor to the selected buffer.
  461.  
  462. If key is pressed within:
  463.  (1) a GNUS-GROUP line, that newsgroup is read;
  464.  (2) to the left of any GNUS-GROUP line, on any of the whitespace, the current
  465.      group is unsubscribed or resubscribed;
  466.  (3) at the end of the GNUS-GROUP buffer, after all lines, checks for new
  467.      news."
  468.  
  469.   (interactive)
  470.   (cond ((last-line-p) (gnus-group-get-new-news))
  471.     ((progn (skip-chars-backward " U") (bolp))
  472.      (gnus-group-unsubscribe-current-group))
  473.     (t (gnus-group-read-group nil))))
  474.  
  475. (defun smart-gnus-group-assist ()
  476.   "Uses an assist-key or assist-mouse key to move through Gnus Newsgroup listings.
  477. Invoked via an assist-key press when in gnus-group-mode.  It assumes that its
  478. caller has already checked that the key was pressed in an appropriate buffer
  479. and has moved the cursor to the selected buffer.
  480.  
  481. If key is pressed within:
  482.  (1) a GNUS-GROUP line, that newsgroup is read;
  483.  (2) to the left of any GNUS-GROUP line, on any of the whitespace, the user is
  484.      prompted for a group name to subscribe or unsubscribe to;
  485.  (3) at the end of the GNUS-GROUP buffer, after all lines, quits from the
  486.      newsreader."
  487.  
  488.   (interactive)
  489.   (cond ((last-line-p) (gnus-group-exit))
  490.     ((progn (skip-chars-backward " U") (bolp))
  491.      (call-interactively 'gnus-group-unsubscribe-group))
  492.     (t (gnus-group-read-group nil))))
  493.  
  494. (defun smart-gnus-summary ()
  495.   "Uses a key or mouse key to move through Gnus News article listings.
  496. Invoked via a key press when in gnus-summary-mode.  It assumes that its caller
  497. has already checked that the key was pressed in an appropriate buffer and has
  498. moved the cursor to the selected buffer.
  499.  
  500. If key is pressed within:
  501.  (1) to the left of an article number, that article is marked as unread;
  502.  (2) a GNUS-SUMMARY line, that article is read, marked deleted, and scrolled
  503.      forward;
  504.  (3) at the end of the GNUS-SUMMARY buffer, the next undeleted article
  505.      is read or the next group is entered."
  506.  
  507.   (interactive)
  508.   (cond ((last-line-p)
  509.      (if gnus-current-article
  510.          (progn (goto-char (point-min))
  511.             (re-search-forward
  512.               (format "^.[ ]+%d:" gnus-current-article) nil t)
  513.             (setq this-command 'gnus-summary-next-page)
  514.             (call-interactively 'gnus-summary-next-page))
  515.        (goto-char (point-min))
  516.        (setq this-command 'gnus-summary-first-unread-article)
  517.        (call-interactively 'gnus-summary-first-unread-article)))
  518.     ((save-excursion (skip-chars-backward " D") (bolp))
  519.      (gnus-summary-mark-as-unread-forward 1))
  520.     (t (setq this-command 'gnus-summary-next-page)
  521.        (call-interactively 'gnus-summary-next-page))))
  522.  
  523. (defun smart-gnus-summary-assist ()
  524.   "Uses an assist-key or assist-mouse key to move through Gnus News articles.
  525. Invoked via an assist-key press when in gnus-summary-mode.  It assumes that its
  526. caller has already checked that the key was pressed in an appropriate buffer
  527. and has moved the cursor to the selected buffer.
  528.  
  529. If key is pressed within:
  530.  (1) to the left of an article number, that article is marked as unread;
  531.  (2) a GNUS-SUMMARY line, that article is read and scrolled backward;
  532.  (3) at the end of the GNUS-SUMMARY buffer, the summary is exited, the user
  533.      is returned to group mode."
  534.  
  535.   (interactive)
  536.   (cond ((last-line-p)
  537.      (setq this-command 'gnus-summary-prev-page)
  538.      (call-interactively 'gnus-summary-exit))
  539.     ((save-excursion (skip-chars-backward " D") (bolp))
  540.      (gnus-summary-mark-as-unread-backward 1))
  541.     (t (setq this-command 'gnus-summary-prev-page)
  542.        (call-interactively 'gnus-summary-prev-page))))
  543.  
  544. (defun smart-gnus-article ()
  545.   "Uses a key or mouse key to move through Gnus netnews articles.
  546.  
  547. Invoked via a key press when in gnus-article-mode.
  548. It assumes that its caller has already checked that the key was pressed in an
  549. appropriate buffer and has moved the cursor to the selected buffer.
  550.  
  551. If key is pressed within:
  552.  (1) the first line or end of an article, the next unread message is displayed;
  553.  (2) the first line of an Info cross reference, the reference is followed;
  554.  (3) anywhere else, the window is scrolled up a windowful."
  555.   (interactive)
  556.   (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
  557.      (unwind-protect
  558.          (progn (set-buffer gnus-summary-buffer)
  559.             (setq this-command 'gnus-summary-next-unread-article)
  560.             (gnus-summary-next-unread-article)
  561.             (gnus-summary-goto-subject gnus-current-article)
  562.             )
  563.        (let ((artic (get-buffer-window gnus-article-buffer)))
  564.          (if artic (select-window artic)))))
  565.     ((and (not (eolp)) (Info-handle-in-note)))
  566.     (t (scroll-up-eol))))
  567.  
  568. (defun smart-gnus-article-assist ()
  569.   "Uses an assist-key or mouse assist-key to move through Gnus netnews articles.
  570.  
  571. Invoked via an assist-key press when in gnus-article-mode.
  572. It assumes that its caller has already checked that the assist-key was pressed in
  573. an appropriate buffer and has moved the cursor to the selected buffer.
  574.  
  575. If assist-key is pressed within:
  576.  (1) the first line or end of an article, the previous message is displayed;
  577.  (2) the first line of an Info cross reference, the reference is followed;
  578.  (3) anywhere else, the window is scrolled down a windowful."
  579.   (interactive)
  580.   (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
  581.      (unwind-protect
  582.          (progn (set-buffer gnus-summary-buffer)
  583.             (setq this-command 'gnus-summary-prev-article)
  584.             (gnus-summary-prev-article nil)
  585.             (gnus-summary-goto-subject gnus-current-article)
  586.             )
  587.        (let ((artic (get-buffer-window gnus-summary-buffer)))
  588.          (if artic (select-window artic)))))
  589.     ((and (not (eolp)) (Info-handle-in-note)))
  590.     (t (scroll-down-eol))))
  591.  
  592. ;;; ************************************************************************
  593. ;;; smart-hmail functions
  594. ;;; ************************************************************************
  595.  
  596. (defun smart-hmail ()
  597.   "Uses a key or mouse key to move through e-mail messages and summaries.
  598.  
  599. Invoked via a key press when in hmail:reader or hmail:lister mode.
  600. It assumes that its caller has already checked that the key was pressed in an
  601. appropriate buffer and has moved the cursor to the selected buffer.
  602.  
  603. If key is pressed within:
  604.  (1) a msg buffer, within the first line or at the end of a message,
  605.      the next undeleted message is displayed;
  606.  (2) a msg buffer within the first line of an Info cross reference, the
  607.      reference is followed;
  608.  (3) anywhere else in a msg buffer, the window is scrolled up a windowful; 
  609.  (4) a msg summary buffer on a header entry, the message corresponding to
  610.      the header is displayed in the msg window;
  611.  (5) a msg summary buffer, on or after the last line, the messages marked
  612.      for deletion are expunged."
  613.  
  614.   (interactive)
  615.   ;;
  616.   ;; Branch on buffer type
  617.   ;;
  618.   (cond ((eq major-mode hmail:reader)
  619.      (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
  620.         (rmail:msg-next))
  621.            ((and (not (eolp)) (Info-handle-in-note)))
  622.            ((scroll-up-eol))))
  623.     ;;
  624.     ;; Assume are in msg summary buffer
  625.     ;;
  626.     ((last-line-p) (lmail:expunge))
  627.     (t (lmail:goto))))
  628.  
  629. (defun smart-hmail-assist ()
  630.   "Uses an assist key or mouse key to move through e-mail messages and summaries.
  631.  
  632. Invoked via an assist key press when in hmail:reader or hmail:lister mode.
  633. It assumes that its caller has already checked that the assist-key was pressed in
  634. an appropriate buffer and has moved the cursor to the selected buffer.
  635.  
  636. If assist-key is pressed within:
  637.  (1) a msg buffer, within the first line or at the end of a message,
  638.      the previous undeleted message is displayed;
  639.  (2) a msg buffer within the first line of an Info cross reference, the
  640.      reference is followed;
  641.  (3) anywhere else in a msg buffer, the window is scrolled down a windowful; 
  642.  (4) a msg summary buffer on a header entry, the message corresponding to
  643.      the header is marked as deleted;
  644.  (5) a msg summary buffer, on or after the last line, all messages are
  645.      marked undeleted."
  646.  
  647.   (interactive)
  648.   ;;
  649.   ;; Branch on buffer type
  650.   ;;
  651.   (cond ((eq major-mode hmail:reader)
  652.      (cond ((or (last-line-p) (and (not (eolp)) (first-line-p)))
  653.         (rmail:msg-prev))
  654.            ((and (not (eolp)) (Info-handle-in-note)))
  655.            ((scroll-down-eol))))
  656.     ;;
  657.     ;; Assume are in msg summary buffer
  658.     ;;
  659.     ((last-line-p) (lmail:undelete-all))
  660.     (t (lmail:delete))))
  661.  
  662.  
  663. ;;; ************************************************************************
  664. ;;; smart-info functions
  665. ;;; ************************************************************************
  666. ;;; Autoloaded in "hyperbole.el".
  667.  
  668. ;;; ************************************************************************
  669. ;;; smart-man functions
  670. ;;; ************************************************************************
  671.  
  672. ;; "unix-apropos.el" is a publicly available Emacs Lisp package that
  673. ;; allows man page browsing from apropos listings.  "superman.el" is a
  674. ;; newer, much more complete package that you would probably prefer at
  675. ;; this point, but there is no Smart Key apropos support for it.  There
  676. ;; is smart key support within the man page buffers it produces, however.
  677. ;;
  678.  
  679. (defun smart-apropos ()
  680.   "Moves through UNIX man apropos listings by using one key or mouse key.
  681.  
  682. Invoked via a key press when in unix-apropos-mode.  It assumes that
  683. its caller has already checked that the key was pressed in an appropriate
  684. buffer and has moved the cursor to the selected buffer.
  685.  
  686. If key is pressed:
  687.  (1) on a UNIX man apropos entry, the man page for that entry is displayed in
  688.      another window;
  689.  (2) on or after the last line, the buffer in the other window is scrolled up
  690.      a windowful."
  691.  
  692.   (interactive)
  693.   (if (last-line-p)
  694.       (scroll-other-window)
  695.     (unix-apropos-get-man)))
  696.  
  697. (defun smart-apropos-assist ()
  698.   "Moves through UNIX man apropos listings by using one assist-key or mouse assist-key.
  699.  
  700. Invoked via an assist-key press when in unix-apropos-mode.  It assumes that
  701. its caller has already checked that the assist-key was pressed in an appropriate
  702. buffer and has moved the cursor to the selected buffer.
  703.  
  704. If assist-key is pressed:
  705.  (1) on a UNIX man apropos entry, the man page for that entry is displayed in
  706.      another window;
  707.  (2) on or after the last line, the buffer in the other window is scrolled down
  708.      a windowful."
  709.  
  710.   (interactive)
  711.   (if (last-line-p)
  712.       (scroll-other-window (- 3 (window-height)))
  713.     (unix-apropos-get-man)))
  714.  
  715. (defun smart-man-display (lisp-form)
  716.   "Evaluates LISP-FORM returned from 'smart-man-entry-ref' to display a man page."
  717.   (eval lisp-form))
  718.  
  719. (defun smart-man-entry-ref ()
  720.   "Returns form which displays referenced manual entry that point is on or nil.
  721. Handles references in sections: NAME, SEE ALSO, or PACKAGES USED.  Also can
  722. display C routine definitions selected in a man page, see
  723. 'smart-man-c-routine-ref'.
  724.  
  725. Man page buffer must either have an attached file or else a `man-path'
  726. local variable containing its pathname."
  727.   (interactive)
  728.   (let ((ref ""))
  729.     (if (not (or (if (string-match "Manual Entry\\|\\*man "
  730.                    (buffer-name (current-buffer)))
  731.              (progn (and (boundp 'man-path) man-path
  732.                  (setq ref (smart-symlink-expand man-path)))
  733.                 t))
  734.          (if buffer-file-name
  735.              (string-match "/man/" (setq ref (smart-symlink-expand
  736.                               buffer-file-name))))))
  737.     (setq ref nil)
  738.       (or (setq ref (or (smart-man-file-ref)
  739.             (smart-man-c-routine-ref)))
  740.       (save-excursion
  741.         (let ((opoint (point))
  742.           (case-fold-search))
  743.           (and
  744.            (re-search-backward "^[.A-Z]" nil t)
  745.            (looking-at
  746.         "\\(\\.SH[ \t]+\\)?\\(SEE ALSO\\|NAME\\|PACKAGES USED\\)")
  747.            (progn (goto-char opoint)
  748.               (skip-chars-backward "-_a-zA-Z0-9?.(")
  749.               (let ((start (point)))
  750.             (skip-chars-forward "-_a-zA-Z0-9?.()")
  751.             (setq ref (buffer-substring start (point)))
  752.             ;; Leave only one char within ref parens
  753.             (if ref
  754.                 (if (string-match "(\\(.\\)\\(.+\\))" ref)
  755.                 (setq ref (concat (substring ref 0 (match-end 1))
  756.                           "\)"))))
  757.             )))))))
  758.     (cond ((equal ref "") nil)
  759.       ((stringp ref) (list 'manual-entry ref))
  760.       (t ref))))
  761.  
  762. (defun smart-man-c-routine-ref ()
  763.   "Returns form to jump to def of C function whose name is at point, if any.
  764. Valid sections within the man page are: ROUTINES, MACROS or FUNCTIONS.
  765. Uses (smart-tags-file) function to determine etags file from which to
  766. locate the definition.
  767.  
  768. Returns etags file name if point is on an identifier in the appropriate
  769. section and the jump is done, otherwise, returns nil."
  770.   (let ((ref)
  771.     (opoint (point))
  772.     (case-fold-search))
  773.     (save-excursion
  774.       (and (re-search-backward "^[.A-Z]" nil t)
  775.        (looking-at "^\\(FUNCTIONS\\|ROUTINES\\|MACROS\\)[ \t\n]")
  776.        (progn (goto-char opoint)
  777.           (skip-chars-backward "_~<>:a-zA-Z0-9(")
  778.           (if (or (looking-at "\\([_~<>:a-zA-Z0-9]+\\)[ \t\n]*(")
  779.               (looking-at "\\([_~<:A-Z][_<>:A-Z0-9]+\\)"))
  780.               (setq ref (buffer-substring
  781.                  (match-beginning 1) (match-end 1))
  782.                 )))))
  783.     (if ref
  784.     (let ((tags-file-name
  785.            (smart-tags-file (if (and (boundp 'man-path) man-path)
  786.                     man-path
  787.                   default-directory))))
  788.       (and (file-exists-p tags-file-name)
  789.            (file-readable-p tags-file-name)
  790.            (list 'let (list (list 'tags-file-name tags-file-name))
  791.              (list (if (br-in-browser)
  792.                    'find-tag 'find-tag-other-window)
  793.                ref)))))))
  794.  
  795. (defun smart-man-file-ref ()
  796.   "Returns form to eval to display file whose name point is on, within a FILES man page section.
  797. If not on a file name, returns nil."
  798.   (let ((ref)
  799.     (opoint (point))
  800.     (case-fold-search))
  801.     (save-excursion
  802.       (and (re-search-backward "^[.A-Z]" nil t)
  803.        (looking-at "^FILES[ \t\n]")
  804.          (progn (goto-char opoint)
  805.             (skip-chars-backward "^ \t")
  806.             (if (looking-at "/[^ \t\n]+")
  807.             (setq ref (buffer-substring
  808.                    (match-beginning 0) (match-end 0))
  809.                   )))))
  810.     (if ref
  811.     (list (if (br-in-browser)
  812.           'find-file 'find-file-other-window)
  813.           ref))))
  814.  
  815. ;;; ************************************************************************
  816. ;;; smart-outline functions
  817. ;;; ************************************************************************
  818.  
  819. ;; The functions in this section require InfoDock's version of outline.el
  820. ;; in order to work properly.
  821.  
  822. (defvar smart-outline-cut nil
  823.   "Non-nil means outline region was cut and is ready to be pasted at point.")
  824.  
  825. (let ((proc
  826.     '((lambda ()
  827.         (make-local-variable 'smart-outline-cut)
  828.         ;; Non-nil means outline region was cut and is available to be
  829.         ;; pasted at point.
  830.         (setq smart-outline-cut nil)
  831.         ))))
  832.   (if (boundp 'outline-mode-map)
  833.       (eval proc)
  834.     (var:append 'outline-mode-hook proc)))
  835.  
  836. (defun smart-outline ()
  837.   "Collapses, expands, and moves outline entries.
  838. Invoked via a key press when in outline-mode.  It assumes that
  839. its caller has already checked that the key was pressed in an appropriate
  840. buffer and has moved the cursor to the selected buffer.
  841.  
  842. If key is pressed:
  843.  (1) after an outline heading has been cut via the Action Key, then paste the
  844.      cut heading at point;
  845.  (2) at the end of buffer, show all buffer text 
  846.  (3) at the beginning of a heading line, cut the headings subtree from the
  847.      buffer;
  848.  (4) on a header line but not at the beginning or end, if headings subtree is
  849.      hidden then show it, otherwise hide it;
  850.  (5) anywhere else, scroll up a windowful."
  851.  
  852.   (interactive)
  853.   (cond (smart-outline-cut
  854.      (setq smart-outline-cut nil) (yank))
  855.     ((eobp) (show-all))
  856.     ((and (bolp) (looking-at outline-regexp))
  857.      (setq smart-outline-cut t)
  858.      (kill-region
  859.       (point)
  860.       (or (outline-get-next-sibling)
  861.           ;; Skip past start of current entry
  862.           (progn (re-search-forward outline-regexp nil t)
  863.              (smart-outline-to-entry-end t (outline-level))))))
  864.  
  865.     ((or (eolp) (zerop (save-excursion (beginning-of-line)
  866.                        (outline-level))))
  867.      (scroll-up-eol))
  868.     ;; On an outline header line but not at the start/end of line.
  869.     ((smart-outline-subtree-hidden-p)
  870.      (show-subtree))
  871.     (t (hide-subtree))))
  872.  
  873.  
  874. (defun smart-outline-assist ()
  875.   "Collapses, expands, and moves outline entries.
  876. Invoked via an assist-key press when in outline-mode.  It assumes that
  877. its caller has already checked that the assist-key was pressed in an appropriate
  878. buffer and has moved the cursor to the selected buffer.
  879.  
  880. If assist-key is pressed:
  881.  (1) after an outline heading has been cut via the action-key, allow multiple
  882.      pastes throughout the buffer (last paste should be done with the Action Key,
  883.      not the Assist Key);
  884.  (2) at the end of buffer, hide all bodies in buffer;
  885.  (3) at the beginning of a heading line, cut the current heading (sans
  886.      subtree) from the buffer;
  887.  (4) on a header line but not at the beginning or end, if heading body is
  888.      hidden then show it, otherwise hide it;
  889.  (5) anywhere else, scroll down a windowful."
  890.  
  891.   (interactive)
  892.   (cond (smart-outline-cut (yank))
  893.     ((eobp) (hide-body ))
  894.     ((and (bolp) (looking-at outline-regexp))
  895.      (setq smart-outline-cut t)
  896.      (kill-region (point) 
  897.               ;; Skip past start of current entry
  898.               (progn (re-search-forward outline-regexp nil t)
  899.                  (smart-outline-to-entry-end
  900.                   nil (outline-level)))))
  901.     ((or (eolp) (zerop (save-excursion (beginning-of-line)
  902.                        (outline-level))))
  903.      (scroll-down-eol))
  904.     ;; On an outline header line but not at the start/end of line.
  905.     ((smart-outline-subtree-hidden-p)
  906.      (show-entry))
  907.     (t (hide-entry))))
  908.  
  909. (defun smart-outline-to-entry-end
  910.   (&optional include-sub-entries curr-entry-level)
  911.   "Goes to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil.
  912. CURR-ENTRY-LEVEL is an integer representing the length of the current level
  913. string which matched to 'outline-regexp'.  If INCLUDE-SUB-ENTRIES is nil,
  914. CURR-ENTRY-LEVEL is not needed."
  915.   (let (next-entry-exists)
  916.     (while (and (setq next-entry-exists
  917.               (re-search-forward outline-regexp nil t))
  918.         include-sub-entries
  919.         (save-excursion
  920.           (beginning-of-line)
  921.           (> (outline-level)
  922.              curr-entry-level))))
  923.     (if next-entry-exists
  924.     (progn (beginning-of-line) (point))
  925.       (goto-char (point-max)))))
  926.  
  927. (defun smart-outline-subtree-hidden-p ()
  928.   "Returns t if at least initial subtree of heading is hidden, else nil."
  929.   (save-excursion
  930.     (if (re-search-forward "[\n\^M]" nil t) (= (preceding-char) ?\^M))))
  931.  
  932. ;;; ************************************************************************
  933. ;;; smart-tar functions
  934. ;;; ************************************************************************
  935.  
  936. (defun smart-tar ()
  937.   "Uses a single key or mouse key to manipulate tar file entries.
  938.  
  939. Invoked via a key press when in tar-mode.  It assumes that its
  940. caller has already checked that the key was pressed in an appropriate buffer
  941. and has moved the cursor there.
  942.  
  943. If key is pressed:
  944.  (1) within an entry line, the selected file/directory is displayed for
  945.      editing in the other window;
  946.  (2) on or after the last line in the buffer, if any deletes are to be
  947.      performed, they are executed after user verification, otherwise, this
  948.      tar file browser is quit."
  949.  
  950.   (interactive)
  951.   (cond ((last-line-p)
  952.      (let (flagged)
  953.        (save-excursion
  954.          (goto-char 1)
  955.          (setq flagged (re-search-forward "^D" nil t)))
  956.        (if flagged
  957.            (tar-expunge)
  958.          (kill-buffer nil))))
  959.     (t (tar-extract-other-window))))
  960.  
  961. (defun smart-tar-assist ()
  962.   "Uses a single assist-key or mouse assist-key to manipulate tar file entries.
  963.  
  964. Invoked via an assist-key press when in dired-mode.  It assumes that its
  965. caller has already checked that the assist-key was pressed in an appropriate
  966. buffer and has moved the cursor there.
  967.  
  968. If assist-key is pressed:
  969.  (1) on an entry line, the current entry is marked for deletion;
  970.  (2) on or after the last line in the buffer, all delete marks on all entries
  971.      are undone."
  972.  
  973.   (interactive)
  974.   (cond ((last-line-p)
  975.      (tar-unflag (- (count-lines (point-min) (point-max))))
  976.      (goto-char (point-max)))
  977.     (t (tar-flag-deleted 1))))
  978.  
  979. ;;; ************************************************************************
  980. ;;; smart-wrolo functions
  981. ;;; ************************************************************************
  982.  
  983. (defun smart-wrolo ()
  984.   "In wrolo match buffer, edits current entry.
  985. Uses one key or mouse key.
  986.  
  987. Invoked via a key press when in the 'rolo-display-buffer'.  It assumes that
  988. its caller has already checked that the key was pressed in an appropriate
  989. buffer and has moved the cursor to the selected buffer."
  990.   (interactive)
  991.   (rolo-edit-entry))
  992.  
  993. (fset 'smart-wrolo-assist 'smart-wrolo)
  994.  
  995. (provide 'hui-mouse)
  996.