cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/kotl/klink.el

   1 ;;; klink.el --- Implicit reference to a kcell action type, for use in koutlines.
   2
   3 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;;         Kellie Clark
   8 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   9 ;; Keywords: extensions, hypermedia, outlines, wp
  10
  11 ;; This file is part of GNU Hyperbole.
  12
  13 ;; GNU Hyperbole is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 3, or (at
  16 ;; your option) any later version.
  17
  18 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29 ;;
  30 ;;; link =
  31 ;;    < pathname [, cell-ref] [, position] >
  32 ;;    < @ cell-ref >  ;; In same buffer
  33 ;;    < journal-name, journal-item-number [, cell-ref] [, position] >
  34 ;;
  35 ;;; pathname =
  36 ;;    path   ;; display path in Emacs buffer
  37 ;;    !path  ;; execute pathname within a shell
  38 ;;    &path  ;; execute path as a windowed program
  39 ;;    -path  ;; Load as an Emacs Lisp program
  40 ;;
  41 ;;; cell-ref =
  42 ;;    cell - 1a, 012, 1.2, 1a=012 (both relative and absolute ids separated
  43 ;;                                 by an equal sign)
  44 ;;    range - 1a-5c, 1a-+3 (include 3 cells past 1a)  (not yet implemented)
  45 ;;    tree  - 1a+  (not yet implemented)
  46 ;;
  47 ;;   optionally followed by a period and 1 or more relative position specs
  48 ;;   (not yet implemented):
  49 ;;
  50 ;;    previous-cell - .b
  51 ;;    down-a-level - .d
  52 ;;    end-of-branch - .e
  53 ;;    follow-next-link - .l
  54 ;;    return-to-prev-location - .r
  55 ;;    return-to-prev-buffer - .rf
  56 ;;    sibling - .s, .2s for 2 siblings forward
  57 ;;    tail-of-tree - .t
  58 ;;    up-a-level - .u
  59 ;;    last char of cell - .f
  60 ;;
  61 ;;   and then optionally followed by any amount of whitespace, a pipe `|'
  62 ;;   character and then one or more view specification characters.  (Augment
  63 ;;   viewspec characters may be given instead, preceded by a colon.  They are
  64 ;;   ignored for now.)
  65 ;;
  66 ;;; position (relative to cell start) = (not yet implemented)
  67 ;;    char-pos, e.g. 28 or C28
  68 ;;    word-num, e.g. W5
  69 ;;    line-num, e.g. L2
  70 ;;    paragraph-num, e.g. P3
  71 ;;    regexp-match, e.g. "regexp"
  72 ;;
  73
  74 ;;; Code:
  75
  76 ;;;
  77 ;;; Public functions
  78 ;;;
  79
  80 ;;;###autoload
  81 (defun klink:create (reference)
  82   "Insert at point an implicit link to REFERENCE.
  83 REFERENCE should be a cell-ref or a string containing \"filename, cell-ref\".
  84 See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
  85   (interactive
  86    ;; Don't change the name or delete default-dir used here.  It is referenced
  87    ;; in "hargs.el" for argument getting.
  88    (let ((default-dir default-directory))
  89      (barf-if-buffer-read-only)
  90      (hargs:iform-read
  91       (list 'interactive "*+LInsert link to <[file,] cell-id [|vspecs]>: "))))
  92   (barf-if-buffer-read-only)
  93   ;; Reference generally is a string.  It may be a list as a string, e.g.
  94   ;; "(\"file\" \"cell\")", in which case, we remove the unneeded internal
  95   ;; double quotes and then parse it with pattern matching.
  96   (and (stringp reference) (> (length reference) 0)
  97        (= (aref reference 0) ?\()
  98        (setq reference (hypb:replace-match-string "\\\"" reference "" t)))
  99   (let ((default-dir default-directory)
 100         file-ref cell-ref)
 101     (setq reference (klink:parse reference)
 102           file-ref  (car reference)
 103           cell-ref  (car (cdr reference)))
 104     ;; Don't need filename if link is to a cell in current buffer.
 105     (if (and file-ref (equal buffer-file-name
 106                              (expand-file-name file-ref default-directory)))
 107         (setq file-ref nil))
 108     (cond (file-ref
 109            (setq file-ref (hpath:relative-to file-ref))
 110                  ;; "./" prefix, if any.
 111            (if (string-match "^\\./" file-ref)
 112                (setq file-ref (substring file-ref (match-end 0))))
 113            (insert "<" file-ref)
 114            (if cell-ref (insert ", " cell-ref))
 115            (insert ">"))
 116           (cell-ref (insert "<@ " cell-ref ">"))
 117           (t  (error "(klink:create) Invalid reference, '%s'" reference)))))
 118
 119 (defun klink:at-p ()
 120   "Return non-nil iff point is within a klink.
 121 See documentation for the `link-to-kotl' function for valid klink formats.
 122 Value returned is a list of: link-label, link-start-position, and
 123 link-end-position, (including delimiters)."
 124   (let (bol klink referent)
 125     (if (and
 126          ;; If this is an OO-Browser listing buffer, ignore anything that
 127          ;; looks like a klink, e.g. a C++ <template> class.
 128          (if (fboundp 'br-browser-buffer-p)
 129              (not (br-browser-buffer-p))
 130            t)
 131          ;; Don't match to C/C++ lines like:  #include < path >
 132          (save-excursion
 133            (beginning-of-line)
 134            (setq bol (point))
 135            (require 'hmouse-tag)
 136            (not (looking-at smart-c-include-regexp)))
 137          (save-excursion
 138            ;; Don't match Elisp print objects such as #<buffer>
 139            (and (search-backward "<" bol t)
 140                 (/= (preceding-char) ?#)
 141                 ;; Don't match to \<(explicit)> Hyperbole buttons
 142                 (/= (char-after (1+ (point))) ?\()))
 143          (setq klink (hbut:label-p t "<" ">" t))
 144          (stringp (setq referent (car klink)))
 145          ;; Eliminate matches to e-mail address like, <user@domain>.
 146          (not (string-match "[^<> \t\n][!&@]" referent)))
 147         klink)))
 148
 149 ;;;
 150 ;;; Hyperbole type definitions
 151 ;;;
 152
 153 (defib klink ()
 154   "Follows a link delimited by <> to a koutline cell.
 155 See documentation for the `link-to-kotl' function for valid klink formats."
 156   (let* ((link-and-pos (klink:at-p))
 157          (link (car link-and-pos))
 158          (start-pos (car (cdr link-and-pos))))
 159     (if link
 160         (progn (ibut:label-set link-and-pos)
 161                (hact 'klink:act link start-pos)))))
 162
 163 (defact link-to-kotl (link)
 164   "Displays at the top of another window the referent pointed to by LINK.
 165 LINK may be of any of the following forms, with or without delimiters:
 166   < pathname [, cell-ref] >
 167   < [-!&] pathname >
 168   < @ cell-ref >
 169
 170 See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
 171
 172   (interactive "sKotl link specifier: ")
 173   (or (stringp link) (error "(link-to-kotl): Non-string link argument, %s"
 174                             link))
 175   (cond
 176    ((or (string-match (format "\\`<?\\s *@\\s *\\(%s\\)\\s *>?\\'"
 177                               klink:cell-ref-regexp) link)
 178         (string-match (format "\\`<?\\s *\\([|:]%s\\)\\s *>?\\'"
 179                               klink:cell-ref-regexp) link))
 180     ;; < @ cell-ref > or < |viewspec > or < :augment-viewspec >
 181     (hact 'link-to-kcell
 182           nil
 183           (kcell:ref-to-id
 184            (substring link (match-beginning 1) (match-end 1)))))
 185    ((string-match
 186      (format "\\`<?\\s *\\([^ \t\n,<>]+\\)\\s *\\(,\\s *\\(%s\\)\\)?\\s *>?\\'"
 187              klink:cell-ref-regexp)
 188      link)
 189     ;; < pathname [, cell-ref] >
 190     (hact 'link-to-kcell
 191           (substring link (match-beginning 1) (match-end 1))
 192           (if (match-end 3)
 193               (kcell:ref-to-id
 194                (substring link (match-beginning 3) (match-end 3))))))
 195    ((string-match
 196      "\\`<?\\s *\\(\\([-!&]\\)?\\s *[^ \t\n,<>]+\\)\\s *>?\\'" link)
 197     ;; < [-!&] pathname >
 198     (hpath:find-other-window
 199      (substring link (match-beginning 1) (match-end 1))))
 200    (t (error "(link-to-kotl): Invalid link specifier, %s" link))))
 201
 202 ;;;
 203 ;;; Private functions
 204 ;;;
 205
 206 (defun klink:act (link start-pos)
 207   (let ((obuf (current-buffer)))
 208     ;; Perform klink's action which is to jump to link referent.
 209     (hact 'link-to-kotl link)
 210     ;; Update klink label if need be, which might be in a different buffer
 211     ;; than the current one.
 212     (klink:update-label link start-pos obuf)))
 213
 214 (defun klink:parse (reference)
 215   "Returns (file-ref cell-ref) list parsed from REFERENCE string.
 216 Either element of the list may be nil if REFERENCE does not contain that
 217 element.  REFERENCE should be one of the following forms (and may include an
 218 optional pair of <> delimiters:
 219   (pathname, cell-ref)
 220   pathname, cell-ref
 221   cell-ref
 222   |viewspec
 223   :augment-viewspec (ignored for now)
 224
 225 See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
 226
 227   (or (stringp reference)
 228       (error "(klink:parse): Non-string reference argument, %s"
 229              reference))
 230   (cond
 231    ((string-match
 232      (format
 233       "\\`\\s *[<\(]?\\s *\\([^|: \t\n\r,<>][^ \t\n\r,<>]*\\)\\s *,\\s *\\(%s\\)\\s *[\)>]?\\s *\\'"
 234       klink:cell-ref-regexp)
 235      reference)
 236     ;; pathname cell-ref
 237     (list (substring reference (match-beginning 1) (match-end 1))
 238           (substring reference (match-beginning 2) (match-end 2))))
 239    ((string-match (format "\\`\\s *<?\\s *\\(%s\\)\\s *>?\\s *\\'"
 240                           klink:cell-ref-regexp)
 241                   reference)
 242     ;; cell-ref
 243     (list nil (substring reference (match-beginning 1) (match-end 1))))
 244    (t (error "(klink:parse): Invalid reference specifier, %s" reference))))
 245
 246 (defun klink:replace-label (klink link-buf start new-label)
 247   "Replace out of date relative id in a link reference of the form, relid=idstamp."
 248   (save-excursion
 249     (set-buffer link-buf)
 250     (if buffer-read-only
 251         (message "Relative label should be `%s' in klink <%s>."
 252                  new-label klink)
 253       (goto-char start)
 254       (cond ((or (looking-at "<\\s *@\\s *")
 255                  (looking-at "[^,]+,\\s *"))
 256              (goto-char (match-end 0))
 257              (zap-to-char 1 ?=)
 258              (insert new-label ?=))
 259             (t nil)))))
 260
 261 (defun klink:update-label (klink start link-buf)
 262   "Update label of KLINK if its relative cell id has changed.
 263 Assume point is in klink referent buffer, where the klink points."
 264   (if (and (stringp klink)
 265            (string-match
 266             "[@,]\\s *\\([*0-9][*.0-9a-zA-Z]*\\)\\s *=\\s *0[0-9]*"
 267             klink))
 268       ;; Then klink has both relative and permanent ids.
 269       (let* ((label (substring klink (match-beginning 1) (match-end 1)))
 270              (new-label (kcell-view:label)))
 271           (if (and new-label (not (equal label new-label)))
 272               (klink:replace-label klink link-buf start new-label)))))
 273
 274 ;;;
 275 ;;; Private variables.
 276 ;;;
 277
 278 (defvar klink:cell-ref-regexp
 279   "[|:0-9a-zA-Z][|:.*~=0-9a-zA-Z \t\n\r]*"
 280   "Regexp matching a cell reference including relative and view specs.
 281 Contains no groupings.")
 282
 283 (provide 'klink)
 284
 285 ;;; klink.el ends here