home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-epoch-stuff / tek-info-buttons.el < prev    next >
Encoding:
Text File  |  1991-11-20  |  6.7 KB  |  201 lines
  1. ;*****************************************************************************
  2. ;
  3. ; Filename:    tek-info-buttons.el
  4. ;
  5. ; Copyright (C) 1991  Ken Wood
  6. ;
  7. ; This program is free software; you can redistribute it and/or modify
  8. ; it under the terms of the GNU General Public License as published by
  9. ; the Free Software Foundation; either version 1, or (at your option)
  10. ; any later version.
  11. ;
  12. ; This program is distributed in the hope that it will be useful,
  13. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ; GNU General Public License for more details.
  16. ;
  17. ; You should have received a copy of the GNU General Public License
  18. ; along with this program; if not, write to the Free Software
  19. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. ;
  21. ; Author:        Ken Wood, <kwood@austek.oz.au>
  22. ; Organisation:        Austek Microsystems Pty Ltd, Australia.
  23. ; Released with permission from Austek Microsystems.
  24. ;
  25. ; Original concept by:    David Carlton (carlton@linus.mitre.org or 
  26. ;            carlton@husc9.harvard.edu).
  27. ;
  28. ; Description:    Epoch support for Dave Gillespie's "Kitchen Sink" info
  29. ;        browser. Provides button highlighting and mouse bindings
  30. ;        which match those Dave provides under emacs.
  31. ;
  32. ;        Button styles may be customised by means of X11 resources.
  33. ;        The resource name to use is "info".
  34. ;        See the file tek-style-utils.el for details.
  35. ;
  36. ;        See the INSTALL file that comes with this package for
  37. ;        installation details.
  38. ;
  39. ;*****************************************************************************
  40.  
  41. ; $Id: tek-info-buttons.el,v 1.5 1991/11/21 02:58:45 kwood Exp $
  42.  
  43. (require 'epoch-running)
  44. (provide 'tek-info-buttons)
  45.  
  46. ; Put the whole guts inside a test to get it to compile under emacs.
  47. (if running-epoch
  48.     (progn
  49.       
  50.       (require 'tek-style-utils)
  51.  
  52.       ; Regular expressions which should match all active areas in info
  53.       ; pages.
  54.       (defvar Info-header-button-regexp
  55.     "Up:\\|Next:\\|File:\\|Prev:\\|Previous:"
  56.     "Regexp used when searching the header for Info buttons to highlight.")
  57.  
  58.       (defvar Info-button-regexp
  59.     (format "\\*%s[ \n][^:]+::?\\|^\\* [^:]+::?" Info-footnote-tag)
  60.     "\
  61. Regexp used when searching for Info buttons to highlight outside the header.")
  62.  
  63.       ; Set up the highlighting attribute first
  64.       
  65.       (defvar Info-button-foreground "blue"
  66.     "\
  67. Foreground color used for info buttons if no value is defined in the
  68. X11 resources and the display device supports color. On monochrome
  69. screens a different font is used in place of the different color.")
  70.  
  71.       (defvar Info-button-styleorattribute
  72.     ; If the display supports multiple colors and a default color
  73.     ; is specified, define the style to use a different color.
  74.     (if (and (> (number-of-colors) 2) Info-button-foreground)
  75.         (tek-build-style "info" nil nil
  76.                  Info-button-foreground (background)
  77.                  (background) (foreground))
  78.       ; Otherwise, define the style to use a different font.
  79.       (tek-build-style "info" nil (or tek-bold-fixed-font
  80.                       tek-italic-bold-fixed-font
  81.                       tek-italic-fixed-font)
  82.                (foreground) (background)
  83.                (background) (foreground)))
  84.     "Style or attribute used to display characters in info buttons.")
  85.  
  86.  
  87.       ; Select V3 or V4 button behaviour
  88.       (if tek-highlight-use-attributes
  89.       (progn
  90.         ; Do things the old way
  91.       
  92.         (defvar Info-button-style Info-button-styleorattribute
  93.           "\
  94. Style used for displaying info buttons when attributes are
  95. used to mark buttons.")
  96.  
  97.         ; Modify the variable used with add-button to be an attribute
  98.         (setq Info-button-styleorattribute (reserve-attribute))
  99.  
  100.         ;Bind the info style to the info attribute
  101.         (set-attribute-style Info-button-styleorattribute
  102.                  Info-button-style)
  103.         ))
  104.  
  105.  
  106.       (defvar Info-mouse-map (create-mouse-map mouse::global-map)
  107.     "Mousemap for Info buttons.")
  108.  
  109.  
  110.       ; Bind the mouse buttons to useful functions.
  111.       
  112.       (define-mouse Info-mouse-map mouse-left mouse-down
  113.     'Info-mouse-scroll-up)
  114.       (define-mouse Info-mouse-map mouse-middle mouse-down
  115.     'Info-mouse-select-item)
  116.       (define-mouse Info-mouse-map mouse-right mouse-down
  117.     'Info-mouse-scroll-down)
  118.       (define-mouse Info-mouse-map mouse-left mouse-shift
  119.     'Info-mouse-next)
  120.       (define-mouse Info-mouse-map mouse-middle mouse-shift
  121.     'Info-mouse-last)
  122.       (define-mouse Info-mouse-map mouse-right mouse-shift
  123.     'Info-mouse-prev)
  124.       (define-mouse Info-mouse-map mouse-middle mouse-control
  125.     'Info-mouse-up)
  126.  
  127.  
  128.       (defun Info-setup-mouse-map ()
  129.     "Use the Info mouse bindings in the current buffer."
  130.     (use-local-mouse-map Info-mouse-map))
  131.  
  132.       (defun Info-setup-buttons ()
  133.     "Setup all buttons in an info-node."
  134.     (clear-buttons)
  135.     (save-excursion
  136.       ; Set up header buttons.
  137.       (goto-char (point-min))
  138.       (forward-line 1)
  139.       (let ((line2-start (point)))
  140.         (goto-char (point-min))
  141.         ; Search for header buttons will be bound by the start
  142.         ; of the second line.
  143.         (while (re-search-forward Info-header-button-regexp line2-start t)
  144.           (add-button (match-beginning 0) (match-end 0)
  145.               Info-button-styleorattribute)))
  146.       ; Setup menu and cross-reference buttons. Point should already
  147.       ; be at the start of the second line in the buffer.
  148.       (while (re-search-forward Info-button-regexp nil t)
  149.         (if (not (string-equal
  150.               (buffer-substring (match-beginning 0)
  151.                     (match-end 0))
  152.               "* Menu:"))
  153.         (add-button (match-beginning 0) (match-end 0)
  154.                 Info-button-styleorattribute)))))
  155.  
  156.       
  157.       (defun Info-mouse-select-item (mouse-data)
  158.     "Select the info node at the mouse cursor."
  159.     (let ((orig-window (selected-window)))
  160.       (select-window (nth 2 mouse-data))
  161.       (Info-follow-nearest-node (car mouse-data))
  162.       (select-window orig-window)))
  163.       
  164.       (defun Info-mouse-scroll-up (mouse-data)
  165.     (let ((orig-window (selected-window)))
  166.       (select-window (nth 2 mouse-data))
  167.       (scroll-up nil)
  168.       (select-window orig-window)))
  169.       
  170.       (defun Info-mouse-scroll-down (mouse-data)
  171.     (let ((orig-window (selected-window)))
  172.       (select-window (nth 2 mouse-data))
  173.       (scroll-down nil)
  174.       (select-window orig-window)))
  175.       
  176.       (defun Info-mouse-prev (mouse-data)
  177.     (let ((orig-window (selected-window)))
  178.       (select-window (nth 2 mouse-data))
  179.       (Info-prev)
  180.       (select-window orig-window)))
  181.       
  182.       (defun Info-mouse-next (mouse-data)
  183.     (let ((orig-window (selected-window)))
  184.       (select-window (nth 2 mouse-data))
  185.       (Info-next)
  186.        (select-window orig-window)))
  187.      
  188.       (defun Info-mouse-up (mouse-data)
  189.     (let ((orig-window (selected-window)))
  190.       (select-window (nth 2 mouse-data))
  191.       (Info-up)
  192.        (select-window orig-window)))
  193.      
  194.       (defun Info-mouse-last (mouse-data)
  195.     (let ((orig-window (selected-window)))
  196.       (select-window (nth 2 mouse-data))
  197.       (Info-last)
  198.       (select-window orig-window)))
  199.       
  200.       )) ; end: running-epoch test
  201.