;;!emacs
;;
;; FILE:         klink.el
;; SUMMARY:      Implicit reference to a kcell action type, for use in koutlines.
;; USAGE:        GNU Emacs V19 Lisp Library
;; KEYWORDS:     extensions, hypermedia, outlines, wp
;;
;; AUTHOR:       Bob Weiner & Kellie Clark
;;
;; ORIG-DATE:    15-Nov-93 at 12:15:16
;; LAST-MOD:     17-Apr-95 at 11:53:45 by Bob Weiner
;;
;; This file is part of Hyperbole.
;; Available for use and distribution under the same terms as GNU Emacs.
;;
;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
;; Developed with support from Motorola Inc.
;;
;; DESCRIPTION:  
;;
;;   The klink implicit button type defined herein, is used to
;;   refer to autonumbered kcells and will eventually be used to autonumbered
;;   journal documents.  Klink buttons invoke the link-to-kotl actype, also
;;   defined herein.
;;
;;   Klinks are delimited by <> characters.  Here is a rough
;;   description of the syntax, only part of which is implemented as yet.
;;
;;; link =
;;    < pathname [, cell-ref] [, position] [, view] >
;;    < @cell-ref >  ;; In same buffer
;;    < journal-name, journal-item-number [, cell-ref] [, position] [,view] >
;;
;;; pathname =
;;    path   ;; display path in Emacs buffer
;;    !path  ;; execute pathname within a shell
;;    &path  ;; execute path as a windowed program
;;    -path  ;; Load as an Emacs Lisp program
;;
;;; cell-ref =
;;    cell - 1a, 012, 1.2, 1a=012 (both relative and absolute ids separated
;;    by an equal sign)
;;    range - 1a:5c, 1a:+3 (include 3 cells past 1a)
;;    kotl - 1a::
;;
;;    previous-cell - .b
;;    down-a-level - .d
;;    end-of-branch - .e
;;    follow-next-link - .l
;;    return-to-prev-location - .r
;;    return-to-prev-buffer - .rf
;;    sibling - .s, .2s for 2 siblings forward
;;    tail-of-plex  - .t
;;    up-a-level - .u
;;    last char of cell - +e
;;
;;; position (relative to cell start) =
;;    char-pos, e.g. 28 or C28
;;    word-num, e.g. W5
;;    line-num, e.g. L2
;;    paragraph-num, e.g. P3
;;    regexp-match, e.g. "regexp"
;;
;; DESCRIP-END.

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

;;;###autoload
(defun klink:create (reference)
  "Insert at point an implicit link to REFERENCE.
REFERENCE should be a cell-ref or a list of (filename cell-ref).
See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
  (interactive
   ;; Don't change the name or delete default-dir used here.  It is referenced
   ;; in "hargs.el" for argument getting.
   (let ((default-dir default-directory))
     (hargs:iform-read
      (list 'interactive "*+LInsert at point a link to: "))))
  (barf-if-buffer-read-only)
  (let ((default-dir default-directory)
	(file-ref (if (listp reference) (car reference)))
	(cell-ref (cond ((listp reference)   (car (cdr reference)))
			((stringp reference) reference)
			(t (error "(klink:create) Invalid reference, '%s'"
				  reference)))))
    ;; Don't need filename if link is to a cell in current buffer.
    (if (and file-ref (equal buffer-file-name
			     (expand-file-name file-ref default-directory)))
	(setq file-ref nil))
    (cond (file-ref
	   (setq file-ref (hpath:relative-to file-ref))
		 ;; "./" prefix, if any.
	   (if (string-match "^\\./" file-ref)
	       (setq file-ref (substring file-ref (match-end 0))))
	   (insert "<" file-ref)
	   (if cell-ref (insert ", " cell-ref))
	   (insert ">"))
	  (cell-ref (insert "<@ " cell-ref ">"))
	  (t  (error "(klink:create) Invalid reference, '%s'" reference)))))

(defun klink:at-p ()
  "Return non-nil iff point is within a klink.
See documentation for `actypes::link-to-kotl' for valid klink formats.
Value returned is a list of: link-label, link-start-position, and
link-end-position, (including delimiters)."
  (let (bol klink referent)
    (if (and
	 ;; If this is an OO-Browser listing buffer, ignore anything that
	 ;; looks like a klink, e.g. a C++ <template> class.
	 (if (fboundp 'br-browser-buffer-p)
	     (not (br-browser-buffer-p))
	   t)
	 ;; Don't match to C/C++ lines like:  #include < path >
	 (save-excursion
	   (beginning-of-line)
	   (setq bol (point))
	   (require 'hmouse-tag)
	   (not (looking-at smart-c-include-regexp)))
	 (save-excursion
	   ;; Don't match Elisp print objects such as #<buffer>
	   (and (search-backward "<" bol t)
		(/= (preceding-char) ?#)
		;; Don't match to \<(explicit)> Hyperbole buttons
		(/= (char-after (1+ (point))) ?\()))
	 (setq klink (hbut:label-p t "<" ">" t))
	 (stringp (setq referent (car klink)))
	 ;; Eliminate matches to e-mail address like, <user@domain>.
	 (not (string-match "[^<> \t\n][!&@]" referent)))
	klink)))

;;; ************************************************************************
;;; Hyperbole type definitions
;;; ************************************************************************

(defib klink ()
  "Follows a link delimited by <> to a koutline cell.
See documentation for `actypes::link-to-kotl' for valid link specifiers."
  (let* ((link-and-pos (klink:at-p))
	 (link (car link-and-pos))
	 (start-pos (car (cdr link-and-pos))))
    (if link
	(progn (ibut:label-set link-and-pos)
	       (hact 'klink:act link start-pos)))))

(defact link-to-kotl (link)
  "Displays at the top of another window the referent pointed to by LINK.
LINK may be of any of the following forms, with or without delimiters:
  < pathname [, cell-ref] >
  < [-!&] pathname >
  < @ cell-ref >

See documentation for 'kcell:ref-to-id' for valid cell-ref formats."

  (interactive "sKotl link specifier: ")
  (or (stringp link) (error "(link-to-kotl): Non-string link argument, %s"
			    link))
  (cond
   ((string-match "\\`<?\\s *@\\s *\\([*.=0-9a-zA-Z]+\\)\\s *>?\\'" link)
    ;; < @ cell-ref >
    (hact 'link-to-kcell
	  nil
	  (kcell:ref-to-id
	   (substring link (match-beginning 1) (match-end 1)))))
   ((string-match
     "\\`<?\\s *\\([^ \t\n,<>]+\\)\\s *\\(,\\s *\\([*.=0-9a-zA-Z]+\\)\\)?\\s *>?\\'"
     link)
    ;; < pathname [, cell-ref] >
    (hact 'link-to-kcell
	  (substring link (match-beginning 1) (match-end 1))
	  (if (match-end 3)
	      (kcell:ref-to-id
	       (substring link (match-beginning 3) (match-end 3))))))
   ((string-match
     "\\`<?\\s *\\(\\([-!&]\\)?\\s *[^ \t\n,<>]+\\)\\s *>?\\'" link)
    ;; < [-!&] pathname >
    (hpath:find-other-window
     (substring link (match-beginning 1) (match-end 1))))
   (t (error "(link-to-kotl): Invalid link specifier, %s" link))))

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

(defun klink:act (link start-pos)
  (let ((obuf (current-buffer)))
    ;; Perform klink's action which is to jump to link referent.
    (hact 'link-to-kotl link)
    ;; Update klink label if need be, which might be in a different buffer
    ;; than the current one.
    (klink:update-label link start-pos obuf)))

(defun klink:replace-label (klink link-buf start new-label)
  (save-excursion
    (set-buffer link-buf)
    (if buffer-read-only
	(message "Relative label should be `%s' in klink <%s>."
		 new-label klink)
      (goto-char start)
      (cond ((or (looking-at "<\\s *@\\s *")
		 (looking-at "[^,]+,\\s *"))
	     (goto-char (match-end 0))
	     (zap-to-char 1 ?=)
	     (insert new-label ?=))
	    (t nil)))))

(defun klink:update-label (klink start link-buf)
  "Update label of KLINK if its relative cell id has changed.
Assume point is in klink referent buffer, where the klink points."
  (if (and (stringp klink)
	   (string-match
	    "[@,]\\s *\\([*0-9][*.0-9a-zA-Z]*\\)\\s *=\\s *0[0-9]*\\(\\'\\|\\s *,\\)"
	    klink))
      ;; Then klink has both relative and permanent ids.
      (let* ((label (substring klink (match-beginning 1) (match-end 1)))
	     (new-label (kcell-view:label)))
	  (if (and new-label (not (equal label new-label)))
	      (klink:replace-label klink link-buf start new-label)))))

(provide 'klink)
