Mercurial > emacs
view lisp/url/url-expand.el @ 83220:fe1db7935e1a
Fix core dump in redisplay window. (Reported by Yoshiaki Kasahara.) Plus cleanups.
* src/xdisp.c (handle_single_display_prop): Use FRAME_WINDOW_P instead of
checking against specific frame types. Ignore images on non-window
frames.
(echo_area_display): Use FRAME_INITIAL_P to check for initial frame.
(redisplay_preserve_echo_area): Update for multi-tty support.
(redisplay_window): Don't bother with toolbars, fringe bitmaps or
vertical borders on tty frames.
(display_line): Remove superflous #ifdefs.
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-260
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Thu, 14 Oct 2004 14:58:43 +0000 |
parents | 8e5779acd195 |
children | ae7fab96922c |
line wrap: on
line source
;;; url-expand.el --- expand-file-name for URLs ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1999 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; ;;; 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) ;;; 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., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'url-methods) (require 'url-util) (require 'url-parse) (defun url-expander-remove-relative-links (name) ;; Strip . and .. from pathnames (let ((new (if (not (string-match "^/" name)) (concat "/" name) name))) ;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat ;; the tests that follow are not too complicated in terms of ;; looking for '..' or '../', etc. (if (string-match "/\\.+$" new) (setq new (concat new "/"))) ;; Remove '/./' first (while (string-match "/\\(\\./\\)" new) (setq new (concat (substring new 0 (match-beginning 1)) (substring new (match-end 1))))) ;; Then remove '/../' (while (string-match "/\\([^/]*/\\.\\./\\)" new) (setq new (concat (substring new 0 (match-beginning 1)) (substring new (match-end 1))))) ;; Remove cruft at the beginning of the string, so people that put ;; in extraneous '..' because they are morons won't lose. (while (string-match "^/\\.\\.\\(/\\)" new) (setq new (substring new (match-beginning 1) nil))) new)) (defun url-expand-file-name (url &optional default) "Convert URL to a fully specified URL, and canonicalize it. Second arg DEFAULT is a URL to start with if URL is relative. If DEFAULT is nil or missing, the current buffer's URL is used. Path components that are `.' are removed, and path components followed by `..' are removed, along with the `..' itself." (if (and url (not (string-match "^#" url))) ;; Need to nuke newlines and spaces in the URL, or we open ;; ourselves up to potential security holes. (setq url (mapconcat (function (lambda (x) (if (memq x '(? ?\n ?\r)) "" (char-to-string x)))) url ""))) ;; Need to figure out how/where to expand the fragment relative to (setq default (cond ((vectorp default) ;; Default URL has already been parsed default) (default ;; They gave us a default URL in non-parsed format (url-generic-parse-url default)) (url-current-object ;; We are in a URL-based buffer, use the pre-parsed object url-current-object) ((string-match url-nonrelative-link url) ;; The URL they gave us is absolute, go for it. nil) (t ;; Hmmm - this shouldn't ever happen. (error "url-expand-file-name confused - no default?")))) (cond ((= (length url) 0) ; nil or empty string (url-recreate-url default)) ((string-match "^#" url) ; Offset link, use it raw url) ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately url) (t (let* ((urlobj (url-generic-parse-url url)) (inhibit-file-name-handlers t) (expander (url-scheme-get-property (url-type default) 'expand-file-name))) (if (string-match "^//" url) (setq urlobj (url-generic-parse-url (concat (url-type default) ":" url)))) (funcall expander urlobj default) (url-recreate-url urlobj))))) (defun url-identity-expander (urlobj defobj) (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))) (defun url-default-expander (urlobj defobj) ;; The default expansion routine - urlobj is modified by side effect! (if (url-type urlobj) ;; Well, they told us the scheme, let's just go with it. nil (url-set-type urlobj (or (url-type urlobj) (url-type defobj))) (url-set-port urlobj (or (url-port urlobj) (and (string= (url-type urlobj) (url-type defobj)) (url-port defobj)))) (if (not (string= "file" (url-type urlobj))) (url-set-host urlobj (or (url-host urlobj) (url-host defobj)))) (if (string= "ftp" (url-type urlobj)) (url-set-user urlobj (or (url-user urlobj) (url-user defobj)))) (if (string= (url-filename urlobj) "") (url-set-filename urlobj "/")) (if (string-match "^/" (url-filename urlobj)) nil (let ((query nil) (file nil) (sepchar nil)) (if (string-match "[?#]" (url-filename urlobj)) (setq query (substring (url-filename urlobj) (match-end 0)) file (substring (url-filename urlobj) 0 (match-beginning 0)) sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0))) (setq file (url-filename urlobj))) (setq file (url-expander-remove-relative-links (concat (url-basepath (url-filename defobj)) file))) (url-set-filename urlobj (if query (concat file sepchar query) file)))))) (provide 'url-expand) ;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a