diff options
| -rw-r--r-- | sx-auth.el | 23 | ||||
| -rw-r--r-- | sx-cache.el | 9 | ||||
| -rw-r--r-- | sx-filter.el | 60 | ||||
| -rw-r--r-- | sx-lto.el | 4 | ||||
| -rw-r--r-- | sx-method.el | 47 | ||||
| -rw-r--r-- | sx-network.el | 2 | ||||
| -rw-r--r-- | sx-question-list.el | 6 | ||||
| -rw-r--r-- | sx-question.el | 14 | ||||
| -rw-r--r-- | sx-request.el | 184 | ||||
| -rw-r--r-- | sx.el | 76 | ||||
| -rw-r--r-- | test/tests.el | 52 |
11 files changed, 258 insertions, 219 deletions
@@ -50,25 +50,24 @@ questions)." (interactive) (setq 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))) - ","))) + (let ((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))) + "," sx-auth-root))) (browse-url url) (read-string "Enter the access token displayed on the webpage: "))) (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")) - (sx-cache-set "auth.el" `((access-token . ,sx-auth-access-token))))) + (sx-cache-set 'auth `((access-token . ,sx-auth-access-token))))) (provide 'sx-auth) -;;; stack-auth.el ends here +;;; sx-auth.el ends here ;; Local Variables: ;; indent-tabs-mode: nil diff --git a/sx-cache.el b/sx-cache.el index ed4895a..098c292 100644 --- a/sx-cache.el +++ b/sx-cache.el @@ -19,7 +19,12 @@ ;;; Commentary: +;; All caches are retrieved and set using symbols. The symbol should +;; be the sub-subpackage that is using the cache. For example, +;; `sx-pkg' would use `(sx-cache-get 'pkg)'. ;; +;; This symbol is then converted into a filename within +;; `sx-cache-directory'. ;;; Code: @@ -29,7 +34,9 @@ (defun sx-cache-get-file-name (filename) "Expands FILENAME in the context of `sx-cache-directory'." - (expand-file-name filename sx-cache-directory)) + (expand-file-name + (concat (symbol-name filename) ".el") + sx-cache-directory)) (defun sx-cache-get (cache) "Return the data within CACHE. diff --git a/sx-filter.el b/sx-filter.el index 7178259..aa815a2 100644 --- a/sx-filter.el +++ b/sx-filter.el @@ -28,21 +28,14 @@ (require 'sx) (require 'sx-cache) +(require 'sx-request) ;;; Customizations -(defconst sx-filter-cache-file - "filters.el") - -(defvar sx-filter - 'default - "The current filter. -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'!") +(defvar sx--filter-alist + (sx-cache-get 'filter) + "") ;;; Compilation @@ -60,39 +53,26 @@ or string." (let ((response (sx-request-make "filter/create" keyword-arguments))) - (url-hexify-string - (cdr (assoc 'filter - (elt response 0))))))) + (sx-assoc-let (elt response 0) + (url-hexify-string filter))))) ;;; Storage and Retrieval -(defun sx-filter-get (filter) - "Retrieve named FILTER from `sx-filter-cache-file'." - (cdr (assoc filter (sx-cache-get sx-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 -`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, -the second argument is simply ignored." - (let ((name (if (consp name) (car name) name)) - (filter (if (consp name) (cdr name) filter))) - (unless (symbolp name) - (error "Name must be a symbol: %S" name)) - (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))) - - (sx-cache-set sx-filter-cache-file dict)))) - -(defun sx-filter-store-all (name-filter-alist) - (mapc #'sx-filter-store name-filter-alist)) +(defun sx-filter-get-var (filter-variable) + "Return the string representation of FILTER-VARIABLE." + (apply #'sx-filter-get filter-variable)) + +(defun sx-filter-get (&optional include exclude base) + "Return the string representation of the given filter." + ;; Maybe we alreay have this filter + (or (cdr (assoc (list include exclude base) sx--filter-alist)) + ;; If we don't, build it, save it, and return it. + (let ((filter (sx-filter-compile include exclude base))) + (when filter + (push (cons (list include exclude base) filter) sx--filter-alist) + (sx-cache-set 'filter sx--filter-alist) + filter)))) (provide 'sx-filter) ;;; sx-filter.el ends here @@ -66,14 +66,14 @@ by the API and read by `json-read'." '((((background light)) :background "Grey90") (((background dark)) :background "Grey10")) "Face used on the body content of questions and answers." - :group 'stack-mode-faces) + :group 'sx-faces) ;;; This is not used ATM since we got rid of HTML. But it can be used ;;; once we start extending markdown mode. (defcustom sx-lto-bullet (if (char-displayable-p ?•) " •" " -") "Bullet used on the display of lists." :type 'string - :group 'stack-mode) + :group 'sx) (defun sx-lto--body (data) "Get and cleanup `body_markdown' from DATA." diff --git a/sx-method.el b/sx-method.el new file mode 100644 index 0000000..f69c381 --- /dev/null +++ b/sx-method.el @@ -0,0 +1,47 @@ +;;; sx-request.el --- requests for stack-mode + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred <sallred@calamity.tcs.com> + +;; 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) +(require 'sx-request) +(require 'sx-filter) + +(defun sx-method-call + (method &optional keyword-arguments filter silent) + "Call METHOD with KEYWORD-ARGUMENTS using FILTER. + +If SILENT is non-nil, no messages will be printed. + +Return the entire response as a complex alist." + (sx-request-make + method + (cons (cons 'filter + (sx-filter-get-var + (cond (filter filter) + ((boundp 'stack-filter) stack-filter)))) + keyword-arguments))) + +(provide 'sx-method) +;;; sx-request.el ends here diff --git a/sx-network.el b/sx-network.el index dcd2349..f756a26 100644 --- a/sx-network.el +++ b/sx-network.el @@ -29,7 +29,7 @@ (sx-request-make "sites")) (provide 'sx-network) -;;; stack-network.el ends here +;;; sx-network.el ends here ;; Local Variables: ;; indent-tabs-mode: nil diff --git a/sx-question-list.el b/sx-question-list.el index 86e9194..caf24b1 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -20,11 +20,13 @@ ;;; Commentary: ;;; Code: -(require 'sx-question) -(require 'sx-time) (require 'tabulated-list) (require 'cl-lib) +(require 'sx) +(require 'sx-time) +(require 'sx-question) + ;;; Customization (defcustom sx-question-list-height 12 diff --git a/sx-question.el b/sx-question.el index e9634f7..20a71cc 100644 --- a/sx-question.el +++ b/sx-question.el @@ -27,20 +27,14 @@ (require 'sx) (require 'sx-filter) (require 'sx-lto) -(require 'sx-request) +(require 'sx-method) -;; I don't know why this is here, but it was causing an API request on require. -(defvar sx-question-browse-filter nil - ;; (stack-filter-compile - ;; nil - ;; '(user.profile_image shallow_user.profile_image)) - ) - -;; (stack-filter-store 'question-browse sx-question-browse-filter) +(defvar sx-question-browse-filter + '(nil (user.profile_image shallow_user.profile_image))) (defun sx-question-get-questions (site &optional page) "Get the page PAGE of questions from SITE." - (sx-request-make + (sx-method-call "questions" `((site . ,site) (page . ,page)) diff --git a/sx-request.el b/sx-request.el index e9f52f3..9d9dca4 100644 --- a/sx-request.el +++ b/sx-request.el @@ -1,4 +1,4 @@ -;;; sx-request.el --- requests for stack-mode +;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -22,10 +22,27 @@ ;; ;;; Code: -(require 'json) + (require 'url) +(require 'json) + (require 'sx) + +;;; Variables + +(defconst sx-request-api-key + "0TE6s1tveCpP9K5r5JNDNQ((" + "When passed, this key provides a higher request quota.") + +(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.") + (defcustom sx-request-silent-p t "When `t', requests default to being silent.") @@ -49,111 +66,69 @@ recent call. Set by `sx-request-make'.") 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.") + +;;; Making Requests (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." + (method &optional args silent) (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 + (url-inhibit-uncompression t) + (silent (or silent sx-request-silent-p)) + (call (sx-request-build + method + (cons (cons 'key sx-request-api-key) + args)))) (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))))) + ((equal '(24 . 4) (cons emacs-major-version emacs-minor-version)) + (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) + (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; response corrupt") + (delete-region (point-min) (point)) + (buffer-string)))) + (response (ignore-errors + (json-read-from-string data)))) + ;; If the response isn't nil, the response was in plain text + (unless response + ;; try to decompress the response + (setq response + (with-demoted-errors "`json-read' 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 outline + (unless response + (sx-message "Unable to parse response: %S" response) + (error "Response could not be read by `json-read-from-string'"))) + ;; If we get here, the response is a valid data structure + (sx-assoc-let response + (when error_id + (error "Request failed: (%s) [%i %s] %S" + method error_id error_name error_message)) + (when (< (setq sx-request-remaining-api-requests + quota_remaining) + sx-request-remaining-api-requests-message-threshold) + (sx-message "%d API requests reamining" + sx-request-remaining-api-requests)) + items))))))) + + +;;; Support Functions + +(defun sx-request-build (method keyword-arguments &optional kv-value-sep root) "Build the request string that will be used to process REQUEST with the given KEYWORD-ARGUMENTS." - (let ((base (concat sx-request-api-root method)) + (let ((base (concat (or root sx-request-api-root) method)) (args (sx-request--build-keyword-arguments keyword-arguments kv-value-sep))) (if (string-equal "" args) @@ -178,16 +153,5 @@ false, use the symbol `false'. Each element is processed with 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 @@ -25,7 +25,8 @@ ;;; Code: -;;; Requirements +;;; Utility Functions + (defun sx-message (format-string &rest args) "Display a message" (message "[stack] %s" (apply #'format format-string args))) @@ -71,11 +72,47 @@ a string, just return it." ;;; Interpreting request data (defvar sx--api-symbols - '(accept_rate answer_count answer_id answers body body_markdown close_vote_count upvoted downvoted - comment_count comment_id creation_date delete_vote_count display_name - edited favorite_count is_accepted is_answered last_activity_date - last_edit_date last_editor link owner profile_image question_id - reopen_vote_count reputation score tags title user_id user_type view_count) + '( + accept_rate + answer_count + answer_id + answers + body + body_markdown + close_vote_count + comment_count + comment_id + creation_date + delete_vote_count + display_name + downvoted + edited + error_id + error_name + error_message + favorite_count + filter + items + is_accepted + is_answered + last_activity_date + last_edit_date + last_editor + link + owner + profile_image + question_id + quota_remaining + reopen_vote_count + reputation + score + tags + title + upvoted + user_id + user_type + view_count + ) "") (defun sx--deep-search (symbol list) @@ -112,6 +149,33 @@ is equivalent to `(let ,(mapcar (lambda (x) `(,x (cdr (assoc ',x ,alist)))) symbols) ,@body))) +(defcustom sx-init-hook nil + "Hook run when stack-mode initializes. + +Run after `sx-init--internal-hook'.") + +(defvar sx-init--internal-hook nil + "Hook run when stack-mode initializes. + +This is used internally to set initial values for variables such +as filters.") + +(defmacro sx-init-variable (variable value &optional setter) + "Set VARIABLE to VALUE using SETTER. +SETTER should be a function of two arguments. If SETTER is nil, +`set' is used." + (eval + `(add-hook + 'sx-init--internal-hook + (lambda () + (,(or setter #'setq) ,variable ,value)))) + nil) + +(defun stack-initialize () + (run-hooks + 'sx-init--internal-hook + 'sx-init-hook)) + (provide 'sx) ;;; sx.el ends here diff --git a/test/tests.el b/test/tests.el index 2864428..a66394c 100644 --- a/test/tests.el +++ b/test/tests.el @@ -1,20 +1,19 @@ -(defun -stack--nuke () +(defun -sx--nuke () (interactive) (mapatoms (lambda (symbol) - (if (string-prefix-p "stack-" (symbol-name symbol)) + (if (string-prefix-p "sx-" (symbol-name symbol)) (unintern symbol))))) ;;; Tests -(defvar stack-test-data-dir +(defvar sx-test-data-dir (expand-file-name "data-samples/" - (or (file-name-directory load-file-name) "./")) - "") + (or (file-name-directory load-file-name) "./"))) -(defun stack-test-sample-data (method &optional directory) +(defun sx-test-sample-data (method &optional directory) (let ((file (concat (when directory (concat directory "/")) - stack-test-data-dir + sx-test-data-dir method ".el"))) (when (file-exists-p file) (with-temp-buffer @@ -27,15 +26,16 @@ sx-request-silent-p nil user-emacs-directory "." - stack-test-data-questions - (stack-test-sample-data "questions") - stack-test-data-sites - (stack-test-sample-data "sites")) + sx-test-data-questions + (sx-test-sample-data "questions") + sx-test-data-sites + (sx-test-sample-data "sites")) (setq package-user-dir (expand-file-name (format "../../.cask/%s/elpa" emacs-version) - stack-test-data-dir)) + sx-test-data-dir)) (package-initialize) + (require 'cl-lib) (require 'sx) (require 'sx-question) @@ -55,7 +55,7 @@ (sx-request-make "questions" '(())))) (ert-deftest test-tree-filter () - "`stack-core-filter-data'" + "`sx-core-filter-data'" ;; flat (should (equal @@ -89,24 +89,6 @@ ((1 . alpha) (2 . beta))] '(1 2 3))))) -(ert-deftest test-filters () - (let ((stack-cache-directory (make-temp-file "stack-test" t))) - (should-error (sx-filter-store "names must be symbols" - "this is a filter")) - ;; basic use - (should (equal '((test . "filter")) - (sx-filter-store 'test "filter"))) - ;; aggregation - (should (equal '((test2 . "filter2") (test . "filter")) - (sx-filter-store 'test2 "filter2"))) - ;; mutation - (should (equal '((test2 . "filter2") (test . "filter-test")) - (sx-filter-store 'test "filter-test"))) - ;; clean up (note: the file should exist) - (delete-file - (sx-cache-get-file-name - sx-filter-cache-file)))) - (defmacro line-should-match (regexp) "" `(let ((line (buffer-substring-no-properties @@ -117,7 +99,7 @@ (ert-deftest question-list-display () (cl-letf (((symbol-function #'sx-request-make) - (lambda (&rest _) stack-test-data-questions))) + (lambda (&rest _) sx-test-data-questions))) (list-questions nil) (switch-to-buffer "*question-list*") (goto-char (point-min)) @@ -127,9 +109,9 @@ (sx-question-list-next 5) (line-should-match "^\\s-+0\\s-+1\\s-+Babel doesn't wrap results in verbatim [ 0-9]+[ydhms] ago\\s-+\\[org-mode\\]") - ;; ;; Use this when we have a real stack-question buffer. - ;; (call-interactively 'stack-question-list-display-question) - ;; (should (equal (buffer-name) "*stack-question*")) + ;; ;; Use this when we have a real sx-question buffer. + ;; (call-interactively 'sx-question-list-display-question) + ;; (should (equal (buffer-name) "*sx-question*")) (switch-to-buffer "*question-list*") (sx-question-list-previous 4) (line-should-match |