Implement sx-question-mode

Also moves question-display code to its own file.

3 files changed, 301 insertions, 50 deletions

diff --git a/sx-question-list.el b/sx-question-list.el
index 0494ef1..f305306 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -67,7 +67,7 @@
   :group 'sx-question-list-faces)
 
 (defface sx-question-list-tags
-  '((t :inherit font-lock-function-name-face))
+  '((t :inherit sx-question-mode-tags))
   ""
   :group 'sx-question-list-faces)
 
@@ -277,7 +277,7 @@ focus the relevant window."
                   (car (cdr-safe er)))
                  nil
                (error (cdr er)))))))
-  (sx-question--display data sx-question--window)
+  (sx-question-mode--display data sx-question--window)
   (when focus
     (if sx-question--window
         (select-window sx-question--window)
diff --git a/sx-question-mode.el b/sx-question-mode.el
new file mode 100644
index 0000000..2c72bba
--- /dev/null
+++ b/sx-question-mode.el
@@ -0,0 +1,299 @@
+;;; sx-question-mode.el --- Creating the buffer that displays 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:
+
+;;
+
+
+;;; Code:
+
+(require 'sx)
+(require 'sx-filter)
+(require 'sx-lto)
+(require 'markdown-mode)
+
+
+;;; Displaying a question
+(defvar sx-question-mode--window nil
+  "Window where the content of questions is displayed.")
+
+(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.")
+
+(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."
+  (let ((inhibit-read-only t))
+    (with-current-buffer
+        (sx-question-mode--display-buffer window)
+      (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 the 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 "*stack-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 (switch-to-buffer sx-question-mode--buffer)))
+  sx-question-mode--buffer)
+
+
+;;; Printing a question's content
+(defvar sx-question-mode--overlays nil 
+  "")
+(make-variable-buffer-local 'sx-question-mode--overlays)
+
+(defface sx-question-mode-header
+  '((t :inherit font-lock-variable-name-face))
+  "Face used on the question headers in the question buffer."
+  :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-title
+  '((t :height 1.3 :weight bold :inherit default))
+  "Face used on the question title in the question buffer."
+  :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-title "\n"
+  "String used before the question title at the header."
+  :type 'string
+  :group 'sx-question-mode)
+
+(defface sx-question-mode-author
+  '((t :inherit font-lock-string-face))
+  "Face used on the question author in the question buffer."
+  :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-author "\nAuthor:   "
+  "String used before the question author at the header."
+  :type 'string
+  :group 'sx-question-mode)
+
+(defface sx-question-mode-date
+  '((t :inherit font-lock-string-face))
+  "Face used on the question date in the question buffer."
+  :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-date "\nAsked on: "
+  "String used before the question date at the header."
+  :type 'string
+  :group 'sx-question-mode)
+
+(defface sx-question-mode-tags
+  '((t :inherit font-lock-function-name-face))
+  "Face used on the question tags in the question buffer."
+  :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-tags "\nTags:     "
+  "String used before the question tags at the header."
+  :type 'string
+  :group 'sx-question-mode)
+
+(defcustom sx-question-mode-last-edit-format " (edited %s ago by %s)"
+  "Format used to describe last edit date in the header.
+First %s is replaced with the date, and the second %s with the
+editor's name."
+  :type 'string
+  :group 'sx-question-mode)
+
+(defcustom sx-question-mode-separator
+  (concat "\n" (make-string 80 ?_) "\n")
+  "Separator used between header and body."
+  :type 'string
+  :group 'sx-question-mode)
+
+;;; 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'."
+  (sx-assoc-let question
+    (insert sx-question-mode-header-title
+            (propertize title
+                        'font-lock-face 'sx-question-mode-title
+                        'sx-question-mode--section 1))
+    (sx-question-mode--wrap-in-overlay
+     (sx-question-mode--insert-header
+      sx-question-mode-header-author
+      (cdr (assoc 'display_name owner))
+      'sx-question-mode-author
+      ;; Date
+      sx-question-mode-header-date
+      (concat
+       (sx-time-seconds-to-date creation_date)
+       (when last_edit_date
+         (format sx-question-mode-last-edit-format
+                 (sx-time-since last_edit_date)
+                 (cdr (assoc 'display_name last_editor)))))
+      'sx-question-mode-date
+      ;; Tags
+      sx-question-mode-header-tags
+      (concat "(" (mapconcat 'identity tags ") (") ")")
+      'sx-question-mode-tags)
+     (insert sx-question-mode-separator
+             ;; @TODO: This is temporary, of course. It prevents
+             ;; errors while the filters aren't setup yet.
+             (or body "BODY")))))
+
+(defmacro sx-question-mode--wrap-in-overlay (&rest body)
+  "Execute BODY and wrap any inserted text in an overlay.
+Overlay is stored in `sx-question-mode--overlays' and given the
+property `sx-question-mode--section-content'."
+  `(let ((p (point-marker)))
+     ,@body
+     (let ((ov (make-overlay p (point))))
+       (overlay-put ov 'sx-question-mode--section-content t)
+       (overlay-put ov 'face 'sx-question-mode-content-face)
+       (push ov sx-question-mode--overlays))))
+
+(defun sx-question-mode--insert-header (&rest args)
+  "Insert HEADER and VALUE.
+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)))))
+
+
+;;; 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 1
+  "Screen line to which we recenter after moving between sections.
+This is used as an argument to `recenter'. 
+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 (n)
+  "Move down to next section (question or answer) of this buffer.
+Prefix argument N moves N sections down or up."
+  (interactive "p")
+  (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)))
+  (when sx-question-mode-recenter-line
+    (recenter sx-question-mode-recenter-line)))
+
+(defun sx-question-mode-previous-section (n)
+  "Move down to previous section (question or answer) of this buffer.
+Prefix argument N moves N sections up or down."
+  (interactive "p")
+  (sx-question-mode-next-section (- n)))
+
+(defun sx-question-mode--goto-propety-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)))
+        (func (if (and (numberp direction)
+                       (< direction 0))
+                  #'previous-single-property-change
+                #'next-single-property-change))
+        (limit (if (and (numberp direction)
+                        (< direction 0))
+                   (point-min) (point-max))))
+    (goto-char (funcall func (point) prop nil limit))
+    (get-text-property (point) prop)))
+
+
+;;; Major-mode
+(define-derived-mode sx-question-mode markdown-mode "Question"
+  "Major mode for a question and its answers.
+Letters do not insert themselves; instead, they are commands.
+\\<sx-question-mode>
+\\{sx-question-mode}"
+  (sx-question-mode--update-mode-line)
+  (remove-hook 'after-change-functions 'markdown-check-change-for-wiki-link t)
+  (remove-hook 'window-configuration-change-hook
+               'markdown-fontify-buffer-wiki-links t)
+  (read-only-mode))
+
+(defun sx-question-mode--update-mode-line ()
+  ""
+  )
+
+(mapc
+ (lambda (x) (define-key sx-question-mode-map
+               (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)))
+
+(defun sx-question-mode-refresh ()
+  "Refresh currently displayed question.
+Queries the API for any changes to the question or its answers or
+comments, and redisplays it."
+  (interactive)
+  (unless (derived-mode-p 'sx-question-mode)
+    (error "Not in `sx-question-mode'"))
+  (sx-assoc-let sx-question-mode--data
+    (sx-question-mode--display
+     (sx-question-get-question sx-question-list--current-site question_id)
+     (selected-window))))
+
+(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.")
+
+(provide 'sx-question-mode)
+;;; sx-question-mode.el ends here
diff --git a/sx-question.el b/sx-question.el
index c681a82..2d65af3 100644
--- a/sx-question.el
+++ b/sx-question.el
@@ -78,54 +78,6 @@ With optional argument predicate, use it instead of `<'."
   (funcall (or pred #'<)
            (cdr (assoc property x))
            (cdr (assoc property y))))
-
-;;; Displaying a question
-(defvar sx-question--window nil
-  "Window where the content of questions is displayed.")
-
-(defvar sx-question--buffer nil
-  "Buffer being used to display questions.")
-
-(defcustom sx-question-use-html t
-  "If nil, markdown is used for the body."
-  :type 'boolean
-  :group 'sx-question)
-
-(defun sx-question--display (data &optional window)
-  "Display question given by DATA on WINDOW.
-If WINDOW is nil, use selected one."
-  (let ((sx-lto--body-src-block
-         (if sx-question-use-html nil
-           sx-lto--body-src-block))
-        (inhibit-read-only t))
-    (with-current-buffer
-        (sx-question--display-buffer window)
-      (erase-buffer)
-      (insert
-       (org-element-interpret-data
-        (sx-lto--question data)))
-      (org-mode)
-      (show-all)
-      (view-mode)
-      (current-buffer))))
-
-(defun sx-question--display-buffer (window)
-  "Display and return the buffer used for displaying a question.
-Create the buffer if necessary.
-If WINDOW is given, use that to display the buffer."
-  ;; Create the buffer if necessary.
-  (unless (buffer-live-p sx-question--buffer)
-    (setq sx-question--buffer
-          (generate-new-buffer "*sx-question*")))
-  (cond
-   ;; Window was given, use it.
-   ((window-live-p window)
-    (set-window-buffer window sx-question--buffer))
-   ;; No window, but the buffer is already being displayed somewhere.
-   ((get-buffer-window sx-question--buffer 'visible))
-   ;; Neither, so we create the window.
-   (t (switch-to-buffer sx-question--buffer)))
-  sx-question--buffer)
 
 (provide 'sx-question)
 ;;; sx-question.el ends here