view lisp/hm--html-menus/hm--html-drag-and-drop.el @ 8:4b173ad71786 r19-15b5

Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents ac2d302a0011
children 8fc7fe29b841
line wrap: on
line source

;;; $Id: hm--html-drag-and-drop.el,v 1.1.1.1 1996/12/18 03:46:48 steve Exp $
;;; 
;;; Copyright (C) 1996 Heiko Muenkel
;;; email: muenkel@tnt.uni-hannover.de
;;;
;;;  This program 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 1, or (at your option)
;;;  any later version.
;;;
;;;  This program 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 this program; if not, write to the Free Software
;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; 
;;; Description:
;;;
;;;	This package contains functions to insert links and other
;;;	HTML stuff with the mouse with drag and drop.
;;;
;;;	For further descriptions look at the file 
;;;	internal-drag-and-drop.el, which implements the basic (and
;;;	more genreal functions) for the drag and drop interface.
;;; 
;;; Installation: 
;;;   
;;;	Put this file in your load path.
;;;

(require 'internal-drag-and-drop)
(require 'cl)

(defun hm--html-first-non-matching-position (string1 string2)
  "Compares both strings and returns the first position, which is not equal."
  (let ((n 0)
	(max-n (min (length string1) (length string2)))
	(continue t))
    (while (and continue (< n max-n))
      (when (setq continue (= (aref string1 n) (aref string2 n)))
	(setq n (1+ n))))
    n))

(defun hm--html-count-subdirs (directory)
  "Returns the number of subdirectories of DIRECTORY."
  (let ((n 0)
	(max-n (1- (length directory)))
	(count 0))
    (while (< n max-n)
      (when (= ?/ (aref directory n))
	(setq count (1+ count)))
      (setq n (1+ n)))
    (when (and (not (= 0 (length directory)))
	       (not (= ?/ (aref directory 0))))
      (setq count (1+ count)))
    count))

(defun hm--html-return-n-backwards (n)
  "Returns a string with N ../"
  (cond ((= n 0) "")
	(t (concat "../" (hm--html-return-n-backwards (1- n))))))

(defun* hm--html-file-relative-name (file-name 
				     &optional (directory default-directory))
  "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
  (let* ((pos (hm--html-first-non-matching-position file-name directory))
	 (backwards (hm--html-count-subdirs (substring directory pos)))
	 (relative-name (concat (hm--html-return-n-backwards backwards)
				(substring file-name pos))))
    (if (= 0 (length relative-name))
	"./"
      (if (= ?/ (aref relative-name 0))
	  (if (= 1 (length relative-name))
	      "./"
	    (substring relative-name 1))
	relative-name))))

(defun hm--html-idd-add-include-image-from-dired-line (source destination)
  "Inserts an include image tag at the SOURCE.
The name of the image is on a line in a dired buffer. It is specified by the
destination."
  (idd-set-point source)
  (if hm--html-idd-create-relative-links
      (hm--html-add-image-top (hm--html-file-relative-name
			       (idd-get-dired-filename-from-line destination))
			      (file-name-nondirectory
			       (idd-get-dired-filename-from-line destination)))
    (hm--html-add-image-top (idd-get-dired-filename-from-line destination)
			    (file-name-nondirectory
			     (idd-get-dired-filename-from-line destination)))))

(defun hm--html-idd-add-link-to-region (link-object source)
  "Inserts a link with the LINK-OBJECT in the SOURCE.
It uses the region as the name of the link."
  (idd-set-region source)
  (hm--html-add-normal-link-to-region link-object)
  )

(defun hm--html-idd-add-link (link-object source)
  "Inserts a link with the LINK-OBJECT in the SOURCE."
  (idd-set-point source)
  (hm--html-add-normal-link link-object))
    
(defun hm--html-idd-add-link-to-point-or-region (link-object source)
  "Inserts a link with the LINK-OBJECT in the SOURCE.
It uses the region as the name of the link, if the region was active
in the SOURCE."
  (if (cdr (assoc ':region-active source))
      (hm--html-idd-add-link-to-region link-object source)
    (hm--html-idd-add-link link-object source)))

(defun hm--html-idd-add-file-link-to-file-on-dired-line (source destination)
  "Inserts a file link in SOURCE to the file on the dired line of DESTINATION."
  (idd-set-point source)
  (if hm--html-idd-create-relative-links
      (hm--html-idd-add-link-to-point-or-region
       (hm--html-file-relative-name 
	(idd-get-dired-filename-from-line destination))
       source)
    (hm--html-idd-add-link-to-point-or-region
     (concat "file://" (idd-get-dired-filename-from-line destination))
     source)))

(defun hm--html-idd-add-file-link-to-buffer (source destination)
  "Inserts a file link at SOURCE to the file of DESTINATION."
  (idd-set-point source)
  (if hm--html-idd-create-relative-links
      (hm--html-idd-add-link-to-point-or-region
       (hm--html-file-relative-name (idd-get-local-filename destination))
       source)
    (hm--html-idd-add-link-to-point-or-region
     (concat "file://" (idd-get-local-filename destination))
     source)))

(defun hm--html-idd-add-file-link-to-directory-of-buffer (source
							  destination)
  "Inserts a file link at SOURCE to the directory of the DESTINATION buffer."
  (idd-set-point source)
  (if hm--html-idd-create-relative-links
      (hm--html-idd-add-link-to-point-or-region
       (hm--html-file-relative-name (idd-get-directory-of-buffer destination))
       source)
    (hm--html-idd-add-link-to-point-or-region
     (concat "file://" (idd-get-directory-of-buffer destination))
     source)))

(defun hm--html-idd-add-html-link-to-w3-buffer (source destination)
  "Inserts a link at SOURCE to the w3 buffer specified by the DESTINATION.
Note: Relative links are currently not supported for this function."
  (idd-set-point source)
  (hm--html-idd-add-link-to-point-or-region (idd-get-buffer-url destination)
					    source))

(defun hm--html-idd-add-html-link-from-w3-buffer-point (source destination)
  "Inserts a link at SOURCE to a lin in the w3 buffer.
The link in the w3-buffer is specified by the DESTINATION.
Note: Relative links are currently not supported for this function."
  (idd-set-point source)
  (hm--html-idd-add-link-to-point-or-region (idd-get-url-at-point destination)
					    source))

;;; Announce the feature hm--html-drag-and-drop
(provide 'hm--html-drag-and-drop)