diff options
| -rw-r--r-- | sx-compose.el | 29 | ||||
| -rw-r--r-- | sx-method.el | 30 | ||||
| -rw-r--r-- | sx-question.el | 3 | ||||
| -rw-r--r-- | sx-request.el | 56 | ||||
| -rw-r--r-- | sx-tag.el | 69 | ||||
| -rw-r--r-- | test/test-api.el | 9 | ||||
| -rw-r--r-- | test/test-state.el | 22 |
7 files changed, 211 insertions, 7 deletions
diff --git a/sx-compose.el b/sx-compose.el index ab4a58d..d27d2f3 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -82,6 +82,10 @@ Is invoked between `sx-compose-before-send-hook' and "Headers inserted when composing a new question. Used by `sx-compose-create'.") +(defvar sx-compose--site nil + "Site which the curent compose buffer belongs to.") +(make-variable-buffer-local 'sx-compose--site) + ;;; Major-mode (define-derived-mode sx-compose-mode markdown-mode "Compose" @@ -116,6 +120,8 @@ contents to the API, then calls `sx-compose-after-send-functions'." (run-hook-with-args 'sx-compose-after-send-functions (current-buffer) result))))) + +;;; Functions for use in hooks (defun sx-compose-quit (buffer _) "Close BUFFER's window and kill it." (interactive (list (current-buffer) nil)) @@ -131,6 +137,26 @@ contents to the API, then calls `sx-compose-after-send-functions'." (with-current-buffer buffer (kill-new (buffer-string))))) +(defun sx-compose--check-tags () + "Check if tags in current compose buffer are valid." + (save-excursion + (goto-char (point-min)) + (unless (search-forward-regexp + "^Tags : *\\([^[:space:]].*\\) *$" + (next-single-property-change (point-min) 'sx-compose-separator) + 'noerror) + (error "No Tags header found")) + (let ((invalid-tags + (sx-tag--invalid-name-p + (split-string (match-string 1) "[[:space:],;]" + 'omit-nulls "[[:space:]]") + sx-compose--site))) + (if invalid-tags + ;; If the user doesn't want to create the tags, we return + ;; nil and sending is aborted. + (y-or-n-p "Following tags don't exist. Create them? %s " invalid-tags) + t)))) + ;;; Functions to help preparing buffers (defun sx-compose-create (site parent &optional before-functions after-functions) @@ -153,6 +179,7 @@ respectively added locally to `sx-compose-before-send-hook' and (cdr (assoc 'title parent)))))) (with-current-buffer (sx-compose--get-buffer-create site parent) (sx-compose-mode) + (setq sx-compose--site site) (setq sx-compose--send-function (if (consp parent) (sx-assoc-let parent @@ -180,6 +207,8 @@ respectively added locally to `sx-compose-before-send-hook' and (add-hook 'sx-compose-before-send-hook it nil t)) (dolist (it (reverse after-functions)) (add-hook 'sx-compose-after-send-functions it nil t)) + (when is-question + (add-hook 'sx-compose-before-send-hook #'sx-compose--check-tags nil t)) ;; If the buffer is empty, the draft didn't exist. So prepare the ;; question. (when (or (string= (buffer-string) "") diff --git a/sx-method.el b/sx-method.el index 1078014..8fa30c9 100644 --- a/sx-method.el +++ b/sx-method.el @@ -38,6 +38,9 @@ (filter '(())) auth (url-method "GET") + get-all + (process-function + #'sx-request-response-get-items) site) "Call METHOD with additional keys. @@ -50,6 +53,8 @@ user. authentication. :URL-METHOD is either \"POST\" or \"GET\" :SITE is the api parameter specifying the site. +:GET-ALL is nil or non-nil +:PROCESS-FUNCTION is a response-processing function When AUTH is nil, it is assumed that no auth-requiring filters or methods will be used. If they are an error will be signaled. This is @@ -66,6 +71,18 @@ for interactive commands that absolutely require authentication \(submitting questions/answers, reading inbox, etc). Filters will treat 'warn as equivalent to t. +If GET-ALL is nil, this method will only return the first (or +specified) page available from this method call. If t, all pages +will be retrieved (`sx-request-all-stop-when-no-more') . +Otherwise, it is a function STOP-WHEN for `sx-request-all-items'. + +If PROCESS-FUNCTION is nil, only the items of the response will +be returned (`sx-request-response-get-items'). Otherwise, it is +a function that processes the entire response (as returned by +`json-read'). + +See `sx-request-make' and `sx-request-all-items'. + Return the entire response as a complex alist." (declare (indent 1)) (let ((access-token (sx-cache-get 'auth)) @@ -82,7 +99,12 @@ Return the entire response as a complex alist." (prog1 (format "?site=%s" site) (setq site nil))))) - (call #'sx-request-make) + (call (if get-all #'sx-request-all-items #'sx-request-make)) + (get-all-stop-when + (cond + ((eq get-all t) #'sx-request-all-stop-when-no-more) + (get-all get-all) + (t nil))) parameters) (lwarn "sx-call-method" :debug "A: %S T: %S. M: %S,%s. F: %S" (equal 'warn auth) access-token method-auth full-method filter-auth) @@ -106,11 +128,15 @@ Return the entire response as a complex alist." (cons (cons 'filter (sx-filter-get-var filter)) keywords)) (when site + ;; @TODO: Maybe use `push' instead? (setq parameters (cons (cons 'site site) parameters))) (funcall call full-method parameters - url-method))) + url-method + (if get-all + get-all-stop-when + process-function)))) (provide 'sx-method) ;;; sx-method.el ends here diff --git a/sx-question.el b/sx-question.el index 1df67cd..0e830a6 100644 --- a/sx-question.el +++ b/sx-question.el @@ -119,7 +119,8 @@ See `sx-question--user-read-list'." ;; Question already present. ((setq cell (assoc .question_id site-cell)) ;; Current version is newer than cached version. - (when (> .last_activity_date (cdr cell)) + (when (or (not (numberp (cdr cell))) + (> .last_activity_date (cdr cell))) (setcdr cell .last_activity_date))) ;; Question wasn't present. (t diff --git a/sx-request.el b/sx-request.el index bc34f9c..da0a1fb 100644 --- a/sx-request.el +++ b/sx-request.el @@ -92,16 +92,52 @@ number of requests left every time it finishes a call." :group 'sx :type 'integer) +(defvar sx-request-all-items-delay + 1 + "Delay in seconds with each `sx-request-all-items' iteration. +It is good to use a reasonable delay to avoid rate-limiting.") + ;;; Making Requests +(defun sx-request-all-items (method &optional args request-method + stop-when) + "Call METHOD with ARGS until there are no more items. +STOP-WHEN is a function that takes the entire response and +returns non-nil if the process should stop. + +All other arguments are identical to `sx-request-make', but +PROCESS-FUNCTION is given the default value of `identity' (rather +than `sx-request-response-get-items') to allow STOP-WHEN to +access the response wrapper." + ;; @TODO: Refactor. This is the product of a late-night jam + ;; session... it is not intended to be model code. + (declare (indent 1)) + (let* ((return-value []) + (current-page 1) + (stop-when (or stop-when #'sx-request-all-stop-when-no-more)) + (process-function #'identity) + (response + (sx-request-make method `((page . ,current-page) ,@args) + request-method process-function))) + (while (not (funcall stop-when response)) + (setq current-page (1+ current-page) + return-value + (vconcat return-value + (cdr (assoc 'items response)))) + (sleep-for sx-request-all-items-delay) + (setq response + (sx-request-make method `((page . ,current-page) ,@args) + request-method process-function))) + (vconcat return-value + (cdr (assoc 'items response))))) -(defun sx-request-make (method &optional args request-method) +(defun sx-request-make (method &optional args request-method process-function) "Make a request to the API, executing METHOD with ARGS. You should almost certainly be using `sx-method-call' instead of this function. REQUEST-METHOD is one of `GET' (default) or `POST'. -Returns cleaned response content. -See (`sx-encoding-clean-content-deep'). +Returns the entire response as processed by PROCESS-FUNCTION. +This defaults to `sx-request-response-get-items'. The full set of arguments is built with `sx-request--build-keyword-arguments', prepending @@ -117,6 +153,7 @@ then read with `json-read-from-string'. `sx-request-remaining-api-requests' is updated appropriately and the main content of the response is returned." + (declare (indent 1)) (let* ((url-automatic-caching t) (url-inhibit-uncompression t) (url-request-data (sx-request--build-keyword-arguments args nil)) @@ -164,7 +201,8 @@ the main content of the response is returned." sx-request-remaining-api-requests-message-threshold) (sx-message "%d API requests remaining" sx-request-remaining-api-requests)) - (sx-encoding-clean-content-deep .items))))))) + (funcall (or process-function #'sx-request-response-get-items) + response))))))) (defun sx-request-fallback (_method &optional _args _request-method) "Fallback method when authentication is not available. @@ -205,6 +243,16 @@ false, use the symbol `false'. Each element is processed with alist)) "&"))) + +;;; Response Processors +(defun sx-request-response-get-items (response) + "Returns the items from RESPONSE." + (sx-assoc-let response + (sx-encoding-clean-content-deep .items))) + +(defun sx-request-all-stop-when-no-more (response) + (or (not response) + (equal :json-false (cdr (assoc 'has_more response))))) (provide 'sx-request) ;;; sx-request.el ends here diff --git a/sx-tag.el b/sx-tag.el new file mode 100644 index 0000000..82f7ddb --- /dev/null +++ b/sx-tag.el @@ -0,0 +1,69 @@ +;;; sx-tag.el --- Retrieving list of tags and handling tags. -*- lexical-binding: t; -*- + +;; 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: +(eval-when-compile + '(require 'cl-lib)) + +(require 'sx) +(require 'sx-method) + + +;;; Getting the list from a site +(defvar sx-tag-filter '((tag.name)) + "Filter used when querying tags.") + +(defun sx-tag--get-some-tags-containing (site string) + "Return at most 100 tags for SITE containing STRING. +Returns an array." + (sx-method-call 'tags + :auth nil + :filter sx-tag-filter + :site site + :keywords `((page . 1) (pagesize . 100) (inname . ,string)))) + +(defun sx-tag--get-some-tag-names-containing (site string) + "Return at most 100 tag names for SITE containing STRING. +Returns a list." + (mapcar (lambda (x) (cdr (assoc 'name x))) + (sx-tag--get-some-tags-containing site string))) + + +;;; Check tag validity +(defun sx-tag--invalid-name-p (site tags) + "Nil if TAGS exist in SITE. +TAGS can be a string (the tag name) or a list of strings. +Fails if TAGS is a list with more than 100 items. +Return the list of invalid tags in TAGS." + (and (listp tags) (> (length tags) 100) + (error "Invalid argument. TAG has more than 100 items")) + (let ((result + (mapcar + (lambda (x) (cdr (assoc 'name x))) + (sx-method-call 'tags + :id (sx--thing-as-string tags) + :submethod 'info + :auth nil + :filter sx-tag-filter + :site site + :keywords '((page . 1) (pagesize . 100)))))) + (cl-remove-if (lambda (x) (member x result)) tags))) + +(provide 'sx-tag) +;;; sx-tag.el ends here diff --git a/test/test-api.el b/test/test-api.el index ca775ff..91a8adb 100644 --- a/test/test-api.el +++ b/test/test-api.el @@ -11,3 +11,12 @@ (should-error (sx-request-make "questions" '(())))) +(ert-deftest test-request-all () + "Test request all items" + (should + (< 250 + (length (sx-request-all-items "sites"))))) + +(ert-deftest test-method-get-all () + "Tests sx-method interface to `sx-request-all-items'" + (should (< 250 (length (sx-method-call 'sites :get-all t))))) diff --git a/test/test-state.el b/test/test-state.el new file mode 100644 index 0000000..7af4a64 --- /dev/null +++ b/test/test-state.el @@ -0,0 +1,22 @@ +(defmacro with-question-data (cell id &rest body) + (declare (indent 2)) + `(let ((,cell '((question_id . ,id) + (site_par . "emacs") + (last_activity_date . 1234123456)))) + ,@body)) + +(ert-deftest test-question-mark-read () + "00ccd139248e782cd8316eff65c26aed838c7e46" + (with-question-data q 10 + ;; Check basic logic. + (should (sx-question--mark-read q)) + (should (sx-question--read-p q)) + (should (not (setcdr (assq 10 (cdr (assoc "emacs" sx-question--user-read-list))) nil))) + ;; Don't freak out because the cdr was nil. + (should (not (sx-question--read-p q))) + (should (sx-question--mark-read q))) + (should + (with-question-data q nil + ;; Don't freak out because question_id was nil. + (sx-question--mark-read q)))) + |