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

comparison lisp/w3/w3.el @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91

author	cvs
date	Mon, 13 Aug 2007 08:49:20 +0200
parents	9ee227acff29
children	859a2309aef8

comparison

equal deleted inserted replaced

-:ad457d5f7d04
+:0293115a14e9
 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
 ;; Author: wmperry
-;; Created: 1996/12/30 20:37:55
+;; Created: 1997/01/29 06:25:59
-;; Version: 1.48
+;; Version: 1.61
 ;; 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.
 ;;;
 ;;; 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
 to disk."
 (interactive (list (w3-read-url-with-default)))
 (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
 ((eq function nil)
 (let ((list nil))
 (defun w3-read-url-with-default ()
 (url-do-setup)
 (let* ((completion-ignore-case t)
 	 (default
-	   (if (eq major-mode 'w3-mode)
+	   (cond
-	       (if (and current-prefix-arg (w3-view-this-url t))
+	    ((null w3-fetch-with-default) nil)
-		   (w3-view-this-url t)
+	    ((eq major-mode 'w3-mode)
-		 (url-view-url t))
+	     (or (and current-prefix-arg (w3-view-this-url t))
-	     (url-get-url-at-point)))
+		 (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))
 (if (string= url "")
 	(setq url (if (eq major-mode 'w3-mode)
 url))
 ;;;###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
+Defaults to URL of the current document, if any.
-Switzerland in 1991.
+With prefix argument, use the URL of the hyperlink under point instead."
-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."
 (interactive (list (w3-read-url-with-default)))
 (if (not w3-setup-done) (w3-do-setup))
 (if (boundp 'w3-working-buffer)
 (setq w3-working-buffer url-working-buffer))
 (if (and (boundp 'command-line-args-left)
 (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))
-	 (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"))
+	   ((null url)
-	    (error "Not a w3 buffer!"))
+	    (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))
 	   ((and (not under) w3-current-source) w3-current-source)
 	   (t
 (if (not url) nil
 (set-buffer (get-buffer-create tmp))
 (insert src)
 (put-text-property (point-min) (point-max) 'w3-base url)
 (goto-char (point-min))
-(setq buffer-file-truename nil
+(setq buffer-file-truename url
-	    buffer-file-name nil)
+	    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))))
 (run-hooks 'w3-source-file-hook))
 (defun w3-convert-code-for-mule (mmtype)
 "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)))
+(mule-code-convert-region
-	      (code (or (and (listp c) (car c)) c)))
+	(point-min) (point-max)
-	 (mule-code-convert-region (point-min) (point-max) code))))
+	(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)
 	(cond
 	 ((not (get-buffer url-working-buffer)) nil)
 (w3-fetch "www://auto/history"))
 (defun w3-save-as (&optional type)
 "Save a document to the local disk"
 (interactive)
-(let* ((completion-ignore-case t)
+(save-excursion
-	 (format (or type (completing-read
+(let* ((completion-ignore-case t)
-			   "Format: "
+	   (format (or type (completing-read
-			   '(("HTML Source") ("Formatted Text")
+			     "Format: "
-			     ("LaTeX Source") ("Binary"))
+			     '(("HTML Source")
-			   nil t)))
+			       ("Formatted Text")
-	(fname (expand-file-name
+			       ("LaTeX Source")
-		(read-file-name "File name: " default-directory)))
+			       ("PostScript")
-	(url (url-view-url t)))
+			       ("Binary"))
-(cond
+			     nil t)))
-((equal "Binary" format)
+	   (fname (expand-file-name
-(if (not w3-current-source)
+		   (read-file-name "File name: " default-directory)))
-	  (let ((url-be-asynchronous nil))
+	   (url (url-view-url t)))
-	    (url-retrieve url))))
+(cond
-((equal "HTML Source" format)
+((equal "Binary" format)
-(if (not w3-current-source)
+	(if (not w3-current-source)
-	  (let ((url-be-asynchronous nil))
+	    (let ((url-be-asynchronous nil))
-	    (url-retrieve url))		; Get the document if necessary
+	      (url-retrieve url))))
-	(let ((txt w3-current-source))
+((equal "HTML Source" format)
-	  (set-buffer (get-buffer-create url-working-buffer))
+	(if (not w3-current-source)
-	  (erase-buffer)
+	    (let ((url-be-asynchronous nil))
-	  (insert txt)))
+	      (url-retrieve url))	; Get the document if necessary
-(goto-char (point-min))
+	  (let ((txt w3-current-source))
-(if (re-search-forward "<head>" nil t)
+	    (set-buffer (get-buffer-create url-working-buffer))
-	  (insert "\n"))
+	    (erase-buffer)
-(insert (format "<BASE HREF=\"%s\">\n" url)))
+	    (insert txt)))
-((or (equal "Formatted Text" format)
+	(goto-char (point-min))
-	  (equal "" format))
+	(if (re-search-forward "<head>" nil t)
-nil)				; Do nothing - we have the text already
+	    (insert "\n"))
-((equal "LaTeX Source" format)
+	(insert (format "<BASE HREF=\"%s\">\n" url)))
-(w3-parse-tree-to-latex w3-current-parse url)
+((or (equal "Formatted Text" format)
-(insert-buffer url-working-buffer)))
+	    (equal "" format))
-(write-region (point-min) (point-max) fname)))
+	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))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Functions to parse out <A> tags and replace it with a hyperlink zone
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (add-minor-mode 'w3-netscape-emulation-minor-mode " NS"
 		  w3-netscape-emulation-minor-mode-map)
 (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")
 (w3-emit-image-warnings-if-necessary)
 				  link-at-point
 				(concat
 				 (substring link-at-point 0 17) "..."))
 			      "): ")
 		    "Link: ") links-alist nil t))
-(if (string= choice "")
+(if (setq choice (try-completion choice links-alist))
-	(w3-follow-link)
+	(w3-fetch (cdr (assoc choice links-alist))))))
-(w3-fetch (cdr (assoc choice links-alist))))))
 (defun w3-mode ()
 "Mode for viewing HTML documents.  If called interactively, will
 display the current buffer as HTML.
 (w3-mode-version-specifics)
 (w3-menu-install-menus)
 (run-hooks 'w3-mode-hook)
 (widget-setup)
 (setq url-current-passwd-count 0
+	    truncate-lines t
 	    mode-line-format w3-modeline-format)
 (if (and w3-current-isindex (equal url-current-type "http"))
 	  (setq mode-line-process "-Searchable")))))
 (require 'mm)

Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 16:0293115a14e9 r19-15b91