xemacs-beta: lisp/w3/w3.el comparison

comparison lisp/w3/w3.el @ 26:441bb1e64a06 r19-15b96

Import from CVS: tag r19-15b96

author	cvs
date	Mon, 13 Aug 2007 08:51:32 +0200
parents	8fc7fe29b841
children	ec9a17fef872

comparison

equal deleted inserted replaced

-:383a494979f8
+:441bb1e64a06
 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
 ;; Author: wmperry
-;; Created: 1997/02/13 23:05:56
+;; Created: 1997/02/20 21:50:57
-;; Version: 1.77
+;; Version: 1.82
 ;; 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.
 	 (fmt  (cdr-safe (assoc "nametemplate" info)))) ; Template for name
 (cond
 (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)))
+(if fmt
-	(setq fmt (concat "%s" (url-file-extension url-current-file))))))
+	  (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
 ((symbolp view)
 (if (not (memq view '(w3-prepare-buffer w3-print w3-source
 					      w3-default-local-file
 					      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))))
 	    (rename-buffer bufnam)
 	    ;; Make the URL show in list-buffers output
 	(funcall view)))
 ((stringp view)
 (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))
 	(setq view (mm-viewer-unescape view fname url))
 	(message "Passing to viewer %s " view)
 (setq url (car command-line-args-left)
 	    command-line-args-left (cdr command-line-args-left)))
 (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) ? )
 (setq url (substring url 1)))
 (cond
 (w3-download-url url))
 (t
 (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)
 	       ((memq w3-reuse-buffers '(no never reload)) t)
 	       ((memq w3-reuse-buffers '(yes reuse always)) nil)
 		 (url-working-buffer (cdr status)))
 	    (if w3-track-last-buffer
 		(setq w3-last-buffer (get-buffer url-working-buffer)))
 	    (if (get-buffer url-working-buffer)
 		(cond
-		 ((and url-be-asynchronous
+		 ((and url-be-asynchronous (not cached))
-		       (not cached))
 		  (save-excursion
 		    (set-buffer url-working-buffer)
 		    (if x
 			(w3-history-push x (url-view-url t)))
 		    (setq w3-current-last-buffer lastbuf)))
 		 (t
 		  (w3-history-push x url)
-		  (w3-sentinel lastbuf)
+		  (w3-sentinel lastbuf)))))
-		  (if (string-match "#\\(.*\\)" url)
-		      (progn
-			(push-mark (point) t)
-			(w3-find-specific-link (match-string 1 url))))))))
 	(if w3-track-last-buffer
 	    (setq w3-last-buffer buf))
 	(let ((w3-notify (if (memq w3-notify '(newframe bully
 					       semibully aggressive))
 			     w3-notify
 "REFERER is the url we followed this link from.  URL is the link we got to."
 (if (not referer)
 (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)
 (defalias 'w3-forward-in-history 'w3-history-forward)
 (set-buffer buff)
 (let* ((url (url-view-url t))
 	     (cur-links w3-current-links)
 	     (title (buffer-name))
 	     (lastmod (or (cdr-safe (assoc "last-modified"
-					   url-current-mime-headers))
+					   url-current-mime-headers))))
-			  (and (member url-current-type '("file" "ftp"))
-			       (nth 5 (url-file-attributes url)))))
 	     (hdrs url-current-mime-headers)
 	     (info w3-current-metainfo))
 	(set-buffer (get-buffer-create url-working-buffer))
-	(setq url-current-can-be-cached nil
+	(setq url-current-can-be-cached nil)
-	      url-current-type "about"
-	      url-current-file "document")
 	(erase-buffer)
 	(cond
 	 ((stringp lastmod) nil)
 	 ((equal '(0 . 0) lastmod) (setq lastmod nil))
 	 ((consp lastmod) (setq lastmod (current-time-string lastmod)))
 "Follow the URL under PT, defaults to link under (point)"
 (interactive "d")
 (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."
 (url-convert-newlines-to-spaces
 (url-strip-leading-spaces
 (defun w3-source-document (under)
 "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)
 	    (error "No URL found!"))
 	   ((and under (null url)) (error "No link at point!"))
 	   ((and (not under) w3-current-source) w3-current-source)
 	   (t
 	    (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))
 	(cond
 	 ((memq w3-reuse-buffers '(no never reload))
 (defun w3-build-continuation ()
 ;; Build a series of functions to be run on this file
 (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)
 	  (setq url-current-mime-viewer
 		(mm-mime-info (or url-current-mime-type
 (defun w3-find-this-file ()
 "Do a find-file on the currently viewed html document if it is a file: or
 ftp: reference"
 (interactive)
-(cond
+(or url-current-object
-((and (or (null url-current-type) (equal url-current-type "file"))
+(error "Not a URL-based buffer"))
-	 (eq major-mode 'w3-mode))
+(let ((type (url-type url-current-object)))
-(find-file url-current-file))
+(cond
-((equal url-current-type "ftp")
+((equal type "file")
-(find-file
+(find-file (url-filename url-current-object)))
-(format "/%s@%s:%s" url-current-user url-current-server
+((equal type "ftp")
-	     url-current-file)))
+(find-file
-(t (message "Sorry, I can't get that file so you can alter it."))))
+(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,
 insert URL under point"
 (interactive "P")
 	 ((not (get-buffer url-working-buffer)) nil)
 	 ((url-mime-response-p) (url-parse-mime-headers)))
 	(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))
 (let ((x (w3-build-continuation))
 ;;; Leftover stuff that didn't quite fit into url.el
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (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
 		  (set-buffer (get-buffer-create " *url-error*"))
 		  (buffer-string))))
 (let ((base (get-text-property (point-min) 'w3-base buffer)))
 (if base
 	(setq base (url-generic-parse-url base)))
 (insert-buffer buffer)
 (if (not base)
-	(setq url-current-type "file"
+	(setq url-current-object
-	      url-current-server nil
+	      (url-generic-parse-url (concat "file:"
-	      url-current-file (buffer-file-name buffer))
+					     (buffer-file-name buffer))))
-(setq url-current-object base
+(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)))))
 (defun w3-internal-url (url)
 ;; Handle internal urls (previewed buffers, etc)
 (if (not (string-match "www:/+\\([^/]+\\)/\\(.*\\)" url))
 (w3-fetch "www://error/")
 (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
 	    (w3-internal-handle-preview data)
 	  (url-retrieve (concat "www://error/nobuf/" data))))
 	(unfocus-frame))
 (display-buffer (find-file-noselect file))))
 (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							    ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun w3-search-forward (string)
 	     (w3-fetch (car possible)))
 	    (otherwise
 	     (w3-fetch (completing-read "Choose an address: "
 					(mapcar 'list possible)
 					nil t (car possible))))))
-(message "Could not automatically determine authors address, sorry.")
+(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))))))))
 (defun w3-kill-emacs-func ()
 "Routine called when exiting emacs.  Do miscellaneous clean up."
 (and (eq url-keep-history t)
 url-global-history-hash-table
 	 (url-inhibit-uncompression t)
 	 (url-mime-accept-string "*/*")
 	 (urlobj (url-generic-parse-url url))
 	 (url-working-buffer
 	  (generate-new-buffer (concat " *" url " download*")))
-	 (stub-fname (url-remove-compressed-extensions
+	 (stub-fname (url-basepath (or (url-filename urlobj) "") t))
-		      (url-basepath (or (url-filename urlobj) "") t)))
+	 (dir (or mm-download-directory "~/"))
-	 (fname (read-file-name "Filename to save as: "
+	 (fname (expand-file-name
-				(or mm-download-directory "~/")
+		 (read-file-name "Filename to save as: "
-				stub-fname
+				 dir
-				nil
+				 stub-fname
-				stub-fname)))
+				 nil
+				 stub-fname) dir)))
 (setq-default url-be-asynchronous t)
 (save-excursion
 (set-buffer url-working-buffer)
 (setq url-current-callback-data (list fname (current-buffer))
 	    url-be-asynchronous t
 				  link-at-point
 				(concat
 				 (substring link-at-point 0 17) "..."))
 			      "): ")
 		    "Link: ") links-alist nil t))
-(if (setq choice (try-completion choice links-alist))
+(let ((match (try-completion choice links-alist)))
-	(w3-fetch (cdr (assoc 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
 display the current buffer as HTML.
 (widget-setup)
 (setq url-current-passwd-count 0
 	    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)
 (require 'url)
 (require 'w3-parse)

Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 26:441bb1e64a06 r19-15b96