|
2
|
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)
|
