;;; url-util.el --- Miscellaneous helper routines for URL library
-;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
;;
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
-;;
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;;
+
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'url-parse)
+(require 'url-vars)
(eval-when-compile (require 'cl))
(autoload 'timezone-parse-date "timezone")
(autoload 'timezone-make-date-arpa-standard "timezone")
;;;###autoload
(defcustom url-debug nil
- "*What types of debug messages from the URL library to show.
+ "What types of debug messages from the URL library to show.
Debug messages are logged to the *URL-DEBUG* buffer.
If t, all messages will be logged.
> ==> >
\" ==> ""
(if (string-match "[&<>\"]" string)
- (save-excursion
- (set-buffer (get-buffer-create " *entity*"))
+ (with-current-buffer (get-buffer-create " *entity*")
(erase-buffer)
(buffer-disable-undo (current-buffer))
(insert string)
type (url-type data))
(if (member type '("www" "about" "mailto" "info"))
(setq retval url)
+ ;; FIXME all this does, and all this function seems to do in
+ ;; most cases, is remove any trailing "#anchor" part of a url.
(setf (url-target data) nil)
(setq retval (url-recreate-url data)))
retval))
(defun url-lazy-message (&rest args)
"Just like `message', but is a no-op if called more than once a second.
Will not do anything if `url-show-status' is nil."
- (if (or (null url-show-status)
+ (if (or (and url-current-object
+ (url-silent url-current-object))
+ (null url-show-status)
(active-minibuffer-window)
(= url-lazy-message-time
(setq url-lazy-message-time (nth 1 (current-time)))))
;;;###autoload
(defun url-display-percentage (fmt perc &rest args)
- (when url-show-status
+ (when (and url-show-status
+ (or (null url-current-object)
+ (not (url-silent url-current-object))))
(if (null fmt)
(if (fboundp 'clear-progress-display)
(clear-progress-display))
(round (* 100 (/ x (float y))))
(/ (* x 100) y)))
+;;;###autoload
+(defalias 'url-basepath 'url-file-directory)
+
;;;###autoload
(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)
+ ((string-match "\\?" file)
(file-name-directory (substring file 0 (match-beginning 0))))
(t (file-name-directory file))))
"Return the nondirectory part of FILE, for a URL."
(cond
((null file) "")
- ((string-match (eval-when-compile (regexp-quote "?")) file)
+ ((string-match "\\?" file)
(file-name-nondirectory (substring file 0 (match-beginning 0))))
(t (file-name-nondirectory file))))
;;;###autoload
(defun url-unhex-string (str &optional allow-newlines)
- "Remove %XX embedded spaces, etc in a url.
+ "Remove %XX embedded spaces, etc in a URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding."
tmp (substring str 0 start)
(cond
(allow-newlines
- (char-to-string code))
+ (byte-to-string code))
((or (= code ?\n) (= code ?\r))
" ")
- (t (char-to-string code))))
+ (t (byte-to-string code))))
str (substring str (match-end 0)))))
(setq tmp (concat tmp str))
tmp))
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
;;;###autoload
(defun url-file-extension (fname &optional x)
"Return the filename extension of FNAME.
-If optional variable X is t,
-then return the basename of the file with the extension stripped off."
+If optional argument X is t, then return the basename
+of the file with the extension stripped off."
(if (and fname
(setq fname (url-file-nondirectory fname))
(string-match "\\.[^./]+$" fname))
;;;###autoload
(defun url-truncate-url-for-viewing (url &optional width)
- "Return a shortened version of URL that is WIDTH characters or less wide.
+ "Return a shortened version of URL that is WIDTH characters wide or less.
WIDTH defaults to the current frame width."
(let* ((fr-width (or width (frame-width)))
(str-width (length url))
(url-recreate-url url-current-object)
(message "%s" (url-recreate-url url-current-object)))))
-(eval-and-compile
- (defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
- "Valid characters in a URL")
- )
+(defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
+ "Valid characters in a URL.")
(defun url-get-url-at-point (&optional pt)
"Get the URL closest to point, but don't change position.
(if (not (bobp))
(backward-char 1)))))
(if (and (char-after (point))
- (string-match (eval-when-compile
- (concat "[" url-get-url-filename-chars "]"))
+ (string-match (concat "[" url-get-url-filename-chars "]")
(char-to-string (char-after (point)))))
(progn
(skip-chars-backward url-get-url-filename-chars)
(defun url-generate-unique-filename (&optional fmt)
"Generate a unique filename in `url-temporary-directory'."
- (if (not fmt)
- (let ((base (format "url-tmp.%d" (user-real-uid)))
+ ;; This variable is obsolete, but so is this function.
+ (let ((tempdir (with-no-warnings url-temporary-directory)))
+ (if (not fmt)
+ (let ((base (format "url-tmp.%d" (user-real-uid)))
+ (fname "")
+ (x 0))
+ (setq fname (format "%s%d" base x))
+ (while (file-exists-p
+ (expand-file-name fname tempdir))
+ (setq x (1+ x)
+ fname (concat base (int-to-string x))))
+ (expand-file-name fname tempdir))
+ (let ((base (concat "url" (int-to-string (user-real-uid))))
(fname "")
(x 0))
- (setq fname (format "%s%d" base x))
+ (setq fname (format fmt (concat base (int-to-string x))))
(while (file-exists-p
- (expand-file-name fname url-temporary-directory))
+ (expand-file-name fname tempdir))
(setq x (1+ x)
- fname (concat base (int-to-string x))))
- (expand-file-name fname url-temporary-directory))
- (let ((base (concat "url" (int-to-string (user-real-uid))))
- (fname "")
- (x 0))
- (setq fname (format fmt (concat base (int-to-string x))))
- (while (file-exists-p
- (expand-file-name fname url-temporary-directory))
- (setq x (1+ x)
- fname (format fmt (concat base (int-to-string x)))))
- (expand-file-name fname url-temporary-directory))))
+ fname (format fmt (concat base (int-to-string x)))))
+ (expand-file-name fname tempdir)))))
+(make-obsolete 'url-generate-unique-filename 'make-temp-file "23.1")
(defun url-extract-mime-headers ()
"Set `url-current-mime-headers' in current buffer."