Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 318232e2a3f0
children 15872534500d
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
1 ;;; w3.el --- 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: 1997/05/09 04:54:28 3 ;; Created: 1997/06/24 22:38:28
4 ;; Version: 1.119 4 ;; Version: 1.130
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 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
69 ) 69 )
70 70
71 71
72 (require 'w3-sysdp) 72 (require 'w3-sysdp)
73 (require 'mule-sysdp) 73 (require 'mule-sysdp)
74 (require 'widget)
74 75
75 (or (featurep 'efs) 76 (or (featurep 'efs)
76 (featurep 'efs-auto) 77 (featurep 'efs-auto)
77 (condition-case () 78 (condition-case ()
78 (require 'ange-ftp) 79 (require 'ange-ftp)
639 (let* ((maxlength (car (sort (mapcar (function (lambda (x) 640 (let* ((maxlength (car (sort (mapcar (function (lambda (x)
640 (length (car x)))) 641 (length (car x))))
641 hdrs) 642 hdrs)
642 '>))) 643 '>)))
643 (fmtstring (format " <tr><td align=right>%%%ds:</td><td>%%s</td></tr>" maxlength))) 644 (fmtstring (format " <tr><td align=right>%%%ds:</td><td>%%s</td></tr>" maxlength)))
644 (insert " <tr><th>MetaInformation</th></tr>\n" 645 (insert " <tr><th colspan=2>MetaInformation</th></tr>\n"
645 (mapconcat 646 (mapconcat
646 (function 647 (function
647 (lambda (x) 648 (lambda (x)
648 (if (/= (length (car x)) 0) 649 (if (/= (length (car x)) 0)
649 (format fmtstring 650 (format fmtstring
665 (let* ((maxlength (car (sort (mapcar (function (lambda (x) 666 (let* ((maxlength (car (sort (mapcar (function (lambda (x)
666 (length (car x)))) 667 (length (car x))))
667 info) 668 info)
668 '>))) 669 '>)))
669 (fmtstring (format " <tr><td>%%%ds:</td><td>%%s</td></tr>" maxlength))) 670 (fmtstring (format " <tr><td>%%%ds:</td><td>%%s</td></tr>" maxlength)))
670 (insert " <tr><th>Miscellaneous Variables</th></tr>\n") 671 (insert " <tr><th colspan=2>Miscellaneous Variables</th></tr>\n")
671 (while info 672 (while info
672 (insert (format fmtstring 673 (insert (format fmtstring
673 (url-insert-entities-in-string 674 (url-insert-entities-in-string
674 (capitalize (caar info))) 675 (capitalize (caar info)))
675 (url-insert-entities-in-string 676 (url-insert-entities-in-string
1330 ;; Add a delayed image for the current buffer. 1331 ;; Add a delayed image for the current buffer.
1331 (setq w3-delayed-images (cons widget w3-delayed-images))) 1332 (setq w3-delayed-images (cons widget w3-delayed-images)))
1332 1333
1333 1334
1334 (defun w3-load-flavors () 1335 (defun w3-load-flavors ()
1335 ;; Load the correct zone/font info for each flavor of emacs 1336 ;; Load the correct emacsen specific stuff
1336 (cond 1337 (cond
1337 ((and w3-running-xemacs (eq system-type 'ms-windows)) 1338 ((and w3-running-xemacs (eq system-type 'ms-windows))
1338 (error "WinEmacs no longer supported.")) 1339 (error "WinEmacs no longer supported."))
1339 (w3-running-xemacs (require 'w3-xemac)) 1340 (w3-running-xemacs (require 'w3-xemac))
1340 (w3-running-FSF19 (require 'w3-e19)) 1341 (w3-running-FSF19 (require 'w3-e19))
1687 1688
1688 (defun w3-view-this-url (&optional no-show) 1689 (defun w3-view-this-url (&optional no-show)
1689 "View the URL of the link under point" 1690 "View the URL of the link under point"
1690 (interactive) 1691 (interactive)
1691 (let* ((widget (widget-at (point))) 1692 (let* ((widget (widget-at (point)))
1692 (href (and widget (widget-get widget 'href)))) 1693 (parent (and widget (widget-get widget :parent)))
1694 (href (or (and widget (widget-get widget 'href))
1695 (and parent (widget-get parent 'href)))))
1693 (cond 1696 (cond
1694 ((and no-show href) 1697 ((and no-show href)
1695 href) 1698 href)
1696 (href 1699 (href
1697 (message "%s" (url-truncate-url-for-viewing href))) 1700 (message "%s" (url-truncate-url-for-viewing href)))
1846 WIDGET and MAPARG. 1849 WIDGET and MAPARG.
1847 The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of 1850 The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of
1848 BUFFER, the end of BUFFER, nil, and (current-buffer), respectively." 1851 BUFFER, the end of BUFFER, nil, and (current-buffer), respectively."
1849 (let ((cur (point-min)) 1852 (let ((cur (point-min))
1850 (widget nil) 1853 (widget nil)
1851 (parent nil)) 1854 (parent nil)
1852 (while (setq cur (next-single-property-change cur 'button)) 1855 (overlays (overlay-lists)))
1853 (setq widget (widget-at cur) 1856 (setq overlays (append (car overlays) (cdr overlays)))
1857 (while (setq cur (pop overlays))
1858 (setq widget (overlay-get cur 'button)
1854 parent (and widget (widget-get widget :parent))) 1859 parent (and widget (widget-get widget :parent)))
1855 ;; Check to see if its a push widget, its got the correct callback, 1860 ;; Check to see if its got a URL tacked on it somewhere
1856 ;; and actually has a URL. Remember the url as a side-effect of the
1857 ;; test for later use.
1858 (cond 1861 (cond
1859 ((and widget (widget-get widget 'href)) 1862 ((and widget (widget-get widget :href))
1860 (funcall function widget maparg)) 1863 (funcall function widget maparg))
1861 ((and parent (widget-get parent 'href)) 1864 ((and parent (widget-get parent :href))
1862 (funcall function parent maparg)) 1865 (funcall function parent maparg))
1863 (t nil))))) 1866 (t nil)))))
1864 1867
1865 (defun w3-emit-image-warnings-if-necessary () 1868 (defun w3-emit-image-warnings-if-necessary ()
1866 (if (and (not w3-delay-image-loads) 1869 (if (and (not w3-delay-image-loads)
1916 (directories (list 1919 (directories (list
1917 data-directory 1920 data-directory
1918 (concat data-directory "w3/") 1921 (concat data-directory "w3/")
1919 (expand-file-name "../../w3" data-directory) 1922 (expand-file-name "../../w3" data-directory)
1920 (file-name-directory (locate-library "w3")) 1923 (file-name-directory (locate-library "w3"))
1924 (expand-file-name "../w3" (file-name-directory
1925 (locate-library "w3")))
1921 w3-configuration-directory)) 1926 w3-configuration-directory))
1922 (total-found 0) 1927 (total-found 0)
1923 (possible (append 1928 (possible (append
1924 (apply 1929 (apply
1925 'append 1930 'append
1970 (url-do-setup) 1975 (url-do-setup)
1971 (url-register-protocol 'about 'w3-about 'url-identity-expander) 1976 (url-register-protocol 'about 'w3-about 'url-identity-expander)
1972 (url-register-protocol 'www 'w3-internal-url 'w3-internal-expander) 1977 (url-register-protocol 'www 'w3-internal-url 'w3-internal-expander)
1973 (w3-load-flavors) 1978 (w3-load-flavors)
1974 (w3-setup-version-specifics) 1979 (w3-setup-version-specifics)
1980 (setq w3-setup-done t)
1975 (setq w3-default-configuration-file (expand-file-name 1981 (setq w3-default-configuration-file (expand-file-name
1976 (or w3-default-configuration-file 1982 (or w3-default-configuration-file
1977 "profile") 1983 "profile")
1978 w3-configuration-directory)) 1984 w3-configuration-directory))
1979
1980
1981 (if (and init-file-user 1985 (if (and init-file-user
1982 w3-default-configuration-file 1986 w3-default-configuration-file
1983 (file-exists-p w3-default-configuration-file)) 1987 (file-exists-p w3-default-configuration-file))
1984 (condition-case e 1988 (condition-case e
1985 (load w3-default-configuration-file nil t) 1989 (load w3-default-configuration-file nil t)
2056 (or (getenv "WWW_HOME") 2060 (or (getenv "WWW_HOME")
2057 "http://www.cs.indiana.edu/elisp/w3/docs.html"))) 2061 "http://www.cs.indiana.edu/elisp/w3/docs.html")))
2058 2062
2059 ; Set up the entity definition for PGP and PEM authentication 2063 ; Set up the entity definition for PGP and PEM authentication
2060 2064
2061 (run-hooks 'w3-load-hook) 2065 (run-hooks 'w3-load-hook))
2062 (setq w3-setup-done t))
2063 2066
2064 (defun w3-mark-link-as-followed (ext dat) 2067 (defun w3-mark-link-as-followed (ext dat)
2065 ;; Mark a link as followed 2068 ;; Mark a link as followed
2066 (message "Reimplement w3-mark-link-as-followed")) 2069 (message "Reimplement w3-mark-link-as-followed"))
2067 2070
2068 (defun w3-only-links () 2071 (defun w3-only-links ()
2069 (let* (result temp) 2072 (let* (result temp)
2070 (if (widget-at (point-min)) 2073 (w3-map-links (function
2071 (setq result (list (widget-at (point-min))))) 2074 (lambda (x y)
2072 (setq temp (w3-next-widget (point-min))) 2075 (setq result (cons x result)))))
2073 (while temp
2074 (if (widget-get temp 'href)
2075 (setq result (cons temp result)))
2076 (setq temp (w3-next-widget (widget-get temp :to))))
2077 result)) 2076 result))
2078 2077
2079 (defun w3-download-callback (fname buff) 2078 (defun w3-download-callback (fname buff)
2080 (if (and (get-buffer buff) (buffer-name buff)) 2079 (if (and (get-buffer buff) (buffer-name buff))
2081 (save-excursion 2080 (save-excursion
2083 (let ((require-final-newline nil) 2082 (let ((require-final-newline nil)
2084 (file-name-handler-alist nil) 2083 (file-name-handler-alist nil)
2085 (write-file-hooks nil) 2084 (write-file-hooks nil)
2086 (write-contents-hooks nil) 2085 (write-contents-hooks nil)
2087 (enable-multibyte-characters t) ; mule 2.4 2086 (enable-multibyte-characters t) ; mule 2.4
2088 (coding-system-for-write mule-no-coding-system) ; (X)Emacs/mule 2087 (buffer-file-coding-system mule-no-coding-system) ; mule 2.4
2089 (file-coding-system mule-no-coding-system) ; mule 2.3 2088 (file-coding-system mule-no-coding-system) ; mule 2.3
2090 (mc-flag t)) ; mule 2.3 2089 (mc-flag t)) ; mule 2.3
2091 (write-file fname) 2090 (write-file fname)
2092 (message "Download of %s complete." (url-view-url t)) 2091 (message "Download of %s complete." (url-view-url t))
2093 (sit-for 3) 2092 (sit-for 3)
2161 ((or p w3-dump-to-disk) 2160 ((or p w3-dump-to-disk)
2162 (w3-download-url href)) 2161 (w3-download-url href))
2163 (t 2162 (t
2164 (w3-fetch href))))) 2163 (w3-fetch href)))))
2165 2164
2166 ;;; FIXME! Need to rewrite these so that we can pass a predicate to
2167 (defun w3-widget-forward (arg) 2165 (defun w3-widget-forward (arg)
2168 "Move point to the next field or button. 2166 "Move point to the next field or button.
2169 With optional ARG, move across that many fields." 2167 With optional ARG, move across that many fields."
2170 (interactive "p") 2168 (interactive "p")
2171 (widget-forward arg)) 2169 (widget-forward arg))
2249 (let ((tmp (mapcar (function (lambda (x) (cons x (symbol-value x)))) 2247 (let ((tmp (mapcar (function (lambda (x) (cons x (symbol-value x))))
2250 w3-persistent-variables))) 2248 w3-persistent-variables)))
2251 ;; Oh gross, this kills buffer-local faces in XEmacs 2249 ;; Oh gross, this kills buffer-local faces in XEmacs
2252 ;;(kill-all-local-variables) 2250 ;;(kill-all-local-variables)
2253 (use-local-map w3-mode-map) 2251 (use-local-map w3-mode-map)
2254 (setq major-mode 'w3-mode)
2255 (setq mode-name "WWW") 2252 (setq mode-name "WWW")
2256 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp) 2253 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp)
2254 (setq major-mode 'w3-mode)
2257 (w3-mode-version-specifics) 2255 (w3-mode-version-specifics)
2258 (w3-menu-install-menus) 2256 (w3-menu-install-menus)
2259 (setq url-current-passwd-count 0 2257 (setq url-current-passwd-count 0
2260 inhibit-read-only nil
2261 truncate-lines t 2258 truncate-lines t
2262 mode-line-format w3-modeline-format) 2259 mode-line-format w3-modeline-format)
2263 (run-hooks 'w3-mode-hook) 2260 (run-hooks 'w3-mode-hook)
2261 ;; Avoid calling the global bindings for RET and mouse-2.
2262 (make-local-variable 'widget-global-map)
2263 (setq widget-global-map (make-sparse-keymap))
2264 (widget-setup) 2264 (widget-setup)
2265 (if w3-current-isindex 2265 (if w3-current-isindex
2266 (setq mode-line-process "-Searchable"))))) 2266 (setq mode-line-process "-Searchable")))))
2267 2267
2268 (require 'mm) 2268 (require 'mm)