emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Enhance core/autoload/system library

Browse source
This commit is contained in:
Henrik Lissner 2017-03-20 15:57:05 -04:00
parent a465be764b
commit 1677844fd6
1 changed files with 18 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

32
core/autoload/system.el
View file

@ -20,16 +20,17 @@
;;;###autoload ;;;###autoload
(defun doom-sh (command &rest args) (defun doom-sh (command &rest args)
"Runs a shell command and prints any output to the DOOM buffer." "Runs a shell command and prints any output to the DOOM buffer."
(if (equal (car (split-string command " ")) "sudo") (let ((cmd-list (split-string command " ")))
(apply 'doom-sudo command args) (if (equal (car cmd-list) "sudo")
(princ (shell-command-to-string (apply 'format command args))))) (apply 'doom-sudo (string-join (cdr command) " ") args)
(let ((buf (get-buffer-create "*doom-sh*")))
(shell-command (apply 'format command args) buf)))))
;;;###autoload ;;;###autoload
(defun doom-sudo (command &rest args) (defun doom-sudo (command &rest args)
"Like `doom-sh', but runs as root (prompts for password)." "Like `doom-sh', but runs as root (prompts for password)."
(let ((tramp-verbose 2) (let ((tramp-verbose 2))
(buf (get-buffer-create "*sudo*"))) (with-current-buffer (get-buffer-create "*doom-sudo*")
(with-current-buffer buf
(unless (string-prefix-p "/sudo::/" default-directory) (unless (string-prefix-p "/sudo::/" default-directory)
(cd "/sudo::/")) (cd "/sudo::/"))
(apply 'doom-sh command args)))) (apply 'doom-sh command args))))
@ -40,22 +41,25 @@
Requires the corresponding client, e.g. git for git repos, hg for mercurial, Requires the corresponding client, e.g. git for git repos, hg for mercurial,
etc." etc."
(let* ((command (pcase fetcher (let* ((command (pcase fetcher
(:github "git clone --recursive https://github.com/%s.git") (:github "git clone --depth 1 --recursive https://github.com/%s.git")
(:git "git clone --recursive %s") (:git "git clone --depth 1 --recursive %s")
(:gist "git clone https://gist.github.com/%s.git") (:gist "git clone https://gist.github.com/%s.git")
(_ (error "%s is not a valid fetcher" fetcher)))) (_ (error "%s is not a valid fetcher" fetcher))))
(argv (s-split-up-to " " command 1)) (argv (s-split-up-to " " command 1))
(args (format (car (cdr argv)) location)) (args (format (car (cdr argv)) location))
(bin (executable-find (car argv))) (bin (executable-find (car argv)))
(fn (if noninteractive 'shell-command 'async-shell-command)) (fn (if noninteractive
buf) (lambda (&rest args) (princ (apply 'shell-command-to-string args)))
'async-shell-command))
(dest (expand-file-name dest)))
(unless bin (unless bin
(error "%s couldn't be found" command)) (error "%s couldn't be found" command))
(if (file-exists-p dest) (unless (file-directory-p dest)
(message "Resource already exists locally, skipping") (funcall fn (format "%s %s %s"
(apply fn (format "%s %s '%s'" bin args dest) (unless noninteractive (list buf))) bin args
(shell-quote-argument dest)))
(if noninteractive (if noninteractive
(message "Cloning %s -> %s" location (file-relative-name dest doom-modules-dir)) (message "Cloning %s -> %s" location dest)
(doom-popup-buffer buf) (doom-popup-buffer buf)
(with-current-buffer buf (with-current-buffer buf
(when (featurep 'evil) (when (featurep 'evil)