link.el

;;; link.el -- putting clickable links into the buffer

;; Author: Torsten Hilbrich <dictionary@myrkr.in-berlin.de>
;; Keywords: interface, hypermedia
;; $Id: link.el,v 1.10 2002/10/12 09:40:09 torsten Exp $

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; Commentary:

;; This file contains functions for using links in buffers.  A link is
;; a part of the buffer marked with a special face, beeing
;; hightlighted while the mouse points to it and beeing activated when
;; pressing return or clicking the button2.

;; Which each link a function and some data are associated.  Upon
;; clicking the function is called with the data as only argument.

(eval-when-compile
  (require 'cl))

(defun link-create-link (start end face function &optional data help)
  "Create a link in the current buffer starting from `start' going to `end'.
The `face' is used for displaying, the `data' are stored together with the
link.  Upon clicking the `function' is called with `data' as argument."
  (let ((properties `(face ,face
	              mouse-face highlight
		      link t
		      link-data ,data
		      help-echo ,help
		      link-function ,function)))
    (remove-text-properties start end properties)
    (add-text-properties start end properties)))

(defun link-insert-link (text face function &optional data help)
  "Insert the `text' at point to be formatted as link.
The `face' is used for displaying, the `data' are stored together with the
link.  Upon clicking the `function' is called with `data' as argument."
  (let ((start (point)))
    (insert text)
    (link-create-link start (point) face function data help)))

(defun link-selected (&optional all)
  "Is called upon clicking or otherwise visiting the link."
  (interactive)

  (let* ((properties (text-properties-at (point)))
	 (function (plist-get properties 'link-function))
	 (data (plist-get properties 'link-data)))
    (if function
	(funcall function data all))))

(defun link-selected-all ()
  "Called for meta clicking the link"
  (interactive)
  (link-selected 'all))

(defun link-mouse-click (event &optional all)
  "Is called upon clicking the link."
  (interactive "@e")

  (mouse-set-point event)
  (link-selected))

(defun link-mouse-click-all (event)
  "Is called upon meta clicking the link."
  (interactive "@e")

  (mouse-set-point event)
  (link-selected-all))

(defun link-next-link ()
  "Return the position of the next link or nil if there is none"
  (let* ((pos (point))
	 (pos (next-single-property-change pos 'link)))
    (if pos
	(if (text-property-any pos (min (1+ pos) (point-max)) 'link t)
	    pos
	  (next-single-property-change pos 'link))
      nil)))
      

(defun link-prev-link ()
  "Return the position of the previous link or nil if there is none"
  (let* ((pos (point))
	 (pos (previous-single-property-change pos 'link)))
    (if pos
	(if (text-property-any pos (1+ pos) 'link t)
	    pos
	  (let ((val (previous-single-property-change pos 'link)))
	    (if val
		val
	      (text-property-any (point-min) (1+ (point-min)) 'link t))))
      nil)))

(defun link-initialize-keymap (keymap)
  "Defines the necessary bindings inside keymap"

  (if (and (boundp 'running-xemacs) running-xemacs)
      (progn
	(define-key keymap [button2] 'link-mouse-click)
	(define-key keymap [(meta button2)] 'link-mouse-click-all))
    (define-key keymap [mouse-2] 'link-mouse-click)
    (define-key keymap [M-mouse-2] 'link-mouse-click-all))
    (define-key keymap "\r" 'link-selected)
    (define-key keymap "\M-\r" 'link-selected-all))

(provide 'link)