Ce serveur Gitlab sera éteint le 30 juin 2020, pensez à migrer vos projets vers les serveurs gitlab-research.centralesupelec.fr et gitlab-student.centralesupelec.fr !

el-get-http.el 3.65 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; el-get --- Manage the external elisp bits and pieces you depend upon
;;
;; Copyright (C) 2010-2011 Dimitri Fontaine
;;
;; Author: Dimitri Fontaine <dim@tapoueh.org>
;; URL: http://www.emacswiki.org/emacs/el-get
;; GIT: https://github.com/dimitri/el-get
;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
;;
;; This file is NOT part of GNU Emacs.
;;
;; Install
;;     Please see the README.asciidoc file from the same distribution

(require 'el-get-core)
16
(require 'sha1)
17 18 19 20 21 22

(defcustom el-get-http-install-hook nil
  "Hook run after http retrieve."
  :group 'el-get
  :type 'hook)

23 24 25
(defvar el-get-http-checksums (make-hash-table)
  "Hash table for storing downloaded SHA1 checksums.")

26 27 28 29 30 31 32 33 34 35
(defun el-get-filename-from-url (url)
  "return a suitable filename from given url

Test url: http://repo.or.cz/w/ShellArchive.git?a=blob_plain;hb=HEAD;f=ack.el"
  (replace-regexp-in-string "[^a-zA-Z0-9-_\.\+]" "_"
			    (file-name-nondirectory url)))

(defun el-get-http-retrieve-callback (status package post-install-fun &optional dest sources)
  "Callback function for `url-retrieve', store the emacs lisp file for the package."
  (let* ((pdir   (el-get-package-directory package))
36
	 (dest   (or dest (format "%s%s.el" (file-name-as-directory pdir) package)))
37 38 39 40 41 42 43 44 45 46
	 (part   (concat dest ".part"))
	 (el-get-sources (if sources sources el-get-sources))
	 (buffer-file-coding-system 'no-conversion)
	 (require-final-newline nil))
    ;; prune HTTP headers before save
    (goto-char (point-min))
    (re-search-forward "^$" nil 'move)
    (forward-char)
    (delete-region (point-min) (point))
    (write-file part)
47
    (puthash package (sha1 (current-buffer)) el-get-http-checksums)
48 49 50 51 52 53 54
    (when (file-exists-p dest)
      (delete-file dest))
    (rename-file part dest)
    (message "Wrote %s" dest)
    (kill-buffer))
  (funcall post-install-fun package))

55 56 57 58 59 60 61 62
(defun el-get-http-dest-filename (package &optional url)
  "Return where to store the file at given URL for given PACKAGE"
  (let* ((pdir   (el-get-package-directory package))
	 (url    (or url (plist-get (el-get-package-def package) :url)))
	 (fname  (or (plist-get (el-get-package-def package) :localname)
		     (el-get-filename-from-url url))))
    (expand-file-name fname pdir)))

63 64 65 66 67 68
(defun el-get-http-install (package url post-install-fun &optional dest)
  "Dowload a single-file PACKAGE over HTTP and store it in DEST.

Should dest be omitted (nil), the url content will get written
into the package :localname option or its `file-name-nondirectory' part."
  (let* ((pdir   (el-get-package-directory package))
69
	 (dest   (or dest (el-get-http-dest-filename package url))))
70 71 72 73 74 75 76 77 78 79 80
    (unless (file-directory-p pdir)
      (make-directory pdir))

    (if (not el-get-default-process-sync)
        (url-retrieve url 'el-get-http-retrieve-callback
                      `(,package ,post-install-fun ,dest ,el-get-sources))

      (with-current-buffer (url-retrieve-synchronously url)
        (el-get-http-retrieve-callback
	 nil package post-install-fun dest el-get-sources)))))

81 82
(defun el-get-http-compute-checksum (package)
  "Look up download time SHA1 of PACKAGE."
83 84 85 86 87 88 89 90 91
  (let ((checksum (gethash package el-get-http-checksums)))
    (unless checksum
      ;; compute the checksum
      (setq checksum
	    (with-temp-buffer
	      (insert-file-contents-literally (el-get-http-dest-filename package))
	      (sha1 (current-buffer))))
      (puthash package checksum el-get-http-checksums))
    checksum))
92

93 94 95 96 97 98
(el-get-register-method :http
  :install #'el-get-http-install
  :update #'el-get-http-install
  :remove #'el-get-rmdir
  :install-hook #'el-get-http-install-hook
  :compute-checksum #'el-get-http-compute-checksum)
99

100
(el-get-register-method-alias :ftp :http)
101 102

(provide 'el-get-http)