356 lines
13 KiB
EmacsLisp
356 lines
13 KiB
EmacsLisp
;;; sx-compose.el --- major-mode for composing 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)
|
||
(require 'sx-tag)
|
||
|
||
(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'.")
|
||
|
||
(defconst sx-compose--question-headers
|
||
(concat
|
||
#("Title: " 0 7 (intangible t read-only t rear-nonsticky t))
|
||
"%s"
|
||
#("\n" 0 1 (read-only t))
|
||
#("Tags : " 0 7 (read-only t intangible t rear-nonsticky t))
|
||
"%s"
|
||
#("\n" 0 1 (read-only t rear-nonsticky t))
|
||
#("________________________________________\n"
|
||
0 41 (read-only t rear-nonsticky t intangible t
|
||
sx-compose-separator t))
|
||
"\n")
|
||
"Headers inserted when composing a new question.
|
||
Used by `sx-compose-create'.")
|
||
|
||
(defconst sx-compose--header-line
|
||
'(" "
|
||
(:propertize "C-c C-c" face mode-line-buffer-id)
|
||
": Finish and Send"
|
||
(sx-compose--is-question-p
|
||
(" "
|
||
(:propertize "C-c C-q" face mode-line-buffer-id)
|
||
": Insert tags"))
|
||
" "
|
||
(:propertize "C-c C-k" face mode-line-buffer-id)
|
||
": Discard Draft")
|
||
"Header-line used on `sx-compose-mode' drafts.")
|
||
|
||
(defvar sx-compose--is-question-p nil
|
||
"Non-nil if this `sx-compose-mode' buffer is a question.")
|
||
(make-variable-buffer-local 'sx-compose--is-question-p)
|
||
|
||
(defvar sx-compose--site nil
|
||
"Site which the curent compose buffer belongs to.")
|
||
(make-variable-buffer-local 'sx-compose--site)
|
||
|
||
|
||
;;; 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.
|
||
|
||
If creating a question draft, the `sx-compose--is-question-p'
|
||
variable should also be set to enable more functionality.
|
||
|
||
\\<sx-compose-mode>
|
||
\\{sx-compose-mode}"
|
||
(setq header-line-format sx-compose--header-line)
|
||
(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)
|
||
(sx--define-conditional-key
|
||
sx-compose-mode-map "\C-c\C-q" #'sx-compose-insert-tags
|
||
sx-compose--is-question-p)
|
||
|
||
(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))
|
||
(buf (current-buffer)))
|
||
(run-hook-wrapped
|
||
'sx-compose-after-send-functions
|
||
(lambda (func)
|
||
(with-demoted-errors
|
||
"[sx] Error encountered AFTER sending post, but the post was sent successfully: %s"
|
||
(funcall func buf result))
|
||
nil)))))
|
||
|
||
(defun sx-compose-insert-tags ()
|
||
"Prompt for a tag list for this draft and insert them."
|
||
(interactive)
|
||
(save-excursion
|
||
(let* ((old (sx-compose--goto-tag-header))
|
||
(new
|
||
(save-match-data
|
||
(mapconcat
|
||
#'identity
|
||
(sx-tag-multiple-read sx-compose--site "Tags" old)
|
||
" "))))
|
||
(if (match-string 1)
|
||
(replace-match new :fixedcase nil nil 1)
|
||
(insert new)))))
|
||
|
||
|
||
;;; Functions for use in hooks
|
||
(defun sx-compose-quit (buffer _)
|
||
"Close BUFFER's window and kill it."
|
||
(interactive (list (current-buffer) nil))
|
||
(when (buffer-live-p buffer)
|
||
(let ((w (get-buffer-window buffer)))
|
||
(when (window-live-p w)
|
||
(ignore-errors (delete-window w))))
|
||
(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)))))
|
||
|
||
(defun sx-compose--goto-tag-header ()
|
||
"Move to the \"Tags:\" header.
|
||
Match data is set so group 1 encompasses any already inserted
|
||
tags. Return a list of already inserted tags."
|
||
(goto-char (point-min))
|
||
(unless (search-forward-regexp
|
||
(rx bol "Tags : " (group-n 1 (* not-newline)) eol)
|
||
(next-single-property-change (point-min) 'sx-compose-separator)
|
||
'noerror)
|
||
(error "No Tags header found"))
|
||
(save-match-data
|
||
(sx--split-string (match-string 1) (rx (any space ",;")))))
|
||
|
||
(defun sx-compose--check-tags ()
|
||
"Check if tags in current compose buffer are valid."
|
||
(save-excursion
|
||
(let ((invalid-tags
|
||
(sx-tag--invalid-name-p
|
||
sx-compose--site (sx-compose--goto-tag-header))))
|
||
(if invalid-tags
|
||
;; If the user doesn't want to create the tags, we return
|
||
;; nil and sending is aborted.
|
||
(y-or-n-p (format "Following tags don't exist. Create them? %s " invalid-tags))
|
||
t))))
|
||
|
||
|
||
;;; 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)
|
||
(or (null parent)
|
||
(cdr (assoc 'title parent))))))
|
||
(with-current-buffer (sx-compose--get-buffer-create site parent)
|
||
(sx-compose-mode)
|
||
(setq sx-compose--site site)
|
||
(setq sx-compose--is-question-p is-question)
|
||
(setq sx-compose--send-function
|
||
(if (consp parent)
|
||
(sx-assoc-let parent
|
||
(lambda () (sx-method-call (cond
|
||
(.title 'questions)
|
||
(.comment_id 'comments)
|
||
(t 'answers))
|
||
:auth 'warn
|
||
:url-method 'post
|
||
:filter sx-browse-filter
|
||
:site site
|
||
:keywords (sx-compose--generate-keywords is-question)
|
||
:id (or .comment_id .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))
|
||
(when is-question
|
||
(add-hook 'sx-compose-before-send-hook #'sx-compose--check-tags nil t))
|
||
;; If the buffer is empty, the draft didn't exist. So prepare the
|
||
;; question.
|
||
(when (or (string= (buffer-string) "")
|
||
(y-or-n-p "Draft buffer exists. Reset it? "))
|
||
(let ((inhibit-point-motion-hooks t)
|
||
(inhibit-read-only t))
|
||
(erase-buffer)
|
||
(when (consp parent)
|
||
(insert (cdr (assoc 'body_markdown parent))))
|
||
(when is-question
|
||
(sx-compose--print-question-headers
|
||
(when (consp parent) parent))
|
||
(unless (consp parent)
|
||
(goto-char (point-min))
|
||
(goto-char (line-end-position))))))
|
||
;; Return the buffer
|
||
(current-buffer))))
|
||
|
||
(defun sx-compose--print-question-headers (question)
|
||
"Print question headers for the compose buffer.
|
||
If QUESTION is non-nil, fill the headers with the data from
|
||
QUESTION."
|
||
(sx-assoc-let question
|
||
(goto-char (point-min))
|
||
(insert
|
||
(format sx-compose--question-headers
|
||
(or .title "") (mapconcat #'identity .tags " ")))))
|
||
|
||
(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 "
|
||
(goto-char (point-min))
|
||
`(,@(when is-question
|
||
(let ((inhibit-point-motion-hooks t)
|
||
(header-end
|
||
(next-single-property-change
|
||
(point-min) 'sx-compose-separator))
|
||
keywords)
|
||
;; Read the Title.
|
||
(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 (sx--split-string (match-string 1) "[[:space:],;]"))
|
||
keywords)
|
||
;; And move past the header so it doesn't get sent.
|
||
(goto-char (next-single-property-change
|
||
header-end 'sx-compose-separator))
|
||
keywords))
|
||
(body . ,(buffer-substring-no-properties (point) (point-max)))))
|
||
|
||
(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
|
||
(sx-assoc-let data
|
||
(format "*sx draft edit %s %s %s*"
|
||
site
|
||
(cond (.title "question")
|
||
(.comment_id "comment")
|
||
(t "answer"))
|
||
(or .comment_id .answer_id .question_id)))))))
|
||
|
||
(provide 'sx-compose)
|
||
;;; sx-compose.el ends here
|
||
|
||
;; Local Variables:
|
||
;; indent-tabs-mode: nil
|
||
;; End:
|