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

comparison lisp/w3/w3.el @ 30:ec9a17fef872 r19-15b98

Import from CVS: tag r19-15b98

author	cvs
date	Mon, 13 Aug 2007 08:52:29 +0200
parents	441bb1e64a06
children	e04119814345

comparison

equal deleted inserted replaced

-:7976500f47f9
+:ec9a17fef872
 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
 ;; Author: wmperry
-;; Created: 1997/02/20 21:50:57
+;; Created: 1997/03/07 16:44:12
-;; Version: 1.82
+;; Version: 1.93
 ;; 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.
 			(url-view-url t))
 		    (url-get-url-at-point))))
 url))
 ;;;###autoload
-(defun w3-fetch (&optional url)
+(defun w3-fetch (&optional url target)
 "Retrieve a document over the World Wide Web.
 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))
 					      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)))
+(or target (setq target w3-base-target))
+(if (stringp target)
+(setq target (intern (downcase target))))
+(and target
+(let ((window-distance (cdr-safe (assq target w3-target-window-distances))))
+	 (if (numberp window-distance)
+	     (other-window window-distance)
+	   (error "target %S not found." target))))
 (cond
 ((= (string-to-char url) ?#)
 (w3-relative-link url))
 ((or (and (interactive-p) current-prefix-arg) w3-dump-to-disk)
 (w3-download-url url))
 (save-excursion
 (set-buffer buff)
 (let* ((url (url-view-url t))
 	     (cur-links w3-current-links)
 	     (title (buffer-name))
+	     (case-fold-search t)
+	     (possible-lastmod (save-excursion
+				 (goto-char (point-min))
+				 (if (re-search-forward "^Last modified:\\(.*\\)" nil t)
+				     (buffer-substring (match-beginning 1)
+						       (match-end 1)))))
+	     (attributes (url-file-attributes url))
 	     (lastmod (or (cdr-safe (assoc "last-modified"
-					   url-current-mime-headers))))
+					   url-current-mime-headers))
+			  (nth 5 attributes)))
 	     (hdrs url-current-mime-headers)
+	     (size (or (cdr (assoc "content-length" url-current-mime-headers))
+		       (point-max)))
 	     (info w3-current-metainfo))
 	(set-buffer (get-buffer-create url-working-buffer))
 	(setq url-current-can-be-cached nil)
 	(erase-buffer)
 	(cond
 	 ((stringp lastmod) nil)
-	 ((equal '(0 . 0) lastmod) (setq lastmod nil))
+	 ((equal '(0 . 0) lastmod) (setq lastmod possible-lastmod))
 	 ((consp lastmod) (setq lastmod (current-time-string lastmod)))
-	 (t (setq lastmod nil)))
+	 (t (setq lastmod possible-lastmod)))
 	(insert "<html>\n"
 		" <head>\n"
 		"  <title>Document Information</title>\n"
 		" </head>\n"
 		" <body\n"
 		"  <table border>\n"
 		"   <tr><th colspan=2>Document Information</th></tr>\n"
 		"   <tr><td>Title:</td><td>" title "</td></tr>\n"
 		"   <tr><td>Location:</td><td>" url "</td></tr>\n"
+		"   <tr><td>Size:</td><td>" (url-pretty-length
+					     (if (stringp size)
+						 (string-to-int size)
+					       size)) "</td></tr>\n"
 		"   <tr><td>Last Modified:</td><td>" (or lastmod "None Given")
 		"</td></tr>\n")
 	(if hdrs
 	    (let* ((maxlength (car (sort (mapcar (function (lambda (x)
 							     (length (car x))))
 (defun w3-source-document-at-point ()
 "View source to the document pointed at by link under point"
 (interactive)
 (w3-source-document t))
-(defun w3-my-safe-copy-face (old new locale)
-(let ((fore (face-foreground old))
-	(back (face-background old))
-	(bpxm (face-background-pixmap old))
-	(font (face-font old))
-	(font-spec (get old 'font-specification)))
-(if (color-specifier-p fore)
-	(setq fore (color-name fore)))
-(if (color-specifier-p back)
-	(setq back (color-name back)))
-(if (font-specifier-p font)
-	(setq font (font-name font)))
-(and fore (set-face-foreground new fore locale))
-(and back (set-face-background new back locale))
-(and bpxm (set-face-background-pixmap new bpxm locale))
-(and (or font-spec font) (set-face-font new (or font-spec font) locale))
-new))
 (defun w3-source-document (under)
 "View this document's source"
 (interactive "P")
 (let* ((url (if under (w3-view-this-url) (url-view-url t)))
 			("Formatted Text")
 			("PostScript")
 			("LaTeX Source")
 			)
 		  nil t)))
+	 (case-fold-search t)
 	 (url (cond
 	       ((stringp under) under)
 	       (under (w3-view-this-url t))
 	       (t (url-view-url t))))
 	 (content-type "text/plain; charset=iso-8859-1")
 	      (setq content-type "application/x-latex; charset=iso-8859-1")
 	      (w3-parse-tree-to-latex w3-current-parse url)))
 	    (buffer-string))))
 (funcall w3-mail-command)
 (mail-subject)
-(insert format " from URL " url "\n"
+(if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag)
-	    "Mime-Version: 1.0\n"
+(insert format " from <URL: " url ">")
-	    "Content-transfer-encoding: 8bit\n"
+(insert format " from <URL: " url ">\n"
-	    "Content-type: " content-type)
+"Mime-Version: 1.0\n"
+"Content-transfer-encoding: 8bit\n"
+"Content-type: " content-type))
 (re-search-forward mail-header-separator nil)
 (forward-char 1)
-(insert (if (equal "HTML Source" format)
+(if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag)
-		(format "<BASE HREF=\"%s\">" url) "")
+(insert (format mime-tag-format content-type) "\n"))
-	    str)
+(save-excursion
+(insert str))
+(cond ((equal "HTML Source" format)
+(if (or (search-forward "<head>" nil t)
+		   (search-forward "<html>" nil t))
+	       (insert "\n"))
+(insert (format "<base href=\"%s\">" url))))
 (mail-to)))
 (defun w3-internal-use-history (hist-item)
 ;; Go to the link in the history
 (let ((url (nth 0 hist-item))
 (setq buffer (get-buffer buffer))
 (let ((base (get-text-property (point-min) 'w3-base buffer)))
 (if base
 	(setq base (url-generic-parse-url base)))
 (insert-buffer buffer)
+(let ((inhibit-read-only t))
+(set-text-properties (point-min) (point-max) nil))
 (if (not base)
 	(setq url-current-object
 	      (url-generic-parse-url (concat "file:"
 					     (buffer-file-name buffer))))
 (setq url-current-object base))))
 (while (and x (not found))
 (setq y (car x)
 	    x (cdr x)
 	    found (cdr-safe (assoc "made" y))))
 (if found
-	(let ((possible nil))
+	(let ((possible nil)
+	      (href nil))
 	  (setq x (car found))		; Fallback if no mail(to|server) found
 	  (while found
-	    (if (string-match "^mail[^:]+:" (car found))
+	    (setq href (plist-get (pop found) 'href))
-		(setq possible (cons (car found) possible)))
+	    (if (and href (string-match "^mail[^:]+:" href))
-	    (setq found (cdr found)))
+		(setq possible (cons href possible))))
 	  (case (length possible)
 	    (0				; No mailto links found
 	     (w3-fetch x))		; fall back onto first 'made' link
 	    (1				; Only one found, get it
 	     (w3-fetch (car possible)))
 (setq w3-user-stylesheet nil
 	w3-face-cache nil)
 (w3-find-default-stylesheets)
 )
+(defvar w3-loaded-stylesheets nil
+"A list of all the stylesheets Emacs-W3 loaded at startup.")
 (defun w3-find-default-stylesheets ()
+(setq w3-loaded-stylesheets nil)
 (let* ((lightp (w3-color-light-p 'default))
 	 (longname (if lightp "stylesheet-light" "stylesheet-dark"))
 	 (shortname (if lightp "light.css" "dark.css"))
 	 (directories (list
 		       data-directory
 	    possible (cdr possible)
 	    found (and cur (file-exists-p cur) (file-readable-p cur)
 		       (not (file-directory-p cur)) cur))
 (if found
 	  (setq total-found (1+ total-found)
+		w3-loaded-stylesheets (cons cur w3-loaded-stylesheets)
 		w3-user-stylesheet (css-parse (concat "file:" cur) nil
 				     w3-user-stylesheet))))
 (setq-default url-be-asynchronous old-asynch)
 (if (= 0 total-found)
 	(w3-warn
 	(completion-ignore-case t))
 (setq link-at-point (widget-at (point))
 	  link-at-point (and
 			 link-at-point
 			 (widget-get link-at-point 'href)
+			 (widget-get link-at-point :from)
+			 (widget-get link-at-point :to)
 			 (w3-fix-spaces
 			  (buffer-substring
 			   (widget-get link-at-point :from)
 			   (widget-get link-at-point :to)))))
 (w3-map-links (function
 		   (lambda (widget arg)
-		     (setq links-alist	(cons
+		     (if (and (widget-get widget :from)
-					 (cons
+			      (widget-get widget :to))
-					  (w3-fix-spaces
+			 (setq links-alist (cons
-					   (buffer-substring-no-properties
+					    (cons
-					    (widget-get widget :from)
+					     (w3-fix-spaces
-					    (widget-get widget :to)))
+					      (buffer-substring-no-properties
-					  (widget-get widget 'href))
+					       (widget-get widget :from)
-					 links-alist)))))
+					       (widget-get widget :to)))
+					     (widget-get widget 'href))
+					    links-alist))))))
 (if (not links-alist) (error "No links in current document."))
 (setq links-alist (sort links-alist (function
 					 (lambda (x y)
 					   (string< (car x) (car y))))))
 ;; Destructively remove duplicate entries from links-alist.

Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 30:ec9a17fef872 r19-15b98