diff options
Diffstat (limited to 'sx-question-list.el')
| -rw-r--r-- | sx-question-list.el | 241 |
1 files changed, 121 insertions, 120 deletions
diff --git a/sx-question-list.el b/sx-question-list.el index 81d7cd5..59acbeb 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -1,4 +1,4 @@ -;;; stack-question-list.el --- Major-mode for navigating questions list. -*- lexical-binding: t; -*- +;;; sx-question-list.el --- Major-mode for navigating questions list. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -20,235 +20,236 @@ ;;; Commentary: ;;; Code: -(require 'stack-question) +(require 'sx-question) +(require 'sx-time) (require 'tabulated-list) (require 'cl-lib) ;;; Customization -(defcustom stack-question-list-height 12 +(defcustom sx-question-list-height 12 "Height, in lines, of stack-mode's *question-list* buffer." :type 'integer - :group 'stack-question-list) + :group 'sx-question-list) -(defface stack-question-list-parent +(defface sx-question-list-parent '((t :inherit default)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-answers +(defface sx-question-list-answers '((((background light)) :foreground "SeaGreen4" - :height 1.0 :inherit stack-question-list-parent) + :height 1.0 :inherit sx-question-list-parent) (((background dark)) :foreground "#D1FA71" - :height 1.0 :inherit stack-question-list-parent) - (t :inherit stack-question-list-parent)) + :height 1.0 :inherit sx-question-list-parent) + (t :inherit sx-question-list-parent)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-answers-accepted +(defface sx-question-list-answers-accepted '((((background light)) :background "YellowGreen" - :inherit stack-question-list-answers) + :inherit sx-question-list-answers) (((background dark)) :background "DarkOliveGreen" - :inherit stack-question-list-answers) - (t :inherit stack-question-list-answers)) + :inherit sx-question-list-answers) + (t :inherit sx-question-list-answers)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-score - '((t :height 1.0 :inherit stack-question-list-parent)) +(defface sx-question-list-score + '((t :height 1.0 :inherit sx-question-list-parent)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-score-upvoted +(defface sx-question-list-score-upvoted '((t :weight bold - :inherit stack-question-list-score)) + :inherit sx-question-list-score)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-tags +(defface sx-question-list-tags '((t :inherit font-lock-function-name-face)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-date +(defface sx-question-list-date '((t :inherit font-lock-comment-face)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-read-question - '((t :height 1.0 :inherit stack-question-list-parent)) +(defface sx-question-list-read-question + '((t :height 1.0 :inherit sx-question-list-parent)) "" - :group 'stack-question-list-faces) + :group 'sx-question-list-faces) -(defface stack-question-list-unread-question - '((t :weight bold :inherit stack-question-list-read-question)) +(defface sx-question-list-unread-question + '((t :weight bold :inherit sx-question-list-read-question)) "" - :group 'stack-question-list-faces) + :group 'sx-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. +(define-derived-mode sx-question-list-mode tabulated-list-mode "Question List" + "Major mode for browsing a list of questions from StackExchange. Letters do not insert themselves; instead, they are commands. -\\<stack-question-list> -\\{stack-question-list}" +\\<sx-question-list> +\\{sx-question-list}" (hl-line-mode 1) - (stack-question-list--update-mode-line) + (sx-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)]) + ("Title" 0 sx-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) + #'sx-question-list-refresh nil t) (add-hook 'tabulated-list-revert-hook - #'stack-question-list--update-mode-line nil t) + #'sx-question-list--update-mode-line nil t) (tabulated-list-init-header)) -(defcustom stack-question-list-date-sort-method 'last_activity_date +(defcustom sx-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) + :group 'sx-question-list) -(defun stack-question-list--date-more-recent-p (x y) +(defun sx-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 + (sx-question--< + sx-question-list-date-sort-method (car x) (car y) #'>)) (mapc - (lambda (x) (define-key stack-question-list-mode-map + (lambda (x) (define-key sx-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" + '(("n" sx-question-list-next) + ("p" sx-question-list-previous) + ("j" sx-question-list-view-next) + ("k" sx-question-list-view-previous) + ("g" sx-question-list-refresh) + ([?\r] sx-question-list-display-question))) + +(defvar sx-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 +(defvar sx-question-list--unread-count 0 "Holds the number of unread questions in the current buffer.") -(make-variable-buffer-local 'stack-question-list--unread-count) +(make-variable-buffer-local 'sx-question-list--unread-count) -(defvar stack-question-list--total-count 0 +(defvar sx-question-list--total-count 0 "Holds the total number of questions in the current buffer.") -(make-variable-buffer-local 'stack-question-list--total-count) +(make-variable-buffer-local 'sx-question-list--total-count) -(defconst stack-question-list--mode-line-format +(defconst sx-question-list--mode-line-format '(" " mode-name " " - (:propertize stack-question-list--current-page + (:propertize sx-question-list--current-page face mode-line-buffer-id) " [" "Unread: " (:propertize - (:eval (int-to-string stack-question-list--unread-count)) + (:eval (int-to-string sx-question-list--unread-count)) face mode-line-buffer-id) ", " "Total: " (:propertize - (:eval (int-to-string stack-question-list--total-count)) + (:eval (int-to-string sx-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 () +(defun sx-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) + (when (derived-mode-p 'sx-question-list-mode) (setq mode-line-format - stack-question-list--mode-line-format) - (setq stack-question-list--total-count + sx-question-list--mode-line-format) + (setq sx-question-list--total-count (length tabulated-list-entries)))) -(defvar stack-question-list--current-site "emacs" +(defvar sx-question-list--current-site "emacs" "Site being displayed in the *question-list* buffer.") -(defun stack-question-list-refresh (&optional redisplay no-update) +(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 the prefix argument NO-UPDATE is nil, query stack-exchange for +If the prefix argument NO-UPDATE is nil, query StackExchange 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))) + (setq sx-question-list--unread-count 0) + (let ((question-list (sx-question-get-questions + sx-question-list--current-site))) ;; Print the result. (setq tabulated-list-entries - (mapcar #'stack-question-list--print-info question-list))) + (mapcar #'sx-question-list--print-info question-list))) (when redisplay (tabulated-list-print 'remember))) -(defcustom stack-question-list-ago-string " ago" +(defcustom sx-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) + :group 'sx-question-list) -(defun stack-question-list--print-info (data) +(defun sx-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)) + (if (cdr (assoc 'upvoted data)) 'sx-question-list-score-upvoted + 'sx-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)) + (if (sx-question--accepted-answer data) + 'sx-question-list-answers-accepted + 'sx-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)) + (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 (stack--time-since (cdr (assoc 'last_activity_date data))) - stack-question-list-ago-string) - 'face 'stack-question-list-date) + (propertize (concat (sx-time-since (cdr (assoc 'last_activity_date data))) + sx-question-list-ago-string) + 'face 'sx-question-list-date) (propertize (concat " [" (mapconcat #'identity (cdr (assoc 'tags data)) "] [") "]") - 'face 'stack-question-list-tags) + 'face 'sx-question-list-tags) (propertize " " 'display "\n"))))) -(defun stack-question-list-view-previous (n) +(defun sx-question-list-view-previous (n) "Hide this question, move to previous one, display it." (interactive "p") - (stack-question-list-view-next (- n))) + (sx-question-list-view-next (- n))) -(defun stack-question-list-view-next (n) +(defun sx-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)) + (sx-question-list-next n) + (sx-question-list-display-question)) -(defun stack-question-list-next (n) +(defun sx-question-list-next (n) "Move to the next entry." (interactive "p") (forward-line n)) -(defun stack-question-list-previous (n) +(defun sx-question-list-previous (n) "Move to the previous entry." (interactive "p") - (stack-question-list-next (- n))) + (sx-question-list-next (- n))) -(defun stack-question-list-display-question (&optional data focus) +(defun sx-question-list-display-question (&optional data focus) "Display question given by DATA. If called interactively (or with DATA being nil), display question under point. @@ -257,13 +258,13 @@ 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 + (when (sx-question--read-p data) + (cl-decf sx-question-list--unread-count) + (sx-question--mark-read data)) + (unless (window-live-p sx-question--window) + (setq sx-question--window (condition-case er - (split-window-below stack-question-list-height) + (split-window-below sx-question-list-height) (error ;; If the window is too small to split, use current one. (if (string-match @@ -271,27 +272,27 @@ focus the relevant window." (car (cdr-safe er))) nil (error (cdr er))))))) - (stack-question--display data stack-question--window) + (sx-question--display data sx-question--window) (when focus - (if stack-question--window - (select-window stack-question--window) - (switch-to-buffer stack-question--buffer)))) + (if sx-question--window + (select-window sx-question--window) + (switch-to-buffer sx-question--buffer)))) -(defvar stack-question-list--buffer nil +(defvar sx-question-list--buffer nil "Buffer where the list of questions is displayed.") (defun list-questions (no-update) - "Display a list of stack-exchange questions." + "Display a list of StackExchange questions." (interactive "P") - (unless (buffer-live-p stack-question-list--buffer) - (setq stack-question-list--buffer + (unless (buffer-live-p sx-question-list--buffer) + (setq sx-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)) + (with-current-buffer sx-question-list--buffer + (sx-question-list-mode) + (sx-question-list-refresh 'redisplay no-update)) + (switch-to-buffer sx-question-list--buffer)) -(defalias 'stack-list-questions #'list-questions) +(defalias 'sx-list-questions #'list-questions) -(provide 'stack-question-list) -;;; stack-question-list.el ends here +(provide 'sx-question-list) +;;; sx-question-list.el ends here |