diff lisp/w3/w3.el @ 82:6a378aca36af r20-0b91

Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 1ce6082ce73f
children 821dec489c24
line wrap: on
line diff
--- a/lisp/w3/w3.el	Mon Aug 13 09:06:45 2007 +0200
+++ b/lisp/w3/w3.el	Mon Aug 13 09:07:36 2007 +0200
@@ -1,12 +1,12 @@
 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
 ;; Author: wmperry
-;; Created: 1996/12/30 20:37:55
-;; Version: 1.48
+;; Created: 1997/01/22 15:30:44
+;; Version: 1.60
 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
-;;; Copyright (c) 1996 Free Software Foundation, Inc.
+;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
 ;;;
 ;;; This file is part of GNU Emacs.
 ;;;
@@ -426,6 +426,28 @@
   (split-window)
   (w3-fetch url))
 
+;; Ripped off from red gnus
+(defun w3-find-etc-directory (package &optional file)
+  "Go through the path and find the \".../etc/PACKAGE\" directory.
+If FILE, find the \".../etc/PACKAGE\" file instead."
+  (let ((path load-path)
+	dir result)
+    ;; We try to find the dir by looking at the load path,
+    ;; stripping away the last component and adding "etc/".
+    (while path
+      (if (and (car path)
+	       (file-exists-p
+		(setq dir (concat
+			   (file-name-directory
+			    (directory-file-name (car path)))
+			   "etc/" package 
+			   (if file "" "/"))))
+	       (or file (file-directory-p dir)))
+	  (setq result dir
+		path nil)
+	(setq path (cdr path))))
+    result))
+
 (defun w3-url-completion-function (string predicate function)
   (if (not w3-setup-done) (w3-do-setup))
   (cond
@@ -457,14 +479,15 @@
   (url-do-setup)
   (let* ((completion-ignore-case t)
 	 (default
-	   (if (eq major-mode 'w3-mode)
-	       (if (and current-prefix-arg (w3-view-this-url t))
-		   (w3-view-this-url t)
-		 (url-view-url t))
-	     (url-get-url-at-point)))
+	   (cond
+	    ((null w3-fetch-with-default) nil)
+	    ((eq major-mode 'w3-mode)
+	     (or (and current-prefix-arg (w3-view-this-url t))
+		 (url-view-url t)))
+	    ((url-get-url-at-point)
+	     (url-get-url-at-point))
+	    (t "http://www.")))
 	 (url nil))
-    (if (not default)
-	(setq default "http://www."))
     (setq url
 	  (completing-read "URL: "  'w3-url-completion-function
 			   nil nil default))
@@ -479,13 +502,8 @@
 ;;;###autoload
 (defun w3-fetch (&optional url)
   "Retrieve a document over the World Wide Web.
-The World Wide Web is a global hypertext system started by CERN in
-Switzerland in 1991.
-
-The document should be specified by its fully specified
-Uniform Resource Locator.  The document will be parsed, printed, or
-passed to an external viewer as appropriate.  Variable
-`mm-mime-info' specifies viewers for particular file types."
+Defaults to URL of the current document, if any.
+With prefix argument, use the URL of the hyperlink under point instead."
   (interactive (list (w3-read-url-with-default)))
   (if (not w3-setup-done) (w3-do-setup))
   (if (boundp 'w3-working-buffer)
@@ -962,13 +980,10 @@
   (interactive "P")
   (let* ((url (if under (w3-view-this-url) (url-view-url t)))
 	 (fil (if under nil url-current-file))
-	 (tag '$html-source)		; For the stylesheet info
-	 (args nil)			; For the stylesheet info
-	 (face nil)			; For the stylesheet info
 	 (src
 	  (cond
-	   ((or (null url) (string= url "file:nil"))
-	    (error "Not a w3 buffer!"))
+	   ((null url)
+	    (error "No URL found!"))
 	   ((and under (null url)) (error "No link at point!"))
 	   ((and (not under) (equal url-current-mime-type "text/plain"))
 	    (buffer-string))
@@ -995,12 +1010,14 @@
       (insert src)
       (put-text-property (point-min) (point-max) 'w3-base url)
       (goto-char (point-min))
-      (setq buffer-file-truename nil
-	    buffer-file-name nil)
+      (setq buffer-file-truename url
+	    buffer-file-name url)
       ;; Null filename bugs `set-auto-mode' in Mule ...
       (condition-case ()
  	  (set-auto-mode)
 	(error nil))
+      (setq buffer-file-truename nil
+	    buffer-file-name nil)
       (buffer-enable-undo)
       (set-buffer-modified-p nil)
       (w3-notify-when-ready (get-buffer tmp))))
@@ -1288,16 +1305,15 @@
   "Convert current data into the appropriate coding system"
   (and (or (not mmtype)
 	   (member mmtype w3-mime-list-for-code-conversion))
-       (let* ((c (mule-detect-coding-version (point-min) (point-max)))
-	      (code (or (and (listp c) (car c)) c)))
-	 (mule-code-convert-region (point-min) (point-max) code))))
+       (mule-code-convert-region
+	(point-min) (point-max)
+	(mule-detect-coding-version (point-min) (point-max)))))
 
 (defun w3-sentinel (&optional proc string)
   (set-buffer url-working-buffer)
   (if (or (stringp proc)
 	  (bufferp proc)) (setq w3-current-last-buffer proc))
-  (if (boundp 'after-change-functions)
-      (remove-hook 'after-change-functions 'url-after-change-function))
+  (remove-hook 'after-change-functions 'url-after-change-function)
   (if url-be-asynchronous
       (progn
 	(url-clean-text)
@@ -1324,39 +1340,50 @@
 (defun w3-save-as (&optional type)
   "Save a document to the local disk"
   (interactive)
-  (let* ((completion-ignore-case t)
-	 (format (or type (completing-read
-			   "Format: "
-			   '(("HTML Source") ("Formatted Text")
-			     ("LaTeX Source") ("Binary"))
-			   nil t)))
-	(fname (expand-file-name
-		(read-file-name "File name: " default-directory)))
-	(url (url-view-url t)))
-    (cond
-     ((equal "Binary" format)
-      (if (not w3-current-source)
-	  (let ((url-be-asynchronous nil))
-	    (url-retrieve url))))
-     ((equal "HTML Source" format)
-      (if (not w3-current-source)
-	  (let ((url-be-asynchronous nil))
-	    (url-retrieve url))		; Get the document if necessary
-	(let ((txt w3-current-source))
-	  (set-buffer (get-buffer-create url-working-buffer))
-	  (erase-buffer)
-	  (insert txt)))
-      (goto-char (point-min))
-      (if (re-search-forward "<head>" nil t)
-	  (insert "\n"))
-      (insert (format "<BASE HREF=\"%s\">\n" url)))
-     ((or (equal "Formatted Text" format)
-	  (equal "" format))
-      nil)				; Do nothing - we have the text already
-     ((equal "LaTeX Source" format)
-      (w3-parse-tree-to-latex w3-current-parse url)
-      (insert-buffer url-working-buffer)))
-    (write-region (point-min) (point-max) fname)))
+  (save-excursion
+    (let* ((completion-ignore-case t)
+	   (format (or type (completing-read
+			     "Format: "
+			     '(("HTML Source")
+			       ("Formatted Text")
+			       ("LaTeX Source")
+			       ("PostScript")
+			       ("Binary"))
+			     nil t)))
+	   (fname (expand-file-name
+		   (read-file-name "File name: " default-directory)))
+	   (url (url-view-url t)))
+      (cond
+       ((equal "Binary" format)
+	(if (not w3-current-source)
+	    (let ((url-be-asynchronous nil))
+	      (url-retrieve url))))
+       ((equal "HTML Source" format)
+	(if (not w3-current-source)
+	    (let ((url-be-asynchronous nil))
+	      (url-retrieve url))	; Get the document if necessary
+	  (let ((txt w3-current-source))
+	    (set-buffer (get-buffer-create url-working-buffer))
+	    (erase-buffer)
+	    (insert txt)))
+	(goto-char (point-min))
+	(if (re-search-forward "<head>" nil t)
+	    (insert "\n"))
+	(insert (format "<BASE HREF=\"%s\">\n" url)))
+       ((or (equal "Formatted Text" format)
+	    (equal "" format))
+	nil)				; Do nothing - we have the text already
+       ((equal "PostScript" format)
+	(let ((ps-spool-buffer-name " *w3-temp*"))
+	  (if (get-buffer ps-spool-buffer-name)
+	      (kill-buffer ps-spool-buffer-name))
+	  (w3-print-with-ps-print (current-buffer)
+				  'ps-spool-buffer-with-faces)
+	  (set-buffer ps-spool-buffer-name)))
+       ((equal "LaTeX Source" format)
+	(w3-parse-tree-to-latex w3-current-parse url)
+	(insert-buffer url-working-buffer)))
+      (write-region (point-min) (point-max) fname))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2208,7 +2235,7 @@
   (add-minor-mode 'w3-annotation-minor-mode " Annotating"
 		  w3-annotation-minor-mode-map)
   (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx"
-		  w3-annotation-minor-mode-map)
+		  w3-lynx-emulation-minor-mode-map)
   
   (setq url-package-version w3-version-number
 	url-package-name "Emacs-W3")
@@ -2431,9 +2458,8 @@
 				 (substring link-at-point 0 17) "..."))
 			      "): ")
 		    "Link: ") links-alist nil t))
-    (if (string= choice "")
-	(w3-follow-link)
-      (w3-fetch (cdr (assoc choice links-alist))))))
+    (if (setq choice (try-completion choice links-alist))
+	(w3-fetch (cdr (assoc choice links-alist))))))
 
 (defun w3-mode ()
   "Mode for viewing HTML documents.  If called interactively, will