File: hm--html-drag-and-drop.el

package info (click to toggle)
xemacs20 20.4-13
  • links: PTS
  • area: main
  • in suites: slink
  • size: 67,324 kB
  • ctags: 57,643
  • sloc: lisp: 586,197; ansic: 184,662; sh: 4,296; asm: 3,179; makefile: 2,021; perl: 1,059; csh: 96; sed: 22
file content (167 lines) | stat: -rw-r--r-- 6,581 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
;;; $Id: hm--html-drag-and-drop.el,v 1.5 1997/02/12 00:21:03 muenkel Exp $
;;; 
;;; Copyright (C) 1996, 1997 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 DESTINATION.
The name of the image is on a line in a dired buffer. It is specified by the
SOURCE."
  (idd-set-point destination)
  (if hm--html-idd-create-relative-links
      (hm--html-add-image-top (file-relative-name
			       (idd-get-dired-filename-from-line source))
			      (file-name-nondirectory
			       (idd-get-dired-filename-from-line source)))
    (hm--html-add-image-top (idd-get-dired-filename-from-line source)
			    (file-name-nondirectory
			     (idd-get-dired-filename-from-line source)))))

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

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

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

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

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

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

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

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