Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-annotat.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 859a2309aef8
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; w3-annotat.el --- Annotation functions for Emacs-W3
2 ;; Author: wmperry
3 ;; Created: 1996/06/30 18:02:56
4 ;; Version: 1.3
5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
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"
180 " <title>" (url-insert-entities-in-string title) "</title>"
181 " </head>\n"
182 " <h1>" (url-insert-entities-in-string title) "</h1>\n"
183 " <p>\n"
184 " <address>" (url-insert-entities-in-string (user-full-name))
185 (if (stringp url-personal-mail-address)
186 (concat " &lt;" (url-insert-entities-in-string
187 url-personal-mail-address) "&gt;")
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))