Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 859a2309aef8
children 441bb1e64a06
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
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/02/08 00:49:52 3 ;; Created: 1997/02/13 23:05:56
4 ;; Version: 1.72 4 ;; Version: 1.77
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.
122 (cond 122 (cond
123 ((< n 1) (char-to-string ?Z)) 123 ((< n 1) (char-to-string ?Z))
124 ((<= n 26) (char-to-string (+ ?A (1- n)))) 124 ((<= n 26) (char-to-string (+ ?A (1- n))))
125 (t (concat (char-to-string (+ ?A (1- (/ n 27)))) 125 (t (concat (char-to-string (+ ?A (1- (/ n 27))))
126 (w3-decimal-to-alpha (% n 26)))))) 126 (w3-decimal-to-alpha (% n 26))))))
127
128
129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130 ;;; Functions for compatibility with XMosaic
131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132
133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
134 ;;; Parse out the Mosaic documents-menu file
135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136 (defun w3-parse-docs-menu ()
137 ;; Parse the Mosaic documents menu
138 (let ((tmp-menu (append '((separator)) w3-starting-documents
139 '((separator))))
140 real-menu x y name url)
141 (if (or (not (file-exists-p w3-documents-menu-file))
142 (not (file-readable-p w3-documents-menu-file)))
143 nil
144 (save-excursion
145 (set-buffer (get-buffer-create " *w3-temp*"))
146 (erase-buffer)
147 (insert-file-contents w3-documents-menu-file)
148 (goto-char (point-min))
149 (while (not (eobp))
150 (if (not (looking-at "-+$"))
151 (setq x (progn (beginning-of-line) (point))
152 y (progn (end-of-line) (point))
153 name (prog1
154 (buffer-substring x y)
155 (delete-region x (min (1+ y) (point-max))))
156 x (progn (beginning-of-line) (point))
157 y (progn (end-of-line) (point))
158 url (prog1
159 (buffer-substring x y)
160 (delete-region x (min (1+ y) (point-max))))
161 tmp-menu (if (rassoc url tmp-menu) tmp-menu
162 (cons (cons name url) tmp-menu)))
163 (setq tmp-menu (cons '(separator) tmp-menu))
164 (delete-region (point-min) (min (1+ (progn (end-of-line)
165 (point)))
166 (point-max)))))
167 (kill-buffer (current-buffer))))
168 (if (equal (car (car tmp-menu)) "") (setq tmp-menu (cdr tmp-menu)))
169 (while tmp-menu
170 (setq real-menu (cons (if (equal 'separator (car (car tmp-menu)))
171 "--------"
172 (vector (car (car tmp-menu))
173 (list 'w3-fetch
174 (if (listp (cdr (car tmp-menu)))
175 (car (cdr (car tmp-menu)))
176 (cdr (car tmp-menu)))) t))
177 real-menu)
178 tmp-menu (cdr tmp-menu)))
179 (setq w3-navigate-menu (append w3-navigate-menu real-menu
180 (list "-----")))))
181 127
182 128
183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
184 ;;; Functions to pass files off to external viewers 130 ;;; Functions to pass files off to external viewers
185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
382 328
383 ;;;###autoload 329 ;;;###autoload
384 (defun w3-open-local (fname) 330 (defun w3-open-local (fname)
385 "Find a local file, and interpret it as a hypertext document. 331 "Find a local file, and interpret it as a hypertext document.
386 It will prompt for an existing file or directory, and retrieve it as a 332 It will prompt for an existing file or directory, and retrieve it as a
387 hypertext document. If it is a directory, and url-use-hypertext-dired 333 hypertext document."
388 is non-nil, then an HTML directory listing is created on the fly.
389 Otherwise, dired-mode is used to visit the buffer."
390 (interactive "FLocal file: ") 334 (interactive "FLocal file: ")
391 (setq fname (expand-file-name fname)) 335 (setq fname (expand-file-name fname))
392 (if (not w3-setup-done) (w3-do-setup)) 336 (if (not w3-setup-done) (w3-do-setup))
393 (w3-fetch (concat "file:" fname))) 337 (w3-fetch (concat "file:" fname)))
394 338
395 ;;;###autoload 339 ;;;###autoload
396 (defun w3-find-file (fname) 340 (defun w3-find-file (fname)
397 "Find a local file, and interpret it as a hypertext document. 341 "Find a local file, and interpret it as a hypertext document.
398 It will prompt for an existing file or directory, and retrieve it as a 342 It will prompt for an existing file or directory, and retrieve it as a
399 hypertext document. If it is a directory, and url-use-hypertext-dired 343 hypertext document."
400 is non-nil, then an HTML directory listing is created on the fly.
401 Otherwise, dired-mode is used to visit the buffer."
402 (interactive "FLocal file: ") 344 (interactive "FLocal file: ")
403 (w3-open-local fname)) 345 (w3-open-local fname))
404 346
405 ;;;###autoload 347 ;;;###autoload
406 (defun w3-fetch-other-frame (&optional url) 348 (defun w3-fetch-other-frame (&optional url)
763 (defun w3-truncate-menu-item (string) 705 (defun w3-truncate-menu-item (string)
764 (if (<= (length string) w3-max-menu-width) 706 (if (<= (length string) w3-max-menu-width)
765 string 707 string
766 (concat (substring string 0 w3-max-menu-width) "$"))) 708 (concat (substring string 0 w3-max-menu-width) "$")))
767 709
768 (defun w3-use-starting-documents ()
769 "Use the list of predefined starting documents from w3-starting-documents"
770 (interactive)
771 (let ((w3-hotlist w3-starting-documents))
772 (w3-use-hotlist)))
773
774 (defun w3-show-starting-documents ()
775 "Show the list of predefined starting documents from w3-starting-documents"
776 (interactive)
777 (if (not w3-setup-done) (w3-do-setup))
778 (w3-fetch "www://auto/starting-points"))
779
780 (defun w3-insert-formatted-url (p) 710 (defun w3-insert-formatted-url (p)
781 "Insert a formatted url into a buffer. With prefix arg, insert the url 711 "Insert a formatted url into a buffer. With prefix arg, insert the url
782 under point." 712 under point."
783 (interactive "P") 713 (interactive "P")
784 (let (buff str) 714 (let (buff str)
785 (cond 715 (cond
786 (p 716 (p
787 (setq p (widget-at (point))) 717 (setq p (widget-at (point)))
788 (or p (error "No url under point")) 718 (or p (error "No url under point"))
789 (setq str (format "<A HREF=\"%s\">%s</A>" (widget-get p 'href) 719 (setq str (format "<a href=\"%s\">%s</a>" (widget-get p 'href)
790 (read-string "Link text: " 720 (read-string "Link text: "
791 (buffer-substring 721 (buffer-substring
792 (widget-get p :from) 722 (widget-get p :from)
793 (widget-get p :to)))))) 723 (widget-get p :to))))))
794 (t 724 (t
795 (setq str (format "<A HREF=\"%s\">%s</A>" (url-view-url t) 725 (setq str (format "<a href=\"%s\">%s</a>" (url-view-url t)
796 (read-string "Link text: " (buffer-name)))))) 726 (read-string "Link text: " (buffer-name))))))
797 (setq buff (read-buffer "Insert into buffer: " nil t)) 727 (setq buff (read-buffer "Insert into buffer: " nil t))
798 (if buff 728 (if buff
799 (save-excursion 729 (save-excursion
800 (set-buffer buff) 730 (set-buffer buff)
817 (if (widget-at (point)) 747 (if (widget-at (point))
818 (widget-button-press (point)))) 748 (widget-button-press (point))))
819 749
820 (defun w3-widget-button-click (e) 750 (defun w3-widget-button-click (e)
821 (interactive "@e") 751 (interactive "@e")
822 (if (widget-at (event-point e)) 752 (cond
823 (widget-button-click e))) 753 ((and (event-point e)
754 (widget-at (event-point e)))
755 (widget-button-click e))
756 ((and (fboundp 'event-glyph)
757 (event-glyph e)
758 (glyph-property (event-glyph e) 'widget))
759 (widget-button-click e))))
824 760
825 (defun w3-breakup-menu (menu-desc max-len) 761 (defun w3-breakup-menu (menu-desc max-len)
826 (if (> (length menu-desc) max-len) 762 (if (> (length menu-desc) max-len)
827 (cons (cons "More..." (w3-first-n-items menu-desc max-len)) 763 (cons (cons "More..." (w3-first-n-items menu-desc max-len))
828 (w3-breakup-menu (nthcdr max-len menu-desc) max-len)) 764 (w3-breakup-menu (nthcdr max-len menu-desc) max-len))
885 (let ((fname "") 821 (let ((fname "")
886 (curname "") 822 (curname "")
887 (x 0) 823 (x 0)
888 (args command-line-args-left) 824 (args command-line-args-left)
889 (w3-strict-width 80) 825 (w3-strict-width 80)
890 (w3-delimit-emphasis nil)
891 (w3-delimit-links nil)
892 (retrieval-function 'w3-fetch) 826 (retrieval-function 'w3-fetch)
893 (file-format "text") 827 (file-format "text")
894 (header "") 828 (header "")
895 (file-extn ".txt")) 829 (file-extn ".txt"))
896 (setq file-format (downcase (car args))) 830 (setq file-format (downcase (car args)))
1093 url))) 1027 url)))
1094 ((equal "LaTeX Source" format) 1028 ((equal "LaTeX Source" format)
1095 (setq content-type "application/x-latex; charset=iso-8859-1") 1029 (setq content-type "application/x-latex; charset=iso-8859-1")
1096 (w3-parse-tree-to-latex w3-current-parse url))) 1030 (w3-parse-tree-to-latex w3-current-parse url)))
1097 (buffer-string)))) 1031 (buffer-string))))
1098 (cond 1032 (funcall w3-mail-command)
1099 ((and w3-mutable-windows (fboundp w3-mail-other-window-command))
1100 (funcall w3-mail-other-window-command))
1101 ((fboundp w3-mail-command)
1102 (funcall w3-mail-command))
1103 (w3-mutable-windows (mail-other-window))
1104 (t (mail)))
1105 (mail-subject) 1033 (mail-subject)
1106 (insert format " from URL " url "\n" 1034 (insert format " from URL " url "\n"
1107 "Mime-Version: 1.0\n" 1035 "Mime-Version: 1.0\n"
1108 "Content-transfer-encoding: 8bit\n" 1036 "Content-transfer-encoding: 8bit\n"
1109 "Content-type: " content-type) 1037 "Content-type: " content-type)
1110
1111 (re-search-forward mail-header-separator nil) 1038 (re-search-forward mail-header-separator nil)
1112 (forward-char 1) 1039 (forward-char 1)
1113 (insert (if (equal "HTML Source" format) 1040 (insert (if (equal "HTML Source" format)
1114 (format "<BASE HREF=\"%s\">" url) "") 1041 (format "<BASE HREF=\"%s\">" url) "")
1115 str) 1042 str)
1174 (setq url-current-mime-viewer 1101 (setq url-current-mime-viewer
1175 (mm-mime-info (or url-current-mime-type 1102 (mm-mime-info (or url-current-mime-type
1176 (mm-extension-to-mime extn)) nil 5))) 1103 (mm-extension-to-mime extn)) nil 5)))
1177 (if url-current-mime-viewer 1104 (if url-current-mime-viewer
1178 (setq cont (append cont '(w3-pass-to-viewer))) 1105 (setq cont (append cont '(w3-pass-to-viewer)))
1179 (setq cont (append cont (list w3-default-action)))) 1106 (setq cont (append cont (list 'w3-prepare-buffer))))
1180 cont))) 1107 cont)))
1181 1108
1182 (defun w3-use-links () 1109 (defun w3-use-links ()
1183 "Select one of the <LINK> tags from this document and fetch it." 1110 "Select one of the <LINK> tags from this document and fetch it."
1184 (interactive) 1111 (interactive)
1191 ftp: reference" 1118 ftp: reference"
1192 (interactive) 1119 (interactive)
1193 (cond 1120 (cond
1194 ((and (or (null url-current-type) (equal url-current-type "file")) 1121 ((and (or (null url-current-type) (equal url-current-type "file"))
1195 (eq major-mode 'w3-mode)) 1122 (eq major-mode 'w3-mode))
1196 (if w3-mutable-windows 1123 (find-file url-current-file))
1197 (find-file-other-window url-current-file)
1198 (find-file url-current-file)))
1199 ((equal url-current-type "ftp") 1124 ((equal url-current-type "ftp")
1200 (if w3-mutable-windows 1125 (find-file
1201 (find-file-other-window 1126 (format "/%s@%s:%s" url-current-user url-current-server
1202 (format "/%s@%s:%s" url-current-user url-current-server 1127 url-current-file)))
1203 url-current-file))
1204 (find-file
1205 (format "/%s@%s:%s" url-current-user url-current-server
1206 url-current-file))))
1207 (t (message "Sorry, I can't get that file so you can alter it.")))) 1128 (t (message "Sorry, I can't get that file so you can alter it."))))
1208 1129
1209 (defun w3-insert-this-url (pref-arg) 1130 (defun w3-insert-this-url (pref-arg)
1210 "Insert the current url in another buffer, with prefix ARG, 1131 "Insert the current url in another buffer, with prefix ARG,
1211 insert URL under point" 1132 insert URL under point"
1485 1406
1486 1407
1487 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1408 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1488 ;;; Functions to handle formatting an html buffer 1409 ;;; Functions to handle formatting an html buffer
1489 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1410 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1490 (defun w3-insert-headers ()
1491 ;; Insert some HTTP/1.0 headers if necessary
1492 (url-lazy-message "Inserting HTTP/1.0 headers...")
1493 (let ((hdrs (if (eq t w3-show-headers) (mapcar 'car url-current-mime-headers)
1494 w3-show-headers))
1495 x y)
1496 (goto-char (setq y (point-max)))
1497 (while hdrs
1498 (if (setq x (w3-in-assoc (car hdrs) url-current-mime-headers))
1499 (insert "<LI> <B>" (car x) "</B>: " (url-insert-entities-in-string
1500 (if (numberp (cdr x))
1501 (int-to-string (cdr x))
1502 (cdr x)))))
1503 (setq hdrs (cdr hdrs)))
1504 (if (= y (point-max))
1505 nil
1506 (insert "</UL>")
1507 (goto-char y)
1508 (url-lazy-message "Inserting HTTP/1.0 headers... done.")
1509 (insert "<HR><UL>"))))
1510
1511 (defun w3-add-delayed-graphic (widget) 1411 (defun w3-add-delayed-graphic (widget)
1512 ;; Add a delayed image for the current buffer. 1412 ;; Add a delayed image for the current buffer.
1513 (setq w3-delayed-images (cons widget w3-delayed-images))) 1413 (setq w3-delayed-images (cons widget w3-delayed-images)))
1514 1414
1515 1415
1719 "</h1>\n\t\t\t<ol>\n") 1619 "</h1>\n\t\t\t<ol>\n")
1720 (while tmp 1620 (while tmp
1721 (insert "\t\t\t\t<li> <a href=\"" (car (cdr (car tmp))) 1621 (insert "\t\t\t\t<li> <a href=\"" (car (cdr (car tmp)))
1722 "\">" (url-insert-entities-in-string 1622 "\">" (url-insert-entities-in-string
1723 (car (car tmp))) "</a></li>\n") 1623 (car (car tmp))) "</a></li>\n")
1724 (setq tmp (cdr tmp)))
1725 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n")))
1726 ((equal type "starting-points")
1727 (let ((tmp w3-starting-documents))
1728 (insert "<html>\n\t<head>\n\t\t"
1729 "<title> Starting Points </title>\n\t</head>\n"
1730 "\t<body>\n\t\t<div>\n\t\t\t<h1>Starting Point on the Web"
1731 "</h1>\n\t\t\t<ol>\n")
1732 (while tmp
1733 (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a></li>\n"
1734 (car (cdr (car tmp)))
1735 (car (car tmp))))
1736 (setq tmp (cdr tmp))) 1624 (setq tmp (cdr tmp)))
1737 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n"))) 1625 (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n")))
1738 ((equal type "history") 1626 ((equal type "history")
1739 (if (not url-history-list) 1627 (if (not url-history-list)
1740 (url-retrieve "www://error/nohist") 1628 (url-retrieve "www://error/nohist")
2225 2113
2226 (setq url-package-version w3-version-number 2114 (setq url-package-version w3-version-number
2227 url-package-name "Emacs-W3") 2115 url-package-name "Emacs-W3")
2228 2116
2229 (w3-emit-image-warnings-if-necessary) 2117 (w3-emit-image-warnings-if-necessary)
2230 (if (eq w3-color-use-reducing 'guess)
2231 (setq w3-color-use-reducing
2232 (cond
2233 ((eq (device-type) 'tty) nil)
2234 ((fboundp 'device-class)
2235 (not (and (memq (device-class) '(TrueColor true-color))
2236 (<= 16 (or (device-bitplanes) 0)))))
2237 (t t))))
2238 2118
2239 (cond 2119 (cond
2240 ((memq system-type '(ms-dos ms-windows)) 2120 ((memq system-type '(ms-dos ms-windows))
2241 (setq w3-documents-menu-file (or w3-documents-menu-file 2121 (setq w3-hotlist-file (or w3-hotlist-file
2242 (expand-file-name "~/mosaic.mnu"))
2243 w3-hotlist-file (or w3-hotlist-file
2244 (expand-file-name "~/mosaic.hot")) 2122 (expand-file-name "~/mosaic.hot"))
2245 )) 2123 ))
2246 ((memq system-type '(axp-vms vax-vms)) 2124 ((memq system-type '(axp-vms vax-vms))
2247 (setq w3-documents-menu-file 2125 (setq w3-hotlist-file (or w3-hotlist-file
2248 (or w3-documents-menu-file
2249 (expand-file-name "decw$system_defaults:documents.menu"))
2250 w3-hotlist-file (or w3-hotlist-file
2251 (expand-file-name "~/mosaic.hotlist-default")) 2126 (expand-file-name "~/mosaic.hotlist-default"))
2252 )) 2127 ))
2253 (t 2128 (t
2254 (setq w3-documents-menu-file 2129 (setq w3-hotlist-file (or w3-hotlist-file
2255 (or w3-documents-menu-file
2256 (expand-file-name "/usr/local/lib/mosaic/documents.menu"))
2257 w3-hotlist-file (or w3-hotlist-file
2258 (expand-file-name "~/.mosaic-hotlist-default")) 2130 (expand-file-name "~/.mosaic-hotlist-default"))
2259 ))) 2131 )))
2260 2132
2261 (if (eq w3-delimit-emphasis 'guess)
2262 (setq w3-delimit-emphasis
2263 (and (not w3-running-xemacs)
2264 (not (and w3-running-FSF19
2265 (memq (device-type) '(x ns pm)))))))
2266
2267 (if (eq w3-delimit-links 'guess)
2268 (setq w3-delimit-links
2269 (and (not w3-running-xemacs)
2270 (not (and w3-running-FSF19
2271 (memq (device-type) '(x ns pm)))))))
2272
2273 ; Set up a hook that will save the history list when 2133 ; Set up a hook that will save the history list when
2274 ; exiting emacs 2134 ; exiting emacs
2275 (add-hook 'kill-emacs-hook 'w3-kill-emacs-func) 2135 (add-hook 'kill-emacs-hook 'w3-kill-emacs-func)
2276 2136
2277 (mm-parse-mailcaps) 2137 (mm-parse-mailcaps)
2284 ; the standard WWW_HOME, then default to the documentation @ IU 2144 ; the standard WWW_HOME, then default to the documentation @ IU
2285 (or w3-default-homepage 2145 (or w3-default-homepage
2286 (setq w3-default-homepage 2146 (setq w3-default-homepage
2287 (or (getenv "WWW_HOME") 2147 (or (getenv "WWW_HOME")
2288 "http://www.cs.indiana.edu/elisp/w3/docs.html"))) 2148 "http://www.cs.indiana.edu/elisp/w3/docs.html")))
2289
2290 ; Set up the documents menu
2291 (w3-parse-docs-menu)
2292 2149
2293 ; Set up the entity definition for PGP and PEM authentication 2150 ; Set up the entity definition for PGP and PEM authentication
2294 2151
2295 (run-hooks 'w3-load-hook) 2152 (run-hooks 'w3-load-hook)
2296 (setq w3-setup-done t)) 2153 (setq w3-setup-done t))