--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/w3/w3-annotat.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,279 @@
+;;; w3-annotat.el,v --- Annotation functions for Emacs-W3
+;; Author: wmperry
+;; Created: 1996/06/06 14:14:34
+;; Version: 1.3
+;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
+;;;
+;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;;
+;;; GNU Emacs 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 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Private annotation support
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun w3-parse-personal-annotations ()
+  ;; Read in personal annotation file
+  (if (and
+       (file-exists-p (format "%s/LOG" w3-personal-annotation-directory))
+       (file-readable-p (format "%s/LOG" w3-personal-annotation-directory)))
+      (save-excursion
+	(setq w3-personal-annotations nil);; nuke the old list
+	(let ((start nil)
+	      (end nil)
+	      (txt nil)
+	      (url nil)
+	      (num nil))
+	  (set-buffer (get-buffer-create " *panno*"))
+	  (erase-buffer)
+	  (insert-file-contents-literally
+	   (format "%s/LOG" w3-personal-annotation-directory))
+	  (goto-char (point-min))
+	  (w3-replace-regexp "\n+" "\n")
+	  (goto-char (point-min))
+	  ;; nuke the header lines
+	  (delete-region (point-min) (progn (forward-line 2) (point)))
+	  (cond
+	   ((eobp) nil)			; Empty LOG file
+	   (t
+	    (if (/= (char-after (1- (point-max))) ?\n)
+		(save-excursion
+		  (goto-char (point-max))
+		  (insert "\n")))
+	    (while (not (eobp))
+	      (setq start (point)
+		    end (prog2 (end-of-line) (point) (forward-char 1))
+		    txt (buffer-substring start end)
+		    url (substring txt 0 (string-match " " txt))
+		    num (url-split
+			 (substring txt (1+ (string-match " " txt)) nil)
+			 "[ \t]"))
+	      (while num
+		(setq w3-personal-annotations
+		      (cons
+		       (list url
+			     (list (car (car num))
+				   (w3-grok-annotation-format
+				    (car (car num)))))
+		       w3-personal-annotations)
+		      num (cdr num))))))
+	  (kill-buffer " *panno*")))))
+
+(defun w3-grok-annotation-format (anno)
+  ;; Grab the title from an annotation
+  (let ((fname  (format "%s/PAN-%s.html"
+			w3-personal-annotation-directory anno)))
+    (save-excursion
+      (set-buffer (get-buffer-create " *annotmp*"))
+      (erase-buffer)
+      (if (file-exists-p fname)
+	  (insert-file-contents-literally fname))
+      (goto-char (point-min))
+      (prog1
+	  (if (re-search-forward "<title>\\(.*\\)</title>" nil t)
+	      (buffer-substring (match-beginning 1) (match-end 1))
+	    (concat "Annotation on "
+		    (current-time-string (nth 5 (file-attributes fname)))))
+	(kill-buffer " *annotmp*")))))
+
+(defun w3-is-personal-annotation (url)
+  ;; Is URL a personal annotation?
+  (string-match "file:/.*/PAN-.*\\.html" url))
+
+(defun w3-delete-personal-annotation-internal (url num)
+  (save-excursion
+    (set-buffer (get-buffer-create " *annotmp*"))
+    (erase-buffer)
+    (insert-file-contents-literally (format "%s/LOG"
+					    w3-personal-annotation-directory))
+    (replace-regexp (format "[ \t]+\\b%s\\b[ \t]*" num) " ")
+    (goto-char (point-min))
+    (delete-matching-lines (format "^%s +$" url))
+    (let ((make-backup-files nil)
+	  (version-control nil)
+	  (require-final-newline t))
+      (write-region (point-min) (point-max)
+		    (format "%s/LOG"
+			    w3-personal-annotation-directory)))
+    (kill-buffer " *annotmp*")
+    (let ((anno w3-personal-annotations))
+      (setq w3-personal-annotations nil)
+      (while anno
+	(if (not (string= num (car (car (cdr (car anno))))))
+	    (setq w3-personal-annotations
+		  (cons (car anno) w3-personal-annotations)))
+	(setq anno (cdr anno)))
+      (delete-file (format "%s/PAN-%s.html"
+			   w3-personal-annotation-directory num)))))
+
+(defun w3-delete-personal-annotation ()
+  "Delete a personal annotation."
+  (interactive)
+  (let ((url (url-view-url t)))
+    (cond
+     ((w3-is-personal-annotation (url-view-url t))
+      (let ((num nil)
+	    (annotated-url nil)
+	    (anno w3-personal-annotations))
+	(string-match "file:/.*/PAN-\\(.*\\)\\.html" url)
+	(setq num (match-string 1 url))
+	(while anno
+	  (if (equal num (car (car (cdr (car anno)))))
+	      (setq annotated-url (car (car anno))))
+	  (setq anno (cdr anno)))
+	(if (not annotated-url)
+	    (message "Couldn't find url that this is annotating!")
+	  (w3-delete-personal-annotation-internal annotated-url num)
+	  (w3-quit))))
+     (t
+      (let* ((tmp w3-personal-annotations)
+	     (thelist nil)
+	     (node nil)
+	     (todel nil))
+	(if (not (assoc url tmp))
+	    (message "No personal annotations.")
+	  (while tmp
+	    (setq node (car tmp))
+	    (if (string= (car node) url)
+		(setq thelist (cons (cons (nth 1 (nth 1 node)) "") thelist)))
+	    (setq tmp (cdr tmp)))
+	  (setq todel (completing-read "Delete annotation: " thelist nil t))
+	  ;; WORK ;;
+	  (message "I should delete %s, but can't." todel)))))))
+
+(defun w3-personal-annotation-add ()
+  "Add an annotation to this document."
+  (interactive)
+  (let ((url (url-view-url t))
+	(buf (get-buffer-create "*Personal Annotation*"))
+	(title (read-string "Title: "
+			    (format "Annotation by %s on %s"
+				    (user-real-login-name)
+				    (current-time-string)))))
+    (set-buffer buf)
+    (switch-to-buffer buf)
+    (erase-buffer)
+    (if (and w3-annotation-mode (fboundp w3-annotation-mode))
+	(funcall w3-annotation-mode)
+      (message "%S is undefined, using %s" w3-annotation-mode
+	       default-major-mode)
+      (funcall default-major-mode))
+    (w3-annotation-minor-mode 1)
+    (setq w3-current-annotation (cons url title))
+    (insert "<html>\n"
+	    " <head>\n"
+	    "  <title>" (w3-insert-entities-in-string title) "</title>"
+	    " </head>\n"
+	    "  <h1>" (w3-insert-entities-in-string title) "</h1>\n"
+	    "  <p>\n"
+	    "   <address>" (w3-insert-entities-in-string (user-full-name))
+            (if (stringp url-personal-mail-address)
+                (concat " &lt;" (w3-insert-entities-in-string
+			      url-personal-mail-address) "&gt;")
+              "")
+	    "</address>\n"
+	    "   <address>" (current-time-string) "</address>\n"
+	    "  </p>\n"
+	    "  <pre>\n")
+    (save-excursion
+      (insert "\n\n\n  </pre>\n"
+	      "</html>"))
+    (message "Hit C-cC-c to send this annotation.")))
+
+(defun w3-annotation-minor-mode (&optional arg)
+  "Minimal minor mode for entering annotations.  Just rebinds C-cC-c to
+finish the annotation."
+  (interactive "P")
+  (cond
+   ((null arg) (setq w3-annotation-minor-mode (not w3-annotation-minor-mode)))
+   ((= 0 arg)  (setq w3-annotation-minor-mode nil))
+   (t          (setq w3-annotation-minor-mode t)))
+  (cond
+   ((or w3-running-FSF19 w3-running-xemacs))
+   (t (local-set-key "\C-c\C-c" 'w3-personal-annotation-finish)))
+  )
+
+(defun w3-annotation-find-highest-number ()
+  ;; Find the highest annotation number in this buffer
+  (let (x)
+    (goto-char (point-min))
+    (while (re-search-forward "[^ \t\n]*[ \t]\\(.*\\)" nil t)
+      (setq x (nconc (mapcar (function (lambda (x) (string-to-int (car x))))
+			     (url-split (buffer-substring (match-beginning 1)
+							 (match-end 1))
+				       "[ \t]")) x)))
+    (if (not x) (setq x '(0)))
+    (1+ (car (sort x '>)))))
+
+(defun w3-personal-annotation-finish ()
+  "Finish doing a personal annotation."
+  (interactive)
+  (cond
+   ((or w3-running-FSF19 w3-running-xemacs))
+   (t (local-set-key "\C-c\C-c" 'undefined)))
+  (if (or (not w3-personal-annotation-directory)
+	  (not (file-exists-p w3-personal-annotation-directory))
+	  (not (file-directory-p w3-personal-annotation-directory)))
+      (error "No personal annotation directory!")
+    (let ((url (car w3-current-annotation))
+	  (txt (buffer-string))
+	  (title (cdr w3-current-annotation))
+	  (fname nil)
+	  (num nil))
+      (save-excursion
+	(not-modified)
+	(kill-buffer (current-buffer))
+	(set-buffer (get-buffer-create " *annotmp*"))
+	(erase-buffer)
+	(if (file-exists-p		; Insert current LOG file if
+					; it exists.
+	     (format "%s/LOG" w3-personal-annotation-directory))
+	    (insert-file-contents-literally
+	     (format "%s/LOG" w3-personal-annotation-directory))
+	  (progn			; Otherwise, create a file
+	    (goto-char (point-min))	; that conforms to first
+					; annotation format from NCSA
+	    (insert "ncsa-mosaic-personal-annotation-log-format-1\n")
+	    (insert "Personal\n")))
+	(goto-char (point-min))
+	(setq num (int-to-string (w3-annotation-find-highest-number))
+	      fname (format "%s/PAN-%s.html"
+			    w3-personal-annotation-directory num))
+	(goto-char (point-min))
+	(if (re-search-forward (regexp-quote url) nil t)
+	    (progn
+	      (end-of-line)
+	      (insert " "))
+	  (goto-char (point-max))
+	  (insert "\n" url " "))
+	(insert num)
+	(let ((make-backup-files nil)
+	      (version-control nil)
+	      (require-final-newline t))
+	  (write-region (point-min) (point-max)
+			(format "%s/LOG" w3-personal-annotation-directory))
+	  (erase-buffer)
+	  (insert w3-annotation-marker txt)
+	  (write-region (point-min) (point-max) fname))
+	(setq w3-personal-annotations
+	      (cons (list url (list num title)) w3-personal-annotations))))))
+
+(defun w3-annotation-add ()
+  "Add an annotation to the current document."
+  (interactive)
+  (w3-personal-annotation-add))