diff options
| -rw-r--r-- | sx-button.el | 34 | ||||
| -rw-r--r-- | sx-compose.el | 247 | ||||
| -rw-r--r-- | sx-interaction.el | 112 | ||||
| -rw-r--r-- | sx-question-list.el | 1 | ||||
| -rw-r--r-- | sx-question-mode.el | 4 | ||||
| -rw-r--r-- | sx-question-print.el | 2 | ||||
| -rw-r--r-- | sx-tab.el | 23 |
7 files changed, 398 insertions, 25 deletions
diff --git a/sx-button.el b/sx-button.el index c1abf90..f1d7e4d 100644 --- a/sx-button.el +++ b/sx-button.el @@ -1,4 +1,4 @@ -;;; sx-button.el --- Defining buttons used throughout SX. +;;; sx-button.el --- Defining buttons used throughout SX. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -18,6 +18,25 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: +;; +;; This file defines all buttons used by SX. For information on +;; buttons, see: +;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Buttons.html +;; +;; Most interactible parts of the SX buffers are buttons. Wherever you +;; are, you can always cycle through all buttons by hitting `TAB', +;; that should help identify what's a button in each buffer. +;; +;; To define a new type of button follow the examples below using +;; `define-button-type' with :supertype `sx-button'. Required +;; properties are `action' and `help-echo'. You'll probably want to +;; give it a `face' as well, unless you want it to look like a link. +;; +;; Buttons can then be inserted in their respective files using +;; `insert-text-button'. Give it the string, the `:type' you defined, +;; and any aditional properties that can only be determined at +;; creation. Existing text can be transformed into a button with +;; `make-text-button' instead. ;;; Code: @@ -118,12 +137,17 @@ code-block." 'help-echo (concat "mouse-1, RET" (propertize ": write a comment" 'face 'minibuffer-prompt)) + 'face 'custom-button 'action #'sx-comment :supertype 'sx-button) +(define-button-type 'sx-button-answer + 'help-echo (concat "mouse-1, RET" + (propertize ": write an answer" + 'face 'minibuffer-prompt)) + 'face 'custom-button + 'action #'sx-answer + :supertype 'sx-button) + (provide 'sx-button) ;;; sx-button.el ends here - -;; Local Variables: -;; lexical-binding: t -;; End: diff --git a/sx-compose.el b/sx-compose.el new file mode 100644 index 0000000..d7d3ff3 --- /dev/null +++ b/sx-compose.el @@ -0,0 +1,247 @@ +;;; sx-compose.el --- Major-mode for coposing questions and answers. -*- 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 defines `sx-compose-mode' and its auxiliary functions and +;; variables. In order to use `sx-compose-mode', it is vital that the +;; variable `sx-compose--send-function' be set. Otherwise it's just a +;; regular markdown buffer. +;; +;; In order to help avoid mistakes, there is the function +;; `sx-compose-create'. This is the preferred way of activating the +;; mode. It creates a buffer, activates the major mode, and sets the +;; `send-function' variable according to the arguments it is given. + + +;;; Code: +(require 'markdown-mode) + +(require 'sx) + +(defgroup sx-compose-mode nil + "Customization group for sx-compose-mode." + :prefix "sx-compose-mode-" + :tag "SX compose Mode" + :group 'sx) + + +;;; Faces and Variables +(defvar sx-compose-before-send-hook nil + "Hook run before POSTing to the API. +Functions are called without arguments and should return non-nil. + +Returning nil indicates something went wrong and the sending will +be aborted. In this case, the function is responsible for +notifying the user. + +Current buffer is the compose-mode buffer whose content is about +to be POSTed.") + +(defvar sx-compose-after-send-functions nil + "Hook run after POSTing to the API. +Functions on this hook should take two arguments, the +`sx-compose-mode' buffer (which not be live) and the data +returned by `sx-compose--send-function' (usually the object +created by the API). They are only called if the transaction +succeeds.") + +(defvar sx-compose--send-function nil + "Function used by `sx-compose-send' to send the data. +Is invoked between `sx-compose-before-send-hook' and +`sx-compose-after-send-functions'.") + +(defvar sx-compose--question-headers + (concat + #("Title: " 0 7 (intangible t read-only t rear-nonsticky t)) + #("\n" 0 1 (read-only t)) + #("Tags : " 0 7 (read-only t intangible t rear-nonsticky t)) + #("\n" 0 1 (read-only t rear-nonsticky t)) + #("________________________________________\n\n" + 0 42 (read-only t rear-nonsticky t intangible t + sx-compose-separator t))) + "Headers inserted when composing a new question. +Used by `sx-compose-create'.") + + +;;; Major-mode +(define-derived-mode sx-compose-mode markdown-mode "Compose" + "Major mode for coposing questions and answers. +Most of the functionality comes from `markdown-mode'. This mode +just implements some extra features related to posting to the +API. + +This mode won't function if `sx-compose--send-function' isn't +set. To make sure you set it correctly, you can create the buffer +with the `sx-compose-create' function. + +\\<sx-compose-mode> +\\{sx-compose-mode}" + (add-hook 'sx-compose-after-send-functions + #'sx-compose-quit nil t) + (add-hook 'sx-compose-after-send-functions + #'sx-compose--copy-as-kill nil t)) + +(define-key sx-compose-mode-map "\C-c\C-c" #'sx-compose-send) +(define-key sx-compose-mode-map "\C-c\C-k" #'sx-compose-quit) + +(defun sx-compose-send () + "Finish composing current buffer and send it. +Calls `sx-compose-before-send-hook', POSTs the the current buffer +contents to the API, then calls `sx-compose-after-send-functions'." + (interactive) + (when (run-hook-with-args-until-failure + 'sx-compose-before-send-hook) + (let ((result (funcall sx-compose--send-function))) + (with-demoted-errors + (run-hook-with-args 'sx-compose-after-send-functions + (current-buffer) result))))) + +(defun sx-compose-quit (buffer _) + "Kill BUFFER." + (interactive (list (current-buffer) nil)) + (when (buffer-live-p buffer) + (kill-buffer buffer))) + +(defun sx-compose--copy-as-kill (buffer _) + "Copy BUFFER contents to the kill-ring." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (kill-new (buffer-string))))) + + +;;; Functions to help preparing buffers +(defun sx-compose-create (site parent &optional before-functions after-functions) + "Create an `sx-compose-mode' buffer. +SITE is the site where it will be posted. + +If composing questions, PARENT is nil. +If composing answers, it is the `question_id'. +If editing answers or questions, it should be the alist data +related to that object. + +Each element of BEFORE-FUNCTIONS and AFTER-FUNCTIONS are +respectively added locally to `sx-compose-before-send-hook' and +`sx-compose-after-send-functions'." + (or (integerp parent) (listp parent) + (error "Invalid PARENT")) + (let ((is-question + (and (listp parent) + (null (cdr (assoc 'answer_id parent)))))) + (with-current-buffer (sx-compose--get-buffer-create site parent) + (sx-compose-mode) + (setq sx-compose--send-function + (if (consp parent) + (sx-assoc-let parent + (lambda () (sx-method-call (if .title 'questions 'answers) + :auth 'warn + :url-method "POST" + :filter sx-browse-filter + :site site + :keywords (sx-compose--generate-keywords is-question) + :id (or .answer_id .question_id) + :submethod 'edit))) + (lambda () (sx-method-call 'questions + :auth 'warn + :url-method "POST" + :filter sx-browse-filter + :site site + :keywords (sx-compose--generate-keywords is-question) + :id parent + :submethod (if parent 'answers/add 'add))))) + ;; Reverse so they're left in the same order. + (dolist (it (reverse before-functions)) + (add-hook 'sx-compose-before-send-hook it nil t)) + (dolist (it (reverse after-functions)) + (add-hook 'sx-compose-after-send-functions it nil t)) + ;; If the buffer is empty, the draft didn't exist. So prepare the + ;; question. + (when (and is-question (string= (buffer-string) "")) + (let ((inhibit-point-motion-hooks)) + (insert sx-compose--question-headers) + (goto-char (point-min)) + (goto-char (line-end-position)))) + (when (consp parent) + (when (or (string= (buffer-string) "") + (y-or-n-p "Draft buffer exists. Reset it? ")) + (erase-buffer) + (insert (cdr (assoc 'body_markdown parent))))) + ;; Return the buffer + (current-buffer)))) + +(defun sx-compose--generate-keywords (is-question) + "Reading current buffer, generate a keywords alist. +Keywords meant to be used in `sx-method-call'. + +`body' is read as the `buffer-string'. If IS-QUESTION is non-nil, +other keywords are read from the header " + `(,@(when is-question + (let ((inhibit-point-motion-hooks t) + (inhibit-read-only t) + (header-end + (next-single-property-change + (point-min) 'sx-compose-separator)) + keywords) + ;; Read the Title. + (goto-char (point-min)) + (unless (search-forward-regexp + "^Title: *\\(.*\\) *$" header-end 'noerror) + (error "No Title header found")) + (push (cons 'title (match-string 1)) keywords) + ;; And the tags + (goto-char (point-min)) + (unless (search-forward-regexp "^Tags : *\\([^[:space:]].*\\) *$" + header-end 'noerror) + (error "No Tags header found")) + (push (cons 'tags (split-string (match-string 1) "[[:space:],;]" + 'omit-nulls "[[:space:]]")) + keywords) + ;; And erase the header so it doesn't get sent. + (delete-region + (point-min) + (next-single-property-change + header-end 'sx-compose-separator)) + keywords)) + (body . ,(buffer-string)))) + +(defun sx-compose--get-buffer-create (site data) + "Get or create a buffer for use with `sx-compose-mode'. +SITE is the site for which composing is aimed (just used to +uniquely identify the buffers). + +If DATA is nil, get a fresh compose buffer. +If DATA is an integer, try to find an existing buffer +corresponding to that integer, otherwise create one. +If DATA is an alist (question or answer data), like above but use +the id property." + (cond + ((null data) + (generate-new-buffer + (format "*sx draft question %s*" site))) + ((integerp data) + (get-buffer-create + (format "*sx draft answer %s %s*" + site data))) + (t + (get-buffer-create + (format "*sx draft edit %s %s*" + site (sx-assoc-let data (or .answer_id .question_id))))))) + +(provide 'sx-compose) +;;; sx-compose.el ends here diff --git a/sx-interaction.el b/sx-interaction.el index b67e0df..9a5bbcb 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -19,6 +19,21 @@ ;;; Commentary: +;; This file holds a series of functions for performing arbitrary +;; interactions with arbitrary objects (objects here always mean the +;; alist of a question, answer, or comment). All commands take at +;; least a DATA argument corresponding to the object which, when +;; called interactively, is always derived from the context at point +;; (usually using the `sx--data-here' function). +;; +;; Interactions represented here involve voting, commenting, asking, +;; answering, editing. +;; +;; These are commands are meant to be available throughout the +;; interface. So it didn't make sense to put them in a specific +;; module. They also rely on a lot of dependencies, so they couldn't +;; be put in sx.el. + ;;; Code: @@ -26,6 +41,8 @@ (require 'sx-question) (require 'sx-question-mode) (require 'sx-question-list) +(require 'sx-compose) +(require 'sx-tab) ;;; Using data in buffer @@ -44,13 +61,15 @@ it throws an error." (and (null noerror) (error "No question data found here")))) -(defun sx--maybe-update-display () - "Refresh the question list if we're inside it." - (cond - ((derived-mode-p 'sx-question-list-mode) - (sx-question-list-refresh 'redisplay 'no-update)) - ((derived-mode-p 'sx-question-mode) - (sx-question-mode-refresh 'no-update)))) +(defun sx--maybe-update-display (&optional buffer) + "Refresh whatever is displayed in BUFFER or the current buffer. +If BUFFER is not live, nothing is done." + (setq buffer (or buffer (current-buffer))) + (when (buffer-live-p buffer) + (cond ((derived-mode-p 'sx-question-list-mode) + (sx-question-list-refresh 'redisplay 'no-update)) + ((derived-mode-p 'sx-question-mode) + (sx-question-mode-refresh 'no-update))))) (defun sx--copy-data (from to) "Copy all fields of alist FORM onto TO. @@ -75,7 +94,7 @@ If DATA is a question, also mark it as read." (let ((link (when (stringp .link) (funcall (if copy-as-kill #'kill-new #'browse-url) - .link)))) + .link)))) (when (and (called-interactively-p 'any) copy-as-kill) (message "Copied: %S" link))) (when (and .title (not copy-as-kill)) @@ -222,13 +241,82 @@ OBJECT can be a question or an answer." (setcdr com-cell (apply #'vector - (append - (cl-map 'list #'identity - (cdr com-cell)) - (list comment))))) + (append + (cl-map 'list #'identity + (cdr com-cell)) + (list comment))))) ;; No previous comments, add it manually. (setcdr object (cons (car object) (cdr object))) (setcar object `(comments . [,comment]))))) + +;;; Editing +(defun sx-edit (data) + "Start editing an answer or question given by DATA. +DATA is an answer or question alist. Interactively, it is guessed +from context at point." + ;; Answering doesn't really make sense from anywhere other than + ;; inside a question. So we don't need `sx--data-here' here. + (interactive (list (sx--data-here))) + ;; If we ever make an "Edit" button, first arg is a marker. + (when (markerp data) (setq data (sx--data-here))) + (sx-assoc-let data + (when .comment_id (user-error "Editing comments is not supported yet")) + (let ((buffer (current-buffer))) + (pop-to-buffer + (sx-compose-create + .site data nil + ;; After send functions + (list (lambda (_ res) + (sx--copy-data (elt res 0) data) + (sx--maybe-update-display buffer)))))))) + + +;;; Asking +(defun sx-ask (site) + "Start composing a question for SITE. +SITE is a string, indicating where the question will be posted." + ;; Answering doesn't really make sense from anywhere other than + ;; inside a question. So we don't need `sx--data-here' here. + (interactive (list (sx-tab--interactive-site-prompt))) + (let ((buffer (current-buffer))) + (pop-to-buffer + (sx-compose-create + site nil nil + ;; After send functions + (list (lambda (_ res) (sx--maybe-update-display buffer))))))) + + +;;; Answering +(defun sx-answer (data) + "Start composing an answer for question given by DATA. +DATA is a question alist. Interactively, it is guessed from +context at point. " + ;; Answering doesn't really make sense from anywhere other than + ;; inside a question. So we don't need `sx--data-here' here. + (interactive (list sx-question-mode--data)) + ;; When clicking the "Write an Answer" button, first arg is a marker. + (when (markerp data) (setq data (sx--data-here))) + (let ((buffer (current-buffer))) + (sx-assoc-let data + (pop-to-buffer + (sx-compose-create + .site .question_id nil + ;; After send functions + (list (lambda (_ res) + (sx--add-answer-to-question-object + (elt res 0) sx-question-mode--data) + (sx--maybe-update-display buffer)))))))) + +(defun sx--add-answer-to-question-object (answer question) + "Add alist ANSWER to alist QUESTION in the right place." + (let ((cell (assoc 'answers question))) + (if cell + (setcdr cell (apply #'vector + (append (cdr cell) (list answer)))) + ;; No previous comments, add it manually. + (setcdr question (cons (car question) (cdr question))) + (setcar question `(answers . [,answer]))))) + (provide 'sx-interaction) ;;; sx-interaction.el ends here diff --git a/sx-question-list.el b/sx-question-list.el index e2eb2b6..628de30 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -297,6 +297,7 @@ into consideration. ("g" sx-question-list-refresh) (":" sx-question-list-switch-site) ("t" sx-question-list-switch-tab) + ("a" sx-ask) ("v" sx-visit) ("u" sx-toggle-upvote) ("d" sx-toggle-downvote) diff --git a/sx-question-mode.el b/sx-question-mode.el index 91044ff..bccb658 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -124,7 +124,7 @@ Prefix argument N moves N sections down or up." (cl-decf count))))) (when (equal (selected-window) (get-buffer-window)) (when sx-question-mode-recenter-line - (let ((ov (car-safe (sx-question-mode--section-overlays-at (line-end-position))))) + (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))) @@ -202,6 +202,8 @@ Letters do not insert themselves; instead, they are commands. ("d" sx-toggle-downvote) ("q" quit-window) (" " scroll-up-command) + ("a" sx-answer) + ("e" sx-edit) (,(kbd "S-SPC") scroll-down-command) ([backspace] scroll-down-command) ([tab] forward-button) diff --git a/sx-question-print.el b/sx-question-print.el index 4655f5e..eb79a7a 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -182,6 +182,8 @@ QUESTION must be a data structure returned by `json-read'." (sx-question-mode--print-section question) (sx-assoc-let question (mapc #'sx-question-mode--print-section .answers)) + (insert "\n\n ") + (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Display weird chars correctly (set-buffer-multibyte nil) (set-buffer-multibyte t) @@ -26,14 +26,13 @@ (require 'sx) (require 'sx-question-list) -(require 'sx-interaction) (defcustom sx-tab-default-site "emacs" "Name of the site to use by default when listing questions." - :type 'string + :type 'string :group 'sx) -(defvar sx-tab--list nil +(defvar sx-tab--list nil "List of the names of all defined tabs.") (defun sx-tab-switch (tab) @@ -45,6 +44,19 @@ t))) (funcall (intern (format "sx-tab-%s" (downcase tab))))) +(defun sx-tab--interactive-site-prompt () + "Query the user for a site." + (let ((default (or sx-question-list--site + (sx-assoc-let sx-question-mode--data + .site) + sx-tab-default-site))) + (funcall (if ido-mode #'ido-completing-read #'completing-read) + (format "Site (%s): " default) + (sx-site-get-api-tokens) nil t nil nil + default))) + + +;;; The main macro (defmacro sx-tab--define (tab pager &optional printer refresher &rest body) "Define a StackExchange tab called TAB. @@ -79,10 +91,7 @@ If SITE is nil, use `sx-tab-default-site'." tab) (interactive (list current-prefix-arg - (funcall (if ido-mode #'ido-completing-read #'completing-read) - (format "Site (%s): " sx-tab-default-site) - (sx-site-get-api-tokens) nil t nil nil - sx-tab-default-site))) + (sx-tab--interactive-site-prompt))) (sx-initialize) (unless site (setq site sx-tab-default-site)) ;; Create the buffer |