Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/hm--html-drag-and-drop.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; $Id: hm--html-drag-and-drop.el,v 1.1.1.1 1996/12/18 22:43:20 steve Exp $ 1 ;;; $Id: hm--html-drag-and-drop.el,v 1.2 1997/02/15 22:21:03 steve Exp $
2 ;;; 2 ;;;
3 ;;; Copyright (C) 1996 Heiko Muenkel 3 ;;; Copyright (C) 1996, 1997 Heiko Muenkel
4 ;;; email: muenkel@tnt.uni-hannover.de 4 ;;; email: muenkel@tnt.uni-hannover.de
5 ;;; 5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify 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 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) 8 ;;; the Free Software Foundation; either version 1, or (at your option)
33 ;;; 33 ;;;
34 34
35 (require 'internal-drag-and-drop) 35 (require 'internal-drag-and-drop)
36 (require 'cl) 36 (require 'cl)
37 37
38 (defun hm--html-first-non-matching-position (string1 string2) 38 ;(defun hm--html-first-non-matching-position (string1 string2)
39 "Compares both strings and returns the first position, which is not equal." 39 ; "Compares both strings and returns the first position, which is not equal."
40 (let ((n 0) 40 ; (let ((n 0)
41 (max-n (min (length string1) (length string2))) 41 ; (max-n (min (length string1) (length string2)))
42 (continue t)) 42 ; (continue t))
43 (while (and continue (< n max-n)) 43 ; (while (and continue (< n max-n))
44 (when (setq continue (= (aref string1 n) (aref string2 n))) 44 ; (when (setq continue (= (aref string1 n) (aref string2 n)))
45 (setq n (1+ n)))) 45 ; (setq n (1+ n))))
46 n)) 46 ; n))
47 47
48 (defun hm--html-count-subdirs (directory) 48 ;(defun hm--html-count-subdirs (directory)
49 "Returns the number of subdirectories of DIRECTORY." 49 ; "Returns the number of subdirectories of DIRECTORY."
50 (let ((n 0) 50 ; (let ((n 0)
51 (max-n (1- (length directory))) 51 ; (max-n (1- (length directory)))
52 (count 0)) 52 ; (count 0))
53 (while (< n max-n) 53 ; (while (< n max-n)
54 (when (= ?/ (aref directory n)) 54 ; (when (= ?/ (aref directory n))
55 (setq count (1+ count))) 55 ; (setq count (1+ count)))
56 (setq n (1+ n))) 56 ; (setq n (1+ n)))
57 (when (and (not (= 0 (length directory))) 57 ; (when (and (not (= 0 (length directory)))
58 (not (= ?/ (aref directory 0)))) 58 ; (not (= ?/ (aref directory 0))))
59 (setq count (1+ count))) 59 ; (setq count (1+ count)))
60 count)) 60 ; count))
61 61
62 (defun hm--html-return-n-backwards (n) 62 ;(defun hm--html-return-n-backwards (n)
63 "Returns a string with N ../" 63 ; "Returns a string with N ../"
64 (cond ((= n 0) "") 64 ; (cond ((= n 0) "")
65 (t (concat "../" (hm--html-return-n-backwards (1- n)))))) 65 ; (t (concat "../" (hm--html-return-n-backwards (1- n))))))
66 66
67 (defun* hm--html-file-relative-name (file-name 67 ;(defun* hm--html-file-relative-name (file-name
68 &optional (directory default-directory)) 68 ; &optional (directory default-directory))
69 "Convert FILENAME to be relative to DIRECTORY (default: 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)) 70 ; (let* ((pos (hm--html-first-non-matching-position file-name directory))
71 (backwards (hm--html-count-subdirs (substring directory pos))) 71 ; (backwards (hm--html-count-subdirs (substring directory pos)))
72 (relative-name (concat (hm--html-return-n-backwards backwards) 72 ; (relative-name (concat (hm--html-return-n-backwards backwards)
73 (substring file-name pos)))) 73 ; (substring file-name pos))))
74 (if (= 0 (length relative-name)) 74 ; (if (= 0 (length relative-name))
75 "./" 75 ; "./"
76 (if (= ?/ (aref relative-name 0)) 76 ; (if (= ?/ (aref relative-name 0))
77 (if (= 1 (length relative-name)) 77 ; (if (= 1 (length relative-name))
78 "./" 78 ; "./"
79 (substring relative-name 1)) 79 ; (substring relative-name 1))
80 relative-name)))) 80 ; relative-name))))
81 81
82 (defun hm--html-idd-add-include-image-from-dired-line (source destination) 82 (defun hm--html-idd-add-include-image-from-dired-line (source destination)
83 "Inserts an include image tag at the SOURCE. 83 "Inserts an include image tag at the DESTINATION.
84 The name of the image is on a line in a dired buffer. It is specified by the 84 The name of the image is on a line in a dired buffer. It is specified by the
85 destination." 85 SOURCE."
86 (idd-set-point source) 86 (idd-set-point destination)
87 (if hm--html-idd-create-relative-links 87 (if hm--html-idd-create-relative-links
88 (hm--html-add-image-top (hm--html-file-relative-name 88 (hm--html-add-image-top (file-relative-name
89 (idd-get-dired-filename-from-line destination)) 89 (idd-get-dired-filename-from-line source))
90 (file-name-nondirectory 90 (file-name-nondirectory
91 (idd-get-dired-filename-from-line destination))) 91 (idd-get-dired-filename-from-line source)))
92 (hm--html-add-image-top (idd-get-dired-filename-from-line destination) 92 (hm--html-add-image-top (idd-get-dired-filename-from-line source)
93 (file-name-nondirectory 93 (file-name-nondirectory
94 (idd-get-dired-filename-from-line destination))))) 94 (idd-get-dired-filename-from-line source)))))
95 95
96 (defun hm--html-idd-add-link-to-region (link-object source) 96 (defun hm--html-idd-add-link-to-region (link-object destination)
97 "Inserts a link with the LINK-OBJECT in the SOURCE. 97 "Inserts a link with the LINK-OBJECT in the DESTINATION.
98 It uses the region as the name of the link." 98 It uses the region as the name of the link."
99 (idd-set-region source) 99 (idd-set-region destination)
100 (hm--html-add-normal-link-to-region link-object) 100 (hm--html-add-normal-link-to-region link-object)
101 ) 101 )
102 102
103 (defun hm--html-idd-add-link (link-object source) 103 (defun hm--html-idd-add-link (link-object destination)
104 "Inserts a link with the LINK-OBJECT in the SOURCE." 104 "Inserts a link with the LINK-OBJECT in the DESTINATION."
105 (idd-set-point source) 105 (idd-set-point destination)
106 (hm--html-add-normal-link link-object)) 106 (hm--html-add-normal-link link-object))
107 107
108 (defun hm--html-idd-add-link-to-point-or-region (link-object source) 108 (defun hm--html-idd-add-link-to-point-or-region (link-object destination)
109 "Inserts a link with the LINK-OBJECT in the SOURCE. 109 "Inserts a link with the LINK-OBJECT in the DESTINATION.
110 It uses the region as the name of the link, if the region was active 110 It uses the region as the name of the link, if the region was active
111 in the SOURCE." 111 in the DESTINATION."
112 (if (cdr (assoc ':region-active source)) 112 (if (cdr (assoc ':region-active destination))
113 (hm--html-idd-add-link-to-region link-object source) 113 (hm--html-idd-add-link-to-region link-object destination)
114 (hm--html-idd-add-link link-object source))) 114 (hm--html-idd-add-link link-object destination)))
115 115
116 (defun hm--html-idd-add-file-link-to-file-on-dired-line (source destination) 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." 117 "Inserts a file link in DESTINATION to the file on the dired line of SOURCE."
118 (idd-set-point source) 118 (idd-set-point destination)
119 (if hm--html-idd-create-relative-links 119 (if hm--html-idd-create-relative-links
120 (hm--html-idd-add-link-to-point-or-region 120 (hm--html-idd-add-link-to-point-or-region
121 (hm--html-file-relative-name 121 (file-relative-name
122 (idd-get-dired-filename-from-line destination)) 122 (idd-get-dired-filename-from-line source))
123 source) 123 destination)
124 (hm--html-idd-add-link-to-point-or-region 124 (hm--html-idd-add-link-to-point-or-region
125 (concat "file://" (idd-get-dired-filename-from-line destination)) 125 (concat "file://" (idd-get-dired-filename-from-line source))
126 source))) 126 destination)))
127 127
128 (defun hm--html-idd-add-file-link-to-buffer (source destination) 128 (defun hm--html-idd-add-file-link-to-buffer (source destination)
129 "Inserts a file link at SOURCE to the file of DESTINATION." 129 "Inserts a file link at DESTINATION to the file of the SOURCE buffer."
130 (idd-set-point source) 130 (idd-set-point destination)
131 (if hm--html-idd-create-relative-links 131 (if hm--html-idd-create-relative-links
132 (hm--html-idd-add-link-to-point-or-region 132 (hm--html-idd-add-link-to-point-or-region
133 (hm--html-file-relative-name (idd-get-local-filename destination)) 133 (file-relative-name (idd-get-local-filename source))
134 source) 134 destination)
135 (hm--html-idd-add-link-to-point-or-region 135 (hm--html-idd-add-link-to-point-or-region
136 (concat "file://" (idd-get-local-filename destination)) 136 (concat "file://" (idd-get-local-filename source))
137 source))) 137 destination)))
138 138
139 (defun hm--html-idd-add-file-link-to-directory-of-buffer (source 139 (defun hm--html-idd-add-file-link-to-directory-of-buffer (source
140 destination) 140 destination)
141 "Inserts a file link at SOURCE to the directory of the DESTINATION buffer." 141 "Inserts a file link at DESTINATION to the directory of the SOURCE buffer."
142 (idd-set-point source) 142 (idd-set-point destination)
143 (if hm--html-idd-create-relative-links 143 (if hm--html-idd-create-relative-links
144 (hm--html-idd-add-link-to-point-or-region 144 (hm--html-idd-add-link-to-point-or-region
145 (hm--html-file-relative-name (idd-get-directory-of-buffer destination)) 145 (file-relative-name (idd-get-directory-of-buffer source))
146 source) 146 destination)
147 (hm--html-idd-add-link-to-point-or-region 147 (hm--html-idd-add-link-to-point-or-region
148 (concat "file://" (idd-get-directory-of-buffer destination)) 148 (concat "file://" (idd-get-directory-of-buffer source))
149 source))) 149 destination)))
150 150
151 (defun hm--html-idd-add-html-link-to-w3-buffer (source destination) 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. 152 "Inserts a link at DESTINATION to the w3 buffer specified by the SOURCE.
153 Note: Relative links are currently not supported for this function." 153 Note: Relative links are currently not supported for this function."
154 (idd-set-point source) 154 (idd-set-point destination)
155 (hm--html-idd-add-link-to-point-or-region (idd-get-buffer-url destination) 155 (hm--html-idd-add-link-to-point-or-region (idd-get-buffer-url source)
156 source)) 156 destination))
157 157
158 (defun hm--html-idd-add-html-link-from-w3-buffer-point (source destination) 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. 159 "Inserts a link at DESTINATION to a lin in the w3 buffer.
160 The link in the w3-buffer is specified by the DESTINATION. 160 The link in the w3-buffer is specified by the SOURCE.
161 Note: Relative links are currently not supported for this function." 161 Note: Relative links are currently not supported for this function."
162 (idd-set-point source) 162 (idd-set-point destination)
163 (hm--html-idd-add-link-to-point-or-region (idd-get-url-at-point destination) 163 (hm--html-idd-add-link-to-point-or-region (idd-get-url-at-point source)
164 source)) 164 destination))
165 165
166 ;;; Announce the feature hm--html-drag-and-drop 166 ;;; Announce the feature hm--html-drag-and-drop
167 (provide 'hm--html-drag-and-drop) 167 (provide 'hm--html-drag-and-drop)