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