Mercurial > hg > xemacs-beta

comparison lisp/w3/url.el @ 36:c53a95d3c46d r19-15b101

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b101
author cvs
date Mon, 13 Aug 2007 08:53:38 +0200
parents e04119814345
children 1a767b41a199
comparison
equal deleted inserted replaced
35:279432d5c479 36:c53a95d3c46d
1 ;;; url.el --- Uniform Resource Locator retrieval tool 1 ;;; url.el --- Uniform Resource Locator retrieval tool
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/09 06:19:51 3 ;; Created: 1997/03/18 01:08:13
4 ;; Version: 1.62 4 ;; Version: 1.65
5 ;; Keywords: comm, data, processes, hypermedia 5 ;; Keywords: comm, data, processes, hypermedia
6 6
7 ;;; LCD Archive Entry: 7 ;;; LCD Archive Entry:
8 ;;; url|William M. Perry|wmperry@cs.indiana.edu| 8 ;;; url|William M. Perry|wmperry@cs.indiana.edu|
9 ;;; Functions for retrieving/manipulating URLs| 9 ;;; Functions for retrieving/manipulating URLs|
10 ;;; 1997/03/09 06:19:51|1.62|Location Undetermined 10 ;;; 1997/03/18 01:08:13|1.65|Location Undetermined
11 ;;; 11 ;;;
12 12
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) 14 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
15 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 15 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
920 ;; Filename handler stuff for emacsen that support it 920 ;; Filename handler stuff for emacsen that support it
921 (url-setup-file-name-handlers) 921 (url-setup-file-name-handlers)
922 922
923 (setq url-cookie-file 923 (setq url-cookie-file
924 (or url-cookie-file 924 (or url-cookie-file
925 (expand-file-name "~/.w3cookies"))) 925 (expand-file-name "~/.w3/cookies")))
926 926
927 (setq url-global-history-file 927 (setq url-global-history-file
928 (or url-global-history-file 928 (or url-global-history-file
929 (and (memq system-type '(ms-dos ms-windows)) 929 (and (memq system-type '(ms-dos ms-windows))
930 (expand-file-name "~/mosaic.hst")) 930 (expand-file-name "~/mosaic.hst"))
931 (and (memq system-type '(axp-vms vax-vms)) 931 (and (memq system-type '(axp-vms vax-vms))
932 (expand-file-name "~/mosaic.global-history")) 932 (expand-file-name "~/mosaic.global-history"))
933 (condition-case () 933 (condition-case ()
934 (expand-file-name "~/.mosaic-global-history") 934 (expand-file-name "~/.w3/history")
935 (error nil)))) 935 (error nil))))
936 936
937 ;; Parse the global history file if it exists, so that it can be used 937 ;; Parse the global history file if it exists, so that it can be used
938 ;; for URL completion, etc. 938 ;; for URL completion, etc.
939 (if (and url-global-history-file 939 (if (and url-global-history-file
1018 1018
1019 (url-setup-privacy-info) 1019 (url-setup-privacy-info)
1020 (run-hooks 'url-load-hook) 1020 (run-hooks 'url-load-hook)
1021 (setq url-setup-done t))) 1021 (setq url-setup-done t)))
1022 1022
1023 (defvar url-get-url-filename-chars "%.?@a-zA-Z0-9---()_/:~=&"
1024 "Valid characters in a URL")
1025
1023 ;;;###autoload 1026 ;;;###autoload
1024 (defun url-get-url-at-point (&optional pt) 1027 (defun url-get-url-at-point (&optional pt)
1025 "Get the URL closest to point, but don't change your 1028 "Get the URL closest to point, but don't change your
1026 position. Has a preference for looking backward when not 1029 position. Has a preference for looking backward when not
1027 directly on a symbol." 1030 directly on a symbol."
1028 ;; Not at all perfect - point must be right in the name. 1031 ;; Not at all perfect - point must be right in the name.
1029 (save-excursion 1032 (save-excursion
1030 (if pt (goto-char pt)) 1033 (if pt (goto-char pt))
1031 (let ((filename-chars "%.?@a-zA-Z0-9---()_/:~=&") start url) 1034 (let (start url)
1032 (save-excursion 1035 (save-excursion
1033 ;; first see if you're just past a filename 1036 ;; first see if you're just past a filename
1034 (if (not (eobp)) 1037 (if (not (eobp))
1035 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens 1038 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
1036 (progn 1039 (progn
1037 (skip-chars-backward " \n\t\r({[]})") 1040 (skip-chars-backward " \n\t\r({[]})")
1038 (if (not (bobp)) 1041 (if (not (bobp))
1039 (backward-char 1))))) 1042 (backward-char 1)))))
1040 (if (string-match (concat "[" filename-chars "]") 1043 (if (and (char-after (point))
1041 (char-to-string (following-char))) 1044 (string-match (eval-when-compile
1045 (concat "[" url-get-url-filename-chars "]"))
1046 (char-to-string (char-after (point)))))
1042 (progn 1047 (progn
1043 (skip-chars-backward filename-chars) 1048 (skip-chars-backward url-get-url-filename-chars)
1044 (setq start (point)) 1049 (setq start (point))
1045 (skip-chars-forward filename-chars)) 1050 (skip-chars-forward url-get-url-filename-chars))
1046 (setq start (point))) 1051 (setq start (point)))
1047 (setq url (if (fboundp 'buffer-substring-no-properties) 1052 (setq url (buffer-substring-no-properties start (point))))
1048 (buffer-substring-no-properties start (point))
1049 (buffer-substring start (point)))))
1050 (if (string-match "^URL:" url) 1053 (if (string-match "^URL:" url)
1051 (setq url (substring url 4 nil))) 1054 (setq url (substring url 4 nil)))
1052 (if (string-match "\\.$" url) 1055 (if (string-match "\\.$" url)
1053 (setq url (substring url 0 -1))) 1056 (setq url (substring url 0 -1)))
1054 (if (string-match "^www\\." url) 1057 (if (string-match "^www\\." url)