nxhtml/util/ediff-url.el

   1 ;;; ediff-url.el --- Diffing buffer against downloaded url
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: Sat Nov 24 2007
   5 ;; Version: 0.56
   6 ;; Last-Updated: 2010-03-18 Thu
   7 ;; URL: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/ediff-url.el
   8 ;;
   9 ;; Features that might be required by this library:
  10 ;;
  11   ;; `mail-prsvr', `mm-util', `timer', `url-parse', `url-util',
  12   ;; `url-vars'.
  13 ;;
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; This file contains a simple function, `ediff-url', to help you
  20 ;; update a single file from the web.
  21 ;;
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;;; Change log:
  25 ;;
  26 ;;
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;;
  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.
  33 ;;
  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.
  38 ;;
  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.
  43 ;;
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;
  46 ;;; Code:
  47
  48 (require 'url-util)
  49 (eval-when-compile (require 'cl))
  50
  51 (defvar ediff-url-read-url-history nil)
  52
  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))
  63                (handle nil)
  64                (http-status nil)
  65                ;; Fix-me: better more flexible pattern?
  66                (dl-patt "<a href=\"\\(.*?\\)\">download file</a>")
  67                dl-url)
  68           (unless buffer
  69             (message "Got empty buffer for %s" url)
  70             (throw 'command-level nil))
  71           (with-current-buffer buffer
  72             (if (= 0 (buffer-size))
  73                 (progn
  74                   (message "Got empty page for %s" url)
  75                   (throw 'command-level nil))
  76               (require 'url-http)
  77               (setq http-status (url-http-parse-response))
  78               (if (memq http-status '(200 201))
  79                   (progn
  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)
  87                     (kill-buffer buffer)
  88                     dl-url)
  89                 (kill-buffer buffer)
  90                 (setq buffer nil)
  91                 (setq http-status
  92                       (concat (number-to-string http-status)
  93                               (case http-status
  94                                 (401 " (unauthorized)")
  95                                 (403 " (forbidden)")
  96                                 (404 " (not found)")
  97                                 (408 " (request timeout)")
  98                                 (410 " (gone)")
  99                                 (500 " (internal server error)")
 100                                 (503 " (service unavailable)")
 101                                 (504 " (gateway timeout)")
 102                                 (530 " (user access denied)")
 103                                 )))
 104                 (message "Got status %s for %s" http-status url)
 105                 (throw 'command-level nil)))))
 106       url)))
 107
 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)))
 118         (let ((prompt
 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)
 125                                 "download/"
 126                                 (substring url start)))))
 127       ;; Not on the wiki, just return the url:
 128       url)))
 129
 130 (defcustom ediff-url-redirects '(ediff-url-redir-emacswiki-description-page
 131                                  ediff-url-redir-launchpad
 132                                  )
 133   "List of functions checking url given to `ediff-url'.
 134 Each function should take an URL as argument and return this URL
 135 or a new URL."
 136   :type '(repeat function)
 137   :group 'ediff)
 138
 139 ;;;###autoload
 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.
 143
 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:
 146
 147    ;; URL: http://the-server.net/the-path/the-file.el
 148
 149 If not the user is asked for the URL."
 150   (interactive (let ((url-init (url-get-url-at-point)))
 151                  (unless url-init
 152                    (when (eq major-mode 'emacs-lisp-mode)
 153                      (save-excursion
 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
 159                                              nil nil
 160                                              'ediff-url-read-url-history
 161                                              ;;url-init
 162                                              ))))
 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)))
 173       (when url-buf
 174         (unless (y-or-n-p "Use previously downloaded url? ")
 175           (kill-buffer url-buf)
 176           (setq url-buf nil)))
 177       (unless 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)))))
 185
 186 (provide 'ediff-url)
 187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 188 ;;; ediff-url.el ends here