diff options
Diffstat (limited to 'sx-question-list.el')
| -rw-r--r-- | sx-question-list.el | 297 |
1 files changed, 297 insertions, 0 deletions
diff --git a/sx-question-list.el b/sx-question-list.el new file mode 100644 index 0000000..81d7cd5 --- /dev/null +++ b/sx-question-list.el @@ -0,0 +1,297 @@ +;;; stack-question-list.el --- Major-mode for navigating questions list. -*- 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: +(require 'stack-question) +(require 'tabulated-list) +(require 'cl-lib) + + +;;; Customization +(defcustom stack-question-list-height 12 + "Height, in lines, of stack-mode's *question-list* buffer." + :type 'integer + :group 'stack-question-list) + +(defface stack-question-list-parent + '((t :inherit default)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-answers + '((((background light)) :foreground "SeaGreen4" + :height 1.0 :inherit stack-question-list-parent) + (((background dark)) :foreground "#D1FA71" + :height 1.0 :inherit stack-question-list-parent) + (t :inherit stack-question-list-parent)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-answers-accepted + '((((background light)) :background "YellowGreen" + :inherit stack-question-list-answers) + (((background dark)) :background "DarkOliveGreen" + :inherit stack-question-list-answers) + (t :inherit stack-question-list-answers)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-score + '((t :height 1.0 :inherit stack-question-list-parent)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-score-upvoted + '((t :weight bold + :inherit stack-question-list-score)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-tags + '((t :inherit font-lock-function-name-face)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-date + '((t :inherit font-lock-comment-face)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-read-question + '((t :height 1.0 :inherit stack-question-list-parent)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-unread-question + '((t :weight bold :inherit stack-question-list-read-question)) + "" + :group 'stack-question-list-faces) + + +;;; Mode Definition +(define-derived-mode stack-question-list-mode tabulated-list-mode "Question List" + "Major mode for browsing a list of questions from stack-exchange. +Letters do not insert themselves; instead, they are commands. +\\<stack-question-list> +\\{stack-question-list}" + (hl-line-mode 1) + (stack-question-list--update-mode-line) + (setq tabulated-list-format + [(" V" 3 t :right-align t) + (" A" 3 t :right-align t) + ("Title" 0 stack-question-list--date-more-recent-p)]) + (setq tabulated-list-padding 1) + ;; Sorting by title actually sorts by date. It's what we want, but + ;; it's not terribly intuitive. + (setq tabulated-list-sort-key '("Title" . nil)) + (add-hook 'tabulated-list-revert-hook + #'stack-question-list-refresh nil t) + (add-hook 'tabulated-list-revert-hook + #'stack-question-list--update-mode-line nil t) + (tabulated-list-init-header)) + +(defcustom stack-question-list-date-sort-method 'last_activity_date + "Parameter which controls date sorting." + ;; This should be made into a (choice ...) of constants. + :type 'symbol + ;; Add a setter to protect the value. + :group 'stack-question-list) + +(defun stack-question-list--date-more-recent-p (x y) + "Non-nil if tabulated-entry X is newer than Y." + (stack-question--< + stack-question-list-date-sort-method + (car x) (car y) #'>)) + +(mapc + (lambda (x) (define-key stack-question-list-mode-map + (car x) (cadr x))) + '(("n" stack-question-list-next) + ("p" stack-question-list-previous) + ("j" stack-question-list-view-next) + ("k" stack-question-list-view-previous) + ("g" stack-question-list-refresh) + ([?\r] stack-question-list-display-question))) + +(defvar stack-question-list--current-page "Latest" + ;; Other values (once we implement them) are "Top Voted", + ;; "Unanswered", etc. + "Variable describing current page being viewed.") + +(defvar stack-question-list--unread-count 0 + "Holds the number of unread questions in the current buffer.") +(make-variable-buffer-local 'stack-question-list--unread-count) + +(defvar stack-question-list--total-count 0 + "Holds the total number of questions in the current buffer.") +(make-variable-buffer-local 'stack-question-list--total-count) + +(defconst stack-question-list--mode-line-format + '(" " + mode-name + " " + (:propertize stack-question-list--current-page + face mode-line-buffer-id) + " [" + "Unread: " + (:propertize + (:eval (int-to-string stack-question-list--unread-count)) + face mode-line-buffer-id) + ", " + "Total: " + (:propertize + (:eval (int-to-string stack-question-list--total-count)) + face mode-line-buffer-id) + "] ") + "Mode-line construct to use in question-list buffers.") + +(defun stack-question-list--update-mode-line () + "Fill the mode-line with useful information." + ;; All the data we need is right in the buffer. + (when (derived-mode-p 'stack-question-list-mode) + (setq mode-line-format + stack-question-list--mode-line-format) + (setq stack-question-list--total-count + (length tabulated-list-entries)))) + +(defvar stack-question-list--current-site "emacs" + "Site being displayed in the *question-list* buffer.") + +(defun stack-question-list-refresh (&optional redisplay no-update) + "Update the list of questions. +If REDISPLAY is non-nil, also call `tabulated-list-print'. +If the prefix argument NO-UPDATE is nil, query stack-exchange for +a new list before redisplaying." + (interactive "pP") + ;; Reset the mode-line unread count (we rebuild it here). + (setq stack-question-list--unread-count 0) + (let ((question-list (stack-question-get-questions + stack-question-list--current-site))) + ;; Print the result. + (setq tabulated-list-entries + (mapcar #'stack-question-list--print-info question-list))) + (when redisplay (tabulated-list-print 'remember))) + +(defcustom stack-question-list-ago-string " ago" + "String appended to descriptions of the time since something happened. +Used in the questions list to indicate a question was updated \"4d ago\"." + :type 'string + :group 'stack-question-list) + +(defun stack-question-list--print-info (data) + "Convert `json-read' DATA into tabulated-list format." + (list + data + (vector + (list (int-to-string (cdr (assoc 'score data))) + 'face + (if (cdr (assoc 'upvoted data)) 'stack-question-list-score-upvoted + 'stack-question-list-score)) + (list (int-to-string (cdr (assoc 'answer_count data))) + 'face + (if (stack-question--accepted-answer data) + 'stack-question-list-answers-accepted + 'stack-question-list-answers)) + (concat + (propertize + (cdr (assoc 'title data)) + 'face + (if (stack-question--read-p data) + 'stack-question-list-read-question + ;; Increment `stack-question-list--unread-count' for the mode-line. + (cl-incf stack-question-list--unread-count) + 'stack-question-list-unread-question)) + (propertize " " 'display "\n ") + (propertize (concat (stack--time-since (cdr (assoc 'last_activity_date data))) + stack-question-list-ago-string) + 'face 'stack-question-list-date) + (propertize (concat " [" (mapconcat #'identity (cdr (assoc 'tags data)) "] [") "]") + 'face 'stack-question-list-tags) + (propertize " " 'display "\n"))))) + +(defun stack-question-list-view-previous (n) + "Hide this question, move to previous one, display it." + (interactive "p") + (stack-question-list-view-next (- n))) + +(defun stack-question-list-view-next (n) + "Hide this question, move to next one, display it." + (interactive "p") + (stack-question-list-next n) + (stack-question-list-display-question)) + +(defun stack-question-list-next (n) + "Move to the next entry." + (interactive "p") + (forward-line n)) + +(defun stack-question-list-previous (n) + "Move to the previous entry." + (interactive "p") + (stack-question-list-next (- n))) + +(defun stack-question-list-display-question (&optional data focus) + "Display question given by DATA. +If called interactively (or with DATA being nil), display +question under point. +Also when called interactively (or when FOCUS is non-nil), also +focus the relevant window." + (interactive '(nil t)) + (unless data (setq data (tabulated-list-get-id))) + (unless data (error "No question here!")) + (when (stack-question--read-p data) + (cl-decf stack-question-list--unread-count) + (stack-question--mark-read data)) + (unless (window-live-p stack-question--window) + (setq stack-question--window + (condition-case er + (split-window-below stack-question-list-height) + (error + ;; If the window is too small to split, use current one. + (if (string-match + "Window #<window .*> too small for splitting" + (car (cdr-safe er))) + nil + (error (cdr er))))))) + (stack-question--display data stack-question--window) + (when focus + (if stack-question--window + (select-window stack-question--window) + (switch-to-buffer stack-question--buffer)))) + +(defvar stack-question-list--buffer nil + "Buffer where the list of questions is displayed.") + +(defun list-questions (no-update) + "Display a list of stack-exchange questions." + (interactive "P") + (unless (buffer-live-p stack-question-list--buffer) + (setq stack-question-list--buffer + (generate-new-buffer "*question-list*"))) + (with-current-buffer stack-question-list--buffer + (stack-question-list-mode) + (stack-question-list-refresh 'redisplay no-update)) + (switch-to-buffer stack-question-list--buffer)) + +(defalias 'stack-list-questions #'list-questions) + +(provide 'stack-question-list) +;;; stack-question-list.el ends here |