Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/hm--html-drag-and-drop.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents
children 8fc7fe29b841
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; $Id: hm--html-drag-and-drop.el,v 1.1.1.1 1996/12/18 03:46:48 steve Exp $
2 ;;;
3 ;;; Copyright (C) 1996 Heiko Muenkel
4 ;;; email: muenkel@tnt.uni-hannover.de
5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 1, or (at your option)
9 ;;; any later version.
10 ;;;
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with this program; if not, write to the Free Software
18 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 ;;;
20 ;;;
21 ;;; Description:
22 ;;;
23 ;;; This package contains functions to insert links and other
24 ;;; HTML stuff with the mouse with drag and drop.
25 ;;;
26 ;;; For further descriptions look at the file
27 ;;; internal-drag-and-drop.el, which implements the basic (and
28 ;;; more genreal functions) for the drag and drop interface.
29 ;;;
30 ;;; Installation:
31 ;;;
32 ;;; Put this file in your load path.
33 ;;;
34
35 (require 'internal-drag-and-drop)
36 (require 'cl)
37
38 (defun hm--html-first-non-matching-position (string1 string2)
39 "Compares both strings and returns the first position, which is not equal."
40 (let ((n 0)
41 (max-n (min (length string1) (length string2)))
42 (continue t))
43 (while (and continue (< n max-n))
44 (when (setq continue (= (aref string1 n) (aref string2 n)))
45 (setq n (1+ n))))
46 n))
47
48 (defun hm--html-count-subdirs (directory)
49 "Returns the number of subdirectories of DIRECTORY."
50 (let ((n 0)
51 (max-n (1- (length directory)))
52 (count 0))
53 (while (< n max-n)
54 (when (= ?/ (aref directory n))
55 (setq count (1+ count)))
56 (setq n (1+ n)))
57 (when (and (not (= 0 (length directory)))
58 (not (= ?/ (aref directory 0))))
59 (setq count (1+ count)))
60 count))
61
62 (defun hm--html-return-n-backwards (n)
63 "Returns a string with N ../"
64 (cond ((= n 0) "")
65 (t (concat "../" (hm--html-return-n-backwards (1- n))))))
66
67 (defun* hm--html-file-relative-name (file-name
68 &optional (directory default-directory))
69 "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
70 (let* ((pos (hm--html-first-non-matching-position file-name directory))
71 (backwards (hm--html-count-subdirs (substring directory pos)))
72 (relative-name (concat (hm--html-return-n-backwards backwards)
73 (substring file-name pos))))
74 (if (= 0 (length relative-name))
75 "./"
76 (if (= ?/ (aref relative-name 0))
77 (if (= 1 (length relative-name))
78 "./"
79 (substring relative-name 1))
80 relative-name))))
81
82 (defun hm--html-idd-add-include-image-from-dired-line (source destination)
83 "Inserts an include image tag at the SOURCE.
84 The name of the image is on a line in a dired buffer. It is specified by the
85 destination."
86 (idd-set-point source)
87 (if hm--html-idd-create-relative-links
88 (hm--html-add-image-top (hm--html-file-relative-name
89 (idd-get-dired-filename-from-line destination))
90 (file-name-nondirectory
91 (idd-get-dired-filename-from-line destination)))
92 (hm--html-add-image-top (idd-get-dired-filename-from-line destination)
93 (file-name-nondirectory
94 (idd-get-dired-filename-from-line destination)))))
95
96 (defun hm--html-idd-add-link-to-region (link-object source)
97 "Inserts a link with the LINK-OBJECT in the SOURCE.
98 It uses the region as the name of the link."
99 (idd-set-region source)
100 (hm--html-add-normal-link-to-region link-object)
101 )
102
103 (defun hm--html-idd-add-link (link-object source)
104 "Inserts a link with the LINK-OBJECT in the SOURCE."
105 (idd-set-point source)
106 (hm--html-add-normal-link link-object))
107
108 (defun hm--html-idd-add-link-to-point-or-region (link-object source)
109 "Inserts a link with the LINK-OBJECT in the SOURCE.
110 It uses the region as the name of the link, if the region was active
111 in the SOURCE."
112 (if (cdr (assoc ':region-active source))
113 (hm--html-idd-add-link-to-region link-object source)
114 (hm--html-idd-add-link link-object source)))
115
116 (defun hm--html-idd-add-file-link-to-file-on-dired-line (source destination)
117 "Inserts a file link in SOURCE to the file on the dired line of DESTINATION."
118 (idd-set-point source)
119 (if hm--html-idd-create-relative-links
120 (hm--html-idd-add-link-to-point-or-region
121 (hm--html-file-relative-name
122 (idd-get-dired-filename-from-line destination))
123 source)
124 (hm--html-idd-add-link-to-point-or-region
125 (concat "file://" (idd-get-dired-filename-from-line destination))
126 source)))
127
128 (defun hm--html-idd-add-file-link-to-buffer (source destination)
129 "Inserts a file link at SOURCE to the file of DESTINATION."
130 (idd-set-point source)
131 (if hm--html-idd-create-relative-links
132 (hm--html-idd-add-link-to-point-or-region
133 (hm--html-file-relative-name (idd-get-local-filename destination))
134 source)
135 (hm--html-idd-add-link-to-point-or-region
136 (concat "file://" (idd-get-local-filename destination))
137 source)))
138
139 (defun hm--html-idd-add-file-link-to-directory-of-buffer (source
140 destination)
141 "Inserts a file link at SOURCE to the directory of the DESTINATION buffer."
142 (idd-set-point source)
143 (if hm--html-idd-create-relative-links
144 (hm--html-idd-add-link-to-point-or-region
145 (hm--html-file-relative-name (idd-get-directory-of-buffer destination))
146 source)
147 (hm--html-idd-add-link-to-point-or-region
148 (concat "file://" (idd-get-directory-of-buffer destination))
149 source)))
150
151 (defun hm--html-idd-add-html-link-to-w3-buffer (source destination)
152 "Inserts a link at SOURCE to the w3 buffer specified by the DESTINATION.
153 Note: Relative links are currently not supported for this function."
154 (idd-set-point source)
155 (hm--html-idd-add-link-to-point-or-region (idd-get-buffer-url destination)
156 source))
157
158 (defun hm--html-idd-add-html-link-from-w3-buffer-point (source destination)
159 "Inserts a link at SOURCE to a lin in the w3 buffer.
160 The link in the w3-buffer is specified by the DESTINATION.
161 Note: Relative links are currently not supported for this function."
162 (idd-set-point source)
163 (hm--html-idd-add-link-to-point-or-region (idd-get-url-at-point destination)
164 source))
165
166 ;;; Announce the feature hm--html-drag-and-drop
167 (provide 'hm--html-drag-and-drop)