From a1a5ccb76329d835adafdf117883199c92de44cb Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Fri, 14 Nov 2014 15:33:59 -0500 Subject: Updated `sx-request-make` to use a consistent format for both `POST` and `GET` methods. (sx-request-make): Added optional arguments for using "POST" and AUTH when performing requests (sx-request--build-keyword-arguments): Add option of using AUTH and including in query when required. (sx-request-build): Removed (sx-request--request): New function to perform query with all variables let bound. sx-auth.el: Updated `sx-auth-root` to be full auth URL rather than lack method. (sx-auth-authenticate): Remove dependency on `sx-request-build` and perform construction inline. --- sx-auth.el | 23 +++++++++++++---------- sx-request.el | 44 ++++++++++++++++++++++++-------------------- 2 files changed, 37 insertions(+), 30 deletions(-) diff --git a/sx-auth.el b/sx-auth.el index f32e7aa..4ccdd0e 100644 --- a/sx-auth.el +++ b/sx-auth.el @@ -28,7 +28,7 @@ (require 'sx-cache) (defconst sx-auth-root - "https://stackexchange.com/oauth/") + "https://stackexchange.com/oauth/dialog") (defconst sx-auth-redirect-uri "http://vermiculus.github.io/stack-mode/auth/auth.htm") (defconst sx-auth-client-id @@ -50,15 +50,18 @@ questions)." (interactive) (setq sx-auth-access-token - (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))) + (let ( + (url (concat + sx-auth-root + "?" + (sx-request--build-keyword-arguments + `((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 "" sx-auth-access-token) diff --git a/sx-request.el b/sx-request.el index 6dc54e7..da8e71e 100644 --- a/sx-request.el +++ b/sx-request.el @@ -71,19 +71,19 @@ number of requests left every time it finishes a call.") ;;; Making Requests (defun sx-request-make - (method &optional args silent) + (method &optional args use-auth use-post 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 - (cons (cons 'key sx-request-api-key) - args)))) + (request-method (if use-post "POST" "GET")) + (request-args + (sx-request--build-keyword-arguments args nil use-auth)) + (request-url (concat sx-request-api-root method))) (unless silent (sx-message "Request: %S" call)) - (let ((response-buffer (cond - ((equal '(24 . 4) (cons emacs-major-version emacs-minor-version)) - (url-retrieve-synchronously call silent)) - (t (url-retrieve-synchronously call))))) + (let ((response-buffer (sx-request--request request-url + request-args + request-method + silent))) (if (not response-buffer) (error "Something went wrong in `url-retrieve-synchronously'") (with-current-buffer response-buffer @@ -120,22 +120,26 @@ number of requests left every time it finishes a call.") ;;; 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 (or root 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) +(defun sx-request--request (url args method silent) + (let ((url-request-method method) + (url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded"))) + (url-request-data args)) + (cond + ((equal '(24 . 4) (cons emacs-major-version emacs-minor-version)) + (url-retrieve-synchronously url silent)) + (t (url-retrieve-synchronously url))))) + +(defun sx-request--build-keyword-arguments (alist &optional + kv-value-sep use-auth) "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'." + (when use-auth + (add-to-list 'alist (cons "key" sx-request-api-key)) + (add-to-list 'alist (car (sx-cache-get 'auth)))) (mapconcat (lambda (pair) (concat -- cgit v1.2.3 From 3593d62493b072b162abfec83a0e3081092738f0 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Fri, 14 Nov 2014 15:56:01 -0500 Subject: Remove unneeded newline --- sx-auth.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sx-auth.el b/sx-auth.el index 4ccdd0e..b470523 100644 --- a/sx-auth.el +++ b/sx-auth.el @@ -50,8 +50,7 @@ questions)." (interactive) (setq sx-auth-access-token - (let ( - (url (concat + (let ((url (concat sx-auth-root "?" (sx-request--build-keyword-arguments -- cgit v1.2.3 From 97a0d11c657fcb3a7369e62ab4c7b5ee676444ea Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 15 Nov 2014 17:29:40 -0500 Subject: Fix use of `rx' macro It needs to be evaluated. --- sx-question-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 32cd112..03647bc 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -345,11 +345,11 @@ HEADER is given `sx-question-mode-header' face, and value is given FACE. (when sx-question-mode-bullet-appearance (font-lock-add-keywords ;; Bullet items. nil - `(((rx line-start (0+ blank) (group-n 1 (any "*+-")) blank) + `((,(rx line-start (0+ blank) (group-n 1 (any "*+-")) blank) 1 '(face nil display ,sx-question-mode-bullet-appearance) prepend)))) (font-lock-add-keywords ;; Highlight usernames. nil - `(((rx (or blank line-start) + `((,(rx (or blank line-start) (group-n 1 (and "@" (1+ (or (syntax word) (syntax symbol))))) symbol-end) 1 font-lock-builtin-face))) -- cgit v1.2.3 From 829821cc988be06c1f8a0699d11fecb7a6db972a Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 16 Nov 2014 10:45:21 +0000 Subject: Implement sx-initialize --- sx.el | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/sx.el b/sx.el index 53aae84..64c555c 100644 --- a/sx.el +++ b/sx.el @@ -143,10 +143,19 @@ SETTER should be a function of two arguments. If SETTER is nil, (,(or setter #'setq) ,variable ,value)))) nil) -(defun stack-initialize () - (run-hooks - 'sx-init--internal-hook - 'sx-init-hook)) +(defvar sx-initialized nil + "Nil if sx hasn't been initialized yet. +If it has, holds the time at which initialization happened.") + +(defun sx-initialize (&optional force) + "Run initialization hooks if they haven't been run yet. +These are `sx-init--internal-hook' and `sx-init-hook'. +If FORCE is non-nil, run them even if they've already been run." + (when (or force (not sx-initialized)) + (prog1 + (run-hooks 'sx-init--internal-hook + 'sx-init-hook) + (setq sx-initialized (current-time))))) (provide 'sx) ;;; sx.el ends here -- cgit v1.2.3 From 14409012011d389c70ff79baf6dc3e228b08584c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 16 Nov 2014 10:45:46 +0000 Subject: Call sx-initialize on list-questions Addresses #63 --- sx-question-list.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-question-list.el b/sx-question-list.el index b220097..72eabd3 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -323,6 +323,7 @@ focus the relevant window." (defun list-questions (no-update) "Display a list of StackExchange questions." (interactive "P") + (sx-initialize) (unless (buffer-live-p sx-question-list--buffer) (setq sx-question-list--buffer (generate-new-buffer "*question-list*"))) -- cgit v1.2.3 From 35ed7285e9271da388ed23416a27d40fd90807e3 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sun, 16 Nov 2014 22:28:19 -0500 Subject: Set question data when printing the question --- sx-question-mode.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-question-mode.el b/sx-question-mode.el index 32cd112..fdb6487 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -192,6 +192,7 @@ Second \"%s\" is replaced with the comment." (defun sx-question-mode--print-question (question) "Print a buffer describing QUESTION. QUESTION must be a data structure returned by `json-read'." + (setq sx-question-mode--data question) ;; Clear the overlays (mapc #'delete-overlay sx-question-mode--overlays) (setq sx-question-mode--overlays nil) -- cgit v1.2.3 From 2e527f3e3c4802602c9f1cff659f0c36a39fce2f Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sun, 16 Nov 2014 22:28:50 -0500 Subject: Add function to browse-url in question-mode --- sx-question-mode.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index fdb6487..9653485 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -545,6 +545,7 @@ Letters do not insert themselves; instead, they are commands. `(("n" sx-question-mode-next-section) ("p" sx-question-mode-previous-section) ("g" sx-question-mode-refresh) + ("v" sx-question-mode-visit) ("q" quit-window) (" " scroll-up-command) (,(kbd "S-SPC") scroll-down-command) @@ -555,18 +556,29 @@ Letters do not insert themselves; instead, they are commands. (,(kbd "") backward-button) ([return] push-button))) +(defun sx-question-mode-visit () + "Visit the currently displayed question." + (interactive) + (sx-question-mode--ensure-mode) + (sx-assoc-let sx-question-mode--data + (browse-url .link))) + (defun sx-question-mode-refresh () "Refresh currently displayed question. Queries the API for any changes to the question or its answers or comments, and redisplays it." (interactive) - (unless (derived-mode-p 'sx-question-mode) - (error "Not in `sx-question-mode'")) + (sx-question-mode--ensure-mode) (sx-assoc-let sx-question-mode--data (sx-question-mode--display (sx-question-get-question sx-question-list--current-site .question_id) (selected-window)))) +(defun sx-question-mode--ensure-mode () + "Ensures we are in question mode, erroring otherwise." + (unless (derived-mode-p 'sx-question-mode) + (error "Not in `sx-question-mode'"))) + (provide 'sx-question-mode) ;;; sx-question-mode.el ends here -- cgit v1.2.3 From 7052a69347e965ac94ea691c8bfe88a1f3825855 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 17 Nov 2014 11:32:57 +0000 Subject: Set text property sx-question-mode--data-here It holds the data of current section, which is a question or answer for now. This means the data of thing-at-point is always immediately available through get-text-property. --- sx-question-mode.el | 116 +++++++++++++++++++++++++++------------------------- 1 file changed, 60 insertions(+), 56 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 9653485..2c4adb3 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -221,67 +221,71 @@ QUESTION must be a data structure returned by `json-read'." (defun sx-question-mode--print-section (data) "Print a section corresponding to DATA. DATA can represent a question or an answer." - (sx-assoc-let data - (insert sx-question-mode-header-title - (apply - #'propertize - ;; Questions have title - (or .title - ;; Answers don't - sx-question-mode-answer-title) - ;; Section level - 'sx-question-mode--section (if .title 1 2) - ;; face, action and help-echo - sx-question-mode--title-properties)) - ;; Sections can be hidden with overlays - (sx-question-mode--wrap-in-overlay - '(sx-question-mode--section-content t) - (sx-question-mode--insert-header - ;; Author - sx-question-mode-header-author - (sx-question-mode--propertize-display-name .owner) - 'sx-question-mode-author - ;; Date - sx-question-mode-header-date - (concat - (sx-time-seconds-to-date .creation_date) - (when .last_edit_date - (format sx-question-mode-last-edit-format - (sx-time-since .last_edit_date) - (sx-question-mode--propertize-display-name .last_editor)))) - 'sx-question-mode-date) - (when .title - ;; Tags - (sx-question-mode--insert-header - sx-question-mode-header-tags - (mapconcat #'sx-question--tag-format .tags " ") - 'sx-question-mode-tags)) - ;; Body - (insert "\n" - (propertize sx-question-mode-separator - 'face 'sx-question-mode-header - 'sx-question-mode--section 4)) + ;; This makes `data' accessible through + ;; `(get-text-property (point) 'sx-question-mode--data-here)' + (sx-question-mode--wrap-in-text-property + (list 'sx-question-mode--data-here data) + (sx-assoc-let data + (insert sx-question-mode-header-title + (apply + #'propertize + ;; Questions have title + (or .title + ;; Answers don't + sx-question-mode-answer-title) + ;; Section level + 'sx-question-mode--section (if .title 1 2) + ;; face, action and help-echo + sx-question-mode--title-properties)) + ;; Sections can be hidden with overlays (sx-question-mode--wrap-in-overlay - '(face sx-question-mode-content-face) + '(sx-question-mode--section-content t) + (sx-question-mode--insert-header + ;; Author + sx-question-mode-header-author + (sx-question-mode--propertize-display-name .owner) + 'sx-question-mode-author + ;; Date + sx-question-mode-header-date + (concat + (sx-time-seconds-to-date .creation_date) + (when .last_edit_date + (format sx-question-mode-last-edit-format + (sx-time-since .last_edit_date) + (sx-question-mode--propertize-display-name .last_editor)))) + 'sx-question-mode-date) + (when .title + ;; Tags + (sx-question-mode--insert-header + sx-question-mode-header-tags + (mapconcat #'sx-question--tag-format .tags " ") + 'sx-question-mode-tags)) + ;; Body (insert "\n" - (sx-question-mode--fill-and-fontify - .body_markdown) (propertize sx-question-mode-separator - 'face 'sx-question-mode-header)))) - ;; Comments - (when .comments - (insert "\n" - (apply #'propertize - sx-question-mode-comments-title - 'face 'sx-question-mode-title-comments - 'sx-question-mode--section 3 - sx-question-mode--title-properties)) - (sx-question-mode--wrap-in-overlay - '(sx-question-mode--section-content t) - (insert "\n") + 'face 'sx-question-mode-header + 'sx-question-mode--section 4)) (sx-question-mode--wrap-in-overlay '(face sx-question-mode-content-face) - (mapc #'sx-question-mode--print-comment .comments)))))) + (insert "\n" + (sx-question-mode--fill-and-fontify + .body_markdown) + (propertize sx-question-mode-separator + 'face 'sx-question-mode-header)))) + ;; Comments + (when .comments + (insert "\n" + (apply #'propertize + sx-question-mode-comments-title + 'face 'sx-question-mode-title-comments + 'sx-question-mode--section 3 + sx-question-mode--title-properties)) + (sx-question-mode--wrap-in-overlay + '(sx-question-mode--section-content t) + (insert "\n") + (sx-question-mode--wrap-in-overlay + '(face sx-question-mode-content-face) + (mapc #'sx-question-mode--print-comment .comments))))))) (defun sx-question-mode--propertize-display-name (author) "Return display_name of AUTHOR with `sx-question-mode-author' face." -- cgit v1.2.3 From 34d28e79f4a6049dc4ceb44397a2ca0725cecd5f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 17 Nov 2014 11:33:53 +0000 Subject: Define -visit to use answer link if available. --- sx-question-mode.el | 18 +++++++++++++++++- sx-question.el | 2 ++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 2c4adb3..20d93c4 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -324,6 +324,16 @@ Return the result of BODY." (push ov sx-question-mode--overlays)) result)) +(defmacro sx-question-mode--wrap-in-text-property (properties &rest body) + "Execute BODY and PROPERTIES to any inserted text. +Return the result of BODY." + (declare (indent 1) + (debug t)) + `(let ((p (point-marker)) + (result (progn ,@body))) + (add-text-properties p (point) ,properties) + result)) + (defun sx-question-mode--insert-header (&rest args) "Insert HEADER and VALUE. HEADER is given `sx-question-mode-header' face, and value is given FACE. @@ -564,7 +574,13 @@ Letters do not insert themselves; instead, they are commands. "Visit the currently displayed question." (interactive) (sx-question-mode--ensure-mode) - (sx-assoc-let sx-question-mode--data + (sx-assoc-let + ;; This allows us to visit the thing-at-point. Which could be a + ;; question or an answer. We use `append', so that if one + ;; doesn't have a `link' item we can fallback to + ;; `sx-question-mode--data'. + (append (get-text-property (point) 'sx-question-mode--data-here) + sx-question-mode--data) (browse-url .link))) (defun sx-question-mode-refresh () diff --git a/sx-question.el b/sx-question.el index fc44bd8..6ef9484 100644 --- a/sx-question.el +++ b/sx-question.el @@ -34,11 +34,13 @@ question.answers question.last_editor question.accepted_answer_id + question.link user.display_name comment.owner comment.body_markdown comment.body answer.last_editor + answer.link answer.owner answer.body_markdown answer.comments) -- cgit v1.2.3 From d3222a36e8f225a3b3df13dbc6401673eff3474d Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 07:45:53 -0500 Subject: Fix incorrect call to `call` rather than `request-url` --- sx-request.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-request.el b/sx-request.el index da8e71e..107806c 100644 --- a/sx-request.el +++ b/sx-request.el @@ -79,7 +79,7 @@ number of requests left every time it finishes a call.") (request-args (sx-request--build-keyword-arguments args nil use-auth)) (request-url (concat sx-request-api-root method))) - (unless silent (sx-message "Request: %S" call)) + (unless silent (sx-message "Request: %S" request-url)) (let ((response-buffer (sx-request--request request-url request-args request-method -- cgit v1.2.3 From a3d1ea047d0f4a5d4c4900b95de66955e65aa3d5 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 08:57:14 -0500 Subject: Adjust request keyword creation to verify if AUTH is needed. If `need-auth` is `'warn`, break with `user-error` to advise the user to authenticate. Otherwise the query will result in an `Error 401`. --- sx-request.el | 48 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 16 deletions(-) diff --git a/sx-request.el b/sx-request.el index 107806c..91c4db4 100644 --- a/sx-request.el +++ b/sx-request.el @@ -71,13 +71,13 @@ number of requests left every time it finishes a call.") ;;; Making Requests (defun sx-request-make - (method &optional args use-auth use-post silent) + (method &optional args need-auth use-post silent) (let ((url-automatic-caching sx-request-cache-p) (url-inhibit-uncompression t) (silent (or silent sx-request-silent-p)) (request-method (if use-post "POST" "GET")) (request-args - (sx-request--build-keyword-arguments args nil use-auth)) + (sx-request--build-keyword-arguments args nil need-auth)) (request-url (concat sx-request-api-root method))) (unless silent (sx-message "Request: %S" request-url)) (let ((response-buffer (sx-request--request request-url @@ -131,26 +131,42 @@ number of requests left every time it finishes a call.") (t (url-retrieve-synchronously url))))) (defun sx-request--build-keyword-arguments (alist &optional - kv-value-sep use-auth) + kv-value-sep need-auth) "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'." - (when use-auth + ;; Add API key to list of arguments, this allows for increased quota + ;; automatically. + (let* ((warn (equal need-auth 'warn)) + (auth + (let ((auth (car (sx-cache-get 'auth)))) + (cond + (auth) + ;; Pass user error when asking to warn + (warn + (user-error + "This query requires authentication. Please run `M-x sx-auth-authenticate' and try again.")) + ((not auth) + (lwarn "stack-mode" :debug + "This query requires authentication") + nil))))) (add-to-list 'alist (cons "key" sx-request-api-key)) - (add-to-list 'alist (car (sx-cache-get 'auth)))) - (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)) - "&")) + (if (and need-auth auth) + (add-to-list 'alist auth)) + (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)) + "&"))) + (provide 'sx-request) ;;; sx-request.el ends here -- cgit v1.2.3 From f4d7c0341ce30a93bc7d75591183292307971e41 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 09:26:27 -0500 Subject: Change from `add-to-list` to `push` to avoid a strange `(void-variable alist)` error. Moved `api-key` to let binding rather than directly in if statement. --- sx-request.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sx-request.el b/sx-request.el index 91c4db4..d982057 100644 --- a/sx-request.el +++ b/sx-request.el @@ -140,6 +140,7 @@ false, use the symbol `false'. Each element is processed with ;; Add API key to list of arguments, this allows for increased quota ;; automatically. (let* ((warn (equal need-auth 'warn)) + (api-key (cons "key" sx-request-api-key)) (auth (let ((auth (car (sx-cache-get 'auth)))) (cond @@ -152,9 +153,9 @@ false, use the symbol `false'. Each element is processed with (lwarn "stack-mode" :debug "This query requires authentication") nil))))) - (add-to-list 'alist (cons "key" sx-request-api-key)) + (push api-key alist) (if (and need-auth auth) - (add-to-list 'alist auth)) + (push auth alist)) (mapconcat (lambda (pair) (concat -- cgit v1.2.3 From 97eee0eae60c97bdab1361edb39dbac57c3dc6e5 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 10:48:32 -0500 Subject: Update `sx-method-call` to use `need-auth` and `use-post` variables when creating a request. --- sx-method.el | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/sx-method.el b/sx-method.el index 6f0a36b..e9c4f60 100644 --- a/sx-method.el +++ b/sx-method.el @@ -29,9 +29,16 @@ (require 'sx-filter) (defun sx-method-call - (method &optional keyword-arguments filter silent) + (method &optional keyword-arguments filter need-auth use-post silent) "Call METHOD with KEYWORD-ARGUMENTS using FILTER. +If NEED-AUTH is non-nil, an auth-token is required. If 'WARN, +warn the user `(user-error ...)' if they do not have an AUTH +token set. + +If USE-POST is non-nil, use `POST' rather than `GET' for passing +arguments. + If SILENT is non-nil, no messages will be printed. Return the entire response as a complex alist." @@ -41,7 +48,9 @@ Return the entire response as a complex alist." (sx-filter-get-var (cond (filter filter) ((boundp 'stack-filter) stack-filter)))) - keyword-arguments))) + keyword-arguments) + need-auth + use-post)) (provide 'sx-method) ;;; sx-method.el ends here -- cgit v1.2.3 From e6bb22b2f0666dbd9ef229d46dc95b9aecfa3d0a Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 15:48:02 -0500 Subject: Create `sx-networks` and the associated cache. sx-network--user-information: User query from site. sx-network--user-sites: List of sites user is active on for use when querying sites. (sx-network--ensure-user): Ensures network-user cache is available for use. (sx-network--update): Retrieve most recent network user information. --- sx-networks.el | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 sx-networks.el diff --git a/sx-networks.el b/sx-networks.el new file mode 100644 index 0000000..41c7aa1 --- /dev/null +++ b/sx-networks.el @@ -0,0 +1,84 @@ +;;; sx-networks.el --- user network information -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; 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 . + +;;; Commentary: + +;; + +;;; Code: + +(require 'sx-method) +(require 'sx-cache) +(require 'sx-site) + +(defun sx-network--get-associated () + (sx-cache-get + 'network-user + '(sx-network--update))) + +(defun sx-network--update () + "Update user information." + (setq sx-network--user-information + (sx-method-call "me/associated" + '((types . "main_site;meta_site")) + 'nil + 'warn)) + (setq sx-network--user-sites (sx-network--map-site-url-to-site-api)) + (sx-cache-set 'network-user sx-network--user-information)) + +(defun sx-network--ensure-user () + "Ensure user-cache is available. + +This should be called during initialization." + (cond + ((not sx-network--user-information) + (or (sx-network--get-associated) + (sx-network--update))) + ((not sx-network--user-sites) + (sx-network--map-site-url-to-site-api)))) + +(defun sx-network--map-site-url-to-site-api () + "Convert `me/associations' to a set of `api_site_parameter's. + +`me/associations' does not return `api_site_parameter' so cannot +be directly used to retrieve content per site. This creates a +list of sites the user is active on." + (let ((sites-info (mapcar (lambda (x) + (cons (cdr (assoc 'site_url x)) + (cdr (assoc 'api_site_parameter + x)))) + (sx-site--get-site-list)))) + (mapcar '(lambda (loc) + (let ((u-site (cdr (assoc 'site_url loc)))) + (when (member u-site (mapcar 'car sites-info)) + (cdr (assoc u-site sites-info))))) + (sx-network--user-information)))) + +(defvar sx-network--user-information nil + "User information for the various sites.") + +(defvar sx-network--user-sites nil + "List of sites where user already has an account.") + +(provide sx-networks) +;;; sx-networks.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: -- cgit v1.2.3 From 7b621fcd6a8459896d13e09fe38f04ebd1f480c4 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 15:59:42 -0500 Subject: Generate and update list of favorited questions. sx-favorites--ensure-favorite-list: List of favorites in format (SITE QUESTION_ID QUESTION_ID ...). (sx-favorites--update-site-favorites): Update favorites for given SITE. (sx-favorites-update): Update favorites for all networks user has an account on. --- sx-favorites.el | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 sx-favorites.el diff --git a/sx-favorites.el b/sx-favorites.el new file mode 100644 index 0000000..b66b2c5 --- /dev/null +++ b/sx-favorites.el @@ -0,0 +1,87 @@ +;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; 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 . + +;;; Commentary: + +;; + +;;; Code: + +(require 'sx-method) +(require 'sx-cache) +(require 'sx-site) +(require 'sx-networks) + +(defvar sx-favorite-list-filter + '((.backoff + .items + .quota_max + .quota_remaining + question.question_id) + nil + none)) + +(defvar sx-favorites--user-favorite-list nil + "Alist of questions favorited by the user. +Each element has the form (SITE FAVORITE-LIST). +And each element in FAVORITE-LIST has the form QUESTION_ID.") + +(defun sx-favorites--ensure-favorite-list (site) + (unless sx-favorites--user-favorite-list + (setq sx-favorites--user-favorite-list + (sx-cache-get + 'question-favorites + (let ((sites + (mapcar '(lambda (site) + `(,site)) + sx-network--user-sites))) + `(quote ,sites)))))) + +(defun sx-favorites--retrieve-favorites (site) + "Obtain list of starred QUESTION_IDs for SITE." + (sx-method-call (format "me/favorites?site=%s" site) + nil + sx-favorite-list-filter + 'warn)) + +(defun sx-favorites--update-site-favorites (site) + "Update list of starred QUESTION_IDs for SITE. + +Writes list to cache QUESTION-FAVORITES." + (sx-favorites--ensure-favorite-list site) + (let ((favs (sx-favorites--retrieve-favorites site)) + (site-cell (assoc site + sx-favorites--user-favorite-list))) + (if site-cell + (setcdr site-cell (mapcar 'cdar favs)) + (push (list site favs) sx-favorites--user-favorite-list)) + (sx-cache-set 'question-favorites sx-favorites--user-favorite-list))) + +(defun sx-favorites-update () + "Update all sites retrieved from `sx-network--user-sites'." + (sx-network--ensure-user) + (mapc #'sx-favorites--update-site-favorites + sx-network--user-sites)) + +(provide sx-favorites) +;;; sx-favorites.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: -- cgit v1.2.3 From 7e6d1a3663b2d9fb21c104c8cc145cb9bf65c85d Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 16:04:40 -0500 Subject: Use sx-network--user-filter to include `user_type' property (non-default). --- sx-networks.el | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/sx-networks.el b/sx-networks.el index 41c7aa1..5e6a96d 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -27,6 +27,31 @@ (require 'sx-cache) (require 'sx-site) +(defvar sx-network--user-filter + '((.backoff + .error_id + .error_message + .error_name + .has_more + .items + .quota_max + .quota_remaining + badge_count.bronze + badge_count.silver + badge_count.gold + network_user.account_id + network_user.answer_count + network_user.badge_counts + network_user.creation_date + network_user.last_access_date + network_user.reputation + network_user.site_name + network_user.site_url + network_user.user_id + network_user.user_type) + nil + none)) + (defun sx-network--get-associated () (sx-cache-get 'network-user @@ -37,7 +62,7 @@ (setq sx-network--user-information (sx-method-call "me/associated" '((types . "main_site;meta_site")) - 'nil + sx-network--user-filter 'warn)) (setq sx-network--user-sites (sx-network--map-site-url-to-site-api)) (sx-cache-set 'network-user sx-network--user-information)) -- cgit v1.2.3 From 49ccfdc2202cb8d71638e115509fc20d487a0da1 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Mon, 17 Nov 2014 17:47:20 -0500 Subject: Fix mistakes: - sx-network--user-information is a var not a function - remember to setq sx-network--user-sites. --- sx-networks.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sx-networks.el b/sx-networks.el index 5e6a96d..3a33f1a 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -76,7 +76,8 @@ This should be called during initialization." (or (sx-network--get-associated) (sx-network--update))) ((not sx-network--user-sites) - (sx-network--map-site-url-to-site-api)))) + (setq sx-network--user-sites + (sx-network--map-site-url-to-site-api))))) (defun sx-network--map-site-url-to-site-api () "Convert `me/associations' to a set of `api_site_parameter's. @@ -93,7 +94,7 @@ list of sites the user is active on." (let ((u-site (cdr (assoc 'site_url loc)))) (when (member u-site (mapcar 'car sites-info)) (cdr (assoc u-site sites-info))))) - (sx-network--user-information)))) + sx-network--user-information))) (defvar sx-network--user-information nil "User information for the various sites.") -- cgit v1.2.3 From 6a7e345bb776c715c0801674ff4cc5feaef08f4c Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 07:18:52 -0500 Subject: Refactor sx-network--get-associated to avoid double call to sx-cache-set. Fix provides lines (missed quote on symbol). --- sx-favorites.el | 2 +- sx-networks.el | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/sx-favorites.el b/sx-favorites.el index b66b2c5..0b9527a 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -79,7 +79,7 @@ Writes list to cache QUESTION-FAVORITES." (mapc #'sx-favorites--update-site-favorites sx-network--user-sites)) -(provide sx-favorites) +(provide 'sx-favorites) ;;; sx-favorites.el ends here ;; Local Variables: diff --git a/sx-networks.el b/sx-networks.el index 3a33f1a..2be764f 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -53,9 +53,9 @@ none)) (defun sx-network--get-associated () - (sx-cache-get - 'network-user - '(sx-network--update))) + (or (sx-cache-get + 'network-user) + (sx-network--update)) (defun sx-network--update () "Update user information." @@ -102,7 +102,7 @@ list of sites the user is active on." (defvar sx-network--user-sites nil "List of sites where user already has an account.") -(provide sx-networks) +(provide 'sx-networks) ;;; sx-networks.el ends here ;; Local Variables: -- cgit v1.2.3 From 1715dfecb488bcfd487e1150adc92875aa2f8c10 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 07:26:51 -0500 Subject: Fixes as per github comments. (sx-network--get-associated): Ensure user-sites is also set when retrieving cache. (sx-network--ensure-user): Simplify. Used to ensure cache is loaded before attempting to use it. Fix quoted lambda in sx-network--map-site-url-to-site-api. --- sx-networks.el | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/sx-networks.el b/sx-networks.el index 2be764f..ead4d6d 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -53,15 +53,19 @@ none)) (defun sx-network--get-associated () - (or (sx-cache-get - 'network-user) - (sx-network--update)) + "Retrieve cached information for network user. + +If cache is not available, retrieve current data." + (or (and (sx-cache-get 'network-user) + (setq sx-network--user-sites + (sx-network--map-site-url-to-site-api))) + (sx-network--update))) (defun sx-network--update () "Update user information." (setq sx-network--user-information (sx-method-call "me/associated" - '((types . "main_site;meta_site")) + '((types . (main_site meta_site))) sx-network--user-filter 'warn)) (setq sx-network--user-sites (sx-network--map-site-url-to-site-api)) @@ -71,13 +75,9 @@ "Ensure user-cache is available. This should be called during initialization." - (cond - ((not sx-network--user-information) - (or (sx-network--get-associated) - (sx-network--update))) - ((not sx-network--user-sites) - (setq sx-network--user-sites - (sx-network--map-site-url-to-site-api))))) + ;; Cache was not retrieved, retrieve it. + (unless sx-network--user-information + (sx-network--get-associated))) (defun sx-network--map-site-url-to-site-api () "Convert `me/associations' to a set of `api_site_parameter's. @@ -90,10 +90,10 @@ list of sites the user is active on." (cdr (assoc 'api_site_parameter x)))) (sx-site--get-site-list)))) - (mapcar '(lambda (loc) - (let ((u-site (cdr (assoc 'site_url loc)))) - (when (member u-site (mapcar 'car sites-info)) - (cdr (assoc u-site sites-info))))) + (mapcar (lambda (loc) + (let ((u-site (cdr (assoc 'site_url loc)))) + (when (member u-site (mapcar 'car sites-info)) + (cdr (assoc u-site sites-info))))) sx-network--user-information))) (defvar sx-network--user-information nil -- cgit v1.2.3 From f813286cf44b8e1bdf7d2003f7f5b1fe870f613d Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 07:38:42 -0500 Subject: Fixes as per Github comments sx-favorites--user-favorite-list: Clarify docstring (sx-favorites--ensure-favorite-list): Remove extraneous argument --- sx-favorites.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/sx-favorites.el b/sx-favorites.el index 0b9527a..497ef1a 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -39,17 +39,18 @@ (defvar sx-favorites--user-favorite-list nil "Alist of questions favorited by the user. -Each element has the form (SITE FAVORITE-LIST). -And each element in FAVORITE-LIST has the form QUESTION_ID.") -(defun sx-favorites--ensure-favorite-list (site) +Each element has the form (SITE FAVORITE-LIST). And each element +in FAVORITE-LIST is the numerical QUESTION_ID.") + +(defun sx-favorites--ensure-favorite-list () (unless sx-favorites--user-favorite-list (setq sx-favorites--user-favorite-list (sx-cache-get 'question-favorites (let ((sites - (mapcar '(lambda (site) - `(,site)) + (mapcar (lambda (site) + `(,site)) sx-network--user-sites))) `(quote ,sites)))))) -- cgit v1.2.3 From a9a47da95ab06e3a68bfd037de51bead4855c1ea Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 07:42:08 -0500 Subject: (sx-favorites--update-site-favorites): Change from (list ..) to (cons ..). --- sx-favorites.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-favorites.el b/sx-favorites.el index 497ef1a..f5a8d6c 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -71,7 +71,7 @@ Writes list to cache QUESTION-FAVORITES." sx-favorites--user-favorite-list))) (if site-cell (setcdr site-cell (mapcar 'cdar favs)) - (push (list site favs) sx-favorites--user-favorite-list)) + (push (cons site favs) sx-favorites--user-favorite-list)) (sx-cache-set 'question-favorites sx-favorites--user-favorite-list))) (defun sx-favorites-update () -- cgit v1.2.3 From 16637550bff638552613aa241a023ad24e757a09 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 08:49:03 -0500 Subject: GH comment fixes: Correct file header. Use sharp quote for function. --- sx-favorites.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx-favorites.el b/sx-favorites.el index f5a8d6c..9412b5b 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -1,4 +1,4 @@ -;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*- +;;; sx-favorites.el --- Starred questions -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -70,7 +70,7 @@ Writes list to cache QUESTION-FAVORITES." (site-cell (assoc site sx-favorites--user-favorite-list))) (if site-cell - (setcdr site-cell (mapcar 'cdar favs)) + (setcdr site-cell (mapcar #'cdar favs)) (push (cons site favs) sx-favorites--user-favorite-list)) (sx-cache-set 'question-favorites sx-favorites--user-favorite-list))) -- cgit v1.2.3 From 876ab80a8b62214bb608716241c525ffc2ea0cf3 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 08:50:22 -0500 Subject: GH comment fix: Use sharp quote for function. --- sx-networks.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-networks.el b/sx-networks.el index ead4d6d..315daba 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -92,7 +92,7 @@ list of sites the user is active on." (sx-site--get-site-list)))) (mapcar (lambda (loc) (let ((u-site (cdr (assoc 'site_url loc)))) - (when (member u-site (mapcar 'car sites-info)) + (when (member u-site (mapcar #'car sites-info)) (cdr (assoc u-site sites-info))))) sx-network--user-information))) -- cgit v1.2.3 From bb2d155ef7ae73a00eba53ed7e0d1acee6c0902e Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 18 Nov 2014 16:35:19 +0000 Subject: Define sorted insertion macro. --- sx.el | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/sx.el b/sx.el index 64c555c..387c6bb 100644 --- a/sx.el +++ b/sx.el @@ -27,6 +27,21 @@ ;;; Utility Functions +(defmacro sx-sorted-insert-skip-first (newelt list &optional predicate) + "Inserted NEWELT into LIST sorted by PREDICATE. +This is designed for the (site id id ...) lists. So the first car +is intentionally skipped." + `(let ((tail ,list) + (x ,newelt)) + ;; The first element is never less-than. + (while (and + ;; We're at the end. + (cdr-safe tail) + ;; We're at the right place. + (,(or predicate #'<) x (cadr tail))) + (setq tail (cdr tail))) + (setcdr tail (cons x (cdr tail))))) + (defun sx-message (format-string &rest args) "Display a message" (message "[stack] %s" (apply #'format format-string args))) -- cgit v1.2.3 From bee6143c8abe0bc7bb6dad3d20ba539e29c4cc3c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 18 Nov 2014 16:35:34 +0000 Subject: Implement hidden question database Also improve read question code. --- sx-question.el | 52 +++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 49 insertions(+), 3 deletions(-) diff --git a/sx-question.el b/sx-question.el index fc44bd8..3906a28 100644 --- a/sx-question.el +++ b/sx-question.el @@ -66,6 +66,7 @@ ;;; Question Properties +;;;; Read/unread (defvar sx-question--user-read-list nil "Alist of questions read by the user. Each element has the form (SITE . QUESTION-LIST). @@ -76,7 +77,7 @@ And each element in QUESTION-LIST has the form (QUESTION_ID . LAST-VIEWED-DATE). If no cache exists for it, initialize one with SITE." (unless sx-question--user-read-list (setq sx-question--user-read-list - (sx-cache-get 'read-questions `(list ,site))))) + (sx-cache-get 'read-questions `'((,site)))))) (defun sx-question--read-p (question) "Non-nil if QUESTION has been read since last updated." @@ -102,13 +103,58 @@ If no cache exists for it, initialize one with SITE." ((setq cell (assoc .question_id site-cell)) (setcdr cell .last_activity_date)) ;; Question wasn't present. - (t - (setcdr site-cell (cons q-cell (cdr site-cell))))))) + (t + (sx-sorted-insert-skip-first + q-cell site-cell (lambda (x y) (> (car x) (car y)))))))) ;; This causes a small lag on `j' and `k' as the list gets large. ;; Should we do this on a timer? ;; Save the results. (sx-cache-set 'read-questions sx-question--user-read-list)) + +;;;; Hidden +(defvar sx-question--user-hidden-list nil + "Alist of questions hidden by the user. +Each element has the form (SITE . QUESTION-LIST). +And each element in QUESTION-LIST has the form (QUESTION_ID . LAST-VIEWED-DATE).") + +(defun sx-question--ensure-hidden-list (site) + "Ensure the `sx-question--user-hidden-list' has been read from cache. +If no cache exists for it, initialize one with SITE." + (unless sx-question--user-hidden-list + (setq sx-question--user-hidden-list + (sx-cache-get 'hidden-questions `'((,site)))))) + +(defun sx-question--hidden-p (question) + "Non-nil if QUESTION has been hidden." + (sx-assoc-let question + (sx-question--ensure-hidden-list .site) + (let ((ql (cdr (assoc .site sx-question--user-hidden-list)))) + (and ql (memq .question_id ql))))) + +(defun sx-question--mark-hidden (question) + "Mark QUESTION as being hidden." + (sx-assoc-let question + (sx-question--ensure-hidden-list .site) + (let ((site-cell (assoc .site sx-question--user-hidden-list)) + cell) + ;; If question already hidden, do nothing. + (unless (memq .question_id site-cell) + ;; First question from this site. + (if (null site-cell) + (push (list .site .question_id) sx-question--user-hidden-list) + ;; Question wasn't present. + ;; Add it in, but make sure it's sorted (just in case we need + ;; it later). + (sx-sorted-insert-skip-first .question_id site-cell >)) + ;; This causes a small lag on `j' and `k' as the list gets large. + ;; Should we do this on a timer? + ;; Save the results. + (sx-cache-set 'hidden-questions sx-question--user-hidden-list))))) + + +;;;; Other data + (defun sx-question--accepted-answer-id (question) "Return accepted answer in QUESTION, or nil if none." (sx-assoc-let question -- cgit v1.2.3 From 4eb4c2fc612e10c6a2c92bfc89a688ebce1a36e1 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 18 Nov 2014 16:44:17 +0000 Subject: Hidden question functionality implemented in the question list --- sx-question-list.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/sx-question-list.el b/sx-question-list.el index 72eabd3..0639f3c 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -132,8 +132,20 @@ Letters do not insert themselves; instead, they are commands. ("g" sx-question-list-refresh) (":" sx-question-list-switch-site) ("v" sx-question-list-visit) + ("h" sx-question-list-hide) ([?\r] sx-question-list-display-question))) +(defun sx-question-list-hide (data) + "Hide question under point. +Non-interactively, DATA is a question alist." + (interactive + (list (if (derived-mode-p 'sx-question-list-mode) + (tabulated-list-get-id) + (user-error "Not in `sx-question-list-mode'")))) + (sx-question--mark-hidden data) + (when (called-interactively-p 'any) + (sx-question-list-refresh 'redisplay 'noupdate))) + (defvar sx-question-list--current-page "Latest" ;; Other values (once we implement them) are "Top Voted", ;; "Unanswered", etc. @@ -197,7 +209,8 @@ a new list before redisplaying." (setq sx-question-list--current-dataset question-list) ;; Print the result. (setq tabulated-list-entries - (mapcar #'sx-question-list--print-info question-list))) + (mapcar #'sx-question-list--print-info + (cl-remove-if #'sx-question--hidden-p question-list)))) (when redisplay (tabulated-list-print 'remember))) (defun sx-question-list-visit (&optional data) -- cgit v1.2.3 From 6a1d561e3af81aaa67dd834192697e39e3e4bc5d Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 11:21:51 -0500 Subject: Fix logic for updating cache and setting variables. Turned (sx-network--ensure-user) into (sx-network--initialize) and added as hook for initialization. --- sx-networks.el | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/sx-networks.el b/sx-networks.el index 315daba..fbb2d78 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -56,28 +56,30 @@ "Retrieve cached information for network user. If cache is not available, retrieve current data." - (or (and (sx-cache-get 'network-user) - (setq sx-network--user-sites + (or (and (setq sx-network--user-information (sx-cache-get 'network-user) + sx-network--user-sites (sx-network--map-site-url-to-site-api))) (sx-network--update))) (defun sx-network--update () - "Update user information." - (setq sx-network--user-information - (sx-method-call "me/associated" - '((types . (main_site meta_site))) - sx-network--user-filter - 'warn)) - (setq sx-network--user-sites (sx-network--map-site-url-to-site-api)) - (sx-cache-set 'network-user sx-network--user-information)) - -(defun sx-network--ensure-user () + "Update user information. + +Sets cache and then uses `sx-network--get-associated' to update +the variables." + (sx-cache-set 'network-user + (sx-method-call "me/associated" + '((types . (main_site meta_site))) + sx-network--user-filter + 'warn)) + (sx-network--get-associated)) + +(defun sx-network--initialize () "Ensure user-cache is available. -This should be called during initialization." +Added as hook to initialization." ;; Cache was not retrieved, retrieve it. - (unless sx-network--user-information - (sx-network--get-associated))) + (sx-network--get-associated)) +(add-hook 'sx-init--internal-hook #'sx-network--initialize) (defun sx-network--map-site-url-to-site-api () "Convert `me/associations' to a set of `api_site_parameter's. -- cgit v1.2.3 From cb4d53d57f5ee68aced5ff1a73829eea8a2d662b Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 11:44:16 -0500 Subject: Correct naming of cache to correspond to sx-cache-get. --- sx-networks.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-networks.el b/sx-networks.el index fbb2d78..755d62c 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -74,7 +74,7 @@ the variables." (sx-network--get-associated)) (defun sx-network--initialize () - "Ensure user-cache is available. + "Ensure network-user cache is available. Added as hook to initialization." ;; Cache was not retrieved, retrieve it. -- cgit v1.2.3 From 8554d48ef764c8ca44438f35243a88f54f8386dc Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 11:44:54 -0500 Subject: Replace (sx-favorites--ensure-favorite-list) with (sx-favorites--initialize). Simplify initialization since it is run at startup rather than tested for by functions. Clean up (sx-favorites--update-site-favorites) to provide the same values for new sites as for existing. --- sx-favorites.el | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/sx-favorites.el b/sx-favorites.el index 9412b5b..3aa96dd 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -43,16 +43,15 @@ Each element has the form (SITE FAVORITE-LIST). And each element in FAVORITE-LIST is the numerical QUESTION_ID.") -(defun sx-favorites--ensure-favorite-list () - (unless sx-favorites--user-favorite-list - (setq sx-favorites--user-favorite-list - (sx-cache-get - 'question-favorites - (let ((sites - (mapcar (lambda (site) - `(,site)) - sx-network--user-sites))) - `(quote ,sites)))))) +(defun sx-favorites--initialize () + "Ensure question-favorites cache is available. + +Added as hook to initialization." + (or (setq sx-favorites--user-favorite-list + (sx-cache-get 'question-favorites)) + (sx-favorites-update))) +;; Append to ensure `sx-network--initialize is run before it. +(add-hook 'sx-init--internal-hook #'sx-favorites--initialize 'append) (defun sx-favorites--retrieve-favorites (site) "Obtain list of starred QUESTION_IDs for SITE." @@ -65,18 +64,17 @@ in FAVORITE-LIST is the numerical QUESTION_ID.") "Update list of starred QUESTION_IDs for SITE. Writes list to cache QUESTION-FAVORITES." - (sx-favorites--ensure-favorite-list site) - (let ((favs (sx-favorites--retrieve-favorites site)) - (site-cell (assoc site - sx-favorites--user-favorite-list))) + (let* ((favs (sx-favorites--retrieve-favorites site)) + (site-cell (assoc site + sx-favorites--user-favorite-list)) + (fav-cell (mapcar #'cdar favs))) (if site-cell - (setcdr site-cell (mapcar #'cdar favs)) - (push (cons site favs) sx-favorites--user-favorite-list)) + (setcdr site-cell fav-cell) + (push (cons site fav-cell) sx-favorites--user-favorite-list)) (sx-cache-set 'question-favorites sx-favorites--user-favorite-list))) (defun sx-favorites-update () "Update all sites retrieved from `sx-network--user-sites'." - (sx-network--ensure-user) (mapc #'sx-favorites--update-site-favorites sx-network--user-sites)) -- cgit v1.2.3 From d0be11905aea5d86705e86c6b5eed57d2f6bc218 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 12:40:26 -0500 Subject: Implements indication of starred questions in question-list `sx-question-list-favorite` inherits face from `sx-question-list-score-upvoted` Favorite is displayed using char \x2b26 WHITE MEDIUM DIAMOND. --- sx-question-list.el | 64 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 38 insertions(+), 26 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 72eabd3..dead68f 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -28,6 +28,7 @@ (require 'sx-site) (require 'sx-question) (require 'sx-question-mode) +(require 'sx-favorites) ;;; Customization @@ -86,6 +87,11 @@ "" :group 'sx-question-list-faces) +(defface sx-question-list-favorite + '((t :inherit sx-question-list-score-upvoted)) + "" + :group 'sx-question-list-faces) + ;;; Mode Definition (define-derived-mode sx-question-list-mode tabulated-list-mode "Question List" @@ -219,32 +225,38 @@ Used in the questions list to indicate a question was updated \"4d ago\"." (defun sx-question-list--print-info (data) "Convert `json-read' DATA into tabulated-list format." (sx-assoc-let data - (list - data - (vector - (list (int-to-string .score) - 'face (if .upvoted 'sx-question-list-score-upvoted - 'sx-question-list-score)) - (list (int-to-string .answer_count) - 'face (if (sx-question--accepted-answer-id data) - 'sx-question-list-answers-accepted - 'sx-question-list-answers)) - (concat - (propertize - .title - 'face (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 (sx-time-since .last_activity_date) - sx-question-list-ago-string) - 'face 'sx-question-list-date) - " " - (propertize (mapconcat #'sx-question--tag-format .tags " ") - 'face 'sx-question-list-tags) - (propertize " " 'display "\n")))))) + (let ((favorite (if (member .question_id + (assoc .site + sx-favorites--user-favorite-list)) + (if (char-displayable-p ?\x2b26) "\x2b26" "*") " "))) + (list + data + (vector + (list (int-to-string .score) + 'face (if .upvoted 'sx-question-list-score-upvoted + 'sx-question-list-score)) + (list (int-to-string .answer_count) + 'face (if (sx-question--accepted-answer-id data) + 'sx-question-list-answers-accepted + 'sx-question-list-answers)) + (concat + (propertize + .title + 'face (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 favorite 'face 'sx-question-list-favorite) + " " + (propertize (concat (sx-time-since .last_activity_date) + sx-question-list-ago-string) + 'face 'sx-question-list-date) + " " + (propertize (mapconcat #'sx-question--tag-format .tags " ") + 'face 'sx-question-list-tags) + (propertize " " 'display "\n"))))))) (defun sx-question-list-view-previous (n) "Hide this question, move to previous one, display it." -- cgit v1.2.3 From 13758581e7c8a5cbfcedb1b8c0eb4089a058ff80 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 14:28:15 -0500 Subject: Provide cache invalidation (sx-cache--invalidate): Invalidate provided cache. Allows for invalidating variables associated with cache using `makunbound`. Cache can be reinitialized using arg `init-method`. (sx-cache-invalidate-all): Invalidate all caches then call `sx-initialize` to reinitialize. Arg `save-auth` prevents access_token from being lost. --- sx-cache.el | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/sx-cache.el b/sx-cache.el index e3b356b..45b379c 100644 --- a/sx-cache.el +++ b/sx-cache.el @@ -67,6 +67,32 @@ DATA will be written as returned by `prin1'." (sx-cache-get-file-name cache)) data) +(defun sx-cache--invalidate (cache &optional vars init-method) + "Set cache CACHE to nil. + +VARS is a list of variables to set to unbind to ensure cache is +cleared. +If INIT-METHOD is defined, call it after all invalidation to +re-initialize the cache." + (sx-cache-set cache nil) + (mapc #'makunbound vars) + (funcall init-method)) + +(defun sx-cache-invalidate-all (&optional save-auth) + "Invalidate all caches using `sx-cache--invalidate'. + +Afterwards reinitialize caches using `sx-initialize'. + +If SAVE-AUTH is non-nil, do not clear AUTH cache." + (let ((caches (let ((default-directory sx-cache-directory)) + (file-expand-wildcards "*.el")))) + (when save-auth + (setq caches (remove-if (lambda (x) + (string= x "auth.el")) caches))) + (lwarn 'stack-mode :debug "Invalidating: %S" caches) + (mapc #'sx-cache--invalidate caches) + (sx-initialize 'force))) + (provide 'sx-cache) ;;; sx-cache.el ends here -- cgit v1.2.3 From b06364055527d93fcea18376befe060c28f97317 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 14:40:15 -0500 Subject: Fix docstring. --- sx-cache.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sx-cache.el b/sx-cache.el index 45b379c..1e64f4f 100644 --- a/sx-cache.el +++ b/sx-cache.el @@ -70,8 +70,7 @@ DATA will be written as returned by `prin1'." (defun sx-cache--invalidate (cache &optional vars init-method) "Set cache CACHE to nil. -VARS is a list of variables to set to unbind to ensure cache is -cleared. +VARS is a list of variables to unbind to ensure cache is cleared. If INIT-METHOD is defined, call it after all invalidation to re-initialize the cache." (sx-cache-set cache nil) -- cgit v1.2.3 From 2149a4c2375e9c73c85c7375565affe3212b6710 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 18 Nov 2014 19:50:48 +0000 Subject: QUICK-FIX: Link regexp Fixes #74 --- sx-question-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index fa58512..089ee12 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -443,7 +443,7 @@ If ID is nil, use ID2 instead." (save-match-data (goto-char (point-min)) (when (search-forward-regexp - (format (rx line-start (0+ blank) "[%s]:" (1+ blank) + (format (rx line-start (0+ blank) "[%s]:" (0+ blank) (group-n 1 (1+ (not blank)))) (or id id2)) nil t) -- cgit v1.2.3 From 7e3685bf944378c49738de2ee2c685af785806b6 Mon Sep 17 00:00:00 2001 From: Jonathan Leech-Pepin Date: Tue, 18 Nov 2014 14:52:38 -0500 Subject: Use `cl-remove-if` rather than `remove-if` --- sx-cache.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-cache.el b/sx-cache.el index 1e64f4f..a564a53 100644 --- a/sx-cache.el +++ b/sx-cache.el @@ -86,7 +86,7 @@ If SAVE-AUTH is non-nil, do not clear AUTH cache." (let ((caches (let ((default-directory sx-cache-directory)) (file-expand-wildcards "*.el")))) (when save-auth - (setq caches (remove-if (lambda (x) + (setq caches (cl-remove-if (lambda (x) (string= x "auth.el")) caches))) (lwarn 'stack-mode :debug "Invalidating: %S" caches) (mapc #'sx-cache--invalidate caches) -- cgit v1.2.3 From cc9e7d491808dda40a0f3f34f0b941f08ed460d8 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 19 Nov 2014 00:00:25 +0000 Subject: Mark as read with "m" Fixes #61 --- sx-question-list.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/sx-question-list.el b/sx-question-list.el index 7dd0d00..be088c8 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -139,6 +139,7 @@ Letters do not insert themselves; instead, they are commands. (":" sx-question-list-switch-site) ("v" sx-question-list-visit) ("h" sx-question-list-hide) + ("m" sx-question-list-mark-read) ([?\r] sx-question-list-display-question))) (defun sx-question-list-hide (data) @@ -152,6 +153,18 @@ Non-interactively, DATA is a question alist." (when (called-interactively-p 'any) (sx-question-list-refresh 'redisplay 'noupdate))) +(defun sx-question-list-mark-read (data) + "Mark as read question under point. +Non-interactively, DATA is a question alist." + (interactive + (list (if (derived-mode-p 'sx-question-list-mode) + (tabulated-list-get-id) + (user-error "Not in `sx-question-list-mode'")))) + (sx-question--mark-read data) + (sx-question-list-next 1) + (when (called-interactively-p 'any) + (sx-question-list-refresh 'redisplay 'noupdate))) + (defvar sx-question-list--current-page "Latest" ;; Other values (once we implement them) are "Top Voted", ;; "Unanswered", etc. -- cgit v1.2.3 From f74323d2679be6312c96b0ba1e4cc2fda5b4da50 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 19 Nov 2014 01:44:13 +0000 Subject: Add some package definitions. Also run checkdoc on sx.el --- sx.el | 43 +++++++++++++++++++++++++++++++------------ 1 file changed, 31 insertions(+), 12 deletions(-) diff --git a/sx.el b/sx.el index 387c6bb..4d06c95 100644 --- a/sx.el +++ b/sx.el @@ -1,8 +1,12 @@ -;;; sx.el --- core functions -*- lexical-binding: t; -*- +;;; sx.el --- Core functions of the sx package. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred ;; Author: Sean Allred +;; URL: https://github.com/vermiculus/stack-mode/ +;; Version: 0.1 +;; Keywords: help, hypermedia, tools +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3")) ;; 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 @@ -24,6 +28,22 @@ ;;; Code: +(defconst sx-version "0.1" "Version of the `sx' package.") + + +;;; User commands +(defun sx-version () + "Print and return the version of the `sx' package." + (interactive) + (message "%s: %s" 'sx-version sx-version) + sx-version) + +;;;###autoload +(defun sx-bug-report () + "File a bug report about the `sx' package." + (interactive) + (browse-url "https://github.com/vermiculus/stack-mode/issues/new")) + ;;; Utility Functions @@ -33,17 +53,15 @@ This is designed for the (site id id ...) lists. So the first car is intentionally skipped." `(let ((tail ,list) (x ,newelt)) - ;; The first element is never less-than. - (while (and - ;; We're at the end. + (while (and ;; We're not at the end. (cdr-safe tail) - ;; We're at the right place. + ;; We're not at the right place. (,(or predicate #'<) x (cadr tail))) (setq tail (cdr tail))) (setcdr tail (cons x (cdr tail))))) (defun sx-message (format-string &rest args) - "Display a message" + "Display a message." (message "[stack] %s" (apply #'format format-string args))) (defun sx-message-help-echo () @@ -52,8 +70,9 @@ is intentionally skipped." (when echo (message "%s" echo)))) (defun sx--thing-as-string (thing &optional sequence-sep) - "Return a string representation of THING. If THING is already -a string, just return it." + "Return a string representation of THING. +If THING is already a string, just return it. +Optional argument SEQUENCE-SEP is the separator applied between elements of a sequence." (cond ((stringp thing) thing) ((symbolp thing) (symbol-name thing)) @@ -63,7 +82,7 @@ a string, just return it." thing (if sequence-sep sequence-sep ";"))))) (defun sx--filter-data (data desired-tree) - "Filters DATA and returns the DESIRED-TREE" + "Filters DATA and return the DESIRED-TREE." (if (vectorp data) (apply #'vector (mapcar (lambda (entry) @@ -141,8 +160,8 @@ This is used internally to set initial values for variables such as filters.") (defun sx--< (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 `<'." + "Non-nil if PROPERTY attribute of alist X is less than that of Y. +With optional argument PRED, use it instead of `<'." (funcall (or pred #'<) (cdr (assoc property x)) (cdr (assoc property y)))) @@ -158,7 +177,7 @@ SETTER should be a function of two arguments. If SETTER is nil, (,(or setter #'setq) ,variable ,value)))) nil) -(defvar sx-initialized nil +(defvar sx-initialized nil "Nil if sx hasn't been initialized yet. If it has, holds the time at which initialization happened.") -- cgit v1.2.3 From 681319aeb250a83d982d1e3e02264a7af0ae4120 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 19 Nov 2014 02:06:18 +0000 Subject: Fix missing dependency --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 4d06c95..eab1ead 100644 --- a/sx.el +++ b/sx.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/vermiculus/stack-mode/ ;; Version: 0.1 ;; Keywords: help, hypermedia, tools -;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3")) +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0")) ;; 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 -- cgit v1.2.3