diff --git a/gist.el b/gist.el index 9765c23..34cba8c 100644 --- a/gist.el +++ b/gist.el @@ -1,6 +1,7 @@ -;;; gist.el --- Emacs integration for gist.github.com +;;; gist.el --- Emacs integration for gist.github.com -*- lexical-binding: t; -*- ;; Author: Yann Hodique +;; URL: https://github.com/defunkt/gist.el ;; Original Author: Christian Neukirchen ;; Contributors: Chris Wanstrath ;; Will Farrington @@ -9,7 +10,7 @@ ;; Dan McKinley ;; Marcelo Muñoz Araya ;; Version: 1.4.0 -;; Package-Requires: ((emacs "24.1") (gh "0.10.0")) +;; Package-Requires: ((emacs "24.3") (gh "0.10.0")) ;; Keywords: tools ;; Homepage: https://github.com/defunkt/gist.el @@ -36,19 +37,18 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'eieio) (require 'eieio-base) (require 'timezone) - (require 'gh-api) (require 'gh-gist) (require 'gh-profile) - (require 'tabulated-list) +(declare-function dired-get-marked-files "dired") + (defgroup gist nil "Interface to GitHub's Gist." :group 'applications) @@ -99,8 +99,8 @@ :group 'gist) (defcustom gist-created-fmt "Paste created: %s" - "Format for the message that gets shown upon successful gist -creation. Must contain a single %s for the location of the newly + "Format for the message to show after successful gist creation. +Must contain a single %s for the location of the newly created gist." :type 'string :group 'gist) @@ -160,18 +160,25 @@ appropriate modes from fetched gist files (based on filenames)." (defvar gist-filename nil) (make-variable-buffer-local 'gist-filename) -(defvar gist-user-history nil "History list for gist-list-user.") - +(defvar gist-user-history nil "History list for `gist-list-user'.") (defvar gist-list-buffer-user nil "Username for this gist buffer.") (make-variable-buffer-local 'gist-list-buffer-user) (put 'gist-list-buffer-user 'permanent-local t) (defun gist-get-api (&optional sync) + "Reuse or create new gist api. +If SYNC is non-nil, make requests synchronously." (let ((gh-profile-current-profile (or gh-profile-current-profile (gh-profile-completing-read)))) - (make-instance 'gh-gist-api :sync sync :cache t :num-retries 1))) + (make-instance 'gh-gist-api + :sync sync + :cache t + :num-retries 1))) (defun gist-internal-new (files &optional private description callback) + "Post new gist with FILES and DESCRIPTION. +With a prefix argument PRIVATE, makes a PRIVATE paste. +Invoke function CALLBACK with created gist as argument." (let* ((api (gist-get-api)) (gist (make-instance 'gh-gist-gist-stub :public (or (not private) json-false) @@ -180,27 +187,31 @@ appropriate modes from fetched gist files (based on filenames)." (resp (gh-gist-new api gist))) (gh-url-add-response-callback resp - (lexical-let ((profile (oref api :profile)) - (cb callback)) + (let ((profile (oref api profile)) + (cb callback)) (lambda (gist) (let ((gh-profile-current-profile profile)) (funcall (or cb 'gist-created-callback) gist))))))) (defun gist-ask-for-description-maybe () + "Read a string from the minibuffer if `gist-ask-for-description' is non nil." (when gist-ask-for-description (read-from-minibuffer "Gist description: "))) (defun gist-ask-for-filename-maybe (fname) + "Read a name for gist the minibuffer If `gist-ask-for-filename' is non-nil. +FNAME is as default name for gist." (if gist-ask-for-filename (read-string (format "File name (%s): " fname) nil nil fname) fname)) ;;;###autoload (defun gist-region (begin end &optional private callback) - "Post the current region as a new paste at gist.github.com + "Post the current region between BEGIN and END as a new paste. Copies the URL into the kill ring. -With a prefix argument, makes a private paste." +With a prefix argument PRIVATE, makes a private paste. +Invoke function CALLBACK with created gist as argument." (interactive "r\nP") (let* ((file (or (buffer-file-name) (buffer-name))) (name (file-name-nondirectory file)) @@ -217,18 +228,23 @@ With a prefix argument, makes a private paste." (gist-ask-for-description-maybe) callback))) (defun gist-files (filenames &optional private callback) + "Create gist from existing FILENAMES and invoke CALLBACK function. +If PRIVATE is non-nil, create private gists." (let ((files nil)) (dolist (f filenames) (with-temp-buffer (insert-file-contents f) (let ((name (file-name-nondirectory f))) - (push (make-instance 'gh-gist-gist-file :filename name :content (buffer-string)) + (push (make-instance 'gh-gist-gist-file + :filename name + :content (buffer-string)) files)))) (gist-internal-new files private (gist-ask-for-description-maybe) callback))) (defun gist-created-callback (gist) - (let ((location (oref gist :html-url))) + "Reload gists and copy url of new GIST." + (let ((location (oref gist html-url))) (gist-list-reload 'current-user t) (message gist-created-fmt location) (when gist-view-gist @@ -237,7 +253,7 @@ With a prefix argument, makes a private paste." ;;;###autoload (defun gist-region-private (begin end) - "Post the current region as a new private paste at gist.github.com + "Post the current region between BEGIN and END as a new private paste. Copies the URL into the kill ring." (interactive "r") (gist-region begin end t)) @@ -247,9 +263,10 @@ Copies the URL into the kill ring." "Post the current buffer as a new paste at gist.github.com. Copies the URL into the kill ring. -With a prefix argument, makes a private paste." +With a prefix argument PRIVATE, makes a private paste." (interactive "P") - (gist-region (point-min) (point-max) private)) + (gist-region (point-min) + (point-max) private)) ;;;###autoload (defun gist-buffer-private () @@ -260,12 +277,11 @@ Copies the URL into the kill ring." ;;;###autoload (defun gist-region-or-buffer (&optional private) - "Post either the current region, or if mark is not set, the - current buffer as a new paste at gist.github.com + "Post either the current region or the current buffer at at gist.github.com. Copies the URL into the kill ring. -With a prefix argument, makes a private paste." +With a prefix argument, makes a PRIVATE paste." (interactive "P") (if (region-active-p) (gist-region (point) (mark) private) @@ -273,8 +289,7 @@ With a prefix argument, makes a private paste." ;;;###autoload (defun gist-region-or-buffer-private () - "Post either the current region, or if mark is not set, the - current buffer as a new private paste at gist.github.com + "Post either the current region, or if mark is not set, the current buffer. Copies the URL into the kill ring." (interactive) @@ -284,13 +299,16 @@ Copies the URL into the kill ring." ;;;###autoload (defun gist-list-user (username &optional force-reload background) - "Displays a list of a user's gists in a new buffer. When called from - a program, pass 'current-user as the username to view the user's own - gists, or nil for the username and a non-nil value for force-reload to - reload the gists for the current buffer." + "Displays a list of gists of user USERNAME in a new buffer. + +If BACKGROUND is non-nil, don't show buffer. + +When called from a program, pass ='current-user as the username to view +the user's own gists, or nil for the username and a non-nil value for +FORCE-RELOAD to reload the gists for the current buffer." (interactive (let ((username (read-from-minibuffer "GitHub user: " nil nil nil - 'gist-user-history)) + 'gist-user-history)) (force-reload (equal current-prefix-arg '(4)))) (list username force-reload))) ;; if buffer exists, it contains the current gh profile @@ -314,56 +332,64 @@ Copies the URL into the kill ring." username) (gh-api-get-username api)))) (when force-reload - (pcache-clear (oref api :cache)) + (pcache-clear (oref api cache)) (or background (message "Retrieving list of gists..."))) (unless (and background (not (get-buffer bufname))) (let ((resp (gh-gist-list api username))) (gh-url-add-response-callback resp - (lexical-let ((buffer bufname)) + (let ((buffer bufname)) (lambda (gists) (with-current-buffer (get-buffer-create buffer) (setq gist-list-buffer-user username) (gist-lists-retrieved-callback gists background))))) (gh-url-add-response-callback resp - (lexical-let ((profile (oref api :profile)) - (buffer bufname)) - (lambda (&rest args) + (let ((profile (oref api profile)) + (buffer bufname)) + (lambda (&rest _args) (with-current-buffer buffer (setq gh-profile-current-profile profile))))))))) ;;;###autoload (defun gist-list (&optional force-reload background) - "Displays a list of all of the current user's gists in a new buffer." + "Display a list of all of the current user's gists in a new buffer. +Clear caches if FORCE-RELOAD is non-nil. +If BACKGROUND is non-nil, don't show it's buffer." (interactive "P") (gist-list-user 'current-user force-reload background)) + (defun gist-list-reload (&optional username background) + "Clear caches and reload gists of user with USERNAME. +If BACKGROUND is non-nil, don't show it's buffer." (interactive) (gist-list-user username t background)) (defun gist-list-redisplay () + "Redisplay a list of current user gists." (gist-list-user 'current-user)) (defun gist-tabulated-entry (gist) + "Make tabulated entry from GIST." (let* ((data (gist-parse-gist gist)) - (repo (oref gist :id))) - (list repo (apply 'vector data)))) + (repo (oref gist id))) + (list repo (apply #'vector data)))) (defun gist-lists-retrieved-callback (gists &optional background) - "Called when the list of gists has been retrieved. Displays -the list." + "Display list of retrieved GISTS. +If BACKGROUND is non-nil, don't show it's buffer." (dolist (g (gethash gist-list-buffer-user gist-list-db-by-user)) - (remhash (oref g :id) gist-list-db)) + (remhash (oref g id) gist-list-db)) (dolist (g gists) - (puthash (oref g :id) g gist-list-db)) + (puthash (oref g id) g gist-list-db)) (puthash gist-list-buffer-user gists gist-list-db-by-user) (gist-list-render (gethash gist-list-buffer-user gist-list-db-by-user) background)) (defun gist--get-time (gist) - (let* ((date (timezone-parse-date (oref gist :date))) + "Return timestamp from GIST." + (let* ((date (timezone-parse-date (oref gist date))) (time (timezone-parse-time (aref date 3)))) (encode-time (string-to-number (aref time 2)) (string-to-number (aref time 1)) @@ -374,31 +400,35 @@ the list." (aref date 4)))) (defun gist-parse-gist (gist) - "Returns a list of the gist's attributes for display, given the xml list -for the gist." - (let ((repo (oref gist :id)) + "Return a list of the GIST's attributes for display. +See also the variable `gist-list-format'." + (let ((repo (oref gist id)) (creation (gist--get-time gist)) - (desc (or (oref gist :description) "")) - (public (eq t (oref gist :public))) - (fnames (mapcar (lambda (f) (when f (oref f :filename))) (oref gist :files)))) - (loop for (id label width sort format) in gist-list-format - collect (let ((string-formatter (if (eq id 'created) - 'format-time-string - 'format)) - (value (cond ((eq id 'id) repo) - ((eq id 'created) creation) - ((eq id 'visibility) public) - ((eq id 'description) desc) - ((eq id 'files) fnames)))) - (funcall (if (stringp format) - (lambda (val) - (funcall string-formatter format val)) - format) - value))))) + (desc (or (oref gist description) "")) + (public (eq t (oref gist public))) + (fnames (mapcar (lambda (f) + (when f (oref f filename))) + (oref gist files)))) + (cl-loop for (id _label _width _sort format) in gist-list-format + collect (let ((string-formatter (if (eq id 'created) + 'format-time-string + 'format)) + (value (cond ((eq id 'id) repo) + ((eq id 'created) creation) + ((eq id 'visibility) public) + ((eq id 'description) desc) + ((eq id 'files) fnames)))) + (funcall (if (stringp format) + (lambda (val) + (funcall string-formatter format val)) + format) + value))))) ;;;###autoload (defun gist-fetch (id) + "Fetch gist with ID." (interactive "sGist ID: ") + (require 'ibuffer) (let ((gist nil) (multi nil) (prefix (format "*gist-%s*" id)) @@ -408,24 +438,25 @@ for the gist." (let ((api (gist-get-api t))) (cond ((null gist) ;; fetch it - (setq gist (oref (gh-gist-get api id) :data)) - (puthash (oref gist :id) gist gist-list-db) - (let* ((user (oref gist :user)) + (setq gist (oref (gh-gist-get api id) data)) + (puthash (oref gist id) gist gist-list-db) + (let* ((user (oref gist user)) (gists (push gist (gethash user gist-list-db-by-user)))) (puthash user gists gist-list-db-by-user))) ((not (gh-gist-gist-has-files gist)) (gh-gist-get api gist)))) - (let ((files (oref gist :files))) + (let ((files (oref gist files))) (setq multi (< 1 (length files))) (dolist (f files) (let ((buffer (get-buffer-create (format "%s/%s" prefix - (oref f :filename)))) - (mode (car (rassoc (file-name-extension (oref f :filename)) + (oref f filename)))) + (mode (car (rassoc (file-name-extension (oref f filename)) gist-supported-modes-alist)))) (with-current-buffer buffer - (delete-region (point-min) (point-max)) - (insert (oref f :content)) - (let ((fname (oref f :filename))) + (delete-region (point-min) + (point-max)) + (insert (oref f content)) + (let ((fname (oref f filename))) ;; set major mode (if (fboundp mode) (funcall mode) @@ -440,27 +471,28 @@ for the gist." (set-buffer-modified-p nil)) (setq result buffer)))) (if multi - (let ((ibuffer-mode-hook nil) - (ibuffer-use-header-line nil) - (ibuffer-show-empty-filter-groups nil)) - (ibuffer t prefix - `((name . ,(regexp-quote (concat prefix "/")))) - nil nil - nil - '((name)))) + (ibuffer t prefix + `((name . ,(regexp-quote (concat prefix "/")))) + nil nil + nil + '((name))) (switch-to-buffer-other-window result)))) (defun gist-fetch-current () + "Fetch gist at point and switch to it's buffer." (interactive) (gist-fetch (tabulated-list-get-id))) + (defun gist-fetch-current-noselect () + "Display content of a gist at point without switching to it's buffer." (interactive) (let ((win (selected-window))) (gist-fetch-current) (select-window win))) (defun gist--check-perms-and-get-api (gist errormsg apiflg) + "Signal user error ERRORMSG if GIST is not present in `gist-list-db-by-user'." (let* ((api (gist-get-api apiflg)) (username (gh-api-get-username api)) (gs (gethash username gist-list-db-by-user))) @@ -469,22 +501,24 @@ for the gist." api))) (defun gist-edit-current-description () + "Edit description for gist at point." (interactive) (let* ((id (tabulated-list-get-id)) (gist (gist-list-db-get-gist id)) (api (gist--check-perms-and-get-api gist "Can't edit a gist that doesn't belong to you" t))) - (let* ((old-descr (oref gist :description)) + (let* ((old-descr (oref gist description)) (new-descr (read-from-minibuffer "Description: " old-descr)) (g (clone gist :files nil :description new-descr)) (resp (gh-gist-edit api g))) (gh-url-add-response-callback resp - (lambda (gist) + (lambda (_gist) (gist-list-reload)))))) (defun gist-add-buffer (buffer) + "Add BUFFER to the gist at point." (interactive "bBuffer: ") (let* ((buffer (get-buffer buffer)) (id (tabulated-list-get-id)) @@ -501,17 +535,20 @@ for the gist." (buffer-string)))))) (resp (gh-gist-edit api g))) (gh-url-add-response-callback resp - (lambda (gist) + (lambda (_gist) (gist-list-reload))))) + (defun gist-remove-file (fname) + "Remove gist's file FNAME." (interactive (list (completing-read "Filename to remove: " (let* ((id (tabulated-list-get-id)) (gist (gist-list-db-get-gist id))) - (mapcar #'(lambda (f) (oref f :filename)) - (oref gist :files)))))) + (mapcar #'(lambda (f) + (oref f filename)) + (oref gist files)))))) (let* ((id (tabulated-list-get-id)) (gist (gist-list-db-get-gist id)) (api (gist--check-perms-and-get-api @@ -523,68 +560,73 @@ for the gist." :content nil)))) (resp (gh-gist-edit api g))) (gh-url-add-response-callback resp - (lambda (gist) + (lambda (_gist) (gist-list-reload))))) (defun gist-kill-current () + "Delete gist at point." (interactive) (let* ((id (tabulated-list-get-id)) (gist (gist-list-db-get-gist id)) (api (gist--check-perms-and-get-api gist "Can't delete a gist that doesn't belong to you" t))) - (when (yes-or-no-p (format "Really delete gist %s ? " id) ) - (let* ((resp (gh-gist-delete api id))) - (gist-list-reload))))) + (when (yes-or-no-p (format "Really delete gist %s ? " id)) + (gh-gist-delete api id) + (gist-list-reload)))) (defun gist-current-url () - "Helper function to fetch current gist url" + "Helper function to fetch current gist url." (let* ((id (or (and (eq major-mode 'gist-list-mode) (tabulated-list-get-id)) (and (boundp 'gist-mode) gist-mode gist-id))) (gist (gist-list-db-get-gist id))) - (oref gist :html-url))) + (oref gist html-url))) (defun gist-print-current-url () - "Display the currently selected gist's url in the echo area and -put it into `kill-ring'." + "Display and copy the currently selected gist's url in the echo area." (interactive) (kill-new (message (gist-current-url)))) + (defun gist-browse-current-url () - "Browse current gist on github" + "Browse current gist on github." (interactive) (browse-url (gist-current-url))) (defun gist--do-star (id how msg) + "Star (if HOW is non-nil) or unstar gist with ID and show message MSG." (let* ((api (gist-get-api t)) (resp (gh-gist-set-star api id how))) (gh-url-add-response-callback resp - (lambda (gist) + (lambda (_gist) (message msg id))))) ;;;###autoload (defun gist-star () + "Star gist at point." (interactive) (let ((id (tabulated-list-get-id))) (gist--do-star id t "Starred gist %s"))) ;;;###autoload (defun gist-unstar () + "Unstar gist at point." (interactive) (let ((id (tabulated-list-get-id))) (gist--do-star id nil "Unstarred gist %s"))) ;;;###autoload (defun gist-list-starred (&optional background) - "List your starred gists." + "List your starred gists. +If BACKGROUND is non nil, don't show the buffer." (interactive) (let* ((api (gist-get-api t)) (resp (gh-gist-list-starred api))) (gh-url-add-response-callback resp - (lexical-let ((buffer "*starred-gists*")) + (let ((buffer "*starred-gists*")) (lambda (gists) (with-current-buffer (get-buffer-create buffer) (gist-list-render gists background))))))) @@ -597,7 +639,7 @@ put it into `kill-ring'." (api (gist-get-api)) (resp (gh-gist-fork api id))) (gh-url-add-response-callback resp - (lambda (gist) + (lambda (_gist) (message "Forked gist %s" id))))) (defvar gist-list-menu-mode-map @@ -625,8 +667,8 @@ put it into `kill-ring'." \\ \\{gist-list-menu-mode-map}" (setq tabulated-list-format - (apply 'vector - (loop for (sym label width sort format) in gist-list-format + (apply #'vector + (cl-loop for (_sym label width sort _format) in gist-list-format collect (list label width sort))) tabulated-list-padding 2 tabulated-list-sort-key nil) @@ -634,23 +676,31 @@ put it into `kill-ring'." (use-local-map gist-list-menu-mode-map) (font-lock-add-keywords nil '(("#[^[:space:]]*" . 'font-lock-keyword-face)))) + (defun gist-list-pop-limit (&optional all) + "Toggle visibility filter for gists. +With prefix argument ALL, show all gists, othervise pop latest filter." (interactive "P") (if all (setq gist-list-limits nil) (pop gist-list-limits)) (gist-list-redisplay)) + (defun gist-list-push-visibility-limit (&optional private) + "Push visibility filter. +If PRIVATE is non nil, show public gists, othervise private." (interactive "P") (push (apply-partially (lambda (flag g) - (or (and flag (not (oref g :public))) - (and (not flag) (oref g :public)))) + (or (and flag (not (oref g public))) + (and (not flag) + (oref g public)))) private) gist-list-limits) (gist-list-redisplay)) (defun gist-parse-tags (tags) + "Parse TAGS." (let ((words (split-string tags)) with without) (dolist (w words) @@ -663,54 +713,63 @@ put it into `kill-ring'." (list with without))) (defun gist-list-push-tag-limit (tags) + "Push TAGS limit." (interactive "sTags: ") (let* ((lsts (gist-parse-tags tags)) (with (car lsts)) (without (cadr lsts))) (push (apply-partially (lambda (with without g) (and - (every (lambda (tag) - (string-match-p - (format "#%s\\>" tag) - (oref g :description))) - with) - (not (some (lambda (tag) - (string-match-p - (format "#%s\\>" tag) - (oref g :description))) - without)))) + (cl-every (lambda (tag) + (string-match-p + (format "#%s\\>" tag) + (oref g description))) + with) + (not (cl-some (lambda (tag) + (string-match-p + (format "#%s\\>" tag) + (oref g description))) + without)))) with without) gist-list-limits)) (gist-list-redisplay)) (defun gist-list-apply-limits (gists) + "Apply filter to GISTS." (condition-case nil (delete nil (mapcar (lambda (g) - (when (every #'identity - (mapcar (lambda (f) (funcall f g)) gist-list-limits)) + (when (cl-every #'identity + (mapcar (lambda (f) + (funcall f g)) + gist-list-limits)) g)) gists)) (error gists))) (defun gist-list-render (gists &optional background) + "Render list of GISTS. +If BACKGROUND is non-nil, don't show it's buffer." (gist-list-mode) - (let ((entries (mapcar 'gist-tabulated-entry + (let ((entries (mapcar #'gist-tabulated-entry (gist-list-apply-limits gists)))) (setq tabulated-list-entries entries) - (when (not (equal (length gists) (length entries))) - (setq mode-name (format "Gists[%d/%d]" (length entries) (length gists))))) + (when (not (equal (length gists) + (length entries))) + (setq mode-name (format "Gists[%d/%d]" (length entries) + (length gists))))) (tabulated-list-print) (gist-list-tag-multi-files) (unless background (set-window-buffer nil (current-buffer)))) (defun gist-list-tag-multi-files () + "Put tags to gists with multiple files in the padding area." (let ((ids nil)) - (maphash (lambda (k v) - (when (< 1 (length (oref v :files))) - (push (oref v :id) ids))) + (maphash (lambda (_k v) + (when (< 1 (length (oref v files))) + (push (oref v id) ids))) gist-list-db) (save-excursion (goto-char (point-min)) @@ -720,11 +779,13 @@ put it into `kill-ring'." (forward-line 1)))))) (defun gist-list-db-get-gist (id) + "Return gist with ID from `gist-list-db'." (gethash id gist-list-db)) ;;; Gist minor mode - (defun gist-mode-edit-buffer (&optional new-name) + "Save currently editing gist. +With NEW-NAME rename gist." (when (or (buffer-modified-p) new-name) (let* ((id gist-id) (gist (gist-list-db-get-gist id)) @@ -734,10 +795,10 @@ put it into `kill-ring'." :content (buffer-string))))) (when new-name ;; remove old file as well - (add-to-list 'files - (make-instance 'gh-gist-gist-file - :filename gist-filename - :content nil))) + (push (make-instance 'gh-gist-gist-file + :filename gist-filename + :content nil) + files)) (let* ((g (clone gist :files files)) (api (gist-get-api t)) @@ -751,14 +812,16 @@ put it into `kill-ring'." (concat "/" new-name) (buffer-name))) (setq gist-filename new-name)) - (let ((g (gist-list-db-get-gist (oref gist :id)))) - (oset g :files (oref gist :files))))))))) + (let ((g (gist-list-db-get-gist (oref gist id)))) + (oset g :files (oref gist files))))))))) (defun gist-mode-save-buffer () + "Save gist in edit buffer." (interactive) (gist-mode-edit-buffer)) (defun gist-mode-write-file () + "Rename current gist." (interactive) (let ((new-name (read-from-minibuffer "File name: " gist-filename))) (gist-mode-edit-buffer new-name))) @@ -770,19 +833,18 @@ put it into `kill-ring'." map)) (define-minor-mode gist-mode - "Minor mode for buffers containing gists files" + "Minor mode for buffers containing gists files." :lighter " gist" :map 'gist-mode-map) ;;; Dired integration -(require 'dired) - -(defun dired-do-gist (&optional private) +(defun gist-dired-do-gist (&optional private) + "Create gist from marked files in `dired'. +If PRIVATE is non-nil, create private gists." (interactive "P") + (require 'dired) (gist-files (dired-get-marked-files) private)) -(define-key dired-mode-map "@" 'dired-do-gist) - (provide 'gist) ;;; gist.el ends here