Permalink
Browse files

Adds a basic gist-list command that fetches the list of the user's gi…

…sts and displays them in a buffer, from which they can fetch gists.

Changes calls to git to use the more durable executable-find.

Adds a macro useful for minimizing shell calls to retrieve the authentication info.

Refactors the request code to share the authentication retrieval bits among authenticated functions.
  • Loading branch information...
1 parent 3c0ca85 commit 660423da7ca8a6b71505df7a2e9bb1e1bd3362ad @mcfunley mcfunley committed Feb 27, 2010
Showing with 147 additions and 32 deletions.
  1. +147 −32 gist.el
View
179 gist.el
@@ -35,6 +35,7 @@
;;; Code:
(eval-when-compile (require 'cl))
+(require 'xml)
(defvar github-user nil
"If non-nil, will be used as your GitHub username without checking
@@ -80,33 +81,41 @@ posted.")
(tex-mode . "tex")
(xml-mode . "xml")))
+
+
+(defun* gist-request (url callback &optional params)
+ "Makes a request to `url' asynchronously, notifying `callback' when
+complete. The github parameters are included in the request. Optionally
+accepts additional POST `params' as a list of (key . value) conses."
+ (github-with-auth-info login token
+ (let ((url-request-data (gist-make-query-string
+ `(("login" . ,login)
+ ("token" . ,token) ,@params)))
+ (url-max-redirecton 5)
+ (url-request-method "POST"))
+ (url-retrieve url callback))))
+
;;;###autoload
(defun gist-region (begin end &optional private &optional callback)
"Post the current region as a new paste at gist.github.com
Copies the URL into the kill ring.
With a prefix argument, makes a private paste."
(interactive "r\nP")
- (destructuring-bind (login . token) (github-auth-info)
- (let* ((file (or (buffer-file-name) (buffer-name)))
- (name (file-name-nondirectory file))
- (ext (or (cdr (assoc major-mode gist-supported-modes-alist))
- (file-name-extension file)
- "txt"))
- (url-max-redirections 5)
- (url-request-method "POST")
- (url-request-data (gist-make-query-string
- `(,@(if private '(("action_button" . "private")))
- ("login" . ,login)
- ("token" . ,token)
- ("file_ext[gistfile1]" . ,(concat "." ext))
- ("file_name[gistfile1]" . ,name)
- ("file_contents[gistfile1]" . ,(buffer-substring begin end))))))
- (url-retrieve "http://gist.github.com/gists"
- (or callback 'gist-url-retrieved-callback)))))
-
-
-(defun gist-url-retrieved-callback (status)
+ (let* ((file (or (buffer-file-name) (buffer-name)))
+ (name (file-name-nondirectory file))
+ (ext (or (cdr (assoc major-mode gist-supported-modes-alist))
+ (file-name-extension file)
+ "txt")))
+ (gist-request
+ "http://gist.github.com/gists"
+ (or callback 'gist-created-callback)
+ `(,@(if private '(("action_button" . "private")))
+ ("file_ext[gistfile1]" . ,(concat "." ext))
+ ("file_name[gistfile1]" . ,name)
+ ("file_contents[gistfile1]" . ,(buffer-substring begin end))))))
+
+(defun gist-created-callback (status)
(let ((location (cadr status)))
(message "Paste created: %s" location)
(when gist-view-gist
@@ -135,13 +144,16 @@ Copies the URL into the kill ring."
"Returns a GitHub specific value from the global Git config."
(let ((strip (lambda (string)
(if (> (length string) 0)
- (substring string 0 (- (length string) 1))))))
+ (substring string 0 (- (length string) 1)))))
+ (git (executable-find "git")))
(funcall strip (shell-command-to-string
- (concat "git config --global github." key)))))
+ (concat git " config --global github." key)))))
(defun github-set-config (key value)
"Sets a GitHub specific value to the global Git config."
- (shell-command-to-string (format "git config --global github.%s %s" key value)))
+ (let ((git (executable-find "git")))
+ (shell-command-to-string
+ (format git " config --global github.%s %s" key value))))
(defun github-auth-info ()
"Returns the user's GitHub authorization information.
@@ -150,18 +162,31 @@ and returns (USERNAME . TOKEN). If nothing is found, prompts
for the info then sets it to the git config."
(interactive)
- (let* ((user (or github-user (github-config "user")))
- (token (or github-token (github-config "token"))))
+ ;; If we've been called within a scope that already has this
+ ;; defined, don't take the time to get it again.
+ (if (boundp '*github-auth-info*)
+ *github-auth-info*
+
+ (let* ((user (or github-user (github-config "user")))
+ (token (or github-token (github-config "token"))))
+
+ (when (not user)
+ (setq user (read-string "GitHub username: "))
+ (github-set-config "user" user))
- (when (not user)
- (setq user (read-string "GitHub username: "))
- (github-set-config "user" user))
+ (when (not token)
+ (setq token (read-string "GitHub API token: "))
+ (github-set-config "token" token))
- (when (not token)
- (setq token (read-string "GitHub API token: "))
- (github-set-config "token" token))
+ (cons user token))))
- (cons user token)))
+(defmacro github-with-auth-info (login token &rest body)
+ "Binds the github authentication credentials to `login' and `token'.
+The credentials are retrieved at most once within the body of this macro."
+ (declare (indent 2))
+ `(let ((*github-auth-info* (github-auth-info)))
+ (destructuring-bind (,login . ,token) *github-auth-info*
+ ,@body)))
;;;###autoload
(defun gist-buffer (&optional private)
@@ -203,6 +228,96 @@ Copies the URL into the kill ring."
"Raw Gist content URL format")
;;;###autoload
+(defun gist-list ()
+ "Displays a list of all of the current user's gists in a new buffer."
+ (interactive)
+ (message "Retrieving list of your gists...")
+ (github-with-auth-info login token
+ (gist-request
+ (format "http://gist.github.com/api/v1/xml/gists/%s" login)
+ 'gist-lists-retrieved-callback)))
+
+(defun gist-lists-retrieved-callback (status)
+ "Called when the list of gists has been retrieved. Parses the result
+and displays the list."
+ (goto-char (point-min))
+ (search-forward "<?xml")
+ (let ((gists (gist-xml-cleanup
+ (xml-parse-region (match-beginning 0) (point-max)))))
+ (kill-buffer (current-buffer))
+ (with-current-buffer (get-buffer-create "*gists*")
+ (goto-char (point-min))
+ (save-excursion
+ (kill-region (point-min) (point-max))
+ (gist-insert-list-header)
+ (mapc 'gist-insert-gist-link (xml-node-children (car gists)))
+
+ ;; remove the extra newline at the end
+ (delete-backward-char 1))
+
+ ;; skip header
+ (forward-line)
+ (toggle-read-only t)
+ (set-window-buffer nil (current-buffer)))))
+
+(defun gist-insert-list-header ()
+ "Creates the header line in the gist list buffer."
+ (save-excursion
+ (insert " ID Created "
+ "Visibility Description \n"))
+ (let ((ov (make-overlay (line-beginning-position) (line-end-position))))
+ (overlay-put ov 'face 'header-line))
+ (forward-line))
+
+(defun gist-insert-gist-link (gist)
+ "Inserts a button that will open the given gist when pressed."
+ (let* ((data (gist-parse-gist gist))
+ (repo (string-to-number (car data))))
+ (mapc '(lambda (x) (insert (format " %s " x))) data)
+ (make-text-button (line-beginning-position) (line-end-position)
+ 'repo repo
+ 'action 'gist-fetch-button
+ 'face 'default))
+ (insert "\n"))
+
+(defun gist-fetch-button (button)
+ "Called when a gist button has been pressed. Fetches and displays the gist."
+ (gist-fetch (button-get button 'repo)))
+
+(defun gist-parse-gist (gist)
+ "Returns a list of the gist's attributes for display, given the xml list
+for the gist."
+ (let ((repo (gist-child-text 'repo gist))
+ (created-at (gist-child-text 'created-at gist))
+ (description (gist-child-text 'description gist))
+ (public (if (string= (gist-child-text 'public gist) "true")
+ "public"
+ "private")))
+ (list repo created-at public description)))
+
+(defun gist-child-text (sym node)
+ "Retrieves the text content of a child of a <gist> element."
+ (let* ((children (xml-node-children node)))
+ (car (xml-node-children (assq sym children)))))
+
+(defun gist-xml-cleanup (xml-list)
+ "Remove empty string or whitespace string node from the XML-LIST.
+Borrowed from rss.el."
+ (mapcar 'gist-xml-cleanup-node xml-list))
+
+(defun gist-xml-cleanup-node (node)
+ (apply 'list
+ (xml-node-name node)
+ (xml-node-attributes node)
+ (let (new)
+ (dolist (child (xml-node-children node))
+ (if (stringp child)
+ (or (string-match "\\`[ \t\n]+\\'" child)
+ (push child new))
+ (push (gist-xml-cleanup-node child) new)))
+ (nreverse new))))
+
+;;;###autoload
(defun gist-fetch (id)
"Fetches a Gist and inserts it into a new buffer
If the Gist already exists in a buffer, switches to it"

0 comments on commit 660423d

Please sign in to comment.