aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Cask8
-rw-r--r--README.org11
-rw-r--r--list-and-question.pngbin0 -> 450796 bytes
-rw-r--r--sx-auth.el5
-rw-r--r--sx-babel.el124
-rw-r--r--sx-button.el18
-rw-r--r--sx-compose.el78
-rw-r--r--sx-filter.el2
-rw-r--r--sx-inbox.el216
-rw-r--r--sx-interaction.el142
-rw-r--r--sx-load.el54
-rw-r--r--sx-method.el6
-rw-r--r--sx-notify.el86
-rw-r--r--sx-question-list.el50
-rw-r--r--sx-question-mode.el54
-rw-r--r--sx-question-print.el145
-rw-r--r--sx-question.el49
-rw-r--r--sx-request.el86
-rw-r--r--sx-search.el112
-rw-r--r--sx-tab.el31
-rw-r--r--sx-time.el2
-rw-r--r--sx.el306
-rw-r--r--sx.org81
-rw-r--r--test/data-samples/inbox-item.el13
-rw-r--r--test/test-api.el13
-rw-r--r--test/test-macros.el22
-rw-r--r--test/test-printing.el73
-rw-r--r--test/test-search.el53
-rw-r--r--test/test-util.el31
-rw-r--r--test/tests.el168
30 files changed, 1503 insertions, 536 deletions
diff --git a/Cask b/Cask
index f0c70fb..a055f12 100644
--- a/Cask
+++ b/Cask
@@ -1,14 +1,8 @@
-(package "stack-mode" "0" "Stack Exchange for Emacs")
-
(source gnu)
(source melpa-stable)
+(package-file "sx.el")
(files "sx*.el")
-(depends-on "json" "1.4")
-(depends-on "url")
-(depends-on "cl-lib")
-(depends-on "markdown-mode")
-
(development
(depends-on "ert"))
diff --git a/README.org b/README.org
index 460ba34..b9888a7 100644
--- a/README.org
+++ b/README.org
@@ -4,9 +4,11 @@
[[https://gitter.im/vermiculus/sx.el?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge][https://badges.gitter.im/Join Chat.svg]]
[[https://www.waffle.io/vermiculus/sx.el][https://badge.waffle.io/vermiculus/sx.el.svg]]
-SX will be a full featured Stack Exchange mode for GNU Emacs 24+. Using the
-official API, we aim to create a more versatile experience for the Stack
-Exchange network within Emacs itself.
+SX is a full featured Stack Exchange mode for GNU Emacs 24+. Using the official
+API, it provides a versatile experience for the Stack Exchange network within
+Emacs itself.
+
+[[file:list-and-question.png]]
* Features
** Viewing Questions
@@ -36,8 +38,7 @@ As always, =C-h m= is the definitive resource for the functions of this mode.
To install the development version, follow the usual steps:
- Clone this repository
- Add this directory to your ~load-path~
-- Issue ~(require 'sx)~
-- Issue ~(require 'sx-tab)~
+- Issue ~(require 'sx-load)~
This should give you access to the ~sx-tab-~ functions (the main entry points at
this time).
diff --git a/list-and-question.png b/list-and-question.png
new file mode 100644
index 0000000..9e89fec
--- /dev/null
+++ b/list-and-question.png
Binary files differ
diff --git a/sx-auth.el b/sx-auth.el
index b6c0411..fca5392 100644
--- a/sx-auth.el
+++ b/sx-auth.el
@@ -80,7 +80,8 @@ will be (METHOD . t)")
Keywords are of form (OBJECT TYPES) where TYPES is (FILTER FILTER
FILTER).")
-(defun sx-auth-authenticate ()
+;;;###autoload
+(defun sx-authenticate ()
"Authenticate this application.
Authentication is required to read your personal data (such as
notifications) and to write with the API (asking and answering
@@ -126,8 +127,6 @@ parsed and displayed prominently on the page)."
(error "You must enter this code to use this client fully"))
(sx-cache-set 'auth `((access_token . ,sx-auth-access-token)))))
-(defalias 'sx-authenticate #'sx-auth-authenticate)
-
(defun sx-auth--method-p (method &optional submethod)
"Check if METHOD is one that may require authentication.
If it has `auth-required' SUBMETHODs, or no submethod, return t."
diff --git a/sx-babel.el b/sx-babel.el
new file mode 100644
index 0000000..b30a044
--- /dev/null
+++ b/sx-babel.el
@@ -0,0 +1,124 @@
+;;; sx-babel.el --- Font-locking pre blocks according to language. -*- 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 contains functions and a variable for font-locking the
+;; content of markdown pre blocks according to their language. The
+;; main configuration point, for both the user and the developer is
+;; the varuable `sx-babel-major-mode-alist', which see.
+
+
+;;; Code:
+(require 'sx-button)
+
+(defvar sx-babel-major-mode-alist
+ `((,(rx (or "*" "#+")) org-mode)
+ (,(rx (or "[" "(" ";" "#(")) emacs-lisp-mode)
+ ;; @TODO: Make shell-mode work here. Currently errors because it
+ ;; needs a process. `sh-mode' isn't as nice.
+ (,(rx (or "$ " "# ")) sh-mode)
+ )
+ "List of cons cells determining which major-mode to use when.
+Each car is a rule and each cdr is a major-mode. The first rule
+which is satisfied activates the major-mode.
+
+Point is moved to the first non-blank character before testing
+the rule, which can either be a string or a function. If it is a
+string, is tested as a regexp starting from point. If it is a
+function, is called with no arguments and should return non-nil
+on a match.")
+(put 'sx-babel-major-mode-alist 'risky-local-variable-p t)
+
+
+;;; Font-locking the text
+(defun sx-babel--make-pre-button (beg end)
+ "Turn the region between BEG and END into a button."
+ (let ((text (buffer-substring-no-properties beg end))
+ indent mode copy)
+ (with-temp-buffer
+ (insert text)
+ (setq indent (sx-babel--unindent-buffer))
+ (goto-char (point-min))
+ (setq mode (sx-babel--determine-major-mode))
+ (setq copy (replace-regexp-in-string "[[:space:]]+\\'" "" (buffer-string)))
+ (when mode
+ (delay-mode-hooks (funcall mode)))
+ (font-lock-fontify-region (point-min) (point-max))
+ (goto-char (point-min))
+ (let ((space (make-string indent ?\s)))
+ (while (not (eobp))
+ (insert-and-inherit space)
+ (forward-line 1)))
+ (setq text (buffer-string)))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert-text-button
+ text
+ 'sx-button-copy copy
+ ;; We store the mode here so it can be used if the user wants
+ ;; to edit the code block.
+ 'sx-mode mode
+ :type 'sx-question-mode-code-block)))
+
+(defun sx-babel--determine-major-mode ()
+ "Return the major-mode most suitable for the current buffer."
+ (let ((alist sx-babel-major-mode-alist)
+ cell out)
+ (while (setq cell (pop alist))
+ (goto-char (point-min))
+ (skip-chars-forward "\r\n[:blank:]")
+ (let ((kar (car cell)))
+ (when (if (stringp kar) (looking-at kar) (funcall kar))
+ (setq alist nil)
+ (setq out (cadr cell)))))
+ out))
+
+(defun sx-babel--unindent-buffer ()
+ "Remove absolute indentation in current buffer.
+Finds the least indented line, and removes that amount of
+indentation from all lines. Primarily designed to extract the
+content of markdown code blocks.
+
+Returns the amount of indentation removed."
+ (save-excursion
+ (goto-char (point-min))
+ (let (result)
+ ;; Get indentation of each non-blank line
+ (while (null (eobp))
+ (skip-chars-forward "[:blank:]")
+ (unless (looking-at "$")
+ (push (current-column) result))
+ (forward-line 1))
+ (when result
+ (setq result (apply #'min result))
+ ;; Build a regexp with the smallest indentation
+ (let ((rx (format "^ \\{0,%s\\}" result)))
+ (goto-char (point-min))
+ ;; Use this regexp to remove that much indentation
+ ;; throughout the buffer.
+ (while (and (null (eobp))
+ (search-forward-regexp rx nil 'noerror))
+ (replace-match "")
+ (forward-line 1))))
+ (or result 0))))
+
+(provide 'sx-babel)
+;;; sx-babel.el ends here
+
diff --git a/sx-button.el b/sx-button.el
index dbadc2e..f166164 100644
--- a/sx-button.el
+++ b/sx-button.el
@@ -51,7 +51,8 @@
'((((type x w32 ns) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
- "Face used on buttons such as \"Write an Answer\".")
+ "Face used on buttons such as \"Write an Answer\"."
+ :group 'sx)
;;; Command definitions
@@ -76,27 +77,30 @@ This is usually a link's URL, or the content of a code block."
(point) 'sx-button-copy-type)
content)))))
-(defun sx-button-edit-this (text-or-marker)
- "Open a temp buffer populated with the string TEXT-OR-MARKER.
+(defun sx-button-edit-this (text-or-marker &optional major-mode)
+ "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJOR-MODE.
When given a marker (or interactively), use the 'sx-button-copy
-text-property under the marker. This is usually the content of a
-code-block."
+and the 'sx-mode text-properties under the marker. These are
+usually part of a code-block."
(interactive (list (point-marker)))
;; Buttons receive markers.
(when (markerp text-or-marker)
+ (setq major-mode (get-text-property text-or-marker 'sx-mode))
(unless (setq text-or-marker
(get-text-property text-or-marker 'sx-button-copy))
(sx-message "Nothing of interest here.")))
(with-current-buffer (pop-to-buffer (generate-new-buffer
"*sx temp buffer*"))
- (insert text-or-marker)))
+ (insert text-or-marker)
+ (when major-mode
+ (funcall major-mode))))
(defun sx-button-follow-link (&optional pos)
"Follow link at POS. If POS is nil, use `point'."
(interactive)
(browse-url
(or (get-text-property (or pos (point)) 'sx-button-url)
- (user-error "No url under point: %s" (or pos (point))))))
+ (sx-user-error "No url under point: %s" (or pos (point))))))
;;; Help-echo definitions
diff --git a/sx-compose.el b/sx-compose.el
index 5d22bf7..d27d2f3 100644
--- a/sx-compose.el
+++ b/sx-compose.el
@@ -43,7 +43,7 @@
;;; Faces and Variables
-(defvar sx-compose-before-send-hook nil
+(defvar sx-compose-before-send-hook nil
"Hook run before POSTing to the API.
Functions are called without arguments and should return non-nil.
@@ -54,7 +54,7 @@ notifying the user.
Current buffer is the compose-mode buffer whose content is about
to be POSTed.")
-(defvar sx-compose-after-send-functions nil
+(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
@@ -70,12 +70,15 @@ Is invoked between `sx-compose-before-send-hook' and
(defvar 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\n"
- 0 42 (read-only t rear-nonsticky t intangible t
- sx-compose-separator 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'.")
@@ -120,9 +123,12 @@ contents to the API, then calls `sx-compose-after-send-functions'."
;;; Functions for use in hooks
(defun sx-compose-quit (buffer _)
- "Kill 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)
+ (delete-window w)))
(kill-buffer buffer)))
(defun sx-compose--copy-as-kill (buffer _)
@@ -155,9 +161,9 @@ contents to the API, then calls `sx-compose-after-send-functions'."
;;; 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.
+SITE is the site where it will be posted.
-If composing questions, PARENT is nil.
+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.
@@ -169,20 +175,24 @@ respectively added locally to `sx-compose-before-send-hook' and
(error "Invalid PARENT"))
(let ((is-question
(and (listp parent)
- (null (cdr (assoc 'answer_id 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--send-function
(if (consp parent)
(sx-assoc-let parent
- (lambda () (sx-method-call (if .title 'questions 'answers)
+ (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 .answer_id .question_id)
+ :id (or .comment_id .answer_id .question_id)
:submethod 'edit)))
(lambda () (sx-method-call 'questions
:auth 'warn
@@ -201,19 +211,32 @@ respectively added locally to `sx-compose-before-send-hook' and
(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 (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? "))
+ (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)
- (insert (cdr (assoc 'body_markdown parent)))))
+ (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'.
@@ -223,7 +246,7 @@ other keywords are read from the header "
`(,@(when is-question
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t)
- (header-end
+ (header-end
(next-single-property-change
(point-min) 'sx-compose-separator))
keywords)
@@ -238,8 +261,8 @@ other keywords are read from the header "
(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:]]"))
+ (push (cons 'tags (split-string (match-string 1)
+ "[[:space:],;]" 'omit-nulls))
keywords)
;; And erase the header so it doesn't get sent.
(delete-region
@@ -269,8 +292,13 @@ the id property."
site data)))
(t
(get-buffer-create
- (format "*sx draft edit %s %s*"
- site (sx-assoc-let data (or .answer_id .question_id)))))))
+ (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
diff --git a/sx-filter.el b/sx-filter.el
index 38084b9..8c00c12 100644
--- a/sx-filter.el
+++ b/sx-filter.el
@@ -1,4 +1,4 @@
-;;; sx-filter.el --- filters -*- lexical-binding: t; -*-
+;;; sx-filter.el --- Handles retrieval of filters. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
diff --git a/sx-inbox.el b/sx-inbox.el
new file mode 100644
index 0000000..d0be379
--- /dev/null
+++ b/sx-inbox.el
@@ -0,0 +1,216 @@
+;;; sx-inbox.el --- Base inbox logic. -*- 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-method)
+(require 'sx-question-list)
+
+
+;;; API
+(defvar sx-inbox-filter
+ '((inbox_item.answer_id
+ inbox_item.body
+ inbox_item.comment_id
+ inbox_item.creation_date
+ inbox_item.is_unread
+ inbox_item.item_type
+ inbox_item.link
+ inbox_item.question_id
+ inbox_item.site
+ inbox_item.title)
+ (site.logo_url
+ site.audience
+ site.icon_url
+ site.high_resolution_icon_url
+ site.site_state
+ site.launch_date
+ site.markdown_extensions
+ site.related_sites
+ site.styling))
+ "Filter used when retrieving inbox items.")
+
+(defcustom sx-inbox-fill-column 40
+ "`fill-column' used in `sx-inbox-mode'."
+ :type 'integer
+ :group 'sx)
+
+(defun sx-inbox-get (&optional notifications page keywords)
+ "Get an array of inbox items for the current user.
+If NOTIFICATIONS is non-nil, query from `notifications' method,
+otherwise use `inbox' method.
+
+Return an array of items. Each item is an alist of properties
+returned by the API.
+See https://api.stackexchange.com/docs/types/inbox-item
+
+KEYWORDS are added to the method call along with PAGE.
+
+`sx-method-call' is used with `sx-inbox-filter'."
+ (sx-method-call (if notifications 'notifications 'inbox)
+ :keywords keywords
+ :filter sx-inbox-filter))
+
+
+;;; Major-mode
+(defvar sx-inbox--notification-p nil
+ "If non-nil, current buffer lists notifications, not inbox.")
+(make-variable-buffer-local 'sx-inbox--notification-p)
+
+(defvar sx-inbox--unread-inbox nil
+ "List of inbox items still unread.")
+
+(defvar sx-inbox--unread-notifications nil
+ "List of notifications items still unread.")
+
+(defvar sx-inbox--read-inbox nil
+ "List of inbox items which are read.
+These are identified by their links.")
+
+(defvar sx-inbox--read-notifications nil
+ "List of notification items which are read.
+These are identified by their links.")
+
+(defvar sx-inbox--header-line
+ '(" "
+ (:propertize "n p j k" face mode-line-buffer-id)
+ ": Navigate"
+ " "
+ (:propertize "RET" face mode-line-buffer-id)
+ ": View"
+ " "
+ (:propertize "v" face mode-line-buffer-id)
+ ": Visit externally"
+ " "
+ (:propertize "q" face mode-line-buffer-id)
+ ": Quit")
+ "Header-line used on the inbox list.")
+
+(defvar sx-inbox--mode-line
+ '(" "
+ (:propertize
+ (sx-inbox--notification-p
+ "Notifications"
+ "Inbox")
+ face mode-line-buffer-id))
+ "Mode-line used on the inbox list.")
+
+(define-derived-mode sx-inbox-mode
+ sx-question-list-mode "Question List"
+ "Mode used to list inbox and notification items."
+ (toggle-truncate-lines 1)
+ (setq fill-column sx-inbox-fill-column)
+ (setq sx-question-list--print-function #'sx-inbox--print-info)
+ (setq sx-question-list--next-page-function
+ (lambda (page) (sx-inbox-get sx-inbox--notification-p page)))
+ (setq tabulated-list-format
+ [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)])
+ (setq mode-line-format sx-inbox--mode-line)
+ (setq header-line-format sx-inbox--header-line)
+ ;; @TODO: This will no longer be necessary once we properly
+ ;; refactor sx-question-list-mode.
+ (remove-hook 'tabulated-list-revert-hook
+ #'sx-question-list--update-mode-line t))
+
+
+;;; Keybinds
+(mapc (lambda (x) (define-key sx-inbox-mode-map (car x) (cadr x)))
+ '(
+ ("t" nil)
+ ("a" nil)
+ ("h" nil)
+ ("m" sx-inbox-mark-read)
+ ([?\r] sx-display)
+ ))
+
+
+;;; print-info
+(defun sx-inbox--print-info (data)
+ "Convert `json-read' DATA into tabulated-list format.
+
+This is the default printer used by `sx-inbox'. It assumes DATA
+is an alist containing the elements:
+ `answer_id', `body', `comment_id', `creation_date', `is_unread',
+ `item_type', `link', `question_id', `site', `title'."
+ (list
+ data
+ (sx-assoc-let data
+ (vector
+ (list
+ (concat (capitalize
+ (replace-regexp-in-string
+ "_" " " (or .item_type .notification_type)))
+ (cond (.answer_id " on Answer at:")
+ (.question_id " on:")))
+ 'face 'font-lock-keyword-face)
+ (list
+ (concat (sx-time-since .creation_date)
+ sx-question-list-ago-string)
+ 'face 'sx-question-list-date)
+ (list
+ (propertize
+ " " 'display
+ (concat "\n " (propertize .title 'face 'sx-question-list-date) "\n"
+ (let ((col fill-column))
+ (with-temp-buffer
+ (setq fill-column col)
+ (insert " " .body)
+ (fill-region (point-min) (point-max))
+ (buffer-string))))
+ 'face 'default))))))
+
+
+;;; Entry commands
+(defvar sx-inbox--buffer nil
+ "Buffer being used to display inbox.")
+
+(defun sx-inbox (&optional notifications)
+ "Display a buffer listing inbox items.
+With prefix NOTIFICATIONS, list notifications instead of inbox."
+ (interactive "P")
+ (setq sx-inbox--buffer (get-buffer-create "*sx-inbox*"))
+ (let ((inhibit-read-only t))
+ (with-current-buffer sx-inbox--buffer
+ (erase-buffer)
+ (sx-inbox-mode)
+ (setq sx-inbox--notification-p notifications)
+ (tabulated-list-revert)))
+ (let ((w (get-buffer-window sx-inbox--buffer)))
+ (if (window-live-p w)
+ (select-window w)
+ (pop-to-buffer sx-inbox--buffer)
+ (enlarge-window
+ (- (+ fill-column 4) (window-width))
+ 'horizontal))))
+
+(defun sx-inbox-notifications ()
+ "Display a buffer listing notification items."
+ (interactive)
+ (sx-inbox t))
+
+(provide 'sx-inbox)
+;;; sx-inbox.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
diff --git a/sx-interaction.el b/sx-interaction.el
index 9b63e0a..3877035 100644
--- a/sx-interaction.el
+++ b/sx-interaction.el
@@ -44,7 +44,6 @@
(require 'sx-question-mode)
(require 'sx-question-list)
(require 'sx-compose)
-(require 'sx-tab)
;;; Using data in buffer
@@ -61,7 +60,7 @@ If no object of the requested type could be returned, an error is
thrown unless NOERROR is non-nil."
(or (let ((data (get-char-property (point) 'sx--data-here)))
(if (null type) data
- (sx-assoc-let type
+ (sx-assoc-let data
;; Is data of the right type?
(cl-case type
(question (when .title data))
@@ -86,7 +85,7 @@ If it's not a question, or if it is read, return DATA."
;; If we found a question, we may need to check if it's read.
(if (and (assoc 'title data)
(null (sx-question--read-p data)))
- (user-error "Question not yet read. View it before acting on it")
+ (sx-user-error "Question not yet read. View it before acting on it")
data))
(defun sx--maybe-update-display (&optional buffer)
@@ -94,10 +93,11 @@ If it's not a question, or if it is read, return DATA."
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)))))
+ (with-current-buffer 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.
@@ -107,7 +107,7 @@ Only fields contained in TO are copied."
;;; Visiting
-(defun sx-visit (data &optional copy-as-kill)
+(defun sx-visit-externally (data &optional copy-as-kill)
"Visit DATA in a web browser.
DATA can be a question, answer, or comment. Interactively, it is
derived from point position.
@@ -119,27 +119,64 @@ Interactively, this is specified with a prefix argument.
If DATA is a question, also mark it as read."
(interactive (list (sx--data-here) current-prefix-arg))
(sx-assoc-let data
- (let ((link
- (when (stringp .link)
- (funcall (if copy-as-kill #'kill-new #'browse-url)
- .link))))
+ (if (not (stringp .link))
+ (sx-message "Nothing to visit here.")
+ (funcall (if copy-as-kill #'kill-new #'browse-url) .link)
(when (and (called-interactively-p 'any) copy-as-kill)
- (message "Copied: %S" link)))
- (when (and .title (not copy-as-kill))
- (sx-question--mark-read data)
- (sx--maybe-update-display))))
+ (message "Copied: %S" .link))
+ (when (and .title (not copy-as-kill))
+ (sx-question--mark-read data)
+ (sx--maybe-update-display)))))
+
+(defun sx-open-link (link)
+ "Visit element given by LINK inside Emacs.
+Element can be a question, answer, or comment."
+ (interactive
+ (let ((def (with-temp-buffer
+ (save-excursion (yank))
+ (thing-at-point 'url))))
+ (list (read-string (concat "Link (" def "): ") nil nil def))))
+ (let ((data (sx--link-to-data link)))
+ (sx-assoc-let data
+ (cl-case .type
+ (answer
+ (sx-display-question
+ (sx-question-get-from-answer .site_par .id) 'focus))
+ (question
+ (sx-display-question
+ (sx-question-get-question .site_par .id) 'focus))))))
;;; Displaying
+(defun sx-display (&optional data)
+ "Display object given by DATA.
+Interactively, display object under point. Object can be a
+question, an answer, or an inbox_item.
+
+This is meant for interactive use. In lisp code, use
+object-specific functions such as `sx-display-question' and the
+likes."
+ (interactive (list (sx--data-here)))
+ (sx-assoc-let data
+ (cond
+ (.notification_type
+ (sx-message "Viewing notifications is not yet implemented"))
+ (.item_type (sx-open-link .link))
+ (.answer_id
+ (sx-display-question
+ (sx-question-get-from-answer .site_par .id) 'focus))
+ (.title
+ (sx-display-question data 'focus)))))
+
(defun sx-display-question (&optional data focus window)
"Display question given by DATA, on WINDOW.
-When DATA is nil, display question under point. When FOCUS is
+Interactively, display question under point. When FOCUS is
non-nil (the default when called interactively), also focus the
-relevant window.
+relevant window.
If WINDOW nil, the window is decided by
`sx-question-mode-display-buffer-function'."
- (interactive (list (sx--data-here) t))
+ (interactive (list (sx--data-here 'question) t))
(when (sx-question--mark-read data)
(sx--maybe-update-display))
;; Display the question.
@@ -188,7 +225,7 @@ changes."
:auth 'warn
:url-method "POST"
:filter sx-browse-filter
- :site .site))))
+ :site .site_par))))
;; The api returns the new DATA.
(when (> (length result) 0)
(sx--copy-data (elt result 0) data)
@@ -216,8 +253,8 @@ TEXT is a string. Interactively, it is read from the minibufer."
"Comment text: "
(when .comment_id
(concat (sx--user-@name .owner) " "))))
- (while (< (string-width text) 15)
- (setq text (read-string "Comment text (at least 15 characters): " text))))
+ (while (not (sx--comment-valid-p text 'silent))
+ (setq text (read-string "Comment text (between 16 and 600 characters): " text))))
;; If non-interactive, `text' could be anything.
(unless (stringp text)
(error "Comment body must be a string"))
@@ -229,27 +266,39 @@ TEXT is a string. Interactively, it is read from the minibufer."
:auth 'warn
:url-method "POST"
:filter sx-browse-filter
- :site .site
+ :site .site_par
:keywords `((body . ,text)))))
;; The api returns the new DATA.
(when (> (length result) 0)
(sx--add-comment-to-object
(elt result 0)
(if .post_id
- (sx--get-post .post_type .site .post_id)
+ (sx--get-post .post_type .site_par .post_id)
data))
;; Display the changes in `data'.
(sx--maybe-update-display)))))
+(defun sx--comment-valid-p (&optional text silent)
+ "Non-nil if TEXT fits stack exchange comment length limits.
+If TEXT is nil, use `buffer-string'. Must have more than 15 and
+less than 601 characters.
+If SILENT is nil, message the user about this limit."
+ (let ((w (string-width (or text (buffer-string)))))
+ (if (and (< 15 w) (< w 601))
+ t
+ (unless silent
+ (message "Comments must be within 16 and 600 characters."))
+ nil)))
+
(defun sx--get-post (type site id)
"Find in the database a post identified by TYPE, SITE and ID.
-TYPE is `question' or `answer'.
+TYPE is `question' or `answer'.
SITE is a string.
ID is an integer."
(let ((db (cons sx-question-mode--data
sx-question-list--dataset)))
(setq db
- (cond
+ (cond
((string= type "question") db)
((string= type "answer")
(apply #'cl-map 'list #'identity
@@ -257,7 +306,7 @@ ID is an integer."
(car (cl-member-if
(lambda (x) (sx-assoc-let x
(and (equal (or .answer_id .question_id) id)
- (equal .site site))))
+ (equal .site_par site))))
db))))
(defun sx--add-comment-to-object (comment object)
@@ -287,11 +336,12 @@ from context at point."
;; 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
+ .site_par data
+ ;; Before send hook
+ (when .comment_id (list #'sx--comment-valid-p))
;; After send functions
(list (lambda (_ res)
(sx--copy-data (elt res 0) data)
@@ -299,16 +349,44 @@ from context at point."
;;; Asking
+(defcustom sx-default-site "emacs"
+ "Name of the site to use by default when listing questions."
+ :type 'string
+ :group 'sx)
+
+(defun sx--interactive-site-prompt ()
+ "Query the user for a site."
+ (let ((default (or sx-question-list--site
+ (sx-assoc-let sx-question-mode--data .site_par)
+ sx-default-site)))
+ (sx-completing-read
+ (format "Site (%s): " default)
+ (sx-site-get-api-tokens) nil t nil nil
+ default)))
+
+(defun sx--maybe-site-prompt (arg)
+ "Get a site token conditionally in an interactive context.
+If ARG is non-nil, use `sx--interactive-site-prompt'.
+Otherwise, use `sx-question-list--site' if non-nil.
+If nil, use `sx--interactive-site-prompt' anyway."
+ ;; This could eventually be generalized into (sx--maybe-prompt
+ ;; prefix-arg value-if-non-nil #'prompt-function).
+ (if arg
+ (sx--interactive-site-prompt)
+ (or sx-question-list--site
+ (sx--interactive-site-prompt))))
+
+;;;###autoload
(defun sx-ask (site)
"Start composing a question for SITE.
SITE is a string, indicating where the question will be posted."
- (interactive (list (sx-tab--interactive-site-prompt)))
+ (interactive (list (sx--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)))))))
+ (list (lambda (_b _res) (sx--maybe-update-display buffer)))))))
;;; Answering
@@ -326,7 +404,7 @@ context at point. "
(sx-assoc-let data
(pop-to-buffer
(sx-compose-create
- .site .question_id nil
+ .site_par .question_id nil
;; After send functions
(list (lambda (_ res)
(sx--add-answer-to-question-object
diff --git a/sx-load.el b/sx-load.el
new file mode 100644
index 0000000..e7cb6b0
--- /dev/null
+++ b/sx-load.el
@@ -0,0 +1,54 @@
+;;; sx-load.el --- Load all files of the sx package.
+
+;; 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:
+(mapc #'require
+ '(sx
+ sx-time
+ sx-auth
+ sx-button
+ sx-babel
+ sx-cache
+ sx-compose
+ sx-encoding
+ sx-favorites
+ sx-filter
+ sx-inbox
+ sx-interaction
+ sx-method
+ sx-networks
+ sx-notify
+ sx-question
+ sx-question-list
+ sx-question-mode
+ sx-question-print
+ sx-request
+ sx-search
+ sx-site
+ sx-tab
+ ))
+
+(provide 'sx-load)
+;;; sx-load.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
diff --git a/sx-method.el b/sx-method.el
index 83455b8..1078014 100644
--- a/sx-method.el
+++ b/sx-method.el
@@ -1,4 +1,4 @@
-;;; sx-method.el --- method calls
+;;; sx-method.el --- Main interface for API method calls. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
@@ -90,8 +90,8 @@ Return the entire response as a complex alist."
(cond
;; 1. Need auth and warn user (interactive use)
((and method-auth (equal 'warn auth))
- (user-error
- "This request requires authentication. Please run `M-x sx-auth-authenticate' and try again."))
+ (sx-user-error
+ "This request requires authentication. Please run `M-x sx-authenticate' and try again."))
;; 2. Need auth to populate UI, cannot provide subset
((and method-auth auth)
(setq call 'sx-request-fallback))
diff --git a/sx-notify.el b/sx-notify.el
new file mode 100644
index 0000000..c335427
--- /dev/null
+++ b/sx-notify.el
@@ -0,0 +1,86 @@
+;;; sx-notify.el --- Mode-line notifications. -*- 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-inbox)
+
+
+;;; mode-line notification
+(defvar sx-notify--mode-line
+ '((sx-inbox--unread-inbox (sx-inbox--unread-notifications " ["))
+ (sx-inbox--unread-inbox
+ (:propertize
+ (:eval (format "i:%s" (length sx-inbox--unread-inbox)))
+ face mode-line-buffer-id
+ mouse-face mode-line-highlight))
+ (sx-inbox--unread-inbox (sx-inbox--unread-notifications " "))
+ (sx-inbox--unread-notifications
+ (:propertize
+ (:eval (format "n:%s" (length sx-inbox--unread-notifications)))
+ mouse-face mode-line-highlight))
+ (sx-inbox--unread-inbox (sx-notify--unread-notifications "]")))
+ "")
+(put 'sx-notify--mode-line 'risky-local-variable t)
+
+
+;;; minor-mode definition
+(defcustom sx-notify-timer-delay (* 60 5)
+ "Idle time, in seconds, before querying for inbox items."
+ :type 'integer
+ :group 'sx-notify)
+
+(defvar sx-notify--timer nil
+ "Timer used for fetching notifications.")
+
+(define-minor-mode sx-notify-mode nil nil nil nil
+ :global t
+ (if sx-notify-mode
+ (progn
+ (add-to-list 'global-mode-string '(t sx-notify--mode-line) 'append)
+ (setq sx-notify--timer
+ (run-with-idle-timer sx-notify-timer-delay 'repeat
+ #'sx-notify--update-unread)))
+ (when (timerp sx-notify--timer)
+ (cancel-timer sx-notify--timer)
+ (setq sx-notify--timer nil))
+ (setq global-mode-string
+ (delete '(t sx-notify--mode-line) global-mode-string))))
+
+(defun sx-notify--update-unread ()
+ "Update the lists of unread notifications."
+ (setq sx-inbox--unread-inbox
+ (cl-remove-if
+ (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-inbox))
+ (append (sx-inbox-get) nil)))
+ (setq sx-inbox--unread-notifications
+ (cl-remove-if
+ (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-notifications))
+ (append (sx-inbox-get t) nil))))
+
+(provide 'sx-notify)
+;;; sx-notify.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
diff --git a/sx-question-list.el b/sx-question-list.el
index c5c32d9..cf849db 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -127,7 +127,7 @@ elements:
Also see `sx-question-list-refresh'."
(sx-assoc-let question-data
(let ((favorite (if (member .question_id
- (assoc .site
+ (assoc .site_par
sx-favorites--user-favorite-list))
(if (char-displayable-p ?\x2b26) "\x2b26" "*") " ")))
(list
@@ -196,6 +196,21 @@ and thus not displayed in the list of questions.
This is ignored if `sx-question-list--refresh-function' is set.")
(make-variable-buffer-local 'sx-question-list--dataset)
+(defvar sx-question-list--header-line
+ '(" "
+ (:propertize "n p j k" face mode-line-buffer-id)
+ ": Navigate"
+ " "
+ (:propertize "RET" face mode-line-buffer-id)
+ ": View question"
+ " "
+ (:propertize "v" face mode-line-buffer-id)
+ ": Visit externally"
+ " "
+ (:propertize "q" face mode-line-buffer-id)
+ ": Quit")
+ "Header-line used on the question list.")
+
;;; Mode Definition
(define-derived-mode sx-question-list-mode
@@ -266,7 +281,7 @@ into consideration.
#'sx-question-list-refresh nil t)
(add-hook 'tabulated-list-revert-hook
#'sx-question-list--update-mode-line nil t)
- (tabulated-list-init-header))
+ (setq header-line-format sx-question-list--header-line))
(defcustom sx-question-list-date-sort-method 'last_activity_date
"Parameter which controls date sorting."
@@ -286,7 +301,11 @@ into consideration.
(mapc
(lambda (x) (define-key sx-question-list-mode-map
(car x) (cadr x)))
- '(("n" sx-question-list-next)
+ '(
+ ;; S-down and S-up would collide with `windmove'.
+ ([down] sx-question-list-next)
+ ([up] sx-question-list-previous)
+ ("n" sx-question-list-next)
("p" sx-question-list-previous)
("j" sx-question-list-view-next)
("k" sx-question-list-view-previous)
@@ -296,14 +315,16 @@ into consideration.
("K" sx-question-list-previous-far)
("g" sx-question-list-refresh)
(":" sx-question-list-switch-site)
- ("t" sx-question-list-switch-tab)
+ ("t" sx-tab-switch)
("a" sx-ask)
- ("v" sx-visit)
+ ("s" sx-search)
+ ("v" sx-visit-externally)
("u" sx-toggle-upvote)
("d" sx-toggle-downvote)
("h" sx-question-list-hide)
("m" sx-question-list-mark-read)
- ([?\r] sx-display-question)))
+ ([?\r] sx-display)
+ ))
(defun sx-question-list-hide (data)
"Hide question under point.
@@ -311,8 +332,13 @@ Non-interactively, DATA is a question alist."
(interactive
(list (if (derived-mode-p 'sx-question-list-mode)
(tabulated-list-get-id)
- (user-error "Not in `sx-question-list-mode'"))))
+ (sx-user-error "Not in `sx-question-list-mode'"))))
(sx-question--mark-hidden data)
+ ;; The current entry will not be present after the list is
+ ;; redisplayed. To avoid `tabulated-list-mode' getting lost (and
+ ;; sending us to the top) we move to the next entry before
+ ;; redisplaying.
+ (forward-line 1)
(when (called-interactively-p 'any)
(sx-question-list-refresh 'redisplay 'noupdate)))
@@ -322,7 +348,7 @@ Non-interactively, DATA is a question alist."
(interactive
(list (if (derived-mode-p 'sx-question-list-mode)
(tabulated-list-get-id)
- (user-error "Not in `sx-question-list-mode'"))))
+ (sx-user-error "Not in `sx-question-list-mode'"))))
(sx-question--mark-read data)
(sx-question-list-next 1)
(when (called-interactively-p 'any)
@@ -427,9 +453,8 @@ Displayed in `sx-question-mode--window', replacing any question
that may currently be there."
(interactive "p")
(sx-question-list-next n)
- (sx-display-question
- (tabulated-list-get-id)
- nil
+ (sx-question-mode--display
+ (tabulated-list-get-id)
(sx-question-list--create-question-window)))
(defun sx-question-list--create-question-window ()
@@ -535,12 +560,11 @@ This does not update `sx-question-mode--window'."
(defun sx-question-list-switch-site (site)
"Switch the current site to SITE and display its questions.
-Use `ido-completing-read' if variable `ido-mode' is active.
Retrieve completions from `sx-site-get-api-tokens'.
Sets `sx-question-list--site' and then call
`sx-question-list-refresh' with `redisplay'."
(interactive
- (list (funcall (if ido-mode #'ido-completing-read #'completing-read)
+ (list (sx-completing-read
"Switch to site: " (sx-site-get-api-tokens)
(lambda (site) (not (equal site sx-question-list--site)))
t)))
diff --git a/sx-question-mode.el b/sx-question-mode.el
index bccb658..721f935 100644
--- a/sx-question-mode.el
+++ b/sx-question-mode.el
@@ -1,4 +1,4 @@
-;;; sx-question-mode.el --- Creating the buffer that displays questions
+;;; sx-question-mode.el --- Major-mode for displaying a question. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
@@ -30,11 +30,13 @@
;;; Displaying a question
-(defcustom sx-question-mode-display-buffer-function #'switch-to-buffer
+(defcustom sx-question-mode-display-buffer-function #'pop-to-buffer
"Function used to display the question buffer.
Called, for instance, when hitting \\<sx-question-list-mode-map>`\\[sx-question-list-display-question]' on an entry in the
question list.
-This is not used when navigating the question list with `\\[sx-question-list-view-next]."
+This is not used when navigating the question list with `\\[sx-question-list-view-next].
+
+Common values for this variable are `pop-to-buffer' and `switch-to-buffer'."
:type 'function
:group 'sx-question-mode)
@@ -62,7 +64,9 @@ Returns the question buffer."
(sx-question-mode--erase-and-print-question data)))
(defun sx-question-mode--erase-and-print-question (data)
- "Erase contents of buffer and print question given by DATA."
+ "Erase contents of buffer and print question given by DATA.
+Also marks the question as read with `sx-question--mark-read'."
+ (sx-question--mark-read data)
(let ((inhibit-read-only t))
(erase-buffer)
(sx-question-mode)
@@ -118,10 +122,8 @@ Prefix argument N moves N sections down or up."
;; 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-property-change 'section n))
- (let ((ov (car-safe (sx-question-mode--section-overlays-at (point)))))
- (unless (and (overlayp ov)
- (overlay-get ov 'invisible))
- (cl-decf count)))))
+ (unless (get-char-property (point) 'invisible)
+ (cl-decf count))))
(when (equal (selected-window) (get-buffer-window))
(when sx-question-mode-recenter-line
(let ((ov (sx-question-mode--section-overlays-at (line-end-position))))
@@ -173,12 +175,34 @@ property."
;;; Major-mode
+(defvar sx-question-mode--header-line
+ '(" "
+ (:propertize "n p TAB" face mode-line-buffer-id)
+ ": Navigate"
+ " "
+ (:propertize "u d" face mode-line-buffer-id)
+ ": Up/Down Vote"
+ " "
+ (:propertize "c" face mode-line-buffer-id)
+ ": Comment"
+ " "
+ (:propertize "a" face mode-line-buffer-id)
+ ": Answer"
+ " "
+ (:propertize "e" face mode-line-buffer-id)
+ ": Edit"
+ " "
+ (:propertize "q" face mode-line-buffer-id)
+ ": Quit")
+ "Header-line used on the question list.")
+
(define-derived-mode sx-question-mode special-mode "Question"
"Major mode to display and navigate a question and its answers.
Letters do not insert themselves; instead, they are commands.
\\<sx-question-mode>
\\{sx-question-mode}"
+ (setq header-line-format sx-question-mode--header-line)
;; Determine how to close this window.
(unless (window-parameter nil 'quit-restore)
(set-window-parameter
@@ -193,17 +217,21 @@ Letters do not insert themselves; instead, they are commands.
(mapc
(lambda (x) (define-key sx-question-mode-map
(car x) (cadr x)))
- `(("n" sx-question-mode-next-section)
+ `(
+ ([down] sx-question-mode-next-section)
+ ([up] sx-question-mode-previous-section)
+ ("n" sx-question-mode-next-section)
("p" sx-question-mode-previous-section)
("g" sx-question-mode-refresh)
("c" sx-comment)
- ("v" sx-visit)
+ ("v" sx-visit-externally)
("u" sx-toggle-upvote)
("d" sx-toggle-downvote)
("q" quit-window)
(" " scroll-up-command)
("a" sx-answer)
("e" sx-edit)
+ ("s" sx-search)
(,(kbd "S-SPC") scroll-down-command)
([backspace] scroll-down-command)
([tab] forward-button)
@@ -227,7 +255,7 @@ query the api."
(if no-update
sx-question-mode--data
(sx-assoc-let sx-question-mode--data
- (sx-question-get-question .site .question_id))))
+ (sx-question-get-question .site_par .question_id))))
(goto-char point)
(when (equal (selected-window)
(get-buffer-window (current-buffer)))
@@ -241,7 +269,3 @@ query the api."
(provide 'sx-question-mode)
;;; sx-question-mode.el ends here
-
-;; Local Variables:
-;; lexical-binding: t
-;; End:
diff --git a/sx-question-print.el b/sx-question-print.el
index eb79a7a..07378e8 100644
--- a/sx-question-print.el
+++ b/sx-question-print.el
@@ -1,4 +1,4 @@
-;;; sx-question-print.el --- Populating the question-mode buffer with content.
+;;; sx-question-print.el --- Populating the question-mode buffer with content. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
@@ -23,11 +23,9 @@
;;; Code:
(require 'markdown-mode)
(require 'sx-button)
-(eval-when-compile
- (require 'rx))
-
(require 'sx)
(require 'sx-question)
+(require 'sx-babel)
(defgroup sx-question-mode nil
"Customization group for sx-question-mode."
@@ -184,9 +182,6 @@ QUESTION must be a data structure returned by `json-read'."
(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)
;; Go up
(goto-char (point-min))
(sx-question-mode-next-section))
@@ -240,8 +235,7 @@ DATA can represent a question or an answer."
;; Body
(insert "\n"
(propertize sx-question-mode-separator
- 'face 'sx-question-mode-header
- 'sx-question-mode--section 4))
+ 'face 'sx-question-mode-header))
(sx--wrap-in-overlay
'(face sx-question-mode-content-face)
(insert "\n"
@@ -292,18 +286,22 @@ The comment is indented, filled, and then printed according to
(sx--wrap-in-overlay
(list 'sx--data-here comment-data)
(sx-assoc-let comment-data
+ (when (and (numberp .score) (> .score 0))
+ (insert (number-to-string .score)
+ (if (eq .upvoted t) "^" "")
+ " "))
(insert
(format
- sx-question-mode-comments-format
- (sx-question-mode--propertize-display-name .owner)
- (substring
- ;; We fill with three spaces at the start, so the comment is
- ;; slightly indented.
- (sx-question-mode--fill-and-fontify
- (concat " " .body_markdown))
- ;; Then we remove the spaces from the first line, since we'll
- ;; add the username there anyway.
- 3))))))
+ sx-question-mode-comments-format
+ (sx-question-mode--propertize-display-name .owner)
+ (substring
+ ;; We fill with three spaces at the start, so the comment is
+ ;; slightly indented.
+ (sx-question-mode--fill-and-fontify
+ (concat " " .body_markdown))
+ ;; Then we remove the spaces from the first line, since we'll
+ ;; add the username there anyway.
+ 3))))))
(defun sx-question-mode--insert-header (&rest args)
"Insert propertized ARGS.
@@ -342,7 +340,7 @@ E.g.:
"Return TEXT filled according to `markdown-mode'."
(with-temp-buffer
(insert text)
- (markdown-mode)
+ (delay-mode-hooks (markdown-mode))
(font-lock-mode -1)
(when sx-question-mode-bullet-appearance
(font-lock-add-keywords ;; Bullet items.
@@ -352,7 +350,7 @@ E.g.:
(font-lock-add-keywords ;; Highlight usernames.
nil
`((,(rx (or blank line-start)
- (group-n 1 (and "@" (1+ (or (syntax word) (syntax symbol)))))
+ (group-n 1 (and "@" (1+ (not space))))
symbol-end)
1 font-lock-builtin-face)))
;; Everything.
@@ -364,26 +362,14 @@ E.g.:
(while (null (eobp))
;; Don't fill pre blocks.
(unless (sx-question-mode--dont-fill-here)
- (skip-chars-forward "\r\n[:blank:]")
- (fill-paragraph)
- (forward-paragraph)))
- (buffer-string)))
-
-(defun sx-question-mode--dont-fill-here ()
- "If text shouldn't be filled here, return t and skip over it."
- (or (sx-question-mode--skip-and-fontify-pre)
- ;; Skip headers and references
- (let ((pos (point)))
- (skip-chars-forward "\r\n[:blank:]")
- (goto-char (line-beginning-position))
- (if (or (looking-at-p (format sx-question-mode--reference-regexp ".+"))
- (looking-at-p "^#"))
- ;; Returns non-nil
- (forward-paragraph)
- ;; Go back and return nil
- (goto-char pos)
- nil))))
+ (let ((beg (point)))
+ (skip-chars-forward "\r\n[:blank:]")
+ (forward-paragraph)
+ (fill-region beg (point)))))
+ (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string))))
+
+;;; Handling links
(defun sx-question-mode--process-links-in-buffer ()
"Turn all markdown links in this buffer into compact format."
(save-excursion
@@ -395,10 +381,11 @@ E.g.:
(match-string-no-properties 3)
text)))
(full-text (match-string-no-properties 0)))
- (replace-match "")
- (sx-question-mode--insert-link
- (if sx-question-mode-pretty-links text full-text)
- url)))))
+ (when (stringp url)
+ (replace-match "")
+ (sx-question-mode--insert-link
+ (if sx-question-mode-pretty-links text full-text)
+ url))))))
(defun sx-question-mode--insert-link (text url)
"Return a link propertized version of string TEXT.
@@ -427,33 +414,57 @@ If ID is nil, use FALLBACK-ID instead."
nil t)
(match-string-no-properties 1)))))
+
+;;; Things we don't fill
+(defun sx-question-mode--dont-fill-here ()
+ "If text shouldn't be filled here, return t and skip over it."
+ (catch 'sx-question-mode-done
+ (let ((before (point)))
+ (skip-chars-forward "\r\n[:blank:]")
+ (let ((first-non-blank (point)))
+ (dolist (it '(sx-question-mode--skip-and-fontify-pre
+ sx-question-mode--skip-headline
+ sx-question-mode--skip-references
+ sx-question-mode--skip-comments))
+ ;; If something worked, keep point where it is and return t.
+ (if (funcall it) (throw 'sx-question-mode-done t)
+ ;; Before calling each new function. Go back to the first
+ ;; non-blank char.
+ (goto-char first-non-blank)))
+ ;; If nothing matched, go back to the very beginning.
+ (goto-char before)
+ ;; And return nil
+ nil))))
+
(defun sx-question-mode--skip-and-fontify-pre ()
"If there's a pre block ahead, handle it, skip it and return t.
Handling means to turn it into a button and remove erroneous
font-locking."
- (let (beg end text)
- (when (markdown-match-pre-blocks
- (save-excursion
- (skip-chars-forward "\r\n[:blank:]")
- (setq beg (point))))
- (setq end (point))
- (setq text
- (sx--unindent-text
- (buffer-substring
- (save-excursion
- (goto-char beg)
- (line-beginning-position))
- end)))
- (put-text-property beg end 'display nil)
- (make-text-button
- beg end
- 'face 'markdown-pre-face
- 'sx-button-copy text
- :type 'sx-question-mode-code-block))))
+ (let ((beg (line-beginning-position)))
+ ;; To identify code-blocks we need to be at start of line.
+ (goto-char beg)
+ (when (markdown-match-pre-blocks (line-end-position))
+ (sx-babel--make-pre-button beg (point))
+ t)))
+
+(defun sx-question-mode--skip-comments ()
+ "If there's an html comment ahead, skip it and return t."
+ ;; @TODO: Handle the comment.
+ ;; "Handling means to store any relevant metadata it might be holding."
+ (markdown-match-comments (line-end-position)))
+
+(defun sx-question-mode--skip-headline ()
+ "If there's a headline ahead, skip it and return non-nil."
+ (when (or (looking-at-p "^#+ ")
+ (progn (forward-line 1) (looking-at-p "===\\|---")))
+ ;; Returns non-nil.
+ (forward-line 1)))
+
+(defun sx-question-mode--skip-references ()
+ "If there's a reference ahead, skip it and return non-nil."
+ (while (looking-at-p (format sx-question-mode--reference-regexp ".+"))
+ ;; Returns non-nil
+ (forward-line 1)))
(provide 'sx-question-print)
;;; sx-question-print.el ends here
-
-;; Local Variables:
-;; lexical-binding: t
-;; End:
diff --git a/sx-question.el b/sx-question.el
index c4b2445..85d3cc5 100644
--- a/sx-question.el
+++ b/sx-question.el
@@ -1,4 +1,4 @@
-;;; sx-question.el --- question logic
+;;; sx-question.el --- Base question logic. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
@@ -54,6 +54,20 @@ If QUESTION-ID doesn't exist on SITE, raise an error."
(error "Couldn't find question %S in %S"
question-id site))))
+(defun sx-question-get-from-answer (site answer-id)
+ "Get question from SITE to which ANSWER-ID belongs.
+If ANSWER-ID doesn't exist on SITE, raise an error."
+ (let ((res (sx-method-call 'answers
+ :id answer-id
+ :site site
+ :submethod 'questions
+ :auth t
+ :filter sx-browse-filter)))
+ (if (vectorp res)
+ (elt res 0)
+ (error "Couldn't find answer %S in %S"
+ answer-id site))))
+
;;; Question Properties
@@ -80,8 +94,8 @@ If no cache exists for it, initialize one with SITE."
"Non-nil if QUESTION has been read since last updated.
See `sx-question--user-read-list'."
(sx-assoc-let question
- (sx-question--ensure-read-list .site)
- (let ((ql (cdr (assoc .site sx-question--user-read-list))))
+ (sx-question--ensure-read-list .site_par)
+ (let ((ql (cdr (assoc .site_par sx-question--user-read-list))))
(and ql
(>= (or (cdr (assoc .question_id ql)) 0)
.last_activity_date)))))
@@ -93,14 +107,14 @@ read, i.e., if it was `sx-question--read-p'.
See `sx-question--user-read-list'."
(prog1
(sx-assoc-let question
- (sx-question--ensure-read-list .site)
- (let ((site-cell (assoc .site sx-question--user-read-list))
+ (sx-question--ensure-read-list .site_par)
+ (let ((site-cell (assoc .site_par sx-question--user-read-list))
(q-cell (cons .question_id .last_activity_date))
cell)
(cond
;; First question from this site.
((null site-cell)
- (push (list .site q-cell) sx-question--user-read-list))
+ (push (list .site_par q-cell) sx-question--user-read-list))
;; Question already present.
((setq cell (assoc .question_id site-cell))
;; Current version is newer than cached version.
@@ -135,25 +149,23 @@ If no cache exists for it, initialize one with SITE."
(defun sx-question--hidden-p (question)
"Non-nil if QUESTION has been hidden."
(sx-assoc-let question
- (sx-question--ensure-hidden-list .site)
- (let ((ql (cdr (assoc .site sx-question--user-hidden-list))))
+ (sx-question--ensure-hidden-list .site_par)
+ (let ((ql (cdr (assoc .site_par sx-question--user-hidden-list))))
(and ql (memq .question_id ql)))))
(defun sx-question--mark-hidden (question)
"Mark QUESTION as being hidden."
(sx-assoc-let question
- (let ((site-cell (assoc .site sx-question--user-hidden-list))
- cell)
+ (let ((site-cell (assoc .site_par sx-question--user-hidden-list)))
;; If question already hidden, do nothing.
(unless (memq .question_id site-cell)
- ;; First question from this site.
- (push (list .site .question_id) sx-question--user-hidden-list)
- ;; Question wasn't present.
- ;; Add it in, but make sure it's sorted (just in case we need
- ;; it later).
- (sx-sorted-insert-skip-first .question_id site-cell >)
- ;; This causes a small lag on `j' and `k' as the list gets large.
- ;; Should we do this on a timer?
+ (if (null site-cell)
+ ;; First question from this site.
+ (push (list .site_par .question_id) sx-question--user-hidden-list)
+ ;; Not first question and question wasn't present.
+ ;; Add it in, but make sure it's sorted (just in case we
+ ;; decide to rely on it later).
+ (sx-sorted-insert-skip-first .question_id site-cell >))
;; Save the results.
(sx-cache-set 'hidden-questions sx-question--user-hidden-list)))))
@@ -175,5 +187,4 @@ If no cache exists for it, initialize one with SITE."
;; Local Variables:
;; indent-tabs-mode: nil
-;; lexical-binding: t
;; End:
diff --git a/sx-request.el b/sx-request.el
index 0994fbd..bc34f9c 100644
--- a/sx-request.el
+++ b/sx-request.el
@@ -1,4 +1,4 @@
-;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*-
+;;; sx-request.el --- Requests and url manipulation. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
@@ -70,7 +70,11 @@
(defcustom sx-request-unzip-program
"gunzip"
"Program used to unzip the response if it is compressed.
-This program must accept compressed data on standard input."
+This program must accept compressed data on standard input.
+
+This is only used (and necessary) if the function
+`zlib-decompress-region' is not defined, which is the case for
+Emacs versions < 24.4."
:group 'sx
:type 'string)
@@ -121,42 +125,48 @@ the main content of the response is returned."
(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
- (let* ((data (progn
- ;; @TODO use url-http-end-of-headers
- (goto-char (point-min))
- (if (not (search-forward "\n\n" nil t))
- (error "Headers missing; response corrupt")
- (delete-region (point-min) (point))
- (buffer-string))))
- (response-zipped-p (sx-encoding-gzipped-p data))
- (data (if (not response-zipped-p) data
- (shell-command-on-region
- (point-min) (point-max)
- sx-request-unzip-program
- nil t)
- (buffer-string)))
- ;; @TODO should use `condition-case' here -- set
- ;; RESPONSE to 'corrupt or something
- (response (with-demoted-errors "`json' error: %S"
- (json-read-from-string data))))
- (when (and (not response) (string-equal data "{}"))
- (sx-message "Unable to parse response: %S" response)
- (error "Response could not be read by `json-read-from-string'"))
- ;; If we get here, the response is a valid data structure
- (sx-assoc-let response
- (when .error_id
- (error "Request failed: (%s) [%i %s] %S"
- .method .error_id .error_name .error_message))
- (when (< (setq sx-request-remaining-api-requests .quota_remaining)
- sx-request-remaining-api-requests-message-threshold)
- (sx-message "%d API requests reamining"
- sx-request-remaining-api-requests))
- (sx-encoding-clean-content-deep .items)))))))
-
-(defun sx-request-fallback (method &optional args request-method)
+ (if (not response-buffer)
+ (error "Something went wrong in `url-retrieve-synchronously'")
+ (with-current-buffer response-buffer
+ (let* ((data (progn
+ ;; @TODO use url-http-end-of-headers
+ (goto-char (point-min))
+ (if (not (search-forward "\n\n" nil t))
+ (error "Headers missing; response corrupt")
+ (delete-region (point-min) (point))
+ (buffer-string))))
+ (response-zipped-p (sx-encoding-gzipped-p data))
+ (data
+ ;; Turn string of bytes into string of characters. See
+ ;; http://emacs.stackexchange.com/q/4100/50
+ (decode-coding-string
+ (if (not response-zipped-p) data
+ (if (fboundp 'zlib-decompress-region)
+ (zlib-decompress-region (point-min) (point-max))
+ (shell-command-on-region
+ (point-min) (point-max)
+ sx-request-unzip-program nil t))
+ (buffer-string))
+ 'utf-8 'nocopy))
+ ;; @TODO should use `condition-case' here -- set
+ ;; RESPONSE to 'corrupt or something
+ (response (with-demoted-errors "`json' error: %S"
+ (json-read-from-string data))))
+ (when (and (not response) (string-equal data "{}"))
+ (sx-message "Unable to parse response: %S" response)
+ (error "Response could not be read by `json-read-from-string'"))
+ ;; If we get here, the response is a valid data structure
+ (sx-assoc-let response
+ (when .error_id
+ (error "Request failed: (%s) [%i %s] %S"
+ .method .error_id .error_name .error_message))
+ (when (< (setq sx-request-remaining-api-requests .quota_remaining)
+ sx-request-remaining-api-requests-message-threshold)
+ (sx-message "%d API requests remaining"
+ sx-request-remaining-api-requests))
+ (sx-encoding-clean-content-deep .items)))))))
+
+(defun sx-request-fallback (_method &optional _args _request-method)
"Fallback method when authentication is not available.
This is for UI generation when the associated API call would
require authentication.
diff --git a/sx-search.el b/sx-search.el
new file mode 100644
index 0000000..2633da9
--- /dev/null
+++ b/sx-search.el
@@ -0,0 +1,112 @@
+;;; sx-search.el --- Searching for 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:
+
+;; Implements sarch functionality. The basic function is
+;; `sx-search-get-questions', which returns an array of questions
+;; according to a search term.
+;;
+;; This also defines a user-level command, `sx-search', which is an
+;; interactive wrapper around `sx-search-get-questions' and
+;; `sx-question-list-mode'.
+
+
+;;; Code:
+
+(require 'sx)
+(require 'sx-question-list)
+
+(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)
+ "Like `sx-question-get-questions', but restrict results by a search.
+
+Perform search on SITE. PAGE is an integer indicating which page
+of results to return. QUERY, TAGS, and EXCLUDED-TAGS restrict the
+possible returned questions as per `sx-search'.
+
+Either QUERY or TAGS must be non-nil, or the search will
+fail. EXCLUDED-TAGS is only is used if TAGS is also provided.
+
+KEYWORDS is passed to `sx-method-call'."
+ (sx-method-call 'search
+ :keywords `((page . ,page)
+ (sort . activity)
+ (intitle . ,query)
+ (tagged . ,tags)
+ (nottagged . ,excluded-tags)
+ ,@keywords)
+ :site site
+ :auth t
+ :filter sx-browse-filter))
+
+
+;;; User command
+(defun sx-search (site query &optional tags excluded-tags)
+ "Display search on SITE for question titles containing QUERY.
+When TAGS is given, it is a lists of tags, one of which must
+match. When EXCLUDED-TAGS is given, it is a list of tags, none
+of which is allowed to match.
+
+Interactively, the user is asked for SITE and QUERY. With a
+prefix argument, the user is asked for everything."
+ (interactive
+ (let ((site (sx--maybe-site-prompt current-prefix-arg))
+ (query (read-string
+ (format "Query (%s): "
+ (if current-prefix-arg "optional" "mandatory"))
+ ""
+ 'sx-search--query-history))
+ tags excluded-tags)
+ (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))
+ (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)))
+ (list site query tags excluded-tags)))
+
+ ;; Here starts the actual function
+ (sx-initialize)
+ (with-current-buffer (get-buffer-create "*sx-search-result*")
+ (sx-question-list-mode)
+ (setq sx-question-list--next-page-function
+ (lambda (page)
+ (sx-search-get-questions
+ sx-question-list--site page
+ query tags excluded-tags)))
+ (setq sx-question-list--site site)
+ (sx-question-list-refresh 'redisplay)
+ (switch-to-buffer (current-buffer))))
+
+(provide 'sx-search)
+;;; sx-search.el ends here
diff --git a/sx-tab.el b/sx-tab.el
index f36d10f..32a7784 100644
--- a/sx-tab.el
+++ b/sx-tab.el
@@ -26,11 +26,7 @@
(require 'sx)
(require 'sx-question-list)
-
-(defcustom sx-tab-default-site "emacs"
- "Name of the site to use by default when listing questions."
- :type 'string
- :group 'sx)
+(require 'sx-interaction)
(defvar sx-tab--list nil
"List of the names of all defined tabs.")
@@ -38,23 +34,12 @@
(defun sx-tab-switch (tab)
"Switch to another question-list tab."
(interactive
- (list (funcall (if ido-mode #'ido-completing-read #'completing-read)
- "Switch to tab: " sx-tab--list
- (lambda (tab) (not (equal tab sx-question-list--current-tab)))
- t)))
+ (list (sx-completing-read
+ "Switch to tab: " sx-tab--list
+ (lambda (tab) (not (equal tab sx-question-list--current-tab)))
+ 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
@@ -87,13 +72,13 @@ variables, but before refreshing the display."
,(format "Display a list of %s questions for SITE.
NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'.
-If SITE is nil, use `sx-tab-default-site'."
+If SITE is nil, use `sx-default-site'."
tab)
(interactive
(list current-prefix-arg
- (sx-tab--interactive-site-prompt)))
+ (sx--interactive-site-prompt)))
(sx-initialize)
- (unless site (setq site sx-tab-default-site))
+ (unless site (setq site sx-default-site))
;; Create the buffer
(unless (buffer-live-p ,buffer-variable)
(setq ,buffer-variable
diff --git a/sx-time.el b/sx-time.el
index e65bb50..3de124d 100644
--- a/sx-time.el
+++ b/sx-time.el
@@ -42,7 +42,7 @@
(defun sx-time-since (time)
"Convert the time interval since TIME (in seconds) to a short string."
- (let ((delay (- (time-to-seconds) time)))
+ (let ((delay (- (float-time) time)))
(concat
(if (> 0 delay) "-" "")
(if (= 0 delay) "0s"
diff --git a/sx.el b/sx.el
index 8e3e5d3..62484b7 100644
--- a/sx.el
+++ b/sx.el
@@ -1,4 +1,4 @@
-;;; sx.el --- core functions of the sx package.
+;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
@@ -6,7 +6,7 @@
;; URL: https://github.com/vermiculus/sx.el/
;; Version: 0.1
;; Keywords: help, hypermedia, tools
-;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0"))
+;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0.3"))
;; 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
@@ -31,12 +31,11 @@
(defconst sx-version "0.1" "Version of the `sx' package.")
(defgroup sx nil
- "Customization group for sx-question-mode."
+ "Customization group for the `sx' package."
:prefix "sx-"
:tag "SX"
:group 'applications)
-
;;; User commands
(defun sx-version ()
@@ -52,12 +51,111 @@
(browse-url "https://github.com/vermiculus/sx.el/issues/new"))
+;;; Site
+(defun sx--site (data)
+ "Get the site in which DATA belongs.
+DATA can be a question, answer, comment, or user (or any object
+with a `link' property).
+DATA can also be the link itself."
+ (let ((link (if (stringp data) data
+ (cdr (assoc 'link data)))))
+ (when (stringp link)
+ (replace-regexp-in-string
+ (rx string-start
+ "http" (optional "s") "://"
+ (or
+ (sequence
+ (group-n 1 (+ (not (any "/"))))
+ ".stackexchange")
+ (group-n 2 (+ (not (any "/")))))
+ "." (+ (not (any ".")))
+ "/" (* any)
+ string-end)
+ "\\1\\2" link))))
+
+(defun sx--ensure-site (data)
+ "Add a `site' property to DATA if it doesn't have one. Return DATA.
+DATA can be a question, answer, comment, or user (or any object
+with a `link' property)."
+ (when data
+ (let-alist data
+ (unless .site_par
+ ;; @TODO: Change this to .site.api_site_parameter sometime
+ ;; after February.
+ (setcdr data (cons (cons 'site_par
+ (or (cdr (assq 'api_site_parameter .site))
+ (sx--site data)))
+ (cdr data)))))
+ data))
+
+(defun sx--link-to-data (link)
+ "Convert string LINK into data that can be displayed."
+ (let ((result (list (cons 'site (sx--site link)))))
+ ;; Try to strip a question or answer ID
+ (when (or
+ ;; Answer
+ (and (or (string-match
+ ;; From 'Share' button
+ (rx "/a/"
+ ;; Question ID
+ (group (+ digit))
+ ;; User ID
+ "/" (+ digit)
+ ;; Answer ID
+ (group (or (sequence "#" (* any)) ""))
+ string-end) link)
+ (string-match
+ ;; From URL
+ (rx "/questions/" (+ digit) "/"
+ (+ (not (any "/"))) "/"
+ ;; User ID
+ (optional (group (+ digit)))
+ (optional "/")
+ (group (or (sequence "#" (* any)) ""))
+ string-end) link))
+ (push '(type . answer) result))
+ ;; Question
+ (and (or (string-match
+ ;; From 'Share' button
+ (rx "/q/"
+ ;; Question ID
+ (group (+ digit))
+ ;; User ID
+ (optional "/" (+ digit))
+ ;; Answer or Comment ID
+ (group (or (sequence "#" (* any)) ""))
+ string-end) link)
+ (string-match
+ ;; From URL
+ (rx "/questions/"
+ ;; Question ID
+ (group (+ digit))
+ "/") link))
+ (push '(type . question) result)))
+ (push (cons 'id (string-to-number (match-string-no-properties 1 link)))
+ result))
+ result))
+
+(defmacro sx-assoc-let (alist &rest body)
+ "Use ALIST with `let-alist' to execute BODY.
+`.site_par' has a special meaning, thanks to `sx--ensure-site'.
+If ALIST doesn't have a `site' property, one is created using the
+`link' property."
+ (declare (indent 1) (debug t))
+ (require 'let-alist)
+ `(progn
+ (sx--ensure-site ,alist)
+ ,(macroexpand
+ `(let-alist ,alist ,@body))))
+
+
;;; Browsing filter
(defvar sx-browse-filter
'((question.body_markdown
question.comments
question.answers
question.last_editor
+ question.last_activity_date
question.accepted_answer_id
question.link
question.upvoted
@@ -78,6 +176,7 @@
comment.comment_id
answer.answer_id
answer.last_editor
+ answer.last_activity_date
answer.link
answer.share_link
answer.owner
@@ -91,6 +190,29 @@ See `sx-question-get-questions' and `sx-question-get-question'.")
;;; Utility Functions
+(defun sx-completing-read (&rest args)
+ "Like `completing-read', but possibly use ido.
+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.
@@ -105,6 +227,12 @@ is intentionally skipped."
(setq tail (cdr tail)))
(setcdr tail (cons x (cdr tail)))))
+(defun sx-user-error (format-string &rest args)
+ "Like `user-error', but prepend FORMAT-STRING with \"[sx]\".
+See `format'."
+ (signal 'user-error
+ (list (apply #'format (concat "[sx] " format-string) args))))
+
(defun sx-message (format-string &rest args)
"Display FORMAT-STRING as a message with ARGS.
See `format'."
@@ -142,50 +270,6 @@ and sequences of strings."
(funcall first-f sequence-sep)
";"))))))
-(defun sx--filter-data (data desired-tree)
- "Filter DATA and return the DESIRED-TREE.
-
-For example:
-
- (sx--filter-data
- '((prop1 . value1)
- (prop2 . value2)
- (prop3
- (test1 . 1)
- (test2 . 2))
- (prop4 . t))
- '(prop1 (prop3 test2)))
-
-would yield
-
- ((prop1 . value1)
- (prop3
- (test2 . 2)))"
- (if (vectorp data)
- (apply #'vector
- (mapcar (lambda (entry)
- (sx--filter-data
- entry desired-tree))
- data))
- (delq
- nil
- (mapcar (lambda (cons-cell)
- ;; @TODO the resolution of `f' is O(2n) in the worst
- ;; case. It may be faster to implement the same
- ;; functionality as a `while' loop to stop looking the
- ;; list once it has found a match. Do speed tests.
- ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e.
- (let ((f (or (memq (car cons-cell) desired-tree)
- (assoc (car cons-cell) desired-tree))))
- (when f
- (if (and (sequencep (cdr cons-cell))
- (sequencep (elt (cdr cons-cell) 0)))
- (cons (car cons-cell)
- (sx--filter-data
- (cdr cons-cell) (cdr f)))
- cons-cell))))
- data))))
-
(defun sx--shorten-url (url)
"Shorten URL hiding anything other than the domain.
Paths after the domain are replaced with \"...\".
@@ -197,45 +281,17 @@ Anything before the (sub)domain is removed."
(eval-when-compile
(concat "\\1" (if (char-displayable-p ?…) "…" "...")))
;; Remove anything before subdomain.
- (replace-regexp-in-string
+ (replace-regexp-in-string
(rx string-start (or (and (0+ word) (optional ":") "//")))
"" url)))
-(defun sx--unindent-text (text)
- "Remove indentation from TEXT.
-Primarily designed to extract the content of markdown code
-blocks."
- (with-temp-buffer
- (insert text)
- (goto-char (point-min))
- (let (result)
- ;; Get indentation of each non-blank line
- (while (null (eobp))
- (skip-chars-forward "[:blank:]")
- (unless (looking-at "$")
- (push (current-column) result))
- (forward-line 1))
- (when result
- ;; Build a regexp with the smallest indentation
- (let ((rx (format "^ \\{0,%s\\}"
- (apply #'min result))))
- (goto-char (point-min))
- ;; Use this regexp to remove that much indentation
- ;; throughout the buffer.
- (while (and (null (eobp))
- (search-forward-regexp rx nil 'noerror))
- (replace-match "")
- (forward-line 1)))))
- ;; Return the buffer
- (buffer-string)))
-
;;; Printing request data
(defvar sx--overlays nil
"Overlays created by sx on this buffer.")
(make-variable-buffer-local 'sx--overlays)
-(defvar sx--overlay-printing-depth 0
+(defvar sx--overlay-printing-depth 0
"Track how many overlays we're printing on top of each other.
Used for assigning higher priority to inner overlays.")
(make-variable-buffer-local 'sx--overlay-printing-depth)
@@ -264,71 +320,50 @@ Return the result of BODY."
(push ov sx--overlays))
result))
+(defvar sx--ascii-replacement-list
+ '(("[:space:]" . "")
+ ("àåáâäãåą" . "a")
+ ("èéêëę" . "e")
+ ("ìíîïı" . "i")
+ ("òóôõöøőð" . "o")
+ ("ùúûüŭů" . "u")
+ ("çćčĉ" . "c")
+ ("żźž" . "z")
+ ("śşšŝ" . "s")
+ ("ñń" . "n")
+ ("ýÿ" . "y")
+ ("ğĝ" . "g")
+ ("ř" . "r")
+ ("ł" . "l")
+ ("đ" . "d")
+ ("ß" . "ss")
+ ("Þ" . "th")
+ ("ĥ" . "h")
+ ("ĵ" . "j")
+ ("^[:ascii:]" . ""))
+ "List of replacements to use for non-ascii characters.
+Used to convert user names into @mentions.")
+
(defun sx--user-@name (user)
"Get the `display_name' of USER prepended with @.
In order to correctly @mention the user, all whitespace is
removed from the display name before it is returned."
(sx-assoc-let user
(when (stringp .display_name)
- (concat "@" (replace-regexp-in-string
- "[[:space:]]" "" .display_name)))))
+ (concat "@" (sx--recursive-replace
+ sx--ascii-replacement-list .display_name)))))
+
+(defun sx--recursive-replace (alist string)
+ "Replace each car of ALIST with its cdr in STRING."
+ (if alist
+ (sx--recursive-replace
+ (cdr alist)
+ (let ((kar (car alist)))
+ (replace-regexp-in-string
+ (format "[%s]" (car kar)) (cdr kar) string)))
+ string))
-;;; Assoc-let
-(defun sx--site (data)
- "Get the site in which DATA belongs.
-DATA can be a question, answer, comment, or user (or any object
-with a `link' property).
-DATA can also be the link itself."
- (let ((link (if (stringp data) data
- (cdr (assoc 'link data)))))
- (when (stringp link)
- (replace-regexp-in-string
- "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$"
- "\\1\\2" link))))
-
-(defun sx--deep-dot-search (data)
- "Find symbols somewhere inside DATA which start with a `.'.
-Returns a list where each element is a cons cell. The car is the
-symbol, the cdr is the symbol without the `.'."
- (cond
- ((symbolp data)
- (let ((name (symbol-name data)))
- (when (string-match "\\`\\." name)
- ;; Return the cons cell inside a list, so it can be appended
- ;; with other results in the clause below.
- (list (cons data (intern (replace-match "" nil nil name)))))))
- ((not (listp data)) nil)
- (t (apply
- #'append
- (remove nil (mapcar #'sx--deep-dot-search data))))))
-
-(defmacro sx-assoc-let (alist &rest body)
- "Use dotted symbols let-bound to their values in ALIST and execute BODY.
-Dotted symbol is any symbol starting with a `.'. Only those
-present in BODY are letbound, which leads to optimal performance.
-The .site symbol is special, it is derived from the .link symbol
-using `sx--site'.
-
-For instance, the following code
-
- (sx-assoc-let alist
- (list .title .body))
-
-is equivalent to
-
- (let ((.title (cdr (assoc 'title alist)))
- (.body (cdr (assoc 'body alist))))
- (list .title .body))"
- (declare (indent 1) (debug t))
- (let* ((symbol-alist (sx--deep-dot-search body))
- (has-site (assoc '.site symbol-alist)))
- `(let ,(append
- (when has-site `((.site (sx--site (cdr (assoc 'link ,alist))))))
- (mapcar (lambda (x) `(,(car x) (cdr (assoc ',(cdr x) ,alist))))
- (remove '(.site . site) (delete-dups symbol-alist))))
- ,@body)))
-
(defcustom sx-init-hook nil
"Hook run when SX initializes.
Run after `sx-init--internal-hook'."
@@ -378,5 +413,4 @@ If FORCE is non-nil, run them even if they've already been run."
;; Local Variables:
;; indent-tabs-mode: nil
-;; lexical-binding: t
;; End:
diff --git a/sx.org b/sx.org
index f866aa5..7ccb51b 100644
--- a/sx.org
+++ b/sx.org
@@ -55,6 +55,14 @@ Emacs conventions. Of course, the core convention of Emacs is
arbitrary customizability -- [[#hooks][hack away]]!
* Basic Usage
+
+** Activation
+
+If you install ~SX~ with ~package-install~, you should have every
+needed command properly autoloaded. If you install it manually,
+require the ~sx-load~ file to make sure everything is correctly
+loaded.
+
** Authenticating
Use ~sx-auth-authenticate~. Calling this function will open up a
webpage on StackExchange that will prompt you to authorize this
@@ -67,7 +75,8 @@ a cache file.
** Browsing Questions
To browse a list of questions retrieved from the site, use
~sx-tab-frontpage~. This queries for a site, pulls the first page of
-questions for that site, and displays them in a list.
+questions for that site, and displays them in a list. Alternatively,
+use any of the other ~sx-tab-~ commands.
- Refresh the page with =g= or by scrolling past the top.
- Use =n=, =p=, =N=, =P= to navigate without viewing the question.
@@ -86,8 +95,27 @@ Scrolling past the bottom of the list fetches more questions.
# used only by contributors.
- ~sx-init-hook~ :: Run when ~sx-initialize~ is called.
+- ~sx-compose-before-send-hook~ :: Run before POSTing to the API from
+ a buffer in ~sx-compose-mode~. If any of the functions in this
+ hook, return nil, the transaction is cancelled.
+- ~sx-compose-after-send-functions~ :: Run after POSTing to the API
+ from a buffer in ~sx-compose-mode~, if the transaction was
+ successful.
* Contributing
+Contributions, be them to the code or to this document, are very much
+welcome. Both of these can be found at [[github.com/vermiculus/sx.el][the GitHub repository]]. The
+easiest way to contribute is to clone it, make your changes, and
+submit a pull request. If you prefer, you can also email a patch of
+your changes to one of the authors or maintainers listed in the header
+comments. But please, when you do, heed the following conventions.
+
+1. Contributions to the code which change or add user-facing
+ functionality should be accompanied by updates to this document.
+2. Both in code and in this document, sentences should end in double
+ space.
+
+** Contributing to this Document
This document is maintained in Org format. Updates to the source code
should be accompanied by updates to this document when user-facing
functionality is changed.
@@ -95,7 +123,7 @@ functionality is changed.
Note that some distinctions are made which may not be apparent when
viewing the document with Info.
-** Markup Conventions
+*** Markup Conventions
Markup is used consistently as follows:
- packages :: =package.el=
@@ -108,7 +136,7 @@ To make the Info export readable, lists and source code blocks are
separated from body text with a blank line (as to start a new
paragraph).
-** Document Attributes
+*** Document Attributes
Attributes should be given in uppercase:
#+BEGIN_SRC org
@@ -117,11 +145,56 @@ Attributes should be given in uppercase:
,#+END_SRC
#+END_SRC
-** Source Code Blocks
+*** Source Code Blocks
The language for Emacs Lisp source code blocks should be given as
=elisp= and its content should be indented by two spaces. See
~org-edit-src-content-indentation~.
+** Contributing to the Code
+Contributing to the code should be fairly straightforward. Each file
+has a descriptive header explaining its purpose. Still, to help you
+find your way around, we describe below the current project
+structure. This list is very loosely ordered form low to high-level.
+
+- ~sx.el~ - Utility functions used throughout the package. Essentially
+ every file indirectly requires this one. If you're adding a function
+ that's used by different parts of the package, add it to this file.
+- ~sx-time.el~ - Similar to ~sx.el~, but only contains a few
+ time-related functions.
+- ~sx-filter.el~ - Handles retrieval of filters.
+- ~sx-cache.el~ - Saves and restores persistent data between sessions.
+- ~sx-button.el~ - Defines all button types used throughout the
+ package. Currently used only by ~sx-question-print.el~.
+
+- ~sx-request.el~ - Requests and url manipulation. Backend used by
+ ~sx-method.el~. It shouldn't be necessary to use the functions in
+ this file outside ~sx-method.el~.
+- ~sx-method.el~ - Main interface for API method calls.
+
+- ~sx-favorites.el~ - Starred questions.
+- ~sx-networks.el~ - User network information.
+- ~sx-site.el~ - Browsing sites.
+- ~sx-auth.el~ - Handles user authentication.
+
+- ~sx-question.el~ - Base question logic. Holds several functions for
+ retrieving questions and for processing retrieved questions. Doesn't
+ do any sort of user interface, that is left for
+ ~sx-question-list.el~ and ~sx-question-mode.el~.
+- ~sx-question-list.el~ - Major-mode for navigating questions list.
+- ~sx-question-mode.el~ - User interface for displaying a
+ question. Creates the buffer and defines the major-mode.
+- ~sx-question-print.el~ - Populating the question buffer with
+ content. Used by ~sx-question-mode.el~ to actually print the content
+ of a question.
+- ~sx-babel.el~ - Font-locking code blocks printed by
+ ~sx-question-print.el~ according to the language.
+
+- ~sx-compose.el~ - Major-mode for composing questions and answers.
+- ~sx-interaction.el~ - Voting, commenting, and otherwise interacting with questions.
+- ~sx-tab.el~ - Functions for viewing different tabs.
+
+- ~sx-load.el~ - Load all files of the sx package. Designed as an easy way in for users who install the package manually (since they don't have autoloads).
+
* COMMENT Local Variables
# LocalWords: StackExchange SX inbox sx API url json inline Org
# LocalWords: Markup keybinding keybindings customizability webpage
diff --git a/test/data-samples/inbox-item.el b/test/data-samples/inbox-item.el
new file mode 100644
index 0000000..faeba12
--- /dev/null
+++ b/test/data-samples/inbox-item.el
@@ -0,0 +1,13 @@
+((title . "Can I mark inbox items as read in api v2.2?")
+ (link . "http://stackapps.com/posts/comments/12080?noredirect=1")
+ (item_type . "comment")
+ (question_id . 5059)
+ (comment_id . 12080)
+ (creation_date . 1419153905)
+ (is_unread . :json-false)
+ (site (site_type . "main_site")
+ (name . "Stack Apps")
+ (api_site_parameter . "stackapps")
+ (site_url . "http://stackapps.com")
+ (favicon_url . "http://cdn.sstatic.net/stackapps/img/favicon.ico")
+ (styling (link_color . "#0077DD") (tag_foreground_color . "#555555") (tag_background_color . "#E7ECEC"))))
diff --git a/test/test-api.el b/test/test-api.el
new file mode 100644
index 0000000..ca775ff
--- /dev/null
+++ b/test/test-api.el
@@ -0,0 +1,13 @@
+(ert-deftest test-basic-request ()
+ "Test basic request functionality"
+ (should (sx-request-make "sites")))
+
+(ert-deftest test-question-retrieve ()
+ "Test the ability to receive a list of questions."
+ (should (sx-question-get-questions 'emacs)))
+
+(ert-deftest test-bad-request ()
+ "Test a method given a bad set of keywords"
+ (should-error
+ (sx-request-make "questions" '(()))))
+
diff --git a/test/test-macros.el b/test/test-macros.el
new file mode 100644
index 0000000..b6bf20b
--- /dev/null
+++ b/test/test-macros.el
@@ -0,0 +1,22 @@
+(defmacro sx-test-with-json-data (cell &rest body)
+ "Run BODY with sample data let-bound to CELL"
+ (declare (indent 1))
+ `(let ((,cell '((test . nil) (test-one . 1) (test-two . 2)
+ (link . "http://meta.emacs.stackexchange.com/"))))
+ ,@body))
+
+(ert-deftest macro-test--sx-assoc-let ()
+ "Test `sx-assoc-let'"
+ (sx-test-with-json-data data
+ (should
+ (null (let-alist data .site_par))))
+
+ (sx-test-with-json-data data
+ (should
+ (equal (sx-assoc-let data .site_par)
+ "meta.emacs")))
+
+ (sx-test-with-json-data data
+ (should
+ (equal (sx-assoc-let data (cons .test-one .test-two))
+ '(1 . 2)))))
diff --git a/test/test-printing.el b/test/test-printing.el
new file mode 100644
index 0000000..2857cb7
--- /dev/null
+++ b/test/test-printing.el
@@ -0,0 +1,73 @@
+
+;;; Setup
+(require 'cl-lib)
+
+(defmacro line-should-match (regexp)
+ "Test if the line at point matches REGEXP"
+ `(let ((line (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))
+ (sx-test-message "Line here is: %S" line)
+ (should (string-match ,regexp line))))
+
+(defmacro question-list-regex (title votes answers &rest tags)
+ "Construct a matching regexp for TITLE, VOTES, and ANSWERS.
+Each element of TAGS is appended at the end of the expression
+after being run through `sx-question--tag-format'."
+ `(rx line-start
+ (+ whitespace) ,(number-to-string votes)
+ (+ whitespace) ,(number-to-string answers)
+ (+ whitespace)
+ ,title
+ (+ (any whitespace digit))
+ (or "y" "d" "h" "m" "mo" "s") " ago"
+ (+ whitespace)
+ (eval (mapconcat #'sx-question--tag-format
+ (list ,@tags) " "))))
+
+
+;;; Tests
+(ert-deftest question-list-tag ()
+ "Test `sx-question--tag-format'."
+ (should
+ (string=
+ (sx-question--tag-format "tag")
+ "[tag]")))
+
+(ert-deftest question-list-display ()
+ (cl-letf (((symbol-function #'sx-request-make)
+ (lambda (&rest _) sx-test-data-questions)))
+ (sx-tab-frontpage nil "emacs")
+ (switch-to-buffer "*question-list*")
+ (goto-char (point-min))
+ (should (equal (buffer-name) "*question-list*"))
+ (line-should-match
+ (question-list-regex
+ "Focus-hook: attenuate colours when losing focus"
+ 1 0 "frames" "hooks" "focus"))
+ (sx-question-list-next 5)
+ (line-should-match
+ (question-list-regex
+ "Babel doesn&#39;t wrap results in verbatim"
+ 0 1 "org-mode" "org-export" "org-babel"))
+ ;; ;; Use this when we have a real sx-question buffer.
+ ;; (call-interactively 'sx-question-list-display-question)
+ ;; (should (equal (buffer-name) "*sx-question*"))
+ (switch-to-buffer "*question-list*")
+ (sx-question-list-previous 4)
+ (line-should-match
+ (question-list-regex
+ "&quot;Making tag completion table&quot; Freezes/Blocks -- how to disable"
+ 2 1 "autocomplete" "performance" "ctags"))))
+
+(ert-deftest sx--user-@name ()
+ "Test `sx--user-@name' character substitution"
+ (should
+ (string=
+ (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★")))
+ "@hTHssdlrggyynnsssszzzccccuuuuuuooooooooiiiiieeeeeaaaaaaaaj"))
+ (should
+ (string=
+ (sx--user-@name '((display_name . "ĤÞßĐŁŘĞĜÝŸÑŃŚŞŠŜŻŹŽÇĆČĈÙÚÛÜŬŮÒÓÔÕÖØŐÐÌÍÎÏıÈÉÊËĘÀÅÁÂÄÃÅĄĴ")))
+ "@HTHssDLRGGYYNNSSSSZZZCCCCUUUUUUOOOOOOOOIIIIiEEEEEAAAAAAAAJ")))
+
diff --git a/test/test-search.el b/test/test-search.el
new file mode 100644
index 0000000..72dbcdc
--- /dev/null
+++ b/test/test-search.el
@@ -0,0 +1,53 @@
+(defmacro test-with-bogus-string (cell &rest body)
+ "Let-bind a bogus string to CELL and execute BODY."
+ (declare (indent 1))
+ `(let ((,cell "E7631BCF-A94B-4507-8F0C-02CFB3207F55"))
+ ,@body))
+
+
+(ert-deftest test-search-basic ()
+ "Test basic search functionality"
+ (should
+ (sx-search-get-questions
+ "emacs" 1 "emacs")))
+
+(ert-deftest test-search-empty ()
+ "Test bogus search returns empty vector"
+ (test-with-bogus-string query
+ (should
+ (equal
+ []
+ (sx-search-get-questions "emacs" 1 query)))))
+
+(ert-deftest test-search-invalid ()
+ "Test invalid search"
+ (should-error
+ ;; @todo: test the interactive call
+ (sx-search
+ "emacs" nil nil ["emacs"])))
+
+(ert-deftest test-search-full-page ()
+ "Test retrieval of the full search page"
+ (should
+ (= 30 (length (sx-search-get-questions
+ "stackoverflow" 1 "jquery")))))
+
+(ert-deftest test-search-exclude-tags ()
+ "Test excluding tags from a search"
+ (should
+ (cl-every
+ (lambda (p)
+ (sx-assoc-let p
+ (not (member "org-export" .tags))))
+ (sx-search-get-questions
+ "emacs" 1 nil "org-mode" "org-export")))
+ (should
+ (cl-every
+ (lambda (p)
+ (sx-assoc-let p
+ (not (or (member "org-export" .tags)
+ (member "org-agenda" .tags)))))
+ (sx-search-get-questions
+ "emacs" 1 nil "org-mode"
+ ["org-export" "org-agenda"]))))
+
diff --git a/test/test-util.el b/test/test-util.el
new file mode 100644
index 0000000..5db1691
--- /dev/null
+++ b/test/test-util.el
@@ -0,0 +1,31 @@
+(ert-deftest thing-as-string ()
+ "Test `sx--thing-as-string'"
+ (should
+ (string= (sx--thing-as-string
+ '(hello world (this is a test))
+ '(";" "+"))
+ "hello;world;this+is+a+test"))
+ (should
+ (string= (sx--thing-as-string
+ '(this is a test) '(";" "+"))
+ "this;is;a;test"))
+ (should
+ (string= (sx--thing-as-string
+ '(this is a test) "+")
+ "this+is+a+test"))
+ (should
+ (string= (sx--thing-as-string
+ '(this is a test))
+ "this;is;a;test"))
+ (should
+ (string= (sx--thing-as-string
+ 'test)
+ "test"))
+ (should
+ (string= (sx--thing-as-string
+ 'test&)
+ "test&"))
+ (should
+ (string= (sx--thing-as-string
+ 'test& nil t)
+ "test%26")))
diff --git a/test/tests.el b/test/tests.el
index 43531b4..d06c0ff 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -1,3 +1,5 @@
+
+;;; SX Settings
(defun -sx--nuke ()
(interactive)
(mapatoms
@@ -5,11 +7,17 @@
(if (string-prefix-p "sx-" (symbol-name symbol))
(unintern symbol)))))
-;;; Tests
+(setq
+ sx-initialized t
+ sx-request-remaining-api-requests-message-threshold 50000
+ debug-on-error t
+ user-emacs-directory "."
+ sx-test-base-dir (file-name-directory (or load-file-name "./")))
+
+
+;;; Test Data
(defvar sx-test-data-dir
- (expand-file-name
- "data-samples/"
- (or (file-name-directory load-file-name) "./")))
+ (expand-file-name "data-samples/" sx-test-base-dir))
(defun sx-test-sample-data (method &optional directory)
(let ((file (concat (when directory (concat directory "/"))
@@ -20,148 +28,34 @@
(insert-file-contents file)
(read (buffer-string))))))
-(defmacro line-should-match (regexp)
- ""
- `(let ((line (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))))
- (message "Line here is: %S" line)
- (should (string-match ,regexp line))))
-
(setq
- sx-initialized t
- sx-request-remaining-api-requests-message-threshold 50000
- debug-on-error t
- user-emacs-directory "."
-
sx-test-data-questions
(sx-test-sample-data "questions")
sx-test-data-sites
(sx-test-sample-data "sites"))
-(setq package-user-dir
- (expand-file-name (format "../../.cask/%s/elpa" emacs-version)
- sx-test-data-dir))
-(package-initialize)
-
-(require 'cl-lib)
-(require 'sx)
-(require 'sx-question)
-(require 'sx-question-list)
-(require 'sx-tab)
-
-(ert-deftest test-basic-request ()
- "Test basic request functionality"
- (should (sx-request-make "sites")))
-
-(ert-deftest test-question-retrieve ()
- "Test the ability to receive a list of questions."
- (should (sx-question-get-questions 'emacs)))
+
+;;; General Settings
+(setq
+ package-user-dir (expand-file-name
+ (format "../../.cask/%s/elpa" emacs-version)
+ sx-test-data-dir))
-(ert-deftest test-bad-request ()
- "Test a method given a bad set of keywords"
- (should-error
- (sx-request-make "questions" '(()))))
+(package-initialize)
-(ert-deftest test-tree-filter ()
- "`sx-core-filter-data'"
- ;; flat
- (should
- (equal
- '((1 . t) (2 . [1 2]) (3))
- (sx--filter-data '((0 . 3) (1 . t) (a . five) (2 . [1 2])
- ("5" . bop) (3) (p . 4))
- '(1 2 3))))
- ;; complex
- (should
- (equal
- '((1 . [a b c])
- (2 . [((a . 1) (c . 3))
- ((a . 4) (c . 6))])
- (3 . peach))
- (sx--filter-data '((1 . [a b c])
- (2 . [((a . 1) (b . 2) (c . 3))
- ((a . 4) (b . 5) (c . 6))])
- (3 . peach)
- (4 . banana))
- '(1 (2 a c) 3))))
+(require 'sx-load)
- ;; vector
- (should
- (equal
- [((1 . 2) (2 . 3) (3 . 4))
- ((1 . a) (2 . b) (3 . c))
- nil ((1 . alpha) (2 . beta))]
- (sx--filter-data [((1 . 2) (2 . 3) (3 . 4))
- ((1 . a) (2 . b) (3 . c) (5 . seven))
- ((should-not-go))
- ((1 . alpha) (2 . beta))]
- '(1 2 3)))))
+(defun sx-load-test (test)
+ (load-file
+ (format "%s/test-%s.el"
+ sx-test-base-dir
+ (symbol-name test))))
-(ert-deftest question-list-display ()
- (cl-letf (((symbol-function #'sx-request-make)
- (lambda (&rest _) sx-test-data-questions)))
- (sx-tab-frontpage nil "emacs")
- (switch-to-buffer "*question-list*")
- (goto-char (point-min))
- (should (equal (buffer-name) "*question-list*"))
- (line-should-match
- "^\\s-+1\\s-+0\\s-+Focus-hook: attenuate colours when losing focus [ 0-9]+[ydhms] ago\\s-+\\[frames\\] \\[hooks\\] \\[focus\\]")
- (sx-question-list-next 5)
- (line-should-match
- "^\\s-+0\\s-+1\\s-+Babel doesn&#39;t wrap results in verbatim [ 0-9]+[ydhms] ago\\s-+\\[org-mode\\]")
- ;; ;; Use this when we have a real sx-question buffer.
- ;; (call-interactively 'sx-question-list-display-question)
- ;; (should (equal (buffer-name) "*sx-question*"))
- (switch-to-buffer "*question-list*")
- (sx-question-list-previous 4)
- (line-should-match
- "^\\s-+2\\s-+1\\s-+&quot;Making tag completion table&quot; Freezes/Blocks -- how to disable [ 0-9]+[ydhms] ago\\s-+\\[autocomplete\\]")))
+(setq sx-test-enable-messages nil)
-(ert-deftest macro-test--sx-assoc-let ()
- "Tests macro expansion for `sx-assoc-let'"
- (should
- (equal '(let ((.test (cdr (assoc 'test data))))
- .test)
- (macroexpand
- '(sx-assoc-let data
- .test))))
- (should
- (equal '(let ((.test-one (cdr (assoc 'test-one data)))
- (.test-two (cdr (assoc 'test-two data))))
- (cons .test-one .test-two))
- (macroexpand
- '(sx-assoc-let data
- (cons .test-one .test-two))))))
+(defun sx-test-message (message &rest args)
+ (when sx-test-enable-messages
+ (apply #'message message args)))
-(ert-deftest thing-as-string ()
- "Tests `sx--thing-as-string'"
- (should
- (string= (sx--thing-as-string
- '(hello world (this is a test))
- '(";" "+"))
- "hello;world;this+is+a+test"))
- (should
- (string= (sx--thing-as-string
- '(this is a test) '(";" "+"))
- "this;is;a;test"))
- (should
- (string= (sx--thing-as-string
- '(this is a test) "+")
- "this+is+a+test"))
- (should
- (string= (sx--thing-as-string
- '(this is a test))
- "this;is;a;test"))
- (should
- (string= (sx--thing-as-string
- 'test)
- "test"))
- (should
- (string= (sx--thing-as-string
- 'test&)
- "test&"))
- (should
- (string= (sx--thing-as-string
- 'test& nil t)
- "test%26")))
+(mapc #'sx-load-test
+ '(api macros printing util search))