Mercurial > hg > xemacs-beta

comparison lisp/w3/w3.el @ 169:15872534500d r20-3b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b11
author cvs
date Mon, 13 Aug 2007 09:46:53 +0200
parents 5a88923fcbfe
children 8eaf7971accc
comparison
equal deleted inserted replaced
168:9851d5c6556e 169:15872534500d
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/06/24 22:38:28 3 ;; Created: 1997/06/30 05:29:38
4 ;; Version: 1.130 4 ;; Version: 1.134
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.
695 (let (buff str) 695 (let (buff str)
696 (cond 696 (cond
697 (p 697 (p
698 (setq p (widget-at (point))) 698 (setq p (widget-at (point)))
699 (or p (error "No url under point")) 699 (or p (error "No url under point"))
700 (setq str (format "<a href=\"%s\">%s</a>" (widget-get p 'href) 700 (setq str (format "<a href=\"%s\">%s</a>" (widget-get p :href)
701 (read-string "Link text: " 701 (read-string "Link text: "
702 (buffer-substring 702 (buffer-substring
703 (widget-get p :from) 703 (widget-get p :from)
704 (widget-get p :to)))))) 704 (widget-get p :to))))))
705 (t 705 (t
762 url-get-url-at-point" 762 url-get-url-at-point"
763 (interactive) 763 (interactive)
764 (require 'w3) 764 (require 'w3)
765 (if (not w3-setup-done) (w3-do-setup)) 765 (if (not w3-setup-done) (w3-do-setup))
766 (let* ((widget (widget-at (point))) 766 (let* ((widget (widget-at (point)))
767 (url1 (and widget (widget-get widget 'href))) 767 (url1 (and widget (widget-get widget :href)))
768 (url2 (url-get-url-at-point))) 768 (url2 (url-get-url-at-point)))
769 (cond 769 (cond
770 (url1 (w3-follow-link)) 770 (url1 (widget-button-press))
771 ((and url2 (string-match url-nonrelative-link url2)) (w3-fetch url2)) 771 ((and url2 (string-match url-nonrelative-link url2)) (w3-fetch url2))
772 (t (message "No URL could be found!"))))) 772 (t (message "No URL could be found!")))))
773 773
774 ;;;###autoload 774 ;;;###autoload
775 (defun w3-follow-url-at-point-other-frame (&optional pt) 775 (defun w3-follow-url-at-point-other-frame (&optional pt)
1336 ;; Load the correct emacsen specific stuff 1336 ;; Load the correct emacsen specific stuff
1337 (cond 1337 (cond
1338 ((and w3-running-xemacs (eq system-type 'ms-windows)) 1338 ((and w3-running-xemacs (eq system-type 'ms-windows))
1339 (error "WinEmacs no longer supported.")) 1339 (error "WinEmacs no longer supported."))
1340 (w3-running-xemacs (require 'w3-xemac)) 1340 (w3-running-xemacs (require 'w3-xemac))
1341 (w3-running-FSF19 (require 'w3-e19)) 1341 (t ; Assume we are the FSF variant
1342 (t 1342 (require (intern (format "w3-e%d" emacs-major-version)))))
1343 (error "Unable to determine the capabilities of this emacs.")))
1344 (if (featurep 'emacspeak) 1343 (if (featurep 'emacspeak)
1345 (condition-case () 1344 (condition-case ()
1346 (progn 1345 (progn
1347 (require 'dtk-css-speech) 1346 (require 'dtk-css-speech)
1348 (require 'w3-speak)))) 1347 (require 'w3-speak))))
1689 (defun w3-view-this-url (&optional no-show) 1688 (defun w3-view-this-url (&optional no-show)
1690 "View the URL of the link under point" 1689 "View the URL of the link under point"
1691 (interactive) 1690 (interactive)
1692 (let* ((widget (widget-at (point))) 1691 (let* ((widget (widget-at (point)))
1693 (parent (and widget (widget-get widget :parent))) 1692 (parent (and widget (widget-get widget :parent)))
1694 (href (or (and widget (widget-get widget 'href)) 1693 (href (or (and widget (widget-get widget :href))
1695 (and parent (widget-get parent 'href))))) 1694 (and parent (widget-get parent :href)))))
1696 (cond 1695 (cond
1697 ((and no-show href) 1696 ((and no-show href)
1698 href) 1697 href)
1699 (href 1698 (href
1700 (message "%s" (url-truncate-url-for-viewing href))) 1699 (message "%s" (url-truncate-url-for-viewing href)))
1919 (directories (list 1918 (directories (list
1920 data-directory 1919 data-directory
1921 (concat data-directory "w3/") 1920 (concat data-directory "w3/")
1922 (expand-file-name "../../w3" data-directory) 1921 (expand-file-name "../../w3" data-directory)
1923 (file-name-directory (locate-library "w3")) 1922 (file-name-directory (locate-library "w3"))
1923 (expand-file-name "../" (file-name-directory
1924 (locate-library "w3")))
1924 (expand-file-name "../w3" (file-name-directory 1925 (expand-file-name "../w3" (file-name-directory
1925 (locate-library "w3"))) 1926 (locate-library "w3")))
1927 (expand-file-name "../etc" (file-name-directory
1928 (locate-library "w3")))
1926 w3-configuration-directory)) 1929 w3-configuration-directory))
1927 (total-found 0) 1930 (total-found 0)
1928 (possible (append 1931 (possible (append
1929 (apply 1932 (apply
1930 'append 1933 'append
2152 "Attempt to follow the hypertext reference under point. 2155 "Attempt to follow the hypertext reference under point.
2153 With prefix-arg P, ignore viewers and dump the link straight 2156 With prefix-arg P, ignore viewers and dump the link straight
2154 to disk." 2157 to disk."
2155 (interactive "P") 2158 (interactive "P")
2156 (let* ((widget (widget-at (point))) 2159 (let* ((widget (widget-at (point)))
2157 (href (and widget (widget-get widget 'href)))) 2160 (href (and widget (widget-get widget :href))))
2158 (cond 2161 (cond
2159 ((null href) nil) 2162 ((null href) nil)
2160 ((or p w3-dump-to-disk) 2163 ((or p w3-dump-to-disk)
2161 (w3-download-url href)) 2164 (w3-download-url href))
2162 (t 2165 (t
2182 choice 2185 choice
2183 (completion-ignore-case t)) 2186 (completion-ignore-case t))
2184 (setq link-at-point (widget-at (point)) 2187 (setq link-at-point (widget-at (point))
2185 link-at-point (and 2188 link-at-point (and
2186 link-at-point 2189 link-at-point
2187 (widget-get link-at-point 'href) 2190 (widget-get link-at-point :href)
2188 (widget-get link-at-point :from) 2191 (widget-get link-at-point :from)
2189 (widget-get link-at-point :to) 2192 (widget-get link-at-point :to)
2190 (w3-fix-spaces 2193 (w3-fix-spaces
2191 (buffer-substring-no-properties 2194 (buffer-substring-no-properties
2192 (widget-get link-at-point :from) 2195 (widget-get link-at-point :from)
2199 (cons 2202 (cons
2200 (w3-fix-spaces 2203 (w3-fix-spaces
2201 (buffer-substring-no-properties 2204 (buffer-substring-no-properties
2202 (widget-get widget :from) 2205 (widget-get widget :from)
2203 (widget-get widget :to))) 2206 (widget-get widget :to)))
2204 (widget-get widget 'href)) 2207 (widget-get widget :href))
2205 links-alist)))))) 2208 links-alist))))))
2206 (if (not links-alist) (error "No links in current document.")) 2209 (if (not links-alist) (error "No links in current document."))
2207 (setq links-alist (sort links-alist (function 2210 (setq links-alist (sort links-alist (function
2208 (lambda (x y) 2211 (lambda (x y)
2209 (string< (car x) (car y)))))) 2212 (string< (car x) (car y))))))