Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 9ee227acff29
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; w3.el,v --- Main functions for emacs-w3 on all platforms/versions 1 ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1996/06/06 15:03:12 3 ;; Created: 1996/08/19 03:30:47
4 ;; Version: 1.550 4 ;; Version: 1.22
5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia 5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; 9 ;;;
10 ;;; This file is not part of GNU Emacs, but the same permissions apply. 10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
11 ;;; 11 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by 13 ;;; it under the terms of the GNU General Public License as published by
283 (buffer-enable-undo) 283 (buffer-enable-undo)
284 (funcall view) 284 (funcall view)
285 (w3-notify-when-ready bufnam)) 285 (w3-notify-when-ready bufnam))
286 (funcall view))) 286 (funcall view)))
287 ((stringp view) 287 ((stringp view)
288 (let ((fname (url-generate-unique-filename fmt)) proc) 288 (let ((fname (url-generate-unique-filename fmt))
289 (proc nil)
290 (file-coding-system url-mule-no-coding-system))
289 (if (url-file-directly-accessible-p (url-view-url t)) 291 (if (url-file-directly-accessible-p (url-view-url t))
290 (make-symbolic-link url-current-file fname t) 292 (make-symbolic-link url-current-file fname t)
291 (if (featurep 'mule) 293 (write-region (point-min) (point-max) fname))
292 (write-region (point-min) (point-max) fname nil nil *noconv*)
293 (write-region (point-min) (point-max) fname)))
294 (if (get-buffer url-working-buffer) 294 (if (get-buffer url-working-buffer)
295 (kill-buffer url-working-buffer)) 295 (kill-buffer url-working-buffer))
296 (if (string-match "%s" view) 296 (setq view (mm-viewer-unescape view fname url))
297 (setq view (concat (substring view 0 (match-beginning 0))
298 fname (substring view (match-end 0)))))
299 (if (string-match "%u" view)
300 (setq view (concat (substring view 0 (match-beginning 0))
301 url
302 (substring view (match-end 0)))))
303 (message "Passing to viewer %s " view) 297 (message "Passing to viewer %s " view)
304 (setq proc (w3-start-viewer fname view)) 298 (setq proc (w3-start-viewer fname view))
305 (set-process-filter proc 'w3-viewer-filter) 299 (set-process-filter proc 'w3-viewer-filter)
306 (set-process-sentinel proc 'w3-viewer-sentinel))) 300 (set-process-sentinel proc 'w3-viewer-sentinel)))
307 ((listp view) 301 ((listp view)
312 (message "Unknown viewer specified: %s" view) 306 (message "Unknown viewer specified: %s" view)
313 (w3-notify-when-ready url-working-buffer))))) 307 (w3-notify-when-ready url-working-buffer)))))
314 308
315 (defun w3-save-binary-file () 309 (defun w3-save-binary-file ()
316 "Save a buffer to disk - this is used when `w3-dump-to-disk' is non-nil" 310 "Save a buffer to disk - this is used when `w3-dump-to-disk' is non-nil"
317 (interactive) 311 ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select
318 (let ((x (read-file-name "Filename to save as: " 312 ;; a URL that gets saved via this function, read-file-name will pop up a
319 (or mm-download-directory "~/") 313 ;; dialog box for file selection. For some reason which buffer we are in
320 (concat (or mm-download-directory "~/") 314 ;; gets royally screwed (even with save-excursions and the whole nine
321 (url-basepath (or url-current-file "") t)) 315 ;; yards). SO, we just keep the old buffer name around and away we go.
322 nil 316 (let ((old-buff (current-buffer))
323 (url-basepath (or url-current-file "") t))) 317 (file (read-file-name "Filename to save as: "
324 (require-final-newline nil)) 318 (or mm-download-directory "~/")
325 (save-excursion 319 (url-remove-compressed-extensions
326 ;; more fixes from the MULE guys 320 (file-name-nondirectory (url-view-url t)))
327 (if w3-dump-to-disk 321 nil
328 (let (jka-compr-compression-info-list 322 (url-remove-compressed-extensions
329 jam-zcat-filename-list) 323 (file-name-nondirectory (url-view-url t)))))
330 (if (featurep 'mule) 324 (require-final-newline nil))
331 (let ((mc-flag t)) 325 (set-buffer old-buff)
332 (write-file x *noconv*)) 326 (let ((mc-flag t)
333 (write-file x))) 327 (file-coding-system url-mule-no-coding-system))
334 (let ((fnha file-name-handler-alist) 328 (write-region (point-min) (point-max) file))
335 (file-name-handler-alist nil)) 329 (kill-buffer (current-buffer))))
336 (if (featurep 'mule)
337 (let ((mc-flag t))
338 (write-file x *noconv*))
339 (write-file x))))
340 (kill-buffer (current-buffer)))))
341 330
342 (defun w3-build-url (protocol) 331 (defun w3-build-url (protocol)
343 "Build a url for PROTOCOL, return it as a string" 332 "Build a url for PROTOCOL, return it as a string"
344 (interactive (list (cdr (assoc (completing-read 333 (interactive (list (cdr (assoc (completing-read
345 "Protocol: " 334 "Protocol: "
566 (t 555 (t
567 (w3-add-urls-to-history x url) 556 (w3-add-urls-to-history x url)
568 (w3-sentinel lastbuf))))) 557 (w3-sentinel lastbuf)))))
569 (if w3-track-last-buffer 558 (if w3-track-last-buffer
570 (setq w3-last-buffer buf)) 559 (setq w3-last-buffer buf))
571 (let ((w3-notify (if (memq w3-notify '(newframe bully aggressive)) 560 (let ((w3-notify (if (memq w3-notify '(newframe bully
561 semibully aggressive))
572 w3-notify 562 w3-notify
573 'aggressive))) 563 'aggressive)))
574 (w3-notify-when-ready buf)) 564 (w3-notify-when-ready buf))
575 (if (string-match "#\\(.*\\)" url) 565 (if (string-match "#\\(.*\\)" url)
576 (progn 566 (progn
794 (setq p (widget-at (point))) 784 (setq p (widget-at (point)))
795 (or p (error "No url under point")) 785 (or p (error "No url under point"))
796 (setq str (format "<A HREF=\"%s\">%s</A>" (widget-get p 'href) 786 (setq str (format "<A HREF=\"%s\">%s</A>" (widget-get p 'href)
797 (read-string "Link text: " 787 (read-string "Link text: "
798 (buffer-substring 788 (buffer-substring
799 (car (widget-get p 'title)) 789 (widget-get p :from)
800 (cdr (widget-get p 'title))))))) 790 (widget-get p :to))))))
801 (t 791 (t
802 (setq str (format "<A HREF=\"%s\">%s</A>" (url-view-url t) 792 (setq str (format "<A HREF=\"%s\">%s</A>" (url-view-url t)
803 (read-string "Link text: " (buffer-name)))))) 793 (read-string "Link text: " (buffer-name))))))
804 (setq buff (read-buffer "Insert into buffer: " nil t)) 794 (setq buff (read-buffer "Insert into buffer: " nil t))
805 (if buff 795 (if buff
1024 (put-text-property (point-min) (point-max) 'face face) 1014 (put-text-property (point-min) (point-max) 'face face)
1025 (put-text-property (point-min) (point-max) 'w3-base url) 1015 (put-text-property (point-min) (point-max) 'w3-base url)
1026 (goto-char (point-min)) 1016 (goto-char (point-min))
1027 (setq buffer-file-truename nil 1017 (setq buffer-file-truename nil
1028 buffer-file-name nil) 1018 buffer-file-name nil)
1029 ;; Null filename bugs `set-auto-mode' in Mule ... 1019 ;; Null filename bugs `set-auto-mode' in Mule ...
1030 (if (not (featurep 'mule)) 1020 (condition-case ()
1031 (set-auto-mode)) 1021 (set-auto-mode)
1022 (error nil))
1032 (buffer-enable-undo) 1023 (buffer-enable-undo)
1033 (set-buffer-modified-p nil) 1024 (set-buffer-modified-p nil)
1034 (w3-notify-when-ready (get-buffer tmp)))) 1025 (w3-notify-when-ready (get-buffer tmp))))
1035 (run-hooks 'w3-source-file-hook)) 1026 (run-hooks 'w3-source-file-hook))
1036 1027
1491 1482
1492 1483
1493 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1484 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1494 ;;; Functions to handle formatting an html buffer 1485 ;;; Functions to handle formatting an html buffer
1495 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1486 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1496 (defun w3-insert-entities-in-string (string)
1497 "Convert HTML markup-start characters to entity references in STRING.
1498 Also replaces the \" character, so that the result may be safely used as
1499 an attribute value in a tag. Returns a new string with the result of the
1500 conversion. Replaces these characters as follows:
1501 & ==> &amp;
1502 < ==> &lt;
1503 > ==> &gt;
1504 \" ==> &quot;"
1505 (if (string-match "[&<>\"]" string)
1506 (save-excursion
1507 (set-buffer (get-buffer-create " *entity*"))
1508 (erase-buffer)
1509 (buffer-disable-undo (current-buffer))
1510 (insert string)
1511 (goto-char (point-min))
1512 (while (progn
1513 (skip-chars-forward "^&<>\"")
1514 (not (eobp)))
1515 (insert (cdr (assq (char-after (point))
1516 '((?\" . "&quot;")
1517 (?& . "&amp;")
1518 (?< . "&lt;")
1519 (?> . "&gt;")))))
1520 (delete-char 1))
1521 (buffer-string))
1522 string))
1523
1524 (defun w3-insert-headers () 1487 (defun w3-insert-headers ()
1525 ;; Insert some HTTP/1.0 headers if necessary 1488 ;; Insert some HTTP/1.0 headers if necessary
1526 (url-lazy-message "Inserting HTTP/1.0 headers...") 1489 (url-lazy-message "Inserting HTTP/1.0 headers...")
1527 (let ((hdrs (if (eq t w3-show-headers) (mapcar 'car url-current-mime-headers) 1490 (let ((hdrs (if (eq t w3-show-headers) (mapcar 'car url-current-mime-headers)
1528 w3-show-headers)) 1491 w3-show-headers))
1529 x y) 1492 x y)
1530 (goto-char (setq y (point-max))) 1493 (goto-char (setq y (point-max)))
1531 (while hdrs 1494 (while hdrs
1532 (if (setq x (w3-in-assoc (car hdrs) url-current-mime-headers)) 1495 (if (setq x (w3-in-assoc (car hdrs) url-current-mime-headers))
1533 (insert "<LI> <B>" (car x) "</B>: " (w3-insert-entities-in-string 1496 (insert "<LI> <B>" (car x) "</B>: " (url-insert-entities-in-string
1534 (if (numberp (cdr x)) 1497 (if (numberp (cdr x))
1535 (int-to-string (cdr x)) 1498 (int-to-string (cdr x))
1536 (cdr x))))) 1499 (cdr x)))))
1537 (setq hdrs (cdr hdrs))) 1500 (setq hdrs (cdr hdrs)))
1538 (if (= y (point-max)) 1501 (if (= y (point-max))
1540 (insert "</UL>") 1503 (insert "</UL>")
1541 (goto-char y) 1504 (goto-char y)
1542 (url-lazy-message "Inserting HTTP/1.0 headers... done.") 1505 (url-lazy-message "Inserting HTTP/1.0 headers... done.")
1543 (insert "<HR><UL>")))) 1506 (insert "<HR><UL>"))))
1544 1507
1545 (defun w3-add-delayed-mpeg (src st &optional width height) 1508 (defun w3-add-delayed-graphic (widget)
1546 ;; Add a delayed mpeg for the current buffer.
1547 (setq w3-delayed-movies (cons (list src
1548 (set-marker (make-marker) st)
1549 width height)
1550 w3-delayed-movies))
1551 (w3-handle-text (concat "[MPEG(" (url-basepath src t) ")]"))
1552 (put-text-property st (point) 'w3mpeg (list 'w3mpeg src st)))
1553
1554 (defun w3-add-delayed-graphic (src st align alt args)
1555 ;; Add a delayed image for the current buffer. 1509 ;; Add a delayed image for the current buffer.
1556 (setq st (set-marker (make-marker) st) 1510 (setq w3-delayed-images (cons widget w3-delayed-images)))
1557 w3-delayed-images (cons (list src st align alt args)
1558 w3-delayed-images))
1559 (w3-handle-text alt)
1560 (if (string= alt "") nil
1561 (put-text-property st (point) 'w3delayed t)))
1562 1511
1563 1512
1564 (defun w3-load-flavors () 1513 (defun w3-load-flavors ()
1565 ;; Load the correct zone/font info for each flavor of emacs 1514 ;; Load the correct zone/font info for each flavor of emacs
1566 (cond 1515 (cond
1609 (concat "WWW v" w3-version-number " of " 1558 (concat "WWW v" w3-version-number " of "
1610 w3-version-date) 1559 w3-version-date)
1611 vars 1560 vars
1612 nil nil 1561 nil nil
1613 "Description of Problem:")))) 1562 "Description of Problem:"))))
1563
1564 (defalias 'w3-bug 'w3-submit-bug)
1614 1565
1615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1566 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1616 ;;; Support for searching ;;; 1567 ;;; Support for searching ;;;
1617 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1618 (defun w3-nuke-spaces-in-search (x) 1569 (defun w3-nuke-spaces-in-search (x)
1766 "<title> Hotlist </title>\n\t</head>\n" 1717 "<title> Hotlist </title>\n\t</head>\n"
1767 "\t<body>\n\t\t<div>\n\t\t\t<h1>Hotlist from " w3-hotlist-file 1718 "\t<body>\n\t\t<div>\n\t\t\t<h1>Hotlist from " w3-hotlist-file
1768 "</h1>\n\t\t\t<ol>\n") 1719 "</h1>\n\t\t\t<ol>\n")
1769 (while tmp 1720 (while tmp
1770 (insert "\t\t\t\t<li> <a href=\"" (car (cdr (car tmp))) 1721 (insert "\t\t\t\t<li> <a href=\"" (car (cdr (car tmp)))
1771 "\">" (w3-insert-entities-in-string 1722 "\">" (url-insert-entities-in-string
1772 (car (car tmp))) "</a></li>\n") 1723 (car (car tmp))) "</a></li>\n")
1773 (setq tmp (cdr tmp))) 1724 (setq tmp (cdr tmp)))
1774 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n"))) 1725 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n")))
1775 ((equal type "starting-points") 1726 ((equal type "starting-points")
1776 (let ((tmp w3-starting-documents)) 1727 (let ((tmp w3-starting-documents))
1793 "History List For This Session of W3</h1>\n\t\t\t<ol>\n") 1744 "History List For This Session of W3</h1>\n\t\t\t<ol>\n")
1794 (url-maphash 1745 (url-maphash
1795 (function 1746 (function
1796 (lambda (url desc) 1747 (lambda (url desc)
1797 (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a>\n" 1748 (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a>\n"
1798 url (w3-insert-entities-in-string desc))))) 1749 url (url-insert-entities-in-string desc)))))
1799 url-history-list) 1750 url-history-list)
1800 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n"))))) 1751 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n")))))
1801 1752
1802 (defun w3-internal-handle-preview (buffer) 1753 (defun w3-internal-handle-preview (buffer)
1803 (setq buffer (get-buffer buffer)) 1754 (setq buffer (get-buffer buffer))
1927 (set-buffer (get-buffer x)) 1878 (set-buffer (get-buffer x))
1928 (if (eq major-mode 'w3-mode) 1879 (if (eq major-mode 'w3-mode)
1929 (w3-quit nil))))) 1880 (w3-quit nil)))))
1930 (buffer-list)) 1881 (buffer-list))
1931 (let ((x w3-current-last-buffer)) 1882 (let ((x w3-current-last-buffer))
1932 (and (fboundp 'w3-mpeg-kill-processes) (w3-mpeg-kill-processes))
1933 (kill-buffer (current-buffer)) 1883 (kill-buffer (current-buffer))
1934 (if (and (bufferp x) (buffer-name x)) 1884 (if (and (bufferp x) (buffer-name x))
1935 (w3-notify-when-ready x))))) 1885 (w3-notify-when-ready x)))))
1936 1886
1937 (defun w3-view-this-url (&optional no-show) 1887 (defun w3-view-this-url (&optional no-show)
1948 nil) 1898 nil)
1949 (t 1899 (t
1950 nil)))) 1900 nil))))
1951 1901
1952 (defun w3-load-delayed-images () 1902 (defun w3-load-delayed-images ()
1953 "Load inlined images that were delayed, if necessary. 1903 "Load inlined images that were delayed, if any."
1954 This function searches through `w3-delayed-images' and fetches the 1904 (interactive)
1955 appropriate picture for each point in the buffer and inserts it." 1905 (let ((w3-delay-image-loads nil)
1956 (interactive) 1906 (todo w3-delayed-images))
1957 (and (fboundp 'w3-insert-graphic) 1907 (setq w3-delayed-images nil)
1958 (let ((buffer-read-only nil)) 1908 (while todo
1959 (mapcar (function (lambda (data) (apply 'w3-insert-graphic data))) 1909 (w3-maybe-start-image-download (car todo))
1960 (nreverse w3-delayed-images)))) 1910 (setq todo (cdr todo)))))
1961 (setq w3-delayed-images nil))
1962 1911
1963 (defun w3-save-this-url () 1912 (defun w3-save-this-url ()
1964 "Save url under point in the kill ring" 1913 "Save url under point in the kill ring"
1965 (interactive) 1914 (interactive)
1966 (w3-save-url t)) 1915 (w3-save-url t))
2139 "\t(setq w3-delay-image-loads t)\n\n" 2088 "\t(setq w3-delay-image-loads t)\n\n"
2140 "in your ~/.emacs file.\n\n" 2089 "in your ~/.emacs file.\n\n"
2141 "You can find the NETPBM utilities in:\n" 2090 "You can find the NETPBM utilities in:\n"
2142 "\tftp://ftp.cs.indiana.edu/pub/elisp/w3/images/\n" 2091 "\tftp://ftp.cs.indiana.edu/pub/elisp/w3/images/\n"
2143 )))) 2092 ))))
2093
2094 (defun w3-refresh-stylesheets ()
2095 "Reload all stylesheets."
2096 (interactive)
2097 (setq w3-user-stylesheet nil
2098 w3-face-cache nil)
2099 (w3-find-default-stylesheets)
2100 (w3-style-post-process-stylesheet w3-user-stylesheet))
2144 2101
2145 (defun w3-find-default-stylesheets () 2102 (defun w3-find-default-stylesheets ()
2146 (let* ((lightp (w3-color-light-p 'default)) 2103 (let* ((lightp (w3-color-light-p 'default))
2147 (longname (if lightp "stylesheet-light" "stylesheet-dark")) 2104 (longname (if lightp "stylesheet-light" "stylesheet-dark"))
2148 (shortname (if lightp "light.css" "dark.css")) 2105 (shortname (if lightp "light.css" "dark.css"))
2242 (not (eq (device-class) 'mono))) 2199 (not (eq (device-class) 'mono)))
2243 (progn 2200 (progn
2244 (setq w3-user-colors-take-precedence t) 2201 (setq w3-user-colors-take-precedence t)
2245 (w3-warn 2202 (w3-warn
2246 'html 2203 'html
2247 "Disabled document color specification because of mono display.")) 2204 "Disabled document color specification because of mono display.")))
2248 (setq w3-user-colors-take-precedence nil)) 2205
2249 2206 (w3-refresh-stylesheets)
2250 (w3-find-default-stylesheets)
2251 (if (not url-global-history-file) 2207 (if (not url-global-history-file)
2252 (setq url-global-history-file 2208 (setq url-global-history-file
2253 (expand-file-name "history" 2209 (expand-file-name "history"
2254 w3-configuration-directory))) 2210 w3-configuration-directory)))
2255
2256 (if w3-user-stylesheet
2257 (w3-generate-stylesheet-faces w3-user-stylesheet))
2258 2211
2259 (if (and w3-use-netscape-configuration-file 2212 (if (and w3-use-netscape-configuration-file
2260 w3-netscape-configuration-file 2213 w3-netscape-configuration-file
2261 (fboundp 'w3-read-netscape-config)) 2214 (fboundp 'w3-read-netscape-config))
2262 (w3-read-netscape-config w3-netscape-configuration-file)) 2215 (w3-read-netscape-config w3-netscape-configuration-file))
2374 (save-excursion 2327 (save-excursion
2375 (set-buffer buff) 2328 (set-buffer buff)
2376 (let ((require-final-newline nil) 2329 (let ((require-final-newline nil)
2377 (file-name-handler-alist nil) 2330 (file-name-handler-alist nil)
2378 (write-file-hooks nil) 2331 (write-file-hooks nil)
2379 (write-contents-hooks nil)) 2332 (write-contents-hooks nil)
2380 (if (featurep 'mule) 2333 (mc-flag t)
2381 (let ((mc-flag t)) 2334 (file-coding-system url-mule-no-coding-system))
2382 (write-file fname nil *noconv*)) 2335 (write-file fname)
2383 (write-file fname))
2384 (message "Download of %s complete." (url-view-url t)) 2336 (message "Download of %s complete." (url-view-url t))
2385 (sit-for 3) 2337 (sit-for 3)
2386 (kill-buffer buff))))) 2338 (kill-buffer buff)))))
2387 2339
2388 (defun w3-download-url (url) 2340 (defun w3-download-url (url)
2390 (url-inhibit-uncompression t) 2342 (url-inhibit-uncompression t)
2391 (url-mime-accept-string "*/*") 2343 (url-mime-accept-string "*/*")
2392 (urlobj (url-generic-parse-url url)) 2344 (urlobj (url-generic-parse-url url))
2393 (url-working-buffer 2345 (url-working-buffer
2394 (generate-new-buffer (concat " *" url " download*"))) 2346 (generate-new-buffer (concat " *" url " download*")))
2395 (stub-fname (url-basepath (or (url-filename urlobj) "") t)) 2347 (stub-fname (url-remove-compressed-extensions
2348 (url-basepath (or (url-filename urlobj) "") t)))
2396 (fname (read-file-name "Filename to save as: " 2349 (fname (read-file-name "Filename to save as: "
2397 (or mm-download-directory "~/") 2350 (or mm-download-directory "~/")
2398 (concat (or mm-download-directory "~/") 2351 stub-fname
2399 stub-fname)
2400 nil 2352 nil
2401 stub-fname))) 2353 stub-fname)))
2402 (setq-default url-be-asynchronous t) 2354 (setq-default url-be-asynchronous t)
2403 (save-excursion 2355 (save-excursion
2404 (set-buffer url-working-buffer) 2356 (set-buffer url-working-buffer)
2482 "Link: ") links-alist nil t)) 2434 "Link: ") links-alist nil t))
2483 (if (string= choice "") 2435 (if (string= choice "")
2484 (w3-follow-link) 2436 (w3-follow-link)
2485 (w3-fetch (cdr (assoc choice links-alist)))))) 2437 (w3-fetch (cdr (assoc choice links-alist))))))
2486 2438
2439 (defun w3-widget-motion-hook (widget)
2440 (assert widget nil "Bad data to w3-widget-motion-hook! Bad hook bad!")
2441 (case w3-echo-link
2442 (text
2443 (message "%s" (w3-fix-spaces (buffer-substring (widget-get widget :from)
2444 (widget-get widget :to)))))
2445 (url
2446 (if (widget-get widget 'href)
2447 (message "%s" (widget-get widget 'href))))
2448 (otherwise nil)))
2449
2487 (defun w3-mode () 2450 (defun w3-mode ()
2488 "Mode for viewing HTML documents. If called interactively, will 2451 "Mode for viewing HTML documents. If called interactively, will
2489 display the current buffer as HTML. 2452 display the current buffer as HTML.
2490 2453
2491 Current keymap is: 2454 Current keymap is:
2501 (setq major-mode 'w3-mode) 2464 (setq major-mode 'w3-mode)
2502 (setq mode-name "WWW") 2465 (setq mode-name "WWW")
2503 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp) 2466 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp)
2504 (w3-mode-version-specifics) 2467 (w3-mode-version-specifics)
2505 (w3-menu-install-menus) 2468 (w3-menu-install-menus)
2469 (make-local-hook 'widget-motion-hook)
2470 (add-hook 'widget-motion-hook 'w3-widget-motion-hook)
2506 (run-hooks 'w3-mode-hook) 2471 (run-hooks 'w3-mode-hook)
2507 (widget-setup) 2472 (widget-setup)
2508 (setq url-current-passwd-count 0 2473 (setq url-current-passwd-count 0
2509 mode-line-format w3-modeline-format) 2474 mode-line-format w3-modeline-format)
2510 (if (and w3-current-isindex (equal url-current-type "http")) 2475 (if (and w3-current-isindex (equal url-current-type "http"))