diff options
Diffstat (limited to 'sx-question-print.el')
| -rw-r--r-- | sx-question-print.el | 104 |
1 files changed, 79 insertions, 25 deletions
diff --git a/sx-question-print.el b/sx-question-print.el index 8d61773..dd1c151 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -141,6 +141,20 @@ the editor's name." "Face used for accepted answers in the question buffer." :group 'sx-question-mode-faces) +(defface sx-question-mode-closed + '((t :box 2 :inherit font-lock-warning-face)) + "Face used for closed question header in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-closed-reason + `((t :box (:line-width 2 :color ,(face-attribute 'sx-question-mode-closed + :foreground nil t)) + :inherit sx-question-mode-title)) + "Face used for closed question header in the question buffer. +Aesthetically, it's important that the color of this face's :box +attribute match the color of the face `sx-question-mode-closed'." + :group 'sx-question-mode-faces) + (defcustom sx-question-mode-answer-accepted-title "Accepted Answer" "Title used at the start of accepted \"Answer\" section." :type 'string @@ -201,31 +215,68 @@ type is not available, images won't work." ;;; Functions ;;;; Printing the general structure +(defconst sx-question-mode--closed-mode-line-string + '(:propertize " [CLOSED] " face font-lock-warning-face) + "String indicating closed questions in the mode-line.") + (defun sx-question-mode--print-question (question) "Print a buffer describing QUESTION. QUESTION must be a data structure returned by `json-read'." + (when (sx--deleted-p question) + (sx-user-error "This is a deleted question")) (setq sx-question-mode--data question) ;; Clear the overlays (mapc #'delete-overlay sx--overlays) (setq sx--overlays nil) ;; Print everything - (sx-question-mode--print-section question) (sx-assoc-let question + (when .closed_reason + (add-to-list 'mode-line-format sx-question-mode--closed-mode-line-string) + (sx-question-mode--print-close-reason .closed_reason .closed_date .closed_details)) + (sx-question-mode--print-section question) (mapc #'sx-question-mode--print-section - (cl-sort .answers sx-question-mode-answer-sort-function))) + (cl-remove-if + #'sx--deleted-p + (cl-sort .answers sx-question-mode-answer-sort-function)))) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up (goto-char (point-min)) (sx-question-mode-next-section)) +(defun sx-question-mode--print-close-reason (reason date &optional details) + "Print a header explaining REASON and DATE. +DATE is an integer. + +DETAILS, when given is an alist further describing the close." + (let ((l (point))) + (let-alist details + (insert "\n " + (propertize (format " %s as %s, %s ago. " + (if .on_hold "Put on hold" "Closed") + reason + (sx-time-since date)) + 'face 'sx-question-mode-closed) + "\n") + (when .description + (insert (replace-regexp-in-string "<[^>]+>" "" .description) + "\n"))) + (save-excursion + (goto-char l) + (search-forward " as " nil 'noerror) + (setq l (point)) + (skip-chars-forward "^,") + (let ((ov (make-overlay l (point)))) + (overlay-put ov 'face 'sx-question-mode-closed-reason) + (push ov sx--overlays))))) + (defun sx-question-mode--print-section (data) "Print a section corresponding to DATA. DATA can represent a question or an answer." ;; This makes `data' accessible through `sx--data-here'. - (sx-assoc-let data - (sx--wrap-in-overlay - (list 'sx--data-here data) + (sx--wrap-in-overlay + (list 'sx--data-here data) + (sx-assoc-let data (insert sx-question-mode-header-title) (insert-text-button ;; Questions have title, Answers don't @@ -288,29 +339,32 @@ DATA can represent a question or an answer." (insert "\n" (propertize sx-question-mode-separator 'face 'sx-question-mode-header))) - ;; Comments have their own `sx--data-here' property (so they can - ;; be upvoted too). - (when .comments - (insert "\n") - (insert-text-button - sx-question-mode-comments-title - 'face 'sx-question-mode-title-comments - 'sx-question-mode--section 3 - 'sx-button-copy .share_link - :type 'sx-question-mode-title) - (sx--wrap-in-overlay - '(sx-question-mode--section-content t) + ;; Clean up commments manually deleted. The `append' call is + ;; to ensure `comments' is a list and not a vector. + (let ((comments (cl-remove-if #'sx--deleted-p (append .comments nil)))) + (when comments (insert "\n") + (insert-text-button + sx-question-mode-comments-title + 'face 'sx-question-mode-title-comments + 'sx-question-mode--section 3 + 'sx-button-copy .share_link + :type 'sx-question-mode-title) (sx--wrap-in-overlay - '(face sx-question-mode-content-face) - (mapc #'sx-question-mode--print-comment .comments)) - ;; If there are comments, we want part of this margin to go - ;; inside them, so the button get's placed beside the - ;; "Comments" header when you hide them. + '(sx-question-mode--section-content t) + (insert "\n") + (sx--wrap-in-overlay + '(face sx-question-mode-content-face) + ;; Comments have their own `sx--data-here' property (so they can + ;; be upvoted too). + (mapc #'sx-question-mode--print-comment comments)) + ;; If there are comments, we want part of this margin to go + ;; inside them, so the button get's placed beside the + ;; "Comments" header when you hide them. + (insert " "))) + ;; If there are no comments, we have to add this margin here. + (unless comments (insert " "))) - ;; If there are no comments, we have to add this margin here. - (unless .comments - (insert " ")) (insert " ") ;; This is where the "add a comment" button is printed. (insert-text-button "Add a Comment" |