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 !

Commit b80409ee authored by Ryan Thompson's avatar Ryan Thompson

Merge pull request #617 from DarwinAwardWinner/method-guess-website

Method guess website
parents e5f02aa0 9b350be5
......@@ -45,16 +45,25 @@ call for doing the named package action in the given method.")
(and (el-get-method name :install) t))
(defun* el-get-register-method (name &key install update remove
install-hook remove-hook compute-checksum)
install-hook remove-hook compute-checksum
guess-website)
"Register the method for backend NAME, with given functions"
(loop for required-arg in '(install update remove)
unless (symbol-value required-arg)
do (error "Missing required argument: :%s" required-arg))
(let ((def (list :install install :update update :remove remove)))
(when install-hook (setq def (plist-put def :install-hook install-hook)))
(when remove-hook (setq def (plist-put def :remove-hook remove-hook)))
(when compute-checksum (setq def (plist-put def :compute-checksum compute-checksum)))
(setq el-get-methods (plist-put el-get-methods name def))))
(let (method-def)
(loop for required-arg in '(install update remove)
unless (symbol-value required-arg)
do (error "Missing required argument: :%s" required-arg)
do (setq method-def
(plist-put method-def
(intern (format ":%s" required-arg))
(symbol-value required-arg))))
(loop for optional-arg in '(install-hook remove-hook
compute-checksum guess-website)
if (symbol-value optional-arg)
do (setq method-def
(plist-put method-def
(intern (format ":%s" optional-arg))
(symbol-value optional-arg))))
(setq el-get-methods (plist-put el-get-methods name method-def))))
(put 'el-get-register-method 'lisp-indent-function
(get 'prog1 'lisp-indent-function))
......
......@@ -16,6 +16,9 @@
;;
;; Description of packages. (Code based on `describe-function').
;;
(require 'el-get-core)
(require 'cl)
(define-button-type 'el-get-help-package-def
:supertype 'help-xref
'help-function (lambda (package) (find-file (el-get-recipe-filename package)))
......@@ -64,11 +67,11 @@ matching REGEX with TYPE and ARGS as parameter."
(re-search-backward regex nil t)
(apply #'help-xref-button 1 type args))))
(defun el-get-guess-github-website (url)
"If a package's URL is on Github, return the project's Github URL."
(when (and url (string-match "github\\.com/" url))
(replace-regexp-in-string "\\.git$" ""
(replace-regexp-in-string "\\(git\\|https\\)://" "http://" url))))
(defun el-get-guess-website (package)
(let* ((type (el-get-package-type package))
(guesser (el-get-method type :guess-website)))
(when guesser
(funcall guesser package))))
(defun el-get-describe-1 (package)
(let* ((psym (el-get-as-symbol package))
......@@ -99,7 +102,7 @@ matching REGEX with TYPE and ARGS as parameter."
(princ ".\n\n")
(let ((website (or website
(and (eq 'git type) (el-get-guess-github-website url)))))
(el-get-guess-website package))))
(when website
(el-get-describe-princ-button (format "Website: %s\n" website)
": \\(.+\\)" 'help-url website)))
......
......@@ -16,18 +16,32 @@
(require 'el-get-git)
(require 'el-get-github)
(defun el-get-emacsmirror-get-github-source (package)
"Return a github-type source equivalent to emacsmirror PACKAGE."
(assert (equal (el-get-package-type package) 'emacsmirror) nil
"Need an emacsmirror package")
(append '(:type github :username "emacsmirror")
(el-get-package-def package)))
;;
;; emacsmirror support
;;
(defun el-get-emacsmirror-clone (package url post-install-fun)
;; Override the package def with an equivalent github-type package,
;; then run the github method.
(let* ((package-github-source (append '(:type github :username "emacsmirror")
(el-get-package-def package)))
(let* ((package-github-source
(el-get-emacsmirror-get-github-source package))
(el-get-sources (cons package-github-source el-get-sources)))
(el-get-github-clone package url post-install-fun)))
(defun el-get-emacsmirror-guess-website (package)
(let* ((package-github-source
(el-get-emacsmirror-get-github-source package))
(el-get-sources (cons package-github-source el-get-sources)))
(el-get-github-guess-website package)))
(el-get-register-derived-method :emacsmirror :github
:install #'el-get-emacsmirror-clone)
:install #'el-get-emacsmirror-clone
:guess-website #'el-get-emacsmirror-guess-website)
(provide 'el-get-emacsmirror)
......@@ -36,9 +36,13 @@ filename.el ;;; filename.el --- description"
(let ((url (or url (format "%s%s.el" el-get-emacswiki-base-url package))))
(el-get-http-install package url post-install-fun)))
(defun el-get-emacswiki-guess-website (package)
(format "%s%s.el" el-get-emacswiki-base-url package))
(el-get-register-derived-method :emacswiki :http
:install #'el-get-emacswiki-install
:update #'el-get-emacswiki-install)
:update #'el-get-emacswiki-install
:guess-website #'el-get-emacswiki-guess-website)
;;;
;;; Functions to maintain a local recipe list from EmacsWiki
......
......@@ -44,6 +44,7 @@
(el-get-register-derived-method :github-tar :http-tar
:install #'el-get-github-tar-install
:update #'el-get-github-tar-install)
:update #'el-get-github-tar-install
:guess-website #'el-get-github-guess-website)
(provide 'el-get-github-tar)
......@@ -42,6 +42,7 @@
(el-get-register-derived-method :github-zip :http-zip
:install #'el-get-github-zip-install
:update #'el-get-github-zip-install)
:update #'el-get-github-zip-install
:guess-website #'el-get-github-guess-website)
(provide 'el-get-github-zip)
......@@ -106,7 +106,25 @@ FROM is a literal string, not a regexp."
(or url (el-get-github-url package))
post-install-fun))
(defun el-get-guess-github-website (url)
"If a package's URL is on Github, return the project's Github URL."
(when (and url (string-match "github\\.com/" url))
(replace-regexp-in-string "\\.git$" ""
(replace-regexp-in-string "\\(git\\|https\\)://" "http://" url))))
(defun el-get-github-guess-website (package)
(let* ((user-and-repo (el-get-github-parse-user-and-repo package))
(username (car user-and-repo))
(reponame (cdr user-and-repo))
(url-format-string "https://github.com/%USER%/%REPO%"))
(el-get-replace-string
"%USER%" username
(el-get-replace-string
"%REPO%" reponame
url-format-string))))
(el-get-register-derived-method :github :git
:install #'el-get-github-clone)
:install #'el-get-github-clone
:guess-website #'el-get-github-guess-website)
(provide 'el-get-github)
......@@ -90,12 +90,16 @@ into the package :localname option or its `file-name-nondirectory' part."
(puthash package checksum el-get-http-checksums))
checksum))
(defun el-get-http-guess-website (package)
(plist-get (el-get-package-def package) :url))
(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)
:compute-checksum #'el-get-http-compute-checksum
:guess-website #'el-get-http-guess-website)
(el-get-register-method-alias :ftp :http)
......
;; https://github.com/dimitri/el-get/issues/615
;;
;; Allow methods to provide default-website guesser
(el-get-describe 'js2-mode)
(with-current-buffer "*Help*"
(assert (string-match-p "Website:" (buffer-string)) nil
"Js2-mode should have a website"))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment