98
|
1 ;;; $Id: hm--html-drag-and-drop.el,v 1.2 1997/02/15 22:21:03 steve Exp $
|
2
|
2 ;;;
|
98
|
3 ;;; Copyright (C) 1996, 1997 Heiko Muenkel
|
2
|
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
|
98
|
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))
|
2
|
47
|
98
|
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))
|
2
|
61
|
98
|
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))))))
|
2
|
66
|
98
|
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))))
|
2
|
81
|
|
82 (defun hm--html-idd-add-include-image-from-dired-line (source destination)
|
98
|
83 "Inserts an include image tag at the DESTINATION.
|
2
|
84 The name of the image is on a line in a dired buffer. It is specified by the
|
98
|
85 SOURCE."
|
|
86 (idd-set-point destination)
|
2
|
87 (if hm--html-idd-create-relative-links
|
98
|
88 (hm--html-add-image-top (file-relative-name
|
|
89 (idd-get-dired-filename-from-line source))
|
2
|
90 (file-name-nondirectory
|
98
|
91 (idd-get-dired-filename-from-line source)))
|
|
92 (hm--html-add-image-top (idd-get-dired-filename-from-line source)
|
2
|
93 (file-name-nondirectory
|
98
|
94 (idd-get-dired-filename-from-line source)))))
|
2
|
95
|
98
|
96 (defun hm--html-idd-add-link-to-region (link-object destination)
|
|
97 "Inserts a link with the LINK-OBJECT in the DESTINATION.
|
2
|
98 It uses the region as the name of the link."
|
98
|
99 (idd-set-region destination)
|
2
|
100 (hm--html-add-normal-link-to-region link-object)
|
|
101 )
|
|
102
|
98
|
103 (defun hm--html-idd-add-link (link-object destination)
|
|
104 "Inserts a link with the LINK-OBJECT in the DESTINATION."
|
|
105 (idd-set-point destination)
|
2
|
106 (hm--html-add-normal-link link-object))
|
|
107
|
98
|
108 (defun hm--html-idd-add-link-to-point-or-region (link-object destination)
|
|
109 "Inserts a link with the LINK-OBJECT in the DESTINATION.
|
2
|
110 It uses the region as the name of the link, if the region was active
|
98
|
111 in the DESTINATION."
|
|
112 (if (cdr (assoc ':region-active destination))
|
|
113 (hm--html-idd-add-link-to-region link-object destination)
|
|
114 (hm--html-idd-add-link link-object destination)))
|
2
|
115
|
|
116 (defun hm--html-idd-add-file-link-to-file-on-dired-line (source destination)
|
98
|
117 "Inserts a file link in DESTINATION to the file on the dired line of SOURCE."
|
|
118 (idd-set-point destination)
|
2
|
119 (if hm--html-idd-create-relative-links
|
|
120 (hm--html-idd-add-link-to-point-or-region
|
98
|
121 (file-relative-name
|
|
122 (idd-get-dired-filename-from-line source))
|
|
123 destination)
|
2
|
124 (hm--html-idd-add-link-to-point-or-region
|
98
|
125 (concat "file://" (idd-get-dired-filename-from-line source))
|
|
126 destination)))
|
2
|
127
|
|
128 (defun hm--html-idd-add-file-link-to-buffer (source destination)
|
98
|
129 "Inserts a file link at DESTINATION to the file of the SOURCE buffer."
|
|
130 (idd-set-point destination)
|
2
|
131 (if hm--html-idd-create-relative-links
|
|
132 (hm--html-idd-add-link-to-point-or-region
|
98
|
133 (file-relative-name (idd-get-local-filename source))
|
|
134 destination)
|
2
|
135 (hm--html-idd-add-link-to-point-or-region
|
98
|
136 (concat "file://" (idd-get-local-filename source))
|
|
137 destination)))
|
2
|
138
|
|
139 (defun hm--html-idd-add-file-link-to-directory-of-buffer (source
|
|
140 destination)
|
98
|
141 "Inserts a file link at DESTINATION to the directory of the SOURCE buffer."
|
|
142 (idd-set-point destination)
|
2
|
143 (if hm--html-idd-create-relative-links
|
|
144 (hm--html-idd-add-link-to-point-or-region
|
98
|
145 (file-relative-name (idd-get-directory-of-buffer source))
|
|
146 destination)
|
2
|
147 (hm--html-idd-add-link-to-point-or-region
|
98
|
148 (concat "file://" (idd-get-directory-of-buffer source))
|
|
149 destination)))
|
2
|
150
|
|
151 (defun hm--html-idd-add-html-link-to-w3-buffer (source destination)
|
98
|
152 "Inserts a link at DESTINATION to the w3 buffer specified by the SOURCE.
|
2
|
153 Note: Relative links are currently not supported for this function."
|
98
|
154 (idd-set-point destination)
|
|
155 (hm--html-idd-add-link-to-point-or-region (idd-get-buffer-url source)
|
|
156 destination))
|
2
|
157
|
|
158 (defun hm--html-idd-add-html-link-from-w3-buffer-point (source destination)
|
98
|
159 "Inserts a link at DESTINATION to a lin in the w3 buffer.
|
|
160 The link in the w3-buffer is specified by the SOURCE.
|
2
|
161 Note: Relative links are currently not supported for this function."
|
98
|
162 (idd-set-point destination)
|
|
163 (hm--html-idd-add-link-to-point-or-region (idd-get-url-at-point source)
|
|
164 destination))
|
2
|
165
|
|
166 ;;; Announce the feature hm--html-drag-and-drop
|
|
167 (provide 'hm--html-drag-and-drop)
|