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

comparison lisp/w3/w3.el @ 14:9ee227acff29 r19-15b90

Import from CVS: tag r19-15b90

author	cvs
date	Mon, 13 Aug 2007 08:48:42 +0200
parents	ac2d302a0011
children	0293115a14e9

comparison

equal deleted inserted replaced

-:13c6d0aaafe5
+:9ee227acff29
 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
 ;; Author: wmperry
-;; Created: 1996/08/19 03:30:47
+;; Created: 1996/12/30 20:37:55
-;; Version: 1.22
+;; Version: 1.48
 ;; 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.
 ;;;
-;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;; 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
 ;;; the Free Software Foundation; either version 2, or (at your option)
 ;;; any later version.
 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;;; GNU General Public License for more details.
 ;;;
 ;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; This is a major mode for browsing documents written in Hypertext Markup ;;;
 ;;; Language (HTML).  These documents are typicallly part of the World Wide ;;;
 					   (expand-file-name
 					    name (car p2)))))))))))
 )
-(load-library "w3-sysdp")
+(require 'w3-sysdp)
+(require 'mule-sysdp)
 (or (featurep 'efs)
 (featurep 'efs-auto)
 (condition-case ()
 	(require 'ange-ftp)
 (error nil)))
 (require 'cl)
+(require 'css)
 (require 'w3-vars)
 (eval-and-compile
-(require 'w3-draw))
+(require 'w3-display))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Code for printing out roman numerals
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 	    (funcall view)
 	    (w3-notify-when-ready bufnam))
 	(funcall view)))
 ((stringp view)
 (let ((fname (url-generate-unique-filename fmt))
-	    (proc nil)
+	    (proc nil))
-	    (file-coding-system url-mule-no-coding-system))
 	(if (url-file-directly-accessible-p (url-view-url t))
 	    (make-symbolic-link url-current-file fname t)
-	  (write-region (point-min) (point-max) fname))
+	  (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 proc (w3-start-viewer fname view))
 			      nil
 			      (url-remove-compressed-extensions
 			       (file-name-nondirectory (url-view-url t)))))
 	(require-final-newline nil))
 (set-buffer old-buff)
-(let ((mc-flag t)
+(mule-write-region-no-coding-system (point-min) (point-max) file)
-	  (file-coding-system url-mule-no-coding-system))
-(write-region (point-min) (point-max) file))
 (kill-buffer (current-buffer))))
 (defun w3-build-url (protocol)
 "Build a url for PROTOCOL, return it as a string"
 (interactive (list (cdr (assoc (completing-read
 It will prompt for an existing file or directory, and retrieve it as a
 hypertext document.  If it is a directory, and url-use-hypertext-dired
 is non-nil, then an HTML directory listing is created on the fly.
 Otherwise, dired-mode is used to visit the buffer."
 (interactive "FLocal file: ")
+(setq fname (expand-file-name fname))
 (if (not w3-setup-done) (w3-do-setup))
 (w3-fetch (concat "file:" fname)))
 ;;;###autoload
 (defun w3-find-file (fname)
 (w3-fetch url))
 (defun w3-url-completion-function (string predicate function)
 (if (not w3-setup-done) (w3-do-setup))
 (cond
-((null function)
+((eq function nil)
-(cond
+(let ((list nil))
-((get 'url-gethash 'sysdep-defined-this)
+(cl-maphash (function (lambda (key val)
-;; Cheat!  If we know that these are the sysdep-defined version
+			      (setq list (cons (cons key val)
-;; of hashtables, they are an obarray.
+					       list))))
-(try-completion string url-global-history-hash-table predicate))
+		  url-global-history-hash-table)
-((url-hashtablep url-global-history-hash-table)
+(try-completion string (nreverse list) predicate)))
-(let ((list nil))
-	(url-maphash (function (lambda (key val)
-				 (setq list (cons (cons (symbol-name key) val)
-						  list))))
-		     url-global-history-hash-table)
-	(try-completion string (nreverse list) predicate)))
-(t nil)))
 ((eq function t)
-(cond
+(let ((stub (concat "^" (regexp-quote string)))
-((get 'url-gethash 'sysdep-defined-this)
+	  (retval nil))
-;; Cheat!  If we know that these are the sysdep-defined version
+(cl-maphash
-;; of hashtables, they are an obarray.
+(function
-(all-completions string url-global-history-hash-table predicate))
+	(lambda (url time)
-((url-hashtablep url-global-history-hash-table)
+	  (if (string-match stub url)
-(let ((stub (concat "^" (regexp-quote string)))
+	      (setq retval (cons url retval)))))
-	    (retval nil))
+url-global-history-hash-table)
-	(url-maphash
+retval))
-	 (function
-	  (lambda (url time)
-	    (setq url (symbol-name url))
-	    (if (string-match stub url)
-		(setq retval (cons url retval)))))
-	 url-global-history-hash-table)
-	retval))
-(t nil)))
 ((eq function 'lambda)
-(and (url-hashtablep url-global-history-hash-table)
+(and url-global-history-hash-table
-	 (url-gethash string url-global-history-hash-table)
+	 (cl-gethash string url-global-history-hash-table)
-	 t))))
+	 t))
+(t
+(error "w3-url-completion-function very confused."))))
 (defun w3-read-url-with-default ()
 (url-do-setup)
 (let* ((completion-ignore-case t)
 	 (default
 		       (prin1-to-string w3-reuse-buffers))
 		      (sit-for 2)))
 		(not (funcall url-confirmation-func
 			      (format "Reuse URL in buffer %s? "
 				      (buffer-name buf)))))))
-	  (let ((cached (url-retrieve url)))
+	  (let* ((status (url-retrieve url))
+		 (cached (car status))
+		 (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 (string-match "^http:" url)
+		 ((and url-be-asynchronous
 		       (not cached))
 		  (save-excursion
 		    (set-buffer url-working-buffer)
 		    (if x
 			(w3-add-urls-to-history x (url-view-url t)))
 		    (setq w3-current-last-buffer lastbuf)))
 		 (t
 		  (w3-add-urls-to-history x url)
-		  (w3-sentinel lastbuf)))))
+		  (w3-sentinel lastbuf)
+		  ))))
 	(if w3-track-last-buffer
 	    (setq w3-last-buffer buf))
 	(let ((w3-notify (if (memq w3-notify '(newframe bully
 					       semibully aggressive))
 			     w3-notify
 	     (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)))))
-	     (hdrs 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")
 	(erase-buffer)
 	(insert "<html>\n"
 		" <head>\n"
 		"  <title>Document Information</title>\n"
 		" </head>\n"
 		" <body\n"
-		"  <h1 align=\"center\">Document Information</h1>\n"
+		"  <table border>\n"
-		"  <hr>\n"
+		"   <tr><th colspan=2>Document Information</th></tr>\n"
-		"  <pre>\n"
+		"   <tr><td>Title:</td><td>" title "</td></tr>\n"
-		"           Title: " title "\n"
+		"   <tr><td>Location:</td><td>" url "</td></tr>\n"
-		"        Location: " url "\n"
+		"   <tr><td>Last Modified:</td><td>" (or lastmod "None Given")
-		"   Last Modified: " (or lastmod "None Given") "\n"
+		"</td></tr>\n")
-		"  </pre>\n")
 	(if hdrs
 	    (let* ((maxlength (car (sort (mapcar (function (lambda (x)
 							     (length (car x))))
 						 hdrs)
 					 '>)))
-		   (fmtstring (format "%%%ds: %%s" maxlength)))
+		   (fmtstring (format "   <tr><td align=right>%%%ds:</td><td>%%s</td></tr>" maxlength)))
-	      (insert "  <hr label=\" MetaInformation \" textalign=\"left\">\n"
+	      (insert "  <tr><th>MetaInformation</th></tr>\n"
-		      "  <pre>\n"
 		      (mapconcat
 		       (function
 			(lambda (x)
 			  (if (/= (length (car x)) 0)
 			      (format fmtstring
 					  (int-to-string (cdr x))
 					(cdr x))))))
 		       (sort hdrs
 			     (function
 			      (lambda (x y) (string-lessp (car x) (car y)))))
-		       "\n")
+		       "\n"))))
-		      "  </pre>\n")))
-	(if cur-links
+	;; FIXME!!! Need to reimplement showing rel/rev links for the new
-	    (while cur-links
+	;; storage format.
-	      (let* ((tmp (car cur-links))
-		     (label (car tmp))
+	(if info
-		     (nodes (cdr tmp))
+	    (let* ((maxlength (car (sort (mapcar (function (lambda (x)
-		     (links nil)
+							     (length (car x))))
-		     (maxlength (car (sort (mapcar
+						 info)
-					    (function (lambda (x)
+					 '>)))
-							(length (car x))))
+		   (fmtstring (format "   <tr><td>%%%ds:</td><td>%%s</td></tr>" maxlength)))
-						   nodes)
+	      (insert "   <tr><th>Miscellaneous Variables</th></tr>\n")
-					   '>)))
+	      (while info
-		     (fmtstring (format "%%%ds: %%s" maxlength)))
+		(insert (format fmtstring (capitalize (caar info))
-		(insert "  \n"
+				(cdar info)) "\n")
-			"  <hr width=\"50%\" label=\" "
+		(setq info (cdr info))
-			label " \" align=\"left\" textalign=\"left\">\n"
+		)
-			"  <pre>\n")
+	      )
-		(while nodes
+	  )
-		  (setq label (car (car nodes))
+	(insert "  </table>\n"
-			links (cdr (car nodes))
+		" </body>\n"
-			nodes (cdr nodes))
-		  (while links
-		    (insert (format "  %15s -- <a href=\"%s\">%s</a>\n"
-				    label (car links) (car links)))
-		    (setq links (cdr links)
-			  label "")))
-		(insert "  </pre>\n"))
-	      (setq cur-links (cdr cur-links))))
-	(insert " </body>\n"
 		"</html>\n")))))
 (defun w3-truncate-menu-item (string)
 (if (<= (length string) w3-max-menu-width)
 string
 (interactive)
 (setq w3-setup-done nil
 	url-setup-done nil
 	w3-hotlist nil
 	url-mime-accept-string nil)
-(let ((x '(w3 w3-mule w3-e19 w3-xem20 mm url w3-xemac w3-toolbar font)))
+(let ((x '(w3 mule-sysdp w3-e19 mm url w3-xemac w3-toolbar font)))
 (while x
 (setq features (delq (car x) features)
 	    x (cdr x)))
 (require 'w3))
 (w3-do-setup)
 	  (setq url nil))
 	 ((funcall url-confirmation-func
 		   (concat "Source for " url " found, reuse? "))
 	  (w3-notify-when-ready (get-buffer url)))))
 (if (not url) nil
-(setq face (and w3-current-stylesheet (cdr (w3-face-for-element))))
 (set-buffer (get-buffer-create tmp))
 (insert src)
-(put-text-property (point-min) (point-max) 'face face)
 (put-text-property (point-min) (point-max) 'w3-base url)
 (goto-char (point-min))
 (setq buffer-file-truename nil
 	    buffer-file-name nil)
 ;; Null filename bugs `set-auto-mode' in Mule ...
 (setq list-buffers-directory (url-view-url t))
 (set-buffer-modified-p nil)
 (buffer-enable-undo)
 (w3-notify-when-ready (get-buffer tmp))))
+(defvar w3-mime-list-for-code-conversion
+'("text/plain" "text/html")
+"List of MIME types that require Mules' code conversion.")
+(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)))
+	      (code (or (and (listp c) (car c)) c)))
+	 (mule-code-convert-region (point-min) (point-max) code))))
 (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)
 	(if (not url-current-mime-type)
 	    (setq url-current-mime-type (or (mm-extension-to-mime
 					     (url-file-extension
 					      url-current-file))
 					    "text/html")))))
-(let ((x (w3-build-continuation))
+(if (not (string-match "^www:" (or (url-view-url t) "")))
-	(done-mule-conversion nil))
+(w3-convert-code-for-mule url-current-mime-type))
+(let ((x (w3-build-continuation)))
 (while x
-(if (and (featurep 'mule) (not (eq 'url-uncompress (car x)))
+(funcall (pop x)))))
-	       (not done-mule-conversion))
-	  (progn
-(if (string-match "^www:" (url-view-url t))
-(setq w3-mime-list-for-code-conversion nil))
-	    (w3-convert-code-for-mule url-current-mime-type)
-	    (setq done-mule-conversion t)))
-(funcall (car x))
-(setq x (cdr x)))))
 (defun w3-show-history-list ()
 "Format the url-history-list prettily and show it to the user"
 (interactive)
 (w3-fetch "www://auto/history"))
 (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)
 (error "WinEmacs no longer supported."))
 (w3-running-xemacs (require 'w3-xemac))
 (w3-running-FSF19  (require 'w3-e19))
 (t
 (error "Unable to determine the capabilities of this emacs.")))
-(cond
+(if (featurep 'emacspeak)
-((boundp 'MULE)
+(condition-case ()
-(require 'w3-mule))
+	  (progn
-((featurep 'mule)
+	    (require 'dtk-css-speech)
-(require 'w3-xem20)
+	    (require 'w3-speak))))
-))
 (condition-case ()
 (require 'w3-site-init)
 (error nil)))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 new))
 (defun w3-search ()
 "Perform a search, if this is a searchable index."
 (interactive)
-(or w3-current-isindex
-(error "Not a searchable index (via <isindex>)"))
 (let* (querystring			; The string to send to the server
 	 (data
 	  (cond
 	   ((null w3-current-isindex)
-	    (let ((rels (mapcar
+	    (let ((rels (cdr-safe (assq 'rel w3-current-links)))
-			 (function
+		  val cur)
-			  (lambda (data)
-			    (if (assoc "rel" data) data)))
-			 w3-current-links))
-		  val)
 	      (while rels
-		(if (string-match "useindex"
+		(setq cur (car rels)
-				  (or (cdr (assoc "rel" (car rels))) ""))
+		      rels (cdr rels))
-		    (setq val (cdr (assoc "href" (car rels)))
+		(if (and (or (string-match "^isindex$" (car cur))
+			     (string-match "^index$" (car cur)))
+			 (plist-get (cadr cur) 'href))
+		    (setq val (plist-get (cadr cur) 'href)
 			  rels nil))
-		(setq rels (cdr rels)))
+		)
-	      (cons val "Search on (+ separates keywords): ")))
+	      (if val
+		  (cons val "Search on (+ separates keywords): "))))
 	   ((eq w3-current-isindex t)
 	    (cons (url-view-url t) "Search on (+ separates keywords): "))
 	   ((consp w3-current-isindex)
 	    w3-current-isindex)
 	   (t nil)))
 	(url-retrieve "www://error/nohist")
 (insert "<html>\n\t<head>\n\t\t"
 	      "<title> History List For This Session of W3</title>"
 	      "\n\t</head>\n\t<body>\n\t\t<div>\n\t\t\t<h1>"
 	      "History List For This Session of W3</h1>\n\t\t\t<ol>\n")
-(url-maphash
+(cl-maphash
 (function
 	(lambda (url desc)
 	  (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a>\n"
 			  url (url-insert-entities-in-string desc)))))
 url-history-list)
 (let ((x w3-current-links)
 	(y nil)
 	(found nil))
 (setq found (cdr-safe (assoc "reply-to" url-current-mime-headers)))
 (if (and found (not (string-match url-nonrelative-link found)))
-	(setq found (concat "mailto:" found)))
+	(setq found (list (concat "mailto:" found))))
 (while (and x (not found))
 (setq y (car x)
 	    x (cdr x)
 	    found (cdr-safe (assoc "made" y))))
 (if found
 WIDGET and MAPARG.
 The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of
 BUFFER, the end of BUFFER, nil, and (current-buffer), respectively."
 (let ((cur (point-min))
 	(widget nil)
-	(url nil))
+	(parent nil))
 (while (setq cur (next-single-property-change cur 'button))
-(setq widget (widget-at cur))
+(setq widget (widget-at cur)
+	    parent (and widget (widget-get widget :parent)))
 ;; Check to see if its a push widget, its got the correct callback,
 ;; and actually has a URL.  Remember the url as a side-effect of the
 ;; test for later use.
-(if (and (eq (car widget) 'push)
+(cond
-	       (eq (widget-get widget :notify) 'w3-follow-hyperlink)
+((and widget (widget-get widget 'href))
-	       (setq url (widget-get widget 'href)))
+	(funcall function widget maparg))
-	  (funcall function widget maparg)))))
+((and parent (widget-get parent 'href))
+	(funcall function parent maparg))
+(t nil)))))
 (defun w3-emit-image-warnings-if-necessary ()
 (if (and (not w3-delay-image-loads)
 	   (fboundp 'w3-insert-graphic)
 	   (or (not (featurep 'gif))
 "Reload all stylesheets."
 (interactive)
 (setq w3-user-stylesheet nil
 	w3-face-cache nil)
 (w3-find-default-stylesheets)
-(w3-style-post-process-stylesheet w3-user-stylesheet))
+)
 (defun w3-find-default-stylesheets ()
 (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
 		       (concat data-directory "w3/")
+		       (expand-file-name "../../w3" data-directory)
 		       (file-name-directory (locate-library "w3"))
 		       w3-configuration-directory))
 	 (total-found 0)
 	 (possible (append
 		    (apply
 	    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-user-stylesheet (car
+		w3-user-stylesheet (css-parse (concat "file:" cur) nil
-				    (w3-style-parse-css
+				     w3-user-stylesheet))))
-				     (concat "file:" cur) nil
-				     w3-user-stylesheet)))))
 (setq-default url-be-asynchronous old-asynch)
 (if (= 0 total-found)
 	(w3-warn
 	 'style
 	 (concat
 (run-hooks 'w3-load-hook)
 (setq w3-setup-done t))
 (defun w3-mark-link-as-followed (ext dat)
 ;; Mark a link as followed
-(let* ((st (w3-zone-start ext))
+(message "Reimplement w3-mark-link-as-followed"))
-	 (nd (w3-zone-end ext))
-	 (tag 'a)
-	 (args (list (cons 'class "visited")))
-	 (face (cdr (w3-face-for-element))))
-(w3-add-zone st nd face dat t)))
 (defun w3-only-links ()
 (let* (result temp)
 (if (widget-at (point-min))
 	(setq result (list (widget-at (point-min)))))
 	(set-buffer buff)
 	(let ((require-final-newline nil)
 	      (file-name-handler-alist nil)
 	      (write-file-hooks nil)
 	      (write-contents-hooks nil)
-	      (mc-flag t)
+	      (enable-multibyte-characters t) ; mule 2.4
-	      (file-coding-system url-mule-no-coding-system))
+	      (buffer-file-coding-system mule-no-coding-system) ; mule 2.4
+	      (file-coding-system mule-no-coding-system) ; mule 2.3
+	      (mc-flag t))		; mule 2.3
 	  (write-file fname)
 	  (message "Download of %s complete." (url-view-url t))
 	  (sit-for 3)
 	  (kill-buffer buff)))))
 ((or p w3-dump-to-disk)
 (w3-download-url href))
 (t
 (w3-fetch href)))))
+;;; FIXME!  Need to rewrite these so that we can pass a predicate to
+(defun w3-widget-forward (arg)
+"Move point to the next field or button.
+With optional ARG, move across that many fields."
+(interactive "p")
+(widget-forward arg))
+(defun w3-widget-backward (arg)
+"Move point to the previous field or button.
+With optional ARG, move across that many fields."
+(interactive "p")
+(w3-widget-forward (- arg)))
 (defun w3-complete-link ()
 "Choose a link from the current buffer and follow it"
 (interactive)
 (let (links-alist
 	link-at-point
 	  link-at-point (and
 			 link-at-point
 			 (widget-get link-at-point 'href)
 			 (w3-fix-spaces
 			  (buffer-substring
-			   (car (widget-get link-at-point 'title))
+			   (widget-get link-at-point :from)
-			   (cdr (widget-get link-at-point 'title))))))
+			   (widget-get link-at-point :to)))))
 (w3-map-links (function
 		   (lambda (widget arg)
 		     (setq links-alist	(cons
 					 (cons
 					  (w3-fix-spaces
 		    "Link: ") links-alist nil t))
 (if (string= choice "")
 	(w3-follow-link)
 (w3-fetch (cdr (assoc choice links-alist))))))
-(defun w3-widget-motion-hook (widget)
-(assert widget nil "Bad data to w3-widget-motion-hook!  Bad hook bad!")
-(case w3-echo-link
-(text
-(message "%s" (w3-fix-spaces (buffer-substring (widget-get widget :from)
-						    (widget-get widget :to)))))
-(url
-(if (widget-get widget 'href)
-	 (message "%s" (widget-get widget 'href))))
-(otherwise nil)))
 (defun w3-mode ()
 "Mode for viewing HTML documents.  If called interactively, will
 display the current buffer as HTML.
 Current keymap is:
 (setq major-mode 'w3-mode)
 (setq mode-name "WWW")
 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp)
 (w3-mode-version-specifics)
 (w3-menu-install-menus)
-(make-local-hook 'widget-motion-hook)
-(add-hook 'widget-motion-hook 'w3-widget-motion-hook)
 (run-hooks 'w3-mode-hook)
 (widget-setup)
 (setq url-current-passwd-count 0
 	    mode-line-format w3-modeline-format)
 (if (and w3-current-isindex (equal url-current-type "http"))
 	  (setq mode-line-process "-Searchable")))))
 (require 'mm)
 (require 'url)
-(require 'url-hash)
 (require 'w3-parse)
-(require 'w3-draw)
+(require 'w3-display)
 (require 'w3-auto)
 (require 'w3-emulate)
 (require 'w3-menu)
 (require 'w3-mouse)
 (provide 'w3)

Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 14:9ee227acff29 r19-15b90