X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a113b3ca322fd73d97d0d9d69c9f48dc13fb326a..d23832a2cc30f28e1d754fcd4a497c8ba7ca5b18:/lisp/url/url-util.el diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 32854f7059..62a9a75f2d 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -1,33 +1,32 @@ ;;; 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 ;; 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 . ;;; 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") @@ -44,7 +43,7 @@ ;;;###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. @@ -142,8 +141,7 @@ Also replaces the \" character, so that the result may be safely used as > ==> > \" ==> "" (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) @@ -169,6 +167,8 @@ Strips out default port numbers, etc." 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)) @@ -177,7 +177,9 @@ Strips out default port numbers, etc." (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))))) @@ -222,7 +224,9 @@ Will not do anything if `url-show-status' is nil." ;;;###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)) @@ -236,12 +240,15 @@ Will not do anything if `url-show-status' is nil." (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)))) @@ -250,7 +257,7 @@ Will not do anything if `url-show-status' is nil." "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)))) @@ -303,7 +310,7 @@ Will not do anything if `url-show-status' is nil." ;;;###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." @@ -319,10 +326,10 @@ 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)) @@ -344,7 +351,7 @@ 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 @@ -366,8 +373,8 @@ string: \"%\" followed by two lowercase hex digits." ;;;###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)) @@ -384,7 +391,7 @@ then return the basename of the file with the extension stripped off." ;;;###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)) @@ -429,10 +436,8 @@ This uses `url-current-object', set locally to the buffer." (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. @@ -450,8 +455,7 @@ Has a preference for looking backward when not directly on a symbol." (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) @@ -473,25 +477,28 @@ Has a preference for looking backward when not directly on a symbol." (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."