Mercurial > hg > xemacs-beta
diff lisp/hm--html-menus/hm--html-drag-and-drop.el @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:35 +0200 |
parents | |
children | 8fc7fe29b841 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/hm--html-menus/hm--html-drag-and-drop.el Mon Aug 13 08:46:35 2007 +0200 @@ -0,0 +1,167 @@ +;;; $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)