github API v3 based gist.el

gist.el

(eval-when-compile (require 'cl))
(require 'json)

(defvar gist-github-user nil
  "GitHub username")
(defvar gist-github-password nil
  "GitHub password")
(defvar gist-supported-modes-alist '((action-script-mode . "as")
                                     (c-mode . "c")
                                     (c++-mode . "cpp")
                                     (clojure-mode . "clj")
                                     (common-lisp-mode . "lisp")
                                     (css-mode . "css")
                                     (diff-mode . "diff")
                                     (emacs-lisp-mode . "el")
                                     (erlang-mode . "erl")
                                     (haskell-mode . "hs")
                                     (html-mode . "html")
                                     (io-mode . "io")
                                     (java-mode . "java")
                                     (javascript-mode . "js")
                                     (jde-mode . "java")
                                     (js2-mode . "js")
                                     (lua-mode . "lua")
                                     (ocaml-mode . "ml")
                                     (objective-c-mode . "m")
                                     (perl-mode . "pl")
                                     (php-mode . "php")
                                     (python-mode . "py")
                                     (ruby-mode . "rb")
                                     (text-mode . "txt")
                                     (scala-mode . "scala")
                                     (sql-mode . "sql")
                                     (scheme-mode . "scm")
                                     (smalltalk-mode . "st")
                                     (sh-mode . "sh")
                                     (tcl-mode . "tcl")
                                     (tex-mode . "tex")
                                     (xml-mode . "xml")))

; gist api base url
(defvar gist-url-api-base "https://api.github.com")
; gist api path and methods
(defvar gist-path-list '("/gists" . "GET"))
(defvar gist-path-single '("/gists/%s" . "GET"))
(defvar gist-path-create '("/gists" . "POST"))
(defvar gist-path-edit '("/gists/%s" . "PATCH"))
(defvar gist-path-delete '("/gists/%s" . "DELETE"))

(setq gist-current-id nil)
(setq gist-current-file nil)

(defun gist-url (path &rest params)
  "Make a gist-api url."
  (let ((gist-api-url (concat gist-url-api-base (car path))))
    (if params (setq gist-api-url (apply 'format gist-api-url params)))
    gist-api-url))

; use BASIC authentication
(defun gist-request (url method callback &optional body)
  "Makes a request to 'url' asynchronously, notifying 'callback' when complete."
  (when (not gist-github-user)
    (setq gist-github-user (read-string "GitHub username: ")))
  (when (not gist-github-password)
    (setq gist-github-password (read-passwd "GitHub password: ")))
  (let ((url-max-redirection -1)
        (url-request-method method)
        (url-request-extra-headers
         `(("Authorization" . ,(concat "Basic "
                                       (base64-encode-string
                                        (concat gist-github-user ":" gist-github-password))))))
        (url-request-data nil))
        (if body (setq url-request-data body))
        (url-retrieve url 'gist-request-callback (list callback))))

(defun gist-parse-json ()
  "Parse HTTP response as JSON"
  (goto-char (point-min))
  (re-search-forward "^$")
  (let ((body (buffer-substring (+ (match-beginning 0) 1) (point-max))))
    (kill-buffer (current-buffer))
    (if (string= body "") nil (json-read-from-string body))))

(defun gist-request-callback (status callback)
  "Called when the response is returned."
  (let ((gist-json (gist-parse-json)))
    (if (string= (car status) ":error")
        (error "%s" (cdar gist-json))
      (funcall callback gist-json))))

(defun gist-list-retrieve (data)
  "Called when the list of gists has been retrieved. Parses the result and displays the list."
  (with-current-buffer (get-buffer-create "*gists*")
    (toggle-read-only -1)
    (goto-char (point-min))
    (save-excursion
      (kill-region (point-min) (point-max))
      (gist-insert-list-header)
      (mapc 'gist-insert-gist-link data)
      (delete-backward-char 1))
    (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 (format "  %-12s%-23s%-13s%-8s%s\n" 'ID 'Created 'Visibility 'Files 'Description)))
  (let ((ov (make-overlay (line-beginning-position) (line-end-position))))
    (overlay-put ov 'face 'header-line))
  (forward-line))

(defun gist-parse-gist (gist)
  "Returns a list of the gist's attributes for display."
  (let ((id (cdr (assoc 'id gist)))
        (created (cdr (assoc 'created_at gist)))
        (description (cdr (assoc 'description gist)))
        (public (if (equal (cdr (assoc 'public gist)) :json-false)
                    "private" "public"))
        (files (mapcar
                '(lambda (f)
                   (list (cdr (assoc 'filename (cdr f))) (cdr f)))
                (cdr (assoc 'files gist)))))
    (list id created public (length files) description files)))

(defun gist-insert-gist-link (gist)
  "Inserts a button that will open the given gist when pressed."
  (let* ((data (gist-parse-gist gist))
         (id (car data)))
    (insert (format "  %-12s%-23s%-13s%-8s%s"
                    (if (> (length id) 9) (concat (substring id 0 9) "..") id) ;id
                    (nth 1 data)        ; created-at
                    (nth 2 data)        ; public
                    (nth 3 data)        ; files
                    (nth 4 data)))      ; description
    (make-text-button (line-beginning-position) (line-end-position)
                      'id id
                      '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 'id)))

(defun gist-file-retrieve (data)
  (let* ((gist (gist-parse-gist data))
         (id (car gist))
         (gist-files (nth 5 gist))
         (file (if (eq (length gist-files) 1)
                   (car gist-files)
                 (assoc
                  (completing-read "Select File: " gist-files nil t) gist-files)))
         (gist-buffer-name)
         (gist-buffer))
    (setq gist-buffer-name (format "*gist %s %s*" id (car file)))
    (setq gist-buffer (get-buffer gist-buffer-name))
    (if (bufferp gist-buffer)
        (switch-to-buffer gist-buffer)
      (setq gist-buffer (get-buffer-create gist-buffer-name))
      (with-current-buffer gist-buffer
        (goto-char (point-min))
        (save-excursion
          (kill-region (point-min) (point-max))
          (insert (cdr (assoc 'content (car (cdr file)))))))
      (switch-to-buffer gist-buffer)
      (kill-all-local-variables)
      (setq default-major-mode
            (or (car (rassoc (file-name-extension (car file)) gist-supported-modes-alist))
                'text-mode))
      (set-buffer-major-mode gist-buffer)
      (make-local-variable 'gist-current-id)
      (make-local-variable 'gist-current-file)
      (setq gist-current-id id)
      (setq gist-current-file (car file)))))

;;;###autoload
(defun gist-fetch (id &optional file)
  "Fetches a Gist and inserts it into a new buffer
If the Gist already exists in a buffer, switches to it"
  (interactive "sGist ID: ")
  (gist-request
   (gist-url gist-path-single id) (cdr gist-path-single) 'gist-file-retrieve))

;;;###autoload
(defun gist-list ()
  "Displays a list of all of the current user's gists in a new buffer."
  (interactive)
  (gist-request
   (gist-url gist-path-list) (cdr gist-path-list) 'gist-list-retrieve))

;;;###autoload
(defun gist-buffer (&optional private)
  "Post the current buffer as a new paste at gist.github.com.
With a prefix argument, makes a private paste."
  (interactive "P")
  (gist-region (point-min) (point-max) private))

;;;###autoload
(defun gist-buffer-private ()
  "Post the current buffer as a new private paste at gist.github.com."
  (interactive)
  (gist-region-private (point-min) (point-max)))

;;;###autoload
(defun gist-region (begin end &optional private &optional callback)
  "Post the current region as a new paste at gist.github.com
With a prefix argument, makes a private paste."
  (interactive "r\nP")
  (let* ((file (or (buffer-file-name) (buffer-name)))
         (name (file-name-nondirectory file))
         (description (read-string "Description: "))
         (data (make-hash-table :test 'equal))
         (content (make-hash-table :test 'equal))
         (file (make-hash-table :test 'equal)))
    (puthash "description" description data)
    (if private
        (puthash "public" "false" data)
      (puthash "public" "true" data))
    (puthash "content" (buffer-substring begin end) content)
    (puthash name content file)
    (puthash "files" file data)
    (gist-request
     (gist-url gist-path-create)
     (cdr gist-path-create)
     '(lambda (data)
        (let* ((gist (gist-parse-gist data))
              (id (car gist)))
          (message "Created: %s" id)))
     (json-encode data))))

;;;###autoload
(defun gist-region-private (begin end)
  "Post the current region as a new private paste at gist.github.com."
  (interactive "r")
  (gist-region begin end t))

;;;###autoload
(defun gist-delete ()
  ""
  (interactive)
  (let ((id (or gist-current-id
               (read-string "Gist ID: "))))
    (gist-request
     (gist-url gist-path-delete id)
     (cdr gist-path-delete)
     `(lambda (&rest args) (message (concat "Deleted: " ,id))))))

;;;###autoload
(defun gist-edit (delete)
  ""
  (interactive "P")
  (let ((id (or gist-current-id
               (read-string "Gist ID: ")))
        (name (or gist-current-file
                  (read-string "Gist file: "
                               (file-name-nondirectory
                                (or (buffer-file-name) (buffer-name))))))
        (data (make-hash-table :test 'equal))
        (file (make-hash-table :test 'equal))
        (content (make-hash-table :test 'equal)))
    (if delete
        (puthash name json-null file)
      (puthash "content" (buffer-substring (point-min) (point-max)) content)
      (puthash name content file))
    (puthash "files" file data)
    (gist-request
     (gist-url gist-path-edit id)
     (cdr gist-path-edit)
     `(lambda (&rest args) (message (concat "Edited: " ,name "@" ,id)))
     (json-encode data))))

Emacs Lisp よくわからん...

アカウント/パスワード周りをなんとかしたい

リファクタしなきゃ

一通りの機能は揃ったので、インターフェースの整合性の調整とリファクタせねば