diff options
| -rw-r--r-- | sx-auth.el | 56 | ||||
| -rw-r--r-- | sx-cache.el | 66 | ||||
| -rw-r--r-- | sx-encoding.el | 83 | ||||
| -rw-r--r-- | sx-filter.el | 62 | ||||
| -rw-r--r-- | sx-lto.el | 43 | ||||
| -rw-r--r-- | sx-network.el | 16 | ||||
| -rw-r--r-- | sx-question-list.el | 241 | ||||
| -rw-r--r-- | sx-question.el | 72 | ||||
| -rw-r--r-- | sx-request.el | 194 | ||||
| -rw-r--r-- | sx-time.el | 54 | ||||
| -rw-r--r-- | sx.el | 359 |
11 files changed, 683 insertions, 563 deletions
@@ -1,4 +1,4 @@ -;;; stack-auth.el --- user authentication for stack-mode -*- lexical-binding: t; -*- +;;; sx-auth.el --- user authentication -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -19,19 +19,21 @@ ;;; Commentary: -;; +;; ;;; Code: -(require 'stack-core) +(require 'sx) +(require 'sx-request) +(require 'sx-cache) -(defconst stack-auth-root - "https://stackexchange.com/oauth/dialog") -(defconst stack-auth--redirect-uri +(defconst sx-auth-root + "https://stackexchange.com/oauth/") +(defconst sx-auth-redirect-uri "http://vermiculus.github.io/stack-mode/auth/auth.htm") -(defconst stack-auth--client-id +(defconst sx-auth-client-id "3291") -(defvar stack-auth-access-token +(defvar sx-auth-access-token nil "Your access token. @@ -39,7 +41,7 @@ This is needed to use your account to write questions, make comments, and read your inbox. Do not alter this unless you know what you are doing!") -(defun stack-authenticate () +(defun sx-auth-authenticate () "Authenticate this application. Authentication is required to read your personal data (such as @@ -47,23 +49,27 @@ notifications) and to write with the API (asking and answering questions)." (interactive) (setq - stack-auth-access-token - (when (browse-url - (let ((stack-core-api-root stack-auth-root) - (stack-core-api-batch-request-separator ",")) - (stack-core-build-request - nil - `((client_id . ,stack-auth--client-id) - (scope . (read_inbox - no_expiry - write_access)) - (redirect_uri . ,(url-hexify-string - stack-auth--redirect-uri)))))) + sx-auth-access-token + (let* ((sx-request-api-root sx-auth-root) + (url (sx-request--build + "dialog" + `((client_id . ,sx-auth-client-id) + (scope . (read_inbox + no_expiry + write_access)) + (redirect_uri . ,(url-hexify-string + sx-auth-redirect-uri))) + ","))) + (browse-url url) (read-string "Enter the access token displayed on the webpage: "))) - (if (string-equal "" stack-auth-access-token) - (progn (setq stack-auth-access-token nil) + (if (string-equal "" sx-auth-access-token) + (progn (setq sx-auth-access-token nil) (error "You must enter this code to use this client fully")) - (stack-cache-set "auth.el" `((access-token . ,stack-auth-access-token))))) + (sx-cache-set "auth.el" `((access-token . ,sx-auth-access-token))))) -(provide 'stack-auth) +(provide 'sx-auth) ;;; stack-auth.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-cache.el b/sx-cache.el new file mode 100644 index 0000000..a090982 --- /dev/null +++ b/sx-cache.el @@ -0,0 +1,66 @@ +;;; sx-cache.el --- caching for stack-mode + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred <sallred@calamity.tcs.com> +;; Keywords: help + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(defcustom sx-cache-directory + (expand-file-name ".stackmode" user-emacs-directory) + "Directory containined cached files and precompiled filters.") + +(defun sx-cache-get-file-name (filename) + "Expands FILENAME in the context of `sx-cache-directory'." + (expand-file-name filename sx-cache-directory)) + +(defun sx-cache-get (cache) + "Return the data within CACHE. + +As with `sx-cache-set', CACHE is a file name within the +context of `sx-cache-directory'." + (unless (file-exists-p sx-cache-directory) + (mkdir sx-cache-directory)) + (let ((file (sx-cache-get-file-name cache))) + (when (file-exists-p file) + (with-temp-buffer + (insert-file-contents (sx-cache-get-file-name cache)) + (read (buffer-string)))))) + +(defun sx-cache-set (cache data) + "Set the content of CACHE to DATA. + +As with `sx-cache-get', CACHE is a file name within the +context of `sx-cache-directory'. + +DATA will be written as returned by `prin1'." + (unless (file-exists-p sx-cache-directory) + (mkdir sx-cache-directory)) + (write-region (prin1-to-string data) nil + (sx-cache-get-file-name cache)) + data) + +(provide 'sx-cache) +;;; sx-cache.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-encoding.el b/sx-encoding.el new file mode 100644 index 0000000..efb333e --- /dev/null +++ b/sx-encoding.el @@ -0,0 +1,83 @@ +;;; sx-encoding.el --- encoding for stack-mode + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred <sallred@calamity.tcs.com> +;; Keywords: help + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(defcustom sx-encoding-html-entities-plist + '(Aacute "Á" aacute "á" Acirc "Â" acirc "â" acute "´" AElig "Æ" aelig "æ" + Agrave "À" agrave "à" alefsym "ℵ" Alpha "Α" alpha "α" amp "&" and "∧" + ang "∠" apos "'" aring "å" Aring "Å" asymp "≈" atilde "ã" Atilde "Ã" + auml "ä" Auml "Ä" bdquo "„" Beta "Β" beta "β" brvbar "¦" bull "•" + cap "∩" ccedil "ç" Ccedil "Ç" cedil "¸" cent "¢" Chi "Χ" chi "χ" + circ "ˆ" clubs "♣" cong "≅" copy "©" crarr "↵" cup "∪" curren "¤" + Dagger "‡" dagger "†" darr "↓" dArr "⇓" deg "°" Delta "Δ" delta "δ" + diams "♦" divide "÷" eacute "é" Eacute "É" ecirc "ê" Ecirc "Ê" egrave "è" + Egrave "È" empty "∅" emsp " " ensp " " Epsilon "Ε" epsilon "ε" equiv "≡" + Eta "Η" eta "η" eth "ð" ETH "Ð" euml "ë" Euml "Ë" euro "€" + exist "∃" fnof "ƒ" forall "∀" frac12 "½" frac14 "¼" frac34 "¾" frasl "⁄" + Gamma "Γ" gamma "γ" ge "≥" gt ">" harr "↔" hArr "⇔" hearts "♥" + hellip "…" iacute "í" Iacute "Í" icirc "î" Icirc "Î" iexcl "¡" igrave "ì" + Igrave "Ì" image "ℑ" infin "∞" int "∫" Iota "Ι" iota "ι" iquest "¿" + isin "∈" iuml "ï" Iuml "Ï" Kappa "Κ" kappa "κ" Lambda "Λ" lambda "λ" + lang "〈" laquo "«" larr "←" lArr "⇐" lceil "⌈" ldquo "“" le "≤" + lfloor "⌊" lowast "∗" loz "◊" lrm "" lsaquo "‹" lsquo "‘" lt "<" + macr "¯" mdash "—" micro "µ" middot "·" minus "−" Mu "Μ" mu "μ" + nabla "∇" nbsp "" ndash "–" ne "≠" ni "∋" not "¬" notin "∉" + nsub "⊄" ntilde "ñ" Ntilde "Ñ" Nu "Ν" nu "ν" oacute "ó" Oacute "Ó" + ocirc "ô" Ocirc "Ô" OElig "Œ" oelig "œ" ograve "ò" Ograve "Ò" oline "‾" + omega "ω" Omega "Ω" Omicron "Ο" omicron "ο" oplus "⊕" or "∨" ordf "ª" + ordm "º" oslash "ø" Oslash "Ø" otilde "õ" Otilde "Õ" otimes "⊗" ouml "ö" + Ouml "Ö" para "¶" part "∂" permil "‰" perp "⊥" Phi "Φ" phi "φ" + Pi "Π" pi "π" piv "ϖ" plusmn "±" pound "£" Prime "″" prime "′" + prod "∏" prop "∝" Psi "Ψ" psi "ψ" quot "\"" radic "√" rang "〉" + raquo "»" rarr "→" rArr "⇒" rceil "⌉" rdquo "”" real "ℜ" reg "®" + rfloor "⌋" Rho "Ρ" rho "ρ" rlm "" rsaquo "›" rsquo "’" sbquo "‚" + scaron "š" Scaron "Š" sdot "⋅" sect "§" shy "" Sigma "Σ" sigma "σ" + sigmaf "ς" sim "∼" spades "♠" sub "⊂" sube "⊆" sum "∑" sup "⊃" + sup1 "¹" sup2 "²" sup3 "³" supe "⊇" szlig "ß" Tau "Τ" tau "τ" + there4 "∴" Theta "Θ" theta "θ" thetasym "ϑ" thinsp " " thorn "þ" THORN "Þ" + tilde "˜" times "×" trade "™" uacute "ú" Uacute "Ú" uarr "↑" uArr "⇑" + ucirc "û" Ucirc "Û" ugrave "ù" Ugrave "Ù" uml "¨" upsih "ϒ" Upsilon "Υ" + upsilon "υ" uuml "ü" Uuml "Ü" weierp "℘" Xi "Ξ" xi "ξ" yacute "ý" + Yacute "Ý" yen "¥" yuml "ÿ" Yuml "Ÿ" Zeta "Ζ" zeta "ζ" zwj "" zwnj "") + "Plist of html entities to replace when displaying question titles and other text." + :type '(repeat (choice symbol string)) + :group 'sx) + +(defun sx-encoding-decode-entities (string) + (let* ((plist sx-encoding-html-entities-plist) + (get-function (lambda (s) (let ((ss (substring s 1 -1))) + ;; Handle things like " + (or (plist-get plist (intern ss)) + ;; Handle things like ' + (format "%c" (string-to-number + (substring ss 1)))))))) + (replace-regexp-in-string "&[^; ]*;" get-function string))) + +(provide 'sx-encoding) +;;; sx-encoding.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-filter.el b/sx-filter.el index 6b56001..7178259 100644 --- a/sx-filter.el +++ b/sx-filter.el @@ -1,4 +1,4 @@ -;;; stack-filter.el --- filters for stack-mode -*- lexical-binding: t; -*- +;;; sx-filter.el --- filters -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -19,49 +19,45 @@ ;;; Commentary: -;; +;; ;;; Code: ;;; Dependencies -(require 'stack-core) +(require 'sx) +(require 'sx-cache) ;;; Customizations -(defconst stack-filter-cache-file +(defconst sx-filter-cache-file "filters.el") -(defvar stack-filter +(defvar sx-filter 'default "The current filter. -To customize the filter for the next call -to `stack-core-make-request', let-bind this variable to the -output of a call to `stack-core-compile-filter'. Be careful! If -you're going to be using this new filter a lot, create a variable -for it. Creation requests count against -`stack-core-remaining-api-requests'!") +To customize the filter for the next call to `sx-request-make', +let-bind this variable to the output of a call to +`sx-filter-compile'. Be careful! If you're going to be using +this new filter a lot, create a variable for it. Creation +requests count against `sx-request-remaining-api-requests'!") ;;; Compilation ;;; TODO allow BASE to be a precompiled filter name -(defun stack-filter-compile (&optional include exclude base) +(defun sx-filter-compile (&optional include exclude base) "Compile INCLUDE and EXCLUDE into a filter derived from BASE. INCLUDE and EXCLUDE must both be lists; BASE should be a symbol or string." (let ((keyword-arguments - `((include . ,(if include (mapconcat - #'stack-core-thing-as-string - include ";"))) - (exclude . ,(if exclude (mapconcat - #'stack-core-thing-as-string - exclude ";"))) + `((include . ,(if include (sx--thing-as-string include))) + (exclude . ,(if exclude (sx--thing-as-string exclude))) (base . ,(if base base))))) - (let ((response (stack-core-make-request + (let ((response (sx-request-make "filter/create" keyword-arguments))) (url-hexify-string @@ -71,15 +67,15 @@ or string." ;;; Storage and Retrieval -(defun stack-filter-get (filter) - "Retrieve named FILTER from `stack-filter-cache-file'." - (cdr (assoc filter (stack-cache-get stack-filter-cache-file)))) +(defun sx-filter-get (filter) + "Retrieve named FILTER from `sx-filter-cache-file'." + (cdr (assoc filter (sx-cache-get sx-filter-cache-file)))) -(defun stack-filter-store (name &optional filter) - "Store NAME as FILTER in `stack-filter-cache-file'. +(defun sx-filter-store (name &optional filter) + "Store NAME as FILTER in `sx-filter-cache-file'. NAME should be a symbol and FILTER is a string as compiled by -`stack-filter-compile'. +`sx-filter-compile'. If NAME is a cons cell, (car NAME) is taken to be the actual NAME and (cdr NAME) is taken to be the actual FILTER. In this case, @@ -88,15 +84,19 @@ the second argument is simply ignored." (filter (if (consp name) (cdr name) filter))) (unless (symbolp name) (error "Name must be a symbol: %S" name)) - (let* ((dict (stack-cache-get stack-filter-cache-file)) + (let* ((dict (sx-cache-get sx-filter-cache-file)) (entry (assoc name dict))) (if entry (setcdr entry filter) (setq dict (cons (cons name filter) dict))) - (stack-cache-set stack-filter-cache-file dict)))) + (sx-cache-set sx-filter-cache-file dict)))) -(defun stack-filter-store-all (name-filter-alist) - (mapc #'stack-filter-store name-filter-alist)) +(defun sx-filter-store-all (name-filter-alist) + (mapc #'sx-filter-store name-filter-alist)) -(provide 'stack-filter) -;;; stack-filter.el ends here +(provide 'sx-filter) +;;; sx-filter.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: @@ -1,4 +1,4 @@ -;;; stack-core.el --- lisp-to-org conversion functions for stack-mode -*- lexical-binding: t; -*- +;;; sx-lto.el --- lisp-to-org conversion functions -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -23,47 +23,46 @@ ;;; Requirements -(require 'stack-core) -(require 'json) +(require 'sx) (require 'org) -(defun stack-lto--question (data) +(defun sx-lto--question (data) "Return question DATA in a format acceptable by `org-element-interpret-data'. DATA is a list of cons cells representing a question, as received by the API and read by `json-read'." `(headline (:title ,(cdr (assoc 'title data)) :level 1 :tags ,(mapcar #'identity (cdr (assoc 'tags data)))) - ,(stack-lto--question-answer data) - ,@(mapcar #'stack-lto--answer (cdr (assoc 'answers data))))) + ,(sx-lto--question-answer data) + ,@(mapcar #'sx-lto--answer (cdr (assoc 'answers data))))) -(defun stack-lto--answer (data) +(defun sx-lto--answer (data) "Return answer DATA in a format acceptable by `org-element-interpret-data'. DATA is a list of cons cells representing a question, as received by the API and read by `json-read'." ;; Right now this doesn't do anything special. But it should check ;; whether the answer is accepted. How do we display that? `(headline (:title "Answer" :level 2) - ,(stack-lto--question-answer data))) + ,(sx-lto--question-answer data))) -(defun stack-lto--question-answer (data) +(defun sx-lto--question-answer (data) "Process and return the elements of DATA which questions and answers have in common." (let ((comments - (mapcar #'stack-lto--comment (cdr (assoc 'comments data))))) + (mapcar #'sx-lto--comment (cdr (assoc 'comments data))))) `(;; Body as a src block (really NOT nice). - (src-block (:value ,(stack-lto--body data) - . ,stack-lto--body-src-block)) + (src-block (:value ,(sx-lto--body data) + . ,sx-lto--body-src-block)) ;; Comments as descriptive lists. If there are no comments, an ;; empty list would throw an error. ,@(when comments `((plain-list (:type descriptive) ,comments)))))) ;;; Body rendering -(defvar stack-lto--body-src-block +(defvar sx-lto--body-src-block '(:language "markdown" :switches nil :parameters nil :hiddenp nil) "Properties used on the markdown src-block which represents the body.") -(defface stack-lto-body +(defface sx-lto-body '((((background light)) :background "Grey90") (((background dark)) :background "Grey10")) "Face used on the body content of questions and answers." @@ -71,12 +70,12 @@ by the API and read by `json-read'." ;;; This is not used ATM since we got rid of HTML. But it can be used ;;; once we start extending markdown mode. -(defcustom stack-lto-bullet (if (char-displayable-p ?•) " •" " -") +(defcustom sx-lto-bullet (if (char-displayable-p ?•) " •" " -") "Bullet used on the display of lists." :type 'string :group 'stack-mode) -(defun stack-lto--body (data) +(defun sx-lto--body (data) "Get and cleanup `body_markdown' from DATA." (concat (replace-regexp-in-string @@ -85,20 +84,20 @@ by the API and read by `json-read'." ;; We need to add padding in case the body contains a * at column 1 ;; (which would break org-mode). -(defvar stack-lto--padding +(defvar sx-lto--padding (propertize " " 'display " ") "Left-padding added to each line of a body.") -(defvar stack-lto-comment-item +(defvar sx-lto-comment-item '(:bullet "- " :checkbox nil :counter nil :hiddenp nil) "Properties used on the items which represent comments.") -(defun stack-lto--comment (data) +(defun sx-lto--comment (data) "" (let* ((owner (cdr (assoc 'owner data))) (owner-name (cdr (assoc 'display_name owner)))) - `(item (:tag ,owner-name . ,stack-lto-comment-item) + `(item (:tag ,owner-name . ,sx-lto-comment-item) (paragraph () ,(cdr (assoc 'body_markdown data)))))) -(provide 'stack-lto) -;;; stack-core.el ends here +(provide 'sx-lto) +;;; sx.el ends here diff --git a/sx-network.el b/sx-network.el index 1d3af0a..dcd2349 100644 --- a/sx-network.el +++ b/sx-network.el @@ -1,4 +1,4 @@ -;;; stack-network.el --- network functions for stack-mode -*- lexical-binding: t; -*- +;;; sx-network.el --- browsing networks -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -19,14 +19,18 @@ ;;; Commentary: -;; +;; ;;; Code: -(require 'stack-core) +(require 'sx-request) -(defun stack-network-get-networks () - (stack-core-make-request "sites")) +(defun sx-network-get-networks () + (sx-request-make "sites")) -(provide 'stack-network) +(provide 'sx-network) ;;; stack-network.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-question-list.el b/sx-question-list.el index 81d7cd5..59acbeb 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -1,4 +1,4 @@ -;;; stack-question-list.el --- Major-mode for navigating questions list. -*- lexical-binding: t; -*- +;;; sx-question-list.el --- Major-mode for navigating questions list. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -20,235 +20,236 @@ ;;; Commentary: ;;; Code: -(require 'stack-question) +(require 'sx-question) +(require 'sx-time) (require 'tabulated-list) (require 'cl-lib) ;;; Customization -(defcustom stack-question-list-height 12 +(defcustom sx-question-list-height 12 "Height, in lines, of stack-mode's *question-list* buffer." :type 'integer - :group 'stack-question-list) + :group 'sx-question-list) -(defface stack-question-list-parent +(defface sx-question-list-parent '((t :inherit default)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-answers +(defface sx-question-list-answers '((((background light)) :foreground "SeaGreen4" - :height 1.0 :inherit stack-question-list-parent) + :height 1.0 :inherit sx-question-list-parent) (((background dark)) :foreground "#D1FA71" - :height 1.0 :inherit stack-question-list-parent) - (t :inherit stack-question-list-parent)) + :height 1.0 :inherit sx-question-list-parent) + (t :inherit sx-question-list-parent)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-answers-accepted +(defface sx-question-list-answers-accepted '((((background light)) :background "YellowGreen" - :inherit stack-question-list-answers) + :inherit sx-question-list-answers) (((background dark)) :background "DarkOliveGreen" - :inherit stack-question-list-answers) - (t :inherit stack-question-list-answers)) + :inherit sx-question-list-answers) + (t :inherit sx-question-list-answers)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-score - '((t :height 1.0 :inherit stack-question-list-parent)) +(defface sx-question-list-score + '((t :height 1.0 :inherit sx-question-list-parent)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-score-upvoted +(defface sx-question-list-score-upvoted '((t :weight bold - :inherit stack-question-list-score)) + :inherit sx-question-list-score)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-tags +(defface sx-question-list-tags '((t :inherit font-lock-function-name-face)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-date +(defface sx-question-list-date '((t :inherit font-lock-comment-face)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-read-question - '((t :height 1.0 :inherit stack-question-list-parent)) +(defface sx-question-list-read-question + '((t :height 1.0 :inherit sx-question-list-parent)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-unread-question - '((t :weight bold :inherit stack-question-list-read-question)) +(defface sx-question-list-unread-question + '((t :weight bold :inherit sx-question-list-read-question)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) ;;; Mode Definition -(define-derived-mode stack-question-list-mode tabulated-list-mode "Question List" - "Major mode for browsing a list of questions from stack-exchange. +(define-derived-mode sx-question-list-mode tabulated-list-mode "Question List" + "Major mode for browsing a list of questions from StackExchange. Letters do not insert themselves; instead, they are commands. -\\<stack-question-list> -\\{stack-question-list}" +\\<sx-question-list> +\\{sx-question-list}" (hl-line-mode 1) - (stack-question-list--update-mode-line) + (sx-question-list--update-mode-line) (setq tabulated-list-format [(" V" 3 t :right-align t) (" A" 3 t :right-align t) - ("Title" 0 stack-question-list--date-more-recent-p)]) + ("Title" 0 sx-question-list--date-more-recent-p)]) (setq tabulated-list-padding 1) ;; Sorting by title actually sorts by date. It's what we want, but ;; it's not terribly intuitive. (setq tabulated-list-sort-key '("Title" . nil)) (add-hook 'tabulated-list-revert-hook - #'stack-question-list-refresh nil t) + #'sx-question-list-refresh nil t) (add-hook 'tabulated-list-revert-hook - #'stack-question-list--update-mode-line nil t) + #'sx-question-list--update-mode-line nil t) (tabulated-list-init-header)) -(defcustom stack-question-list-date-sort-method 'last_activity_date +(defcustom sx-question-list-date-sort-method 'last_activity_date "Parameter which controls date sorting." ;; This should be made into a (choice ...) of constants. :type 'symbol ;; Add a setter to protect the value. - :group 'stack-question-list) + :group 'sx-question-list) -(defun stack-question-list--date-more-recent-p (x y) +(defun sx-question-list--date-more-recent-p (x y) "Non-nil if tabulated-entry X is newer than Y." - (stack-question--< - stack-question-list-date-sort-method + (sx-question--< + sx-question-list-date-sort-method (car x) (car y) #'>)) (mapc - (lambda (x) (define-key stack-question-list-mode-map + (lambda (x) (define-key sx-question-list-mode-map (car x) (cadr x))) - '(("n" stack-question-list-next) - ("p" stack-question-list-previous) - ("j" stack-question-list-view-next) - ("k" stack-question-list-view-previous) - ("g" stack-question-list-refresh) - ([?\r] stack-question-list-display-question))) - -(defvar stack-question-list--current-page "Latest" + '(("n" sx-question-list-next) + ("p" sx-question-list-previous) + ("j" sx-question-list-view-next) + ("k" sx-question-list-view-previous) + ("g" sx-question-list-refresh) + ([?\r] sx-question-list-display-question))) + +(defvar sx-question-list--current-page "Latest" ;; Other values (once we implement them) are "Top Voted", ;; "Unanswered", etc. "Variable describing current page being viewed.") -(defvar stack-question-list--unread-count 0 +(defvar sx-question-list--unread-count 0 "Holds the number of unread questions in the current buffer.") -(make-variable-buffer-local 'stack-question-list--unread-count) +(make-variable-buffer-local 'sx-question-list--unread-count) -(defvar stack-question-list--total-count 0 +(defvar sx-question-list--total-count 0 "Holds the total number of questions in the current buffer.") -(make-variable-buffer-local 'stack-question-list--total-count) +(make-variable-buffer-local 'sx-question-list--total-count) -(defconst stack-question-list--mode-line-format +(defconst sx-question-list--mode-line-format '(" " mode-name " " - (:propertize stack-question-list--current-page + (:propertize sx-question-list--current-page face mode-line-buffer-id) " [" "Unread: " (:propertize - (:eval (int-to-string stack-question-list--unread-count)) + (:eval (int-to-string sx-question-list--unread-count)) face mode-line-buffer-id) ", " "Total: " (:propertize - (:eval (int-to-string stack-question-list--total-count)) + (:eval (int-to-string sx-question-list--total-count)) face mode-line-buffer-id) "] ") "Mode-line construct to use in question-list buffers.") -(defun stack-question-list--update-mode-line () +(defun sx-question-list--update-mode-line () "Fill the mode-line with useful information." ;; All the data we need is right in the buffer. - (when (derived-mode-p 'stack-question-list-mode) + (when (derived-mode-p 'sx-question-list-mode) (setq mode-line-format - stack-question-list--mode-line-format) - (setq stack-question-list--total-count + sx-question-list--mode-line-format) + (setq sx-question-list--total-count (length tabulated-list-entries)))) -(defvar stack-question-list--current-site "emacs" +(defvar sx-question-list--current-site "emacs" "Site being displayed in the *question-list* buffer.") -(defun stack-question-list-refresh (&optional redisplay no-update) +(defun sx-question-list-refresh (&optional redisplay no-update) "Update the list of questions. If REDISPLAY is non-nil, also call `tabulated-list-print'. -If the prefix argument NO-UPDATE is nil, query stack-exchange for +If the prefix argument NO-UPDATE is nil, query StackExchange for a new list before redisplaying." (interactive "pP") ;; Reset the mode-line unread count (we rebuild it here). - (setq stack-question-list--unread-count 0) - (let ((question-list (stack-question-get-questions - stack-question-list--current-site))) + (setq sx-question-list--unread-count 0) + (let ((question-list (sx-question-get-questions + sx-question-list--current-site))) ;; Print the result. (setq tabulated-list-entries - (mapcar #'stack-question-list--print-info question-list))) + (mapcar #'sx-question-list--print-info question-list))) (when redisplay (tabulated-list-print 'remember))) -(defcustom stack-question-list-ago-string " ago" +(defcustom sx-question-list-ago-string " ago" "String appended to descriptions of the time since something happened. Used in the questions list to indicate a question was updated \"4d ago\"." :type 'string - :group 'stack-question-list) + :group 'sx-question-list) -(defun stack-question-list--print-info (data) +(defun sx-question-list--print-info (data) "Convert `json-read' DATA into tabulated-list format." (list data (vector (list (int-to-string (cdr (assoc 'score data))) 'face - (if (cdr (assoc 'upvoted data)) 'stack-question-list-score-upvoted - 'stack-question-list-score)) + (if (cdr (assoc 'upvoted data)) 'sx-question-list-score-upvoted + 'sx-question-list-score)) (list (int-to-string (cdr (assoc 'answer_count data))) 'face - (if (stack-question--accepted-answer data) - 'stack-question-list-answers-accepted - 'stack-question-list-answers)) + (if (sx-question--accepted-answer data) + 'sx-question-list-answers-accepted + 'sx-question-list-answers)) (concat (propertize (cdr (assoc 'title data)) 'face - (if (stack-question--read-p data) - 'stack-question-list-read-question - ;; Increment `stack-question-list--unread-count' for the mode-line. - (cl-incf stack-question-list--unread-count) - 'stack-question-list-unread-question)) + (if (sx-question--read-p data) + 'sx-question-list-read-question + ;; Increment `sx-question-list--unread-count' for the mode-line. + (cl-incf sx-question-list--unread-count) + 'sx-question-list-unread-question)) (propertize " " 'display "\n ") - (propertize (concat (stack--time-since (cdr (assoc 'last_activity_date data))) - stack-question-list-ago-string) - 'face 'stack-question-list-date) + (propertize (concat (sx-time-since (cdr (assoc 'last_activity_date data))) + sx-question-list-ago-string) + 'face 'sx-question-list-date) (propertize (concat " [" (mapconcat #'identity (cdr (assoc 'tags data)) "] [") "]") - 'face 'stack-question-list-tags) + 'face 'sx-question-list-tags) (propertize " " 'display "\n"))))) -(defun stack-question-list-view-previous (n) +(defun sx-question-list-view-previous (n) "Hide this question, move to previous one, display it." (interactive "p") - (stack-question-list-view-next (- n))) + (sx-question-list-view-next (- n))) -(defun stack-question-list-view-next (n) +(defun sx-question-list-view-next (n) "Hide this question, move to next one, display it." (interactive "p") - (stack-question-list-next n) - (stack-question-list-display-question)) + (sx-question-list-next n) + (sx-question-list-display-question)) -(defun stack-question-list-next (n) +(defun sx-question-list-next (n) "Move to the next entry." (interactive "p") (forward-line n)) -(defun stack-question-list-previous (n) +(defun sx-question-list-previous (n) "Move to the previous entry." (interactive "p") - (stack-question-list-next (- n))) + (sx-question-list-next (- n))) -(defun stack-question-list-display-question (&optional data focus) +(defun sx-question-list-display-question (&optional data focus) "Display question given by DATA. If called interactively (or with DATA being nil), display question under point. @@ -257,13 +258,13 @@ focus the relevant window." (interactive '(nil t)) (unless data (setq data (tabulated-list-get-id))) (unless data (error "No question here!")) - (when (stack-question--read-p data) - (cl-decf stack-question-list--unread-count) - (stack-question--mark-read data)) - (unless (window-live-p stack-question--window) - (setq stack-question--window + (when (sx-question--read-p data) + (cl-decf sx-question-list--unread-count) + (sx-question--mark-read data)) + (unless (window-live-p sx-question--window) + (setq sx-question--window (condition-case er - (split-window-below stack-question-list-height) + (split-window-below sx-question-list-height) (error ;; If the window is too small to split, use current one. (if (string-match @@ -271,27 +272,27 @@ focus the relevant window." (car (cdr-safe er))) nil (error (cdr er))))))) - (stack-question--display data stack-question--window) + (sx-question--display data sx-question--window) (when focus - (if stack-question--window - (select-window stack-question--window) - (switch-to-buffer stack-question--buffer)))) + (if sx-question--window + (select-window sx-question--window) + (switch-to-buffer sx-question--buffer)))) -(defvar stack-question-list--buffer nil +(defvar sx-question-list--buffer nil "Buffer where the list of questions is displayed.") (defun list-questions (no-update) - "Display a list of stack-exchange questions." + "Display a list of StackExchange questions." (interactive "P") - (unless (buffer-live-p stack-question-list--buffer) - (setq stack-question-list--buffer + (unless (buffer-live-p sx-question-list--buffer) + (setq sx-question-list--buffer (generate-new-buffer "*question-list*"))) - (with-current-buffer stack-question-list--buffer - (stack-question-list-mode) - (stack-question-list-refresh 'redisplay no-update)) - (switch-to-buffer stack-question-list--buffer)) + (with-current-buffer sx-question-list--buffer + (sx-question-list-mode) + (sx-question-list-refresh 'redisplay no-update)) + (switch-to-buffer sx-question-list--buffer)) -(defalias 'stack-list-questions #'list-questions) +(defalias 'sx-list-questions #'list-questions) -(provide 'stack-question-list) -;;; stack-question-list.el ends here +(provide 'sx-question-list) +;;; sx-question-list.el ends here diff --git a/sx-question.el b/sx-question.el index 80d772f..8a39493 100644 --- a/sx-question.el +++ b/sx-question.el @@ -1,4 +1,4 @@ -;;; stack-question.el --- question logic for stack-mode -*- lexical-binding: t; -*- +;;; sx-question.el --- question logic for stack-mode -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -19,49 +19,49 @@ ;;; Commentary: -;; +;; ;;; Code: -(require 'stack-core) -(require 'stack-filter) -(require 'stack-lto) +(require 'sx) +(require 'sx-filter) +(require 'sx-lto) ;; I don't know why this is here, but it was causing an API request on require. -(defvar stack-question-browse-filter nil +(defvar sx-question-browse-filter nil ;; (stack-filter-compile ;; nil ;; '(user.profile_image shallow_user.profile_image)) ) -;; (stack-filter-store 'question-browse stack-question-browse-filter) +;; (stack-filter-store 'question-browse sx-question-browse-filter) -(defun stack-question-get-questions (site &optional page) +(defun sx-question-get-questions (site &optional page) "Get the page PAGE of questions from SITE." - (stack-core-make-request + (sx-request-make "questions" `((site . ,site) (page . ,page)) - stack-question-browse-filter)) + sx-question-browse-filter)) ;;; Question Properties -(defun stack-question--read-p (question) +(defun sx-question--read-p (question) "Non-nil if QUESTION has been read since last updated." ;; @TODO: (cl-evenp (random))) -(defun stack-question--accepted-answer (question) +(defun sx-question--accepted-answer (question) "Return accepted answer in QUESTION, or nil if none." ;; @TODO: (cl-evenp (random))) -(defun stack-question--mark-read (question) +(defun sx-question--mark-read (question) "Mark QUESTION as being read, until it is updated again." nil) -(defun stack-question--< (property x y &optional pred) +(defun sx-question--< (property x y &optional pred) "Non-nil if PROPERTY attribute of question X is less than that of Y. With optional argument predicate, use it instead of `<'." (funcall (or pred #'<) @@ -69,52 +69,56 @@ With optional argument predicate, use it instead of `<'." (cdr (assoc property y)))) ;;; Displaying a question -(defvar stack-question--window nil +(defvar sx-question--window nil "Window where the content of questions is displayed.") -(defvar stack-question--buffer nil +(defvar sx-question--buffer nil "Buffer being used to display questions.") -(defcustom stack-question-use-html t +(defcustom sx-question-use-html t "If nil, markdown is used for the body." :type 'boolean - :group 'stack-question) + :group 'sx-question) -(defun stack-question--display (data &optional window) +(defun sx-question--display (data &optional window) "Display question given by DATA on WINDOW. If WINDOW is nil, use selected one." - (let ((stack-lto--body-src-block - (if stack-question-use-html nil - stack-lto--body-src-block)) + (let ((sx-lto--body-src-block + (if sx-question-use-html nil + sx-lto--body-src-block)) (inhibit-read-only t)) (with-current-buffer - (stack-question--display-buffer window) + (sx-question--display-buffer window) (erase-buffer) (insert (org-element-interpret-data - (stack-lto--question data))) + (sx-lto--question data))) (org-mode) (show-all) (view-mode) (current-buffer)))) -(defun stack-question--display-buffer (window) +(defun sx-question--display-buffer (window) "Display and return the buffer used for displaying a question. Create the buffer if necessary. If WINDOW is given, use that to display the buffer." ;; Create the buffer if necessary. - (unless (buffer-live-p stack-question--buffer) - (setq stack-question--buffer - (generate-new-buffer "*stack-question*"))) + (unless (buffer-live-p sx-question--buffer) + (setq sx-question--buffer + (generate-new-buffer "*sx-question*"))) (cond ;; Window was given, use it. ((window-live-p window) - (set-window-buffer window stack-question--buffer)) + (set-window-buffer window sx-question--buffer)) ;; No window, but the buffer is already being displayed somewhere. - ((get-buffer-window stack-question--buffer 'visible)) + ((get-buffer-window sx-question--buffer 'visible)) ;; Neither, so we create the window. - (t (switch-to-buffer stack-question--buffer))) - stack-question--buffer) + (t (switch-to-buffer sx-question--buffer))) + sx-question--buffer) -(provide 'stack-question) -;;; stack-question.el ends here +(provide 'sx-question) +;;; sx-question.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-request.el b/sx-request.el new file mode 100644 index 0000000..a62ee0e --- /dev/null +++ b/sx-request.el @@ -0,0 +1,194 @@ +;;; sx-request.el --- requests for stack-mode + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred <sallred@calamity.tcs.com> +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: +(require 'json) +(require 'url) +(require 'sx) + +(defcustom sx-request-silent-p + t + "When `t', requests default to being silent.") + +(defcustom sx-request-cache-p + t + "Cache requests made to the StackExchange API.") + +(defcustom sx-request-unzip-program + "gunzip" + "program used to unzip the response") + +(defvar sx-request-remaining-api-requests + nil + "The number of API requests remaining according to the most +recent call. Set by `sx-request-make'.") + +(defcustom sx-request-remaining-api-requests-message-threshold + 50 + "After `sx-request-remaining-api-requests' drops below this +number, `sx-request-make' will begin printing out the +number of requests left every time it finishes a call.") + +(defcustom sx-request-default-keyword-arguments-alist + '(("filters/create") + ("sites") + ("questions" (site . emacs)) + (t nil)) + "Keywords to use as the default for a given method. + +The first element of each list is the method call the keywords +apply to. The remaining cons cells (and they must be conses) are +the values for each keyword. + +For each list, if no keywords are provided, the method's +arguments are forced to the default as determined by the API. + +For each cons cell, if the cdr is `nil', then the keyword will be +forced to the default as determined by the API. + +See `sx-request-get-default-keyword-arguments' and +`sx-request-build-keyword-arguments'. +") + +(defconst sx-request-api-version + "2.2" + "The current version of the API.") + +(defconst sx-request-api-root + (format "http://api.stackexchange.com/%s/" sx-request-api-version) + "The base URL to make requests from.") + +(defconst sx-request-api-key + "0TE6s1tveCpP9K5r5JNDNQ((" + "When passed, this key provides a higher request quota.") + +(defun sx-request-make + (method &optional keyword-arguments filter silent) + "Make a request to the StackExchange API using METHOD and +optional KEYWORD-ARGUMENTS. If no KEYWORD-ARGUMENTS are given, +`sx-default-keyword-arguments-alist' is used. Return the +entire response as a complex alist." + (let ((url-automatic-caching sx-request-cache-p) + (url-inhibit-uncompression t) + (silent (or silent sx-request-silent-p)) + (call + (sx-request--build + method + (append `((filter . ,(cond (filter filter) + ((boundp 'stack-filter) stack-filter))) + (key . ,sx-request-api-key)) + (if keyword-arguments keyword-arguments + (sx-request--get-default-keyword-arguments method)))))) + ;; TODO: url-retrieve-synchronously can return nil if the call is + ;; unsuccessful should handle this case + (unless silent (sx-message "Request: %S" call)) + (let ((response-buffer (cond + ((= emacs-minor-version 4) + (url-retrieve-synchronously call silent)) + (t (url-retrieve-synchronously call))))) + (if (not response-buffer) + (error "Something went wrong in `url-retrieve-synchronously'") + (with-current-buffer response-buffer + (let* ((data (progn + (goto-char (point-min)) + (if (not (search-forward "\n\n" nil t)) + (error "Response headers missing") + (delete-region (point-min) (point)) + (buffer-string)))) + (response (ignore-errors + (json-read-from-string data)))) + ;; if response isn't nil, the response was in plain text + (unless response + ;; try to decompress the response + (setq response + (with-demoted-errors "JSON Error: %s" + (shell-command-on-region + (point-min) (point-max) + sx-request-unzip-program + nil t) + (json-read-from-string + (buffer-substring + (point-min) (point-max))))) + ;; If it still fails, error out + (unless response + (sx-message "Unable to parse response") + (sx-message "Printing response as message") + (message "%S" response) + (error "Response could not be read by json-read-string"))) + ;; At this point, either response is a valid data structure + ;; or we have already thrown an error + (when (assoc 'error_id response) + (error "Request failed: (%s) [%i %s] %s" + method + (cdr (assoc 'error_id response)) + (cdr (assoc 'error_name response)) + (cdr (assoc 'error_message response)))) + (when (< (setq sx-request-remaining-api-requests + (cdr (assoc 'quota_remaining response))) + sx-request-remaining-api-requests-message-threshold) + (sx-message "%d API requests remaining" + sx-request-remaining-api-requests)) + (cdr (assoc 'items response)))))))) + +(defun sx-request--build (method keyword-arguments &optional kv-value-sep) + "Build the request string that will be used to process REQUEST +with the given KEYWORD-ARGUMENTS." + (let ((base (concat sx-request-api-root method)) + (args (sx-request--build-keyword-arguments + keyword-arguments kv-value-sep))) + (if (string-equal "" args) + base + (concat base "?" args)))) + +(defun sx-request--build-keyword-arguments (alist &optional kv-value-sep) + "Build a \"key=value&key=value&...\"-style string with the elements +of ALIST. If any value in the alist is `nil', that pair will not +be included in the return. If you wish to pass a notion of +false, use the symbol `false'. Each element is processed with +`sx--thing-as-string'." + (mapconcat + (lambda (pair) + (concat + (sx--thing-as-string (car pair)) + "=" + (sx--thing-as-string (cdr pair) kv-value-sep))) + (delq nil (mapcar + (lambda (pair) + (when (cdr pair) pair)) + alist)) + "&")) + +(defun sx-request--get-default-keyword-arguments (method) + "Gets the correct keyword arguments for METHOD." + (let ((entry (assoc method sx-request-default-keyword-arguments-alist))) + (cdr (or entry (assoc t sx-request-default-keyword-arguments-alist))))) + +;;; @todo sx-request-change-default-keyword-arguments +;;; (method new-keyword-arguments) +;;; @todo sx-request-change-default-keyword-arguments-for-key +;;; (method key new-value) + + +(provide 'sx-request) +;;; sx-request.el ends here diff --git a/sx-time.el b/sx-time.el new file mode 100644 index 0000000..1cea76f --- /dev/null +++ b/sx-time.el @@ -0,0 +1,54 @@ +;;; sx-time.el --- time for stack-mode + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred <sallred@calamity.tcs.com> +;; Keywords: help + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'time-date) + +(defvar sx-time-seconds-to-string + ;; (LIMIT NAME VALUE) + ;; We use an entry if the number of seconds in question is less than + ;; LIMIT, but more than the previous entry's LIMIT. + '((100 "s" 1) + (6000 "m" 60.0) + (108000 "h" 3600.0) + (34560000 "d" 86400.0) + (nil "y" 31557600.0)) + "Auxiliary variable used by `sx-time-since'.") + +(defun sx-time-since (time) + "Convert the time interval since TIME (in seconds) to a short string." + (let ((delay (- (time-to-seconds) time))) + (concat + (if (> 0 delay) "-" "") + (if (= 0 delay) "0s" + (setq delay (abs delay)) + (let ((sts sx-time-seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.0f" (/ delay (car (cddr here)))) + (cadr here))))))) + +(provide 'sx-time) +;;; sx-time.el ends here @@ -1,4 +1,4 @@ -;;; stack-core.el --- core functions for stack-mode -*- lexical-binding: t; -*- +;;; sx.el --- core functions -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -20,99 +20,17 @@ ;;; Commentary: ;; This file defines basic commands used by all other parts of -;; StackMode. Currently, there are sections that are pretty wildly -;; different from each other (e.g. `Filters' and `Questions'. These -;; will eventually be migrated to their own files with related functions -;; of their ilk -- for now, it is more convenient to keep them handy. +;; StackMode. ;;; Code: ;;; Requirements -(require 'json) -(require 'url) -(require 'time-date) - - -;;; Package Logging - -(defun stack-message (format-string &rest args) +(defun sx-message (format-string &rest args) "Display a message" (message "[stack] %s" (apply #'format format-string args))) - -;;; Constants and Customizable Options - -(defcustom stack-cache-directory - (expand-file-name ".stackmode" user-emacs-directory) - "Directory containined cached files and precompiled filters.") - -(defconst stack-core-api-version - "2.2" - "The current version of the API.") - -(defconst stack-core-api-root - (format "http://api.stackexchange.com/%s/" stack-core-api-version) - "The base URL to make requests from.") - -(defvar stack-core-api-batch-request-separator - ";" - "The separator character to use when making batch requests. - -Do not change this unless you know what you are doing!") - -(defconst stack-core-api-key - "0TE6s1tveCpP9K5r5JNDNQ((" - "When passed, this key provides a higher request quota.") - -(defcustom stack-core-default-keyword-arguments-alist - '(("filters/create") - ("sites") - ("questions" (site . emacs)) - (t nil)) - "Keywords to use as the default for a given method. - -The first element of each list is the method call the keywords -apply to. The remaining cons cells (and they must be conses) are -the values for each keyword. - -For each list, if no keywords are provided, the method's -arguments are forced to the default as determined by the API. - -For each cons cell, if the cdr is `nil', then the keyword will be -forced to the default as determined by the API. - -See `stack-core-get-default-keyword-arguments' and -`stack-core-build-keyword-arguments'. -") - -(defcustom stack-core-cache-requests - t - "Cache requests made to the StackExchange API.") - -(defcustom stack-core-unzip-program - "gunzip" - "program used to unzip the response") - -(defvar stack-core-remaining-api-requests - nil - "The number of API requests remaining according to the most -recent call. Set by `stack-core-make-request'.") - -(defcustom stack-core-remaining-api-requests-message-threshold - 50 - "After `stack-core-remaining-api-requests' drops below this -number, `stack-core-make-request' will begin printing out the -number of requests left every time it finishes a call.") - -(defcustom stack-core-silent-requests - t - "When `t', requests default to being silent.") - - -;;; Keyword Arguments - -(defun stack-core-thing-as-string (thing) +(defun sx--thing-as-string (thing &optional sequence-sep) "Return a string representation of THING. If THING is already a string, just return it." (cond @@ -120,248 +38,39 @@ a string, just return it." ((symbolp thing) (symbol-name thing)) ((numberp thing) (number-to-string thing)) ((sequencep thing) - (mapconcat #'stack-core-thing-as-string - thing stack-core-api-batch-request-separator)))) - -(defun stack-core-get-default-keyword-arguments (method) - "Gets the correct keyword arguments for METHOD." - (let ((entry (assoc method stack-core-default-keyword-arguments-alist))) - (cdr (or entry (assoc t stack-core-default-keyword-arguments-alist))))) - -;;; @todo stack-core-change-default-keyword-arguments -;;; (method new-keyword-arguments) -;;; @todo stack-core-change-default-keyword-arguments-for-key -;;; (method key new-value) - -(defun stack-core-build-keyword-arguments (alist) - "Build a \"key=value&key=value&...\"-style string with the elements -of ALIST. If any value in the alist is `nil', that pair will not -be included in the return. If you wish to pass a notion of -false, use the symbol `false'. Each element is processed with -`stack-core-thing-as-string'." - (mapconcat - (lambda (pair) - (concat - (stack-core-thing-as-string (car pair)) - "=" - (stack-core-thing-as-string (cdr pair)))) - (delq nil (mapcar - (lambda (pair) - (when (cdr pair) pair)) - alist)) - "&")) + (mapconcat #'sx--thing-as-string + thing (if sequence-sep sequence-sep ";"))))) - -;;; Making Requests of StackExchange - -(defun stack-core-build-request (method keyword-arguments) - "Build the request string that will be used to process REQUEST -with the given KEYWORD-ARGUMENTS." - (let ((base (concat stack-core-api-root method)) - (args (stack-core-build-keyword-arguments keyword-arguments))) - (if (string-equal "" args) - base - (concat base "?" args)))) - -(defun stack-core-make-request - (method &optional keyword-arguments filter silent) - "Make a request to the StackExchange API using METHOD and -optional KEYWORD-ARGUMENTS. If no KEYWORD-ARGUMENTS are given, -`stack-core-default-keyword-arguments-alist' is used. Return the -entire response as a complex alist." - (let ((url-automatic-caching stack-core-cache-requests) - (url-inhibit-uncompression t) - (silent (or silent stack-core-silent-requests)) - (call - (stack-core-build-request - method - (append `((filter . ,(cond (filter filter) - ((boundp 'stack-filter) stack-filter))) - (key . ,stack-core-api-key)) - (if keyword-arguments keyword-arguments - (stack-core-get-default-keyword-arguments method)))))) - ;; TODO: url-retrieve-synchronously can return nil if the call is - ;; unsuccessful should handle this case - (unless silent (stack-message "Request: %S" call)) - (let ((response-buffer (cond - ((= emacs-minor-version 4) - (url-retrieve-synchronously call silent)) - (t (url-retrieve-synchronously call))))) - (if (not response-buffer) - (error "Something went wrong in `url-retrieve-synchronously'") - (with-current-buffer response-buffer - (let* ((data (progn - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - (error "Response headers missing") - (delete-region (point-min) (point)) - (buffer-string)))) - (response (ignore-errors - (json-read-from-string data)))) - ;; if response isn't nil, the response was in plain text - (unless response - ;; try to decompress the response - (setq response - (with-demoted-errors "JSON Error: %s" - (shell-command-on-region - (point-min) (point-max) - stack-core-unzip-program - nil t) - (json-read-from-string - (buffer-substring - (point-min) (point-max))))) - ;; If it still fails, error out - (unless response - (stack-message "Unable to parse response") - (stack-message "Printing response as message") - (message "%S" response) - (error "Response could not be read by json-read-string"))) - ;; At this point, either response is a valid data structure - ;; or we have already thrown an error - (when (assoc 'error_id response) - (error "Request failed: (%s) [%i %s] %s" - method - (cdr (assoc 'error_id response)) - (cdr (assoc 'error_name response)) - (cdr (assoc 'error_message response)))) - (when (< (setq stack-core-remaining-api-requests - (cdr (assoc 'quota_remaining response))) - stack-core-remaining-api-requests-message-threshold) - (stack-message "%d API requests remaining" - stack-core-remaining-api-requests)) - (cdr (assoc 'items response)))))))) - -(defun stack-core-filter-data (data desired-tree) +(defun sx--filter-data (data desired-tree) "Filters DATA and returns the DESIRED-TREE" (if (vectorp data) - (apply #'vector - (mapcar (lambda (entry) - (stack-core-filter-data - entry desired-tree)) - data)) + (apply #'vector + (mapcar (lambda (entry) + (sx--filter-data + entry desired-tree)) + data)) (delq nil (mapcar (lambda (cons-cell) - ;; TODO the resolution of `f' is O(2n) in the worst - ;; case. It may be faster to implement the same - ;; functionality as a `while' loop to stop looking the - ;; list once it has found a match. Do speed tests. - ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. - (let ((f (or (memq (car cons-cell) desired-tree) - (assoc (car cons-cell) desired-tree)))) - (when f - (if (and (sequencep (cdr cons-cell)) - (sequencep (elt (cdr cons-cell) 0))) - (cons (car cons-cell) - (stack-core-filter-data - (cdr cons-cell) (cdr f))) - cons-cell)))) - data)))) - -(defun stack-cache-get-file-name (filename) - "Expands FILENAME in the context of `stack-cache-directory'." - (expand-file-name filename stack-cache-directory)) - -(defun stack-cache-get (cache) - "Return the data within CACHE. - -As with `stack-cache-set', CACHE is a file name within the -context of `stack-cache-directory'." - (unless (file-exists-p stack-cache-directory) - (mkdir stack-cache-directory)) - (let ((file (stack-cache-get-file-name cache))) - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents (stack-cache-get-file-name cache)) - (read (buffer-string)))))) - -(defun stack-cache-set (cache data) - "Set the content of CACHE to DATA. - -As with `stack-cache-get', CACHE is a file name within the -context of `stack-cache-directory'. - -DATA will be written as returned by `prin1'." - (unless (file-exists-p stack-cache-directory) - (mkdir stack-cache-directory)) - (write-region (prin1-to-string data) nil - (stack-cache-get-file-name cache)) - data) - -(defvar stack-core--seconds-to-string - ;; (LIMIT NAME VALUE) - ;; We use an entry if the number of seconds in question is less than - ;; LIMIT, but more than the previous entry's LIMIT. - '((100 "s" 1) - (6000 "m" 60.0) - (108000 "h" 3600.0) - (34560000 "d" 86400.0) - (nil "y" 31557600.0)) - "Auxiliary variable used by `stack--time-since'.") - -(defun stack--time-since (time) - "Convert the time interval since TIME (in seconds) to a short string." - (let ((delay (- (time-to-seconds) time))) - (concat - (if (> 0 delay) "-" "") - (if (= 0 delay) "0s" - (setq delay (abs delay)) - (let ((sts stack-core--seconds-to-string) here) - (while (and (car (setq here (pop sts))) - (<= (car here) delay))) - (concat (format "%.0f" (/ delay (car (cddr here)))) - (cadr here))))))) - -(defcustom stack-core-html-entities-plist - '(Aacute "Á" aacute "á" Acirc "Â" acirc "â" acute "´" AElig "Æ" aelig "æ" - Agrave "À" agrave "à" alefsym "ℵ" Alpha "Α" alpha "α" amp "&" and "∧" - ang "∠" apos "'" aring "å" Aring "Å" asymp "≈" atilde "ã" Atilde "Ã" - auml "ä" Auml "Ä" bdquo "„" Beta "Β" beta "β" brvbar "¦" bull "•" - cap "∩" ccedil "ç" Ccedil "Ç" cedil "¸" cent "¢" Chi "Χ" chi "χ" - circ "ˆ" clubs "♣" cong "≅" copy "©" crarr "↵" cup "∪" curren "¤" - Dagger "‡" dagger "†" darr "↓" dArr "⇓" deg "°" Delta "Δ" delta "δ" - diams "♦" divide "÷" eacute "é" Eacute "É" ecirc "ê" Ecirc "Ê" egrave "è" - Egrave "È" empty "∅" emsp " " ensp " " Epsilon "Ε" epsilon "ε" equiv "≡" - Eta "Η" eta "η" eth "ð" ETH "Ð" euml "ë" Euml "Ë" euro "€" - exist "∃" fnof "ƒ" forall "∀" frac12 "½" frac14 "¼" frac34 "¾" frasl "⁄" - Gamma "Γ" gamma "γ" ge "≥" gt ">" harr "↔" hArr "⇔" hearts "♥" - hellip "…" iacute "í" Iacute "Í" icirc "î" Icirc "Î" iexcl "¡" igrave "ì" - Igrave "Ì" image "ℑ" infin "∞" int "∫" Iota "Ι" iota "ι" iquest "¿" - isin "∈" iuml "ï" Iuml "Ï" Kappa "Κ" kappa "κ" Lambda "Λ" lambda "λ" - lang "〈" laquo "«" larr "←" lArr "⇐" lceil "⌈" ldquo "“" le "≤" - lfloor "⌊" lowast "∗" loz "◊" lrm "" lsaquo "‹" lsquo "‘" lt "<" - macr "¯" mdash "—" micro "µ" middot "·" minus "−" Mu "Μ" mu "μ" - nabla "∇" nbsp "" ndash "–" ne "≠" ni "∋" not "¬" notin "∉" - nsub "⊄" ntilde "ñ" Ntilde "Ñ" Nu "Ν" nu "ν" oacute "ó" Oacute "Ó" - ocirc "ô" Ocirc "Ô" OElig "Œ" oelig "œ" ograve "ò" Ograve "Ò" oline "‾" - omega "ω" Omega "Ω" Omicron "Ο" omicron "ο" oplus "⊕" or "∨" ordf "ª" - ordm "º" oslash "ø" Oslash "Ø" otilde "õ" Otilde "Õ" otimes "⊗" ouml "ö" - Ouml "Ö" para "¶" part "∂" permil "‰" perp "⊥" Phi "Φ" phi "φ" - Pi "Π" pi "π" piv "ϖ" plusmn "±" pound "£" Prime "″" prime "′" - prod "∏" prop "∝" Psi "Ψ" psi "ψ" quot "\"" radic "√" rang "〉" - raquo "»" rarr "→" rArr "⇒" rceil "⌉" rdquo "”" real "ℜ" reg "®" - rfloor "⌋" Rho "Ρ" rho "ρ" rlm "" rsaquo "›" rsquo "’" sbquo "‚" - scaron "š" Scaron "Š" sdot "⋅" sect "§" shy "" Sigma "Σ" sigma "σ" - sigmaf "ς" sim "∼" spades "♠" sub "⊂" sube "⊆" sum "∑" sup "⊃" - sup1 "¹" sup2 "²" sup3 "³" supe "⊇" szlig "ß" Tau "Τ" tau "τ" - there4 "∴" Theta "Θ" theta "θ" thetasym "ϑ" thinsp " " thorn "þ" THORN "Þ" - tilde "˜" times "×" trade "™" uacute "ú" Uacute "Ú" uarr "↑" uArr "⇑" - ucirc "û" Ucirc "Û" ugrave "ù" Ugrave "Ù" uml "¨" upsih "ϒ" Upsilon "Υ" - upsilon "υ" uuml "ü" Uuml "Ü" weierp "℘" Xi "Ξ" xi "ξ" yacute "ý" - Yacute "Ý" yen "¥" yuml "ÿ" Yuml "Ÿ" Zeta "Ζ" zeta "ζ" zwj "" zwnj "") - "Plist of html entities to replace when displaying question titles and other text." - :type '(repeat (choice symbol string)) - :group 'stack-core) - -(defun stack-core--decode-entities (string) - (let* ((plist stack-core-html-entities-plist) - (get-function (lambda (s) (let ((ss (substring s 1 -1))) - ;; Handle things like " - (or (plist-get plist (intern ss)) - ;; Handle things like ' - (format "%c" (string-to-int - (substring ss 1)))))))) - (replace-regexp-in-string "&[^; ]*;" get-function string))) - -(provide 'stack-core) -;;; stack-core.el ends here + ;; TODO the resolution of `f' is O(2n) in the worst + ;; case. It may be faster to implement the same + ;; functionality as a `while' loop to stop looking the + ;; list once it has found a match. Do speed tests. + ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. + (let ((f (or (memq (car cons-cell) desired-tree) + (assoc (car cons-cell) desired-tree)))) + (when f + (if (and (sequencep (cdr cons-cell)) + (sequencep (elt (cdr cons-cell) 0))) + (cons (car cons-cell) + (sx-filter-data + (cdr cons-cell) (cdr f))) + cons-cell)))) + data)))) + +(provide 'sx) +;;; sx.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: |