Mercurial > hg > xemacs-beta
diff lisp/w3/w3-annotat.el @ 20:859a2309aef8 r19-15b93
Import from CVS: tag r19-15b93
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:05 +0200 |
parents | 0293115a14e9 |
children | 131b0175ea99 |
line wrap: on
line diff
--- a/lisp/w3/w3-annotat.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/w3-annotat.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,281 +0,0 @@ -;;; w3-annotat.el --- Annotation functions for Emacs-W3 -;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.6 -;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Emacs. -;;; -;;; 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, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, 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>" (url-insert-entities-in-string title) "</title>" - " </head>\n" - " <h1>" (url-insert-entities-in-string title) "</h1>\n" - " <p>\n" - " <address>" (url-insert-entities-in-string (user-full-name)) - (if (stringp url-personal-mail-address) - (concat " <" (url-insert-entities-in-string - url-personal-mail-address) ">") - "") - "</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))