Merge pull request #204 from vermiculus/issue-137-tag-completion

Issue 137 tag completion

6 files changed, 154 insertions, 51 deletions

diff --git a/sx-compose.el b/sx-compose.el
index 8a6edc3..67c476e 100644
--- a/sx-compose.el
+++ b/sx-compose.el
@@ -67,7 +67,7 @@ succeeds.")
 Is invoked between `sx-compose-before-send-hook' and
 `sx-compose-after-send-functions'.")
 
-(defvar sx-compose--question-headers
+(defconst sx-compose--question-headers
   (concat
    #("Title: " 0 7 (intangible t read-only t rear-nonsticky t))
    "%s"
@@ -82,6 +82,23 @@ Is invoked between `sx-compose-before-send-hook' and
   "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)
@@ -95,11 +112,15 @@ 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.
+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
@@ -107,6 +128,9 @@ with the `sx-compose-create' function.
 
 (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.
@@ -120,6 +144,21 @@ contents to the API, then calls `sx-compose-after-send-functions'."
           (run-hook-with-args 'sx-compose-after-send-functions
                               (current-buffer) result)))))
 
+(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 _)
@@ -137,20 +176,26 @@ contents to the API, then calls `sx-compose-after-send-functions'."
     (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
+    (split-string (match-string 1) (rx (any space ",;"))
+                  'omit-nulls (rx space))))
+
 (defun sx-compose--check-tags ()
   "Check if tags in current compose buffer are valid."
   (save-excursion
-    (goto-char (point-min))
-    (unless (search-forward-regexp
-             "^Tags : *\\([^[:space:]].*\\) *$"
-             (next-single-property-change (point-min) 'sx-compose-separator)
-             'noerror)
-      (error "No Tags header found"))
     (let ((invalid-tags
            (sx-tag--invalid-name-p
-            (split-string (match-string 1) "[[:space:],;]"
-                          'omit-nulls "[[:space:]]")
-            sx-compose--site)))
+            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.
@@ -180,6 +225,7 @@ respectively added locally to `sx-compose-before-send-hook' and
     (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
diff --git a/sx-request.el b/sx-request.el
index 6f95687..f892367 100644
--- a/sx-request.el
+++ b/sx-request.el
@@ -216,6 +216,35 @@ Currently returns nil."
   '(()))
 
 
+;;; Our own generated data
+(defvar sx-request--data-url-format
+  "https://raw.githubusercontent.com/vermiculus/sx.el/data/data/%s.el"
+  "Url of the \"data\" directory inside the SX `data' branch.")
+
+(defun sx-request-get-data (file)
+  "Fetch and return data stored online by SX.
+FILE is a string or symbol, the name of the file which holds the
+desired data, relative to `sx-request--data-url-format'.  For
+instance, `tags/emacs' returns the list of tags on Emacs.SE."
+  (let* ((url-automatic-caching t)
+         (url-inhibit-uncompression t)
+         (request-url (format sx-request--data-url-format file))
+         (url-request-method "GET")
+         (url-request-extra-headers
+          '(("Content-Type" . "application/x-www-form-urlencoded")))
+         (response-buffer (url-retrieve-synchronously request-url)))
+    (if (not response-buffer)
+        (error "Something went wrong in `url-retrieve-synchronously'")
+      (with-current-buffer response-buffer
+        (progn
+          (goto-char (point-min))
+          (if (not (search-forward "\n\n" nil t))
+              (error "Headers missing; response corrupt")
+            (when (looking-at-p "Not Found") (error "Page not found."))
+            (prog1 (read (current-buffer))
+              (kill-buffer (current-buffer)))))))))
+
+
 ;;; Support Functions
 (defun sx-request--build-keyword-arguments (alist &optional kv-sep)
   "Format ALIST as a key-value list joined with KV-SEP.
diff --git a/sx-search.el b/sx-search.el
index d47905e..fa08e56 100644
--- a/sx-search.el
+++ b/sx-search.el
@@ -32,13 +32,11 @@
 
 (require 'sx)
 (require 'sx-question-list)
+(require 'sx-tag)
 
 (defvar sx-search--query-history nil
   "Query history for interactive prompts.")
 
-(defvar sx-search--tag-history nil
-  "Tags history for interactive prompts.")
-
 
 ;;; Basic function
 (defun sx-search-get-questions (site page query &optional tags excluded-tags keywords)
@@ -84,15 +82,12 @@ prefix argument, the user is asked for everything."
      (when (string= query "")
        (setq query nil))
      (when current-prefix-arg
-       (setq tags (sx--multiple-read
-                   (format "Tags (%s)"
-                     (if query "optional" "mandatory"))
-                   'sx-search--tag-history))
+       (setq tags (sx-tag-multiple-read
+                   site (concat "Tags" (when query " (optional)"))))
        (when (and (not query) (string= "" tags))
          (sx-user-error "Must supply either QUERY or TAGS"))
        (setq excluded-tags
-             (sx--multiple-read
-              "Excluded tags (optional)" 'sx-search--tag-history)))
+             (sx-tag-multiple-read site "Excluded tags (optional)")))
      (list site query tags excluded-tags)))
   
   ;; Here starts the actual function
diff --git a/sx-switchto.el b/sx-switchto.el
index 458586a..ed83360 100644
--- a/sx-switchto.el
+++ b/sx-switchto.el
@@ -54,18 +54,6 @@
 ;;; These are keys which depend on context.
 ;;;; For instance, it makes no sense to have `switch-site' bound to a
 ;;;; key on a buffer with no `sx-question-list--site' variable.
-(defmacro sx--define-conditional-key (keymap key def &rest body)
-  "In KEYMAP, define key sequence KEY as DEF conditionally.
-This is like `define-key', except the definition \"disapears\"
-whenever BODY evaluates to nil."
-  (declare (indent 3)
-           (debug (form form form &rest sexp)))
-  `(define-key ,keymap ,key
-     '(menu-item
-       ,(format "maybe-%s" (or (car (cdr-safe def)) def)) ignore
-       :filter (lambda (&optional _)
-                 (when (progn ,@body) ,def)))))
-
 (sx--define-conditional-key sx-switchto-map "s" #'sx-question-list-switch-site
   (and (boundp 'sx-question-list--site) sx-question-list--site))
 
diff --git a/sx-tag.el b/sx-tag.el
index 5e75890..b2ad375 100644
--- a/sx-tag.el
+++ b/sx-tag.el
@@ -63,6 +63,23 @@ Returns a list."
           (sx-tag--get-some-tags-containing site string)))
 
 
+;;; Getting tags from our data branch. Without the API.
+;;;; @TODO: Once the cache is finished, this can probably be made into
+;;;; a cache variasble with 1 day expiration time.
+(defvar sx-tag-list-alist nil
+  "Alist where the tag list for each site is stored.
+Elements are of the type (SITE . TAG-LIST).")
+
+(defun sx-tag-list--get (site)
+  "Retrieve all tags from SITE in a single request.
+This does not access the API.  Instead, it uses
+`sx-request-get-data', which accesses SX's tag cache."
+  (or (cdr (assoc site sx-tag-list-alist))
+      (let ((list (sx-request-get-data (concat "tags/" site))))
+        (push (cons site list) sx-tag-list-alist)
+        list)))
+
+
 ;;; Check tag validity
 (defun sx-tag--invalid-name-p (site tags)
   "Nil if TAGS exist in SITE.
@@ -82,6 +99,40 @@ Return the list of invalid tags in TAGS."
             :site site))))
     (cl-remove-if (lambda (x) (member x result)) tags)))
 
+
+;;; Prompt the user for tags.
+(defvar sx-tag-history nil
+  "Tags history for interactive prompts.")
+
+;;; @TODO: Make it so that hitting BACKSPACE with an empty input
+;;; deletes a previously submitted tag.
+(defun sx-tag-multiple-read (site prompt &optional initial-value)
+  "Interactively read a list of tags for SITE.
+Call `sx-completing-read' multiple times, until input is empty,
+with completion options given by the tag list of SITE.
+Return a list of tags given by the user.
+
+PROMPT is a string displayed to the user and should not end with
+a space nor a colon.  INITIAL-VALUE is a list of already-selected
+tags."
+  (let ((completion-list (sx-tag-list--get site))
+        (list (reverse initial-value))
+        (empty-string 
+         (propertize "--\x000-some-string-representing-empty-\x000--"
+                     'display "DONE"))
+        input)
+    (while (not (string=
+                 empty-string
+                 (setq input (sx-completing-read
+                              (concat prompt " ["
+                                      (mapconcat #'identity (reverse list) ",")
+                                      "]: ")
+                              completion-list
+                              nil 'require-match nil 'sx-tag-history
+                              empty-string))))
+      (push input list))
+    (reverse list)))
+
 (provide 'sx-tag)
 ;;; sx-tag.el ends here
 
diff --git a/sx.el b/sx.el
index 5aec9e5..e080271 100644
--- a/sx.el
+++ b/sx.el
@@ -176,24 +176,6 @@ All ARGS are passed to `completing-read' or `ido-completing-read'."
   (apply (if ido-mode #'ido-completing-read #'completing-read)
     args))
 
-(defun sx--multiple-read (prompt hist-var)
-  "Interactively query the user for a list of strings.
-Call `read-string' multiple times, until the input is empty.
-
-PROMPT is a string displayed to the user and should not end with
-a space nor a colon.  HIST-VAR is a quoted symbol, indicating a
-list in which to store input history."
-  (let (list input)
-    (while (not (string=
-                 ""
-                 (setq input (read-string
-                              (concat prompt " ["
-                                      (mapconcat #'identity list ",")
-                                      "]: ")
-                              "" hist-var))))
-      (push input list))
-    list))
-
 (defmacro sx-sorted-insert-skip-first (newelt list &optional predicate)
   "Inserted NEWELT into LIST sorted by PREDICATE.
 This is designed for the (site id id ...) lists.  So the first car
@@ -265,6 +247,18 @@ Anything before the (sub)domain is removed."
     (rx string-start (or (and (0+ word) (optional ":") "//")))
     "" url)))
 
+(defmacro sx--define-conditional-key (keymap key def &rest body)
+  "In KEYMAP, define key sequence KEY as DEF conditionally.
+This is like `define-key', except the definition \"disappears\"
+whenever BODY evaluates to nil."
+  (declare (indent 3)
+           (debug (form form form &rest sexp)))
+  `(define-key ,keymap ,key
+     '(menu-item
+       ,(format "maybe-%s" (or (car (cdr-safe def)) def)) ignore
+       :filter (lambda (&optional _)
+                 (when (progn ,@body) ,def)))))
+
 
 ;;; Printing request data
 (defvar sx--overlays nil