diff options
| -rw-r--r-- | sx-cache.el | 13 | ||||
| -rw-r--r-- | sx-filter.el | 2 | ||||
| -rw-r--r-- | sx-lto.el | 103 | ||||
| -rw-r--r-- | sx-network.el | 36 | ||||
| -rw-r--r-- | sx-question-list.el | 36 | ||||
| -rw-r--r-- | sx-question-mode.el | 253 | ||||
| -rw-r--r-- | sx-question.el | 72 | ||||
| -rw-r--r-- | sx-site.el | 45 | ||||
| -rw-r--r-- | sx.el | 31 |
9 files changed, 343 insertions, 248 deletions
diff --git a/sx-cache.el b/sx-cache.el index 098c292..e3b356b 100644 --- a/sx-cache.el +++ b/sx-cache.el @@ -38,18 +38,21 @@ (concat (symbol-name filename) ".el") sx-cache-directory)) -(defun sx-cache-get (cache) +(defun sx-cache-get (cache &optional form) "Return the data within CACHE. +If CACHE does not exist, evaluate FORM and set it to its return. + As with `sx-cache-set', CACHE is a file name within the context of `sx-cache-directory'." (unless (file-exists-p sx-cache-directory) (mkdir sx-cache-directory)) (let ((file (sx-cache-get-file-name cache))) - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents (sx-cache-get-file-name cache)) - (read (buffer-string)))))) + (if (file-exists-p file) + (with-temp-buffer + (insert-file-contents (sx-cache-get-file-name cache)) + (read (buffer-string))) + (sx-cache-set cache (eval form))))) (defun sx-cache-set (cache data) "Set the content of CACHE to DATA. diff --git a/sx-filter.el b/sx-filter.el index acd8fc1..90681e8 100644 --- a/sx-filter.el +++ b/sx-filter.el @@ -54,7 +54,7 @@ or string." "filter/create" keyword-arguments))) (sx-assoc-let (elt response 0) - (url-hexify-string .filter))))) + .filter)))) ;;; Storage and Retrieval diff --git a/sx-lto.el b/sx-lto.el deleted file mode 100644 index ad58570..0000000 --- a/sx-lto.el +++ /dev/null @@ -1,103 +0,0 @@ -;;; sx-lto.el --- lisp-to-org conversion functions -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Artur Malabarba - -;; Author: Artur Malabarba <bruce.connor.am@gmail.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: - - -;;; Requirements -(require 'sx) -(require 'org) - -(defun sx-lto--question (data) - "Return question DATA in a format acceptable by `org-element-interpret-data'. -DATA is a list of cons cells representing a question, as received -by the API and read by `json-read'." - `(headline (:title ,(cdr (assoc 'title data)) - :level 1 - :tags ,(mapcar #'identity (cdr (assoc 'tags data)))) - ,(sx-lto--question-answer data) - ,@(mapcar #'sx-lto--answer (cdr (assoc 'answers data))))) - -(defun sx-lto--answer (data) - "Return answer DATA in a format acceptable by `org-element-interpret-data'. -DATA is a list of cons cells representing a question, as received -by the API and read by `json-read'." - ;; Right now this doesn't do anything special. But it should check - ;; whether the answer is accepted. How do we display that? - `(headline (:title "Answer" :level 2) - ,(sx-lto--question-answer data))) - -(defun sx-lto--question-answer (data) - "Process and return the elements of DATA which questions and answers have in common." - (let ((comments - (mapcar #'sx-lto--comment (cdr (assoc 'comments data))))) - `(;; Body as a src block (really NOT nice). - (src-block (:value ,(sx-lto--body data) - . ,sx-lto--body-src-block)) - ;; Comments as descriptive lists. If there are no comments, an - ;; empty list would throw an error. - ,@(when comments `((plain-list (:type descriptive) ,comments)))))) - - -;;; Body rendering -(defvar sx-lto--body-src-block - '(:language "markdown" :switches nil :parameters nil :hiddenp nil) - "Properties used on the markdown src-block which represents the body.") - -(defface sx-lto-body - '((((background light)) :background "Grey90") - (((background dark)) :background "Grey10")) - "Face used on the body content of questions and answers." - :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 'sx) - -(defun sx-lto--body (data) - "Get and cleanup `body_markdown' from DATA." - (concat - (replace-regexp-in-string - "\r\n" "\n" (cdr (assoc 'body_markdown data))) - "\n")) - -;; We need to add padding in case the body contains a * at column 1 -;; (which would break org-mode). -(defvar sx-lto--padding - (propertize " " 'display " ") - "Left-padding added to each line of a body.") - -(defvar sx-lto-comment-item - '(:bullet "- " :checkbox nil :counter nil :hiddenp nil) - "Properties used on the items which represent comments.") - -(defun sx-lto--comment (data) - "" - (let* ((owner (cdr (assoc 'owner data))) - (owner-name (cdr (assoc 'display_name owner)))) - `(item (:tag ,owner-name . ,sx-lto-comment-item) - (paragraph () ,(cdr (assoc 'body_markdown data)))))) - -(provide 'sx-lto) -;;; sx.el ends here diff --git a/sx-network.el b/sx-network.el deleted file mode 100644 index f756a26..0000000 --- a/sx-network.el +++ /dev/null @@ -1,36 +0,0 @@ -;;; sx-network.el --- browsing networks -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Sean Allred - -;; Author: Sean Allred <code@seanallred.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 'sx-request) - -(defun sx-network-get-networks () - (sx-request-make "sites")) - -(provide 'sx-network) -;;; sx-network.el ends here - -;; Local Variables: -;; indent-tabs-mode: nil -;; End: diff --git a/sx-question-list.el b/sx-question-list.el index a1dec7a..72eabd3 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -51,11 +51,7 @@ :group 'sx-question-list-faces) (defface sx-question-list-answers-accepted - '((((background light)) :background "YellowGreen" - :inherit sx-question-list-answers) - (((background dark)) :background "DarkOliveGreen" - :inherit sx-question-list-answers) - (t :inherit sx-question-list-answers)) + '((t :underline t :overline t :inherit sx-question-list-answers)) "" :group 'sx-question-list-faces) @@ -122,7 +118,7 @@ Letters do not insert themselves; instead, they are commands. (defun sx-question-list--date-more-recent-p (x y) "Non-nil if tabulated-entry X is newer than Y." - (sx-question--< + (sx--< sx-question-list-date-sort-method (car x) (car y) #'>)) @@ -187,10 +183,10 @@ Letters do not insert themselves; instead, they are commands. (defun sx-question-list-refresh (&optional redisplay no-update) "Update the list of questions. -If REDISPLAY is non-nil, also call `tabulated-list-print'. +If REDISPLAY is non-nil (or if interactive), also call `tabulated-list-print'. If the prefix argument NO-UPDATE is nil, query StackExchange for a new list before redisplaying." - (interactive "pP") + (interactive "p\nP") ;; Reset the mode-line unread count (we rebuild it here). (setq sx-question-list--unread-count 0) (let ((question-list @@ -210,7 +206,9 @@ a new list before redisplaying." (unless data (setq data (tabulated-list-get-id))) (unless data (error "No question here!")) (sx-assoc-let data - (browse-url .link))) + (browse-url .link)) + (sx-question--mark-read data) + (sx-question-list-refresh 'redisplay 'no-update)) (defcustom sx-question-list-ago-string " ago" "String appended to descriptions of the time since something happened. @@ -228,13 +226,13 @@ Used in the questions list to indicate a question was updated \"4d ago\"." 'face (if .upvoted 'sx-question-list-score-upvoted 'sx-question-list-score)) (list (int-to-string .answer_count) - 'face (if (sx-question--accepted-answer .data) + '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) + '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) @@ -278,14 +276,15 @@ focus the relevant window." (interactive '(nil t)) (unless data (setq data (tabulated-list-get-id))) (unless data (error "No question here!")) - (when (sx-question--read-p data) + (unless (sx-question--read-p data) (cl-decf sx-question-list--unread-count) - (sx-question--mark-read data)) + (sx-question--mark-read data) + (sx-question-list-refresh 'redisplay 'no-update)) (unless (and (window-live-p sx-question-mode--window) (null (equal sx-question-mode--window (selected-window)))) (setq sx-question-mode--window (condition-case er - (split-window-below sx-question-list-height) + (split-window (selected-window) sx-question-list-height 'below) (error ;; If the window is too small to split, use current one. (if (string-match @@ -293,7 +292,15 @@ focus the relevant window." (car (cdr-safe er))) nil (error (cdr er))))))) + ;; Display the question. (sx-question-mode--display data sx-question-mode--window) + ;; Configure the window to be closed on `q'. + (set-window-prev-buffers sx-question-mode--window nil) + (set-window-parameter + sx-question-mode--window + 'quit-restore + ;; See https://www.gnu.org/software/emacs/manual/html_node/elisp/Window-Parameters.html#Window-Parameters + `(window window ,(selected-window) ,sx-question-mode--buffer)) (when focus (if sx-question-mode--window (select-window sx-question-mode--window) @@ -316,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*"))) diff --git a/sx-question-mode.el b/sx-question-mode.el index 20d3035..03647bc 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -24,6 +24,8 @@ ;;; Code: (require 'markdown-mode) +(eval-when-compile + (require 'rx)) (require 'sx) (require 'sx-question) @@ -157,7 +159,7 @@ editor's name." :group 'sx-question-mode) (defcustom sx-question-mode-separator - (concat "\n" (make-string 80 ?_) "\n") + (concat (make-string 80 ?_) "\n") "Separator used between header and body." :type 'string :group 'sx-question-mode) @@ -179,11 +181,14 @@ Second \"%s\" is replaced with the comment." :type 'string :group 'sx-question-mode) +(defcustom sx-question-mode-pretty-links t + "If non-nil, markdown links are displayed in a compact form." + :type 'boolean + :group 'sx-question-mode) + ;;; Printing a question's content ;;;; Functions -;; This is where most of the work is still left to be done! Need to -;; insert more data from QUESTION. (defun sx-question-mode--print-question (question) "Print a buffer describing QUESTION. QUESTION must be a data structure returned by `json-read'." @@ -198,29 +203,42 @@ QUESTION must be a data structure returned by `json-read'." (with-selected-window sx-question-mode--window (sx-question-mode-next-section))) +(defvar sx-question-mode--section-help-echo + (format + (propertize "%s to hide/display content" 'face 'minibuffer-prompt) + (propertize "RET" 'face 'font-lock-function-name-face)) + "") + +(defvar sx-question-mode--title-properties + `(face sx-question-mode-title + action sx-question-mode-hide-show-section + help-echo ,sx-question-mode--section-help-echo + button t + follow-link t) + "") + (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 - (if .title - ;; Questions have title - (propertize - .title - 'font-lock-face 'sx-question-mode-title - 'sx-question-mode--section 1) - ;; Answers don't - (propertize - sx-question-mode-answer-title - 'font-lock-face 'sx-question-mode-title - 'sx-question-mode--section 2))) + (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--propertized-display-name .owner) + (sx-question-mode--propertize-display-name .owner) 'sx-question-mode-author ;; Date sx-question-mode-header-date @@ -229,7 +247,7 @@ DATA can represent a question or an answer." (when .last_edit_date (format sx-question-mode-last-edit-format (sx-time-since .last_edit_date) - (sx-question-mode--propertized-display-name .last_editor)))) + (sx-question-mode--propertize-display-name .last_editor)))) 'sx-question-mode-date) (when .title ;; Tags @@ -238,23 +256,25 @@ DATA can represent a question or an answer." (mapconcat #'sx-question--tag-format .tags " ") 'sx-question-mode-tags)) ;; Body - (insert (propertize sx-question-mode-separator - 'face 'sx-question-mode-header)) + (insert "\n" + (propertize sx-question-mode-separator + 'face 'sx-question-mode-header + 'sx-question-mode--section 4)) (sx-question-mode--wrap-in-overlay '(face sx-question-mode-content-face) (insert "\n" - (sx-question-mode--fill-string + (sx-question-mode--fill-and-fontify .body_markdown) (propertize sx-question-mode-separator 'face 'sx-question-mode-header)))) ;; Comments (when .comments - (insert - "\n" - (propertize - sx-question-mode-comments-title - 'font-lock-face 'sx-question-mode-title-comments - 'sx-question-mode--section 3)) + (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") @@ -262,23 +282,11 @@ DATA can represent a question or an answer." '(face sx-question-mode-content-face) (mapc #'sx-question-mode--print-comment .comments)))))) -(defun sx-question-mode--fill-string (text) - "Fill TEXT according to `markdown-mode' and return it." - (with-temp-buffer - (insert text) - (markdown-mode) - (goto-char (point-min)) - ;; ;; Do something here - ;; (while (null (eobp)) - ;; (skip-chars-forward "\r\n[:blank:]") - ;; (markdown-pre-region)) - (buffer-string))) - -(defun sx-question-mode--propertized-display-name (author) +(defun sx-question-mode--propertize-display-name (author) "Return display_name of AUTHOR with `sx-question-mode-author' face." (sx-assoc-let author (propertize .display_name - 'font-lock-face 'sx-question-mode-author))) + 'face 'sx-question-mode-author))) (defun sx-question-mode--print-comment (data) "Print the comment described by alist DATA." @@ -286,11 +294,11 @@ DATA can represent a question or an answer." (insert (format sx-question-mode-comments-format - (sx-question-mode--propertized-display-name .owner) + (sx-question-mode--propertize-display-name .owner) (substring ;; We fill with three spaces at the start, so the comment is ;; slightly indented. - (sx-question-mode--fill-string + (sx-question-mode--fill-and-fontify (concat " " .body_markdown)) ;; Then we remove the spaces from the first line, since we'll ;; add the username there anyway. @@ -317,8 +325,121 @@ HEADER is given `sx-question-mode-header' face, and value is given FACE. \(fn header value face [header value face] [header value face] ...)" (while args (insert - (propertize (pop args) 'font-lock-face 'sx-question-mode-header) - (propertize (pop args) 'font-lock-face (pop args))))) + (propertize (pop args) 'face 'sx-question-mode-header) + (propertize (pop args) 'face (pop args))))) + + +;;;;; Font-locking the content +(defvar sx-question-mode-bullet-appearance + (propertize (if (char-displayable-p ?•) " •" " *") + 'face 'markdown-list-face) + "String to be displayed as the bullet of markdown list items.") + +(defun sx-question-mode--fill-and-fontify (text) + "Fill TEXT according to `markdown-mode' and return it." + (with-temp-buffer + (erase-buffer) + (insert text) + (markdown-mode) + (font-lock-mode -1) + (when sx-question-mode-bullet-appearance + (font-lock-add-keywords ;; Bullet items. + nil + `((,(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) + (group-n 1 (and "@" (1+ (or (syntax word) (syntax symbol))))) + symbol-end) + 1 font-lock-builtin-face))) + ;; Everything. + (font-lock-fontify-region (point-min) (point-max)) + ;; Compact links. + (sx-question-mode--process-links-in-buffer) + ;; And now the filling + (goto-char (point-min)) + (while (null (eobp)) + ;; Don't fill pre blocks. + (unless (sx-question-mode--move-over-pre) + (skip-chars-forward "\r\n[:blank:]") + (fill-paragraph) + (forward-paragraph))) + (buffer-string))) + +(defvar sx-question-mode--link-regexp + ;; Done at compile time. + (rx "[" (group-n 1 (1+ (not (any "]")))) "]" + (or (and "(" (group-n 2 (1+ (not (any ")")))) ")") + (and "[" (group-n 3 (1+ (not (any "]")))) "]"))) + "Regexp matching markdown links.") + +(defun sx-question-mode--process-links-in-buffer () + "Turn all markdown links in this buffer into compact format." + (save-excursion + (goto-char (point-min)) + (while (search-forward-regexp sx-question-mode--link-regexp nil t) + (let* ((text (match-string-no-properties 1)) + (url (or (match-string-no-properties 2) + (sx-question-mode-find-reference + (match-string-no-properties 3) + text)))) + (replace-match + (sx-question-mode--propertize-link + (if sx-question-mode-pretty-links + text + (match-string-no-properties 0)) + url) + :fixedcase :literal nil 0))))) + +(defun sx-question-mode--propertize-link (text url) + "Return a link propertized version of string TEXT. +URL is used as 'help-echo and 'url properties." + (propertize + text + ;; Mouse-over + 'help-echo (format + (propertize "URL: %s, %s to visit" 'face 'minibuffer-prompt) + (propertize url 'face 'default) + (propertize "RET" 'face 'font-lock-function-name-face)) + ;; In case we need it. + 'url url + ;; Decoration + 'face 'link + 'mouse-face 'highlight + ;; So RET works + 'button t + ;; So mouse works + 'follow-link t + ;; What RET calls + 'action #'sx-question-mode-follow-link)) + +(defun sx-question-mode-follow-link (&optional pos) + "Follow link at POS or point" + (interactive) + (browse-url + (or (get-text-property (or pos (point)) 'url) + (error "No url under point: %s" (or pos (point)))))) + +(defun sx-question-mode-find-reference (id &optional id2) + "Find url identified by reference ID in current buffer. +If ID is nil, use ID2 instead." + (save-excursion + (save-match-data + (goto-char (point-min)) + (when (search-forward-regexp + (format (rx line-start (0+ blank) "[%s]:" (1+ blank) + (group-n 1 (1+ (not blank)))) + (or id id2)) + nil t) + (match-string-no-properties 1))))) + +(defun sx-question-mode--move-over-pre () + "Non-nil if paragraph at point can be filled." + (markdown-match-pre-blocks + (save-excursion + (skip-chars-forward "\r\n[:blank:]") + (point)))) ;;; Movement commands @@ -341,18 +462,23 @@ If nil, no recentering is performed." "Move down to next section (question or answer) of this buffer. Prefix argument N moves N sections down or up." (interactive "p") - (unless n (setq n 1)) - (dotimes (_ (abs n)) - ;; This will either move us to the next section, or move out of - ;; the current one. - (unless (sx-question-mode--goto-propety-change 'section n) - ;; If all we did was move out the current one, then move again - ;; and we're guaranteed to reach the next section. - (sx-question-mode--goto-propety-change 'section n))) + (let ((count (if n (abs n) 1))) + (while (> count 0) + ;; This will either move us to the next section, or move out of + ;; the current one. + (unless (sx-question-mode--goto-property-change 'section n) + ;; If all we did was move out the current one, then move again + ;; and we're guaranteed to reach the next section. + (sx-question-mode--goto-property-change 'section n)) + (let ((ov (car-safe (sx-question-mode--section-overlays-at (point))))) + (unless (and (overlayp ov) + (overlay-get ov 'invisible)) + (cl-decf count))))) (when sx-question-mode-recenter-line (let ((ov (car-safe (sx-question-mode--section-overlays-at (line-end-position))))) (when (and (overlayp ov) (> (overlay-end ov) (window-end))) - (recenter sx-question-mode-recenter-line))))) + (recenter sx-question-mode-recenter-line)))) + (sx-message-help-echo)) (defun sx-question-mode-previous-section (&optional n) "Move down to previous section (question or answer) of this buffer. @@ -360,8 +486,8 @@ Prefix argument N moves N sections up or down." (interactive "p") (sx-question-mode-next-section (- (or n 1)))) -(defun sx-question-mode--goto-propety-change (prop &optional direction) - "Move forward until the value of text-property `sx-question-mode--PROP' changes. +(defun sx-question-mode--goto-property-change (prop &optional direction) + "Move forward until the value of text-property sx-question-mode--PROP changes. Return the new value of PROP at point. If DIRECTION is negative, move backwards instead." (let ((prop (intern (format "sx-question-mode--%s" prop))) @@ -375,8 +501,8 @@ If DIRECTION is negative, move backwards instead." (goto-char (funcall func (point) prop nil limit)) (get-text-property (point) prop))) - -(defun sx-question-mode-hide-show-section () +;;; Optional argument is for `push-button'. +(defun sx-question-mode-hide-show-section (&optional _) "Hide or show section under point." (interactive) (let ((ov (car (or (sx-question-mode--section-overlays-at (point)) @@ -400,6 +526,13 @@ If DIRECTION is negative, move backwards instead." Letters do not insert themselves; instead, they are commands. \\<sx-question-mode> \\{sx-question-mode}" + ;; Determine how to close this window. + (unless (window-parameter nil 'quit-restore) + (set-window-parameter + nil 'quit-restore + `(other window nil ,(current-buffer)))) + ;; We call font-lock-region manually. See `sx-question-mode--fill-and-fontify' + (font-lock-mode -1) (remove-hook 'after-change-functions 'markdown-check-change-for-wiki-link t) (remove-hook 'window-configuration-change-hook 'markdown-fontify-buffer-wiki-links t) @@ -410,14 +543,16 @@ Letters do not insert themselves; instead, they are commands. (car x) (cadr x))) `(("n" sx-question-mode-next-section) ("p" sx-question-mode-previous-section) - ("j" sx-question-mode-next-section) - ("k" sx-question-mode-previous-section) ("g" sx-question-mode-refresh) ("q" quit-window) (" " scroll-up-command) (,(kbd "S-SPC") scroll-down-command) ([backspace] scroll-down-command) - ([tab] sx-question-mode-hide-show-section))) + ([tab] forward-button) + (,(kbd "<S-iso-lefttab>") backward-button) + (,(kbd "<S-tab>") backward-button) + (,(kbd "<backtab>") backward-button) + ([return] push-button))) (defun sx-question-mode-refresh () "Refresh currently displayed question. diff --git a/sx-question.el b/sx-question.el index d15cc80..fc44bd8 100644 --- a/sx-question.el +++ b/sx-question.el @@ -26,7 +26,6 @@ (require 'sx) (require 'sx-filter) -(require 'sx-lto) (require 'sx-method) (defvar sx-question-browse-filter @@ -34,6 +33,7 @@ question.comments question.answers question.last_editor + question.accepted_answer_id user.display_name comment.owner comment.body_markdown @@ -46,11 +46,13 @@ (defun sx-question-get-questions (site &optional page) "Get the page PAGE of questions from SITE." - (sx-method-call - "questions" - `((site . ,site) - (page . ,page)) - sx-question-browse-filter)) + (mapcar + (lambda (question) (cons (cons 'site site) question)) + (sx-method-call + "questions" + `((site . ,site) + (page . ,page)) + sx-question-browse-filter))) (defun sx-question-get-question (site id) "Get the question ID from SITE." @@ -64,26 +66,54 @@ ;;; Question Properties +(defvar sx-question--user-read-list nil + "Alist of questions read 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-read-list (site) + "Ensure the `sx-question--user-read-list' has been read from cache. +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))))) + (defun sx-question--read-p (question) "Non-nil if QUESTION has been read since last updated." - ;; @TODO: - (cl-evenp (random))) - -(defun sx-question--accepted-answer (question) - "Return accepted answer in QUESTION, or nil if none." - ;; @TODO: - (cl-evenp (random))) + (sx-assoc-let question + (sx-question--ensure-read-list .site) + (let ((ql (cdr (assoc .site sx-question--user-read-list)))) + (and ql + (>= (or (cdr (assoc .question_id ql)) 0) + .last_activity_date))))) (defun sx-question--mark-read (question) "Mark QUESTION as being read, until it is updated again." - nil) - -(defun sx-question--< (property x y &optional pred) - "Non-nil if PROPERTY attribute of question X is less than that of Y. -With optional argument predicate, use it instead of `<'." - (funcall (or pred #'<) - (cdr (assoc property x)) - (cdr (assoc property y)))) + (sx-assoc-let question + (sx-question--ensure-read-list .site) + (let ((site-cell (assoc .site sx-question--user-read-list)) + (q-cell (cons .question_id .last_activity_date)) + cell) + (cond + ;; First question from this site. + ((null site-cell) + (push (list .site q-cell) sx-question--user-read-list)) + ;; Question already has an older time. + ((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))))))) + ;; 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)) + +(defun sx-question--accepted-answer-id (question) + "Return accepted answer in QUESTION, or nil if none." + (sx-assoc-let question + (and (integerp .accepted_answer_id) + .accepted_answer_id))) (defun sx-question--tag-format (tag) "Formats TAG for display" @@ -1,4 +1,4 @@ -;;; sx-site.el --- site functions +;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -19,16 +19,53 @@ ;;; Commentary: -;; +;; ;;; Code: -;;; @TODO use new caching system implemented in branch `network-list' +(require 'sx-method) +(require 'sx-cache) + +(defvar sx-site-browse-filter + '((.backoff + .error_id + .error_message + .error_name + .has_more + .items + .quota_max + .quota_remaining + site.site_type + site.name + site.site_url + site.api_site_parameter + site.related_sites + related_site.api_site_parameter + related_site.relation) + nil + none)) + +(defun sx-site--get-site-list () + (sx-cache-get + 'site-list + '(sx-method-call + "sites" '((pagesize . 999)) + sx-site-browse-filter))) + +(defcustom sx-site-favorites + nil + "Favorite sites." + :group 'sx-site) + (defun sx-site-get-api-tokens () "Return a list of all known site tokens." (mapcar (lambda (site) (cdr (assoc 'api_site_parameter site))) - (sx-method-call "sites" '((pagesize . 9999))))) + (sx-site--get-site-list))) (provide 'sx-site) ;;; sx-site.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: @@ -31,6 +31,11 @@ "Display a message" (message "[stack] %s" (apply #'format format-string args))) +(defun sx-message-help-echo () + "If there's a 'help-echo property under point, message it." + (let ((echo (get-text-property (point) 'help-echo))) + (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." @@ -106,7 +111,7 @@ is equivalent to (debug t)) (let ((symbol-alist (sx--deep-dot-search body))) `(let ,(mapcar (lambda (x) `(,(car x) (cdr (assoc ',(cdr x) ,alist)))) - symbol-alist) + (delete-dups symbol-alist)) ,@body))) (defcustom sx-init-hook nil @@ -120,6 +125,13 @@ Run after `sx-init--internal-hook'.") 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 `<'." + (funcall (or pred #'<) + (cdr (assoc property x)) + (cdr (assoc property y)))) + (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, @@ -131,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 |