;;; url-util.el --- Miscellaneous helper routines for URL library
-;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(defun url-normalize-url (url)
"Return a 'normalized' version of URL.
Strips out default port numbers, etc."
- (let (type data grok retval)
+ (let (type data retval)
(setq data (url-generic-parse-url url)
type (url-type data))
(if (member type '("www" "about" "mailto" "info"))
(setq retval url)
- (url-set-target data nil)
+ (setf (url-target data) nil)
(setq retval (url-recreate-url data)))
retval))
(let* ((raw (if specified-time (current-time-string specified-time)
(current-time-string)))
(gmt (timezone-make-date-arpa-standard raw
- (nth 1 (current-time-zone))
+ (current-time-zone)
"GMT"))
(parsed (timezone-parse-date gmt))
- (day (cdr-safe (assoc (substring raw 0 3) weekday-alist)))
+ (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist)))
(year nil)
(month (car
(rassoc
- (string-to-int (aref parsed 1)) monthabbrev-alist)))
+ (string-to-number (aref parsed 1)) url-monthabbrev-alist)))
)
- (setq day (or (car-safe (rassoc day weekday-alist))
+ (setq day (or (car-safe (rassoc day url-weekday-alist))
(substring raw 0 3))
year (aref parsed 0))
;; This is needed for plexus servers, or the server will hang trying to
;;;###autoload
(defun url-display-percentage (fmt perc &rest args)
- (if (null fmt)
- (if (fboundp 'clear-progress-display)
- (clear-progress-display))
- (if (and (fboundp 'progress-display) perc)
- (apply 'progress-display fmt perc args)
- (apply 'message fmt args))))
+ (when url-show-status
+ (if (null fmt)
+ (if (fboundp 'clear-progress-display)
+ (clear-progress-display))
+ (if (and (fboundp 'progress-display) perc)
+ (apply 'progress-display fmt perc args)
+ (apply 'message fmt args)))))
;;;###autoload
(defun url-percentage (x y)
(/ (* x 100) y)))
;;;###autoload
-(defun url-basepath (file &optional x)
- "Return the base pathname of FILE, or the actual filename if X is true."
+(defun url-file-directory (file)
+ "Return the directory part of FILE, for a URL."
(cond
((null file) "")
((string-match (eval-when-compile (regexp-quote "?")) file)
- (if x
- (file-name-nondirectory (substring file 0 (match-beginning 0)))
- (file-name-directory (substring file 0 (match-beginning 0)))))
- (x (file-name-nondirectory file))
+ (file-name-directory (substring file 0 (match-beginning 0))))
(t (file-name-directory file))))
;;;###autoload
-(defun url-parse-query-string (query &optional downcase)
+(defun url-file-nondirectory (file)
+ "Return the nondirectory part of FILE, for a URL."
+ (cond
+ ((null file) "")
+ ((string-match (eval-when-compile (regexp-quote "?")) file)
+ (file-name-nondirectory (substring file 0 (match-beginning 0))))
+ (t (file-name-nondirectory file))))
+
+;;;###autoload
+(defun url-parse-query-string (query &optional downcase allow-newlines)
(let (retval pairs cur key val)
(setq pairs (split-string query "&"))
(while pairs
pairs (cdr pairs))
(if (not (string-match "=" cur))
nil ; Grace
- (setq key (url-unhex-string (substring cur 0 (match-beginning 0)))
- val (url-unhex-string (substring cur (match-end 0) nil)))
+ (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
+ allow-newlines))
+ (setq val (url-unhex-string (substring cur (match-end 0) nil)
+ allow-newlines))
(if downcase
(setq key (downcase key)))
(setq cur (assoc key retval))
This is taken from RFC 2396.")
;;;###autoload
-(defun url-hexify-string (str)
- "Escape characters in a string."
- (mapconcat
- (lambda (char)
- ;; Fixme: use a char table instead.
- (if (not (memq char url-unreserved-chars))
- (if (> char 255)
- (error "Hexifying multibyte character %s" str)
- (format "%%%02X" char))
- (char-to-string char)))
- str ""))
+(defun url-hexify-string (string)
+ "Return a new string that is STRING URI-encoded.
+First, STRING is converted to utf-8, if necessary. Then, for each
+character in the utf-8 string, those found in `url-unreserved-chars'
+are left as-is, all others are represented as a three-character
+string: \"%\" followed by two lowercase hex digits."
+ ;; To go faster and avoid a lot of consing, we could do:
+ ;;
+ ;; (defconst url-hexify-table
+ ;; (let ((map (make-vector 256 nil)))
+ ;; (dotimes (byte 256) (aset map byte
+ ;; (if (memq byte url-unreserved-chars)
+ ;; (char-to-string byte)
+ ;; (format "%%%02x" byte))))
+ ;; map))
+ ;;
+ ;; (mapconcat (curry 'aref url-hexify-table) ...)
+ (mapconcat (lambda (byte)
+ (if (memq byte url-unreserved-chars)
+ (char-to-string byte)
+ (format "%%%02x" byte)))
+ (if (multibyte-string-p string)
+ (encode-coding-string string 'utf-8)
+ string)
+ ""))
;;;###autoload
(defun url-file-extension (fname &optional x)
If optional variable X is t,
then return the basename of the file with the extension stripped off."
(if (and fname
- (setq fname (url-basepath fname t))
+ (setq fname (url-file-nondirectory fname))
(string-match "\\.[^./]+$" fname))
(if x (substring fname 0 (match-beginning 0))
(substring fname (match-beginning 0) nil))
WIDTH defaults to the current frame width."
(let* ((fr-width (or width (frame-width)))
(str-width (length url))
- (tail (file-name-nondirectory url))
(fname nil)
(modified 0)
(urlobj nil))
(if (and (>= str-width fr-width)
(string-match "?" url))
(setq url (concat (substring url 0 (match-beginning 0)) "?...")
- str-width (length url)
- tail (file-name-nondirectory url)))
+ str-width (length url)))
(if (< str-width fr-width)
nil ; Hey, we are done!
(setq urlobj (url-generic-parse-url url)
(string-match "/" fname))
(setq fname (substring fname (match-end 0) nil)
modified (1+ modified))
- (url-set-filename urlobj fname)
+ (setf (url-filename urlobj) fname)
(setq url (url-recreate-url urlobj)
str-width (length url)))
(if (> modified 1)
(setq fname (concat "/.../" fname))
(setq fname (concat "/" fname)))
- (url-set-filename urlobj fname)
+ (setf (url-filename urlobj) fname)
(setq url (url-recreate-url urlobj)))
url))
HCoop / bpt / emacs.git / blobdiff