310 lines
11 KiB
EmacsLisp
310 lines
11 KiB
EmacsLisp
|
;;; sx-question-mode.el --- major-mode for displaying questions -*- 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:
|
|||
|
|
|
|||
|
|
;; This file provides a means to print questions with their answers
|
|||
|
|
;; and all comments. See the customizable group `sx-question-mode'.
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
(eval-when-compile
|
|||
|
|
(require 'rx))
|
|||
|
|
|
|||
|
|
(require 'sx)
|
|||
|
|
(require 'sx-switchto)
|
|||
|
|
(require 'sx-question)
|
|||
|
|
(require 'sx-question-print)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Displaying a question
|
|||
|
|
(defcustom sx-question-mode-display-buffer-function #'pop-to-buffer
|
|||
|
|
"Function used to display the question buffer.
|
|||
|
|
Called, for instance, when hitting \\<sx-question-list-mode-map>`\\[sx-question-list-display-question]' on an entry in the
|
|||
|
|
question list.
|
|||
|
|
This is not used when navigating the question list with `\\[sx-question-list-view-next].
|
|||
|
|
|
|||
|
|
Common values for this variable are `pop-to-buffer' and `switch-to-buffer'."
|
|||
|
|
:type 'function
|
|||
|
|
:group 'sx-question-mode)
|
|||
|
|
|
|||
|
|
(defvar sx-question-mode--buffer nil
|
|||
|
|
"Buffer being used to display questions.")
|
|||
|
|
|
|||
|
|
(defvar sx-question-mode--data nil
|
|||
|
|
"The data of the question being displayed.")
|
|||
|
|
(make-variable-buffer-local 'sx-question-mode--data)
|
|||
|
|
|
|||
|
|
(defun sx-question-mode--get-window ()
|
|||
|
|
"Return a window displaying a question, or nil."
|
|||
|
|
(car-safe
|
|||
|
|
(cl-member-if
|
|||
|
|
(lambda (x) (with-selected-window x
|
|||
|
|
(derived-mode-p 'sx-question-mode)))
|
|||
|
|
(window-list nil 'never nil))))
|
|||
|
|
|
|||
|
|
(defun sx-question-mode--display (data &optional window)
|
|||
|
|
"Display question given by DATA on WINDOW.
|
|||
|
|
If WINDOW is nil, use selected one.
|
|||
|
|
|
|||
|
|
Returns the question buffer."
|
|||
|
|
(with-current-buffer
|
|||
|
|
(sx-question-mode--display-buffer window)
|
|||
|
|
(sx-question-mode--erase-and-print-question data)))
|
|||
|
|
|
|||
|
|
(defun sx-question-mode--erase-and-print-question (data)
|
|||
|
|
"Erase contents of buffer and print question given by DATA.
|
|||
|
|
Also marks the question as read with `sx-question--mark-read'."
|
|||
|
|
(sx--ensure-site data)
|
|||
|
|
(sx-question--mark-read data)
|
|||
|
|
(let ((inhibit-read-only t))
|
|||
|
|
(erase-buffer)
|
|||
|
|
(sx-question-mode)
|
|||
|
|
(sx-question-mode--print-question data)
|
|||
|
|
(current-buffer)))
|
|||
|
|
|
|||
|
|
(defun sx-question-mode--display-buffer (window)
|
|||
|
|
"Display and return the buffer used for displaying a question.
|
|||
|
|
Create `sx-question-mode--buffer' if necessary.
|
|||
|
|
If WINDOW is given, use that to display the buffer."
|
|||
|
|
;; Create the buffer if necessary.
|
|||
|
|
(unless (buffer-live-p sx-question-mode--buffer)
|
|||
|
|
(setq sx-question-mode--buffer
|
|||
|
|
(generate-new-buffer "*sx-question*")))
|
|||
|
|
(cond
|
|||
|
|
;; Window was given, use it.
|
|||
|
|
((window-live-p window)
|
|||
|
|
(set-window-buffer window sx-question-mode--buffer))
|
|||
|
|
;; No window, but the buffer is already being displayed somewhere.
|
|||
|
|
((get-buffer-window sx-question-mode--buffer 'visible))
|
|||
|
|
;; Neither, so we create the window.
|
|||
|
|
(t (funcall sx-question-mode-display-buffer-function
|
|||
|
|
sx-question-mode--buffer)))
|
|||
|
|
sx-question-mode--buffer)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Movement commands
|
|||
|
|
;; Sections are headers placed above a question's content or an
|
|||
|
|
;; answer's content, or above the list of comments. They are
|
|||
|
|
;; identified with the `sx-question-mode--section' text property.
|
|||
|
|
;; To move between sections, just search for the property. The value
|
|||
|
|
;; of the text-property is the depth of the section (1 for contents, 2
|
|||
|
|
;; for comments).
|
|||
|
|
(defcustom sx-question-mode-recenter-line 0
|
|||
|
|
"Screen line to which we recenter after moving between sections.
|
|||
|
|
This is used as an argument to `recenter', only used if the end
|
|||
|
|
of section is outside the window.
|
|||
|
|
|
|||
|
|
If nil, no recentering is performed."
|
|||
|
|
:type '(choice (const :tag "Don't recenter" nil)
|
|||
|
|
integer)
|
|||
|
|
:group 'sx-question-mode)
|
|||
|
|
|
|||
|
|
(defun sx-question-mode-next-section (&optional n)
|
|||
|
|
"Move down to next section (question or answer) of this buffer.
|
|||
|
|
Prefix argument N moves N sections down or up."
|
|||
|
|
(interactive "p")
|
|||
|
|
(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--goto-property-change 'sx-question-mode--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--goto-property-change 'sx-question-mode--section n))
|
|||
|
|
(unless (get-char-property (point) 'invisible)
|
|||
|
|
(cl-decf count))))
|
|||
|
|
(when (equal (selected-window) (get-buffer-window))
|
|||
|
|
(when sx-question-mode-recenter-line
|
|||
|
|
(let ((ov (sx-question-mode--section-overlays-at (line-end-position))))
|
|||
|
|
(when (and (overlayp ov) (> (overlay-end ov) (window-end)))
|
|||
|
|
(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.
|
|||
|
|
Prefix argument moves N sections up or down."
|
|||
|
|
(interactive "p")
|
|||
|
|
(sx-question-mode-next-section (- (or n 1))))
|
|||
|
|
|
|||
|
|
(defun sx-question-mode-hide-show-section (&optional _)
|
|||
|
|
"Hide or show section under point.
|
|||
|
|
Optional argument _ is for `push-button'."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((ov (or (sx-question-mode--section-overlays-at
|
|||
|
|
(line-end-position))
|
|||
|
|
(sx-question-mode--section-overlays-at (point)))))
|
|||
|
|
(unless (overlayp ov)
|
|||
|
|
(sx-user-error "Not inside a question or answer"))
|
|||
|
|
(goto-char (overlay-start ov))
|
|||
|
|
(forward-line 0)
|
|||
|
|
(overlay-put
|
|||
|
|
ov 'invisible
|
|||
|
|
(null (overlay-get ov 'invisible)))))
|
|||
|
|
|
|||
|
|
(defun sx-question-mode--section-overlays-at (pos)
|
|||
|
|
"Return the highest priority section overlay at POS.
|
|||
|
|
A section overlay has a `sx-question-mode--section-content'
|
|||
|
|
property."
|
|||
|
|
(cdr-safe (get-char-property-and-overlay
|
|||
|
|
pos 'sx-question-mode--section-content nil)))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Major-mode constants
|
|||
|
|
(defconst sx-question-mode--key-definitions
|
|||
|
|
'(
|
|||
|
|
("<down>" sx-question-mode-next-section)
|
|||
|
|
("<up>" sx-question-mode-previous-section)
|
|||
|
|
("n" sx-question-mode-next-section "Navigate")
|
|||
|
|
("p" sx-question-mode-previous-section "Navigate")
|
|||
|
|
("g" sx-question-mode-refresh)
|
|||
|
|
("v" sx-visit-externally)
|
|||
|
|
("u" sx-upvote "upvote")
|
|||
|
|
("d" sx-downvote "downvote")
|
|||
|
|
("q" quit-window)
|
|||
|
|
("SPC" scroll-up-command)
|
|||
|
|
("e" sx-edit "edit")
|
|||
|
|
("S" sx-search)
|
|||
|
|
("*" sx-favorite "star")
|
|||
|
|
("K" sx-delete "Delete")
|
|||
|
|
("s" sx-switchto-map "switch-to")
|
|||
|
|
("O" sx-question-mode-order-by "Order")
|
|||
|
|
("c" sx-comment "comment")
|
|||
|
|
("a" sx-answer "answer")
|
|||
|
|
("TAB" forward-button "Navigate")
|
|||
|
|
("<S-iso-lefttab>" backward-button)
|
|||
|
|
("<S-tab>" backward-button)
|
|||
|
|
("<backtab>" backward-button))
|
|||
|
|
"List of key definitions for `sx-question-mode'.
|
|||
|
|
This list must follow the form described in
|
|||
|
|
`sx--key-definitions-to-header-line'.")
|
|||
|
|
|
|||
|
|
(defconst sx-question-mode--header-line
|
|||
|
|
(sx--key-definitions-to-header-line
|
|||
|
|
sx-question-mode--key-definitions)
|
|||
|
|
"Header-line used on the question list.")
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Major-mode definition
|
|||
|
|
(defconst sx-question-mode--mode-line
|
|||
|
|
'(" "
|
|||
|
|
;; `sx-question-mode--data' is guaranteed to have through
|
|||
|
|
;; `sx--ensure-site' already, so we use `let-alist' instead of
|
|||
|
|
;; `sx-assoc-let' to improve performance (since the mode-line is
|
|||
|
|
;; updated a lot).
|
|||
|
|
(:propertize
|
|||
|
|
(:eval (sx--pretty-site-parameter
|
|||
|
|
(let-alist sx-question-mode--data .site_par)))
|
|||
|
|
face mode-line-buffer-id)
|
|||
|
|
" " mode-name
|
|||
|
|
" ["
|
|||
|
|
"Answers: "
|
|||
|
|
(:propertize
|
|||
|
|
(:eval (number-to-string (let-alist sx-question-mode--data .answer_count)))
|
|||
|
|
face mode-line-buffer-id)
|
|||
|
|
", "
|
|||
|
|
"Stars: "
|
|||
|
|
(:propertize
|
|||
|
|
(:eval (number-to-string (or (let-alist sx-question-mode--data .favorite_count) 0)))
|
|||
|
|
face mode-line-buffer-id)
|
|||
|
|
", "
|
|||
|
|
"Views: "
|
|||
|
|
(:propertize
|
|||
|
|
(:eval (number-to-string (let-alist sx-question-mode--data .view_count)))
|
|||
|
|
face mode-line-buffer-id)
|
|||
|
|
"] ")
|
|||
|
|
"Mode-line construct to use in `sx-question-mode' buffers.")
|
|||
|
|
|
|||
|
|
(define-derived-mode sx-question-mode special-mode "Question"
|
|||
|
|
"Major mode to display and navigate a question and its answers.
|
|||
|
|
Letters do not insert themselves; instead, they are commands.
|
|||
|
|
|
|||
|
|
Don't activate this mode directly. Instead, to print a question
|
|||
|
|
on the current buffer use
|
|||
|
|
`sx-question-mode--erase-and-print-question'.
|
|||
|
|
|
|||
|
|
\\<sx-question-mode>
|
|||
|
|
\\{sx-question-mode}"
|
|||
|
|
(setq header-line-format sx-question-mode--header-line)
|
|||
|
|
(setq mode-line-format sx-question-mode--mode-line)
|
|||
|
|
(buffer-disable-undo (current-buffer))
|
|||
|
|
(set (make-local-variable 'nobreak-char-display) nil)
|
|||
|
|
;; 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--insert-markdown'.
|
|||
|
|
(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))
|
|||
|
|
|
|||
|
|
;; We need this quote+eval combo because `kbd' was a macro in 24.2.
|
|||
|
|
(mapc (lambda (x) (eval `(define-key sx-question-mode-map
|
|||
|
|
(kbd ,(car x)) #',(cadr x))))
|
|||
|
|
sx-question-mode--key-definitions)
|
|||
|
|
|
|||
|
|
(defun sx-question-mode-refresh (&optional no-update)
|
|||
|
|
"Refresh currently displayed question.
|
|||
|
|
Queries the API for any changes to the question or its answers or
|
|||
|
|
comments, and redisplays it.
|
|||
|
|
|
|||
|
|
With non-nil prefix argument NO-UPDATE, just redisplay, don't
|
|||
|
|
query the api."
|
|||
|
|
(interactive "P")
|
|||
|
|
(sx-question-mode--ensure-mode)
|
|||
|
|
(let ((point (point))
|
|||
|
|
(line (count-screen-lines
|
|||
|
|
(window-start) (point))))
|
|||
|
|
(sx-question-mode--erase-and-print-question
|
|||
|
|
(if no-update
|
|||
|
|
sx-question-mode--data
|
|||
|
|
(sx-assoc-let sx-question-mode--data
|
|||
|
|
(sx-question-get-question .site_par .question_id))))
|
|||
|
|
(goto-char point)
|
|||
|
|
(when (equal (selected-window)
|
|||
|
|
(get-buffer-window (current-buffer)))
|
|||
|
|
(recenter line)))
|
|||
|
|
(sx-message "Done."))
|
|||
|
|
|
|||
|
|
(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'")))
|
|||
|
|
|
|||
|
|
(defun sx-question-mode-order-by (sort)
|
|||
|
|
"Order answers in the current buffer by the method SORT.
|
|||
|
|
Sets `sx-question-list--order' and then calls
|
|||
|
|
`sx-question-list-refresh' with `redisplay'."
|
|||
|
|
(interactive
|
|||
|
|
(list (let ((order (sx-completing-read "Order answers by: "
|
|||
|
|
(mapcar #'car sx-question-mode--sort-methods))))
|
|||
|
|
(cdr-safe (assoc-string order sx-question-mode--sort-methods)))))
|
|||
|
|
(when (and sort (functionp sort))
|
|||
|
|
(setq sx-question-mode-answer-sort-function sort)
|
|||
|
|
(sx-question-mode-refresh 'no-update)))
|
|||
|
|
|
|||
|
|
(provide 'sx-question-mode)
|
|||
|
|
;;; sx-question-mode.el ends here
|
|||
|
|
|
|||
|
|
;; Local Variables:
|
|||
|
|
;; indent-tabs-mode: nil
|
|||
|
|
;; End:
|