1 ;;; ediff-url.el --- Diffing buffer against downloaded url
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: Sat Nov 24 2007
6 ;; Last-Updated: 2010-03-18 Thu
7 ;; URL: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/ediff-url.el
9 ;; Features that might be required by this library:
11 ;; `mail-prsvr', `mm-util', `timer', `url-parse', `url-util',
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; This file contains a simple function, `ediff-url', to help you
20 ;; update a single file from the web.
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;; This program is free software; you can redistribute it and/or
30 ;; modify it under the terms of the GNU General Public License as
31 ;; published by the Free Software Foundation; either version 2, or
32 ;; (at your option) any later version.
34 ;; This program is distributed in the hope that it will be useful,
35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
37 ;; General Public License for more details.
39 ;; You should have received a copy of the GNU General Public License
40 ;; along with this program; see the file COPYING. If not, write to
41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
42 ;; Floor, Boston, MA 02110-1301, USA.
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49 (eval-when-compile (require 'cl))
51 (defvar ediff-url-read-url-history nil)
53 (defun ediff-url-redir-launchpad (url)
54 "Check if bazaar list page on Launchpad.
55 If URL is a description page for a file uploaded to EmacsWiki
56 suggest to use the download URL instead."
57 (let* ((bazaar-url "http://bazaar.launchpad.net/")
58 (bazaar-len (length bazaar-url)))
59 (if (and (< bazaar-len (length url))
60 (string= bazaar-url (substring url 0 bazaar-len)))
61 (let* ((url-show-status nil) ;; just annoying showing status here
62 (buffer (url-retrieve-synchronously url))
65 ;; Fix-me: better more flexible pattern?
66 (dl-patt "<a href=\"\\(.*?\\)\">download file</a>")
69 (message "Got empty buffer for %s" url)
70 (throw 'command-level nil))
71 (with-current-buffer buffer
72 (if (= 0 (buffer-size))
74 (message "Got empty page for %s" url)
75 (throw 'command-level nil))
77 (setq http-status (url-http-parse-response))
78 (if (memq http-status '(200 201))
80 (goto-char (point-min))
81 (unless (search-forward "\n\n" nil t)
82 (error "Could not find header end in buffer for %s" url))
83 (unless (re-search-forward dl-patt nil t)
84 (error "Could not find download link"))
85 (setq dl-url (match-string 1))
86 (set-buffer-modified-p nil)
92 (concat (number-to-string http-status)
94 (401 " (unauthorized)")
97 (408 " (request timeout)")
99 (500 " (internal server error)")
100 (503 " (service unavailable)")
101 (504 " (gateway timeout)")
102 (530 " (user access denied)")
104 (message "Got status %s for %s" http-status url)
105 (throw 'command-level nil)))))
108 (defun ediff-url-redir-emacswiki-description-page (url)
109 "Check if description page on EmacsWiki.
110 If URL is a description page for a file uploaded to EmacsWiki
111 suggest to use the download URL instead."
112 ;;(let* ((desc-url "http://www.emacswiki.org/emacs/")
113 (let* ((emacswiki-url "http://www.emacswiki.org/")
114 (emacswiki-len (length emacswiki-url)))
115 (if (and (< emacswiki-len (length url))
116 (string= emacswiki-url (substring url 0 emacswiki-len))
117 (not (string-match-p "/download/" url)))
119 (concat "This seem to be the description page on EmacsWiki,"
120 "\n\tdo you want the download url instead? ")))
121 (when (y-or-n-p prompt)
122 ;;(let ((start (+ 6 (string-match "/wiki/" url))))
123 (let ((start (+ 7 (string-match "/emacs/" url))))
124 (concat (substring url 0 start)
126 (substring url start)))))
127 ;; Not on the wiki, just return the url:
130 (defcustom ediff-url-redirects '(ediff-url-redir-emacswiki-description-page
131 ediff-url-redir-launchpad
133 "List of functions checking url given to `ediff-url'.
134 Each function should take an URL as argument and return this URL
136 :type '(repeat function)
140 (defun ediff-url (url)
141 "Compare current buffer to a web URL using `ediff-buffers'.
142 Check URL using `ediff-url-redirects' before fetching the file.
144 This is for checking downloaded file. A the file may have a comment
145 telling the download URL of thise form in the header:
147 ;; URL: http://the-server.net/the-path/the-file.el
149 If not the user is asked for the URL."
150 (interactive (let ((url-init (url-get-url-at-point)))
152 (when (eq major-mode 'emacs-lisp-mode)
154 (goto-char (point-min))
155 (when (re-search-forward "URL:[ \t]*" nil t)
156 (setq url-init (url-get-url-at-point))))))
157 (list (read-from-minibuffer "Url for download file: "
158 (cons (or url-init "") 1) ;nil
160 'ediff-url-read-url-history
163 (catch 'command-level ;; Fix-me: remove and let go to top later
164 (unless (> (length url) 0)
165 (message "No URL given, aborted by user")
166 (throw 'command-level nil))
167 ;; Check if URL seems reasonable
168 (dolist (fun ediff-url-redirects)
169 (setq url (funcall fun url)))
170 ;; Fetch URL and run ediff
171 (let* ((url-buf-name (concat "URL=" url))
172 (url-buf (get-buffer url-buf-name)))
174 (unless (y-or-n-p "Use previously downloaded url? ")
175 (kill-buffer url-buf)
178 (setq url-buf (get-buffer-create url-buf-name))
179 (let ((current-major major-mode))
180 (with-current-buffer url-buf
181 (url-insert-file-contents url)
182 ;; Assume same modes:
183 (funcall current-major))))
184 (ediff-buffers url-buf (current-buffer)))))
187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
188 ;;; ediff-url.el ends here