diff lisp/w3/w3.el @ 102:a145efe76779 r20-1b3

Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 0d2f883870bc
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/w3/w3.el	Mon Aug 13 09:15:13 2007 +0200
+++ b/lisp/w3/w3.el	Mon Aug 13 09:15:49 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
 ;; Author: wmperry
-;; Created: 1997/02/13 23:05:56
-;; Version: 1.77
+;; Created: 1997/02/20 21:50:57
+;; Version: 1.82
 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -211,8 +211,10 @@
      (fmt nil)
      ((cdr-safe (assoc "type" info))
       (setq fmt (mm-type-to-file (cdr-safe (assoc "type" info))))
-      (if fmt (setq fmt (concat "%s" (car fmt)))
-	(setq fmt (concat "%s" (url-file-extension url-current-file))))))
+      (if fmt
+	  (setq fmt (concat "%s" (car fmt)))
+	(setq fmt (concat "%s" (url-file-extension
+				(url-filename url-current-object)))))))
     (if (null view)
 	(setq view 'indented-text-mode))
     (cond
@@ -222,7 +224,8 @@
 					      mm-multipart-viewer)))
 	  (let ((bufnam (url-generate-new-buffer-name
 			 (file-name-nondirectory
-			  (or url-current-file "Unknown")))))
+			  (or (url-filename url-current-object)
+			      "Unknown")))))
 	    (if (string= bufnam "")
 		(setq bufnam (url-generate-new-buffer-name
 			      (url-view-url t))))
@@ -239,7 +242,7 @@
       (let ((fname (url-generate-unique-filename fmt))
 	    (proc nil))
 	(if (url-file-directly-accessible-p (url-view-url t))
-	    (make-symbolic-link url-current-file fname t)
+	    (make-symbolic-link (url-filename url-current-object) fname t)
 	  (mule-write-region-no-coding-system (point-min) (point-max) fname))
 	(if (get-buffer url-working-buffer)
 	    (kill-buffer url-working-buffer))
@@ -458,7 +461,8 @@
   (if (equal url "") (error "No document specified!"))
   ;; legal use for relative URLs ?
   (if (string-match "^www:[^/].*" url)
-      (setq url (concat (file-name-directory url-current-file)
+      (setq url (concat (file-name-directory (url-filename
+					      url-current-object))
  			(substring url 4))))
   ;; In the common case, this is probably cheaper than searching.
   (while (= (string-to-char url) ? )
@@ -472,8 +476,6 @@
     (let ((x (url-view-url t))
 	  (lastbuf (current-buffer))
 	  (buf (url-buffer-visiting url)))
-      (and x (or (string= "file:nil" x) (string= "" x))
-	   (setq x nil))
       (if (or (not buf)
 	      (cond
 	       ((not (equal (downcase (or url-request-method "GET")) "get")) t)
@@ -497,8 +499,7 @@
 		(setq w3-last-buffer (get-buffer url-working-buffer)))
 	    (if (get-buffer url-working-buffer)
 		(cond
-		 ((and url-be-asynchronous
-		       (not cached))
+		 ((and url-be-asynchronous (not cached))
 		  (save-excursion
 		    (set-buffer url-working-buffer)
 		    (if x
@@ -506,11 +507,7 @@
 		    (setq w3-current-last-buffer lastbuf)))
 		 (t
 		  (w3-history-push x url)
-		  (w3-sentinel lastbuf)
-		  (if (string-match "#\\(.*\\)" url)
-		      (progn
-			(push-mark (point) t)
-			(w3-find-specific-link (match-string 1 url))))))))
+		  (w3-sentinel lastbuf)))))
 	(if w3-track-last-buffer
 	    (setq w3-last-buffer buf))
 	(let ((w3-notify (if (memq w3-notify '(newframe bully 
@@ -576,7 +573,10 @@
       (setq w3-history-stack (list (cons url (current-time))))
     (let ((node (memq (assoc referer w3-history-stack) w3-history-stack)))
       (if node
-	  (setcdr node (list (cons url (current-time))))))))
+	  (setcdr node (list (cons url (current-time))))
+	(setq w3-history-stack (append w3-history-stack
+				       (list
+					(cons url (current-time)))))))))
 
 (defalias 'w3-add-urls-to-history 'w3-history-push)
 (defalias 'w3-backward-in-history 'w3-history-backward)
@@ -634,15 +634,11 @@
 	     (cur-links w3-current-links)
 	     (title (buffer-name))
 	     (lastmod (or (cdr-safe (assoc "last-modified"
-					   url-current-mime-headers))
-			  (and (member url-current-type '("file" "ftp"))
-			       (nth 5 (url-file-attributes url)))))
+					   url-current-mime-headers))))
 	     (hdrs url-current-mime-headers)
 	     (info w3-current-metainfo))
 	(set-buffer (get-buffer-create url-working-buffer))
-	(setq url-current-can-be-cached nil
-	      url-current-type "about"
-	      url-current-file "document")
+	(setq url-current-can-be-cached nil)
 	(erase-buffer)
 	(cond
 	 ((stringp lastmod) nil)
@@ -804,67 +800,6 @@
   (let ((url (url-get-url-at-point pt)))
     (and url (w3-fetch url))))
 
-;;;###autoload
-(defun w3-batch-fetch ()
-  "Fetch all the URLs on the command line and save them to files in
-the current directory.  The first argument after the -f w3-batch-fetch
-on the command line should be a string specifying how to save the
-information retrieved.  If it is \"html\", then the page will be
-unformatted when it is written to disk.  If it is \"text\", then the
-page will be formatted before it is written to disk.  If it is
-\"binary\" it will not mess with the file extensions, and just save
-the data in raw binary format.  If none of those, the default is
-\"text\", and the first argument is treated as a normal URL."
-  (if (not w3-setup-done) (w3-do-setup))
-  (if (not noninteractive)
-      (error "`w3-batch-fetch' is to be used only with -batch"))
-  (let ((fname "")
-        (curname "")
-	(x 0)
-	(args command-line-args-left)
-	(w3-strict-width 80)
-	(retrieval-function 'w3-fetch)
-	(file-format "text")
-	(header "")
-	(file-extn ".txt"))
-    (setq file-format (downcase (car args)))
-    (cond
-     ((string= file-format "html")
-      (message "Saving all text as raw HTML...")
-      (setq retrieval-function 'url-retrieve
-	    file-extn ".html"
-	    header "<BASE HREF=\"%s\">"
-	    args (cdr args)))
-     ((string= file-format "binary")
-      (message "Saving as raw binary...")
-      (setq retrieval-function 'url-retrieve
-	    file-extn ""
-	    args (cdr args)))
-     ((string= file-format "text")
-      (setq header "Text from: %s\n---------------\n")
-      (message "Saving all text as formatted...")
-      (setq args (cdr args)))
-     (t
-      (setq header "Text from: %s\n---------------\n")
-      (message "Going with default, saving all text as formatted...")))
-    (while args
-      (funcall retrieval-function (car args))
-      (goto-char (point-min))
-      (if buffer-read-only (toggle-read-only))
-      (insert (format header (car args)))
-      (setq fname (url-basepath url-current-file t))
-      (if (string= file-extn "") nil
-	(setq fname (url-file-extension fname t)))
-      (if (string= (url-strip-leading-spaces fname) "")
-	  (setq fname "root"))
-      (setq curname fname)
-      (while (file-exists-p (concat curname file-extn))
-	(setq curname (concat fname x)
-	      x (1+ x)))
-      (setq fname (concat curname file-extn))
-      (write-region (point-min) (point-max) fname)
-      (setq args (cdr args)))))
-
 (defun w3-fix-spaces (x)
   "Remove spaces/tabs at the beginning of a string,
 and convert newlines into spaces."
@@ -915,7 +850,6 @@
   "View this document's source"
   (interactive "P")
   (let* ((url (if under (w3-view-this-url) (url-view-url t)))
-	 (fil (if under nil url-current-file))
 	 (src
 	  (cond
 	   ((null url)
@@ -928,7 +862,6 @@
 	    (prog2
 		(url-retrieve url)
 		(buffer-string)
-	      (setq fil (or fil url-current-file))
 	      (kill-buffer (current-buffer))))))
 	 (tmp (url-generate-new-buffer-name url)))
     (if (and url (get-buffer url))
@@ -1091,10 +1024,12 @@
   (save-excursion
     (set-buffer url-working-buffer)
     (let ((cont w3-default-continuation)
-	  (extn (url-file-extension url-current-file)))
+	  (extn (url-file-extension
+		 (url-filename url-current-object))))
       (if (assoc extn url-uncompressor-alist)
 	  (setq extn (url-file-extension
-		      (substring url-current-file 0 (- (length extn))))))
+		      (substring (url-filename url-current-object)
+				 0 (- (length extn))))))
       (if w3-source
 	  (setq url-current-mime-viewer '(("viewer" . w3-source))))
       (if (not url-current-mime-viewer)
@@ -1117,15 +1052,19 @@
   "Do a find-file on the currently viewed html document if it is a file: or
 ftp: reference"
   (interactive)
-  (cond
-   ((and (or (null url-current-type) (equal url-current-type "file"))
-	 (eq major-mode 'w3-mode))
-    (find-file url-current-file))
-   ((equal url-current-type "ftp")
-    (find-file
-     (format "/%s@%s:%s" url-current-user url-current-server
-	     url-current-file)))
-   (t (message "Sorry, I can't get that file so you can alter it."))))
+  (or url-current-object
+      (error "Not a URL-based buffer"))
+  (let ((type (url-type url-current-object)))
+    (cond
+     ((equal type "file")
+      (find-file (url-filename url-current-object)))
+     ((equal type "ftp")
+      (find-file
+       (format "/%s@%s:%s"
+	       (url-user url-current-object)
+	       (url-host url-current-object)
+	       (url-filename url-current-object))))
+     (t (message "Sorry, I can't get that file so you can alter it.")))))
 
 (defun w3-insert-this-url (pref-arg)
   "Insert the current url in another buffer, with prefix ARG,
@@ -1230,7 +1169,8 @@
 	(if (not url-current-mime-type)
 	    (setq url-current-mime-type (or (mm-extension-to-mime
 					     (url-file-extension
-					      url-current-file))
+					      (url-filename
+					       url-current-object)))
 					    "text/html")))))
   (if (not (string-match "^www:" (or (url-view-url t) "")))
       (w3-convert-code-for-mule url-current-mime-type))
@@ -1570,6 +1510,7 @@
 
 (defun w3-generate-error (type data)
   ;; Generate an HTML error buffer for error TYPE with data DATA.
+  (setq url-current-mime-type "text/html")
   (cond
    ((equal type "nofile")
     (let ((error (save-excursion
@@ -1645,15 +1586,10 @@
 	(setq base (url-generic-parse-url base)))
     (insert-buffer buffer)
     (if (not base)
-	(setq url-current-type "file"
-	      url-current-server nil
-	      url-current-file (buffer-file-name buffer))
-      (setq url-current-object base
-	    url-current-type (url-type base)
-	    url-current-user (url-user base)
-	    url-current-port (url-port base)
-	    url-current-server (url-host base)
-	    url-current-file (url-filename base)))))
+	(setq url-current-object
+	      (url-generic-parse-url (concat "file:"
+					     (buffer-file-name buffer))))
+      (setq url-current-object base))))
 
 (defun w3-internal-url (url)
   ;; Handle internal urls (previewed buffers, etc)
@@ -1662,9 +1598,6 @@
     (let ((type (url-match url 1))
 	  (data (url-match url 2)))
       (set-buffer (get-buffer-create url-working-buffer))
-      (setq url-current-type "www"
-	    url-current-server type
-	    url-current-file data)
       (cond
        ((equal type "preview")		; Previewing a document
 	(if (get-buffer data)		; Buffer still exists
@@ -1692,7 +1625,7 @@
 
 (defun w3-default-local-file()
   "Use find-file to open the local file"
-  (w3-ff url-current-file))
+  (w3-ff (url-filename url-current-object)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Mode definition							    ;;;
@@ -1876,12 +1809,7 @@
 	     (w3-fetch (completing-read "Choose an address: "
 					(mapcar 'list possible)
 					nil t (car possible))))))
-      (message "Could not automatically determine authors address, sorry.")
-      (sit-for 1)
-      (w3-fetch (concat "mailto:"
-			(read-string "Email address: "
-				     (if url-current-server
-					 (concat "@" url-current-server))))))))
+      (message "Could not automatically determine authors address, sorry."))))
 
 (defun w3-kill-emacs-func ()
   "Routine called when exiting emacs.  Do miscellaneous clean up."
@@ -2191,13 +2119,14 @@
 	 (urlobj (url-generic-parse-url url))
 	 (url-working-buffer
 	  (generate-new-buffer (concat " *" url " download*")))
-	 (stub-fname (url-remove-compressed-extensions
-		      (url-basepath (or (url-filename urlobj) "") t)))
-	 (fname (read-file-name "Filename to save as: "
-				(or mm-download-directory "~/")
-				stub-fname
-				nil
-				stub-fname)))
+	 (stub-fname (url-basepath (or (url-filename urlobj) "") t))
+	 (dir (or mm-download-directory "~/"))
+	 (fname (expand-file-name
+		 (read-file-name "Filename to save as: "
+				 dir
+				 stub-fname
+				 nil
+				 stub-fname) dir)))
     (setq-default url-be-asynchronous t)
     (save-excursion
       (set-buffer url-working-buffer)
@@ -2292,8 +2221,15 @@
 				 (substring link-at-point 0 17) "..."))
 			      "): ")
 		    "Link: ") links-alist nil t))
-    (if (setq choice (try-completion choice links-alist))
-	(w3-fetch (cdr (assoc choice links-alist))))))
+    (let ((match (try-completion choice links-alist)))
+      (cond
+       ((eq t match)			; We have an exact match
+	(setq choice (cdr (assoc choice links-alist))))
+       ((stringp match)
+	(setq choice (cdr (assoc match links-alist))))
+       (t (setq choice nil)))
+      (if choice
+	  (w3-fetch choice)))))
 
 (defun w3-mode ()
   "Mode for viewing HTML documents.  If called interactively, will
@@ -2320,7 +2256,7 @@
 	    inhibit-read-only nil
 	    truncate-lines t
 	    mode-line-format w3-modeline-format)
-      (if (and w3-current-isindex (equal url-current-type "http"))
+      (if w3-current-isindex
 	  (setq mode-line-process "-Searchable")))))
 
 (require 'mm)