Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 8fc7fe29b841
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
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/01/29 06:25:59 3 ;; Created: 1997/02/08 00:49:52
4 ;; Version: 1.61 4 ;; Version: 1.72
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.
558 ((and url-be-asynchronous 558 ((and url-be-asynchronous
559 (not cached)) 559 (not cached))
560 (save-excursion 560 (save-excursion
561 (set-buffer url-working-buffer) 561 (set-buffer url-working-buffer)
562 (if x 562 (if x
563 (w3-add-urls-to-history x (url-view-url t))) 563 (w3-history-push x (url-view-url t)))
564 (setq w3-current-last-buffer lastbuf))) 564 (setq w3-current-last-buffer lastbuf)))
565 (t 565 (t
566 (w3-add-urls-to-history x url) 566 (w3-history-push x url)
567 (w3-sentinel lastbuf) 567 (w3-sentinel lastbuf)
568 )))) 568 (if (string-match "#\\(.*\\)" url)
569 (progn
570 (push-mark (point) t)
571 (w3-find-specific-link (match-string 1 url))))))))
569 (if w3-track-last-buffer 572 (if w3-track-last-buffer
570 (setq w3-last-buffer buf)) 573 (setq w3-last-buffer buf))
571 (let ((w3-notify (if (memq w3-notify '(newframe bully 574 (let ((w3-notify (if (memq w3-notify '(newframe bully
572 semibully aggressive)) 575 semibully aggressive))
573 w3-notify 576 w3-notify
582 585
583 586
584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 587 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585 ;;; History for forward/back buttons 588 ;;; History for forward/back buttons
586 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 589 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
587 (defvar w3-node-history nil "History for forward and backward jumping") 590 (defvar w3-history-stack nil
588 591 "History stack viewing history.
589 (defun w3-plot-course () 592 This is an assoc list, with the oldest items first.
590 "Show a map of where the user has been in this session of W3. !!!!NYI!!!" 593 Each element is a cons cell of (url . timeobj), where URL
591 (interactive) 594 is the normalized URL (default ports removed, etc), and TIMEOBJ is
592 (error "Sorry, w3-plot-course is not yet implemented.")) 595 a standard Emacs time. See the `current-time' function documentation
593 596 for information on this format.")
594 (defun w3-forward-in-history () 597
598 (defun w3-history-find-url-internal (url)
599 "Search in the history list for URL.
600 Returns a cons cell, where the car is the 'back' node, and
601 the cdr is the 'next' node."
602 (let* ((node (assoc url w3-history-stack))
603 (next (cadr (memq node w3-history-stack)))
604 (last nil)
605 (temp nil)
606 (todo w3-history-stack))
607 ;; Last node is a little harder to find without using back links
608 (while (and (not last) todo)
609 (if (string= (caar todo) url)
610 (setq last (or temp 'none))
611 (setq temp (pop todo))))
612 (cons (if (not (symbolp last)) last)
613 next)))
614
615 (defun w3-history-forward ()
595 "Go forward in the history from this page" 616 "Go forward in the history from this page"
596 (interactive) 617 (interactive)
597 (let* ((thisurl (url-view-url t)) 618 (let ((next (cadr (w3-history-find-url-internal (url-view-url t))))
598 (node (assoc (if (string= "" thisurl) (current-buffer) thisurl) 619 (w3-reuse-buffers 'yes))
599 w3-node-history)) 620 (if next
600 (url (cdr node)) 621 (w3-fetch next))))
601 (w3-reuse-buffers 'yes)) 622
602 (cond 623 (defun w3-history-backward ()
603 ((null url) (error "No forward found for %s" thisurl))
604 ((and (bufferp url) (buffer-name url))
605 (switch-to-buffer url))
606 ((stringp url)
607 (w3-fetch url))
608 ((bufferp url)
609 (setq w3-node-history (delete node w3-node-history))
610 (error "Killed buffer in history, removed."))
611 (t
612 (error "Something is very wrong with the history!")))))
613
614 (defun w3-backward-in-history ()
615 "Go backward in the history from this page" 624 "Go backward in the history from this page"
616 (interactive) 625 (interactive)
617 (let* ((thisurl (url-view-url t)) 626 (let ((last (caar (w3-history-find-url-internal (url-view-url t))))
618 (node (rassoc (if (string= thisurl "") (current-buffer) thisurl) 627 (w3-reuse-buffers 'yes))
619 w3-node-history)) 628 (if last
620 (url (car node)) 629 (w3-fetch last))))
621 (w3-reuse-buffers 'yes)) 630
622 (cond 631 (defun w3-history-push (referer url)
623 ((null url) (error "No backward found for %s" thisurl))
624 ((and (bufferp url) (buffer-name url))
625 (switch-to-buffer url))
626 ((stringp url)
627 (w3-fetch url))
628 ((bufferp url)
629 (setq w3-node-history (delete node w3-node-history))
630 (error "Killed buffer in history, removed."))
631 (t
632 (error "Something is very wrong with the history!")))))
633
634 (defun w3-add-urls-to-history (referer url)
635 "REFERER is the url we followed this link from. URL is the link we got to." 632 "REFERER is the url we followed this link from. URL is the link we got to."
636 (let ((node (assoc referer w3-node-history))) 633 (if (not referer)
637 (if node 634 (setq w3-history-stack (list (cons url (current-time))))
638 (setcdr node url) 635 (let ((node (memq (assoc referer w3-history-stack) w3-history-stack)))
639 (setq w3-node-history (cons (cons referer url) w3-node-history))))) 636 (if node
637 (setcdr node (list (cons url (current-time))))))))
638
639 (defalias 'w3-add-urls-to-history 'w3-history-push)
640 (defalias 'w3-backward-in-history 'w3-history-backward)
641 (defalias 'w3-forward-in-history 'w3-history-forward)
640 642
641 643
642 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 644 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
643 ;;; Miscellaneous functions 645 ;;; Miscellaneous functions
644 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 646 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1065 (setq content-type "application/postscript") 1067 (setq content-type "application/postscript")
1066 (w3-fetch url) 1068 (w3-fetch url)
1067 (let ((ps-spool-buffer-name " *w3-temp*")) 1069 (let ((ps-spool-buffer-name " *w3-temp*"))
1068 (if (get-buffer ps-spool-buffer-name) 1070 (if (get-buffer ps-spool-buffer-name)
1069 (kill-buffer ps-spool-buffer-name)) 1071 (kill-buffer ps-spool-buffer-name))
1070 (w3-print-with-ps-print (current-buffer) 1072 (ps-spool-buffer-with-faces)
1071 'ps-spool-buffer-with-faces)
1072 (set-buffer ps-spool-buffer-name))) 1073 (set-buffer ps-spool-buffer-name)))
1073 ((equal "PostScript" format) 1074 ((equal "PostScript" format)
1074 (let ((ps-spool-buffer-name " *w3-temp*")) 1075 (let ((ps-spool-buffer-name " *w3-temp*"))
1075 (if (get-buffer ps-spool-buffer-name) 1076 (if (get-buffer ps-spool-buffer-name)
1076 (kill-buffer ps-spool-buffer-name)) 1077 (kill-buffer ps-spool-buffer-name))
1077 (setq content-type "application/postscript") 1078 (setq content-type "application/postscript")
1078 (w3-print-with-ps-print (current-buffer) 1079 (ps-spool-buffer-with-faces)
1079 'ps-spool-buffer-with-faces)
1080 (set-buffer ps-spool-buffer-name))) 1080 (set-buffer ps-spool-buffer-name)))
1081 ((and under (equal "Formatted Text" format)) 1081 ((and under (equal "Formatted Text" format))
1082 (setq content-type "text/plain; charset=iso-8859-1") 1082 (setq content-type "text/plain; charset=iso-8859-1")
1083 (w3-fetch url)) 1083 (w3-fetch url))
1084 ((equal "Formatted Text" format) 1084 ((equal "Formatted Text" format)
1087 (let ((old-asynch url-be-asynchronous)) 1087 (let ((old-asynch url-be-asynchronous))
1088 (setq content-type "application/x-latex; charset=iso-8859-1") 1088 (setq content-type "application/x-latex; charset=iso-8859-1")
1089 (setq-default url-be-asynchronous nil) 1089 (setq-default url-be-asynchronous nil)
1090 (url-retrieve url) 1090 (url-retrieve url)
1091 (setq-default url-be-asynchronous old-asynch) 1091 (setq-default url-be-asynchronous old-asynch)
1092 (w3-parse-tree-to-latex (w3-parse-buffer (current-buffer) t) 1092 (w3-parse-tree-to-latex (w3-parse-buffer (current-buffer))
1093 url))) 1093 url)))
1094 ((equal "LaTeX Source" format) 1094 ((equal "LaTeX Source" format)
1095 (setq content-type "application/x-latex; charset=iso-8859-1") 1095 (setq content-type "application/x-latex; charset=iso-8859-1")
1096 (w3-parse-tree-to-latex w3-current-parse url))) 1096 (w3-parse-tree-to-latex w3-current-parse url)))
1097 (buffer-string)))) 1097 (buffer-string))))
1268 specify formatting for text. More information on HTML can be found at 1268 specify formatting for text. More information on HTML can be found at
1269 ftp.w3.org:/pub/www/doc." 1269 ftp.w3.org:/pub/www/doc."
1270 (interactive) 1270 (interactive)
1271 (w3-fetch (concat "www://preview/" (buffer-name)))) 1271 (w3-fetch (concat "www://preview/" (buffer-name))))
1272 1272
1273 (defun w3-edit-source ()
1274 "Edit the html document just retrieved"
1275 (set-buffer url-working-buffer)
1276 (let ((ttl (format "Editing %s Annotation: %s"
1277 (cond
1278 ((eq w3-editing-annotation 'group) "Group")
1279 ((eq w3-editing-annotation 'personal) "Personal")
1280 (t "Unknown"))
1281 (url-basepath url-current-file t)))
1282 (str (buffer-string)))
1283 (set-buffer (get-buffer-create ttl))
1284 (insert str)
1285 (kill-buffer url-working-buffer)))
1286
1287 (defun w3-source () 1273 (defun w3-source ()
1288 "Show the source of a file" 1274 "Show the source of a file"
1289 (let ((tmp (buffer-name (generate-new-buffer "Document Source")))) 1275 (let ((tmp (buffer-name (generate-new-buffer "Document Source"))))
1290 (set-buffer url-working-buffer) 1276 (set-buffer url-working-buffer)
1291 (kill-buffer tmp) 1277 (kill-buffer tmp)
1326 url-current-file)) 1312 url-current-file))
1327 "text/html"))))) 1313 "text/html")))))
1328 (if (not (string-match "^www:" (or (url-view-url t) ""))) 1314 (if (not (string-match "^www:" (or (url-view-url t) "")))
1329 (w3-convert-code-for-mule url-current-mime-type)) 1315 (w3-convert-code-for-mule url-current-mime-type))
1330 1316
1331 (let ((x (w3-build-continuation))) 1317 (let ((x (w3-build-continuation))
1318 (url (url-view-url t)))
1332 (while x 1319 (while x
1333 (funcall (pop x))))) 1320 (funcall (pop x)))))
1334 1321
1335 (defun w3-show-history-list () 1322 (defun w3-show-history-list ()
1336 "Format the url-history-list prettily and show it to the user" 1323 "Format the url-history-list prettily and show it to the user"
1375 nil) ; Do nothing - we have the text already 1362 nil) ; Do nothing - we have the text already
1376 ((equal "PostScript" format) 1363 ((equal "PostScript" format)
1377 (let ((ps-spool-buffer-name " *w3-temp*")) 1364 (let ((ps-spool-buffer-name " *w3-temp*"))
1378 (if (get-buffer ps-spool-buffer-name) 1365 (if (get-buffer ps-spool-buffer-name)
1379 (kill-buffer ps-spool-buffer-name)) 1366 (kill-buffer ps-spool-buffer-name))
1380 (w3-print-with-ps-print (current-buffer) 1367 (ps-spool-buffer-with-faces)
1381 'ps-spool-buffer-with-faces)
1382 (set-buffer ps-spool-buffer-name))) 1368 (set-buffer ps-spool-buffer-name)))
1383 ((equal "LaTeX Source" format) 1369 ((equal "LaTeX Source" format)
1384 (w3-parse-tree-to-latex w3-current-parse url) 1370 (w3-parse-tree-to-latex w3-current-parse url)
1385 (insert-buffer url-working-buffer))) 1371 (insert-buffer url-working-buffer)))
1386 (write-region (point-min) (point-max) fname)))) 1372 (write-region (point-min) (point-max) fname))))
1908 href) 1894 href)
1909 (href 1895 (href
1910 (message "%s" (url-truncate-url-for-viewing href))) 1896 (message "%s" (url-truncate-url-for-viewing href)))
1911 (no-show 1897 (no-show
1912 nil) 1898 nil)
1899 (widget
1900 (widget-echo-help (point)))
1913 (t 1901 (t
1914 nil)))) 1902 nil))))
1915 1903
1916 (defun w3-load-delayed-images () 1904 (defun w3-load-delayed-images ()
1917 "Load inlined images that were delayed, if any." 1905 "Load inlined images that were delayed, if any."
2230 (fboundp 'w3-read-netscape-config)) 2218 (fboundp 'w3-read-netscape-config))
2231 (w3-read-netscape-config w3-netscape-configuration-file)) 2219 (w3-read-netscape-config w3-netscape-configuration-file))
2232 2220
2233 (add-minor-mode 'w3-netscape-emulation-minor-mode " NS" 2221 (add-minor-mode 'w3-netscape-emulation-minor-mode " NS"
2234 w3-netscape-emulation-minor-mode-map) 2222 w3-netscape-emulation-minor-mode-map)
2235 (add-minor-mode 'w3-annotation-minor-mode " Annotating"
2236 w3-annotation-minor-mode-map)
2237 (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx" 2223 (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx"
2238 w3-lynx-emulation-minor-mode-map) 2224 w3-lynx-emulation-minor-mode-map)
2239 2225
2240 (setq url-package-version w3-version-number 2226 (setq url-package-version w3-version-number
2241 url-package-name "Emacs-W3") 2227 url-package-name "Emacs-W3")
2254 ((memq system-type '(ms-dos ms-windows)) 2240 ((memq system-type '(ms-dos ms-windows))
2255 (setq w3-documents-menu-file (or w3-documents-menu-file 2241 (setq w3-documents-menu-file (or w3-documents-menu-file
2256 (expand-file-name "~/mosaic.mnu")) 2242 (expand-file-name "~/mosaic.mnu"))
2257 w3-hotlist-file (or w3-hotlist-file 2243 w3-hotlist-file (or w3-hotlist-file
2258 (expand-file-name "~/mosaic.hot")) 2244 (expand-file-name "~/mosaic.hot"))
2259 w3-personal-annotation-directory (or w3-personal-annotation-directory 2245 ))
2260 (expand-file-name
2261 "~/mosaic.ann"))))
2262 ((memq system-type '(axp-vms vax-vms)) 2246 ((memq system-type '(axp-vms vax-vms))
2263 (setq w3-documents-menu-file 2247 (setq w3-documents-menu-file
2264 (or w3-documents-menu-file 2248 (or w3-documents-menu-file
2265 (expand-file-name "decw$system_defaults:documents.menu")) 2249 (expand-file-name "decw$system_defaults:documents.menu"))
2266 w3-hotlist-file (or w3-hotlist-file 2250 w3-hotlist-file (or w3-hotlist-file
2267 (expand-file-name "~/mosaic.hotlist-default")) 2251 (expand-file-name "~/mosaic.hotlist-default"))
2268 w3-personal-annotation-directory 2252 ))
2269 (or w3-personal-annotation-directory
2270 (expand-file-name "~/mosaic-annotations/"))))
2271 (t 2253 (t
2272 (setq w3-documents-menu-file 2254 (setq w3-documents-menu-file
2273 (or w3-documents-menu-file 2255 (or w3-documents-menu-file
2274 (expand-file-name "/usr/local/lib/mosaic/documents.menu")) 2256 (expand-file-name "/usr/local/lib/mosaic/documents.menu"))
2275 w3-hotlist-file (or w3-hotlist-file 2257 w3-hotlist-file (or w3-hotlist-file
2276 (expand-file-name "~/.mosaic-hotlist-default")) 2258 (expand-file-name "~/.mosaic-hotlist-default"))
2277 w3-personal-annotation-directory 2259 )))
2278 (or w3-personal-annotation-directory
2279 (expand-file-name "~/.mosaic-personal-annotations")))))
2280 2260
2281 (if (eq w3-delimit-emphasis 'guess) 2261 (if (eq w3-delimit-emphasis 'guess)
2282 (setq w3-delimit-emphasis 2262 (setq w3-delimit-emphasis
2283 (and (not w3-running-xemacs) 2263 (and (not w3-running-xemacs)
2284 (not (and w3-running-FSF19 2264 (not (and w3-running-FSF19
2297 (mm-parse-mailcaps) 2277 (mm-parse-mailcaps)
2298 (mm-parse-mimetypes) 2278 (mm-parse-mimetypes)
2299 2279
2300 ; Load in the hotlist if they haven't set it already 2280 ; Load in the hotlist if they haven't set it already
2301 (or w3-hotlist (w3-parse-hotlist)) 2281 (or w3-hotlist (w3-parse-hotlist))
2302
2303 ; Load in their personal annotations if they haven't set them already
2304 (or w3-personal-annotations (w3-parse-personal-annotations))
2305 2282
2306 ; Set the default home page, honoring their defaults, then 2283 ; Set the default home page, honoring their defaults, then
2307 ; the standard WWW_HOME, then default to the documentation @ IU 2284 ; the standard WWW_HOME, then default to the documentation @ IU
2308 (or w3-default-homepage 2285 (or w3-default-homepage
2309 (setq w3-default-homepage 2286 (setq w3-default-homepage
2481 (w3-mode-version-specifics) 2458 (w3-mode-version-specifics)
2482 (w3-menu-install-menus) 2459 (w3-menu-install-menus)
2483 (run-hooks 'w3-mode-hook) 2460 (run-hooks 'w3-mode-hook)
2484 (widget-setup) 2461 (widget-setup)
2485 (setq url-current-passwd-count 0 2462 (setq url-current-passwd-count 0
2463 inhibit-read-only nil
2486 truncate-lines t 2464 truncate-lines t
2487 mode-line-format w3-modeline-format) 2465 mode-line-format w3-modeline-format)
2488 (if (and w3-current-isindex (equal url-current-type "http")) 2466 (if (and w3-current-isindex (equal url-current-type "http"))
2489 (setq mode-line-process "-Searchable"))))) 2467 (setq mode-line-process "-Searchable")))))
2490 2468