|
2
|
1 ;;; w3-annotat.el --- Annotation functions for Emacs-W3
|
|
0
|
2 ;; Author: wmperry
|
|
2
|
3 ;; Created: 1996/06/30 18:02:56
|
|
0
|
4 ;; Version: 1.3
|
|
|
5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
0
|
9 ;;;
|
|
|
10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
|
|
|
11 ;;;
|
|
|
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;;; any later version.
|
|
|
16 ;;;
|
|
|
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;;; GNU General Public License for more details.
|
|
|
21 ;;;
|
|
|
22 ;;; You should have received a copy of the GNU General Public License
|
|
|
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
26
|
|
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28 ;;; Private annotation support
|
|
|
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
30 (defun w3-parse-personal-annotations ()
|
|
|
31 ;; Read in personal annotation file
|
|
|
32 (if (and
|
|
|
33 (file-exists-p (format "%s/LOG" w3-personal-annotation-directory))
|
|
|
34 (file-readable-p (format "%s/LOG" w3-personal-annotation-directory)))
|
|
|
35 (save-excursion
|
|
|
36 (setq w3-personal-annotations nil);; nuke the old list
|
|
|
37 (let ((start nil)
|
|
|
38 (end nil)
|
|
|
39 (txt nil)
|
|
|
40 (url nil)
|
|
|
41 (num nil))
|
|
|
42 (set-buffer (get-buffer-create " *panno*"))
|
|
|
43 (erase-buffer)
|
|
|
44 (insert-file-contents-literally
|
|
|
45 (format "%s/LOG" w3-personal-annotation-directory))
|
|
|
46 (goto-char (point-min))
|
|
|
47 (w3-replace-regexp "\n+" "\n")
|
|
|
48 (goto-char (point-min))
|
|
|
49 ;; nuke the header lines
|
|
|
50 (delete-region (point-min) (progn (forward-line 2) (point)))
|
|
|
51 (cond
|
|
|
52 ((eobp) nil) ; Empty LOG file
|
|
|
53 (t
|
|
|
54 (if (/= (char-after (1- (point-max))) ?\n)
|
|
|
55 (save-excursion
|
|
|
56 (goto-char (point-max))
|
|
|
57 (insert "\n")))
|
|
|
58 (while (not (eobp))
|
|
|
59 (setq start (point)
|
|
|
60 end (prog2 (end-of-line) (point) (forward-char 1))
|
|
|
61 txt (buffer-substring start end)
|
|
|
62 url (substring txt 0 (string-match " " txt))
|
|
|
63 num (url-split
|
|
|
64 (substring txt (1+ (string-match " " txt)) nil)
|
|
|
65 "[ \t]"))
|
|
|
66 (while num
|
|
|
67 (setq w3-personal-annotations
|
|
|
68 (cons
|
|
|
69 (list url
|
|
|
70 (list (car (car num))
|
|
|
71 (w3-grok-annotation-format
|
|
|
72 (car (car num)))))
|
|
|
73 w3-personal-annotations)
|
|
|
74 num (cdr num))))))
|
|
|
75 (kill-buffer " *panno*")))))
|
|
|
76
|
|
|
77 (defun w3-grok-annotation-format (anno)
|
|
|
78 ;; Grab the title from an annotation
|
|
|
79 (let ((fname (format "%s/PAN-%s.html"
|
|
|
80 w3-personal-annotation-directory anno)))
|
|
|
81 (save-excursion
|
|
|
82 (set-buffer (get-buffer-create " *annotmp*"))
|
|
|
83 (erase-buffer)
|
|
|
84 (if (file-exists-p fname)
|
|
|
85 (insert-file-contents-literally fname))
|
|
|
86 (goto-char (point-min))
|
|
|
87 (prog1
|
|
|
88 (if (re-search-forward "<title>\\(.*\\)</title>" nil t)
|
|
|
89 (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
90 (concat "Annotation on "
|
|
|
91 (current-time-string (nth 5 (file-attributes fname)))))
|
|
|
92 (kill-buffer " *annotmp*")))))
|
|
|
93
|
|
|
94 (defun w3-is-personal-annotation (url)
|
|
|
95 ;; Is URL a personal annotation?
|
|
|
96 (string-match "file:/.*/PAN-.*\\.html" url))
|
|
|
97
|
|
|
98 (defun w3-delete-personal-annotation-internal (url num)
|
|
|
99 (save-excursion
|
|
|
100 (set-buffer (get-buffer-create " *annotmp*"))
|
|
|
101 (erase-buffer)
|
|
|
102 (insert-file-contents-literally (format "%s/LOG"
|
|
|
103 w3-personal-annotation-directory))
|
|
|
104 (replace-regexp (format "[ \t]+\\b%s\\b[ \t]*" num) " ")
|
|
|
105 (goto-char (point-min))
|
|
|
106 (delete-matching-lines (format "^%s +$" url))
|
|
|
107 (let ((make-backup-files nil)
|
|
|
108 (version-control nil)
|
|
|
109 (require-final-newline t))
|
|
|
110 (write-region (point-min) (point-max)
|
|
|
111 (format "%s/LOG"
|
|
|
112 w3-personal-annotation-directory)))
|
|
|
113 (kill-buffer " *annotmp*")
|
|
|
114 (let ((anno w3-personal-annotations))
|
|
|
115 (setq w3-personal-annotations nil)
|
|
|
116 (while anno
|
|
|
117 (if (not (string= num (car (car (cdr (car anno))))))
|
|
|
118 (setq w3-personal-annotations
|
|
|
119 (cons (car anno) w3-personal-annotations)))
|
|
|
120 (setq anno (cdr anno)))
|
|
|
121 (delete-file (format "%s/PAN-%s.html"
|
|
|
122 w3-personal-annotation-directory num)))))
|
|
|
123
|
|
|
124 (defun w3-delete-personal-annotation ()
|
|
|
125 "Delete a personal annotation."
|
|
|
126 (interactive)
|
|
|
127 (let ((url (url-view-url t)))
|
|
|
128 (cond
|
|
|
129 ((w3-is-personal-annotation (url-view-url t))
|
|
|
130 (let ((num nil)
|
|
|
131 (annotated-url nil)
|
|
|
132 (anno w3-personal-annotations))
|
|
|
133 (string-match "file:/.*/PAN-\\(.*\\)\\.html" url)
|
|
|
134 (setq num (match-string 1 url))
|
|
|
135 (while anno
|
|
|
136 (if (equal num (car (car (cdr (car anno)))))
|
|
|
137 (setq annotated-url (car (car anno))))
|
|
|
138 (setq anno (cdr anno)))
|
|
|
139 (if (not annotated-url)
|
|
|
140 (message "Couldn't find url that this is annotating!")
|
|
|
141 (w3-delete-personal-annotation-internal annotated-url num)
|
|
|
142 (w3-quit))))
|
|
|
143 (t
|
|
|
144 (let* ((tmp w3-personal-annotations)
|
|
|
145 (thelist nil)
|
|
|
146 (node nil)
|
|
|
147 (todel nil))
|
|
|
148 (if (not (assoc url tmp))
|
|
|
149 (message "No personal annotations.")
|
|
|
150 (while tmp
|
|
|
151 (setq node (car tmp))
|
|
|
152 (if (string= (car node) url)
|
|
|
153 (setq thelist (cons (cons (nth 1 (nth 1 node)) "") thelist)))
|
|
|
154 (setq tmp (cdr tmp)))
|
|
|
155 (setq todel (completing-read "Delete annotation: " thelist nil t))
|
|
|
156 ;; WORK ;;
|
|
|
157 (message "I should delete %s, but can't." todel)))))))
|
|
|
158
|
|
|
159 (defun w3-personal-annotation-add ()
|
|
|
160 "Add an annotation to this document."
|
|
|
161 (interactive)
|
|
|
162 (let ((url (url-view-url t))
|
|
|
163 (buf (get-buffer-create "*Personal Annotation*"))
|
|
|
164 (title (read-string "Title: "
|
|
|
165 (format "Annotation by %s on %s"
|
|
|
166 (user-real-login-name)
|
|
|
167 (current-time-string)))))
|
|
|
168 (set-buffer buf)
|
|
|
169 (switch-to-buffer buf)
|
|
|
170 (erase-buffer)
|
|
|
171 (if (and w3-annotation-mode (fboundp w3-annotation-mode))
|
|
|
172 (funcall w3-annotation-mode)
|
|
|
173 (message "%S is undefined, using %s" w3-annotation-mode
|
|
|
174 default-major-mode)
|
|
|
175 (funcall default-major-mode))
|
|
|
176 (w3-annotation-minor-mode 1)
|
|
|
177 (setq w3-current-annotation (cons url title))
|
|
|
178 (insert "<html>\n"
|
|
|
179 " <head>\n"
|
|
2
|
180 " <title>" (url-insert-entities-in-string title) "</title>"
|
|
0
|
181 " </head>\n"
|
|
2
|
182 " <h1>" (url-insert-entities-in-string title) "</h1>\n"
|
|
0
|
183 " <p>\n"
|
|
2
|
184 " <address>" (url-insert-entities-in-string (user-full-name))
|
|
0
|
185 (if (stringp url-personal-mail-address)
|
|
2
|
186 (concat " <" (url-insert-entities-in-string
|
|
0
|
187 url-personal-mail-address) ">")
|
|
|
188 "")
|
|
|
189 "</address>\n"
|
|
|
190 " <address>" (current-time-string) "</address>\n"
|
|
|
191 " </p>\n"
|
|
|
192 " <pre>\n")
|
|
|
193 (save-excursion
|
|
|
194 (insert "\n\n\n </pre>\n"
|
|
|
195 "</html>"))
|
|
|
196 (message "Hit C-cC-c to send this annotation.")))
|
|
|
197
|
|
|
198 (defun w3-annotation-minor-mode (&optional arg)
|
|
|
199 "Minimal minor mode for entering annotations. Just rebinds C-cC-c to
|
|
|
200 finish the annotation."
|
|
|
201 (interactive "P")
|
|
|
202 (cond
|
|
|
203 ((null arg) (setq w3-annotation-minor-mode (not w3-annotation-minor-mode)))
|
|
|
204 ((= 0 arg) (setq w3-annotation-minor-mode nil))
|
|
|
205 (t (setq w3-annotation-minor-mode t)))
|
|
|
206 (cond
|
|
|
207 ((or w3-running-FSF19 w3-running-xemacs))
|
|
|
208 (t (local-set-key "\C-c\C-c" 'w3-personal-annotation-finish)))
|
|
|
209 )
|
|
|
210
|
|
|
211 (defun w3-annotation-find-highest-number ()
|
|
|
212 ;; Find the highest annotation number in this buffer
|
|
|
213 (let (x)
|
|
|
214 (goto-char (point-min))
|
|
|
215 (while (re-search-forward "[^ \t\n]*[ \t]\\(.*\\)" nil t)
|
|
|
216 (setq x (nconc (mapcar (function (lambda (x) (string-to-int (car x))))
|
|
|
217 (url-split (buffer-substring (match-beginning 1)
|
|
|
218 (match-end 1))
|
|
|
219 "[ \t]")) x)))
|
|
|
220 (if (not x) (setq x '(0)))
|
|
|
221 (1+ (car (sort x '>)))))
|
|
|
222
|
|
|
223 (defun w3-personal-annotation-finish ()
|
|
|
224 "Finish doing a personal annotation."
|
|
|
225 (interactive)
|
|
|
226 (cond
|
|
|
227 ((or w3-running-FSF19 w3-running-xemacs))
|
|
|
228 (t (local-set-key "\C-c\C-c" 'undefined)))
|
|
|
229 (if (or (not w3-personal-annotation-directory)
|
|
|
230 (not (file-exists-p w3-personal-annotation-directory))
|
|
|
231 (not (file-directory-p w3-personal-annotation-directory)))
|
|
|
232 (error "No personal annotation directory!")
|
|
|
233 (let ((url (car w3-current-annotation))
|
|
|
234 (txt (buffer-string))
|
|
|
235 (title (cdr w3-current-annotation))
|
|
|
236 (fname nil)
|
|
|
237 (num nil))
|
|
|
238 (save-excursion
|
|
|
239 (not-modified)
|
|
|
240 (kill-buffer (current-buffer))
|
|
|
241 (set-buffer (get-buffer-create " *annotmp*"))
|
|
|
242 (erase-buffer)
|
|
|
243 (if (file-exists-p ; Insert current LOG file if
|
|
|
244 ; it exists.
|
|
|
245 (format "%s/LOG" w3-personal-annotation-directory))
|
|
|
246 (insert-file-contents-literally
|
|
|
247 (format "%s/LOG" w3-personal-annotation-directory))
|
|
|
248 (progn ; Otherwise, create a file
|
|
|
249 (goto-char (point-min)) ; that conforms to first
|
|
|
250 ; annotation format from NCSA
|
|
|
251 (insert "ncsa-mosaic-personal-annotation-log-format-1\n")
|
|
|
252 (insert "Personal\n")))
|
|
|
253 (goto-char (point-min))
|
|
|
254 (setq num (int-to-string (w3-annotation-find-highest-number))
|
|
|
255 fname (format "%s/PAN-%s.html"
|
|
|
256 w3-personal-annotation-directory num))
|
|
|
257 (goto-char (point-min))
|
|
|
258 (if (re-search-forward (regexp-quote url) nil t)
|
|
|
259 (progn
|
|
|
260 (end-of-line)
|
|
|
261 (insert " "))
|
|
|
262 (goto-char (point-max))
|
|
|
263 (insert "\n" url " "))
|
|
|
264 (insert num)
|
|
|
265 (let ((make-backup-files nil)
|
|
|
266 (version-control nil)
|
|
|
267 (require-final-newline t))
|
|
|
268 (write-region (point-min) (point-max)
|
|
|
269 (format "%s/LOG" w3-personal-annotation-directory))
|
|
|
270 (erase-buffer)
|
|
|
271 (insert w3-annotation-marker txt)
|
|
|
272 (write-region (point-min) (point-max) fname))
|
|
|
273 (setq w3-personal-annotations
|
|
|
274 (cons (list url (list num title)) w3-personal-annotations))))))
|
|
|
275
|
|
|
276 (defun w3-annotation-add ()
|
|
|
277 "Add an annotation to the current document."
|
|
|
278 (interactive)
|
|
|
279 (w3-personal-annotation-add))
|
