Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children c53a95d3c46d
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
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/03/07 16:44:12 3 ;; Created: 1997/03/14 06:39:41
4 ;; Version: 1.93 4 ;; Version: 1.98
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.
128 128
129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130 ;;; Functions to pass files off to external viewers 130 ;;; Functions to pass files off to external viewers
131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132 (defun w3-start-viewer (fname cmd &optional view) 132 (defun w3-start-viewer (fname cmd &optional view)
133 "Start a subprocess, named FNAME, executing CMD 133 "Start a subprocess, named FNAME, executing CMD.
134 If third arg VIEW is non-nil, show the output in a buffer when 134 If third arg VIEW is non-nil, show the output in a buffer when
135 the subprocess exits." 135 the subprocess exits."
136 (if view (save-excursion 136 (if view (save-excursion
137 (set-buffer (get-buffer-create view)) 137 (set-buffer (get-buffer-create view))
138 (erase-buffer))) 138 (erase-buffer)))
139 (let ((proc 139 (start-process fname view shell-file-name shell-command-switch cmd))
140 (start-process fname view (or shell-file-name
141 (getenv "ESHELL")
142 (getenv "SHELL")
143 "/bin/sh") "-c" cmd)))
144 proc))
145 140
146 (defun w3-viewer-filter (proc string) 141 (defun w3-viewer-filter (proc string)
147 ;; A process filter for asynchronous external viewers 142 ;; A process filter for asynchronous external viewers
148 (let ((buff (get-buffer-create (url-generate-new-buffer-name 143 (let ((buff (get-buffer-create (url-generate-new-buffer-name
149 (symbol-name 144 (symbol-name
276 (file-name-nondirectory (url-view-url t))))) 271 (file-name-nondirectory (url-view-url t)))))
277 (require-final-newline nil)) 272 (require-final-newline nil))
278 (set-buffer old-buff) 273 (set-buffer old-buff)
279 (mule-write-region-no-coding-system (point-min) (point-max) file) 274 (mule-write-region-no-coding-system (point-min) (point-max) file)
280 (kill-buffer (current-buffer)))) 275 (kill-buffer (current-buffer))))
281
282 (defun w3-build-url (protocol)
283 "Build a url for PROTOCOL, return it as a string"
284 (interactive (list (cdr (assoc (completing-read
285 "Protocol: "
286 w3-acceptable-protocols-alist nil t)
287 w3-acceptable-protocols-alist))))
288 (let (user host port file)
289 (cond
290 ((null protocol) (error "Protocol is unknown to me!"))
291 ((string= protocol "news")
292 (setq host (read-string "Enter news server name, or blank for default: ")
293 port (read-string "Enter port number, or blank for default: ")
294 file (read-string "Newgroup name or Message-ID: ")))
295 ((string= protocol "mailto") (setq file (read-string "E-mail address: ")))
296 ((string= protocol "http")
297 (setq host (read-string "Enter server name: ")
298 port (read-string "Enter port number, or blank for default: ")
299 file (read-string "Remote file: "))
300 (and (string= "" port) (setq port nil))
301 (and (string= "" host) (error "Must specify a remote machine!")))
302 ((string= protocol "file")
303 (if (funcall url-confirmation-func "Local file?")
304 (setq file (read-file-name "Local File: " nil nil t))
305 (setq user (read-string "Login as user (blank=anonymous): ")
306 host (read-string "Remote machine name: "))
307 (and (string= user "") (setq user "anonymous"))
308 (and (string= host "") (error "Must specify a remote machine!"))
309 (setq file (read-file-name "File: " (format "/%s@%s:" user host)
310 nil t)
311 file (substring file (length (format "/%s@%s:" user host))))))
312 ((or (string= protocol "telnet")
313 (string= protocol "tn3270"))
314 (setq user (read-string "Login as user (blank=none): ")
315 host (read-string "Remote machine name: ")
316 port (read-string "Port number (blank=23): "))
317 (and (string= "" port) (setq port nil))
318 (and (string= "" user) (setq user nil))
319 (and (string= "" host) (error "Must specify a host machine!")))
320 ((string= protocol "gopher")
321 (setq host (read-string "Enter server name: ")
322 port (read-string "Enter port number, or blank for default: ")
323 file (read-string "Remote file: "))
324 (and (string= "" port) (setq port nil))
325 (and (string= "" host) (error "Must specify a remote machine!"))))
326 (message "%s:%s%s"
327 protocol
328 (if (null host) "" (concat "//" host
329 (if (null port) "" (concat ":" port))))
330 (if (= ?/ (string-to-char file)) file (concat "/" file)))))
331 276
332 ;;;###autoload 277 ;;;###autoload
333 (defun w3-open-local (fname) 278 (defun w3-open-local (fname)
334 "Find a local file, and interpret it as a hypertext document. 279 "Find a local file, and interpret it as a hypertext document.
335 It will prompt for an existing file or directory, and retrieve it as a 280 It will prompt for an existing file or directory, and retrieve it as a
651 (lastmod (or (cdr-safe (assoc "last-modified" 596 (lastmod (or (cdr-safe (assoc "last-modified"
652 url-current-mime-headers)) 597 url-current-mime-headers))
653 (nth 5 attributes))) 598 (nth 5 attributes)))
654 (hdrs url-current-mime-headers) 599 (hdrs url-current-mime-headers)
655 (size (or (cdr (assoc "content-length" url-current-mime-headers)) 600 (size (or (cdr (assoc "content-length" url-current-mime-headers))
656 (point-max))) 601 (buffer-size)))
657 (info w3-current-metainfo)) 602 (info w3-current-metainfo))
658 (set-buffer (get-buffer-create url-working-buffer)) 603 (set-buffer (get-buffer-create url-working-buffer))
659 (setq url-current-can-be-cached nil) 604 (setq url-current-can-be-cached nil)
660 (erase-buffer) 605 (erase-buffer)
661 (cond 606 (cond
965 url))) 910 url)))
966 ((equal "LaTeX Source" format) 911 ((equal "LaTeX Source" format)
967 (setq content-type "application/x-latex; charset=iso-8859-1") 912 (setq content-type "application/x-latex; charset=iso-8859-1")
968 (w3-parse-tree-to-latex w3-current-parse url))) 913 (w3-parse-tree-to-latex w3-current-parse url)))
969 (buffer-string)))) 914 (buffer-string))))
970 (funcall w3-mail-command) 915 (funcall url-mail-command)
971 (mail-subject) 916 (mail-subject)
972 (if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag) 917 (if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag)
973 (insert format " from <URL: " url ">") 918 (insert format " from <URL: " url ">")
974 (insert format " from <URL: " url ">\n" 919 (insert format " from <URL: " url ">\n"
975 "Mime-Version: 1.0\n" 920 "Mime-Version: 1.0\n"
2006 (or w3-default-configuration-file 1951 (or w3-default-configuration-file
2007 "profile") 1952 "profile")
2008 w3-configuration-directory)) 1953 w3-configuration-directory))
2009 1954
2010 1955
2011 (if (and w3-default-configuration-file 1956 (if (and init-file-user
1957 w3-default-configuration-file
2012 (file-exists-p w3-default-configuration-file)) 1958 (file-exists-p w3-default-configuration-file))
2013 (condition-case e 1959 (condition-case e
2014 (load w3-default-configuration-file nil t) 1960 (load w3-default-configuration-file nil t)
2015 (error 1961 (error
2016 (let ((buf-name " *Configuration Error*")) 1962 (let ((buf-name " *Configuration Error*"))
2025 (concat 1971 (concat
2026 "Configuration file `%s' contains an error.\n" 1972 "Configuration file `%s' contains an error.\n"
2027 "Please consult the `%s' buffer for details.")) 1973 "Please consult the `%s' buffer for details."))
2028 w3-default-configuration-file buf-name)))))) 1974 w3-default-configuration-file buf-name))))))
2029 1975
2030 (setq w3-netscape-configuration-file
2031 (cond
2032 (w3-netscape-configuration-file
2033 w3-netscape-configuration-file)
2034 ((memq system-type '(ms-dos ms-windows))
2035 (expand-file-name "~/NETSCAPE.CFG"))
2036 (t (expand-file-name "~/.netscape/preferences"))))
2037
2038 (if (and (eq w3-user-colors-take-precedence 'guess) 1976 (if (and (eq w3-user-colors-take-precedence 'guess)
2039 (not (eq (device-type) 'tty)) 1977 (not (eq (device-type) 'tty))
2040 (not (eq (device-class) 'mono))) 1978 (not (eq (device-class) 'mono)))
2041 (progn 1979 (progn
2042 (setq w3-user-colors-take-precedence t) 1980 (setq w3-user-colors-take-precedence t)
2048 (if (not url-global-history-file) 1986 (if (not url-global-history-file)
2049 (setq url-global-history-file 1987 (setq url-global-history-file
2050 (expand-file-name "history" 1988 (expand-file-name "history"
2051 w3-configuration-directory))) 1989 w3-configuration-directory)))
2052 1990
2053 (if (and w3-use-netscape-configuration-file
2054 w3-netscape-configuration-file
2055 (fboundp 'w3-read-netscape-config))
2056 (w3-read-netscape-config w3-netscape-configuration-file))
2057
2058 (add-minor-mode 'w3-netscape-emulation-minor-mode " NS" 1991 (add-minor-mode 'w3-netscape-emulation-minor-mode " NS"
2059 w3-netscape-emulation-minor-mode-map) 1992 w3-netscape-emulation-minor-mode-map)
2060 (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx" 1993 (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx"
2061 w3-lynx-emulation-minor-mode-map) 1994 w3-lynx-emulation-minor-mode-map)
2062 1995
2273 (setq major-mode 'w3-mode) 2206 (setq major-mode 'w3-mode)
2274 (setq mode-name "WWW") 2207 (setq mode-name "WWW")
2275 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp) 2208 (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp)
2276 (w3-mode-version-specifics) 2209 (w3-mode-version-specifics)
2277 (w3-menu-install-menus) 2210 (w3-menu-install-menus)
2278 (run-hooks 'w3-mode-hook)
2279 (widget-setup)
2280 (setq url-current-passwd-count 0 2211 (setq url-current-passwd-count 0
2281 inhibit-read-only nil 2212 inhibit-read-only nil
2282 truncate-lines t 2213 truncate-lines t
2283 mode-line-format w3-modeline-format) 2214 mode-line-format w3-modeline-format)
2215 (run-hooks 'w3-mode-hook)
2216 (widget-setup)
2284 (if w3-current-isindex 2217 (if w3-current-isindex
2285 (setq mode-line-process "-Searchable"))))) 2218 (setq mode-line-process "-Searchable")))))
2286 2219
2287 (require 'mm) 2220 (require 'mm)
2288 (require 'url) 2221 (require 'url)