cgit.sxemacs.org Git - packages/blob - xemacs-packages/oo-browser/hmouse-br.el

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         hmouse-br.el
   4 ;; SUMMARY:      Hyperbole Key control for the OO-Browser.
   5 ;; USAGE:        GNU Emacs Lisp Library
   6 ;; KEYWORDS:     mouse, oop, tools
   7 ;;
   8 ;; AUTHOR:       Bob Weiner
   9 ;; ORG:          BeOpen.com
  10 ;;
  11 ;; ORIG-DATE:    Sep-04-90
  12 ;; LAST-MOD:     10-May-01 at 13:32:59 by Bob Weiner
  13 ;;
  14 ;; Copyright (C) 1990-1995, 1997, 1998  BeOpen.com
  15 ;; See the file BR-COPY for license information.
  16 ;;
  17 ;; This file is part of the OO-Browser.
  18 ;;
  19 ;; DESCRIPTION:
  20 ;; DESCRIP-END.
  21
  22 ;;; ************************************************************************
  23 ;;; Other required Elisp libraries
  24 ;;; ************************************************************************
  25
  26 (require 'br)
  27
  28 ;;; ************************************************************************
  29 ;;; smart-br functions
  30 ;;; ************************************************************************
  31
  32 ;;; Unused unless the "br.el" library, part of the OO-Browser package, has
  33 ;;; been loaded.
  34
  35 (defun smart-br ()
  36   "Controls OO-Browser listing buffers with one key or mouse key.
  37
  38 Invoked via a key press when in an OO-Browser listing window.  It assumes
  39 that its caller has already checked that the key was pressed in an
  40 appropriate buffer and has moved the cursor to the selected buffer.
  41
  42 If key is pressed:
  43  (1) in a blank buffer or at the end of a buffer, browser help
  44      information is displayed in the viewer window;
  45  (2) on a default class name, the statically defined instances of the default
  46      class are listed;
  47  (3) at the beginning of a (non-single character) class name, the class'
  48      ancestors are listed;
  49  (4) at the end of an entry line, the listing is scrolled up;
  50  (5) on the `...', following a class name, point is moved to the class
  51      descendency expansion;
  52  (6) before an element entry, the element's implementors are listed;
  53  (7) anywhere else on an entry line, the entry's source is displayed for
  54      editing."
  55
  56   (interactive)
  57   (br-browse)
  58   (cond ((eobp)
  59          (br-help)
  60          (and action-mouse-key-prev-window
  61               (select-window action-mouse-key-prev-window)))
  62         ((eolp) (smart-scroll-up))
  63         ((br-at-default-class-p) (br-features 1))
  64         ((br-at-feature-p)
  65          (if (save-excursion
  66                 (skip-chars-backward " \t")
  67                 (bolp))
  68              (br-implementors)
  69            (br-feature)
  70          (if (br-in-browser) (br-to-from-viewer))))
  71         ((and (save-excursion
  72                 (skip-chars-backward " \t")
  73                 (bolp))
  74               (let ((cl (br-find-class-name)))
  75                 (and cl (/= (length cl) 1))))
  76          (br-ancestors))
  77         ((br-to-tree))
  78         ((br-edit)
  79          (if (br-in-browser) (br-to-from-viewer))
  80          t)))
  81
  82 (defun smart-br-assist ()
  83   "Controls OO-Browser listing buffers with one assist-key or mouse assist-key.
  84
  85 Invoked via an assist-key press when in an OO-Browser listing window.  It
  86 assumes that its caller has already checked that the assist-key was pressed in
  87 an appropriate buffer and has moved the cursor to the selected buffer.
  88
  89 If assist-key is pressed:
  90  (1) in a blank buffer, a selection list of buffer files is displayed;
  91  (2) on a default class name, the statically defined instances of
  92      the default class are listed;
  93  (3) at the beginning of a (non-single character) class, the class'
  94      descendants are listed;
  95  (4) at the end of an entry line, the listing is scrolled down;
  96  (5) on the `...', following a class name, point is moved to the class
  97      expansion;
  98  (6) anywhere else on a class line, the class' elements are listed;
  99  (7) anywhere else on an element line, the element's implementors
 100      are listed;
 101  (8) on a blank line following all entries, the current listing buffer
 102      is exited."
 103
 104   (interactive)
 105   (br-browse)
 106   (cond ((equal 0 (string-match br-buffer-prefix-blank (buffer-name)))
 107          (br-buffer-menu))
 108         ((eobp) (br-exit-level 1))
 109         ((eolp) (smart-scroll-down))
 110         ((br-at-default-class-p) (br-features 1))
 111         ((br-at-feature-p) (br-implementors))
 112         ((and (save-excursion
 113                 (skip-chars-backward " \t")
 114                 (bolp))
 115               (let ((cl (br-find-class-name)))
 116                 (and cl (/= (length cl) 1))))
 117          (br-descendants))
 118         ((br-to-tree))
 119         (t (br-features 1))))
 120
 121 (defun smart-br-dispatch ()
 122   (cond ((or (br-listing-window-p) (eq major-mode 'br-mode))
 123          ;; In an OO-Browser listing window.
 124          (smart-br))
 125         ((eq major-mode 'Info-mode) (smart-info))
 126         ((eolp) (smart-scroll-up))
 127         ((and (boundp 'br-src-file-regexp)
 128               buffer-file-name
 129               (fboundp (symbol-function 'br-to-definition))
 130               (string-match br-src-file-regexp buffer-file-name))
 131          (br-to-definition))
 132         ((and action-mouse-key-prev-window
 133               (or (smart-br-cmd-select nil)
 134                   (error "(Action Key): No command bound to key."))))
 135         (t (scroll-up))))
 136
 137 (defun smart-br-assist-dispatch ()
 138   (if (or (br-listing-window-p) (eq major-mode 'br-mode))
 139       ;; In an OO-Browser listing window.
 140       (smart-br-assist)
 141     (cond ((eq major-mode 'Info-mode)
 142            (smart-info-assist))
 143           ((eolp) (smart-scroll-down))
 144           ((and action-mouse-key-prev-window
 145                 (or (smart-br-cmd-select 'assist)
 146                     (error "(Assist Key): No command bound to key."))))
 147           (t (scroll-down)))))
 148
 149 (defun smart-br-cmd-select (&optional assist-flag)
 150   "Selects an OO-Browser command with its key binding at point.
 151 By default executes the command, with optional ASSIST-FLAG non-nil, shows help for
 152 command.  Returns t if a command is selected.  Nil indicates no key binding was
 153 found on the current line.  Key bindings are delimited by {}."
 154   (let ((start) (end) (tmp-buf) (tmp-buf-nm) (obuf (current-buffer)))
 155     (and (save-excursion
 156            (or (eobp) (forward-char))
 157            (save-excursion
 158              (beginning-of-line)
 159              (setq start (point)))
 160            (and (re-search-backward "\\(^\\|[^\\]\\){" start t)
 161                 (progn
 162                   (goto-char (match-end 0))
 163                   (setq start (point))
 164                   (save-excursion
 165                     (end-of-line)
 166                     (setq end (point)))
 167                   (and (re-search-forward "[^\\]}" end t)
 168                        (setq end (1- (point)))))))
 169          (progn
 170            (setq tmp-buf-nm "*smart-br-tmp*"
 171                  tmp-buf (progn (if (get-buffer tmp-buf-nm)
 172                                     (kill-buffer tmp-buf-nm))
 173                                 (get-buffer-create tmp-buf-nm)))
 174            (or tmp-buf
 175                (error
 176                 "(Action Key): (smart-br-cmd-select) - Can't create tmp-buf."))
 177            (copy-to-buffer tmp-buf start end)
 178            (set-buffer tmp-buf)
 179            (let ((case-fold-search nil) (case-replace t)
 180                  (keys)
 181                  (pref-arg action-mouse-key-prefix-arg))
 182              ;; Quote Control and Meta key names
 183              (goto-char (point-min))
 184              (replace-regexp "[ \t]+" "")
 185              (goto-char (point-min))
 186              (replace-string "SPC" "\040")
 187              (goto-char (point-min))
 188              (replace-string "DEL" "\177")
 189              (goto-char (point-min))
 190              (replace-regexp "ESC" "M-")
 191              (goto-char (point-min))
 192              ;; Unqote special {} chars.
 193              (replace-regexp "\\\\\\([{}]\\)" "\\1")
 194              (goto-char (point-min))
 195              (if (looking-at "C-u")
 196                  (progn (delete-char 3)
 197                         (and (or (null pref-arg)
 198                                  (equal pref-arg 1))
 199                              (setq pref-arg '(4)))))
 200              (while (search-forward "C-" nil t)
 201                (replace-match "")
 202                (setq keys (1+ (- (downcase (following-char)) ?a)))
 203                (delete-char 1)
 204                (insert keys))
 205              (goto-char (point-min))
 206              (while (search-forward "M-" nil t)
 207                (replace-match "")
 208                (setq keys (+ 128 (downcase (following-char))))
 209                (delete-char 1)
 210                (insert keys))
 211              (setq keys (buffer-string))
 212              (kill-buffer tmp-buf-nm)
 213              (set-buffer obuf)
 214              (and (boundp 'action-mouse-key-prev-window)
 215                   action-mouse-key-prev-window
 216                   (select-window action-mouse-key-prev-window))
 217              (let ((current-prefix-arg pref-arg)
 218                    (binding (key-binding keys)))
 219                (if binding
 220                    (progn
 221                      (if assist-flag
 222                          (br-cmd-help keys)
 223                        (call-interactively binding))
 224                      t))))))))
 225
 226 (defun smart-element ()
 227   "Jumps to the source line associated with an interim OOBR-FTR feature tags file entry.
 228 Assumes caller has checked that point is within an OOBR-FTR buffer, an
 229 *Implementors* listing buffer, or an Element signatures listing buffer from
 230 the OO-Browser.  If on a tag entry line, jumps to the source line for the
 231 tag.  If on a class name line, jumps to the class definition.  If on a
 232 pathname line or line preceding it, jumps to the associated file."
 233   (save-excursion
 234     (beginning-of-line)
 235     (cond
 236      ;; On a file separator or file entry line, display the file.
 237      ((save-excursion
 238         (and (or (and (eq (following-char) ?\^L)
 239                       (zerop (forward-line 1)))
 240                  (and (zerop (forward-line -1))
 241                       (eq (following-char) ?\^L)
 242                       (zerop (forward-line 1))))
 243              (looking-at "\"?\\([^,\n\r\"]+\\)\"?$")))
 244       (let ((file (buffer-substring (match-beginning 1) (match-end 1))))
 245         (if (and (fboundp 'ibut:label-set) (fboundp 'hproperty:but-flash))
 246             (progn (ibut:label-set file (match-beginning 1) (match-end 1))
 247                    (hproperty:but-flash)))
 248         (hpath:find file)))
 249      ;;
 250      ;; On an OO-Browser V3 element tag line, display its source code definition.
 251      ((save-excursion (beginning-of-line) (looking-at br-tag-fields-regexp))
 252       (let* ((bol (progn (back-to-indentation) (point)))
 253              (eol (progn (end-of-line) (point)))
 254              (ftr-tag (buffer-substring bol eol))
 255              (def-file))
 256         (setq def-file (br-feature-v3-def-file (regexp-quote ftr-tag)))
 257         (if def-file
 258             (progn (if (and (fboundp 'ibut:label-set)
 259                             (fboundp 'hproperty:but-flash))
 260                        (progn (ibut:label-set ftr-tag bol eol)
 261                               (hproperty:but-flash)))
 262                    (if (br-edit-feature-from-tag ftr-tag def-file)
 263                        nil
 264                      (error "(Action Key): (smart-element) - `%s' def not found in \"%s\""
 265                             (br-feature-signature-to-name ftr-tag) def-file)))
 266           (error "(Action Key): (smart-element) - No implementor definitions for `%s'"
 267                  (br-feature-signature-to-name ftr-tag)))))
 268      ;;
 269      ;; On an OO-Browser V4 element tag line, display its source code definition.
 270      ((save-excursion (beginning-of-line) (looking-at "\\s-*\\["))
 271       (let* ((eol (progn (end-of-line) (point)))
 272              (bol (progn (back-to-indentation) (point)))
 273              (ftr-str (br-buffer-substring eol bol))
 274              (ftr-tag (read (current-buffer)))
 275              (def-file (br-feature-tag-path ftr-tag)))
 276         (if def-file
 277             (progn (if (and (fboundp 'ibut:label-set)
 278                             (fboundp 'hproperty:but-flash))
 279                        (progn (ibut:label-set ftr-str bol eol)
 280                               (hproperty:but-flash)))
 281                    (if (br-edit-feature-from-tag ftr-tag def-file)
 282                        nil
 283                      (error "(Action Key): (smart-element) - `%s' def not found in \"%s\""
 284                             (br-feature-tag-name ftr-tag) def-file)))
 285           (error "(Action Key): (smart-element) - No implementor definitions for `%s'"
 286                  (br-feature-tag-name ftr-tag)))))
 287      ;;
 288      ;; On a OO-Browser V4 feature signature line, indented below its class
 289      ;; name line (e.g. Implementors buffer)
 290      ((save-excursion (back-to-indentation) (looking-at ".*[ \t|,\{\;]"))
 291       (let* ((ftr-tag (br-feature-get-tag))
 292              (bol (progn (back-to-indentation) (point)))
 293              (eol (progn (end-of-line) (point)))
 294              (ftr-sig (if ftr-tag (br-feature-tag-signature ftr-tag)
 295                         (buffer-substring bol eol)))
 296              (def-file (if ftr-tag (br-feature-tag-path ftr-tag)))
 297              (ftr-name (if ftr-tag (br-feature-tag-name ftr-tag))))
 298         (if def-file
 299             (progn (if (and (fboundp 'ibut:label-set)
 300                             (fboundp 'hproperty:but-flash))
 301                        (progn (ibut:label-set ftr-sig bol eol)
 302                               (hproperty:but-flash)))
 303                    (if (br-edit-feature-from-tag ftr-tag def-file)
 304                        nil
 305                      (error
 306                       "(Action Key): (smart-element) - `%s' def not found in \"%s\""
 307                       ftr-name def-file)))
 308           (if ftr-name
 309               (error
 310                "(Action Key): (smart-element) - No implementor definitions for `%s'"
 311                ftr-name)
 312             (error
 313              "(Action Key): (smart-element) - Select a class or feature line")))))
 314      ;;
 315      ;; Assume this is a class name entry, display the class def.
 316      (t (let* ((bol (progn (back-to-indentation) (point)))
 317                (eol (progn (end-of-line) (point)))
 318                (class (br-buffer-substring bol eol)))
 319           (if (and (fboundp 'ibut:label-set) (fboundp 'hproperty:but-flash))
 320               (progn (ibut:label-set class bol eol) (hproperty:but-flash)))
 321           (br-edit nil class))))))
 322
 323 ;;; ************************************************************************
 324 ;;; Hyperbole info browsing functions
 325 ;;; ************************************************************************
 326
 327 (autoload 'Info-handle-in-note "hmous-info"
 328           "Follows Info documentation references.")
 329 (autoload 'smart-info "hmous-info" "Follows Info documentation references." t)
 330 (autoload 'smart-info-assist "hmous-info"
 331           "Follows Info documentation references." t)
 332
 333 (provide 'hmouse-br)