+++ /dev/null
-;;; sx-auth.el --- user authentication -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 handles logic related to authentication. This includes
-;; determining if a certain filter requires authentication (via the
-;; variable `sx-auth-filter-auth' and function `sx-auth--filter-p'),
-;; determining if a method requires authentication (via the variable
-;; `sx-auth-method-auth' and function `sx-auth--method-p'), and
-;; actually authenticating the user (with `sx-auth-authenticate').
-
-;;; Code:
-
-(require 'sx)
-(require 'sx-request)
-(require 'sx-cache)
-
-(defconst sx-auth-root
- "https://stackexchange.com/oauth/dialog")
-(defconst sx-auth-redirect-uri
- "https://vermiculus.github.io/sx.el/auth/auth.htm")
-(defconst sx-auth-client-id
- "3291")
-(defvar sx-auth-access-token
- nil
- "Your access token.
-This is needed to use your account to write questions, make
-comments, and read your inbox. Do not alter this unless you know
-what you are doing!
-
-This variable is set with `sx-auth-authenticate'.")
-
-(defconst sx-auth-method-auth
- '((me . t)
- (inbox . t)
- (notifications . t)
- (events . t)
- (posts (comments add))
- (comments delete
- edit
- flags
- upvote)
- (answers accept
- delete
- downvote
- edit
- flags
- upvote)
- (questions answers
- add
- close
- delete
- downvote
- edit
- favorite
- flags
- render
- upvote
- (unanswered my-tags)))
- "List of methods that require auth.
-Methods are of the form \(METHOD . SUBMETHODS) where SUBMETHODS
- is \(METHOD METHOD METHOD ...).
-
-If all SUBMETHODS require auth or there are no submethods, form
-will be \(METHOD . t)")
-
-(defconst sx-auth-filter-auth
- '(question.upvoted
- question.downvoted
- answer.upvoted
- answer.downvoted
- comment.upvoted)
- "List of filter types that require auth.
-Keywords are of the form \(OBJECT TYPES) where TYPES is \(FILTER
-FILTER FILTER).")
-
-;;;###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
-questions).
-
-When this function is called, `browse-url' is used to send the
-user to an authorization page managed by StackExchange. The
-following privileges are requested:
-
-* read_inbox
- use SX to manage and visit items in your inbox
-
-* write_acesss
- write comments, ask questions, and post answers on your
- behalf
-
-* no_expiry
- do not pester you to reauthorize again
-
-* private_info
- TODO explanation.
-
-After authorization with StackExchange, the user is then
-redirected to a website managed by SX. The access token required
-to use authenticated methods is included in the hash (which is
-parsed and displayed prominently on the page)."
- (interactive)
- (setq
- sx-auth-access-token
- (let ((url (concat
- sx-auth-root
- "?"
- (sx-request--build-keyword-arguments
- `((client_id . ,sx-auth-client-id)
- (scope . (read_inbox
- no_expiry
- private_info
- write_access))
- (redirect_uri . ,sx-auth-redirect-uri))
- ","))))
- (browse-url url)
- (read-string "Enter the access token displayed on the webpage: ")))
- (if (string-equal "" sx-auth-access-token)
- (progn (setq sx-auth-access-token nil)
- (error "You must enter this code to use this client fully"))
- (sx-cache-set 'auth `((access_token . ,sx-auth-access-token)))))
-
-(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."
- (let ((method-auth (cdr (assoc method sx-auth-method-auth)))
- ;; If the submethod has additional options, they may all be
- ;; eligible, in which case we only need to check the `car'.
- (sub-head (if (listp submethod)
- (car submethod))))
- (lwarn " sx-auth method" :debug "Method %s requires auth" method-auth)
- (and method-auth
- (or
- ;; All submethods require auth.
- (eq t method-auth)
- ;; All sub-submethods require auth.
- (member sub-head method-auth)
- ;; Specific submethod requires auth.
- (member submethod method-auth)))))
-
-;; Temporary solution. When we switch to pre-defined filters we will
-;; have to change the logic to match against specific filters.
-(defun sx-auth--filter-p (filter)
- "Check if FILTER contains properties that require authentication.
-If it has `auth-required' properties, return a filter that has
-removed those properties."
- (let* ((incl-filter (if (listp filter) (car filter)))
- (rest-filter (if incl-filter (cdr filter)))
- (auth-filters (remove nil
- ;; Only retrieve the elements that
- ;; are issues.
- (mapcar (lambda (prop)
- (car
- (member prop
- sx-auth-filter-auth)))
- (or incl-filter filter))))
- clean-filter out-filter)
- (lwarn "sx-auth filter" :debug "Filter: %S" filter)
- ;; Auth-filters is the filters that are issues
- (when auth-filters
- (setq clean-filter
- (cl-remove-if (lambda (prop)
- (member prop auth-filters))
- (or incl-filter filter))))
- (if (and incl-filter clean-filter)
- (setq out-filter
- (cons clean-filter rest-filter))
- (setq out-filter clean-filter))
- (lwarn "sx-auth filter2" :debug "Filter property %s requires auth. %S"
- auth-filters out-filter)
- out-filter))
-
-(provide 'sx-auth)
-;;; sx-auth.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "sx" "sx.el" (0 0 0 0))
-;;; Generated autoloads from sx.el
-
-(autoload 'sx-bug-report "sx" "\
-File a bug report about the `sx' package.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-auth" "sx-auth.el" (0 0 0 0))
-;;; Generated autoloads from sx-auth.el
-
-(autoload 'sx-authenticate "sx-auth" "\
-Authenticate this application.
-Authentication is required to read your personal data (such as
-notifications) and to write with the API (asking and answering
-questions).
-
-When this function is called, `browse-url' is used to send the
-user to an authorization page managed by StackExchange. The
-following privileges are requested:
-
-* read_inbox
- use SX to manage and visit items in your inbox
-
-* write_acesss
- write comments, ask questions, and post answers on your
- behalf
-
-* no_expiry
- do not pester you to reauthorize again
-
-* private_info
- TODO explanation.
-
-After authorization with StackExchange, the user is then
-redirected to a website managed by SX. The access token required
-to use authenticated methods is included in the hash (which is
-parsed and displayed prominently on the page).
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-auth" '("sx-auth-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-babel" "sx-babel.el" (0 0 0 0))
-;;; Generated autoloads from sx-babel.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-babel" '("sx-babel-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-button" "sx-button.el" (0 0 0 0))
-;;; Generated autoloads from sx-button.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-button" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-cache" "sx-cache.el" (0 0 0 0))
-;;; Generated autoloads from sx-cache.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-cache" '("sx-cache-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-compose" "sx-compose.el" (0 0 0 0))
-;;; Generated autoloads from sx-compose.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-compose" '("sx-compose-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-encoding" "sx-encoding.el" (0 0 0 0))
-;;; Generated autoloads from sx-encoding.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-encoding" '("sx-encoding-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-favorites" "sx-favorites.el" (0 0 0 0))
-;;; Generated autoloads from sx-favorites.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-favorites" '("sx-favorite")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-filter" "sx-filter.el" (0 0 0 0))
-;;; Generated autoloads from sx-filter.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-filter" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-inbox" "sx-inbox.el" (0 0 0 0))
-;;; Generated autoloads from sx-inbox.el
-
-(autoload 'sx-inbox "sx-inbox" "\
-Display a buffer listing inbox items.
-With prefix NOTIFICATIONS, list notifications instead of inbox.
-
-\(fn &optional NOTIFICATIONS)" t nil)
-
-(autoload 'sx-inbox-notifications "sx-inbox" "\
-Display a buffer listing notification items.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-inbox" '("sx-inbox-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-interaction" "sx-interaction.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from sx-interaction.el
-
-(autoload 'sx-open-link "sx-interaction" "\
-Visit element given by LINK inside Emacs.
-Element can be a question, answer, or comment.
-
-\(fn LINK &optional _)" t nil)
-
-(autoload 'sx-org-get-link "sx-interaction" "\
-Add a link to this post to Org's memory.
-
-\(fn)" nil nil)
-
-(autoload 'sx-ask "sx-interaction" "\
-Start composing a question for SITE.
-SITE is a string, indicating where the question will be posted.
-
-\(fn SITE)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-interaction" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-method" "sx-method.el" (0 0 0 0))
-;;; Generated autoloads from sx-method.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-method" '("sx-method-post-from-data")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-networks" "sx-networks.el" (0 0 0 0))
-;;; Generated autoloads from sx-networks.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-networks" '("sx-network-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-notify" "sx-notify.el" (0 0 0 0))
-;;; Generated autoloads from sx-notify.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-notify" '("sx-notify-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-question" "sx-question.el" (0 0 0 0))
-;;; Generated autoloads from sx-question.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-question" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-question-list" "sx-question-list.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from sx-question-list.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-question-list" '("sx-question-list-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-question-mode" "sx-question-mode.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from sx-question-mode.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-question-mode" '("sx-question-mode")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-question-print" "sx-question-print.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from sx-question-print.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-question-print" '("sx-question-mode-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-request" "sx-request.el" (0 0 0 0))
-;;; Generated autoloads from sx-request.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-request" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-search" "sx-search.el" (0 0 0 0))
-;;; Generated autoloads from sx-search.el
-
-(autoload 'sx-search "sx-search" "\
-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.
-
-\(fn SITE QUERY &optional TAGS EXCLUDED-TAGS)" t nil)
-
-(autoload 'sx-search-tag-at-point "sx-search" "\
-Follow tag under position POS or point.
-
-\(fn &optional POS)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-search" '("sx-search-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-site" "sx-site.el" (0 0 0 0))
-;;; Generated autoloads from sx-site.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-site" '("sx-site-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-switchto" "sx-switchto.el" (0 0 0 0))
-;;; Generated autoloads from sx-switchto.el
-
-(define-prefix-command 'sx-switchto-map)
-
-;;;***
-\f
-;;;### (autoloads nil "sx-tab" "sx-tab.el" (0 0 0 0))
-;;; Generated autoloads from sx-tab.el
-
-(autoload 'sx-tab-all-questions "sx-tab" nil t)
-
-(autoload 'sx-tab-unanswered "sx-tab" nil t)
-
-(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t)
-
-(autoload 'sx-tab-featured "sx-tab" nil t)
-
-(autoload 'sx-tab-starred "sx-tab" nil t)
-
-(autoload 'sx-tab-frontpage "sx-tab" nil t)
-
-(autoload 'sx-tab-newest "sx-tab" nil t)
-
-(autoload 'sx-tab-topvoted "sx-tab" nil t)
-
-(autoload 'sx-tab-hot "sx-tab" nil t)
-
-(autoload 'sx-tab-week "sx-tab" nil t)
-
-(autoload 'sx-tab-month "sx-tab" nil t)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-tab" '("sx-tab-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-tag" "sx-tag.el" (0 0 0 0))
-;;; Generated autoloads from sx-tag.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-tag" '("sx-tag-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-time" "sx-time.el" (0 0 0 0))
-;;; Generated autoloads from sx-time.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-time" '("sx-time-")))
-
-;;;***
-\f
-;;;### (autoloads nil "sx-user" "sx-user.el" (0 0 0 0))
-;;; Generated autoloads from sx-user.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sx-user" '("sx-")))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("sx-load.el" "sx-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; sx-autoloads.el ends here
+++ /dev/null
-;;; sx-babel.el --- font-locking pre blocks according to language -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 variable `sx-babel-major-mode-alist', which see.
-
-\f
-;;; 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)
- ;; Not sure if leaving out "[{" might lead to false positives.
- (,(rx "\\" (+ alnum) (any "[{")) latex-mode)
- ;; Right now, this will match a lot of stuff. Once we are capable
- ;; of determining major-mode from tags, site, and comments, this
- ;; will work as a last case fallback.
- (,(rx (or (and "int" (+ space) "main" (* space) "("))) c-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)
-
-\f
-;;; 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
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-button.el --- defining buttons -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file defines all buttons used by SX. For information on
-;; buttons, see:
-;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Buttons.html
-;;
-;; Most interactive parts of the SX buffers are buttons. Wherever you
-;; are, you can always cycle through all buttons by hitting `TAB',
-;; that should help identify what's a button in each buffer.
-;;
-;; To define a new type of button follow the examples below using
-;; `define-button-type' with :supertype `sx-button'. Required
-;; properties are `action' and `help-echo'. You'll probably want to
-;; give it a `face' as well, unless you want it to look like a link.
-;;
-;; Buttons can then be inserted in their respective files using
-;; `insert-text-button'. Give it the string, the `:type' you defined,
-;; and any additional properties that can only be determined at
-;; creation. Existing text can be transformed into a button with
-;; `make-text-button' instead.
-
-\f
-;;; Code:
-(require 'button)
-
-(require 'sx)
-(require 'sx-question)
-
-(declare-function sx-accept "sx-interaction")
-(declare-function sx-answer "sx-interaction")
-(declare-function sx-comment "sx-interaction")
-(declare-function sx-open-link "sx-interaction")
-(declare-function sx-question-mode-hide-show-section "sx-question-mode")
-
-\f
-;;; Face
-(defface sx-custom-button
- '((((type x w32 ns) (class color)) ; Like default mode line
- :box (:line-width 3 :style released-button)
- :height 0.9
- :background "lightgrey" :foreground "black"))
- "Face used on buttons such as \"Write an Answer\"."
- :group 'sx)
-
-\f
-;;; Command definitions
-;; This extends `button-map', which already defines RET and mouse-1.
-(defvar sx-button-map
- (let ((map (copy-keymap button-map)))
- (define-key map "w" #'sx-button-copy)
- map)
- "Keymap used on buttons.")
-
-(defun sx-button-copy ()
- "Copy the content of thing at point.
-This is usually a link's URL, or the content of a code block."
- (interactive)
- (let ((content
- (get-text-property (point) 'sx-button-copy)))
- (if (null content)
- (sx-message "Nothing to copy here.")
- (kill-new content)
- (sx-message "Copied %s to kill ring."
- (or (get-text-property
- (point) 'sx-button-copy-type)
- content)))))
-
-(defun sx-button-edit-this (text-or-marker &optional majormode)
- "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJORMODE.
-When given a marker (or interactively), use the 'sx-button-copy
-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 majormode (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)
- (when majormode
- (funcall majormode))))
-
-(defun sx-button-follow-link (&optional pos)
- "Follow link at POS. If POS is nil, use `point'."
- (interactive)
- (let ((url (or (get-text-property (or pos (point)) 'sx-button-url)
- (sx-user-error "No url under point: %s" (or pos (point))))))
- ;; If we didn't recognize the link, this errors immediately. If
- ;; we mistakenly recognize it, it will error when we try to fetch
- ;; whatever we thought it was.
- (condition-case nil (sx-open-link url)
- ;; When it errors, don't blame the user, just visit externally.
- (error (browse-url url)))))
-
-\f
-;;; Help-echo definitions
-(defconst sx-button--help-echo
- (concat "mouse-1, RET"
- (propertize ": %s -- " 'face 'minibuffer-prompt)
- "w"
- (propertize ": copy %s" 'face 'minibuffer-prompt))
- "Base help-echo on which others can be written.")
-
-(defconst sx-button--user-help-echo
- (format sx-button--help-echo
- "visit user page"
- "link")
- "Help echoed in the minibuffer when point is on a user.")
-
-(defconst sx-button--tag-help-echo
- (format sx-button--help-echo
- "Tag search"
- "tag")
- "Help echoed in the minibuffer when point is on a tag.")
-
-(defconst sx-button--question-title-help-echo
- (format sx-button--help-echo
- "hide content"
- "link")
- "Help echoed in the minibuffer when point is on a section.")
-
-(defconst sx-button--link-help-echo
- (format sx-button--help-echo
- "visit %s"
- "URL")
- "Help echoed in the minibuffer when point is on a section.")
-
-\f
-;;; Type definitions
-(define-button-type 'sx-button
- 'follow-link t
- 'keymap sx-button-map)
-
-(define-button-type 'sx-question-mode-title
- 'face 'sx-question-mode-title
- 'action #'sx-question-mode-hide-show-section
- 'help-echo sx-button--question-title-help-echo
- 'sx-button-copy-type "Share Link"
- :supertype 'sx-button)
-
-(define-button-type 'sx-question-mode-code-block
- 'action #'sx-button-edit-this
- 'face nil
- :supertype 'sx-button)
-
-(define-button-type 'sx-button-link
- 'action #'sx-button-follow-link
- :supertype 'sx-button)
-
-(define-button-type 'sx-button-user
- 'action #'sx-button-follow-link
- 'help-echo sx-button--user-help-echo
- ;; We use different faces on different parts of the user button.
- 'face 'sx-user-name
- :supertype 'sx-button)
-
-(declare-function sx-search-tag-at-point "sx-search")
-(define-button-type 'sx-button-tag
- 'action #'sx-search-tag-at-point
- 'help-echo sx-button--tag-help-echo
- 'face 'sx-tag
- :supertype 'sx-button)
-
-(define-button-type 'sx-button-comment
- 'help-echo (concat "mouse-1, RET"
- (propertize ": write a comment"
- 'face 'minibuffer-prompt))
- 'face 'sx-custom-button
- 'action #'sx-comment
- :supertype 'sx-button)
-
-(define-button-type 'sx-button-accept
- 'help-echo (concat "mouse-1, RET"
- (propertize ": accept answer"
- 'face 'minibuffer-prompt))
- 'face 'sx-custom-button
- 'action #'sx-accept
- :supertype 'sx-button)
-
-(define-button-type 'sx-button-answer
- 'help-echo (concat "mouse-1, RET"
- (propertize ": write an answer"
- 'face 'minibuffer-prompt))
- 'face 'sx-custom-button
- 'action #'sx-answer
- :supertype 'sx-button)
-
-(provide 'sx-button)
-;;; sx-button.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-cache.el --- caching -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 handles the cache system. All caches are retrieved and
-;; set using symbols. The symbol should be the sub-package that is
-;; using the cache. For example, `sx-pkg' would use
-;;
-;; `(sx-cache-get 'pkg)'
-;;
-;; This symbol is then converted into a filename within
-;; `sx-cache-directory' using `sx-cache-get-file-name'.
-;;
-;; Currently, the cache is written at every `sx-cache-set', but this
-;; write will eventually be done by some write-all function which will
-;; be set on an idle timer.
-
-;;; Code:
-
-(defcustom sx-cache-directory (locate-user-emacs-file ".sx")
- "Directory containing cached data."
- :type 'directory
- :group 'sx)
-
-(defun sx-cache--ensure-sx-cache-directory-exists ()
- "Ensure `sx-cache-directory' exists."
- (unless (file-exists-p sx-cache-directory)
- (mkdir sx-cache-directory)))
-
-(defun sx-cache-get-file-name (filename)
- "Expand FILENAME in the context of `sx-cache-directory'."
- (expand-file-name
- (concat (symbol-name filename) ".el")
- sx-cache-directory))
-
-(defun sx-cache-get (cache &optional form)
- "Return the data within CACHE.
-If CACHE does not exist, use `sx-cache-set' to set CACHE to the
-result of evaluating FORM.
-
-CACHE is resolved to a file name by `sx-cache-get-file-name'."
- (sx-cache--ensure-sx-cache-directory-exists)
- (let ((file (sx-cache-get-file-name cache)))
- ;; If the file exists, return the data it contains
- (if (file-exists-p file)
- (with-temp-buffer
- (insert-file-contents (sx-cache-get-file-name cache))
- (read (buffer-string)))
- ;; Otherwise, set CACHE to the evaluation of FORM.
- ;; `sx-cache-set' returns the data that CACHE was set to.
- (sx-cache-set cache (eval form)))))
-
-(defun sx-cache-set (cache data)
- "Set the content of CACHE to DATA and save.
-DATA will be written as returned by `prin1'.
-
-CACHE is resolved to a file name by `sx-cache-get-file-name'."
- (sx-cache--ensure-sx-cache-directory-exists)
- (let (print-length print-level)
- (write-region (prin1-to-string data) nil
- (sx-cache-get-file-name cache)))
- data)
-
-(defun sx-cache--invalidate (cache &optional vars init-method)
- "Set cache CACHE to nil.
-
-VARS is a list of variables to unbind to ensure cache is cleared.
-If INIT-METHOD is defined, call it after all invalidation to
-re-initialize the cache."
- (let ((file (sx-cache-get-file-name cache)))
- (delete-file file))
- (mapc #'makunbound vars)
- (when init-method
- (funcall init-method)))
-
-(defun sx-cache-invalidate-all (&optional save-auth)
- "Invalidate all caches using `sx-cache--invalidate'.
-Afterwards reinitialize caches using `sx-initialize'. If
-SAVE-AUTH is non-nil, do not clear AUTH cache.
-
-Interactively, SAVE-AUTH is the negation of the prefix argument.
-That is, by default the auth cache is PRESERVED interactively.
-If you provide a prefix argument, the auth cache is INVALIDATED.
-
-Note: This will also remove read/unread status of questions as well
-as delete the list of hidden questions."
- (interactive (list (not current-prefix-arg)))
- (let* ((default-directory sx-cache-directory)
- (caches (file-expand-wildcards "*.el")))
- (when save-auth
- (setq caches (cl-remove-if (lambda (x)
- (string= x "auth.el")) caches)))
- (lwarn 'sx :debug "Invalidating: %S" caches)
- (mapc #'delete-file caches)
- (sx-initialize 'force)))
-
-(provide 'sx-cache)
-;;; sx-cache.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-compose.el --- major-mode for composing questions and answers -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file defines `sx-compose-mode' and its auxiliary functions and
-;; variables. In order to use `sx-compose-mode', it is vital that the
-;; variable `sx-compose--send-function' be set. Otherwise it's just a
-;; regular markdown buffer.
-;;
-;; In order to help avoid mistakes, there is the function
-;; `sx-compose-create'. This is the preferred way of activating the
-;; mode. It creates a buffer, activates the major mode, and sets the
-;; `send-function' variable according to the arguments it is given.
-
-\f
-;;; Code:
-(require 'markdown-mode)
-
-(require 'sx)
-(require 'sx-tag)
-
-(defgroup sx-compose-mode nil
- "Customization group for sx-compose-mode."
- :prefix "sx-compose-mode-"
- :tag "SX compose Mode"
- :group 'sx)
-
-\f
-;;; Faces and Variables
-(defvar sx-compose-before-send-hook nil
- "Hook run before POSTing to the API.
-Functions are called without arguments and should return non-nil.
-
-Returning nil indicates something went wrong and the sending will
-be aborted. In this case, the function is responsible for
-notifying the user.
-
-Current buffer is the compose-mode buffer whose content is about
-to be POSTed.")
-
-(defvar sx-compose-after-send-functions nil
- "Hook run after POSTing to the API.
-Functions on this hook should take two arguments, the
-`sx-compose-mode' buffer (which not be live) and the data
-returned by `sx-compose--send-function' (usually the object
-created by the API). They are only called if the transaction
-succeeds.")
-
-(defvar sx-compose--send-function nil
- "Function used by `sx-compose-send' to send the data.
-Is invoked between `sx-compose-before-send-hook' and
-`sx-compose-after-send-functions'.")
-
-(defconst sx-compose--question-headers
- (concat
- #("Title: " 0 7 (intangible t read-only t rear-nonsticky t))
- "%s"
- #("\n" 0 1 (read-only t))
- #("Tags : " 0 7 (read-only t intangible t rear-nonsticky t))
- "%s"
- #("\n" 0 1 (read-only t rear-nonsticky t))
- #("________________________________________\n"
- 0 41 (read-only t rear-nonsticky t intangible t
- sx-compose-separator t))
- "\n")
- "Headers inserted when composing a new question.
-Used by `sx-compose-create'.")
-
-(defconst sx-compose--header-line
- '(" "
- (:propertize "C-c C-c" face mode-line-buffer-id)
- ": Finish and Send"
- (sx-compose--is-question-p
- (" "
- (:propertize "C-c C-q" face mode-line-buffer-id)
- ": Insert tags"))
- " "
- (:propertize "C-c C-k" face mode-line-buffer-id)
- ": Discard Draft")
- "Header-line used on `sx-compose-mode' drafts.")
-
-(defvar sx-compose--is-question-p nil
- "Non-nil if this `sx-compose-mode' buffer is a question.")
-(make-variable-buffer-local 'sx-compose--is-question-p)
-
-(defvar sx-compose--site nil
- "Site which the curent compose buffer belongs to.")
-(make-variable-buffer-local 'sx-compose--site)
-
-\f
-;;; Major-mode
-(define-derived-mode sx-compose-mode markdown-mode "Compose"
- "Major mode for coposing questions and answers.
-Most of the functionality comes from `markdown-mode'. This mode
-just implements some extra features related to posting to the
-API.
-
-This mode won't function if `sx-compose--send-function' isn't
-set. To make sure you set it correctly, you can create the
-buffer with the `sx-compose-create' function.
-
-If creating a question draft, the `sx-compose--is-question-p'
-variable should also be set to enable more functionality.
-
-\\<sx-compose-mode>
-\\{sx-compose-mode}"
- (setq header-line-format sx-compose--header-line)
- (add-hook 'sx-compose-after-send-functions
- #'sx-compose-quit nil t)
- (add-hook 'sx-compose-after-send-functions
- #'sx-compose--copy-as-kill nil t))
-
-(define-key sx-compose-mode-map "\C-c\C-c" #'sx-compose-send)
-(define-key sx-compose-mode-map "\C-c\C-k" #'sx-compose-quit)
-(sx--define-conditional-key
- sx-compose-mode-map "\C-c\C-q" #'sx-compose-insert-tags
- sx-compose--is-question-p)
-
-(defun sx-compose-send ()
- "Finish composing current buffer and send it.
-Calls `sx-compose-before-send-hook', POSTs the the current buffer
-contents to the API, then calls `sx-compose-after-send-functions'."
- (interactive)
- (when (run-hook-with-args-until-failure
- 'sx-compose-before-send-hook)
- (let ((result (funcall sx-compose--send-function))
- (buf (current-buffer)))
- (run-hook-wrapped
- 'sx-compose-after-send-functions
- (lambda (func)
- (with-demoted-errors
- "[sx] Error encountered AFTER sending post, but the post was sent successfully: %s"
- (funcall func buf result))
- nil)))))
-
-(defun sx-compose-insert-tags ()
- "Prompt for a tag list for this draft and insert them."
- (interactive)
- (save-excursion
- (let* ((old (sx-compose--goto-tag-header))
- (new
- (save-match-data
- (mapconcat
- #'identity
- (sx-tag-multiple-read sx-compose--site "Tags" old)
- " "))))
- (if (match-string 1)
- (replace-match new :fixedcase nil nil 1)
- (insert new)))))
-
-\f
-;;; Functions for use in hooks
-(defun sx-compose-quit (buffer _)
- "Close BUFFER's window and kill it."
- (interactive (list (current-buffer) nil))
- (when (buffer-live-p buffer)
- (let ((w (get-buffer-window buffer)))
- (when (window-live-p w)
- (ignore-errors (delete-window w))))
- (kill-buffer buffer)))
-
-(defun sx-compose--copy-as-kill (buffer _)
- "Copy BUFFER contents to the kill-ring."
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (kill-new (buffer-string)))))
-
-(defun sx-compose--goto-tag-header ()
- "Move to the \"Tags:\" header.
-Match data is set so group 1 encompasses any already inserted
-tags. Return a list of already inserted tags."
- (goto-char (point-min))
- (unless (search-forward-regexp
- (rx bol "Tags : " (group-n 1 (* not-newline)) eol)
- (next-single-property-change (point-min) 'sx-compose-separator)
- 'noerror)
- (error "No Tags header found"))
- (save-match-data
- (sx--split-string (match-string 1) (rx (any space ",;")))))
-
-(defun sx-compose--check-tags ()
- "Check if tags in current compose buffer are valid."
- (save-excursion
- (let ((invalid-tags
- (sx-tag--invalid-name-p
- sx-compose--site (sx-compose--goto-tag-header))))
- (if invalid-tags
- ;; If the user doesn't want to create the tags, we return
- ;; nil and sending is aborted.
- (y-or-n-p (format "Following tags don't exist. Create them? %s " invalid-tags))
- t))))
-
-\f
-;;; Functions to help preparing buffers
-(defun sx-compose-create (site parent &optional before-functions after-functions)
- "Create an `sx-compose-mode' buffer.
-SITE is the site where it will be posted.
-
-If composing questions, PARENT is nil.
-If composing answers, it is the `question_id'.
-If editing answers or questions, it should be the alist data
-related to that object.
-
-Each element of BEFORE-FUNCTIONS and AFTER-FUNCTIONS are
-respectively added locally to `sx-compose-before-send-hook' and
-`sx-compose-after-send-functions'."
- (or (integerp parent) (listp parent)
- (error "Invalid PARENT"))
- (let ((is-question
- (and (listp parent)
- (or (null parent)
- (cdr (assoc 'title parent))))))
- (with-current-buffer (sx-compose--get-buffer-create site parent)
- (sx-compose-mode)
- (setq sx-compose--site site)
- (setq sx-compose--is-question-p is-question)
- (setq sx-compose--send-function
- (if (consp parent)
- (sx-assoc-let parent
- (lambda () (sx-method-call (cond
- (.title 'questions)
- (.comment_id 'comments)
- (t 'answers))
- :auth 'warn
- :url-method 'post
- :filter sx-browse-filter
- :site site
- :keywords (sx-compose--generate-keywords is-question)
- :id (or .comment_id .answer_id .question_id)
- :submethod 'edit)))
- (lambda () (sx-method-call 'questions
- :auth 'warn
- :url-method 'post
- :filter sx-browse-filter
- :site site
- :keywords (sx-compose--generate-keywords is-question)
- :id parent
- :submethod (if parent 'answers/add 'add)))))
- ;; Reverse so they're left in the same order.
- (dolist (it (reverse before-functions))
- (add-hook 'sx-compose-before-send-hook it nil t))
- (dolist (it (reverse after-functions))
- (add-hook 'sx-compose-after-send-functions it nil t))
- (when is-question
- (add-hook 'sx-compose-before-send-hook #'sx-compose--check-tags nil t))
- ;; If the buffer is empty, the draft didn't exist. So prepare the
- ;; question.
- (when (or (string= (buffer-string) "")
- (y-or-n-p "Draft buffer exists. Reset it? "))
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- (erase-buffer)
- (when (consp parent)
- (insert (cdr (assoc 'body_markdown parent))))
- (when is-question
- (sx-compose--print-question-headers
- (when (consp parent) parent))
- (unless (consp parent)
- (goto-char (point-min))
- (goto-char (line-end-position))))))
- ;; Return the buffer
- (current-buffer))))
-
-(defun sx-compose--print-question-headers (question)
- "Print question headers for the compose buffer.
-If QUESTION is non-nil, fill the headers with the data from
-QUESTION."
- (sx-assoc-let question
- (goto-char (point-min))
- (insert
- (format sx-compose--question-headers
- (or .title "") (mapconcat #'identity .tags " ")))))
-
-(defun sx-compose--generate-keywords (is-question)
- "Reading current buffer, generate a keywords alist.
-Keywords meant to be used in `sx-method-call'.
-
-`body' is read as the `buffer-string'. If IS-QUESTION is non-nil,
-other keywords are read from the header "
- (goto-char (point-min))
- `(,@(when is-question
- (let ((inhibit-point-motion-hooks t)
- (header-end
- (next-single-property-change
- (point-min) 'sx-compose-separator))
- keywords)
- ;; Read the Title.
- (unless (search-forward-regexp
- "^Title: *\\(.*\\) *$" header-end 'noerror)
- (error "No Title header found"))
- (push (cons 'title (match-string 1)) keywords)
- ;; And the tags
- (goto-char (point-min))
- (unless (search-forward-regexp "^Tags : *\\([^[:space:]].*\\) *$"
- header-end 'noerror)
- (error "No Tags header found"))
- (push (cons 'tags (sx--split-string (match-string 1) "[[:space:],;]"))
- keywords)
- ;; And move past the header so it doesn't get sent.
- (goto-char (next-single-property-change
- header-end 'sx-compose-separator))
- keywords))
- (body . ,(buffer-substring-no-properties (point) (point-max)))))
-
-(defun sx-compose--get-buffer-create (site data)
- "Get or create a buffer for use with `sx-compose-mode'.
-SITE is the site for which composing is aimed (just used to
-uniquely identify the buffers).
-
-If DATA is nil, get a fresh compose buffer.
-If DATA is an integer, try to find an existing buffer
-corresponding to that integer, otherwise create one.
-If DATA is an alist (question or answer data), like above but use
-the id property."
- (cond
- ((null data)
- (generate-new-buffer
- (format "*sx draft question %s*" site)))
- ((integerp data)
- (get-buffer-create
- (format "*sx draft answer %s %s*"
- site data)))
- (t
- (get-buffer-create
- (sx-assoc-let data
- (format "*sx draft edit %s %s %s*"
- site
- (cond (.title "question")
- (.comment_id "comment")
- (t "answer"))
- (or .comment_id .answer_id .question_id)))))))
-
-(provide 'sx-compose)
-;;; sx-compose.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-encoding.el --- encoding -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 handles decoding the responses we get from the API. They
-;; are received either as plain-text or as a `gzip' compressed archive.
-;; For this, `sx-encoding-gzipped-p' is used to determine if content
-;; has been compressed under `gzip'.
-
-;;; Code:
-
-(require 'cl-lib)
-
-\f
-;;;; HTML Encoding
-
-(defcustom sx-encoding-html-entities-plist
- '(Aacute "Á" aacute "á" Acirc "Â" acirc "â" acute "´" AElig "Æ" aelig "æ"
- Agrave "À" agrave "à" alefsym "ℵ" Alpha "Α" alpha "α" amp "&" and "∧"
- ang "∠" apos "'" aring "å" Aring "Å" asymp "≈" atilde "ã" Atilde "Ã"
- auml "ä" Auml "Ä" bdquo "„" Beta "Β" beta "β" brvbar "¦" bull "•"
- cap "∩" ccedil "ç" Ccedil "Ç" cedil "¸" cent "¢" Chi "Χ" chi "χ"
- circ "ˆ" clubs "♣" cong "≅" copy "©" crarr "↵" cup "∪" curren "¤"
- Dagger "‡" dagger "†" darr "↓" dArr "⇓" deg "°" Delta "Δ" delta "δ"
- diams "♦" divide "÷" eacute "é" Eacute "É" ecirc "ê" Ecirc "Ê" egrave "è"
- Egrave "È" empty "∅" emsp " " ensp " " Epsilon "Ε" epsilon "ε" equiv "≡"
- Eta "Η" eta "η" eth "ð" ETH "Ð" euml "ë" Euml "Ë" euro "€"
- exist "∃" fnof "ƒ" forall "∀" frac12 "½" frac14 "¼" frac34 "¾" frasl "⁄"
- Gamma "Γ" gamma "γ" ge "≥" gt ">" harr "↔" hArr "⇔" hearts "♥"
- hellip "…" iacute "í" Iacute "Í" icirc "î" Icirc "Î" iexcl "¡" igrave "ì"
- Igrave "Ì" image "ℑ" infin "∞" int "∫" Iota "Ι" iota "ι" iquest "¿"
- isin "∈" iuml "ï" Iuml "Ï" Kappa "Κ" kappa "κ" Lambda "Λ" lambda "λ"
- lang "〈" laquo "«" larr "←" lArr "⇐" lceil "⌈" ldquo "“" le "≤"
- lfloor "⌊" lowast "∗" loz "◊" lrm "" lsaquo "‹" lsquo "‘" lt "<"
- macr "¯" mdash "—" micro "µ" middot "·" minus "−" Mu "Μ" mu "μ"
- nabla "∇" nbsp " " ndash "–" ne "≠" ni "∋" not "¬" notin "∉"
- nsub "⊄" ntilde "ñ" Ntilde "Ñ" Nu "Ν" nu "ν" oacute "ó" Oacute "Ó"
- ocirc "ô" Ocirc "Ô" OElig "Œ" oelig "œ" ograve "ò" Ograve "Ò" oline "‾"
- omega "ω" Omega "Ω" Omicron "Ο" omicron "ο" oplus "⊕" or "∨" ordf "ª"
- ordm "º" oslash "ø" Oslash "Ø" otilde "õ" Otilde "Õ" otimes "⊗" ouml "ö"
- Ouml "Ö" para "¶" part "∂" permil "‰" perp "⊥" Phi "Φ" phi "φ"
- Pi "Π" pi "π" piv "ϖ" plusmn "±" pound "£" Prime "″" prime "′"
- prod "∏" prop "∝" Psi "Ψ" psi "ψ" quot "\"" radic "√" rang "〉"
- raquo "»" rarr "→" rArr "⇒" rceil "⌉" rdquo "”" real "ℜ" reg "®"
- rfloor "⌋" Rho "Ρ" rho "ρ" rlm "" rsaquo "›" rsquo "’" sbquo "‚"
- scaron "š" Scaron "Š" sdot "⋅" sect "§" shy "" Sigma "Σ" sigma "σ"
- sigmaf "ς" sim "∼" spades "♠" sub "⊂" sube "⊆" sum "∑" sup "⊃"
- sup1 "¹" sup2 "²" sup3 "³" supe "⊇" szlig "ß" Tau "Τ" tau "τ"
- there4 "∴" Theta "Θ" theta "θ" thetasym "ϑ" thinsp " " thorn "þ" THORN "Þ"
- tilde "˜" times "×" trade "™" uacute "ú" Uacute "Ú" uarr "↑" uArr "⇑"
- ucirc "û" Ucirc "Û" ugrave "ù" Ugrave "Ù" uml "¨" upsih "ϒ" Upsilon "Υ"
- upsilon "υ" uuml "ü" Uuml "Ü" weierp "℘" Xi "Ξ" xi "ξ" yacute "ý"
- Yacute "Ý" yen "¥" yuml "ÿ" Yuml "Ÿ" Zeta "Ζ" zeta "ζ" zwj "" zwnj "")
- "Plist of HTML entities and their respective glyphs.
-See `sx-encoding-decode-entities'."
- :type '(repeat (choice symbol string))
- :group 'sx)
-
-(defun sx-encoding-decode-entities (string)
- "Decode HTML entities (e.g. \""\") in STRING.
-
-Done according to `sx-encoding-html-entities-plist'. If this
-list does not contain the entity, it is assumed to be a number
-and converted to a string (with `char-to-string').
-
-Return the decoded string."
- (let* ((plist sx-encoding-html-entities-plist)
- (get-function
- (lambda (s)
- (let ((ss (substring s 1 -1)))
- ;; Handle things like "
- (or (plist-get plist (intern ss))
- ;; Handle things like '
- (char-to-string
- (string-to-number
- ;; Skip the `#'
- (substring ss 1))))))))
- (replace-regexp-in-string "&[^; ]*;" get-function string)))
-
-\f
-;;;; Convenience Functions
-
-(defun sx-encoding-normalize-line-endings (string)
- "Normalize the line endings for STRING.
-The API returns strings that use Windows-style line endings.
-These are largely useless in an Emacs environment. Windows uses
-\"\\r\\n\", Unix uses just \"\\n\". Deleting \"\\r\" is sufficient for
-conversion."
- (delete ?\r string))
-
-(defun sx-encoding-clean-content (string)
- "Clean STRING for display.
-Applies `sx-encoding-normalize-line-endings' and
-`sx-encoding-decode-entities' (in that order) to prepare STRING
-for sane display."
- (sx-encoding-decode-entities
- (sx-encoding-normalize-line-endings
- string)))
-
-(defun sx-encoding-clean-content-deep (data)
- "Clean DATA recursively where necessary.
-
-If DATA is a list or a vector, map this function over DATA and
-return as the the same type of structure.
-
-If DATA is a cons cell (but not a list), use
-`sx-encoding-clean-content-deep' on the `cdr' of DATA.
-
-If DATA is a string, return DATA after applying
-`sx-encoding-clean-content'.
-
-Otherwise, return DATA.
-
-This function is highly specialized for the data structures
-returned by `json-read' via `sx-request-make'. It may fail in
-some cases."
- (if (consp data)
- (if (listp (cdr data))
- (cl-map #'list #'sx-encoding-clean-content-deep data)
- (cons (car data) (sx-encoding-clean-content-deep (cdr data))))
- (cond
- ((stringp data)
- (sx-encoding-clean-content data))
- ((vectorp data)
- (cl-map #'vector #'sx-encoding-clean-content-deep data))
- (t data))))
-
-\f
-;;;; GZIP
-
-(defun sx-encoding-gzipped-p (data)
- "Check for magic bytes in DATA.
-Check if the first two bytes of a string in DATA match the magic
-numbers identifying the gzip file format.
-
-See URL `http://www.gzip.org/zlib/rfc-gzip.html'."
- ;; Credit: http://emacs.stackexchange.com/a/2978
- (let ((unidata (string-as-unibyte data)))
- (when (<= 2 (length unidata))
- (equal (substring unidata 0 2)
- (unibyte-string 31 139)))))
-
-(defun sx-encoding-gzipped-buffer-p (buffer)
- "Check if BUFFER is gzip-compressed.
-See `sx-encoding-gzipped-p'."
- (with-current-buffer buffer
- (sx-encoding-gzipped-p
- (buffer-string))))
-
-(defun sx-encoding-gzipped-file-p (file)
- "Check if the FILE is gzip-compressed.
-See `sx-encoding-gzipped-p'."
- (let ((first-two-bytes (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally file nil 0 2)
- (buffer-string))))
- (sx-encoding-gzipped-p first-two-bytes)))
-
-(provide 'sx-encoding)
-;;; sx-encoding.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-favorites.el --- starred questions -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 provides logic for retrieving and managing a user's
-;; starred questions.
-
-;;; Code:
-
-(require 'sx-method)
-(require 'sx-cache)
-(require 'sx-site)
-(require 'sx-networks)
-(require 'sx-filter)
-
-(defconst sx-favorite-list-filter
- (sx-filter-from-nil
- (question.question_id)))
-
-(defvar sx-favorites--user-favorite-list nil
- "Alist of questions favorited by the user.
-Each element has the form (SITE FAVORITE-LIST). And each element
-in FAVORITE-LIST is the numerical QUESTION_ID.")
-
-(defun sx-favorites--initialize ()
- "Ensure question-favorites cache is available.
-Added as hook to initialization."
- (or (setq sx-favorites--user-favorite-list
- (sx-cache-get 'question-favorites))
- (sx-favorites-update)))
-;; ;; Append to ensure `sx-network--initialize' is run before it.
-;; This is removed for now because it performs a lot of API calls and
-;; was never used.
-;; (add-hook 'sx-init--internal-hook #'sx-favorites--initialize 'append)
-
-(defun sx-favorites--retrieve-favorites (site)
- "Obtain list of starred QUESTION_IDs for SITE."
- (sx-method-call 'me
- :submethod 'favorites
- :site site
- :filter sx-favorite-list-filter
- :auth t))
-
-(defun sx-favorites--update-site-favorites (site)
- "Update list of starred QUESTION_IDs for SITE.
-Writes list to cache QUESTION-FAVORITES."
- (let* ((favs (sx-favorites--retrieve-favorites site))
- (site-cell (assoc site
- sx-favorites--user-favorite-list))
- (fav-cell (mapcar #'cdar favs)))
- (if site-cell
- (setcdr site-cell fav-cell)
- (push (cons site fav-cell) sx-favorites--user-favorite-list))
- (sx-cache-set 'question-favorites sx-favorites--user-favorite-list)))
-
-(defun sx-favorites-update ()
- "Update all sites retrieved from `sx-network--user-sites'."
- (mapc #'sx-favorites--update-site-favorites
- sx-network--user-sites))
-
-(provide 'sx-favorites)
-;;; sx-favorites.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-filter.el --- handles retrieval of filters -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 manages filters and provides an API to compile filters
-;; and retrieve them from the cache. See `sx-filter-compile' and
-;; `sx-filter-get-var', respectively.
-
-;;; Code:
-
-\f
-;;; Dependencies
-
-(require 'sx)
-(require 'sx-cache)
-(require 'sx-request)
-
-\f
-;;; Customizations
-
-(defvar sx--filter-alist
- nil
- "An alist of known filters. See `sx-filter-compile'.
-Structure:
-
- (((INCLUDE EXCLUDE BASE ) . \"compiled filter \")
- ((INCLUDE2 EXCLUDE2 BASE2) . \"compiled filter2\")
- ...)")
-
-\f
-;;; Creation
-(defmacro sx-filter-from-nil (included)
- "Create a filter data structure with INCLUDED fields.
-All wrapper fields are included by default."
- `(quote
- ((,@(sx--tree-expand
- (lambda (path)
- (intern (mapconcat #'symbol-name path ".")))
- included)
- .backoff
- .error_id
- .error_message
- .error_name
- .has_more
- .items
- .page
- .page_size
- .quota_max
- .quota_remaining
- )
- nil nil)))
-
-;;; @TODO allow BASE to be a precompiled filter name
-(defun sx-filter-compile (&optional include exclude base)
- "Compile INCLUDE and EXCLUDE into a filter derived from BASE.
-INCLUDE and EXCLUDE must both be lists; BASE should be a symbol.
-
-Returns the compiled filter as a string."
- (let ((keyword-arguments
- `((include . ,(if include (sx--thing-as-string include)))
- (exclude . ,(if exclude (sx--thing-as-string exclude)))
- (base . ,(if base base)))))
- (let ((result (elt (sx-request-make "filter/create" keyword-arguments) 0)))
- (sx-assoc-let result
- .filter))))
-
-\f
-;;; Storage and Retrieval
-
-(defun sx-filter-get-var (filter-variable)
- "Return the string representation of FILTER-VARIABLE."
- (apply #'sx-filter-get filter-variable))
-
-(defun sx-filter-get (&optional include exclude base)
- "Return the string representation of the given filter.
-
-If the filter data exists in `sx--filter-alist', that value will
-be returned. Otherwise, compile INCLUDE, EXCLUDE, and BASE into
-a filter with `sx-filter-compile' and push the association onto
-`sx--filter-alist'. Re-cache the alist with `sx-cache-set' and
-return the compiled filter."
- (unless sx--filter-alist
- (setq sx--filter-alist (sx-cache-get 'filter)))
- (or (cdr (assoc (list include exclude base) sx--filter-alist))
- (let ((filter (sx-filter-compile include exclude base)))
- (when filter
- (push (cons (list include exclude base) filter) sx--filter-alist)
- (sx-cache-set 'filter sx--filter-alist)
- filter))))
-
-\f
-;;; Browsing filter
-(defconst sx-browse-filter
- (sx-filter-from-nil
- ((question body_markdown
- bounty_amount
- comments
- creation_date
- closed_reason
- closed_date
- closed_details
- answers
- answer_count
- score
- title
- owner
- tags
- last_editor
- last_activity_date
- accepted_answer_id
- link
- upvoted
- downvoted
- question_id
- share_link)
- (user display_name
- link
- accept_rate
- reputation)
- (shallow_user display_name
- link
- accept_rate
- reputation)
- (comment owner
- body_markdown
- body
- link
- edited
- creation_date
- upvoted
- score
- post_type
- post_id
- comment_id)
- (answer answer_id
- creation_date
- last_editor
- last_activity_date
- link
- share_link
- score
- owner
- body_markdown
- upvoted
- downvoted
- comments)))
- "The filter applied when retrieving question data.
-See `sx-question-get-questions' and `sx-question-get-question'.")
-
-(provide 'sx-filter)
-;;; sx-filter.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-inbox.el --- base inbox logic -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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)
-(require 'sx-interaction)
-
-\f
-;;; API
-(defconst 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)
-
-(defface sx-inbox-item-type
- '((t :inherit font-lock-keyword-face)) "")
-
-(defface sx-inbox-item-type-unread
- '((t :inherit font-lock-keyword-face :weight bold)) "")
-
-(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
- :page page
- :filter sx-inbox-filter))
-
-\f
-;;; 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.")
-
-(defconst 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.")
-
-(defconst 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))
-
-\f
-;;; 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)
- ))
-
-\f
-;;; 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:")
- (t ":")))
- 'face (if .is_unread 'sx-inbox-item-type-unread 'sx-inbox-item-type))
- (list
- (concat (sx-time-since .creation_date)
- sx-question-list-ago-string)
- 'face 'sx-question-list-date)
- (list
- (propertize " " 'display
- (concat " " (propertize (or .title "") 'face 'sx-question-list-date) "\n"
- (when .body
- (let ((col fill-column))
- (with-temp-buffer
- (setq fill-column col)
- (insert " " .body)
- (fill-region (point-min) (point-max))
- (buffer-string))))
- "\n" ) 'face (if .is_unread 'bold 'default) ))))))
-
-\f
-;;; Entry commands
-(defvar sx-inbox--buffer nil
- "Buffer being used to display inbox.")
-
-;;;###autoload
-(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))))
-
-;;;###autoload
-(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:
+++ /dev/null
-;;; sx-interaction.el --- voting, commenting, and other interaction -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 holds a series of functions for performing arbitrary
-;; interactions with arbitrary objects (objects here always mean the
-;; alist of a question, answer, or comment). All commands take at
-;; least a DATA argument corresponding to the object which, when
-;; called interactively, is always derived from the context at point
-;; (usually using the `sx--data-here' function).
-;;
-;; Interactions represented here involve voting, commenting, asking,
-;; answering, editing.
-;;
-;; These are commands are meant to be available throughout the
-;; interface. So it didn't make sense to put them in a specific
-;; module. They also rely on a lot of dependencies, so they couldn't
-;; be put in sx.el.
-
-\f
-;;; Code:
-(eval-when-compile
- '(require 'cl-lib))
-
-(require 'sx)
-(require 'sx-question)
-(require 'sx-question-mode)
-(require 'sx-question-list)
-(require 'sx-compose)
-(require 'sx-cache)
-
-\f
-;;; Using data in buffer
-(defun sx--data-here (&optional type noerror)
- "Get the alist regarding object under point of type TYPE.
-Looks at the text property `sx--data-here'. If it's not set, it
-looks at a few other reasonable variables. If those fail too, it
-throws an error.
-
-TYPE is a symbol restricting the type of object desired. Possible
-values are 'question, 'answer, 'comment, or nil (for any type).
-
-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 data
- ;; Is data of the right type?
- (cl-case type
- (question (when .title data))
- (answer (when .answer_id data))
- (comment (when .comment_id data))))))
- ;; The following two only ever return questions.
- (when (or (null type) (eq type 'question))
- ;; @TODO: `sx-question-list-mode' may one day display answers.
- ;; Ideally, it would use the `sx--data-here' (so no special
- ;; handling would be necessary.
- (or (and (derived-mode-p 'sx-question-list-mode)
- (tabulated-list-get-id))
- (and (derived-mode-p 'sx-question-mode)
- sx-question-mode--data)))
- ;; Nothing was found
- (and (null noerror)
- (error "No %s found here" (or type "data")))))
-
-(defun sx--marker-to-data (marker &rest rest)
- "Get the data at MARKER.
-REST is passed to `sx--data-here'."
- (save-excursion
- (goto-char marker)
- (apply #'sx--data-here rest)))
-
-(defun sx--error-if-unread (data)
- "Throw a user-error if DATA is an unread question.
-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)))
- (sx-user-error "Question not yet read. View it before acting on it")
- data))
-
-(defun sx--maybe-update-display (&optional buffer site id)
- "Refresh whatever is displayed in BUFFER or the current buffer.
-If BUFFER is not live, nothing is done.
-
-If SITE is given but ID isn't, only update if BUFFER appears to
-be a question-list displaying SITE.
-If both SITE and ID are given, only update if BUFFER appears to
-be a question matching SITE and ID."
- (setq buffer (or buffer (current-buffer)))
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (cond ((derived-mode-p 'sx-question-list-mode)
- (when (or (not site)
- (and (not id)
- (string= site sx-question-list--site)))
- (sx-question-list-refresh 'redisplay 'no-update)))
- ((derived-mode-p 'sx-question-mode)
- (when (or (not site)
- (and id
- (equal
- (let-alist (sx--data-here 'question)
- (cons .site_par .question_id))
- (cons site id))))
- (sx-question-mode-refresh 'no-update)))))))
-
-(defun sx--copy-data (from to)
- "Copy all fields of alist FORM onto TO.
-Only fields contained in TO are copied."
- (setcar to (car from))
- (setcdr to (cdr from)))
-
-(defun sx-ensure-authentication ()
- "Signal user-error if the user refuses to authenticate.
-Note that `sx-method-call' already does authentication checking.
-This function is meant to be used by commands that don't
-immediately perform method calls, such as `sx-ask'. This way,
-the unauthenticated user will be prompted before going through
-the trouble of composing an entire question."
- (unless (sx-cache-get 'auth)
- (if (y-or-n-p "This command requires authentication, would you like to authenticate? ")
- (sx-authenticate)
- (sx-user-error "This command requires authentication, please run `M-x sx-authenticate' and try again."))))
-
-(defmacro sx--make-update-callback (&rest body)
- "Return a function that runs BODY and updates display.
-`sx--maybe-update-display' is only called if the buffer where the
-function was created still exists. In that case, BODY is also
-run in this buffer."
- (declare (debug t))
- `(let ((buffer (current-buffer)))
- (lambda (result)
- ;; See http://emacs.stackexchange.com/a/10725/50
- (ignore result)
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- ,@body
- (sx--maybe-update-display))
- ,@body))))
-
-(defun sx--copy-update-callback (data)
- "Return a function that overwrites DATA and updates display.
-First, DATA is destructively overwritten with the car of the
-argument passed to the function. Then,
-`sx--maybe-update-display' is called in the original buffer."
- (sx--make-update-callback
- ;; The api returns the new DATA.
- (when result
- (sx--copy-data (elt result 0) data))))
-
-\f
-;;; Visiting
-(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.
-
-If copy-as-kill is non-nil, do not call `browse-url'.
-Instead, copy the link as a new kill with `kill-new'.
-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
- (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)))))
-
-;;;###autoload
-(defun sx-open-link (link &optional _)
- "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))))
- ;; For now, we have no chance of handling chat links, let's just
- ;; send them to the browser.
- (if (string-match (rx string-start "http" (opt "s") "://chat.") link)
- (sx-visit-externally link)
- (let ((data (sx--link-to-data link)))
- (sx-assoc-let data
- (cl-case .type
- (comment
- (sx-display-question
- (sx-question-get-from-comment .site_par .id) 'focus)
- (sx--find-in-buffer 'comment .id))
- (answer
- (sx-display-question
- (sx-question-get-from-answer .site_par .id) 'focus)
- (sx--find-in-buffer 'answer .id))
- (question
- (sx-display-question
- (sx-question-get-question .site_par .id) 'focus))
- (t (error "Don't know how to open this link, please file a bug report: %s"
- link)
- nil))))))
-
-;;;###autoload
-(defun sx-org-get-link ()
- "Add a link to this post to Org's memory."
- (when (memq major-mode '(sx-question-mode sx-question-list-mode))
- (sx-assoc-let (sx--data-here)
- (when .link
- (org-store-link-props :type 'http
- :link .link
- :description .title)))))
-
-(eval-after-load "org"
- '(cond
- ((fboundp 'org-link-set-parameters)
- (org-link-set-parameters
- "sx" :store #'sx-org-get-link))
- ((boundp 'org-store-link-functions)
- (add-to-list 'org-store-link-functions
- #'sx-org-get-link))))
-
-\f
-;;; 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
- ;; This is an attempt to identify when we have the question
- ;; object itself, so there's no need to fetch anything. This
- ;; happens inside the question-list, but it can be easily
- ;; confused with the inbox (whose items have a title, a body, and
- ;; a question_id).
- ((and .title .question_id .score
- (not .item_type) (not .notification_type))
- (sx-display-question data 'focus))
- (.answer_id
- (sx-display-question
- (sx-question-get-from-answer .site_par .answer_id)
- 'focus)
- (if .comment_id
- (sx--find-in-buffer 'comment .comment_id)
- (sx--find-in-buffer 'answer .answer_id)))
- (.question_id
- (sx-display-question
- (sx-question-get-question .site_par .question_id) 'focus)
- (when .comment_id
- (sx--find-in-buffer 'comment .comment_id)))
- ;; `sx-question-get-from-comment' takes 2 api requests, so we
- ;; test it last.
- (.comment_id
- (sx-display-question
- (sx-question-get-from-comment .site_par .comment_id) 'focus)
- (sx--find-in-buffer 'comment .comment_id))
- (.notification_type
- (sx-message "Viewing notifications is not yet implemented"))
- (.item_type (sx-open-link .link)))))
-
-(defun sx-display-question (&optional data focus window)
- "Display question given by DATA, on WINDOW.
-Interactively, display question under point. When FOCUS is
-non-nil (the default when called interactively), also focus the
-relevant window.
-
-If WINDOW nil, the window is decided by
-`sx-question-mode-display-buffer-function'."
- (interactive (list (sx--data-here 'question) t))
- (when (sx-question--mark-read data)
- (sx--maybe-update-display))
- ;; Display the question.
- (setq window
- (get-buffer-window
- (sx-question-mode--display data window)))
- (when focus
- (if (window-live-p window)
- (select-window window)
- (switch-to-buffer sx-question-mode--buffer))))
-
-\f
-;;; Simple interactions
-(defun sx-favorite (data &optional undo)
- "Favorite question given by DATA.
-Interactively, it is guessed from context at point.
-With the UNDO prefix argument, unfavorite the question instead."
- (interactive (list (sx--error-if-unread (sx--data-here 'question))
- current-prefix-arg))
- (sx-method-post-from-data data
- (if undo 'favorite/undo 'favorite)
- :callback (sx--copy-update-callback data)))
-(defalias 'sx-star #'sx-favorite)
-
-(defun sx-accept (data &optional undo)
- "Accept answer given by DATA.
-Interactively, it is guessed from context at point.
-With the UNDO prefix argument, unaccept the question instead."
- (interactive (list (sx--data-here 'answer)
- current-prefix-arg))
- (sx-ensure-authentication)
- ;; When clicking the "Accept" button, first arg is a marker.
- (when (markerp data)
- (setq data (sx--marker-to-data data 'answer)))
- (sx-method-post-from-data data
- (if undo 'accept/undo 'accept)
- :callback (sx--copy-update-callback data)))
-
-\f
-;;; Voting
-(defun sx-upvote (data &optional undo)
- "Upvote an object given by DATA.
-DATA can be a question, answer, or comment. Interactively, it is
-guessed from context at point.
-With UNDO prefix argument, remove upvote instead of applying it."
- (interactive (list (sx--error-if-unread (sx--data-here))
- current-prefix-arg))
- (sx-set-vote data "upvote" (not undo)))
-
-(defun sx-downvote (data &optional undo)
- "Downvote an object given by DATA.
-DATA can be a question or an answer. Interactively, it is guessed
-from context at point.
-With UNDO prefix argument, remove downvote instead of applying it."
- (interactive (list (sx--error-if-unread (sx--data-here))
- current-prefix-arg))
- (sx-set-vote data "downvote" (not undo)))
-
-(defun sx-set-vote (data type status)
- "Set the DATA's vote TYPE to STATUS.
-DATA can be a question, answer, or comment. TYPE can be
-\"upvote\" or \"downvote\". STATUS is a boolean.
-
-Besides posting to the api, DATA is also altered to reflect the
-changes."
- (sx-ensure-authentication)
- (sx-method-post-from-data data
- (concat type (unless status "/undo"))
- :callback (sx--copy-update-callback data)))
-
-\f
-;;; Delete
-(defun sx-delete (data &optional undo)
- "Delete an object given by DATA.
-DATA can be a question, answer, or comment. Interactively, it is
-guessed from context at point.
-With UNDO prefix argument, undelete instead."
- (interactive (list (sx--error-if-unread (sx--data-here))
- current-prefix-arg))
- (sx-ensure-authentication)
- (when (y-or-n-p (format "DELETE this %s? "
- (let-alist data
- (cond (.comment_id "comment")
- (.answer_id "answer")
- (.question_id "question")))))
- (sx-method-post-from-data data
- (if undo 'delete/undo 'delete)
- :callback (sx--make-update-callback
- ;; Indicate to ourselves this has been deleted.
- (setcdr data (cons (car data) (cdr data)))
- (setcar data 'deleted)))))
-
-\f
-;;; Commenting
-(defun sx-comment (data &optional text)
- "Post a comment on DATA given by TEXT.
-DATA can be a question, an answer, or a comment. Interactively,
-it is guessed from context at point.
-If DATA is a comment, the comment is posted as a reply to it.
-
-TEXT is a string. Interactively, it is read from the minibufer."
- (interactive (list (sx--error-if-unread (sx--data-here)) 'query))
- (sx-ensure-authentication)
- ;; When clicking the "Add a Comment" button, first arg is a marker.
- (when (markerp data)
- (setq data (sx--marker-to-data data))
- (setq text 'query))
- (sx-assoc-let data
- ;; Get the comment text
- (when (eq text 'query)
- (setq text (read-string
- "Comment text: "
- (when .comment_id
- (substring-no-properties (sx-user--format "%@ " .owner)))))
- (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"))
- ;; And post
- (let ((result
- (sx-method-call 'posts
- :id (or .post_id .answer_id .question_id)
- :submethod "comments/add"
- :auth 'warn
- :url-method 'post
- :filter sx-browse-filter
- :site .site_par
- :keywords `((body . ,text)))))
- ;; The api returns the new DATA.
- (when result
- (sx--add-comment-to-object
- (sx--ensure-owner-in-object (list (cons 'display_name "(You)")) (elt result 0))
- (if .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'.
-SITE is a string.
-ID is an integer."
- (let ((db (cons sx-question-mode--data
- sx-question-list--dataset)))
- (setq db
- (cond
- ((string= type "question") db)
- ((string= type "answer")
- (apply #'cl-map 'list #'identity
- (mapcar (lambda (x) (cdr (assoc 'answers x))) db)))))
- (car (cl-member-if
- (lambda (x) (sx-assoc-let x
- (and (equal (or .answer_id .question_id) id)
- (equal .site_par site))))
- db))))
-
-(defun sx--add-comment-to-object (comment object)
- "Add COMMENT to OBJECT's `comments' property.
-OBJECT can be a question or an answer."
- (let ((com-cell (assoc 'comments object)))
- (if com-cell
- (progn
- (setcdr
- com-cell
- (append (cdr com-cell)
- (list comment))))
- ;; No previous comments, add it manually.
- (setcdr object (cons (car object) (cdr object)))
- (setcar object `(comments . (,comment)))))
- object)
-
-(defun sx--ensure-owner-in-object (owner object)
- "Add `owner' property with value OWNER to OBJECT."
- (unless (cdr-safe (assq 'owner object))
- (setcdr object (cons (car object) (cdr object)))
- (setcar object `(owner . ,owner)))
- object)
-
-\f
-;;; Editing
-(defun sx-edit (data)
- "Start editing an answer or question given by DATA.
-DATA is an answer or question alist. Interactively, it is guessed
-from context at point."
- (interactive (list (sx--data-here)))
- (sx-ensure-authentication)
- ;; If we ever make an "Edit" button, first arg is a marker.
- (when (markerp data) (setq data (sx--data-here)))
- (sx-assoc-let data
- (let ((buffer (current-buffer)))
- (pop-to-buffer
- (sx-compose-create
- .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)
- (sx--maybe-update-display buffer))))))))
-
-\f
-;;; 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--interactive-site-prompt)))
- (sx-ensure-authentication)
- (let ((buffer (current-buffer)))
- (pop-to-buffer
- (sx-compose-create
- site nil nil
- ;; After send functions
- (list (lambda (_b _res) (sx--maybe-update-display buffer)))))))
-
-\f
-;;; Answering
-(defun sx-answer (data)
- "Start composing an answer for question given by DATA.
-DATA is a question alist. Interactively, it is guessed from
-context at point. "
- ;; If the user tries to answer a question that's not viewed, he
- ;; probaby hit the button by accident.
- (interactive
- (list (sx--error-if-unread (sx--data-here 'question))))
- (sx-ensure-authentication)
- ;; When clicking the "Write an Answer" button, first arg is a marker.
- (when (markerp data) (setq data (sx--data-here)))
- (let ((buffer (current-buffer)))
- (sx-assoc-let data
- (pop-to-buffer
- (sx-compose-create
- .site_par .question_id nil
- ;; After send functions
- (list (lambda (_ res)
- (sx--add-answer-to-question-object (elt res 0) data)
- (sx--maybe-update-display buffer .site_par .question_id))))))))
-
-(defun sx--add-answer-to-question-object (answer question)
- "Add alist ANSWER to alist QUESTION in the right place."
- (let ((cell (assoc 'answers question)))
- (if cell
- (setcdr cell (append (cdr cell) (list answer)))
- ;; No previous comments, add it manually.
- (setcdr question (cons (car question) (cdr question)))
- (setcar question `(answers . (,answer))))
- question))
-
-(provide 'sx-interaction)
-;;; sx-interaction.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-load.el --- load all files of the SX package -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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-switchto
- sx-tab
- sx-tag
- ))
-
-(provide 'sx-load)
-;;; sx-load.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-method.el --- method calls -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 is effectively a common-use wrapper for
-;;; `sx-request-make'. It provides higher-level handling such as
-;;; (authentication, filters, ...) that `sx-request-make' doesn't need
-;;; to handle.
-
-;;; Code:
-(require 'json)
-(require 'url)
-(require 'sx)
-(require 'sx-auth)
-(require 'sx-request)
-(require 'sx-filter)
-
-(cl-defun sx-method-call (method &key id
- submethod
- keywords
- page
- (pagesize 100)
- (filter '(()))
- auth
- (url-method 'get)
- get-all
- (process-function
- #'sx-request-response-get-items)
- callback
- site)
- "Call METHOD with additional keys.
-
-ID is the id associated with a question, answer, comment, post or
-user.
-SUBMETHOD is the additional segments of the method.
-KEYWORDS are the api parameters. Some parameters have their own
-keywords too, for convenience. The KEYWORDS argument overrides
-parameter specific keywords.
-FILTER is the set of filters to control the returned information
-AUTH defines how to act if the method or filters require
-authentication.
-URL-METHOD is either `post' or `get'
-SITE is the api parameter specifying the site.
-GET-ALL is nil or non-nil
-PROCESS-FUNCTION is a response-processing function
-PAGE is the page number which will be requested
-PAGESIZE is the number of items to retrieve per request, default
-100
-CALLBACK is a function to be called if the request succeeds. It
-is given the returned result as an argument.
-
-When AUTH is nil, it is assumed that no auth-requiring filters or
-methods will be used. If they are an error will be signaled. This is
-to ensure awareness of where auth is needed.
-
-When AUTH Is t, filters will automatically use a non-auth subset if
-no `access_token' is available. Methods requiring auth will instead
-use `sx-request-fallback' rather than have a failed API response.
-This is meant to allow for UI pages where portions may require AUTH
-but could still be used without authenticating (i.e a launch/home page).
-
-When AUTH is 'warn, methods will signal a `user-error'. This is meant
-for interactive commands that absolutely require authentication
-\(submitting questions/answers, reading inbox, etc). Filters will
-treat 'warn as equivalent to t.
-
-If GET-ALL is nil, this method will only return the first (or
-specified) page available from this method call. If t, all pages
-will be retrieved (`sx-request-all-stop-when-no-more') .
-Otherwise, it is a function STOP-WHEN for `sx-request-all-items'.
-
-If PROCESS-FUNCTION is nil, only the items of the response will
-be returned (`sx-request-response-get-items'). Otherwise, it is
-a function that processes the entire response (as returned by
-`json-read').
-
-See `sx-request-make' and `sx-request-all-items'.
-
-Return the entire response as a complex alist."
- (declare (indent 1))
- (let ((access-token (sx-cache-get 'auth))
- (method-auth (sx-auth--method-p method submethod))
- (filter-auth (sx-auth--filter-p filter))
- (full-method (concat (format "%s" method)
- (when id
- (format "/%s" id))
- (when submethod
- (format "/%s" submethod))
- ;; On GET methods site is buggy, so we
- ;; need to provide it as a url argument.
- (when (and site (eq url-method 'get))
- (prog1
- (format "?site=%s" site)
- (setq site nil)))))
- (call (if get-all #'sx-request-all-items #'sx-request-make))
- (get-all
- (cond
- ((eq get-all t) #'sx-request-all-stop-when-no-more)
- (t get-all))))
- (lwarn "sx-call-method" :debug "A: %S T: %S. M: %S,%s. F: %S" (equal 'warn auth)
- access-token method-auth full-method filter-auth)
- (unless access-token
- (cond
- ;; 1. Need auth and warn user (interactive use)
- ((and method-auth (equal 'warn auth))
- (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))
- ;; 3. Need auth for type. Use auth-less filter.
- ((and filter-auth auth)
- (setq filter filter-auth))
- ;; 4. Requires auth but no value set for auth
- ((and (or filter-auth method-auth) (not auth))
- (error "This request requires authentication."))))
- ;; Concatenate all parameters now that filter is ensured.
- (push `(filter . ,(sx-filter-get-var filter)) keywords)
- (unless (assq 'page keywords)
- (push `(page . ,page) keywords))
- (unless (assq 'pagesize keywords)
- (push `(pagesize . ,pagesize) keywords))
- (when site
- (push `(site . ,site) keywords))
- (let ((result (funcall call
- full-method
- keywords
- url-method
- (or get-all process-function))))
- (when callback
- (funcall callback result))
- result)))
-
-(defun sx-method-post-from-data (data &rest keys)
- "Make a POST `sx-method-call', deriving parameters from DATA.
-KEYS are [KEYWORD VALUE] pairs passed to `sx-method-call', except
-the following which are decided by this function:
-
- METHOD :site and :id are derived from DATA, where METHOD is
- either \"answers\", \"comments\", or \"questions\".
- :url-method is post.
- :filter is `sx-browse-filter'.
- :auth is warn.
-
-As a special exception, if the car of KEYS is not a keyword, it
-is assumed to be the :submethod argument."
- (declare (indent 1))
- (sx-assoc-let data
- (apply #'sx-method-call
- (cond (.comment_id "comments")
- (.answer_id "answers")
- (.question_id "questions"))
- :id (or .comment_id .answer_id .question_id)
- :auth 'warn
- :url-method 'post
- :filter sx-browse-filter
- :site .site_par
- (if (keywordp (car keys))
- keys
- (cons :submethod keys)))))
-
-(provide 'sx-method)
-;;; sx-method.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-networks.el --- user network information -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 provides logic for retrieving information about the user
-;; across the entire network, e.g. their registered sites.
-
-;;; Code:
-
-(require 'sx-method)
-(require 'sx-cache)
-(require 'sx-site)
-(require 'sx-filter)
-
-(defvar sx-network--user-information nil
- "User information for the various sites.")
-
-(defvar sx-network--user-information-alist nil
- "User information for the various site parameters.")
-
-(defvar sx-network--user-sites nil
- "List of sites where user already has an account.")
-
-(defconst sx-network--user-filter
- (sx-filter-from-nil
- ((badge_count bronze
- silver
- gold)
- (network_user account_id
- answer_count
- badge_counts
- creation_date
- last_access_date
- reputation
- site_name
- site_url
- user_id
- user_type))))
-
-(defun sx-network--get-associated ()
- "Retrieve cached information for network user.
-If cache is not available, retrieve current data."
- (unless (setq sx-network--user-information (sx-cache-get 'network-user))
- (sx-network--update))
- (let ((url-par-alist (mapcar (lambda (x)
- (cons (cdr (assoc 'site_url x))
- (cdr (assoc 'api_site_parameter
- x))))
- (sx-site--get-site-list))))
- (setq sx-network--user-sites nil)
- (setq sx-network--user-information-alist nil)
- (mapc (lambda (nu)
- (let ((parameter (cdr (assoc (cdr (assq 'site_url nu))
- url-par-alist))))
- (push parameter sx-network--user-sites)
- (push (cons parameter nu)
- sx-network--user-information-alist)))
- sx-network--user-information)))
-
-(defun sx-network--update ()
- "Update user information.
-Sets cache and then uses `sx-network--get-associated' to update
-the variables."
- (setq sx-network--user-information
- (sx-method-call 'me
- :submethod 'associated
- :keywords '((types . (main_site meta_site)))
- :filter sx-network--user-filter
- :auth t))
- (sx-cache-set 'network-user sx-network--user-information))
-
-(defun sx-network--initialize ()
- "Ensure network-user cache is available.
-Added as hook to initialization."
- ;; Cache was not retrieved, retrieve it.
- (sx-network--get-associated))
-(add-hook 'sx-init--internal-hook #'sx-network--initialize)
-
-(defun sx-network-user (site)
- "Return an alist containing user information for SITE."
- (cdr (assoc site sx-network--user-information-alist)))
-
-(provide 'sx-networks)
-;;; sx-networks.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-notify.el --- mode-line notifications -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
-
-\f
-;;; Code:
-
-(require 'sx)
-(require 'sx-inbox)
-
-\f
-;;; mode-line notification
-(defconst 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)
-
-\f
-;;; 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))
- (sx-inbox-get)))
- (setq sx-inbox--unread-notifications
- (cl-remove-if
- (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-notifications))
- (sx-inbox-get t))))
-
-(provide 'sx-notify)
-;;; sx-notify.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-(define-package "sx" "20190114.1523" "StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes"
- '((emacs "24.1")
- (cl-lib "0.5")
- (json "1.3")
- (markdown-mode "2.0")
- (let-alist "1.0.3"))
- :keywords
- '("help" "hypermedia" "tools")
- :authors
- '(("Sean Allred" . "codeNOSPAMseanallred.com"))
- :maintainer
- '("Sean Allred" . "codeNOSPAMseanallred.com")
- :url "https://github.com/vermiculus/sx.el/")
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; sx-question-list.el --- major-mode for navigating questions list -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
-
-;; Provides question list logic (as used in e.g. `sx-tab-frontpage').
-
-;;; Code:
-(require 'tabulated-list)
-(require 'cl-lib)
-
-(require 'sx)
-(require 'sx-switchto)
-(require 'sx-time)
-(require 'sx-tag)
-(require 'sx-site)
-(require 'sx-question)
-(require 'sx-question-mode)
-(require 'sx-favorites)
-
-(defgroup sx-question-list nil
- "Customization group for sx-question-list."
- :prefix "sx-question-list-"
- :tag "SX Question List"
- :group 'sx)
-
-(defgroup sx-question-list-faces nil
- "Customization group for the faces of `sx-question-list'."
- :prefix "sx-question-list-"
- :tag "SX Question List Faces"
- :group 'sx-question-list)
-
-\f
-;;; Customization
-(defcustom sx-question-list-height 12
- "Height, in lines, of SX's *question-list* buffer."
- :type 'integer
- :group 'sx-question-list)
-
-(defcustom sx-question-list-excluded-tags nil
- "List of tags (strings) to be excluded from the question list."
- :type '(repeat string)
- :group 'sx-question-list)
-
-(defface sx-question-list-parent
- '((t :inherit default))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-answers
- '((((background light)) :foreground "SeaGreen4"
- :height 1.0 :inherit sx-question-list-parent)
- (((background dark)) :foreground "#D1FA71"
- :height 1.0 :inherit sx-question-list-parent)
- (t :inherit sx-question-list-parent))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-answers-accepted
- '((t :box 1 :inherit sx-question-list-answers))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-score
- '((t :height 1.0 :inherit sx-question-list-parent))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-score-upvoted
- '((t :weight bold
- :inherit sx-question-list-score))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-date
- '((t :inherit font-lock-comment-face))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-read-question
- '((t :height 1.0 :inherit sx-question-list-parent))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-unread-question
- '((t :weight bold :inherit sx-question-list-read-question))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-favorite
- '((t :inherit sx-question-list-score-upvoted))
- ""
- :group 'sx-question-list-faces)
-
-(defface sx-question-list-bounty
- '((t :inherit font-lock-warning-face))
- ""
- :group 'sx-question-list-faces)
-
-\f
-;;; Backend variables
-
-(defvar sx-question-list--site nil
- "Site being displayed in the *question-list* buffer.")
-(make-variable-buffer-local 'sx-question-list--site)
-
-(defvar sx-question-list--order nil
- "Order being displayed in the *question-list* buffer.
-This is also affected by `sx-question-list--descending'.")
-(make-variable-buffer-local 'sx-question-list--order)
-
-(defvar sx-question-list--descending t
- "In which direction should `sx-question-list--order' be sorted.
-If non-nil (default), descending.
-If nil, ascending.")
-(make-variable-buffer-local 'sx-question-list--order)
-
-(defvar sx-question-list--print-function #'sx-question-list--print-info
- "Function to convert a question alist into a tabulated-list entry.
-Used by `sx-question-list-mode', the default value is
-`sx-question-list--print-info'.
-
-If this is set to a different value, it may be necessary to
-change `tabulated-list-format' accordingly.")
-(make-variable-buffer-local 'sx-question-list--print-function)
-
-(defcustom sx-question-list-ago-string " ago"
- "String appended to descriptions of the time since something happened.
-Used in the questions list to indicate a question was updated
-\"4d ago\"."
- :type 'string
- :group 'sx-question-list)
-
-(defun sx-question-list--print-info (question-data)
- "Convert `json-read' QUESTION-DATA into tabulated-list format.
-
-This is the default printer used by `sx-question-list'. It
-assumes QUESTION-DATA is an alist containing (at least) the
-elements:
- `question_id', `site_par', `score', `upvoted', `answer_count',
- `title', `bounty_amount', `bounty_amount', `bounty_amount',
- `last_activity_date', `tags', `owner'.
-
-Also see `sx-question-list-refresh'."
- (sx-assoc-let question-data
- (let ((favorite (if (member .question_id
- (assoc .site_par
- sx-favorites--user-favorite-list))
- (if (char-displayable-p ?\x2b26) "\x2b26" "*") " ")))
- (list
- question-data
- (vector
- (list (int-to-string .score)
- 'face (if .upvoted 'sx-question-list-score-upvoted
- 'sx-question-list-score))
- (list (int-to-string .answer_count)
- 'face (if (sx-question--accepted-answer-id question-data)
- 'sx-question-list-answers-accepted
- 'sx-question-list-answers))
- (concat
- ;; First line
- (propertize
- .title
- 'face (if (sx-question--read-p question-data)
- 'sx-question-list-read-question
- 'sx-question-list-unread-question))
- (propertize " " 'display "\n ")
- ;; Second line
- (propertize favorite 'face 'sx-question-list-favorite)
- (if (and (numberp .bounty_amount) (> .bounty_amount 0))
- (propertize (format "%4d" .bounty_amount)
- 'face 'sx-question-list-bounty)
- " ")
- " "
- (propertize (format "%3s%s"
- (sx-time-since .last_activity_date)
- sx-question-list-ago-string)
- 'face 'sx-question-list-date)
- " "
- ;; @TODO: Make this width customizable. (Or maybe just make
- ;; the whole thing customizable)
- (format "%-40s" (sx-tag--format-tags .tags sx-question-list--site))
- " "
- (sx-user--format "%15d %4r" .owner)
- (propertize " " 'display "\n")))))))
-
-(defvar sx-question-list--pages-so-far 0
- "Number of pages currently being displayed.
-This variable gets reset to 0 before every refresh.
-It should be used by `sx-question-list--next-page-function'.")
-(make-variable-buffer-local 'sx-question-list--pages-so-far)
-
-(defvar sx-question-list--refresh-function nil
- "Function used to refresh the list of questions to be displayed.
-Used by `sx-question-list-mode', this is a function, called with
-no arguments, which returns a list questions to be displayed,
-like the one returned by `sx-question-get-questions'.
-
-If this is not set, the value of `sx-question-list--dataset' is
-used, and the list is simply redisplayed.")
-(make-variable-buffer-local 'sx-question-list--refresh-function)
-
-(defvar sx-question-list--next-page-function nil
- "Function used to fetch the next page of questions to be displayed.
-Used by `sx-question-list-mode'. This is a function, called with
-no arguments, which returns a list questions to be displayed,
-like the one returned by `sx-question-get-questions'.
-
-This function will be called when the user presses \\<sx-question-list-mode-map>\\[sx-question-list-next] at the end
-of the question list. It should either return nil (indicating
-\"no more questions\") or return a list of questions which will
-appended to the currently displayed list.
-
-If this is not set, it's the same as a function which always
-returns nil.")
-(make-variable-buffer-local 'sx-question-list--next-page-function)
-
-(defvar sx-question-list--dataset nil
- "The logical data behind the displayed list of questions.
-This dataset contains even questions that are hidden by the user,
-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)
-
-(defconst sx-question-list--key-definitions
- '(
- ;; S-down and S-up would collide with `windmove'.
- ("<down>" sx-question-list-next)
- ("<up>" sx-question-list-previous)
- ("RET" sx-display "Display")
- ("n" sx-question-list-next "Navigate")
- ("p" sx-question-list-previous "Navigate")
- ("j" sx-question-list-view-next "Navigate")
- ("k" sx-question-list-view-previous "Navigate")
- ("N" sx-question-list-next-far)
- ("P" sx-question-list-previous-far)
- ("J" sx-question-list-next-far)
- ("K" sx-question-list-previous-far)
- ("g" sx-question-list-refresh)
- ("t" sx-tab-switch "tab")
- ("a" sx-ask "ask")
- ("S" sx-search "Search")
- ("s" sx-switchto-map "switch-to")
- ("v" sx-visit-externally "visit")
- ("u" sx-upvote)
- ("d" sx-downvote)
- ("h" sx-question-list-hide "hide")
- ("m" sx-question-list-mark-read "mark-read")
- ("*" sx-favorite)
- )
- "List of key definitions for `sx-question-list-mode'.
-This list must follow the form described in
-`sx--key-definitions-to-header-line'.")
-
-(defconst sx-question-list--header-line
- (sx--key-definitions-to-header-line
- sx-question-list--key-definitions)
- "Header-line used on the question list.")
-
-(defvar sx-question-list--order-methods
- '(("Recent Activity" . activity)
- ("Creation Date" . creation)
- ("Most Voted" . votes)
- ("Score" . votes))
- "Alist of possible values to be passed to the `sort' keyword.")
-(make-variable-buffer-local 'sx-question-list--order-methods)
-
-(defun sx-question-list--interactive-order-prompt (&optional prompt)
- "Interactively prompt for a sorting order.
-PROMPT is displayed to the user. If it is omitted, a default one
-is used."
- (let ((order (sx-completing-read
- (or prompt "Order questions by: ")
- (mapcar #'car sx-question-list--order-methods))))
- (cdr-safe (assoc-string order sx-question-list--order-methods))))
-
-(defun sx-question-list--make-pager (method &optional submethod)
- "Return a function suitable for use as a question list pager.
-Meant to be used as `sx-question-list--next-page-function'."
- (lambda (page)
- (sx-method-call method
- :keywords `((page . ,page)
- ,@(when sx-question-list--order
- `((order . ,(if sx-question-list--descending 'desc 'asc))
- (sort . ,sx-question-list--order))))
- :site sx-question-list--site
- :auth t
- :submethod submethod
- :filter sx-browse-filter)))
-
-\f
-;;; Mode Definition
-
-(defvar sx-question-list--current-tab "Latest"
- ;; @TODO Other values (once we implement them) are "Top Voted",
- ;; "Unanswered", etc.
- "Variable describing current tab being viewed.")
-
-(defconst sx-question-list--mode-line-format
- '(" "
- (:propertize
- (:eval (sx--pretty-site-parameter sx-question-list--site))
- face mode-line-buffer-id)
- " " mode-name ": "
- (:propertize sx-question-list--current-tab
- face mode-line-buffer-id)
- " ["
- "Unread: "
- (:propertize
- (:eval (sx-question-list--unread-count))
- face mode-line-buffer-id)
- ", "
- "Total: "
- (:propertize
- (:eval (int-to-string (length tabulated-list-entries)))
- face mode-line-buffer-id)
- "] ")
- "Mode-line construct to use in question-list buffers.")
-
-(define-derived-mode sx-question-list-mode
- tabulated-list-mode "Question List"
- "Major mode for browsing a list of questions from StackExchange.
-Letters do not insert themselves; instead, they are commands.
-
-The recommended way of using this mode is to activate it and then
-set `sx-question-list--next-page-function'. The return value of
-this function is mapped with `sx-question-list--print-function',
-so you may need to customize the latter if the former does not
-return a list of questions.
-
-The full list of variables which can be set is:
- 1. `sx-question-list--site'
- Set this to the name of the site if that makes sense. If it
- doesn't leave it as nil.
- 2. `sx-question-list--print-function'
- Change this if the data you're dealing with is not strictly a
- list of questions (see the doc for details).
- 3. `sx-question-list--refresh-function'
- This is used to populate the initial list. It is only necessary
- if item 4 does not fit your needs.
- 4. `sx-question-list--next-page-function'
- This is used to fetch further questions. If item 3 is nil, it is
- also used to populate the initial list.
- 5. `sx-question-list--dataset'
- This is only used if both 3 and 4 are nil. It can be used to
- display a static list.
- 6. `sx-question-list--order'
- Set this to the `sort' method that should be used when
- requesting the list, if that makes sense. If it doesn't
- leave it as nil.
-\\<sx-question-list-mode-map>
-If none of these is configured, the behaviour is that of a
-\"Frontpage\", for the site given by
-`sx-question-list--site'.
-
-Item 2 is mandatory, but it also has a sane default which is
-usually enough.
-
-As long as one of 3, 4, or 5 is provided, the other two are
-entirely optional. Populating or refreshing the list of questions
-is done in the following way:
- - Set `sx-question-list--pages-so-far' to 1.
- - Call function 2.
- - If function 2 is not given, call function 3 with argument 1.
- - If 3 is not given use the value of 4.
-
-Adding further questions to the bottom of the list is done by:
- - Increment `sx-question-list--pages-so-far'.
- - Call function 3 with argument `sx-question-list--pages-so-far'.
- - If it returns anything, append to the dataset and refresh the
- display; otherwise, decrement `sx-question-list--pages-so-far'.
-
-If `sx-question-list--site' is given, items 3 and 4 should take it
-into consideration. The same holds for `sx-question-list--order'.
-
-\\{sx-question-list-mode-map}"
- (hl-line-mode 1)
- (setq mode-line-format
- sx-question-list--mode-line-format)
- (setq sx-question-list--pages-so-far 0)
- (setq tabulated-list-format
- [(" V" 3 t :right-align t)
- (" A" 3 t :right-align t)
- ("Title" 0 sx-question-list--date-more-recent-p)])
- (setq tabulated-list-padding 1)
- ;; Sorting by title actually sorts by date. It's what we want, but
- ;; it's not terribly intuitive.
- (setq tabulated-list-sort-key nil)
- (add-hook 'tabulated-list-revert-hook
- #'sx-question-list-refresh nil t)
- ;; This is the default value, but we'll error out if the user has
- ;; set it to nil.
- (setq tabulated-list-use-header-line 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."
- ;; This should be made into a (choice ...) of constants.
- :type 'symbol
- ;; Add a setter to protect the value.
- :group 'sx-question-list)
-
-(sx--create-comparator sx-question-list--date-more-recent-p
- "Non-nil if tabulated-entry A is newer than B."
- #'> (lambda (x)
- (cdr (assq sx-question-list-date-sort-method (car x)))))
-
-\f
-;;; Keybinds
-;; We need this quote+eval combo because `kbd' was a macro in 24.2.
-(mapc (lambda (x) (eval `(define-key sx-question-list-mode-map
- (kbd ,(car x)) #',(cadr x))))
- sx-question-list--key-definitions)
-
-(sx--define-conditional-key sx-question-list-mode-map "O" #'sx-question-list-order-by
- (and (boundp 'sx-question-list--order) sx-question-list--order))
-
-(defun sx-question-list-hide (data)
- "Hide question under point.
-Non-interactively, DATA is a question alist."
- (interactive
- (list (if (derived-mode-p 'sx-question-list-mode)
- (tabulated-list-get-id)
- (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)))
-
-(defun sx-question-list-mark-read (data)
- "Mark as read question under point.
-Non-interactively, DATA is a question alist."
- (interactive
- (list (if (derived-mode-p 'sx-question-list-mode)
- (tabulated-list-get-id)
- (sx-user-error "Not in `sx-question-list-mode'"))))
- (sx-question--mark-read data)
- (sx-question-list-next 1)
- (when (called-interactively-p 'any)
- (sx-question-list-refresh 'redisplay 'noupdate)))
-
-(defun sx-question-list--unread-count ()
- "Number of unread questions in current dataset, as a string."
- (int-to-string
- (cl-count-if-not
- #'sx-question--read-p sx-question-list--dataset)))
-
-(defun sx-question-list--remove-excluded-tags (question-list)
- "Return QUESTION-LIST, with some questions removed.
-Removes all questions hidden by the user, as well as those
-containing a tag in `sx-question-list-excluded-tags'."
- (cl-remove-if (lambda (q)
- (or (sx-question--hidden-p q)
- (cl-intersection (let-alist q .tags)
- sx-question-list-excluded-tags
- :test #'string=)))
- question-list))
-
-(defun sx-question-list-refresh (&optional redisplay no-update)
- "Update the list of questions.
-If REDISPLAY is non-nil (or if interactive), also call `tabulated-list-print'.
-If the prefix argument NO-UPDATE is nil, query StackExchange for
-a new list before redisplaying."
- (interactive "p\nP")
- ;; Reset the mode-line unread count (we rebuild it here).
- (unless no-update
- (setq sx-question-list--pages-so-far 1))
- (let* ((question-list
- (or (and no-update sx-question-list--dataset)
- (and (functionp sx-question-list--refresh-function)
- (funcall sx-question-list--refresh-function))
- (and (functionp sx-question-list--next-page-function)
- (funcall sx-question-list--next-page-function 1))
- sx-question-list--dataset))
- ;; Preserve window positioning.
- (window (get-buffer-window (current-buffer)))
- (old-start (when window (window-start window))))
- ;; The dataset contains everything. Hiding and filtering is done
- ;; on the `tabulated-list-entries' below.
- (setq sx-question-list--dataset question-list)
- ;; Print the result.
- (setq tabulated-list-entries
- (mapcar sx-question-list--print-function
- (sx-question-list--remove-excluded-tags
- sx-question-list--dataset)))
- (when redisplay
- (tabulated-list-print 'remember))
- (when window
- (set-window-start window old-start)))
- (sx-message "Done."))
-
-(defun sx-question-list-view-previous (n)
- "Move cursor up N questions up and display this question.
-Displayed in `sx-question-mode--window', replacing any question
-that may currently be there."
- (interactive "p")
- (sx-question-list-view-next (- n)))
-
-(defun sx-question-list-view-next (n)
- "Move cursor down N questions and display this question.
-Displayed in `sx-question-mode--window', replacing any question
-that may currently be there."
- (interactive "p")
- (sx-question-list-next n)
- (sx-question-mode--display
- (tabulated-list-get-id)
- (sx-question-list--create-question-window)))
-
-(defun sx-question-list--create-question-window ()
- "Create or find a window where a question can be displayed.
-
-If any current window displays a question, that window is
-returned. If none do, a new one is created such that the
-question-list window remains `sx-question-list-height' lines
-high (if possible)."
- (or (sx-question-mode--get-window)
- ;; Create a proper window.
- (let ((window
- (condition-case er
- (split-window (selected-window) sx-question-list-height 'below)
- (error
- ;; If the window is too small to split, use any one.
- (if (string-match
- "Window #<window .*> too small for splitting"
- (car (cdr-safe er)))
- (next-window)
- (error (cdr er)))))))
- ;; Configure the window to be closed on `q'.
- (set-window-prev-buffers window nil)
- (set-window-parameter
- window 'quit-restore
- ;; See (info "(elisp) Window Parameters")
- `(window window ,(selected-window) ,sx-question-mode--buffer))
- window)))
-
-(defvar sx-question-list--last-refresh (current-time)
- "Time of the latest refresh.")
-
-(defun sx-question-list-next (n)
- "Move cursor down N questions.
-This does not update `sx-question-mode--window'."
- (interactive "p")
- (if (and (< n 0) (bobp))
- (when (> (time-to-seconds
- (time-subtract (current-time) sx-question-list--last-refresh))
- 1)
- (sx-question-list-refresh 'redisplay)
- (setq sx-question-list--last-refresh (current-time)))
- (forward-line n)
- ;; If we were trying to move forward, but we hit the end.
- (when (eobp)
- ;; Try to get more questions.
- (sx-question-list-next-page))
- (sx-question-list--ensure-line-good-line-position)))
-
-(defun sx-question-list--ensure-line-good-line-position ()
- "Scroll window such that current line is a good place.
-Check if we're at least 6 lines from the bottom. Scroll up if
-we're not. Do the same for 3 lines from the top."
- ;; At least one entry below us.
- (let ((lines-to-bottom (count-screen-lines (point) (window-end))))
- (unless (>= lines-to-bottom 6)
- (recenter (- 6))))
- ;; At least one entry above us.
- (let ((lines-to-top (count-screen-lines (point) (window-start))))
- (unless (>= lines-to-top 3)
- (recenter 3))))
-
-(defun sx-question-list-next-page ()
- "Fetch and display the next page of questions."
- (interactive)
- ;; Stay at the last line.
- (goto-char (point-max))
- (forward-line -1)
- (when (functionp sx-question-list--next-page-function)
- ;; Try to get more questions
- (let ((list
- (funcall sx-question-list--next-page-function
- (1+ sx-question-list--pages-so-far))))
- (if (null list)
- (message "No further questions.")
- ;; If it worked, increment the variable.
- (cl-incf sx-question-list--pages-so-far)
- ;; And update the dataset.
- ;; @TODO: Check for duplicates.
- (setq sx-question-list--dataset
- (append sx-question-list--dataset list))
- (sx-question-list-refresh 'redisplay 'no-update)
- (forward-line 1)))))
-
-(defun sx-question-list-previous (n)
- "Move cursor up N questions.
-This does not update `sx-question-mode--window'."
- (interactive "p")
- (sx-question-list-next (- n)))
-
-(defcustom sx-question-list-far-step-size 5
- "How many questions `sx-question-list-next-far' skips."
- :type 'integer
- :group 'sx-question-list
- :package-version '(sx-question-list . ""))
-
-(defun sx-question-list-next-far (n)
- "Move cursor up N*`sx-question-list-far-step-size' questions.
-This does not update `sx-question-mode--window'."
- (interactive "p")
- (sx-question-list-next (* n sx-question-list-far-step-size)))
-
-(defun sx-question-list-previous-far (n)
- "Move cursor up N questions.
-This does not update `sx-question-mode--window'."
- (interactive "p")
- (sx-question-list-next-far (- n)))
-
-(defun sx-question-list-switch-site (site)
- "Switch the current site to SITE and display its questions.
-Retrieve completions from `sx-site-get-api-tokens'.
-Sets `sx-question-list--site' and then call
-`sx-question-list-refresh' with `redisplay'."
- (interactive
- (list (sx-completing-read
- "Switch to site: " (sx-site-get-api-tokens)
- (lambda (site) (not (equal site sx-question-list--site)))
- t)))
- (when (and (stringp site) (> (length site) 0))
- (setq sx-question-list--site site)
- (sx-question-list-refresh 'redisplay)))
-
-(defun sx-question-list-order-by (sort &optional ascend)
- "Order questions in the current list by the method SORT.
-Sets `sx-question-list--order' and then calls
-`sx-question-list-refresh' with `redisplay'.
-
-With a prefix argument or a non-nil ASCEND, invert the sorting
-order."
- (interactive
- (list (when sx-question-list--order
- (sx-question-list--interactive-order-prompt))
- current-prefix-arg))
- (unless sx-question-list--order
- (sx-user-error "This list can't be reordered"))
- (when (and sort (symbolp sort))
- (setq sx-question-list--order sort)
- (setq sx-question-list--descending (not ascend))
- (sx-question-list-refresh 'redisplay)))
-
-(provide 'sx-question-list)
-;;; sx-question-list.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-question-mode.el --- major-mode for displaying questions -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 provides a means to print questions with their answers
-;; and all comments. See the customizable group `sx-question-mode'.
-
-\f
-;;; Code:
-(eval-when-compile
- (require 'rx))
-
-(require 'sx)
-(require 'sx-switchto)
-(require 'sx-question)
-(require 'sx-question-print)
-
-\f
-;;; Displaying a question
-(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].
-
-Common values for this variable are `pop-to-buffer' and `switch-to-buffer'."
- :type 'function
- :group 'sx-question-mode)
-
-(defvar sx-question-mode--buffer nil
- "Buffer being used to display questions.")
-
-(defvar sx-question-mode--data nil
- "The data of the question being displayed.")
-(make-variable-buffer-local 'sx-question-mode--data)
-
-(defun sx-question-mode--get-window ()
- "Return a window displaying a question, or nil."
- (get-window-with-predicate
- (lambda (win)
- (with-selected-window win
- (derived-mode-p 'sx-question-mode)))
- 'never))
-
-(defun sx-question-mode--display (data &optional window)
- "Display question given by DATA on WINDOW.
-If WINDOW is nil, use selected one.
-
-Returns the question buffer."
- (with-current-buffer
- (sx-question-mode--display-buffer window)
- (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.
-Also marks the question as read with `sx-question--mark-read'."
- (sx--ensure-site data)
- (sx-question--mark-read data)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (sx-question-mode)
- (sx-question-mode--print-question data)
- (current-buffer)))
-
-(defun sx-question-mode--display-buffer (window)
- "Display and return the buffer used for displaying a question.
-Create `sx-question-mode--buffer' if necessary.
-If WINDOW is given, use that to display the buffer."
- ;; Create the buffer if necessary.
- (unless (buffer-live-p sx-question-mode--buffer)
- (setq sx-question-mode--buffer
- (generate-new-buffer "*sx-question*")))
- (cond
- ;; Window was given, use it.
- ((window-live-p window)
- (set-window-buffer window sx-question-mode--buffer))
- ;; No window, but the buffer is already being displayed somewhere.
- ((get-buffer-window sx-question-mode--buffer 'visible))
- ;; Neither, so we create the window.
- (t (funcall sx-question-mode-display-buffer-function
- sx-question-mode--buffer)))
- sx-question-mode--buffer)
-
-\f
-;;; Movement commands
-;; Sections are headers placed above a question's content or an
-;; answer's content, or above the list of comments. They are
-;; identified with the `sx-question-mode--section' text property.
-;; To move between sections, just search for the property. The value
-;; of the text-property is the depth of the section (1 for contents, 2
-;; for comments).
-(defcustom sx-question-mode-recenter-line 0
- "Screen line to which we recenter after moving between sections.
-This is used as an argument to `recenter', only used if the end
-of section is outside the window.
-
-If nil, no recentering is performed."
- :type '(choice (const :tag "Don't recenter" nil)
- integer)
- :group 'sx-question-mode)
-
-(defun sx-question-mode-next-section (&optional n)
- "Move down to next section (question or answer) of this buffer.
-Prefix argument N moves N sections down or up."
- (interactive "p")
- (let ((count (if n (abs n) 1)))
- (while (> count 0)
- ;; This will either move us to the next section, or move out of
- ;; the current one.
- (unless (sx--goto-property-change 'sx-question-mode--section n)
- ;; If all we did was move out the current one, then move again
- ;; and we're guaranteed to reach the next section.
- (sx--goto-property-change 'sx-question-mode--section n))
- (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))))
- (when (and (overlayp ov) (> (overlay-end ov) (window-end)))
- (recenter sx-question-mode-recenter-line))))
- (sx-message-help-echo)))
-
-(defun sx-question-mode-previous-section (&optional n)
- "Move down to previous section (question or answer) of this buffer.
-Prefix argument moves N sections up or down."
- (interactive "p")
- (sx-question-mode-next-section (- (or n 1))))
-
-(defun sx-question-mode-hide-show-section (&optional _)
- "Hide or show section under point.
-Optional argument _ is for `push-button'."
- (interactive)
- (let ((ov (or (sx-question-mode--section-overlays-at
- (line-end-position))
- (sx-question-mode--section-overlays-at (point)))))
- (unless (overlayp ov)
- (sx-user-error "Not inside a question or answer"))
- (goto-char (overlay-start ov))
- (forward-line 0)
- (overlay-put
- ov 'invisible
- (null (overlay-get ov 'invisible)))))
-
-(defun sx-question-mode--section-overlays-at (pos)
- "Return the highest priority section overlay at POS.
-A section overlay has a `sx-question-mode--section-content'
-property."
- (cdr-safe (get-char-property-and-overlay
- pos 'sx-question-mode--section-content nil)))
-
-\f
-;;; Major-mode constants
-(defconst sx-question-mode--key-definitions
- '(
- ("<down>" sx-question-mode-next-section)
- ("<up>" sx-question-mode-previous-section)
- ("n" sx-question-mode-next-section "Navigate")
- ("p" sx-question-mode-previous-section "Navigate")
- ("g" sx-question-mode-refresh)
- ("v" sx-visit-externally)
- ("u" sx-upvote "upvote")
- ("d" sx-downvote "downvote")
- ("q" quit-window)
- ("SPC" scroll-up-command)
- ("e" sx-edit "edit")
- ("S" sx-search)
- ("*" sx-favorite "star")
- ("K" sx-delete "Delete")
- ("s" sx-switchto-map "switch-to")
- ("O" sx-question-mode-order-by "Order")
- ("c" sx-comment "comment")
- ("a" sx-answer "answer")
- ("TAB" forward-button "Navigate")
- ("<S-iso-lefttab>" backward-button)
- ("<S-tab>" backward-button)
- ("<backtab>" backward-button))
- "List of key definitions for `sx-question-mode'.
-This list must follow the form described in
-`sx--key-definitions-to-header-line'.")
-
-(defconst sx-question-mode--header-line
- (sx--key-definitions-to-header-line
- sx-question-mode--key-definitions)
- "Header-line used on the question list.")
-
-\f
-;;; Major-mode definition
-(defconst sx-question-mode--mode-line
- '(" "
- ;; `sx-question-mode--data' is guaranteed to have through
- ;; `sx--ensure-site' already, so we use `let-alist' instead of
- ;; `sx-assoc-let' to improve performance (since the mode-line is
- ;; updated a lot).
- (:propertize
- (:eval (sx--pretty-site-parameter
- (let-alist sx-question-mode--data .site_par)))
- face mode-line-buffer-id)
- " " mode-name
- " ["
- "Answers: "
- (:propertize
- (:eval (number-to-string (let-alist sx-question-mode--data .answer_count)))
- face mode-line-buffer-id)
- ", "
- "Stars: "
- (:propertize
- (:eval (number-to-string (or (let-alist sx-question-mode--data .favorite_count) 0)))
- face mode-line-buffer-id)
- ", "
- "Views: "
- (:propertize
- (:eval (number-to-string (let-alist sx-question-mode--data .view_count)))
- face mode-line-buffer-id)
- "] ")
- "Mode-line construct to use in `sx-question-mode' buffers.")
-
-(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.
-
-Don't activate this mode directly. Instead, to print a question
-on the current buffer use
-`sx-question-mode--erase-and-print-question'.
-
-\\<sx-question-mode>
-\\{sx-question-mode}"
- (setq header-line-format sx-question-mode--header-line)
- (setq mode-line-format sx-question-mode--mode-line)
- (buffer-disable-undo (current-buffer))
- (set (make-local-variable 'nobreak-char-display) nil)
- ;; Determine how to close this window.
- (unless (window-parameter nil 'quit-restore)
- (set-window-parameter
- nil 'quit-restore
- `(other window nil ,(current-buffer))))
- ;; We call font-lock-region manually. See `sx-question-mode--insert-markdown'.
- (font-lock-mode -1)
- (remove-hook 'after-change-functions 'markdown-check-change-for-wiki-link t)
- (remove-hook 'window-configuration-change-hook
- 'markdown-fontify-buffer-wiki-links t))
-
-;; We need this quote+eval combo because `kbd' was a macro in 24.2.
-(mapc (lambda (x) (eval `(define-key sx-question-mode-map
- (kbd ,(car x)) #',(cadr x))))
- sx-question-mode--key-definitions)
-
-(defun sx-question-mode-refresh (&optional no-update)
- "Refresh currently displayed question.
-Queries the API for any changes to the question or its answers or
-comments, and redisplays it.
-
-With non-nil prefix argument NO-UPDATE, just redisplay, don't
-query the api."
- (interactive "P")
- (sx-question-mode--ensure-mode)
- (let ((point (point))
- (line (count-screen-lines
- (window-start) (point))))
- (sx-question-mode--erase-and-print-question
- (if no-update
- sx-question-mode--data
- (sx-assoc-let sx-question-mode--data
- (sx-question-get-question .site_par .question_id))))
- (goto-char point)
- (when (equal (selected-window)
- (get-buffer-window (current-buffer)))
- (recenter line)))
- (sx-message "Done."))
-
-(defun sx-question-mode--ensure-mode ()
- "Ensures we are in question mode, erroring otherwise."
- (unless (derived-mode-p 'sx-question-mode)
- (error "Not in `sx-question-mode'")))
-
-(defun sx-question-mode-order-by (sort)
- "Order answers in the current buffer by the method SORT.
-Sets `sx-question-list--order' and then calls
-`sx-question-list-refresh' with `redisplay'."
- (interactive
- (list (let ((order (sx-completing-read "Order answers by: "
- (mapcar #'car sx-question-mode--sort-methods))))
- (cdr-safe (assoc-string order sx-question-mode--sort-methods)))))
- (when (and sort (functionp sort))
- (setq sx-question-mode-answer-sort-function sort)
- (sx-question-mode-refresh 'no-update)))
-
-(provide 'sx-question-mode)
-;;; sx-question-mode.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-question-print.el --- populating the question-mode buffer with content -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
-
-\f
-;;; Code:
-(require 'markdown-mode)
-(require 'sx-button)
-(require 'sx)
-(require 'sx-question)
-(require 'sx-babel)
-(require 'sx-user)
-
-(defvar sx-question-mode--data)
-
-(defgroup sx-question-mode nil
- "Customization group for sx-question-mode."
- :prefix "sx-question-mode-"
- :tag "SX Question Mode"
- :group 'sx)
-
-(defgroup sx-question-mode-faces '((sx-user custom-group))
- "Customization group for the faces of `sx-question-mode'.
-Some faces of this mode might be defined in the `sx-user' group."
- :prefix "sx-question-mode-"
- :tag "SX Question Mode Faces"
- :group 'sx-question-mode)
-
-\f
-;;; Faces and Variables
-(defface sx-question-mode-header
- '((t :inherit font-lock-variable-name-face))
- "Face used on the question headers in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-title
- '((t :weight bold :inherit default))
- "Face used on the question title in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-title-comments
- '((t :inherit sx-question-mode-title))
- "Face used on the question title in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defcustom sx-question-mode-header-title "\n"
- "String used before the question title at the header."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-header-author-format "\nAuthor: %d %r"
- "String used to display the question author at the header.
-% constructs have special meaning here. See `sx-user--format'."
- :type 'string
- :group 'sx-question-mode)
-
-(defface sx-question-mode-date
- '((t :inherit font-lock-string-face))
- "Face used on the question date in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defcustom sx-question-mode-header-date "\nPosted on: "
- "String used before the question date at the header."
- :type 'string
- :group 'sx-question-mode)
-
-(defface sx-question-mode-score
- '((t))
- "Face used for the score in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-score-downvoted
- '((t :inherit (font-lock-warning-face sx-question-mode-score)))
- "Face used for downvoted score in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-score-upvoted
- '((t :weight bold
- :inherit (font-lock-function-name-face sx-question-mode-score)))
- "Face used for downvoted score in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defcustom sx-question-mode-header-tags "\nTags: "
- "String used before the question tags at the header."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-header-score "\nScore: "
- "String used before the question score at the header."
- :type 'string
- :group 'sx-question-mode)
-
-(defface sx-question-mode-content-face
- '((((background dark)) :background "#090909")
- (((background light)) :background "#f4f4f4"))
- "Face used on the question body in the question buffer.
-This shouldn't have a foreground, or this will interfere with
-font-locking."
- :group 'sx-question-mode-faces)
-
-(defcustom sx-question-mode-last-edit-format " (edited %s ago by %s)"
- "Format used to describe last edit date in the header.
-First \"%s\" is replaced with the date and the second \"%s\" with
-the editor's name."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-separator
- (concat (propertize (make-string 72 ?\s)
- 'face '(underline sx-question-mode-header))
- "\n")
- "Separator used between header and body."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-answer-title "Answer"
- "Title used at the start of \"Answer\" sections."
- :type 'string
- :group 'sx-question-mode)
-
-(defface sx-question-mode-accepted
- '((((background dark)) :foreground "LimeGreen"
- :height 1.3 :inherit sx-question-mode-title)
- (((background light)) :foreground "ForestGreen"
- :height 1.3 :inherit sx-question-mode-title))
- "Face used for accepted answers in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-closed
- '((t :box 2 :inherit font-lock-warning-face))
- "Face used for closed question header in the question buffer."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-closed-reason
- `((t :box (:line-width 2 :color ,(face-attribute 'sx-question-mode-closed
- :foreground nil t))
- :inherit sx-question-mode-title))
- "Face used for closed question header in the question buffer.
-Aesthetically, it's important that the color of this face's :box
-attribute match the color of the face `sx-question-mode-closed'."
- :group 'sx-question-mode-faces)
-
-(defcustom sx-question-mode-answer-accepted-title "Accepted Answer"
- "Title used at the start of accepted \"Answer\" section."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-comments-title " Comments"
- "Title used at the start of \"Comments\" sections."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-comments-format "%s: %s\n"
- "Format used to display comments.
-First \"%s\" is replaced with user name. Second \"%s\" is
-replaced with the comment."
- :type 'string
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-pretty-links t
- "If non-nil, markdown links are displayed in a compact form."
- :type 'boolean
- :group 'sx-question-mode)
-
-(defconst sx-question-mode--sort-methods
- (let ((methods
- '(("Higher-scoring" . sx-answer-higher-score-p)
- ("Newer" . sx-answer-newer-p)
- ("More active" . sx-answer-more-active-p))))
- (append (mapcar (lambda (x) (cons (concat (car x) " first") (cdr x)))
- methods)
- (mapcar (lambda (x) (cons (concat (car x) " last")
- (sx--invert-predicate (cdr x))))
- methods))))
-
-(defcustom sx-question-mode-answer-sort-function
- #'sx-answer-higher-score-p
- "Function used to sort answers in the question buffer."
- :type
- (cons 'choice
- (mapcar (lambda (x) `(const :tag ,(car x) ,(cdr x)))
- sx-question-mode--sort-methods))
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-use-images (image-type-available-p 'imagemagick)
- "Non-nil if SX should download and display images.
-By default, this is `t' if the `imagemagick' image type is
-available (checked with `image-type-available-p'). If this image
-type is not available, images won't work."
- :type 'boolean
- :group 'sx-question-mode)
-
-(defcustom sx-question-mode-image-max-width 550
- "Maximum width, in pixels, of images in the question buffer."
- :type 'integer
- :group 'sx-question-mode)
-
-(defvar sx-question-mode-after-print-hook nil
- "Hook run after the question has been printed.
-The hook functions are called without arguments with
-the `sx-question-mode' buffer current.
-The special variable `inhibit-read-only' is t while the hook functions run.
-This hook can be used for special formatting of parts of the question buffer.")
-
-\f
-;;; Functions
-;;;; Printing the general structure
-(defconst sx-question-mode--closed-mode-line-string
- '(:propertize " [CLOSED] " face font-lock-warning-face)
- "String indicating closed questions in the mode-line.")
-
-(defun sx-question-mode--print-question (question)
- "Print a buffer describing QUESTION.
-QUESTION must be a data structure returned by `json-read'."
- (when (sx--deleted-p question)
- (sx-user-error "This is a deleted question"))
- (setq sx-question-mode--data question)
- ;; Clear the overlays
- (mapc #'delete-overlay sx--overlays)
- (setq sx--overlays nil)
- ;; Print everything
- (sx-assoc-let question
- (when .closed_reason
- (add-to-list 'mode-line-format sx-question-mode--closed-mode-line-string)
- (sx-question-mode--print-close-reason .closed_reason .closed_date .closed_details))
- (sx-question-mode--print-section question)
- (mapc #'sx-question-mode--print-section
- (cl-remove-if
- #'sx--deleted-p
- (cl-sort (copy-sequence .answers) sx-question-mode-answer-sort-function))))
- (insert "\n\n ")
- (insert-text-button "Write an Answer" :type 'sx-button-answer)
- (run-hooks 'sx-question-mode-after-print-hook)
- ;; Go up
- (goto-char (point-min))
- (sx-question-mode-next-section))
-
-(defun sx-question-mode--print-close-reason (reason date &optional details)
- "Print a header explaining REASON and DATE.
-DATE is an integer.
-
-DETAILS, when given is an alist further describing the close."
- (let ((l (point)))
- (let-alist details
- (insert "\n "
- (propertize (format " %s as %s, %s ago. "
- (if .on_hold "Put on hold" "Closed")
- reason
- (sx-time-since date))
- 'face 'sx-question-mode-closed)
- "\n")
- (when .description
- (insert (replace-regexp-in-string "<[^>]+>" "" .description)
- "\n")))
- (save-excursion
- (goto-char l)
- (search-forward " as " nil 'noerror)
- (setq l (point))
- (skip-chars-forward "^,")
- (let ((ov (make-overlay l (point))))
- (overlay-put ov 'face 'sx-question-mode-closed-reason)
- (push ov sx--overlays)))))
-
-(defun sx-question-mode--maybe-print-accept-button ()
- "Print accept button if you own this question."
- (when (sx-assoc-let sx-question-mode--data
- (ignore-errors
- (= .owner.user_id
- (cdr (assq 'user_id (sx-network-user .site_par))))))
- (insert " ")
- (insert-text-button "Accept" :type 'sx-button-accept)))
-
-(defun sx-question-mode--print-section (data)
- "Print a section corresponding to DATA.
-DATA can represent a question or an answer."
- ;; This makes `data' accessible through `sx--data-here'.
- (sx--wrap-in-overlay
- (list 'sx--data-here data)
- (sx-assoc-let data
- (insert sx-question-mode-header-title)
- (insert-text-button
- ;; Questions have title, Answers don't
- (cond (.title)
- (.is_accepted sx-question-mode-answer-accepted-title)
- (t sx-question-mode-answer-title))
- ;; Section level
- 'sx-question-mode--section (if .title 1 2)
- 'sx-button-copy .share_link
- 'face (if .is_accepted 'sx-question-mode-accepted
- 'sx-question-mode-title)
- :type 'sx-question-mode-title)
- (when (not (or .title .is_accepted))
- (sx-question-mode--maybe-print-accept-button))
-
- ;; Sections can be hidden with overlays
- (sx--wrap-in-overlay
- '(sx-question-mode--section-content t)
-
- ;; Author
- (insert
- (sx-user--format
- (propertize sx-question-mode-header-author-format
- 'face 'sx-question-mode-header)
- .owner))
-
- ;; Date
- (sx-question-mode--insert-header
- sx-question-mode-header-date
- (concat
- (sx-time-seconds-to-date .creation_date)
- (when .last_edit_date
- (format sx-question-mode-last-edit-format
- (sx-time-since .last_edit_date)
- (sx-user--format "%d" .last_editor))))
- 'sx-question-mode-date)
-
- ;; Score and upvoted/downvoted status.
- (sx-question-mode--insert-header
- sx-question-mode-header-score
- (format "%s%s" .score
- (cond (.upvoted "↑") (.downvoted "↓") (t "")))
- (cond (.upvoted 'sx-question-mode-score-upvoted)
- (.downvoted 'sx-question-mode-score-downvoted)
- (t 'sx-question-mode-score)))
-
- ;; Tags
- (when .title
- ;; Tags
- (sx-question-mode--insert-header
- sx-question-mode-header-tags
- (sx-tag--format-tags .tags .site_par)
- nil))
- ;; Body
- (insert "\n" sx-question-mode-separator)
- (sx--wrap-in-overlay
- '(face sx-question-mode-content-face)
- (insert "\n")
- (sx-question-mode--insert-markdown .body_markdown)
- (insert "\n" sx-question-mode-separator))
- ;; Clean up commments manually deleted. The `append' call is
- ;; to ensure `comments' is a list and not a vector.
- (let ((comments (cl-remove-if #'sx--deleted-p .comments)))
- (when comments
- (insert "\n")
- (insert-text-button
- sx-question-mode-comments-title
- 'face 'sx-question-mode-title-comments
- 'sx-question-mode--section 3
- 'sx-button-copy .share_link
- :type 'sx-question-mode-title)
- (sx--wrap-in-overlay
- '(sx-question-mode--section-content t)
- (insert "\n")
- (sx--wrap-in-overlay
- '(face sx-question-mode-content-face)
- ;; Comments have their own `sx--data-here' property (so they can
- ;; be upvoted too).
- (mapc #'sx-question-mode--print-comment comments))
- ;; If there are comments, we want part of this margin to go
- ;; inside them, so the button get's placed beside the
- ;; "Comments" header when you hide them.
- (insert " ")))
- ;; If there are no comments, we have to add this margin here.
- (unless comments
- (insert " ")))
- (insert " ")
- ;; This is where the "add a comment" button is printed.
- (insert-text-button "Add a Comment"
- :type 'sx-button-comment)
- (insert "\n")))))
-
-(defun sx-question-mode--print-comment (comment-data)
- "Print the comment described by alist COMMENT-DATA.
-The comment is indented, filled, and then printed according to
-`sx-question-mode-comments-format'."
- (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 .upvoted "^" "")
- " "))
- (insert
- (format sx-question-mode-comments-format
- (sx-user--format "%d" .owner)
- (substring
- ;; We use temp buffer, so that image overlays don't get
- ;; inserted with the comment.
- (with-temp-buffer
- ;; We fill with three spaces at the start, so the comment is
- ;; slightly indented.
- (sx-question-mode--insert-markdown (concat " " (sx--squash-whitespace .body_markdown)))
- (buffer-string))
- ;; 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.
-ARGS is a list of repeating values -- `header', `value', and
-`face'. `header' is given `sx-question-mode-header' as a face,
-where `value' is given `face' as its face.
-
-\(fn HEADER VALUE FACE [HEADER VALUE FACE] [HEADER VALUE FACE] ...)"
- (while args
- (insert
- (propertize (pop args) 'face 'sx-question-mode-header)
- (let ((header (pop args))
- (face (pop args)))
- (if face (propertize header 'face face)
- header)))))
-
-\f
-;;;; Printing and Font-locking the content (body)
-(defvar sx-question-mode-bullet-appearance
- (propertize (if (char-displayable-p ?•) "•" "*")
- 'face 'markdown-list-face)
- "String to be displayed as the bullet of markdown list items.")
-
-(defconst sx-question-mode--reference-regexp
- (rx line-start (0+ blank) "[%s]:" (0+ blank)
- (group-n 1 (1+ (not (any blank "\n\r")))))
- "Regexp used to find the url of labeled links.
-E.g.:
- [1]: https://...")
-
-(defconst sx-question-mode--link-regexp
- ;; Done at compile time.
- (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:"
- (group-n 5 (+ (not (any " ]")))) "]")
- (and (opt "!") "[" (group-n 1 (1+ (not (any "[]")))) "]"
- (or (and "(" (group-n 2 (1+ (not (any ")")))) ")")
- (and "[" (group-n 3 (1+ (not (any "]")))) "]")))
- (group-n 4 (and "http" (opt "s") "://"
- (>= 2 (any lower numeric "_%"))
- "."
- (>= 2 (any lower numeric "_%"))
- (* (any lower numeric "-/._%&#?=;"))))))
- "Regexp matching markdown links.")
-
-(defun sx-question-mode--process-line-breaks (beg end-marker)
- "Process Markdown line breaks between BEG and END-MARKER.
-Double space at the end of a line becomes an invisible \"\\n\".
-Consecutive blank lines beyond the first are consensed.
-Assumes `marker-insertion-type' of END-MARKER is t."
- (goto-char beg)
- (while (search-forward-regexp
- (rx line-start (* blank) "\n"
- (group-n 1 (+ (any blank "\n"))))
- end-marker 'noerror)
- ;; An invisible newline ensures the previous text
- ;; will get filled as a separate paragraph.
- (replace-match "" nil nil nil 1))
- (goto-char beg)
- (while (search-forward-regexp " $" end-marker 'noerror)
- ;; An invisible newline ensures the previous text
- ;; will get filled as a separate paragraph.
- (replace-match (propertize "\n" 'invisible t))))
-
-(defun sx-question-mode--process-markdown-in-region (beg end)
- "Process Markdown text between BEG and END.
-This does not do Markdown font-locking. Instead, it fills text,
-propertizes links, inserts images, cleans up html comments, and
-font-locks code-blocks according to mode."
- ;; Paragraph filling
- (let ((paragraph-start
- "\f\\|[ \t]*$\\|[ \t]*[*+-] \\|[ \t]*[0-9]+\\.[ \t]\\|[ \t]*: ")
- (paragraph-separate "\\(?:[ \t\f]*\\|.* \\)$")
- (adaptive-fill-first-line-regexp "\\`[ \t]*>[ \t]*?\\'")
- (adaptive-fill-function #'markdown-adaptive-fill-function))
- (save-restriction
- (narrow-to-region beg end)
- ;; html tags can span many paragraphs, so we handle them
- ;; globally first.
- (sx-question-mode--process-html-tags (point-min) (copy-marker (point-max)))
- ;; And now the filling and other handlings.
- (goto-char (point-min))
- (while (null (eobp))
- ;; Don't fill pre blocks.
- (unless (sx-question-mode--dont-fill-here)
- (let ((beg (point)))
- (skip-chars-forward "\r\n[:blank:]")
- (forward-paragraph)
- (let ((end (point-marker)))
- (set-marker-insertion-type end t)
- ;; Turn markdown linebreaks into their final form
- (sx-question-mode--process-line-breaks beg end)
- ;; Compactify links by paragraph, so we don't linkify
- ;; inside code-blocks. This will still linkify inside
- ;; code tags, unfortunately.
- (sx-question-mode--process-links beg end)
- ;; Filling is done after all of the above, since those
- ;; steps change the length of text.
- (fill-region beg end)
- (goto-char end)))))
- (goto-char (point-max)))))
-
-(defconst sx-question-mode-hr
- (propertize (make-string 72 ?―)
- 'face 'markdown-header-rule-face))
-
-(defun sx-question-mode--insert-markdown (text)
- "Return TEXT fontified according to `markdown-mode'."
- (let ((beg (point)))
- (insert
- ;; Font-locking needs to be done in a temp buffer, because it
- ;; affects the entire buffer even if we narrow.
- (with-temp-buffer
- (insert text)
- ;; Trim whitespace
- (goto-char (point-max))
- (skip-chars-backward "\r\n[:blank:]")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (skip-chars-forward "\r\n[:blank:]")
- (forward-line 0)
- (delete-region (point-min) (point))
- ;; Font lock
- (delay-mode-hooks (markdown-mode))
- (font-lock-mode -1)
- (when sx-question-mode-bullet-appearance
- (font-lock-add-keywords ;; Bullet items.
- nil
- `((,(rx line-start (0+ blank) (group-n 1 (any "*+-")) blank)
- 1 '(face nil display ,sx-question-mode-bullet-appearance) prepend))))
- (font-lock-add-keywords ;; Highlight usernames.
- nil
- `((,(rx (or blank line-start)
- (group-n 1 (and "@" (1+ (not space))))
- symbol-end)
- 1 font-lock-builtin-face)
- ("^---+$" 0 '(face nil display ,sx-question-mode-hr))))
- ;; Everything.
- (font-lock-fontify-region (point-min) (point-max))
- (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string))))
- ;; This part can and should be done in place, this way it can
- ;; create overlays.
- (sx-question-mode--process-markdown-in-region beg (point))))
-
-\f
-;;; HTML tags
-(defconst sx-question-mode--html-tag-regexp
- (rx "<" (group-n 1 "%s") (* (not (any ">"))) ">"))
-
-(defface sx-question-mode-sub-sup-tag
- '((t :height 0.7))
- "Face used on <sub> and <sup> tags."
- :group 'sx-question-mode-faces)
-
-(defface sx-question-mode-kbd-tag
- '((((background dark))
- :height 0.9
- :weight semi-bold
- :box (:line-width 3 :style released-button :color "gray30"))
- (((background light))
- :height 0.9
- :weight semi-bold
- :box (:line-width 3 :style released-button :color "gray70")))
- "Face used on <kbd> tags."
- :group 'sx-question-mode-faces)
-
-(defun sx-question-mode--inside-code-p ()
- "Return non-nil if point is inside code.
-This can be inline Markdown code or a Markdown code-block."
- (save-match-data
- (or (markdown-inline-code-at-point-p)
- (save-excursion
- (sx-question-mode--skip-and-fontify-pre 'dont-fontify)))))
-
-(defun sx-question-mode--standalone-tag-p (string)
- "Return non-nil if STRING ends in \"/>\"."
- (string-match "/[[:blank:]]*>\\'" string))
-
-(defun sx-question-mode--next-tag (tag &optional closing end)
- "Move point to the next occurrence of html TAG, or return nil.
-Don't move past END.
-If CLOSING is non-nil, find a closing tag."
- (search-forward-regexp
- (format sx-question-mode--html-tag-regexp
- (if closing
- (concat "/[[:blank:]]*" tag)
- tag))
- end 'noerror))
-
-(defun sx-question-mode--process-html-tags (beg end-marker)
- "Hide all html tags between BEG and END and possibly interpret them.
-END-MARKER should be a marker."
- ;; This code understands nested html, but not if the same tag is
- ;; nested in itself (e.g., <kbd><kbd></kbd></kbd>).
- (set-marker-insertion-type end-marker t)
- (goto-char beg)
- (while (sx-question-mode--next-tag "[[:alpha:]]+" nil end-marker)
- (unless (sx-question-mode--inside-code-p)
- (let ((tag (match-string 1))
- (full (match-string 0))
- (l (match-beginning 0)))
- (replace-match "")
- (pcase tag
- (`"hr"
- (unless (looking-at-p "^") (insert "\n"))
- (insert (propertize "---" 'display sx-question-mode-hr))
- (unless (eq (char-after) ?\n) (insert "\n")))
- (`"br" (insert "\n ")))
- (when (and (not (sx-question-mode--standalone-tag-p full))
- (sx-question-mode--next-tag tag 'closing))
- (let ((r (copy-marker (match-beginning 0))))
- ;; The code tag is special, because it quotes everything inside.
- (if (string= tag "code")
- (progn (replace-match "`")
- (save-excursion (goto-char l) (insert "`")))
- (replace-match "")
- ;; Handle stuff between the two tags.
- (save-match-data (sx-question-mode--process-html-tags l r))
- (pcase tag
- (`"kbd"
- (add-text-properties l r '(face sx-question-mode-kbd-tag))
- (when (looking-at-p
- (format sx-question-mode--html-tag-regexp "kbd"))
- (insert " ")))
- (`"sub"
- (add-text-properties
- l r '(face sx-question-mode-sub-sup-tag display (raise -0.3))))
- (`"sup"
- (add-text-properties
- l r '(face sx-question-mode-sub-sup-tag display (raise +0.3))))))))))))
-
-\f
-;;; Handling links
-(defun sx-question-mode--process-links (beg end-marker)
- "Turn all markdown links between BEG and ENG into compact format.
-Image links are downloaded and displayed, if
-`sx-question-mode-use-images' is non-nil.
-Assumes `marker-insertion-type' of END-MARKER is t."
- (goto-char beg)
- (while (search-forward-regexp sx-question-mode--link-regexp end-marker t)
- ;; Tags are tag-buttons.
- (let ((tag (match-string-no-properties 5)))
- (if (and tag (> (length tag) 0))
- (progn (replace-match "")
- (sx-tag--insert tag))
- ;; Other links are link-buttons.
- (let* ((text (match-string-no-properties 1))
- (url (or (match-string-no-properties 2)
- (match-string-no-properties 4)
- (sx-question-mode-find-reference
- (match-string-no-properties 3)
- text)))
- (full-text (match-string-no-properties 0))
- (image-p (and sx-question-mode-use-images
- (eq ?! (elt full-text 0)))))
- (when (stringp url)
- (replace-match "")
- (sx-question-mode--insert-link
- (cond (image-p (sx-question-mode--create-image url))
- ((and sx-question-mode-pretty-links text))
- ((not text) (sx--shorten-url url))
- (t full-text))
- url)))))))
-
-(defun sx-question-mode--create-image (url)
- "Get and create an image from URL and insert it at POINT.
-The image will take the place of the character at POINT.
-Its size is bound by `sx-question-mode-image-max-width' and
-`window-body-width'."
- (let* ((ov (make-overlay (point) (point) (current-buffer) t nil))
- (callback
- (lambda (data)
- (let* ((image (create-image data 'imagemagick t))
- (image-width (car (image-size image 'pixels))))
- (overlay-put
- ov 'display
- (append image
- (list :width (min sx-question-mode-image-max-width
- (window-body-width nil 'pixel)
- image-width))))))))
- (sx-request-get-url url callback)
- (overlay-put ov 'face 'default)
- ov))
-
-(defun sx-question-mode--insert-link (text url)
- "Return a link propertized version of TEXT-OR-IMAGE.
-URL is used as 'help-echo and 'url properties."
- ;; Try to handle an image/link inside another link.
- (when (eq (char-before) ?\[)
- (insert "a")
- (forward-char -2)
- (if (looking-at sx-question-mode--link-regexp)
- (progn (setq url (or (match-string-no-properties 2)
- (match-string-no-properties 4)
- (sx-question-mode-find-reference
- (match-string-no-properties 3)
- (if (stringp text) text "¶"))
- url))
- (replace-match ""))
- (forward-char 1)
- (delete-char 1)))
- (unless (stringp text)
- ;; Images need to be at the start of a line.
- (unless (looking-at-p "^") (insert "\n"))
- ;; And need an empty line above so they don't get wrapped into
- ;; text when we do filling.
- (insert (propertize "\n" 'display "")))
- ;; Insert the link button.
- (insert-text-button (if (stringp text) text "¶")
- ;; Mouse-over
- 'help-echo
- (format sx-button--link-help-echo
- ;; If TEXT is a shortened url, we don't shorten URL.
- (propertize (if (and (stringp text)
- (string-match "^https?:" text))
- url (sx--shorten-url url))
- 'face 'font-lock-function-name-face))
- ;; For visiting and stuff.
- 'sx-button-url url
- 'sx-button-copy url
- :type 'sx-button-link)
- ;; Images need to be at the end of a line too.
- (unless (stringp text)
- (move-overlay text (1- (point)) (point) (current-buffer))
- (insert (propertize "\n\n" 'display "\n"))))
-
-(defun sx-question-mode-find-reference (id &optional fallback-id)
- "Find url identified by reference ID in current buffer.
-If ID is nil, use FALLBACK-ID instead."
- (save-excursion
- (save-match-data
- (goto-char (point-min))
- (when (search-forward-regexp
- (format sx-question-mode--reference-regexp
- (or id fallback-id))
- nil t)
- (match-string-no-properties 1)))))
-
-\f
-;;; 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 (&optional dont-fontify)
- "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.
-
-If DONT-FONTIFY is non-nil, just return the result and possibly
-move point, don't create the code-block button."
- (let ((beg (line-beginning-position)))
- ;; To identify code-blocks we need to be at start of line.
- (goto-char beg)
- (when (fboundp 'markdown-syntax-propertize)
- (markdown-syntax-propertize (point) (point-max)))
- (when (markdown-match-pre-blocks (line-end-position))
- (unless dont-fontify
- (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."
- (let ((end (save-excursion
- (when (markdown-match-comments (line-end-position))
- (point)))))
- (when end
- (delete-region (point) end)
- (skip-chars-backward "[:blank:]")
- (when (looking-at "^[:blank:]*\n")
- (replace-match ""))
- t)))
-
-(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."
- (forward-line 0)
- (when (looking-at-p (format sx-question-mode--reference-regexp ".+"))
- ;; Returns non-nil
- (forward-paragraph 1)
- t))
-
-(provide 'sx-question-print)
-;;; sx-question-print.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-question.el --- question logic -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 provides an API for retrieving questions and defines
-;; additional logic for marking questions as read or hidden.
-
-\f
-;;; Code:
-
-(require 'sx)
-(require 'sx-filter)
-(require 'sx-method)
-
-(defun sx-question-get-questions (site &optional page keywords submethod)
- "Get SITE questions. Return page PAGE (the first if nil).
-Return a list of question. Each question is an alist of
-properties returned by the API with an added (site SITE)
-property.
-
-KEYWORDS are added to the method call along with PAGE.
-
-`sx-method-call' is used with `sx-browse-filter'."
- (sx-method-call 'questions
- :keywords `((page . ,page) ,@keywords)
- :site site
- :auth t
- :submethod submethod
- :filter sx-browse-filter))
-
-(defun sx-question-get-question (site question-id)
- "Query SITE for a QUESTION-ID and return it.
-If QUESTION-ID doesn't exist on SITE, raise an error."
- (let ((res (sx-method-call 'questions
- :id question-id
- :site site
- :auth t
- :filter sx-browse-filter)))
- (if res (elt res 0)
- (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 res (elt res 0)
- (error "Couldn't find answer %S in %S"
- answer-id site))))
-
-(defun sx-question-get-from-comment (site comment-id)
- "Get question from SITE to which COMMENT-ID belongs.
-If COMMENT-ID doesn't exist on SITE, raise an error.
-
-Note this requires two API requests. One for the comment and one
-for the post."
- (let ((res (sx-method-call 'comments
- :id comment-id
- :site site
- :auth t
- :filter sx-browse-filter)))
- (unless res
- (error "Couldn't find comment %S in %S" comment-id site))
- (sx-assoc-let (elt res 0)
- (funcall (if (string= .post_type "answer")
- #'sx-question-get-from-answer
- #'sx-question-get-question)
- .site_par
- .post_id))))
-
-\f
-;;; Question Properties
-
-;;;; Read/unread
-(defvar sx-question--user-read-list nil
- "Alist of questions read by the user.
-
-Each element has the form
-
- (SITE . QUESTION-LIST)
-
-where each element in QUESTION-LIST has the form
-
- (QUESTION_ID . LAST-VIEWED-DATE).")
-
-(defun sx-question--ensure-read-list (site)
- "Ensure `sx-question--user-read-list' has been read from cache.
-If no cache exists for it, initialize one with SITE."
- (unless sx-question--user-read-list
- (setq sx-question--user-read-list
- (sx-cache-get 'read-questions `'((,site))))))
-
-(defun sx-question--read-p (question)
- "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_par)
- (let ((ql (cdr (assoc .site_par sx-question--user-read-list))))
- (and ql
- (>= (or (cdr (assoc .question_id ql)) 0)
- .last_activity_date)))))
-
-(defmacro sx-sorted-insert-skip-first (newelt list &optional predicate)
- "Inserted NEWELT into LIST sorted by PREDICATE.
-This is designed for the (site id id ...) lists. So the first car
-is intentionally skipped."
- `(let ((tail ,list)
- (x ,newelt))
- (while (and ;; We're not at the end.
- (cdr-safe tail)
- ;; We're not at the right place.
- (funcall (or #',predicate #'<) x (cadr tail)))
- (setq tail (cdr tail)))
- (setcdr tail (cons x (cdr tail)))))
-
-(defun sx-question--mark-read (question)
- "Mark QUESTION as being read until it is updated again.
-Returns nil if question (in its current state) was already marked
-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_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_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.
- (when (or (not (numberp (cdr cell)))
- (> .last_activity_date (cdr cell)))
- (setcdr cell .last_activity_date)))
- ;; Question wasn't present.
- (t
- (sx-sorted-insert-skip-first
- q-cell site-cell
- (lambda (x y) (> (or (car x) -1) (or (car y) -1))))))))
- ;; Save the results.
- ;; @TODO This causes a small lag on `j' and `k' as the list gets
- ;; large. Should we do this on a timer?
- (sx-cache-set 'read-questions sx-question--user-read-list)))
-
-\f
-;;;; Hidden
-(defvar sx-question--user-hidden-list nil
- "Alist of questions hidden by the user.
-
-Each element has the form
-
- (SITE QUESTION_ID QUESTION_ID ...)")
-
-(defun sx-question--ensure-hidden-list (site)
- "Ensure the `sx-question--user-hidden-list' has been read from cache.
-
-If no cache exists for it, initialize one with SITE."
- (unless sx-question--user-hidden-list
- (setq sx-question--user-hidden-list
- (sx-cache-get 'hidden-questions `'((,site))))))
-
-(defun sx-question--hidden-p (question)
- "Non-nil if QUESTION has been hidden."
- (sx-assoc-let question
- (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_par sx-question--user-hidden-list)))
- ;; If question already hidden, do nothing.
- (unless (memq .question_id site-cell)
- (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)))))
-
-\f
-;;;; Other data
-(defun sx-question--accepted-answer-id (question)
- "Return accepted answer in QUESTION or nil if none exists."
- (sx-assoc-let question
- (and (integerp .accepted_answer_id)
- .accepted_answer_id)))
-
-\f
-;;; Question Mode Answer-Sorting Functions
-(sx--create-comparator sx-answer-higher-score-p
- "Return t if answer A has a higher score than answer B."
- #'> (lambda (x) (cdr (assq 'score x))))
-
-(sx--create-comparator sx-answer-newer-p
- "Return t if answer A was posted later than answer B."
- #'> (lambda (x) (cdr (assq 'creation_date x))))
-
-(sx--create-comparator sx-answer-more-active-p
- "Return t if answer A was updated after answer B."
- #'> (lambda (x) (cdr (assq 'last_activity_date x))))
-
-(provide 'sx-question)
-;;; sx-question.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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:
-
-;; API requests are handled on three separate tiers:
-;;
-;; `sx-method-call':
-;;
-;; This is the function that should be used most often, since it
-;; runs necessary checks (authentication) and provides basic
-;; processing of the result for consistency.
-;;
-;; `sx-request-make':
-;;
-;; This is the fundamental function for interacting with the API.
-;; It makes no provisions for 'common' usage, but it does ensure
-;; data is retrieved successfully or an appropriate signal is
-;; thrown.
-;;
-;; `url.el' and `json.el':
-;;
-;; The whole solution is built upon `url-retrieve-synchronously'
-;; for making the request and `json-read-from-string' for parsing
-;; it into a properly symbolic data structure.
-;;
-;; When at all possible, use `sx-method-call'. There are specialized
-;; cases for the use of `sx-request-make' outside of sx-method.el, but
-;; these must be well-documented inline with the code.
-
-;;; Code:
-
-(require 'url)
-(require 'json)
-
-(require 'sx)
-(require 'sx-encoding)
-
-\f
-;;; Variables
-
-(defconst sx-request-api-key
- "0TE6s1tveCpP9K5r5JNDNQ(("
- "When passed, this key provides a higher request quota.")
-
-(defconst sx-request-api-version
- "2.2"
- "The current version of the API.")
-
-(defconst sx-request-api-root
- (format "https://api.stackexchange.com/%s/" sx-request-api-version)
- "The base URL to make requests from.")
-
-(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 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)
-
-(defvar sx-request-remaining-api-requests
- nil
- "The number of API requests remaining.
-Set by `sx-request-make'.")
-
-(defcustom sx-request-remaining-api-requests-message-threshold
- 50
- "Lower bound for printed warnings of API usage limits.
-After `sx-request-remaining-api-requests' drops below this
-number, `sx-request-make' will begin printing out the
-number of requests left every time it finishes a call."
- :group 'sx
- :type 'integer)
-
-(defvar sx-request-all-items-delay 0
- "Delay in seconds with each `sx-request-all-items' iteration.
-It is good to use a reasonable delay to avoid rate-limiting.")
-
-\f
-;;; Making Requests
-(defvar sx--backoff-time nil)
-
-(defun sx-request--wait-while-backoff ()
- (when sx--backoff-time
- (message "Waiting for backoff time: %s" sx--backoff-time)
- (let ((time (cadr (current-time))))
- (if (> (- sx--backoff-time time) 1000)
- ;; If backoff-time is more than 1000 seconds in the future,
- ;; we've likely just looped around the "least significant"
- ;; bits of `current-time'.
- (setq sx--backoff-time time)
- (when (< time sx--backoff-time)
- (message "Backoff detected, waiting %s seconds" (- sx--backoff-time time))
- (sleep-for (+ 0.3 (- sx--backoff-time time))))))))
-
-(defun sx-request-all-items (method &optional args request-method
- stop-when)
- "Call METHOD with ARGS until there are no more items.
-STOP-WHEN is a function that takes the entire response and
-returns non-nil if the process should stop.
-
-All other arguments are identical to `sx-request-make', but
-PROCESS-FUNCTION is given the default value of `identity' (rather
-than `sx-request-response-get-items') to allow STOP-WHEN to
-access the response wrapper."
- ;; @TODO: Refactor. This is the product of a late-night jam
- ;; session... it is not intended to be model code.
- (declare (indent 1))
- (let* ((return-value nil)
- (current-page 1)
- (stop-when (or stop-when #'sx-request-all-stop-when-no-more))
- (process-function #'identity)
- (response
- (sx-request-make method `((page . ,current-page) ,@args)
- request-method process-function)))
- (while (not (funcall stop-when response))
- (let-alist response
- (setq current-page (1+ current-page)
- return-value
- (nconc return-value .items)))
- (sleep-for sx-request-all-items-delay)
- (setq response
- (sx-request-make method `((page . ,current-page) ,@args)
- request-method process-function)))
- (nconc return-value
- (cdr (assoc 'items response)))))
-
-;;; NOTE: Whenever this is arglist changes, `sx-request-fallback' must
-;;; also change.
-(defun sx-request-make (method &optional args request-method process-function)
- "Make a request to the API, executing METHOD with ARGS.
-You should almost certainly be using `sx-method-call' instead of
-this function. REQUEST-METHOD is one of `get' (default) or `post'.
-
-Returns the entire response as processed by PROCESS-FUNCTION.
-This defaults to `sx-request-response-get-items'.
-
-The full set of arguments is built with
-`sx-request--build-keyword-arguments', prepending
-`sx-request-api-key' to receive a higher quota. It will also
-include user's `access_token` if it is avaialble. This call is
-then resolved with `url-retrieve-synchronously' to a temporary
-buffer that it returns. The headers are then stripped using a
-search a blank line (\"\\n\\n\"). The main body of the response
-is then tested with `sx-encoding-gzipped-buffer-p' for
-compression. If it is compressed, `sx-request-unzip-program' is
-called to uncompress the response. The uncompressed respons is
-then read with `json-read-from-string'.
-
-`sx-request-remaining-api-requests' is updated appropriately and
-the main content of the response is returned."
- (declare (indent 1))
- (sx-request--wait-while-backoff)
- (let* ((url-automatic-caching t)
- (url-inhibit-uncompression t)
- (url-request-data (sx-request--build-keyword-arguments args nil))
- (request-url (concat sx-request-api-root method))
- (url-request-method (and request-method (upcase (symbol-name request-method))))
- (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
- ;; 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"
- (let ((json-false nil)
- (json-array-type 'list)
- (json-null :null))
- (json-read-from-string data)))))
- (kill-buffer response-buffer)
- (when (not response)
- (error "Invalid response to the url request: %s" data))
- ;; 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 .backoff
- (message "Backoff received %s" .backoff)
- (setq sx--backoff-time (+ (cadr (current-time)) .backoff)))
- (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))
- (funcall (or process-function #'sx-request-response-get-items)
- response)))))))
-
-(defun sx-request-fallback (_method &optional _args _request-method _process-function)
- "Fallback method when authentication is not available.
-This is for UI generation when the associated API call would
-require authentication.
-
-Currently returns nil."
- '(()))
-
-\f
-;;; Our own generated data
-(defconst sx-request--data-url-format
- "https://raw.githubusercontent.com/vermiculus/sx.el/data/data/%s.el"
- "Url of the \"data\" directory inside the SX `data' branch.")
-
-(defun sx-request--read-buffer-data ()
- "Return the buffer contents after any url headers.
-Error if url headers are absent or if they indicate something
-went wrong."
- (goto-char (point-min))
- (unless (string-match "200" (thing-at-point 'line))
- (error "Page not found."))
- (if (not (search-forward "\n\n" nil t))
- (error "Headers missing; response corrupt")
- (prog1 (buffer-substring (point) (point-max))
- (kill-buffer (current-buffer)))))
-
-(defun sx-request-get-url (url &optional callback)
- "Fetch and return data stored online at URL.
-If CALLBACK is nil, fetching is done synchronously and the
-data (buffer contents sans headers) is returned as a string.
-
-Otherwise CALLBACK must be a function of a single argument. Then
-`url-retrieve' is called asynchronously and CALLBACK is passed
-the retrieved data."
- (let* ((url-automatic-caching t)
- (url-inhibit-uncompression t)
- (url-request-method "GET")
- (url-request-extra-headers
- '(("Content-Type" . "application/x-www-form-urlencoded")))
- (callback-internal
- (when callback
- ;; @TODO: Error check in STATUS.
- (lambda (_status)
- (funcall callback (sx-request--read-buffer-data)))))
- (response-buffer
- (if callback (url-retrieve url callback-internal nil 'silent)
- (url-retrieve-synchronously url))))
- (unless callback
- (if (not response-buffer)
- (error "Something went wrong in `url-retrieve-synchronously'")
- (with-current-buffer response-buffer
- (sx-request--read-buffer-data))))))
-
-(defun sx-request-get-data (file)
- "Fetch and return data stored online by SX.
-FILE is a string or symbol, the name of the file which holds the
-desired data, relative to `sx-request--data-url-format'. For
-instance, `tags/emacs' returns the list of tags on Emacs.SE."
- (read (sx-request-get-url
- (format sx-request--data-url-format file))))
-
-\f
-;;; Support Functions
-(defun sx-request--build-keyword-arguments (alist &optional kv-sep)
- "Format ALIST as a key-value list joined with KV-SEP.
-If authentication is needed, include it also or error if it is
-not available.
-
-Build a \"key=value&key=value&...\"-style string with the elements
-of ALIST. If any value in the alist is nil, that pair will not
-be included in the return. If you wish to pass a notion of
-false, use the symbol `false'. Each element is processed with
-`sx--thing-as-string'."
- ;; Add API key to list of arguments, this allows for increased quota
- ;; automatically.
- (let ((api-key (cons "key" sx-request-api-key))
- (auth (car (sx-cache-get 'auth))))
- (push api-key alist)
- (when auth
- (push auth alist))
- (mapconcat
- (lambda (pair)
- (concat
- (sx--thing-as-string (car pair))
- "="
- (sx--thing-as-string (cdr pair) kv-sep t)))
- (delq nil (mapcar
- (lambda (pair)
- (when (cdr pair) pair))
- alist))
- "&")))
-
-\f
-;;; Response Processors
-(defun sx-request-response-get-items (response)
- "Returns the items from RESPONSE."
- (sx-assoc-let response
- (sx-encoding-clean-content-deep .items)))
-
-(defun sx-request-all-stop-when-no-more (response)
- (or (not response)
- (not (cdr (assoc 'has_more response)))))
-
-(provide 'sx-request)
-;;; sx-request.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-search.el --- searching for questions -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 search 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'.
-
-\f
-;;; Code:
-
-(require 'sx)
-(require 'sx-question-list)
-(require 'sx-question-mode)
-(require 'sx-tag)
-(require 'sx-interaction)
-
-(defvar sx-search--query-history nil
- "Query history for interactive prompts.")
-
-\f
-;;; Basic function
-(defun sx-search-get-questions (site page query
- &optional tags excluded-tags
- &rest 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/advanced
- :keywords `((page . ,page)
- (q . ,query)
- (tagged . ,tags)
- (nottagged . ,excluded-tags)
- ,@keywords)
- :site site
- :auth t
- :filter sx-browse-filter))
-
-(defconst sx-search--order-methods
- (cons '("Relevance" . relevance)
- (default-value 'sx-question-list--order-methods))
- "Alist of possible values to be passed to the `sort' keyword.")
-
-(defcustom sx-search-default-order 'activity
- "Default ordering method used on new searches.
-Possible values are the cdrs of `sx-search--order-methods'."
- :type (cons 'choice
- (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c)))
- (cl-remove-duplicates
- sx-search--order-methods
- :key #'cdr)))
- :group 'sx-question-list)
-
-\f
-;;;###autoload
-(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-tag-multiple-read
- site (concat "Tags" (when query " (optional)"))))
- (unless (or query tags)
- (sx-user-error "Must supply either QUERY or TAGS"))
- (setq excluded-tags
- (sx-tag-multiple-read site "Excluded tags (optional)")))
- (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
- (cons 'order (if sx-question-list--descending 'desc 'asc))
- (cons 'sort sx-question-list--order))))
- (setq sx-question-list--site site)
- (setq sx-question-list--order sx-search-default-order)
- (setq sx-question-list--order-methods sx-search--order-methods)
- (sx-question-list-refresh 'redisplay)
- (switch-to-buffer (current-buffer))))
-
-\f
-;;; Tag
-;;;###autoload
-(defun sx-search-tag-at-point (&optional pos)
- "Follow tag under position POS or point."
- (interactive)
- (let ((tag (save-excursion
- (when pos (goto-char pos))
- (or (get-text-property (point) 'sx-tag)
- (thing-at-point 'symbol))))
- (meta (save-excursion
- (when pos (goto-char pos))
- (get-text-property (point) 'sx-tag-meta)))
- (site (replace-regexp-in-string
- (rx string-start "meta.") ""
- (or sx-question-list--site
- (sx-assoc-let sx-question-mode--data .site_par)))))
- (sx-search (concat (when meta "meta.") site)
- nil tag)))
-
-(provide 'sx-search)
-;;; sx-search.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 provides various pieces of site logic, such as retrieving
-;; the list of sites and the list of a user's favorited questions.
-
-;;; Code:
-
-(require 'sx-method)
-(require 'sx-cache)
-(require 'sx-filter)
-
-(defconst sx-site-browse-filter
- (sx-filter-from-nil
- ((site site_type
- name
- api_site_parameter
- site_url
- related_sites)
- (related_site api_site_parameter
- relation)))
- "Filter for browsing sites.")
-
-(defun sx-site--get-site-list ()
- "Return all sites with `sx-site-browse-filter'."
- (sx-cache-get
- 'site-list
- '(sx-method-call 'sites
- :pagesize 999
- :filter sx-site-browse-filter)))
-
-(defcustom sx-site-favorites
- nil
- "List of favorite sites.
-Each entry is a string corresponding to a single site's
-api_site_parameter."
- :group 'sx)
-
-(defun sx-site-get-api-tokens ()
- "Return a list of all known site tokens."
- (mapcar
- (lambda (site) (cdr (assoc 'api_site_parameter site)))
- (sx-site--get-site-list)))
-
-(provide 'sx-site)
-;;; sx-site.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-switchto.el --- keymap for navigating between pages -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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)
-
-\f
-;;; Keybinds
-;;;###autoload
-(define-prefix-command 'sx-switchto-map)
-
-(mapc (lambda (x) (define-key sx-switchto-map (car x) (cadr x)))
- '(
- ;; These imitate the site's G hotkey.
- ("a" sx-ask)
- ("h" sx-tab-frontpage)
- ("m" sx-tab-meta-or-main)
- ;; This is `n' on the site.
- ("u" sx-tab-unanswered)
- ;; These are extra things we can do, because we're awesome.
- ("f" sx-tab-featured)
- ("i" sx-inbox)
- ("n" sx-tab-newest)
- ("t" sx-tab-switch)
- ("U" sx-tab-unanswered-my-tags)
- ("v" sx-tab-topvoted)
- ("w" sx-tab-week)
- ("*" sx-tab-starred)
- ))
-
-\f
-;;; These are keys which depend on context.
-;;;; For instance, it makes no sense to have `switch-site' bound to a
-;;;; key on a buffer with no `sx-question-list--site' variable.
-(defvar sx-question-list--site)
-(sx--define-conditional-key sx-switchto-map "s" #'sx-question-list-switch-site
- (and (boundp 'sx-question-list--site) sx-question-list--site))
-
-(provide 'sx-switchto)
-;;; sx-switchto.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-tab.el --- functions for viewing different tabs -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 provides a single macro to define 'tabs' to view lists of
-;; questions.
-
-;;; Tabs:
-
-;; - `sx-tab-all-questions' :: All questions.
-;; - `sx-tab-unanswered' :: Unanswered questions.
-;; - `sx-tab-unanswered-my-tags' :: Unanswered questions in your followed tags.
-;; - `sx-tab-featured' :: Featured questions.
-;; - `sx-tab-starred' :: Starred questions.
-
-;;; Code:
-
-(require 'sx)
-(require 'sx-question-list)
-(require 'sx-interaction)
-
-(defvar sx-tab--list nil
- "List of the names of all defined tabs.")
-
-(defun sx-tab-switch (tab)
- "Switch to another question-list TAB."
- (interactive
- (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)))))
-
-(defconst sx-tab--order-methods
- `(,@(default-value 'sx-question-list--order-methods)
- ("Hottest Now" . hot)
- ("Weekly Hottest" . week)
- ("Monthly Hottest" . month))
- "Alist of possible values to be passed to the `sort' keyword.")
-
-(defcustom sx-tab-default-order 'activity
- "Default ordering method used on `sx-tab-questions' and the likes.
-Possible values are the cdrs of `sx-tab--order-methods'."
- :type (cons 'choice
- (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c)))
- (cl-remove-duplicates
- sx-tab--order-methods
- :key #'cdr)))
- :group 'sx-question-list)
-
-(eval-and-compile
- (defconst sx-tab--docstring-format
- "Display a list of %s questions for SITE.
-The variable `sx-tab-default-order' can be used to customize the
-sorting of the resulting list.
-
-NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'.
-If SITE is nil, use `sx-default-site'."
- "Format used on the docstring of `sx-tab-*' commands."))
-
-\f
-;;; The main macro
-(defmacro sx-tab--define (tab pager &optional printer refresher obsolete
- &rest body)
- "Define a StackExchange tab called TAB.
-TAB is a capitalized string.
-
-This defines a command `sx-tab-TAB' for displaying the tab,
-and a variable `sx-tab--TAB-buffer' for holding the bufer.
-
-The arguments PAGER, PRINTER, and REFRESHER, if non-nil, are
-respectively used to set the value of the variables
-`sx-question-list--print-function',
-`sx-question-list--refresh-function', and
-`sx-question-list--next-page-function'.
-
-If OBSOLETE is non-nil, it should be a string indicating the tab
-to use instead of this one.
-
-BODY is evaluated after activating the mode and setting these
-variables, but before refreshing the display."
- (declare (indent 1) (debug t))
- (let* ((name (downcase tab))
- (buffer-variable
- (intern (format "sx-tab--%s-buffer"
- (if obsolete (downcase obsolete)
- name))))
- (function-name
- (intern (concat "sx-tab-" name)))
- (use-instead
- (when obsolete (intern (concat "sx-tab-" (downcase obsolete))))))
- `(progn
- ,(unless obsolete
- `(defvar ,buffer-variable nil
- ,(format "Buffer where the %s questions are displayed." tab)))
- (defun ,function-name (&optional no-update site)
- ,(format sx-tab--docstring-format tab)
- (interactive
- (list current-prefix-arg
- (sx--interactive-site-prompt)))
- (sx-initialize)
- (unless site (setq site sx-default-site))
- ;; Create the buffer
- (unless (buffer-live-p ,buffer-variable)
- (setq ,buffer-variable
- (generate-new-buffer
- ,(format "*question-list: %s *" (or obsolete tab)))))
- ;; Fill the buffer with content.
- (with-current-buffer ,buffer-variable
- (sx-question-list-mode)
- (when ,printer (setq sx-question-list--print-function ,printer))
- (when ,refresher (setq sx-question-list--refresh-function ,refresher))
- (setq sx-question-list--next-page-function ,pager)
- (setq sx-question-list--site site)
- (setq sx-question-list--order 'activity)
- (setq sx-question-list--current-tab ,(or obsolete tab))
- ,@body
- (sx-question-list-refresh 'redisplay no-update))
- (switch-to-buffer ,buffer-variable))
- ,(when obsolete
- `(make-obsolete ',function-name ',use-instead nil))
- ;; Add this tab to the list of existing tabs. So we can prompt
- ;; the user with completion and stuff.
- (unless ,obsolete
- (add-to-list 'sx-tab--list ,tab)))))
-
-\f
-;;; Entry commands
-(sx-tab--define "All-Questions"
- (sx-question-list--make-pager 'questions)
- nil nil nil
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-all-questions "sx-tab" nil t)
-
-(sx-tab--define "Unanswered"
- (sx-question-list--make-pager 'questions 'unanswered))
-;;;###autoload
-(autoload 'sx-tab-unanswered "sx-tab" nil t)
-
-(sx-tab--define "Unanswered-My-Tags"
- (sx-question-list--make-pager 'questions 'unanswered/my-tags))
-;;;###autoload
-(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t)
-
-(sx-tab--define "Featured"
- (sx-question-list--make-pager 'questions 'featured))
-;;;###autoload
-(autoload 'sx-tab-featured "sx-tab" nil t)
-
-(sx-tab--define "Starred"
- (sx-question-list--make-pager 'me 'favorites))
-;;;###autoload
-(autoload 'sx-tab-starred "sx-tab" nil t)
-
-\f
-;;; Inter-modes navigation
-(defun sx-tab-meta-or-main ()
- "Switch to the meta version of a main site, or vice-versa.
-Inside a question, go to the frontpage of the site this question
-belongs to."
- (interactive)
- (if (and (derived-mode-p 'sx-question-list-mode)
- sx-question-list--site)
- (sx-question-list-switch-site
- (if (string-match "\\`meta\\." sx-question-list--site)
- (replace-match "" :fixedcase nil sx-question-list--site)
- (concat "meta." sx-question-list--site)))
- (sx-tab-all-questions nil (sx--site (sx--data-here 'question)))))
-
-\f
-;;; Obsolete tabs
-(defconst sx-tab--basic-question-pager
- (sx-question-list--make-pager 'questions))
-
-(sx-tab--define "FrontPage"
- sx-tab--basic-question-pager
- nil nil "All-Questions"
- (setq sx-question-list--order 'activity)
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-frontpage "sx-tab" nil t)
-
-(sx-tab--define "Newest"
- sx-tab--basic-question-pager
- nil nil "All-Questions"
- (setq sx-question-list--order 'creation)
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-newest "sx-tab" nil t)
-
-(sx-tab--define "TopVoted"
- sx-tab--basic-question-pager
- nil nil "All-Questions"
- (setq sx-question-list--order 'votes)
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-topvoted "sx-tab" nil t)
-
-(sx-tab--define "Hot"
- sx-tab--basic-question-pager
- nil nil "All-Questions"
- (setq sx-question-list--order 'hot)
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-hot "sx-tab" nil t)
-
-(sx-tab--define "Week"
- sx-tab--basic-question-pager
- nil nil "All-Questions"
- (setq sx-question-list--order 'week)
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-week "sx-tab" nil t)
-
-(sx-tab--define "Month"
- sx-tab--basic-question-pager
- nil nil "All-Questions"
- (setq sx-question-list--order 'month)
- (setq sx-question-list--order-methods
- sx-tab--order-methods))
-;;;###autoload
-(autoload 'sx-tab-month "sx-tab" nil t)
-
-(provide 'sx-tab)
-;;; sx-tab.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-tag.el --- retrieving list of tags and handling tags -*- lexical-binding: t; -*-
-
-;; 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:
-
-
-\f
-;;; Code:
-(eval-when-compile
- '(require 'cl-lib))
-
-(require 'sx)
-(require 'sx-method)
-(require 'sx-button)
-
-(defface sx-tag
- '((t :underline nil :inherit font-lock-function-name-face))
- "Face used on the question tags in the question buffer."
- :group 'sx-question-mode-faces
- :group 'sx-question-list-faces)
-
-\f
-;;; Getting the list from a site
-(defconst sx-tag-filter
- (sx-filter-from-nil
- (tag.name
- tag.synonyms))
- "Filter used when querying tags.")
-
-(defun sx-tag--get-all (site &optional no-synonyms)
- "Retrieve all tags for SITE.
-If NO-SYNONYMS is non-nil, don't return synonyms."
- (cl-reduce
- (lambda (so-far tag)
- (let-alist tag
- (cons .name
- (if no-synonyms so-far
- (append .synonyms so-far)))))
- (sx-method-call 'tags
- :get-all t
- :filter sx-tag-filter
- :site site)
- :initial-value nil))
-
-(defun sx-tag--get-some-tags-containing (site string)
- "Return at most 100 tags for SITE containing STRING.
-Returns an array."
- (sx-method-call 'tags
- :auth nil
- :filter sx-tag-filter
- :site site
- :keywords `((inname . ,string))))
-
-(defun sx-tag--get-some-tag-names-containing (site string)
- "Return at most 100 tag names for SITE containing STRING.
-Returns a list."
- (mapcar (lambda (x) (cdr (assoc 'name x)))
- (sx-tag--get-some-tags-containing site string)))
-
-\f
-;;; Getting tags from our data branch. Without the API.
-;;;; @TODO: Once the cache is finished, this can probably be made into
-;;;; a cache variasble with 1 day expiration time.
-(defvar sx-tag-list-alist nil
- "Alist where the tag list for each site is stored.
-Elements are of the type (SITE . TAG-LIST).")
-
-(defun sx-tag-list--get (site)
- "Retrieve all tags from SITE in a single request.
-This does not access the API. Instead, it uses
-`sx-request-get-data', which accesses SX's tag cache."
- (or (cdr (assoc site sx-tag-list-alist))
- (let ((list (sx-request-get-data (concat "tags/" site))))
- (push (cons site list) sx-tag-list-alist)
- list)))
-
-\f
-;;; Check tag validity
-(defun sx-tag--invalid-name-p (site tags)
- "Nil if TAGS exist in SITE.
-TAGS can be a string (the tag name) or a list of strings.
-Fails if TAGS is a list with more than 100 items.
-Return the list of invalid tags in TAGS."
- (and (listp tags) (> (length tags) 100)
- (error "Invalid argument. TAG has more than 100 items"))
- (let ((result
- (mapcar
- (lambda (x) (cdr (assoc 'name x)))
- (sx-method-call 'tags
- :id (sx--thing-as-string tags)
- :submethod 'info
- :auth nil
- :filter sx-tag-filter
- :site site))))
- (cl-remove-if (lambda (x) (member x result)) tags)))
-
-\f
-;;; Prompt the user for tags.
-(defvar sx-tag-history nil
- "Tags history for interactive prompts.")
-
-;;; @TODO: Make it so that hitting BACKSPACE with an empty input
-;;; deletes a previously submitted tag.
-(defun sx-tag-multiple-read (site prompt &optional initial-value)
- "Interactively read a list of tags for SITE.
-Call `sx-completing-read' multiple times, until input is empty,
-with completion options given by the tag list of SITE.
-Return a list of tags given by the user.
-
-PROMPT is a string displayed to the user and should not end with
-a space nor a colon. INITIAL-VALUE is a list of already-selected
-tags."
- (let ((completion-list (sx-tag-list--get site))
- (list (reverse initial-value))
- (empty-string
- (propertize "--\x000-some-string-representing-empty-\x000--"
- 'display "DONE"))
- input)
- (while (not (string=
- empty-string
- (setq input (sx-completing-read
- (concat prompt " ["
- (mapconcat #'identity (reverse list) ",")
- "]: ")
- completion-list
- nil 'require-match nil 'sx-tag-history
- empty-string))))
- (push input list))
- (reverse list)))
-
-\f
-;;; Printing
-(defun sx-tag--format (tag &optional meta)
- "Format and return TAG for display.
-If META is non-nil, the tag is for the meta site."
- (with-temp-buffer
- (sx-tag--insert tag meta)
- (buffer-string)))
-
-(defun sx-tag--insert (tag &optional meta)
- "Insert TAG button.
-If META is non-nil, the tag is for the meta site."
- (insert-text-button (concat "[" tag "]")
- 'sx-button-copy tag
- 'sx-tag tag
- 'sx-tag-meta meta
- :type 'sx-button-tag))
-
-(defun sx-tag--format-tags (tags &optional site)
- "Format and concatenate a sequence of TAGS.
-Returns a string of all tags in TAGS, separated by a space.
-
-SITE is the site to which the tags refer, it is only used to
-decide whether they are main or meta tags. SITE can also be t or
-nil, which respectively indicate meta and main."
- (let ((is-meta
- (if (stringp site) (string-match (rx string-start "meta.") site)
- site)))
- (mapconcat (lambda (tag) (sx-tag--format tag is-meta))
- tags " ")))
-
-(provide 'sx-tag)
-;;; sx-tag.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-time.el --- time -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.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 provides functions for manipulating and displaying
-;; timestamps.
-
-;;; Code:
-
-(require 'time-date)
-
-(defconst sx-time-seconds-to-string
- ;; (LIMIT NAME VALUE)
- ;; We use an entry if the number of seconds in question is less than
- ;; LIMIT, but more than the previous entry's LIMIT.
- ;; For instance, if time is less than 100 sec, we write it in seconds;
- ;; if it is between 100 and 6000 sec, we use minutes.
- ;; VALUE is the actual number of seconds which NAME represents.
- '((100 "s" 1)
- (6000 "m" 60.0)
- (108000 "h" 3600.0)
- (3456000 "d" 86400.0)
- (31622400 "mo" 2628000.0)
- (nil "y" 31557600.0))
- "Auxiliary variable used by `sx-time-since'.")
-
-(defun sx-time-since (time)
- "Convert the time interval since TIME (in seconds) to a short string."
- (let ((delay (- (float-time) time)))
- (concat
- (if (> 0 delay) "-" "")
- (if (= 0 delay) "0s"
- (setq delay (abs delay))
- (let ((sts sx-time-seconds-to-string) here)
- (while (and (car (setq here (pop sts)))
- (<= (car here) delay)))
- (concat (format "%.0f" (/ delay (car (cddr here))))
- (cadr here)))))))
-
-(defcustom sx-time-date-format-year "%H:%M %e %b %Y"
- "Format used for dates on a past year.
-See also `sx-time-date-format'."
- :type 'string
- :group 'sx)
-
-(defcustom sx-time-date-format "%H:%M - %d %b"
- "Format used for dates on this year.
-See also `sx-time-date-format-year'."
- :type 'string
- :group 'sx)
-
-(defun sx-time-seconds-to-date (seconds)
- "Return the integer SECONDS as a date string."
- (let ((time (seconds-to-time seconds)))
- (format-time-string
- (if (string= (format-time-string "%Y")
- (format-time-string "%Y" time))
- sx-time-date-format
- sx-time-date-format-year)
- time)))
-
-(provide 'sx-time)
-;;; sx-time.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx-user.el --- handling and printing user information -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Artur Malabarba
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
-
-\f
-;;; Code:
-(require 'sx)
-(require 'sx-button)
-
-(defgroup sx-user nil
- "How users are displayed by SX."
- :prefix "sx-user-"
- :tag "SX User"
- :group 'sx)
-
-(defcustom sx-question-mode-fallback-user
- '(
- (about_me . "")
- (accept_rate . -1)
- (account_id . -1)
- (age . -1)
- (answer_count . -1)
- (badge_counts . ((bronze . -1) (silver . -1) (gold . -1)))
- (creation_date . -1)
- (display_name . "(unknown user)")
- (down_vote_count . -1)
- (is_employee . nil)
- (last_access_date . -1)
- (last_modified_date . -1)
- (link . "")
- (location . "")
- (profile_image . ":(")
- (question_count . -1)
- (reputation . -1)
- (reputation_change_day . -1)
- (reputation_change_month . -1)
- (reputation_change_quarter . -1)
- (reputation_change_week . -1)
- (reputation_change_year . -1)
- (timed_penalty_date . -1)
- (up_vote_count . -1)
- (user_id . -1)
- (user_type . does_not_exist)
- (view_count . -1)
- (website_url . "")
- )
- "The structure used to represent missing user information.
-NOOTE: SX relies on this variable containing all necessary user
-information. You may edit any of its fields, but you'll run into
-errors if you remove them."
- :type '(alist :options ((about_me string)
- (accept_rate integer)
- (account_id integer)
- (age integer)
- (answer_count integer)
- (badge_counts alist)
- (creation_date integer)
- (display_name string)
- (down_vote_count integer)
- (is_employee boolean)
- (last_access_date integer)
- (last_modified_date integer)
- (link string)
- (location string)
- (profile_image string)
- (question_count integer)
- (reputation integer)
- (reputation_change_day integer)
- (reputation_change_month integer)
- (reputation_change_quarter integer)
- (reputation_change_week integer)
- (reputation_change_year integer)
- (timed_penalty_date integer)
- (up_vote_count integer)
- (user_id integer)
- (user_type symbol)
- (view_count integer)
- (website_url string)))
- :group 'sx-user)
-
-\f
-;;; Text properties
-(defface sx-user-name
- '((t :inherit font-lock-builtin-face))
- "Face used for user names."
- :group 'sx-user)
-
-(defface sx-user-reputation
- '((t :inherit font-lock-comment-face))
- "Face used for user reputations."
- :group 'sx-user)
-
-(defface sx-user-accept-rate
- '((t))
- "Face used for user accept-rates."
- :group 'sx-user)
-
-(defvar sx-user--format-property-alist
- `((?d button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
- (?n button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
- (?@ button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
- (?r face sx-user-reputation)
- (?a face sx-user-accept-rate))
- "Alist relating % constructs with text properties.
-See `sx-user--format'.")
-
-\f
-;;; Formatting function
-(defun sx-user--format (format-string user)
- "Use FORMAT-STRING to format the user object USER.
-The value is a copy of FORMAT-STRING, but with certain constructs
-replaced by text that describes the specified USER:
-
-%d is the display name.
-%@ is the display name in a format suitable for @mentions.
-%l is the link to the profile.
-%r is the reputation.
-%a is the accept rate.
-
-The string replaced in each of these construct is also given the
-text-properties specified in `sx-user--format-property-alist'.
-Specially, %d and %@ are turned into buttons with the
-`sx-button-user' category."
- (sx-assoc-let (append user sx-question-mode-fallback-user)
- (let* ((text (sx-format-replacements
- format-string
- `((?d . ,\.display_name)
- (?n . ,\.display_name)
- (?l . ,\.link)
- (?r . ,\.reputation)
- (?a . ,\.accept_rate)
- (?@ . ,(when (string-match "%@" format-string)
- (sx-user--@name .display_name)))
- )
- sx-user--format-property-alist)))
- (if (< 0 (string-width .link))
- (propertize text
- ;; For visiting and stuff.
- 'sx-button-url .link
- 'sx-button-copy .link)
- text))))
-
-\f
-;;; @name conversion
-(defconst sx-user--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 (display-name)
- "Convert DISPLAY-NAME into an @mention.
-In order to correctly @mention the user, all whitespace is
-removed from DISPLAY-NAME and a series of unicode conversions are
-performed before it is returned.
-See `sx-user--ascii-replacement-list'.
-
-If all you need is the @name, this is very slightly faster than
-using `sx-user--format', but it doesn't do any sanity checking."
- (concat "@" (sx--recursive-replace
- sx-user--ascii-replacement-list display-name)))
-
-(provide 'sx-user)
-;;; sx-user.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
+++ /dev/null
-;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2018 Sean Allred
-
-;; Author: Sean Allred <codeNOSPAMseanallred.com>
-;; URL: https://github.com/vermiculus/sx.el/
-;; Version: 0.3
-;; Keywords: help, hypermedia, tools
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file defines basic commands used by all other parts of SX.
-
-;;; Code:
-(require 'tabulated-list)
-
-(defconst sx-version "0.3" "Version of the `sx' package.")
-
-(defgroup sx nil
- "Customization group for the `sx' package."
- :prefix "sx-"
- :tag "SX"
- :group 'applications)
-
-\f
-;;; User commands
-(defun sx-version ()
- "Print and return the version of the `sx' package."
- (interactive)
- (message "%s: %s" 'sx-version sx-version)
- sx-version)
-
-;;;###autoload
-(defun sx-bug-report ()
- "File a bug report about the `sx' package."
- (interactive)
- (if (featurep 'magithub)
- (magithub-issue-new (magithub-repo "vermiculus/sx.el"))
- (browse-url "https://github.com/vermiculus/sx.el/issues/new")))
-
-\f
-;;; 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_par (sx--site link)))))
- ;; Try to strip a question or answer ID
- (when (cond ;; Comment
- ((or ;; If there's a #commentNUMBER_NUMBER at the end, we
- ;; know it's a comment with that ID.
- (string-match (rx "#comment" (group-n 1 (+ digit))
- "_" (+ digit) string-end)
- link)
- ;; From inbox items
- (string-match (rx "/posts/comments/"
- ;; Comment ID
- (group-n 1 (+ digit))
- ;; Optional stuff at the end
- (or (and (any "?#") (* any)) "")
- string-end)
- link))
- (push '(type . comment) result))
- ;; Answer
- ((or ;; If there's a #NUMBER at the end, we know it's an
- ;; answer with that ID.
- (string-match (rx "#" (group-n 1 (+ digit)) string-end) link)
- ;; From 'Share' button
- (string-match (rx "/a/"
- ;; Answer ID
- (group-n 1 (+ digit)) "/"
- ;; User ID
- (+ digit)
- ;; Garbage at the end
- (optional (and (any "?#") (* any)))
- string-end)
- link)
- ;; From URL
- (string-match (rx "/questions/" (+ digit) "/"
- ;; Question title
- (+ (not (any "/"))) "/"
- ;; Answer ID. If this is absent, we match on
- ;; Question clause below.
- (group-n 1 (+ digit))
- (opt "/")
- ;; Garbage at the end
- (optional (and (any "?#") (* any)))
- string-end)
- link))
- (push '(type . answer) result))
- ;; Question
- ((or ;; From 'Share' button
- (string-match (rx "/q/"
- ;; Question ID
- (group-n 1 (+ digit))
- ;; User ID
- (optional "/" (+ digit))
- ;; Garbage at the end
- (optional (and (any "?#") (* any)))
- string-end)
- link)
- ;; From URL
- (string-match (rx "/questions/"
- ;; Question ID
- (group-n 1 (+ digit)) "/")
- link))
- (push '(type . question) result)))
- (push (cons 'id (string-to-number (match-string-no-properties 1 link)))
- result))
- result))
-
-(defun sx--tree-paths (tree)
- "Return a list of all paths in TREE.
-Adapted from http://stackoverflow.com/q/3019250."
- (if (atom tree)
- (list (list tree))
- (apply #'append
- (mapcar (lambda (node)
- (mapcar (lambda (path)
- (cons (car tree) path))
- (sx--tree-paths node)))
- (cdr tree)))))
-
-(defun sx--tree-expand (path-func tree)
- "Apply PATH-FUNC to every path in TREE.
-Return the result. See `sx--tree-paths'."
- (mapcar path-func
- (apply #'append
- (mapcar #'sx--tree-paths
- tree))))
-
-(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))))
-
-(defun sx--pretty-site-parameter (site)
- "Returned a pretty and capitalized version of string SITE."
- (mapconcat #'capitalize
- (split-string site "\\.")
- " "))
-
-\f
-;;; Utility Functions
-(defun sx--split-string (string &optional separators)
- "Split STRING into substrings bounded by matches for SEPARATORS."
- (mapcar (lambda (s) (replace-regexp-in-string "\\` +\\| +\\'" "" s))
- (split-string string separators 'omit-nulls)))
-
-(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-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'."
- (message "[sx] %s" (apply #'format format-string args)))
-
-(defun sx-message-help-echo ()
- "If there's a 'help-echo property under point, message it."
- (let ((echo (get-text-property (point) 'help-echo)))
- (when echo (message "%s" echo))))
-
-(defun sx--thing-as-string (thing &optional sequence-sep url-hexify)
- "Return a string representation of THING.
-If THING is already a string, just return it.
-
-Optional argument SEQUENCE-SEP is the separator applied between
-elements of a sequence. If SEQUENCE-SEP is a list, use the first
-element for the top level joining, the second for the next level,
-etc. \";\" is used as a default.
-
-If optional argument URL-HEXIFY is non-nil, this function behaves
-as `url-hexify-string'; this option is only effective on strings
-and sequences of strings."
- (let ((process (if url-hexify #'url-hexify-string #'identity))
- (first-f (if (listp sequence-sep) #'car #'identity))
- (rest-f (if (listp sequence-sep) #'cdr #'identity)))
- (cond
- ((stringp thing) (funcall process thing))
- ((symbolp thing) (funcall process (symbol-name thing)))
- ((numberp thing) (number-to-string thing))
- ((sequencep thing)
- (mapconcat (lambda (thing)
- (sx--thing-as-string
- thing (funcall rest-f sequence-sep) url-hexify))
- thing (if sequence-sep
- (funcall first-f sequence-sep)
- ";"))))))
-
-(defun sx--shorten-url (url)
- "Shorten URL hiding anything other than the domain.
-Paths after the domain are replaced with \"...\".
-Anything before the (sub)domain is removed."
- (replace-regexp-in-string
- ;; Remove anything after domain.
- (rx (group-n 1 (and (1+ (any word ".")) "/"))
- (1+ anything) string-end)
- (eval-when-compile
- (concat "\\1" (if (char-displayable-p ?…) "…" "...")))
- ;; Remove anything before subdomain.
- (replace-regexp-in-string
- (rx string-start (or (and (0+ word) (optional ":") "//")))
- "" url)))
-
-(defmacro sx--define-conditional-key (keymap key def &rest body)
- "In KEYMAP, define key sequence KEY as DEF conditionally.
-This is like `define-key', except the definition \"disappears\"
-whenever BODY evaluates to nil."
- (declare (indent 3)
- (debug (form form form &rest sexp)))
- `(define-key ,keymap ,key
- '(menu-item
- ,(format "maybe-%s" (or (car (cdr-safe def)) def)) ignore
- :filter (lambda (&optional _)
- (when (progn ,@body) ,def)))))
-
-(defun sx--goto-property-change (prop &optional direction)
- "Move forward to the next change of text-property PROP.
-Return the new value of PROP at point.
-
-If DIRECTION is negative, move backwards instead."
- (let ((func (if (and (numberp direction)
- (< direction 0))
- #'previous-single-property-change
- #'next-single-property-change))
- (limit (if (and (numberp direction)
- (< direction 0))
- (point-min) (point-max))))
- (goto-char (funcall func (point) prop nil limit))
- (get-text-property (point) prop)))
-
-(defun sx--find-in-buffer (type id)
- "Move point to an object of TYPE and ID.
-That is, move forward from beginning of buffer until
-`sx--data-here' is an object of type TYPE with the respective id
-ID. If point is left at the of a line, move over the line break.
-
-TYPE is either question, answer, or comment.
-ID is an integer."
- (let* ((id-symbol (cl-case type
- (answer 'answer_id)
- (comment 'comment_id)
- (question 'question_id)))
- (pos
- (save-excursion
- (goto-char (point-min))
- (while (not (or (eobp)
- (let ((data (sx--data-here type t)))
- (and data
- (= id (or (cdr (assq id-symbol data))))))))
- (forward-char 1))
- (point))))
- (if (equal pos (point-max))
- (sx-message "Can't find the specified %s" type)
- (goto-char pos)
- (when (looking-at-p "$")
- (forward-char 1)))))
-
-(defmacro sx--create-comparator (name doc compare-func get-func)
- "Define a new comparator called NAME with documentation DOC.
-COMPARE-FUNC is a function that takes the return value of
-GET-FUNC and performs the actual comparison."
- (declare (indent 1) (doc-string 2))
- `(defun ,name (a b)
- ,doc
- (funcall ,compare-func
- (funcall ,get-func a)
- (funcall ,get-func b))))
-
-(defun sx--squash-whitespace (string)
- "Return STRING with consecutive whitespace squashed together."
- (replace-regexp-in-string "[ \r\n]+" " " string))
-
-(defun sx--deleted-p (data)
- "Return non-nil if DATA represents a deleted object."
- (eq (car data) 'deleted))
-
-(defun sx--invert-predicate (predicate)
- "Return PREDICATE function with arguments inverted.
-For instance (sx--invert-predicate #'<) is the same as #'>.
-Note this is not the same as negating PREDICATE."
- (lambda (&rest args) (apply predicate (reverse args))))
-
-\f
-;;; 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
- "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)
-
-(defmacro sx--wrap-in-overlay (properties &rest body)
- "Start a scope with overlay PROPERTIES and execute BODY.
-Overlay is pushed on the buffer-local variable `sx--overlays' and
-given PROPERTIES.
-
-Return the result of BODY."
- (declare (indent 1)
- (debug t))
- `(let ((p (point-marker))
- (result (progn ,@body))
- ;; The first overlay is the shallowest. Any overlays created
- ;; while the first one is still being created go deeper and
- ;; deeper.
- (sx--overlay-printing-depth (1+ sx--overlay-printing-depth)))
- (let ((ov (make-overlay p (point)))
- (props ,properties))
- (while props
- (overlay-put ov (pop props) (pop props)))
- ;; Let's multiply by 10 just in case we ever want to put
- ;; something in the middle.
- (overlay-put ov 'priority (* 10 sx--overlay-printing-depth))
- (push ov sx--overlays))
- result))
-
-(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))
-
-(defun sx-format-replacements (format alist &optional property-alist)
- "Use FORMAT-STRING to format the values in ALIST.
-ALIST is a list with elements of the form (CHAR . STRING).
-The value is a copy of FORMAT-STRING, but with certain constructs
-replaced by text as given by ALIST.
-
-The construct is a `%' character followed by any other character.
-The replacement is the STRING corresponding to CHAR in ALIST. In
-addition, if CHAR is also the car of an element in
-PROPERTY-ALIST, the cdr of that element should be a list of text
-properties which will be applied on the replacement.
-
-The %% construct is special, it is replaced with a single %, even
-if ALIST contains a different string at the ?% entry."
- (let ((alist (cons '(?% . "%") alist)))
- (with-temp-buffer
- (insert format)
- (goto-char (point-min))
- (while (search-forward-regexp
- (rx "%" (group-n 1 (* (any "-+ #0-9.")))) nil 'noerror)
- (let* ((char (char-after))
- ;; Understand flags
- (flag (match-string 1))
- (val (cdr-safe (assq char alist))))
- (unless val
- (error "Invalid format character: `%%%c'" char))
- ;; Insert first, to preserve text properties.
- (insert-and-inherit (format (concat "%" flag "s") val))
- (when property-alist
- (add-text-properties (match-end 0) (point)
- (cdr-safe (assq char property-alist))))
- ;; Delete the specifier body.
- (delete-region (match-beginning 0)
- (match-end 0))
- ;; Delete `char-after'.
- (delete-char 1)))
- (buffer-string))))
-
-\f
-;;; Key definitions
-(defun sx--key-definitions-to-header-line (definitions)
- "Return a `header-line-format' from DEFINITIONS.
-DEFINITIONS is a list where each element has one of the following two forms
- (KEY COMMAND)
- (KEY COMMAND DESCRIPTION)
-
-The latter are used to build the return value, the former are
-ignored."
- (let ((ptize (lambda (x) `(:propertize ,x face mode-line-buffer-id)))
- alist out)
- (dolist (it definitions)
- (when (> (length it) 2)
- (let* ((key (car it))
- (desc (elt it 2))
- (cell (assoc desc alist)))
- (if cell (push key (cdr cell))
- (push (cons desc (list key)) alist)))))
- (dolist (it alist out)
- (let ((desc (car it))
- (keys (cdr it)))
- (push (list " "
- (cons (funcall ptize (car keys))
- (mapcar (lambda (k) `("," ,(funcall ptize k))) (cdr keys)))
- (let ((match
- (and (= 1 (length keys))
- (string-match (regexp-quote (car keys)) desc))))
- (if (and (numberp match) (= 0 match))
- (substring desc (length (car keys)))
- (concat ":" desc))))
- out)))))
-
-\f
-(defcustom sx-init-hook nil
- "Hook run when SX initializes.
-Run after `sx-init--internal-hook'."
- :group 'sx
- :type 'hook)
-
-(defvar sx-init--internal-hook nil
- "Hook run when SX initializes.
-This is used internally to set initial values for variables such
-as filters.")
-
-(defmacro sx-init-variable (variable value &optional setter)
- "Set VARIABLE to VALUE using SETTER.
-SETTER should be a function of two arguments. If SETTER is nil,
-`set' is used."
- (eval
- `(add-hook
- 'sx-init--internal-hook
- (lambda ()
- (,(or setter #'setq) ,variable ,value))))
- nil)
-
-(defvar sx-initialized nil
- "Nil if sx hasn't been initialized yet.
-If it has, holds the time at which initialization happened.")
-
-(defun sx-initialize (&optional force)
- "Run initialization hooks if they haven't been run yet.
-These are `sx-init--internal-hook' and `sx-init-hook'.
-
-If FORCE is non-nil, run them even if they've already been run."
- (when (or force (not sx-initialized))
- (prog1
- (run-hooks 'sx-init--internal-hook
- 'sx-init-hook)
- (setq sx-initialized (current-time)))))
-
-(provide 'sx)
-;;; sx.el ends here
-
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; End:
--- /dev/null
+;;; sx-auth.el --- user authentication -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 handles logic related to authentication. This includes
+;; determining if a certain filter requires authentication (via the
+;; variable `sx-auth-filter-auth' and function `sx-auth--filter-p'),
+;; determining if a method requires authentication (via the variable
+;; `sx-auth-method-auth' and function `sx-auth--method-p'), and
+;; actually authenticating the user (with `sx-auth-authenticate').
+
+;;; Code:
+
+(require 'sx)
+(require 'sx-request)
+(require 'sx-cache)
+
+(defconst sx-auth-root
+ "https://stackexchange.com/oauth/dialog")
+(defconst sx-auth-redirect-uri
+ "https://vermiculus.github.io/sx.el/auth/auth.htm")
+(defconst sx-auth-client-id
+ "3291")
+(defvar sx-auth-access-token
+ nil
+ "Your access token.
+This is needed to use your account to write questions, make
+comments, and read your inbox. Do not alter this unless you know
+what you are doing!
+
+This variable is set with `sx-auth-authenticate'.")
+
+(defconst sx-auth-method-auth
+ '((me . t)
+ (inbox . t)
+ (notifications . t)
+ (events . t)
+ (posts (comments add))
+ (comments delete
+ edit
+ flags
+ upvote)
+ (answers accept
+ delete
+ downvote
+ edit
+ flags
+ upvote)
+ (questions answers
+ add
+ close
+ delete
+ downvote
+ edit
+ favorite
+ flags
+ render
+ upvote
+ (unanswered my-tags)))
+ "List of methods that require auth.
+Methods are of the form \(METHOD . SUBMETHODS) where SUBMETHODS
+ is \(METHOD METHOD METHOD ...).
+
+If all SUBMETHODS require auth or there are no submethods, form
+will be \(METHOD . t)")
+
+(defconst sx-auth-filter-auth
+ '(question.upvoted
+ question.downvoted
+ answer.upvoted
+ answer.downvoted
+ comment.upvoted)
+ "List of filter types that require auth.
+Keywords are of the form \(OBJECT TYPES) where TYPES is \(FILTER
+FILTER FILTER).")
+
+;;;###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
+questions).
+
+When this function is called, `browse-url' is used to send the
+user to an authorization page managed by StackExchange. The
+following privileges are requested:
+
+* read_inbox
+ use SX to manage and visit items in your inbox
+
+* write_acesss
+ write comments, ask questions, and post answers on your
+ behalf
+
+* no_expiry
+ do not pester you to reauthorize again
+
+* private_info
+ TODO explanation.
+
+After authorization with StackExchange, the user is then
+redirected to a website managed by SX. The access token required
+to use authenticated methods is included in the hash (which is
+parsed and displayed prominently on the page)."
+ (interactive)
+ (setq
+ sx-auth-access-token
+ (let ((url (concat
+ sx-auth-root
+ "?"
+ (sx-request--build-keyword-arguments
+ `((client_id . ,sx-auth-client-id)
+ (scope . (read_inbox
+ no_expiry
+ private_info
+ write_access))
+ (redirect_uri . ,sx-auth-redirect-uri))
+ ","))))
+ (browse-url url)
+ (read-string "Enter the access token displayed on the webpage: ")))
+ (if (string-equal "" sx-auth-access-token)
+ (progn (setq sx-auth-access-token nil)
+ (error "You must enter this code to use this client fully"))
+ (sx-cache-set 'auth `((access_token . ,sx-auth-access-token)))))
+
+(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."
+ (let ((method-auth (cdr (assoc method sx-auth-method-auth)))
+ ;; If the submethod has additional options, they may all be
+ ;; eligible, in which case we only need to check the `car'.
+ (sub-head (if (listp submethod)
+ (car submethod))))
+ (lwarn '(sx-auth method) :debug "Method %s requires auth" method-auth)
+ (and method-auth
+ (or
+ ;; All submethods require auth.
+ (eq t method-auth)
+ ;; All sub-submethods require auth.
+ (member sub-head method-auth)
+ ;; Specific submethod requires auth.
+ (member submethod method-auth)))))
+
+;; Temporary solution. When we switch to pre-defined filters we will
+;; have to change the logic to match against specific filters.
+(defun sx-auth--filter-p (filter)
+ "Check if FILTER contains properties that require authentication.
+If it has `auth-required' properties, return a filter that has
+removed those properties."
+ (let* ((incl-filter (if (listp filter) (car filter)))
+ (rest-filter (if incl-filter (cdr filter)))
+ (auth-filters (remove nil
+ ;; Only retrieve the elements that
+ ;; are issues.
+ (mapcar (lambda (prop)
+ (car
+ (member prop
+ sx-auth-filter-auth)))
+ (or incl-filter filter))))
+ clean-filter out-filter)
+ (lwarn '(sx-auth filter) :debug "Filter: %S" filter)
+ ;; Auth-filters is the filters that are issues
+ (when auth-filters
+ (setq clean-filter
+ (cl-remove-if (lambda (prop)
+ (member prop auth-filters))
+ (or incl-filter filter))))
+ (if (and incl-filter clean-filter)
+ (setq out-filter
+ (cons clean-filter rest-filter))
+ (setq out-filter clean-filter))
+ (lwarn '(sx-auth filter2) :debug "Filter property %s requires auth. %S"
+ auth-filters out-filter)
+ out-filter))
+
+(provide 'sx-auth)
+;;; sx-auth.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "sx" "sx.el" (0 0 0 0))
+;;; Generated autoloads from sx.el
+
+(autoload 'sx-bug-report "sx" "\
+File a bug report about the `sx' package." t nil)
+
+(register-definition-prefixes "sx" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-auth" "sx-auth.el" (0 0 0 0))
+;;; Generated autoloads from sx-auth.el
+
+(autoload 'sx-authenticate "sx-auth" "\
+Authenticate this application.
+Authentication is required to read your personal data (such as
+notifications) and to write with the API (asking and answering
+questions).
+
+When this function is called, `browse-url' is used to send the
+user to an authorization page managed by StackExchange. The
+following privileges are requested:
+
+* read_inbox
+ use SX to manage and visit items in your inbox
+
+* write_acesss
+ write comments, ask questions, and post answers on your
+ behalf
+
+* no_expiry
+ do not pester you to reauthorize again
+
+* private_info
+ TODO explanation.
+
+After authorization with StackExchange, the user is then
+redirected to a website managed by SX. The access token required
+to use authenticated methods is included in the hash (which is
+parsed and displayed prominently on the page)." t nil)
+
+(register-definition-prefixes "sx-auth" '("sx-auth-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-babel" "sx-babel.el" (0 0 0 0))
+;;; Generated autoloads from sx-babel.el
+
+(register-definition-prefixes "sx-babel" '("sx-babel-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-button" "sx-button.el" (0 0 0 0))
+;;; Generated autoloads from sx-button.el
+
+(register-definition-prefixes "sx-button" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-cache" "sx-cache.el" (0 0 0 0))
+;;; Generated autoloads from sx-cache.el
+
+(register-definition-prefixes "sx-cache" '("sx-cache-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-compose" "sx-compose.el" (0 0 0 0))
+;;; Generated autoloads from sx-compose.el
+
+(register-definition-prefixes "sx-compose" '("sx-compose-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-encoding" "sx-encoding.el" (0 0 0 0))
+;;; Generated autoloads from sx-encoding.el
+
+(register-definition-prefixes "sx-encoding" '("sx-encoding-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-favorites" "sx-favorites.el" (0 0 0 0))
+;;; Generated autoloads from sx-favorites.el
+
+(register-definition-prefixes "sx-favorites" '("sx-favorite"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-filter" "sx-filter.el" (0 0 0 0))
+;;; Generated autoloads from sx-filter.el
+
+(register-definition-prefixes "sx-filter" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-inbox" "sx-inbox.el" (0 0 0 0))
+;;; Generated autoloads from sx-inbox.el
+
+(autoload 'sx-inbox "sx-inbox" "\
+Display a buffer listing inbox items.
+With prefix NOTIFICATIONS, list notifications instead of inbox.
+
+\(fn &optional NOTIFICATIONS)" t nil)
+
+(autoload 'sx-inbox-notifications "sx-inbox" "\
+Display a buffer listing notification items." t nil)
+
+(register-definition-prefixes "sx-inbox" '("sx-inbox-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-interaction" "sx-interaction.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from sx-interaction.el
+
+(autoload 'sx-open-link "sx-interaction" "\
+Visit element given by LINK inside Emacs.
+Element can be a question, answer, or comment.
+
+\(fn LINK &optional _)" t nil)
+
+(autoload 'sx-org-get-link "sx-interaction" "\
+Add a link to this post to Org's memory." nil nil)
+
+(autoload 'sx-ask "sx-interaction" "\
+Start composing a question for SITE.
+SITE is a string, indicating where the question will be posted.
+
+\(fn SITE)" t nil)
+
+(register-definition-prefixes "sx-interaction" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-method" "sx-method.el" (0 0 0 0))
+;;; Generated autoloads from sx-method.el
+
+(register-definition-prefixes "sx-method" '("sx-method-post-from-data"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-networks" "sx-networks.el" (0 0 0 0))
+;;; Generated autoloads from sx-networks.el
+
+(register-definition-prefixes "sx-networks" '("sx-network-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-notify" "sx-notify.el" (0 0 0 0))
+;;; Generated autoloads from sx-notify.el
+
+(register-definition-prefixes "sx-notify" '("sx-notify-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-question" "sx-question.el" (0 0 0 0))
+;;; Generated autoloads from sx-question.el
+
+(register-definition-prefixes "sx-question" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-question-list" "sx-question-list.el" (0
+;;;;;; 0 0 0))
+;;; Generated autoloads from sx-question-list.el
+
+(register-definition-prefixes "sx-question-list" '("sx-question-list-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-question-mode" "sx-question-mode.el" (0
+;;;;;; 0 0 0))
+;;; Generated autoloads from sx-question-mode.el
+
+(register-definition-prefixes "sx-question-mode" '("sx-question-mode"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-question-print" "sx-question-print.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from sx-question-print.el
+
+(register-definition-prefixes "sx-question-print" '("sx-question-mode-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-request" "sx-request.el" (0 0 0 0))
+;;; Generated autoloads from sx-request.el
+
+(register-definition-prefixes "sx-request" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-search" "sx-search.el" (0 0 0 0))
+;;; Generated autoloads from sx-search.el
+
+(autoload 'sx-search "sx-search" "\
+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.
+
+\(fn SITE QUERY &optional TAGS EXCLUDED-TAGS)" t nil)
+
+(autoload 'sx-search-tag-at-point "sx-search" "\
+Follow tag under position POS or point.
+
+\(fn &optional POS)" t nil)
+
+(register-definition-prefixes "sx-search" '("sx-search-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-site" "sx-site.el" (0 0 0 0))
+;;; Generated autoloads from sx-site.el
+
+(register-definition-prefixes "sx-site" '("sx-site-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-switchto" "sx-switchto.el" (0 0 0 0))
+;;; Generated autoloads from sx-switchto.el
+
+(define-prefix-command 'sx-switchto-map)
+
+;;;***
+\f
+;;;### (autoloads nil "sx-tab" "sx-tab.el" (0 0 0 0))
+;;; Generated autoloads from sx-tab.el
+
+(autoload 'sx-tab-all-questions "sx-tab" nil t)
+
+(autoload 'sx-tab-unanswered "sx-tab" nil t)
+
+(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t)
+
+(autoload 'sx-tab-featured "sx-tab" nil t)
+
+(autoload 'sx-tab-starred "sx-tab" nil t)
+
+(autoload 'sx-tab-frontpage "sx-tab" nil t)
+
+(autoload 'sx-tab-newest "sx-tab" nil t)
+
+(autoload 'sx-tab-topvoted "sx-tab" nil t)
+
+(autoload 'sx-tab-hot "sx-tab" nil t)
+
+(autoload 'sx-tab-week "sx-tab" nil t)
+
+(autoload 'sx-tab-month "sx-tab" nil t)
+
+(register-definition-prefixes "sx-tab" '("sx-tab-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-tag" "sx-tag.el" (0 0 0 0))
+;;; Generated autoloads from sx-tag.el
+
+(register-definition-prefixes "sx-tag" '("sx-tag-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-time" "sx-time.el" (0 0 0 0))
+;;; Generated autoloads from sx-time.el
+
+(register-definition-prefixes "sx-time" '("sx-time-"))
+
+;;;***
+\f
+;;;### (autoloads nil "sx-user" "sx-user.el" (0 0 0 0))
+;;; Generated autoloads from sx-user.el
+
+(register-definition-prefixes "sx-user" '("sx-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("sx-load.el" "sx-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; sx-autoloads.el ends here
--- /dev/null
+;;; sx-babel.el --- font-locking pre blocks according to language -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 variable `sx-babel-major-mode-alist', which see.
+
+\f
+;;; 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)
+ ;; Not sure if leaving out "[{" might lead to false positives.
+ (,(rx "\\" (+ alnum) (any "[{")) latex-mode)
+ ;; Right now, this will match a lot of stuff. Once we are capable
+ ;; of determining major-mode from tags, site, and comments, this
+ ;; will work as a last case fallback.
+ (,(rx (or (and "int" (+ space) "main" (* space) "("))) c-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)
+
+\f
+;;; 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
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-button.el --- defining buttons -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This file defines all buttons used by SX. For information on
+;; buttons, see:
+;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Buttons.html
+;;
+;; Most interactive parts of the SX buffers are buttons. Wherever you
+;; are, you can always cycle through all buttons by hitting `TAB',
+;; that should help identify what's a button in each buffer.
+;;
+;; To define a new type of button follow the examples below using
+;; `define-button-type' with :supertype `sx-button'. Required
+;; properties are `action' and `help-echo'. You'll probably want to
+;; give it a `face' as well, unless you want it to look like a link.
+;;
+;; Buttons can then be inserted in their respective files using
+;; `insert-text-button'. Give it the string, the `:type' you defined,
+;; and any additional properties that can only be determined at
+;; creation. Existing text can be transformed into a button with
+;; `make-text-button' instead.
+
+\f
+;;; Code:
+(require 'button)
+
+(require 'sx)
+(require 'sx-question)
+
+(declare-function sx-accept "sx-interaction")
+(declare-function sx-answer "sx-interaction")
+(declare-function sx-comment "sx-interaction")
+(declare-function sx-open-link "sx-interaction")
+(declare-function sx-question-mode-hide-show-section "sx-question-mode")
+
+\f
+;;; Face
+(defface sx-custom-button
+ '((((type x w32 ns) (class color)) ; Like default mode line
+ :box (:line-width 3 :style released-button)
+ :height 0.9
+ :background "lightgrey" :foreground "black"))
+ "Face used on buttons such as \"Write an Answer\"."
+ :group 'sx)
+
+\f
+;;; Command definitions
+;; This extends `button-map', which already defines RET and mouse-1.
+(defvar sx-button-map
+ (let ((map (copy-keymap button-map)))
+ (define-key map "w" #'sx-button-copy)
+ map)
+ "Keymap used on buttons.")
+
+(defun sx-button-copy ()
+ "Copy the content of thing at point.
+This is usually a link's URL, or the content of a code block."
+ (interactive)
+ (let ((content
+ (get-text-property (point) 'sx-button-copy)))
+ (if (null content)
+ (sx-message "Nothing to copy here.")
+ (kill-new content)
+ (sx-message "Copied %s to kill ring."
+ (or (get-text-property
+ (point) 'sx-button-copy-type)
+ content)))))
+
+(defun sx-button-edit-this (text-or-marker &optional majormode)
+ "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJORMODE.
+When given a marker (or interactively), use the 'sx-button-copy
+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 majormode (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)
+ (when majormode
+ (funcall majormode))))
+
+(defun sx-button-follow-link (&optional pos)
+ "Follow link at POS. If POS is nil, use `point'."
+ (interactive)
+ (let ((url (or (get-text-property (or pos (point)) 'sx-button-url)
+ (sx-user-error "No url under point: %s" (or pos (point))))))
+ ;; If we didn't recognize the link, this errors immediately. If
+ ;; we mistakenly recognize it, it will error when we try to fetch
+ ;; whatever we thought it was.
+ (condition-case nil (sx-open-link url)
+ ;; When it errors, don't blame the user, just visit externally.
+ (error (browse-url url)))))
+
+\f
+;;; Help-echo definitions
+(defconst sx-button--help-echo
+ (concat "mouse-1, RET"
+ (propertize ": %s -- " 'face 'minibuffer-prompt)
+ "w"
+ (propertize ": copy %s" 'face 'minibuffer-prompt))
+ "Base help-echo on which others can be written.")
+
+(defconst sx-button--user-help-echo
+ (format sx-button--help-echo
+ "visit user page"
+ "link")
+ "Help echoed in the minibuffer when point is on a user.")
+
+(defconst sx-button--tag-help-echo
+ (format sx-button--help-echo
+ "Tag search"
+ "tag")
+ "Help echoed in the minibuffer when point is on a tag.")
+
+(defconst sx-button--question-title-help-echo
+ (format sx-button--help-echo
+ "hide content"
+ "link")
+ "Help echoed in the minibuffer when point is on a section.")
+
+(defconst sx-button--link-help-echo
+ (format sx-button--help-echo
+ "visit %s"
+ "URL")
+ "Help echoed in the minibuffer when point is on a section.")
+
+\f
+;;; Type definitions
+(define-button-type 'sx-button
+ 'follow-link t
+ 'keymap sx-button-map)
+
+(define-button-type 'sx-question-mode-title
+ 'face 'sx-question-mode-title
+ 'action #'sx-question-mode-hide-show-section
+ 'help-echo sx-button--question-title-help-echo
+ 'sx-button-copy-type "Share Link"
+ :supertype 'sx-button)
+
+(define-button-type 'sx-question-mode-code-block
+ 'action #'sx-button-edit-this
+ 'face nil
+ :supertype 'sx-button)
+
+(define-button-type 'sx-button-link
+ 'action #'sx-button-follow-link
+ :supertype 'sx-button)
+
+(define-button-type 'sx-button-user
+ 'action #'sx-button-follow-link
+ 'help-echo sx-button--user-help-echo
+ ;; We use different faces on different parts of the user button.
+ 'face 'sx-user-name
+ :supertype 'sx-button)
+
+(declare-function sx-search-tag-at-point "sx-search")
+(define-button-type 'sx-button-tag
+ 'action #'sx-search-tag-at-point
+ 'help-echo sx-button--tag-help-echo
+ 'face 'sx-tag
+ :supertype 'sx-button)
+
+(define-button-type 'sx-button-comment
+ 'help-echo (concat "mouse-1, RET"
+ (propertize ": write a comment"
+ 'face 'minibuffer-prompt))
+ 'face 'sx-custom-button
+ 'action #'sx-comment
+ :supertype 'sx-button)
+
+(define-button-type 'sx-button-accept
+ 'help-echo (concat "mouse-1, RET"
+ (propertize ": accept answer"
+ 'face 'minibuffer-prompt))
+ 'face 'sx-custom-button
+ 'action #'sx-accept
+ :supertype 'sx-button)
+
+(define-button-type 'sx-button-answer
+ 'help-echo (concat "mouse-1, RET"
+ (propertize ": write an answer"
+ 'face 'minibuffer-prompt))
+ 'face 'sx-custom-button
+ 'action #'sx-answer
+ :supertype 'sx-button)
+
+(provide 'sx-button)
+;;; sx-button.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-cache.el --- caching -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 handles the cache system. All caches are retrieved and
+;; set using symbols. The symbol should be the sub-package that is
+;; using the cache. For example, `sx-pkg' would use
+;;
+;; `(sx-cache-get 'pkg)'
+;;
+;; This symbol is then converted into a filename within
+;; `sx-cache-directory' using `sx-cache-get-file-name'.
+;;
+;; Currently, the cache is written at every `sx-cache-set', but this
+;; write will eventually be done by some write-all function which will
+;; be set on an idle timer.
+
+;;; Code:
+
+(defcustom sx-cache-directory (locate-user-emacs-file ".sx")
+ "Directory containing cached data."
+ :type 'directory
+ :group 'sx)
+
+(defun sx-cache--ensure-sx-cache-directory-exists ()
+ "Ensure `sx-cache-directory' exists."
+ (unless (file-exists-p sx-cache-directory)
+ (mkdir sx-cache-directory)))
+
+(defun sx-cache-get-file-name (filename)
+ "Expand FILENAME in the context of `sx-cache-directory'."
+ (expand-file-name
+ (concat (symbol-name filename) ".el")
+ sx-cache-directory))
+
+(defun sx-cache-get (cache &optional form)
+ "Return the data within CACHE.
+If CACHE does not exist, use `sx-cache-set' to set CACHE to the
+result of evaluating FORM.
+
+CACHE is resolved to a file name by `sx-cache-get-file-name'."
+ (sx-cache--ensure-sx-cache-directory-exists)
+ (let ((file (sx-cache-get-file-name cache)))
+ ;; If the file exists, return the data it contains
+ (if (file-exists-p file)
+ (with-temp-buffer
+ (insert-file-contents (sx-cache-get-file-name cache))
+ (read (buffer-string)))
+ ;; Otherwise, set CACHE to the evaluation of FORM.
+ ;; `sx-cache-set' returns the data that CACHE was set to.
+ (sx-cache-set cache (eval form)))))
+
+(defun sx-cache-set (cache data)
+ "Set the content of CACHE to DATA and save.
+DATA will be written as returned by `prin1'.
+
+CACHE is resolved to a file name by `sx-cache-get-file-name'."
+ (sx-cache--ensure-sx-cache-directory-exists)
+ (let (print-length print-level)
+ (write-region (prin1-to-string data) nil
+ (sx-cache-get-file-name cache)))
+ data)
+
+(defun sx-cache--invalidate (cache &optional vars init-method)
+ "Set cache CACHE to nil.
+
+VARS is a list of variables to unbind to ensure cache is cleared.
+If INIT-METHOD is defined, call it after all invalidation to
+re-initialize the cache."
+ (let ((file (sx-cache-get-file-name cache)))
+ (delete-file file))
+ (mapc #'makunbound vars)
+ (when init-method
+ (funcall init-method)))
+
+(defun sx-cache-invalidate-all (&optional save-auth)
+ "Invalidate all caches using `sx-cache--invalidate'.
+Afterwards reinitialize caches using `sx-initialize'. If
+SAVE-AUTH is non-nil, do not clear AUTH cache.
+
+Interactively, SAVE-AUTH is the negation of the prefix argument.
+That is, by default the auth cache is PRESERVED interactively.
+If you provide a prefix argument, the auth cache is INVALIDATED.
+
+Note: This will also remove read/unread status of questions as well
+as delete the list of hidden questions."
+ (interactive (list (not current-prefix-arg)))
+ (let* ((default-directory sx-cache-directory)
+ (caches (file-expand-wildcards "*.el")))
+ (when save-auth
+ (setq caches (cl-remove-if (lambda (x)
+ (string= x "auth.el")) caches)))
+ (lwarn 'sx :debug "Invalidating: %S" caches)
+ (mapc #'delete-file caches)
+ (sx-initialize 'force)))
+
+(provide 'sx-cache)
+;;; sx-cache.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-compose.el --- major-mode for composing questions and answers -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines `sx-compose-mode' and its auxiliary functions and
+;; variables. In order to use `sx-compose-mode', it is vital that the
+;; variable `sx-compose--send-function' be set. Otherwise it's just a
+;; regular markdown buffer.
+;;
+;; In order to help avoid mistakes, there is the function
+;; `sx-compose-create'. This is the preferred way of activating the
+;; mode. It creates a buffer, activates the major mode, and sets the
+;; `send-function' variable according to the arguments it is given.
+
+\f
+;;; Code:
+(require 'markdown-mode)
+
+(require 'sx)
+(require 'sx-tag)
+
+(defgroup sx-compose-mode nil
+ "Customization group for sx-compose-mode."
+ :prefix "sx-compose-mode-"
+ :tag "SX compose Mode"
+ :group 'sx)
+
+\f
+;;; Faces and Variables
+(defvar sx-compose-before-send-hook nil
+ "Hook run before POSTing to the API.
+Functions are called without arguments and should return non-nil.
+
+Returning nil indicates something went wrong and the sending will
+be aborted. In this case, the function is responsible for
+notifying the user.
+
+Current buffer is the compose-mode buffer whose content is about
+to be POSTed.")
+
+(defvar sx-compose-after-send-functions nil
+ "Hook run after POSTing to the API.
+Functions on this hook should take two arguments, the
+`sx-compose-mode' buffer (which not be live) and the data
+returned by `sx-compose--send-function' (usually the object
+created by the API). They are only called if the transaction
+succeeds.")
+
+(defvar sx-compose--send-function nil
+ "Function used by `sx-compose-send' to send the data.
+Is invoked between `sx-compose-before-send-hook' and
+`sx-compose-after-send-functions'.")
+
+(defconst sx-compose--question-headers
+ (concat
+ #("Title: " 0 7 (intangible t read-only t rear-nonsticky t))
+ "%s"
+ #("\n" 0 1 (read-only t))
+ #("Tags : " 0 7 (read-only t intangible t rear-nonsticky t))
+ "%s"
+ #("\n" 0 1 (read-only t rear-nonsticky t))
+ #("________________________________________\n"
+ 0 41 (read-only t rear-nonsticky t intangible t
+ sx-compose-separator t))
+ "\n")
+ "Headers inserted when composing a new question.
+Used by `sx-compose-create'.")
+
+(defconst sx-compose--header-line
+ '(" "
+ (:propertize "C-c C-c" face mode-line-buffer-id)
+ ": Finish and Send"
+ (sx-compose--is-question-p
+ (" "
+ (:propertize "C-c C-q" face mode-line-buffer-id)
+ ": Insert tags"))
+ " "
+ (:propertize "C-c C-k" face mode-line-buffer-id)
+ ": Discard Draft")
+ "Header-line used on `sx-compose-mode' drafts.")
+
+(defvar sx-compose--is-question-p nil
+ "Non-nil if this `sx-compose-mode' buffer is a question.")
+(make-variable-buffer-local 'sx-compose--is-question-p)
+
+(defvar sx-compose--site nil
+ "Site which the current compose buffer belongs to.")
+(make-variable-buffer-local 'sx-compose--site)
+
+\f
+;;; Major-mode
+(define-derived-mode sx-compose-mode markdown-mode "Compose"
+ "Major mode for coposing questions and answers.
+Most of the functionality comes from `markdown-mode'. This mode
+just implements some extra features related to posting to the
+API.
+
+This mode won't function if `sx-compose--send-function' isn't
+set. To make sure you set it correctly, you can create the
+buffer with the `sx-compose-create' function.
+
+If creating a question draft, the `sx-compose--is-question-p'
+variable should also be set to enable more functionality.
+
+\\<sx-compose-mode>
+\\{sx-compose-mode}"
+ (setq header-line-format sx-compose--header-line)
+ (add-hook 'sx-compose-after-send-functions
+ #'sx-compose-quit nil t)
+ (add-hook 'sx-compose-after-send-functions
+ #'sx-compose--copy-as-kill nil t))
+
+(define-key sx-compose-mode-map "\C-c\C-c" #'sx-compose-send)
+(define-key sx-compose-mode-map "\C-c\C-k" #'sx-compose-quit)
+(sx--define-conditional-key
+ sx-compose-mode-map "\C-c\C-q" #'sx-compose-insert-tags
+ sx-compose--is-question-p)
+
+(defun sx-compose-send ()
+ "Finish composing current buffer and send it.
+Calls `sx-compose-before-send-hook', POSTs the the current buffer
+contents to the API, then calls `sx-compose-after-send-functions'."
+ (interactive)
+ (when (run-hook-with-args-until-failure
+ 'sx-compose-before-send-hook)
+ (let ((result (funcall sx-compose--send-function))
+ (buf (current-buffer)))
+ (run-hook-wrapped
+ 'sx-compose-after-send-functions
+ (lambda (func)
+ (with-demoted-errors
+ "[sx] Error encountered AFTER sending post, but the post was sent successfully: %s"
+ (funcall func buf result))
+ nil)))))
+
+(defun sx-compose-insert-tags ()
+ "Prompt for a tag list for this draft and insert them."
+ (interactive)
+ (save-excursion
+ (let* ((old (sx-compose--goto-tag-header))
+ (new
+ (save-match-data
+ (mapconcat
+ #'identity
+ (sx-tag-multiple-read sx-compose--site "Tags" old)
+ " "))))
+ (if (match-string 1)
+ (replace-match new :fixedcase nil nil 1)
+ (insert new)))))
+
+\f
+;;; Functions for use in hooks
+(defun sx-compose-quit (buffer _)
+ "Close BUFFER's window and kill it."
+ (interactive (list (current-buffer) nil))
+ (when (buffer-live-p buffer)
+ (let ((w (get-buffer-window buffer)))
+ (when (window-live-p w)
+ (ignore-errors (delete-window w))))
+ (kill-buffer buffer)))
+
+(defun sx-compose--copy-as-kill (buffer _)
+ "Copy BUFFER contents to the kill-ring."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (kill-new (buffer-string)))))
+
+(defun sx-compose--goto-tag-header ()
+ "Move to the \"Tags:\" header.
+Match data is set so group 1 encompasses any already inserted
+tags. Return a list of already inserted tags."
+ (goto-char (point-min))
+ (unless (search-forward-regexp
+ (rx bol "Tags : " (group-n 1 (* not-newline)) eol)
+ (next-single-property-change (point-min) 'sx-compose-separator)
+ 'noerror)
+ (error "No Tags header found"))
+ (save-match-data
+ (sx--split-string (match-string 1) (rx (any space ",;")))))
+
+(defun sx-compose--check-tags ()
+ "Check if tags in current compose buffer are valid."
+ (save-excursion
+ (let ((invalid-tags
+ (sx-tag--invalid-name-p
+ sx-compose--site (sx-compose--goto-tag-header))))
+ (if invalid-tags
+ ;; If the user doesn't want to create the tags, we return
+ ;; nil and sending is aborted.
+ (y-or-n-p (format "Following tags don't exist. Create them? %s " invalid-tags))
+ t))))
+
+\f
+;;; Functions to help preparing buffers
+(defun sx-compose-create (site parent &optional before-functions after-functions)
+ "Create an `sx-compose-mode' buffer.
+SITE is the site where it will be posted.
+
+If composing questions, PARENT is nil.
+If composing answers, it is the `question_id'.
+If editing answers or questions, it should be the alist data
+related to that object.
+
+Each element of BEFORE-FUNCTIONS and AFTER-FUNCTIONS are
+respectively added locally to `sx-compose-before-send-hook' and
+`sx-compose-after-send-functions'."
+ (or (integerp parent) (listp parent)
+ (error "Invalid PARENT"))
+ (let ((is-question
+ (and (listp parent)
+ (or (null parent)
+ (cdr (assoc 'title parent))))))
+ (with-current-buffer (sx-compose--get-buffer-create site parent)
+ (sx-compose-mode)
+ (setq sx-compose--site site)
+ (setq sx-compose--is-question-p is-question)
+ (setq sx-compose--send-function
+ (if (consp parent)
+ (sx-assoc-let parent
+ (lambda () (sx-method-call (cond
+ (.title 'questions)
+ (.comment_id 'comments)
+ (t 'answers))
+ :auth 'warn
+ :url-method 'post
+ :filter sx-browse-filter
+ :site site
+ :keywords (sx-compose--generate-keywords is-question)
+ :id (or .comment_id .answer_id .question_id)
+ :submethod 'edit)))
+ (lambda () (sx-method-call 'questions
+ :auth 'warn
+ :url-method 'post
+ :filter sx-browse-filter
+ :site site
+ :keywords (sx-compose--generate-keywords is-question)
+ :id parent
+ :submethod (if parent 'answers/add 'add)))))
+ ;; Reverse so they're left in the same order.
+ (dolist (it (reverse before-functions))
+ (add-hook 'sx-compose-before-send-hook it nil t))
+ (dolist (it (reverse after-functions))
+ (add-hook 'sx-compose-after-send-functions it nil t))
+ (when is-question
+ (add-hook 'sx-compose-before-send-hook #'sx-compose--check-tags nil t))
+ ;; If the buffer is empty, the draft didn't exist. So prepare the
+ ;; question.
+ (when (or (string= (buffer-string) "")
+ (y-or-n-p "Draft buffer exists. Reset it? "))
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-read-only t))
+ (erase-buffer)
+ (when (consp parent)
+ (insert (cdr (assoc 'body_markdown parent))))
+ (when is-question
+ (sx-compose--print-question-headers
+ (when (consp parent) parent))
+ (unless (consp parent)
+ (goto-char (point-min))
+ (goto-char (line-end-position))))))
+ ;; Return the buffer
+ (current-buffer))))
+
+(defun sx-compose--print-question-headers (question)
+ "Print question headers for the compose buffer.
+If QUESTION is non-nil, fill the headers with the data from
+QUESTION."
+ (sx-assoc-let question
+ (goto-char (point-min))
+ (insert
+ (format sx-compose--question-headers
+ (or .title "") (mapconcat #'identity .tags " ")))))
+
+(defun sx-compose--generate-keywords (is-question)
+ "Reading current buffer, generate a keywords alist.
+Keywords meant to be used in `sx-method-call'.
+
+`body' is read as the `buffer-string'. If IS-QUESTION is non-nil,
+other keywords are read from the header "
+ (goto-char (point-min))
+ `(,@(when is-question
+ (let ((inhibit-point-motion-hooks t)
+ (header-end
+ (next-single-property-change
+ (point-min) 'sx-compose-separator))
+ keywords)
+ ;; Read the Title.
+ (unless (search-forward-regexp
+ "^Title: *\\(.*\\) *$" header-end 'noerror)
+ (error "No Title header found"))
+ (push (cons 'title (match-string 1)) keywords)
+ ;; And the tags
+ (goto-char (point-min))
+ (unless (search-forward-regexp "^Tags : *\\([^[:space:]].*\\) *$"
+ header-end 'noerror)
+ (error "No Tags header found"))
+ (push (cons 'tags (sx--split-string (match-string 1) "[[:space:],;]"))
+ keywords)
+ ;; And move past the header so it doesn't get sent.
+ (goto-char (next-single-property-change
+ header-end 'sx-compose-separator))
+ keywords))
+ (body . ,(buffer-substring-no-properties (point) (point-max)))))
+
+(defun sx-compose--get-buffer-create (site data)
+ "Get or create a buffer for use with `sx-compose-mode'.
+SITE is the site for which composing is aimed (just used to
+uniquely identify the buffers).
+
+If DATA is nil, get a fresh compose buffer.
+If DATA is an integer, try to find an existing buffer
+corresponding to that integer, otherwise create one.
+If DATA is an alist (question or answer data), like above but use
+the id property."
+ (cond
+ ((null data)
+ (generate-new-buffer
+ (format "*sx draft question %s*" site)))
+ ((integerp data)
+ (get-buffer-create
+ (format "*sx draft answer %s %s*"
+ site data)))
+ (t
+ (get-buffer-create
+ (sx-assoc-let data
+ (format "*sx draft edit %s %s %s*"
+ site
+ (cond (.title "question")
+ (.comment_id "comment")
+ (t "answer"))
+ (or .comment_id .answer_id .question_id)))))))
+
+(provide 'sx-compose)
+;;; sx-compose.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-encoding.el --- encoding -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 handles decoding the responses we get from the API. They
+;; are received either as plain-text or as a `gzip' compressed archive.
+;; For this, `sx-encoding-gzipped-p' is used to determine if content
+;; has been compressed under `gzip'.
+
+;;; Code:
+
+(require 'cl-lib)
+
+\f
+;;;; HTML Encoding
+
+(defcustom sx-encoding-html-entities-plist
+ '(Aacute "Á" aacute "á" Acirc "Â" acirc "â" acute "´" AElig "Æ" aelig "æ"
+ Agrave "À" agrave "à" alefsym "ℵ" Alpha "Α" alpha "α" amp "&" and "∧"
+ ang "∠" apos "'" aring "å" Aring "Å" asymp "≈" atilde "ã" Atilde "Ã"
+ auml "ä" Auml "Ä" bdquo "„" Beta "Β" beta "β" brvbar "¦" bull "•"
+ cap "∩" ccedil "ç" Ccedil "Ç" cedil "¸" cent "¢" Chi "Χ" chi "χ"
+ circ "ˆ" clubs "♣" cong "≅" copy "©" crarr "↵" cup "∪" curren "¤"
+ Dagger "‡" dagger "†" darr "↓" dArr "⇓" deg "°" Delta "Δ" delta "δ"
+ diams "♦" divide "÷" eacute "é" Eacute "É" ecirc "ê" Ecirc "Ê" egrave "è"
+ Egrave "È" empty "∅" emsp " " ensp " " Epsilon "Ε" epsilon "ε" equiv "≡"
+ Eta "Η" eta "η" eth "ð" ETH "Ð" euml "ë" Euml "Ë" euro "€"
+ exist "∃" fnof "ƒ" forall "∀" frac12 "½" frac14 "¼" frac34 "¾" frasl "⁄"
+ Gamma "Γ" gamma "γ" ge "≥" gt ">" harr "↔" hArr "⇔" hearts "♥"
+ hellip "…" iacute "í" Iacute "Í" icirc "î" Icirc "Î" iexcl "¡" igrave "ì"
+ Igrave "Ì" image "ℑ" infin "∞" int "∫" Iota "Ι" iota "ι" iquest "¿"
+ isin "∈" iuml "ï" Iuml "Ï" Kappa "Κ" kappa "κ" Lambda "Λ" lambda "λ"
+ lang "〈" laquo "«" larr "←" lArr "⇐" lceil "⌈" ldquo "“" le "≤"
+ lfloor "⌊" lowast "∗" loz "◊" lrm "" lsaquo "‹" lsquo "‘" lt "<"
+ macr "¯" mdash "—" micro "µ" middot "·" minus "−" Mu "Μ" mu "μ"
+ nabla "∇" nbsp " " ndash "–" ne "≠" ni "∋" not "¬" notin "∉"
+ nsub "⊄" ntilde "ñ" Ntilde "Ñ" Nu "Ν" nu "ν" oacute "ó" Oacute "Ó"
+ ocirc "ô" Ocirc "Ô" OElig "Œ" oelig "œ" ograve "ò" Ograve "Ò" oline "‾"
+ omega "ω" Omega "Ω" Omicron "Ο" omicron "ο" oplus "⊕" or "∨" ordf "ª"
+ ordm "º" oslash "ø" Oslash "Ø" otilde "õ" Otilde "Õ" otimes "⊗" ouml "ö"
+ Ouml "Ö" para "¶" part "∂" permil "‰" perp "⊥" Phi "Φ" phi "φ"
+ Pi "Π" pi "π" piv "ϖ" plusmn "±" pound "£" Prime "″" prime "′"
+ prod "∏" prop "∝" Psi "Ψ" psi "ψ" quot "\"" radic "√" rang "〉"
+ raquo "»" rarr "→" rArr "⇒" rceil "⌉" rdquo "”" real "ℜ" reg "®"
+ rfloor "⌋" Rho "Ρ" rho "ρ" rlm "" rsaquo "›" rsquo "’" sbquo "‚"
+ scaron "š" Scaron "Š" sdot "⋅" sect "§" shy "" Sigma "Σ" sigma "σ"
+ sigmaf "ς" sim "∼" spades "♠" sub "⊂" sube "⊆" sum "∑" sup "⊃"
+ sup1 "¹" sup2 "²" sup3 "³" supe "⊇" szlig "ß" Tau "Τ" tau "τ"
+ there4 "∴" Theta "Θ" theta "θ" thetasym "ϑ" thinsp " " thorn "þ" THORN "Þ"
+ tilde "˜" times "×" trade "™" uacute "ú" Uacute "Ú" uarr "↑" uArr "⇑"
+ ucirc "û" Ucirc "Û" ugrave "ù" Ugrave "Ù" uml "¨" upsih "ϒ" Upsilon "Υ"
+ upsilon "υ" uuml "ü" Uuml "Ü" weierp "℘" Xi "Ξ" xi "ξ" yacute "ý"
+ Yacute "Ý" yen "¥" yuml "ÿ" Yuml "Ÿ" Zeta "Ζ" zeta "ζ" zwj "" zwnj "")
+ "Plist of HTML entities and their respective glyphs.
+See `sx-encoding-decode-entities'."
+ :type '(repeat (choice symbol string))
+ :group 'sx)
+
+(defun sx-encoding-decode-entities (string)
+ "Decode HTML entities (e.g. \""\") in STRING.
+
+Done according to `sx-encoding-html-entities-plist'. If this
+list does not contain the entity, it is assumed to be a number
+and converted to a string (with `char-to-string').
+
+Return the decoded string."
+ (let* ((plist sx-encoding-html-entities-plist)
+ (get-function
+ (lambda (s)
+ (let ((ss (substring s 1 -1)))
+ ;; Handle things like "
+ (or (plist-get plist (intern ss))
+ ;; Handle things like '
+ (char-to-string
+ (string-to-number
+ ;; Skip the `#'
+ (substring ss 1))))))))
+ (replace-regexp-in-string "&[^; ]*;" get-function string)))
+
+\f
+;;;; Convenience Functions
+
+(defun sx-encoding-normalize-line-endings (string)
+ "Normalize the line endings for STRING.
+The API returns strings that use Windows-style line endings.
+These are largely useless in an Emacs environment. Windows uses
+\"\\r\\n\", Unix uses just \"\\n\". Deleting \"\\r\" is sufficient for
+conversion."
+ (delete ?\r string))
+
+(defun sx-encoding-clean-content (string)
+ "Clean STRING for display.
+Applies `sx-encoding-normalize-line-endings' and
+`sx-encoding-decode-entities' (in that order) to prepare STRING
+for sane display."
+ (sx-encoding-decode-entities
+ (sx-encoding-normalize-line-endings
+ string)))
+
+(defun sx-encoding-clean-content-deep (data)
+ "Clean DATA recursively where necessary.
+
+If DATA is a list or a vector, map this function over DATA and
+return as the the same type of structure.
+
+If DATA is a cons cell (but not a list), use
+`sx-encoding-clean-content-deep' on the `cdr' of DATA.
+
+If DATA is a string, return DATA after applying
+`sx-encoding-clean-content'.
+
+Otherwise, return DATA.
+
+This function is highly specialized for the data structures
+returned by `json-read' via `sx-request-make'. It may fail in
+some cases."
+ (if (consp data)
+ (if (listp (cdr data))
+ (cl-map #'list #'sx-encoding-clean-content-deep data)
+ (cons (car data) (sx-encoding-clean-content-deep (cdr data))))
+ (cond
+ ((stringp data)
+ (sx-encoding-clean-content data))
+ ((vectorp data)
+ (cl-map #'vector #'sx-encoding-clean-content-deep data))
+ (t data))))
+
+\f
+;;;; GZIP
+
+(defun sx-encoding-gzipped-p (data)
+ "Check for magic bytes in DATA.
+Check if the first two bytes of a string in DATA match the magic
+numbers identifying the gzip file format.
+
+See URL `http://www.gzip.org/zlib/rfc-gzip.html'."
+ ;; Credit: http://emacs.stackexchange.com/a/2978
+ (let ((unidata (string-as-unibyte data)))
+ (when (<= 2 (length unidata))
+ (equal (substring unidata 0 2)
+ (unibyte-string 31 139)))))
+
+(defun sx-encoding-gzipped-buffer-p (buffer)
+ "Check if BUFFER is gzip-compressed.
+See `sx-encoding-gzipped-p'."
+ (with-current-buffer buffer
+ (sx-encoding-gzipped-p
+ (buffer-string))))
+
+(defun sx-encoding-gzipped-file-p (file)
+ "Check if the FILE is gzip-compressed.
+See `sx-encoding-gzipped-p'."
+ (let ((first-two-bytes (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file nil 0 2)
+ (buffer-string))))
+ (sx-encoding-gzipped-p first-two-bytes)))
+
+(provide 'sx-encoding)
+;;; sx-encoding.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-favorites.el --- starred questions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 provides logic for retrieving and managing a user's
+;; starred questions.
+
+;;; Code:
+
+(require 'sx-method)
+(require 'sx-cache)
+(require 'sx-site)
+(require 'sx-networks)
+(require 'sx-filter)
+
+(defconst sx-favorite-list-filter
+ (sx-filter-from-nil
+ (question.question_id)))
+
+(defvar sx-favorites--user-favorite-list nil
+ "Alist of questions favorited by the user.
+Each element has the form (SITE FAVORITE-LIST). And each element
+in FAVORITE-LIST is the numerical QUESTION_ID.")
+
+(defun sx-favorites--initialize ()
+ "Ensure question-favorites cache is available.
+Added as hook to initialization."
+ (or (setq sx-favorites--user-favorite-list
+ (sx-cache-get 'question-favorites))
+ (sx-favorites-update)))
+;; ;; Append to ensure `sx-network--initialize' is run before it.
+;; This is removed for now because it performs a lot of API calls and
+;; was never used.
+;; (add-hook 'sx-init--internal-hook #'sx-favorites--initialize 'append)
+
+(defun sx-favorites--retrieve-favorites (site)
+ "Obtain list of starred QUESTION_IDs for SITE."
+ (sx-method-call 'me
+ :submethod 'favorites
+ :site site
+ :filter sx-favorite-list-filter
+ :auth t))
+
+(defun sx-favorites--update-site-favorites (site)
+ "Update list of starred QUESTION_IDs for SITE.
+Writes list to cache QUESTION-FAVORITES."
+ (let* ((favs (sx-favorites--retrieve-favorites site))
+ (site-cell (assoc site
+ sx-favorites--user-favorite-list))
+ (fav-cell (mapcar #'cdar favs)))
+ (if site-cell
+ (setcdr site-cell fav-cell)
+ (push (cons site fav-cell) sx-favorites--user-favorite-list))
+ (sx-cache-set 'question-favorites sx-favorites--user-favorite-list)))
+
+(defun sx-favorites-update ()
+ "Update all sites retrieved from `sx-network--user-sites'."
+ (mapc #'sx-favorites--update-site-favorites
+ sx-network--user-sites))
+
+(provide 'sx-favorites)
+;;; sx-favorites.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-filter.el --- handles retrieval of filters -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 manages filters and provides an API to compile filters
+;; and retrieve them from the cache. See `sx-filter-compile' and
+;; `sx-filter-get-var', respectively.
+
+;;; Code:
+
+\f
+;;; Dependencies
+
+(require 'sx)
+(require 'sx-cache)
+(require 'sx-request)
+
+\f
+;;; Customizations
+
+(defvar sx--filter-alist
+ nil
+ "An alist of known filters. See `sx-filter-compile'.
+Structure:
+
+ (((INCLUDE EXCLUDE BASE ) . \"compiled filter \")
+ ((INCLUDE2 EXCLUDE2 BASE2) . \"compiled filter2\")
+ ...)")
+
+\f
+;;; Creation
+(defmacro sx-filter-from-nil (included)
+ "Create a filter data structure with INCLUDED fields.
+All wrapper fields are included by default."
+ `(quote
+ ((,@(sx--tree-expand
+ (lambda (path)
+ (intern (mapconcat #'symbol-name path ".")))
+ included)
+ .backoff
+ .error_id
+ .error_message
+ .error_name
+ .has_more
+ .items
+ .page
+ .page_size
+ .quota_max
+ .quota_remaining
+ )
+ nil nil)))
+
+;;; @TODO allow BASE to be a precompiled filter name
+(defun sx-filter-compile (&optional include exclude base)
+ "Compile INCLUDE and EXCLUDE into a filter derived from BASE.
+INCLUDE and EXCLUDE must both be lists; BASE should be a symbol.
+
+Returns the compiled filter as a string."
+ (let ((keyword-arguments
+ `((include . ,(if include (sx--thing-as-string include)))
+ (exclude . ,(if exclude (sx--thing-as-string exclude)))
+ (base . ,(if base base)))))
+ (let ((result (elt (sx-request-make "filter/create" keyword-arguments) 0)))
+ (sx-assoc-let result
+ .filter))))
+
+\f
+;;; Storage and Retrieval
+
+(defun sx-filter-get-var (filter-variable)
+ "Return the string representation of FILTER-VARIABLE."
+ (apply #'sx-filter-get filter-variable))
+
+(defun sx-filter-get (&optional include exclude base)
+ "Return the string representation of the given filter.
+
+If the filter data exists in `sx--filter-alist', that value will
+be returned. Otherwise, compile INCLUDE, EXCLUDE, and BASE into
+a filter with `sx-filter-compile' and push the association onto
+`sx--filter-alist'. Re-cache the alist with `sx-cache-set' and
+return the compiled filter."
+ (unless sx--filter-alist
+ (setq sx--filter-alist (sx-cache-get 'filter)))
+ (or (cdr (assoc (list include exclude base) sx--filter-alist))
+ (let ((filter (sx-filter-compile include exclude base)))
+ (when filter
+ (push (cons (list include exclude base) filter) sx--filter-alist)
+ (sx-cache-set 'filter sx--filter-alist)
+ filter))))
+
+\f
+;;; Browsing filter
+(defconst sx-browse-filter
+ (sx-filter-from-nil
+ ((question body_markdown
+ bounty_amount
+ comments
+ creation_date
+ closed_reason
+ closed_date
+ closed_details
+ answers
+ answer_count
+ score
+ title
+ owner
+ tags
+ last_editor
+ last_activity_date
+ accepted_answer_id
+ link
+ upvoted
+ downvoted
+ question_id
+ share_link)
+ (user display_name
+ link
+ accept_rate
+ reputation)
+ (shallow_user display_name
+ link
+ accept_rate
+ reputation)
+ (comment owner
+ body_markdown
+ body
+ link
+ edited
+ creation_date
+ upvoted
+ score
+ post_type
+ post_id
+ comment_id)
+ (answer answer_id
+ creation_date
+ last_editor
+ last_activity_date
+ link
+ share_link
+ score
+ owner
+ body_markdown
+ upvoted
+ downvoted
+ comments)))
+ "The filter applied when retrieving question data.
+See `sx-question-get-questions' and `sx-question-get-question'.")
+
+(provide 'sx-filter)
+;;; sx-filter.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-inbox.el --- base inbox logic -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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)
+(require 'sx-interaction)
+
+\f
+;;; API
+(defconst 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)
+
+(defface sx-inbox-item-type
+ '((t :inherit font-lock-keyword-face)) "")
+
+(defface sx-inbox-item-type-unread
+ '((t :inherit font-lock-keyword-face :weight bold)) "")
+
+(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
+ :page page
+ :filter sx-inbox-filter))
+
+\f
+;;; 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.")
+
+(defconst 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.")
+
+(defconst 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))
+
+\f
+;;; 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)
+ ))
+
+\f
+;;; 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:")
+ (t ":")))
+ 'face (if .is_unread 'sx-inbox-item-type-unread 'sx-inbox-item-type))
+ (list
+ (concat (sx-time-since .creation_date)
+ sx-question-list-ago-string)
+ 'face 'sx-question-list-date)
+ (list
+ (propertize " " 'display
+ (concat " " (propertize (or .title "") 'face 'sx-question-list-date) "\n"
+ (when .body
+ (let ((col fill-column))
+ (with-temp-buffer
+ (setq fill-column col)
+ (insert " " .body)
+ (fill-region (point-min) (point-max))
+ (buffer-string))))
+ "\n" ) 'face (if .is_unread 'bold 'default) ))))))
+
+\f
+;;; Entry commands
+(defvar sx-inbox--buffer nil
+ "Buffer being used to display inbox.")
+
+;;;###autoload
+(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))))
+
+;;;###autoload
+(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:
--- /dev/null
+;;; sx-interaction.el --- voting, commenting, and other interaction -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 holds a series of functions for performing arbitrary
+;; interactions with arbitrary objects (objects here always mean the
+;; alist of a question, answer, or comment). All commands take at
+;; least a DATA argument corresponding to the object which, when
+;; called interactively, is always derived from the context at point
+;; (usually using the `sx--data-here' function).
+;;
+;; Interactions represented here involve voting, commenting, asking,
+;; answering, editing.
+;;
+;; These are commands are meant to be available throughout the
+;; interface. So it didn't make sense to put them in a specific
+;; module. They also rely on a lot of dependencies, so they couldn't
+;; be put in sx.el.
+
+\f
+;;; Code:
+(eval-when-compile
+ '(require 'cl-lib))
+
+(require 'sx)
+(require 'sx-question)
+(require 'sx-question-mode)
+(require 'sx-question-list)
+(require 'sx-compose)
+(require 'sx-cache)
+
+\f
+;;; Using data in buffer
+(defun sx--data-here (&optional type noerror)
+ "Get the alist regarding object under point of type TYPE.
+Looks at the text property `sx--data-here'. If it's not set, it
+looks at a few other reasonable variables. If those fail too, it
+throws an error.
+
+TYPE is a symbol restricting the type of object desired. Possible
+values are 'question, 'answer, 'comment, or nil (for any type).
+
+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 data
+ ;; Is data of the right type?
+ (cl-case type
+ (question (when .title data))
+ (answer (when .answer_id data))
+ (comment (when .comment_id data))))))
+ ;; The following two only ever return questions.
+ (when (or (null type) (eq type 'question))
+ ;; @TODO: `sx-question-list-mode' may one day display answers.
+ ;; Ideally, it would use the `sx--data-here' (so no special
+ ;; handling would be necessary.
+ (or (and (derived-mode-p 'sx-question-list-mode)
+ (tabulated-list-get-id))
+ (and (derived-mode-p 'sx-question-mode)
+ sx-question-mode--data)))
+ ;; Nothing was found
+ (and (null noerror)
+ (error "No %s found here" (or type "data")))))
+
+(defun sx--marker-to-data (marker &rest rest)
+ "Get the data at MARKER.
+REST is passed to `sx--data-here'."
+ (save-excursion
+ (goto-char marker)
+ (apply #'sx--data-here rest)))
+
+(defun sx--error-if-unread (data)
+ "Throw a user-error if DATA is an unread question.
+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)))
+ (sx-user-error "Question not yet read. View it before acting on it")
+ data))
+
+(defun sx--maybe-update-display (&optional buffer site id)
+ "Refresh whatever is displayed in BUFFER or the current buffer.
+If BUFFER is not live, nothing is done.
+
+If SITE is given but ID isn't, only update if BUFFER appears to
+be a question-list displaying SITE.
+If both SITE and ID are given, only update if BUFFER appears to
+be a question matching SITE and ID."
+ (setq buffer (or buffer (current-buffer)))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (cond ((derived-mode-p 'sx-question-list-mode)
+ (when (or (not site)
+ (and (not id)
+ (string= site sx-question-list--site)))
+ (sx-question-list-refresh 'redisplay 'no-update)))
+ ((derived-mode-p 'sx-question-mode)
+ (when (or (not site)
+ (and id
+ (equal
+ (let-alist (sx--data-here 'question)
+ (cons .site_par .question_id))
+ (cons site id))))
+ (sx-question-mode-refresh 'no-update)))))))
+
+(defun sx--copy-data (from to)
+ "Copy all fields of alist FORM onto TO.
+Only fields contained in TO are copied."
+ (setcar to (car from))
+ (setcdr to (cdr from)))
+
+(defun sx-ensure-authentication ()
+ "Signal user-error if the user refuses to authenticate.
+Note that `sx-method-call' already does authentication checking.
+This function is meant to be used by commands that don't
+immediately perform method calls, such as `sx-ask'. This way,
+the unauthenticated user will be prompted before going through
+the trouble of composing an entire question."
+ (unless (sx-cache-get 'auth)
+ (if (y-or-n-p "This command requires authentication, would you like to authenticate? ")
+ (sx-authenticate)
+ (sx-user-error "This command requires authentication, please run `M-x sx-authenticate' and try again."))))
+
+(defmacro sx--make-update-callback (&rest body)
+ "Return a function that runs BODY and updates display.
+`sx--maybe-update-display' is only called if the buffer where the
+function was created still exists. In that case, BODY is also
+run in this buffer."
+ (declare (debug t))
+ `(let ((buffer (current-buffer)))
+ (lambda (result)
+ ;; See http://emacs.stackexchange.com/a/10725/50
+ (ignore result)
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ ,@body
+ (sx--maybe-update-display))
+ ,@body))))
+
+(defun sx--copy-update-callback (data)
+ "Return a function that overwrites DATA and updates display.
+First, DATA is destructively overwritten with the car of the
+argument passed to the function. Then,
+`sx--maybe-update-display' is called in the original buffer."
+ (sx--make-update-callback
+ ;; The api returns the new DATA.
+ (when result
+ (sx--copy-data (elt result 0) data))))
+
+\f
+;;; Visiting
+(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.
+
+If copy-as-kill is non-nil, do not call `browse-url'.
+Instead, copy the link as a new kill with `kill-new'.
+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
+ (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)))))
+
+;;;###autoload
+(defun sx-open-link (link &optional _)
+ "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))))
+ ;; For now, we have no chance of handling chat links, let's just
+ ;; send them to the browser.
+ (if (string-match (rx string-start "http" (opt "s") "://chat.") link)
+ (sx-visit-externally link)
+ (let ((data (sx--link-to-data link)))
+ (sx-assoc-let data
+ (cl-case .type
+ (comment
+ (sx-display-question
+ (sx-question-get-from-comment .site_par .id) 'focus)
+ (sx--find-in-buffer 'comment .id))
+ (answer
+ (sx-display-question
+ (sx-question-get-from-answer .site_par .id) 'focus)
+ (sx--find-in-buffer 'answer .id))
+ (question
+ (sx-display-question
+ (sx-question-get-question .site_par .id) 'focus))
+ (t (error "Don't know how to open this link, please file a bug report: %s"
+ link)
+ nil))))))
+
+;;;###autoload
+(defun sx-org-get-link ()
+ "Add a link to this post to Org's memory."
+ (when (memq major-mode '(sx-question-mode sx-question-list-mode))
+ (sx-assoc-let (sx--data-here)
+ (when .link
+ (org-store-link-props :type 'http
+ :link .link
+ :description .title)))))
+
+(eval-after-load "org"
+ '(cond
+ ((fboundp 'org-link-set-parameters)
+ (org-link-set-parameters
+ "sx" :store #'sx-org-get-link))
+ ((boundp 'org-store-link-functions)
+ (add-to-list 'org-store-link-functions
+ #'sx-org-get-link))))
+
+\f
+;;; 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
+ ;; This is an attempt to identify when we have the question
+ ;; object itself, so there's no need to fetch anything. This
+ ;; happens inside the question-list, but it can be easily
+ ;; confused with the inbox (whose items have a title, a body, and
+ ;; a question_id).
+ ((and .title .question_id .score
+ (not .item_type) (not .notification_type))
+ (sx-display-question data 'focus))
+ (.answer_id
+ (sx-display-question
+ (sx-question-get-from-answer .site_par .answer_id)
+ 'focus)
+ (if .comment_id
+ (sx--find-in-buffer 'comment .comment_id)
+ (sx--find-in-buffer 'answer .answer_id)))
+ (.question_id
+ (sx-display-question
+ (sx-question-get-question .site_par .question_id) 'focus)
+ (when .comment_id
+ (sx--find-in-buffer 'comment .comment_id)))
+ ;; `sx-question-get-from-comment' takes 2 api requests, so we
+ ;; test it last.
+ (.comment_id
+ (sx-display-question
+ (sx-question-get-from-comment .site_par .comment_id) 'focus)
+ (sx--find-in-buffer 'comment .comment_id))
+ (.notification_type
+ (sx-message "Viewing notifications is not yet implemented"))
+ (.item_type (sx-open-link .link)))))
+
+(defun sx-display-question (&optional data focus window)
+ "Display question given by DATA, on WINDOW.
+Interactively, display question under point. When FOCUS is
+non-nil (the default when called interactively), also focus the
+relevant window.
+
+If WINDOW nil, the window is decided by
+`sx-question-mode-display-buffer-function'."
+ (interactive (list (sx--data-here 'question) t))
+ (when (sx-question--mark-read data)
+ (sx--maybe-update-display))
+ ;; Display the question.
+ (setq window
+ (get-buffer-window
+ (sx-question-mode--display data window)))
+ (when focus
+ (if (window-live-p window)
+ (select-window window)
+ (switch-to-buffer sx-question-mode--buffer))))
+
+\f
+;;; Simple interactions
+(defun sx-favorite (data &optional undo)
+ "Favorite question given by DATA.
+Interactively, it is guessed from context at point.
+With the UNDO prefix argument, unfavorite the question instead."
+ (interactive (list (sx--error-if-unread (sx--data-here 'question))
+ current-prefix-arg))
+ (sx-method-post-from-data data
+ (if undo 'favorite/undo 'favorite)
+ :callback (sx--copy-update-callback data)))
+(defalias 'sx-star #'sx-favorite)
+
+(defun sx-accept (data &optional undo)
+ "Accept answer given by DATA.
+Interactively, it is guessed from context at point.
+With the UNDO prefix argument, unaccept the question instead."
+ (interactive (list (sx--data-here 'answer)
+ current-prefix-arg))
+ (sx-ensure-authentication)
+ ;; When clicking the "Accept" button, first arg is a marker.
+ (when (markerp data)
+ (setq data (sx--marker-to-data data 'answer)))
+ (sx-method-post-from-data data
+ (if undo 'accept/undo 'accept)
+ :callback (sx--copy-update-callback data)))
+
+\f
+;;; Voting
+(defun sx-upvote (data &optional undo)
+ "Upvote an object given by DATA.
+DATA can be a question, answer, or comment. Interactively, it is
+guessed from context at point.
+With UNDO prefix argument, remove upvote instead of applying it."
+ (interactive (list (sx--error-if-unread (sx--data-here))
+ current-prefix-arg))
+ (sx-set-vote data "upvote" (not undo)))
+
+(defun sx-downvote (data &optional undo)
+ "Downvote an object given by DATA.
+DATA can be a question or an answer. Interactively, it is guessed
+from context at point.
+With UNDO prefix argument, remove downvote instead of applying it."
+ (interactive (list (sx--error-if-unread (sx--data-here))
+ current-prefix-arg))
+ (sx-set-vote data "downvote" (not undo)))
+
+(defun sx-set-vote (data type status)
+ "Set the DATA's vote TYPE to STATUS.
+DATA can be a question, answer, or comment. TYPE can be
+\"upvote\" or \"downvote\". STATUS is a boolean.
+
+Besides posting to the api, DATA is also altered to reflect the
+changes."
+ (sx-ensure-authentication)
+ (sx-method-post-from-data data
+ (concat type (unless status "/undo"))
+ :callback (sx--copy-update-callback data)))
+
+\f
+;;; Delete
+(defun sx-delete (data &optional undo)
+ "Delete an object given by DATA.
+DATA can be a question, answer, or comment. Interactively, it is
+guessed from context at point.
+With UNDO prefix argument, undelete instead."
+ (interactive (list (sx--error-if-unread (sx--data-here))
+ current-prefix-arg))
+ (sx-ensure-authentication)
+ (when (y-or-n-p (format "DELETE this %s? "
+ (let-alist data
+ (cond (.comment_id "comment")
+ (.answer_id "answer")
+ (.question_id "question")))))
+ (sx-method-post-from-data data
+ (if undo 'delete/undo 'delete)
+ :callback (sx--make-update-callback
+ ;; Indicate to ourselves this has been deleted.
+ (setcdr data (cons (car data) (cdr data)))
+ (setcar data 'deleted)))))
+
+\f
+;;; Commenting
+(defun sx-comment (data &optional text)
+ "Post a comment on DATA given by TEXT.
+DATA can be a question, an answer, or a comment. Interactively,
+it is guessed from context at point.
+If DATA is a comment, the comment is posted as a reply to it.
+
+TEXT is a string. Interactively, it is read from the minibufer."
+ (interactive (list (sx--error-if-unread (sx--data-here)) 'query))
+ (sx-ensure-authentication)
+ ;; When clicking the "Add a Comment" button, first arg is a marker.
+ (when (markerp data)
+ (setq data (sx--marker-to-data data))
+ (setq text 'query))
+ (sx-assoc-let data
+ ;; Get the comment text
+ (when (eq text 'query)
+ (setq text (read-string
+ "Comment text: "
+ (when .comment_id
+ (substring-no-properties (sx-user--format "%@ " .owner)))))
+ (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"))
+ ;; And post
+ (let ((result
+ (sx-method-call 'posts
+ :id (or .post_id .answer_id .question_id)
+ :submethod "comments/add"
+ :auth 'warn
+ :url-method 'post
+ :filter sx-browse-filter
+ :site .site_par
+ :keywords `((body . ,text)))))
+ ;; The api returns the new DATA.
+ (when result
+ (sx--add-comment-to-object
+ (sx--ensure-owner-in-object (list (cons 'display_name "(You)")) (elt result 0))
+ (if .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'.
+SITE is a string.
+ID is an integer."
+ (let ((db (cons sx-question-mode--data
+ sx-question-list--dataset)))
+ (setq db
+ (cond
+ ((string= type "question") db)
+ ((string= type "answer")
+ (apply #'cl-map 'list #'identity
+ (mapcar (lambda (x) (cdr (assoc 'answers x))) db)))))
+ (car (cl-member-if
+ (lambda (x) (sx-assoc-let x
+ (and (equal (or .answer_id .question_id) id)
+ (equal .site_par site))))
+ db))))
+
+(defun sx--add-comment-to-object (comment object)
+ "Add COMMENT to OBJECT's `comments' property.
+OBJECT can be a question or an answer."
+ (let ((com-cell (assoc 'comments object)))
+ (if com-cell
+ (progn
+ (setcdr
+ com-cell
+ (append (cdr com-cell)
+ (list comment))))
+ ;; No previous comments, add it manually.
+ (setcdr object (cons (car object) (cdr object)))
+ (setcar object `(comments . (,comment)))))
+ object)
+
+(defun sx--ensure-owner-in-object (owner object)
+ "Add `owner' property with value OWNER to OBJECT."
+ (unless (cdr-safe (assq 'owner object))
+ (setcdr object (cons (car object) (cdr object)))
+ (setcar object `(owner . ,owner)))
+ object)
+
+\f
+;;; Editing
+(defun sx-edit (data)
+ "Start editing an answer or question given by DATA.
+DATA is an answer or question alist. Interactively, it is guessed
+from context at point."
+ (interactive (list (sx--data-here)))
+ (sx-ensure-authentication)
+ ;; If we ever make an "Edit" button, first arg is a marker.
+ (when (markerp data) (setq data (sx--data-here)))
+ (sx-assoc-let data
+ (let ((buffer (current-buffer)))
+ (pop-to-buffer
+ (sx-compose-create
+ .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)
+ (sx--maybe-update-display buffer))))))))
+
+\f
+;;; 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--interactive-site-prompt)))
+ (sx-ensure-authentication)
+ (let ((buffer (current-buffer)))
+ (pop-to-buffer
+ (sx-compose-create
+ site nil nil
+ ;; After send functions
+ (list (lambda (_b _res) (sx--maybe-update-display buffer)))))))
+
+\f
+;;; Answering
+(defun sx-answer (data)
+ "Start composing an answer for question given by DATA.
+DATA is a question alist. Interactively, it is guessed from
+context at point. "
+ ;; If the user tries to answer a question that's not viewed, he
+ ;; probably hit the button by accident.
+ (interactive
+ (list (sx--error-if-unread (sx--data-here 'question))))
+ (sx-ensure-authentication)
+ ;; When clicking the "Write an Answer" button, first arg is a marker.
+ (when (markerp data) (setq data (sx--data-here)))
+ (let ((buffer (current-buffer)))
+ (sx-assoc-let data
+ (pop-to-buffer
+ (sx-compose-create
+ .site_par .question_id nil
+ ;; After send functions
+ (list (lambda (_ res)
+ (sx--add-answer-to-question-object (elt res 0) data)
+ (sx--maybe-update-display buffer .site_par .question_id))))))))
+
+(defun sx--add-answer-to-question-object (answer question)
+ "Add alist ANSWER to alist QUESTION in the right place."
+ (let ((cell (assoc 'answers question)))
+ (if cell
+ (setcdr cell (append (cdr cell) (list answer)))
+ ;; No previous comments, add it manually.
+ (setcdr question (cons (car question) (cdr question)))
+ (setcar question `(answers . (,answer))))
+ question))
+
+(provide 'sx-interaction)
+;;; sx-interaction.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-load.el --- load all files of the SX package -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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-switchto
+ sx-tab
+ sx-tag
+ ))
+
+(provide 'sx-load)
+;;; sx-load.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-method.el --- method calls -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 is effectively a common-use wrapper for
+;;; `sx-request-make'. It provides higher-level handling such as
+;;; (authentication, filters, ...) that `sx-request-make' doesn't need
+;;; to handle.
+
+;;; Code:
+(require 'json)
+(require 'url)
+(require 'sx)
+(require 'sx-auth)
+(require 'sx-request)
+(require 'sx-filter)
+
+(cl-defun sx-method-call (method &key id
+ submethod
+ keywords
+ page
+ (pagesize 100)
+ (filter '(()))
+ auth
+ (url-method 'get)
+ get-all
+ (process-function
+ #'sx-request-response-get-items)
+ callback
+ site)
+ "Call METHOD with additional keys.
+
+ID is the id associated with a question, answer, comment, post or
+user.
+SUBMETHOD is the additional segments of the method.
+KEYWORDS are the api parameters. Some parameters have their own
+keywords too, for convenience. The KEYWORDS argument overrides
+parameter specific keywords.
+FILTER is the set of filters to control the returned information
+AUTH defines how to act if the method or filters require
+authentication.
+URL-METHOD is either `post' or `get'
+SITE is the api parameter specifying the site.
+GET-ALL is nil or non-nil
+PROCESS-FUNCTION is a response-processing function
+PAGE is the page number which will be requested
+PAGESIZE is the number of items to retrieve per request, default
+100
+CALLBACK is a function to be called if the request succeeds. It
+is given the returned result as an argument.
+
+When AUTH is nil, it is assumed that no auth-requiring filters or
+methods will be used. If they are an error will be signaled. This is
+to ensure awareness of where auth is needed.
+
+When AUTH Is t, filters will automatically use a non-auth subset if
+no `access_token' is available. Methods requiring auth will instead
+use `sx-request-fallback' rather than have a failed API response.
+This is meant to allow for UI pages where portions may require AUTH
+but could still be used without authenticating (i.e a launch/home page).
+
+When AUTH is 'warn, methods will signal a `user-error'. This is meant
+for interactive commands that absolutely require authentication
+\(submitting questions/answers, reading inbox, etc). Filters will
+treat 'warn as equivalent to t.
+
+If GET-ALL is nil, this method will only return the first (or
+specified) page available from this method call. If t, all pages
+will be retrieved (`sx-request-all-stop-when-no-more') .
+Otherwise, it is a function STOP-WHEN for `sx-request-all-items'.
+
+If PROCESS-FUNCTION is nil, only the items of the response will
+be returned (`sx-request-response-get-items'). Otherwise, it is
+a function that processes the entire response (as returned by
+`json-read').
+
+See `sx-request-make' and `sx-request-all-items'.
+
+Return the entire response as a complex alist."
+ (declare (indent 1))
+ (let ((access-token (sx-cache-get 'auth))
+ (method-auth (sx-auth--method-p method submethod))
+ (filter-auth (sx-auth--filter-p filter))
+ (full-method (concat (format "%s" method)
+ (when id
+ (format "/%s" id))
+ (when submethod
+ (format "/%s" submethod))
+ ;; On GET methods site is buggy, so we
+ ;; need to provide it as a url argument.
+ (when (and site (eq url-method 'get))
+ (prog1
+ (format "?site=%s" site)
+ (setq site nil)))))
+ (call (if get-all #'sx-request-all-items #'sx-request-make))
+ (get-all
+ (cond
+ ((eq get-all t) #'sx-request-all-stop-when-no-more)
+ (t get-all))))
+ (lwarn '(sx-call-method) :debug "A: %S T: %S. M: %S,%s. F: %S" (equal 'warn auth)
+ access-token method-auth full-method filter-auth)
+ (unless access-token
+ (cond
+ ;; 1. Need auth and warn user (interactive use)
+ ((and method-auth (equal 'warn auth))
+ (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))
+ ;; 3. Need auth for type. Use auth-less filter.
+ ((and filter-auth auth)
+ (setq filter filter-auth))
+ ;; 4. Requires auth but no value set for auth
+ ((and (or filter-auth method-auth) (not auth))
+ (error "This request requires authentication."))))
+ ;; Concatenate all parameters now that filter is ensured.
+ (push `(filter . ,(sx-filter-get-var filter)) keywords)
+ (unless (assq 'page keywords)
+ (push `(page . ,page) keywords))
+ (unless (assq 'pagesize keywords)
+ (push `(pagesize . ,pagesize) keywords))
+ (when site
+ (push `(site . ,site) keywords))
+ (let ((result (funcall call
+ full-method
+ keywords
+ url-method
+ (or get-all process-function))))
+ (when callback
+ (funcall callback result))
+ result)))
+
+(defun sx-method-post-from-data (data &rest keys)
+ "Make a POST `sx-method-call', deriving parameters from DATA.
+KEYS are [KEYWORD VALUE] pairs passed to `sx-method-call', except
+the following which are decided by this function:
+
+ METHOD :site and :id are derived from DATA, where METHOD is
+ either \"answers\", \"comments\", or \"questions\".
+ :url-method is post.
+ :filter is `sx-browse-filter'.
+ :auth is warn.
+
+As a special exception, if the car of KEYS is not a keyword, it
+is assumed to be the :submethod argument."
+ (declare (indent 1))
+ (sx-assoc-let data
+ (apply #'sx-method-call
+ (cond (.comment_id "comments")
+ (.answer_id "answers")
+ (.question_id "questions"))
+ :id (or .comment_id .answer_id .question_id)
+ :auth 'warn
+ :url-method 'post
+ :filter sx-browse-filter
+ :site .site_par
+ (if (keywordp (car keys))
+ keys
+ (cons :submethod keys)))))
+
+(provide 'sx-method)
+;;; sx-method.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-networks.el --- user network information -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 provides logic for retrieving information about the user
+;; across the entire network, e.g. their registered sites.
+
+;;; Code:
+
+(require 'sx-method)
+(require 'sx-cache)
+(require 'sx-site)
+(require 'sx-filter)
+
+(defvar sx-network--user-information nil
+ "User information for the various sites.")
+
+(defvar sx-network--user-information-alist nil
+ "User information for the various site parameters.")
+
+(defvar sx-network--user-sites nil
+ "List of sites where user already has an account.")
+
+(defconst sx-network--user-filter
+ (sx-filter-from-nil
+ ((badge_count bronze
+ silver
+ gold)
+ (network_user account_id
+ answer_count
+ badge_counts
+ creation_date
+ last_access_date
+ reputation
+ site_name
+ site_url
+ user_id
+ user_type))))
+
+(defun sx-network--get-associated ()
+ "Retrieve cached information for network user.
+If cache is not available, retrieve current data."
+ (unless (setq sx-network--user-information (sx-cache-get 'network-user))
+ (sx-network--update))
+ (let ((url-par-alist (mapcar (lambda (x)
+ (cons (cdr (assoc 'site_url x))
+ (cdr (assoc 'api_site_parameter
+ x))))
+ (sx-site--get-site-list))))
+ (setq sx-network--user-sites nil)
+ (setq sx-network--user-information-alist nil)
+ (mapc (lambda (nu)
+ (let ((parameter (cdr (assoc (cdr (assq 'site_url nu))
+ url-par-alist))))
+ (push parameter sx-network--user-sites)
+ (push (cons parameter nu)
+ sx-network--user-information-alist)))
+ sx-network--user-information)))
+
+(defun sx-network--update ()
+ "Update user information.
+Sets cache and then uses `sx-network--get-associated' to update
+the variables."
+ (setq sx-network--user-information
+ (sx-method-call 'me
+ :submethod 'associated
+ :keywords '((types . (main_site meta_site)))
+ :filter sx-network--user-filter
+ :auth t))
+ (sx-cache-set 'network-user sx-network--user-information))
+
+(defun sx-network--initialize ()
+ "Ensure network-user cache is available.
+Added as hook to initialization."
+ ;; Cache was not retrieved, retrieve it.
+ (sx-network--get-associated))
+(add-hook 'sx-init--internal-hook #'sx-network--initialize)
+
+(defun sx-network-user (site)
+ "Return an alist containing user information for SITE."
+ (cdr (assoc site sx-network--user-information-alist)))
+
+(provide 'sx-networks)
+;;; sx-networks.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-notify.el --- mode-line notifications -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
+
+\f
+;;; Code:
+
+(require 'sx)
+(require 'sx-inbox)
+
+\f
+;;; mode-line notification
+(defconst 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)
+
+\f
+;;; 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))
+ (sx-inbox-get)))
+ (setq sx-inbox--unread-notifications
+ (cl-remove-if
+ (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-notifications))
+ (sx-inbox-get t))))
+
+(provide 'sx-notify)
+;;; sx-notify.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+(define-package "sx" "20220804.1419" "StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes"
+ '((emacs "24.1")
+ (cl-lib "0.5")
+ (json "1.3")
+ (markdown-mode "2.0")
+ (let-alist "1.0.3"))
+ :commit "c58405f9ff27b9740997ea837a1f6fd173d1edc5" :authors
+ '(("Sean Allred" . "codeNOSPAMseanallred.com"))
+ :maintainers
+ '(("Sean Allred" . "codeNOSPAMseanallred.com"))
+ :maintainer
+ '("Sean Allred" . "codeNOSPAMseanallred.com")
+ :keywords
+ '("help" "hypermedia" "tools")
+ :url "https://github.com/vermiculus/sx.el/")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; sx-question-list.el --- major-mode for navigating questions list -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
+
+;; Provides question list logic (as used in e.g. `sx-tab-frontpage').
+
+;;; Code:
+(require 'tabulated-list)
+(require 'cl-lib)
+
+(require 'sx)
+(require 'sx-switchto)
+(require 'sx-time)
+(require 'sx-tag)
+(require 'sx-site)
+(require 'sx-question)
+(require 'sx-question-mode)
+(require 'sx-favorites)
+
+(defgroup sx-question-list nil
+ "Customization group for sx-question-list."
+ :prefix "sx-question-list-"
+ :tag "SX Question List"
+ :group 'sx)
+
+(defgroup sx-question-list-faces nil
+ "Customization group for the faces of `sx-question-list'."
+ :prefix "sx-question-list-"
+ :tag "SX Question List Faces"
+ :group 'sx-question-list)
+
+\f
+;;; Customization
+(defcustom sx-question-list-height 12
+ "Height, in lines, of SX's *question-list* buffer."
+ :type 'integer
+ :group 'sx-question-list)
+
+(defcustom sx-question-list-excluded-tags nil
+ "List of tags (strings) to be excluded from the question list."
+ :type '(repeat string)
+ :group 'sx-question-list)
+
+(defface sx-question-list-parent
+ '((t :inherit default))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-answers
+ '((((background light)) :foreground "SeaGreen4"
+ :height 1.0 :inherit sx-question-list-parent)
+ (((background dark)) :foreground "#D1FA71"
+ :height 1.0 :inherit sx-question-list-parent)
+ (t :inherit sx-question-list-parent))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-answers-accepted
+ '((t :box 1 :inherit sx-question-list-answers))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-score
+ '((t :height 1.0 :inherit sx-question-list-parent))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-score-upvoted
+ '((t :weight bold
+ :inherit sx-question-list-score))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-date
+ '((t :inherit font-lock-comment-face))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-read-question
+ '((t :height 1.0 :inherit sx-question-list-parent))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-unread-question
+ '((t :weight bold :inherit sx-question-list-read-question))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-favorite
+ '((t :inherit sx-question-list-score-upvoted))
+ ""
+ :group 'sx-question-list-faces)
+
+(defface sx-question-list-bounty
+ '((t :inherit font-lock-warning-face))
+ ""
+ :group 'sx-question-list-faces)
+
+\f
+;;; Backend variables
+
+(defvar sx-question-list--site nil
+ "Site being displayed in the *question-list* buffer.")
+(make-variable-buffer-local 'sx-question-list--site)
+
+(defvar sx-question-list--order nil
+ "Order being displayed in the *question-list* buffer.
+This is also affected by `sx-question-list--descending'.")
+(make-variable-buffer-local 'sx-question-list--order)
+
+(defvar sx-question-list--descending t
+ "In which direction should `sx-question-list--order' be sorted.
+If non-nil (default), descending.
+If nil, ascending.")
+(make-variable-buffer-local 'sx-question-list--order)
+
+(defvar sx-question-list--print-function #'sx-question-list--print-info
+ "Function to convert a question alist into a tabulated-list entry.
+Used by `sx-question-list-mode', the default value is
+`sx-question-list--print-info'.
+
+If this is set to a different value, it may be necessary to
+change `tabulated-list-format' accordingly.")
+(make-variable-buffer-local 'sx-question-list--print-function)
+
+(defcustom sx-question-list-ago-string " ago"
+ "String appended to descriptions of the time since something happened.
+Used in the questions list to indicate a question was updated
+\"4d ago\"."
+ :type 'string
+ :group 'sx-question-list)
+
+(defun sx-question-list--print-info (question-data)
+ "Convert `json-read' QUESTION-DATA into tabulated-list format.
+
+This is the default printer used by `sx-question-list'. It
+assumes QUESTION-DATA is an alist containing (at least) the
+elements:
+ `question_id', `site_par', `score', `upvoted', `answer_count',
+ `title', `bounty_amount', `bounty_amount', `bounty_amount',
+ `last_activity_date', `tags', `owner'.
+
+Also see `sx-question-list-refresh'."
+ (sx-assoc-let question-data
+ (let ((favorite (if (member .question_id
+ (assoc .site_par
+ sx-favorites--user-favorite-list))
+ (if (char-displayable-p ?\x2b26) "\x2b26" "*") " ")))
+ (list
+ question-data
+ (vector
+ (list (int-to-string .score)
+ 'face (if .upvoted 'sx-question-list-score-upvoted
+ 'sx-question-list-score))
+ (list (int-to-string .answer_count)
+ 'face (if (sx-question--accepted-answer-id question-data)
+ 'sx-question-list-answers-accepted
+ 'sx-question-list-answers))
+ (concat
+ ;; First line
+ (propertize
+ .title
+ 'face (if (sx-question--read-p question-data)
+ 'sx-question-list-read-question
+ 'sx-question-list-unread-question))
+ (propertize " " 'display "\n ")
+ ;; Second line
+ (propertize favorite 'face 'sx-question-list-favorite)
+ (if (and (numberp .bounty_amount) (> .bounty_amount 0))
+ (propertize (format "%4d" .bounty_amount)
+ 'face 'sx-question-list-bounty)
+ " ")
+ " "
+ (propertize (format "%3s%s"
+ (sx-time-since .last_activity_date)
+ sx-question-list-ago-string)
+ 'face 'sx-question-list-date)
+ " "
+ ;; @TODO: Make this width customizable. (Or maybe just make
+ ;; the whole thing customizable)
+ (format "%-40s" (sx-tag--format-tags .tags sx-question-list--site))
+ " "
+ (sx-user--format "%15d %4r" .owner)
+ (propertize " " 'display "\n")))))))
+
+(defvar sx-question-list--pages-so-far 0
+ "Number of pages currently being displayed.
+This variable gets reset to 0 before every refresh.
+It should be used by `sx-question-list--next-page-function'.")
+(make-variable-buffer-local 'sx-question-list--pages-so-far)
+
+(defvar sx-question-list--refresh-function nil
+ "Function used to refresh the list of questions to be displayed.
+Used by `sx-question-list-mode', this is a function, called with
+no arguments, which returns a list questions to be displayed,
+like the one returned by `sx-question-get-questions'.
+
+If this is not set, the value of `sx-question-list--dataset' is
+used, and the list is simply redisplayed.")
+(make-variable-buffer-local 'sx-question-list--refresh-function)
+
+(defvar sx-question-list--next-page-function nil
+ "Function used to fetch the next page of questions to be displayed.
+Used by `sx-question-list-mode'. This is a function, called with
+no arguments, which returns a list questions to be displayed,
+like the one returned by `sx-question-get-questions'.
+
+This function will be called when the user presses \\<sx-question-list-mode-map>\\[sx-question-list-next] at the end
+of the question list. It should either return nil (indicating
+\"no more questions\") or return a list of questions which will
+appended to the currently displayed list.
+
+If this is not set, it's the same as a function which always
+returns nil.")
+(make-variable-buffer-local 'sx-question-list--next-page-function)
+
+(defvar sx-question-list--dataset nil
+ "The logical data behind the displayed list of questions.
+This dataset contains even questions that are hidden by the user,
+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)
+
+(defconst sx-question-list--key-definitions
+ '(
+ ;; S-down and S-up would collide with `windmove'.
+ ("<down>" sx-question-list-next)
+ ("<up>" sx-question-list-previous)
+ ("RET" sx-display "Display")
+ ("n" sx-question-list-next "Navigate")
+ ("p" sx-question-list-previous "Navigate")
+ ("j" sx-question-list-view-next "Navigate")
+ ("k" sx-question-list-view-previous "Navigate")
+ ("N" sx-question-list-next-far)
+ ("P" sx-question-list-previous-far)
+ ("J" sx-question-list-next-far)
+ ("K" sx-question-list-previous-far)
+ ("g" sx-question-list-refresh)
+ ("t" sx-tab-switch "tab")
+ ("a" sx-ask "ask")
+ ("S" sx-search "Search")
+ ("s" sx-switchto-map "switch-to")
+ ("v" sx-visit-externally "visit")
+ ("u" sx-upvote)
+ ("d" sx-downvote)
+ ("h" sx-question-list-hide "hide")
+ ("m" sx-question-list-mark-read "mark-read")
+ ("*" sx-favorite)
+ )
+ "List of key definitions for `sx-question-list-mode'.
+This list must follow the form described in
+`sx--key-definitions-to-header-line'.")
+
+(defconst sx-question-list--header-line
+ (sx--key-definitions-to-header-line
+ sx-question-list--key-definitions)
+ "Header-line used on the question list.")
+
+(defvar sx-question-list--order-methods
+ '(("Recent Activity" . activity)
+ ("Creation Date" . creation)
+ ("Most Voted" . votes)
+ ("Score" . votes))
+ "Alist of possible values to be passed to the `sort' keyword.")
+(make-variable-buffer-local 'sx-question-list--order-methods)
+
+(defun sx-question-list--interactive-order-prompt (&optional prompt)
+ "Interactively prompt for a sorting order.
+PROMPT is displayed to the user. If it is omitted, a default one
+is used."
+ (let ((order (sx-completing-read
+ (or prompt "Order questions by: ")
+ (mapcar #'car sx-question-list--order-methods))))
+ (cdr-safe (assoc-string order sx-question-list--order-methods))))
+
+(defun sx-question-list--make-pager (method &optional submethod)
+ "Return a function suitable for use as a question list pager.
+Meant to be used as `sx-question-list--next-page-function'."
+ (lambda (page)
+ (sx-method-call method
+ :keywords `((page . ,page)
+ ,@(when sx-question-list--order
+ `((order . ,(if sx-question-list--descending 'desc 'asc))
+ (sort . ,sx-question-list--order))))
+ :site sx-question-list--site
+ :auth t
+ :submethod submethod
+ :filter sx-browse-filter)))
+
+\f
+;;; Mode Definition
+
+(defvar sx-question-list--current-tab "Latest"
+ ;; @TODO Other values (once we implement them) are "Top Voted",
+ ;; "Unanswered", etc.
+ "Variable describing current tab being viewed.")
+
+(defconst sx-question-list--mode-line-format
+ '(" "
+ (:propertize
+ (:eval (sx--pretty-site-parameter sx-question-list--site))
+ face mode-line-buffer-id)
+ " " mode-name ": "
+ (:propertize sx-question-list--current-tab
+ face mode-line-buffer-id)
+ " ["
+ "Unread: "
+ (:propertize
+ (:eval (sx-question-list--unread-count))
+ face mode-line-buffer-id)
+ ", "
+ "Total: "
+ (:propertize
+ (:eval (int-to-string (length tabulated-list-entries)))
+ face mode-line-buffer-id)
+ "] ")
+ "Mode-line construct to use in question-list buffers.")
+
+(define-derived-mode sx-question-list-mode
+ tabulated-list-mode "Question List"
+ "Major mode for browsing a list of questions from StackExchange.
+Letters do not insert themselves; instead, they are commands.
+
+The recommended way of using this mode is to activate it and then
+set `sx-question-list--next-page-function'. The return value of
+this function is mapped with `sx-question-list--print-function',
+so you may need to customize the latter if the former does not
+return a list of questions.
+
+The full list of variables which can be set is:
+ 1. `sx-question-list--site'
+ Set this to the name of the site if that makes sense. If it
+ doesn't leave it as nil.
+ 2. `sx-question-list--print-function'
+ Change this if the data you're dealing with is not strictly a
+ list of questions (see the doc for details).
+ 3. `sx-question-list--refresh-function'
+ This is used to populate the initial list. It is only necessary
+ if item 4 does not fit your needs.
+ 4. `sx-question-list--next-page-function'
+ This is used to fetch further questions. If item 3 is nil, it is
+ also used to populate the initial list.
+ 5. `sx-question-list--dataset'
+ This is only used if both 3 and 4 are nil. It can be used to
+ display a static list.
+ 6. `sx-question-list--order'
+ Set this to the `sort' method that should be used when
+ requesting the list, if that makes sense. If it doesn't
+ leave it as nil.
+\\<sx-question-list-mode-map>
+If none of these is configured, the behaviour is that of a
+\"Frontpage\", for the site given by
+`sx-question-list--site'.
+
+Item 2 is mandatory, but it also has a sane default which is
+usually enough.
+
+As long as one of 3, 4, or 5 is provided, the other two are
+entirely optional. Populating or refreshing the list of questions
+is done in the following way:
+ - Set `sx-question-list--pages-so-far' to 1.
+ - Call function 2.
+ - If function 2 is not given, call function 3 with argument 1.
+ - If 3 is not given use the value of 4.
+
+Adding further questions to the bottom of the list is done by:
+ - Increment `sx-question-list--pages-so-far'.
+ - Call function 3 with argument `sx-question-list--pages-so-far'.
+ - If it returns anything, append to the dataset and refresh the
+ display; otherwise, decrement `sx-question-list--pages-so-far'.
+
+If `sx-question-list--site' is given, items 3 and 4 should take it
+into consideration. The same holds for `sx-question-list--order'.
+
+\\{sx-question-list-mode-map}"
+ (hl-line-mode 1)
+ (setq mode-line-format
+ sx-question-list--mode-line-format)
+ (setq sx-question-list--pages-so-far 0)
+ (setq tabulated-list-format
+ [(" V" 3 t :right-align t)
+ (" A" 3 t :right-align t)
+ ("Title" 0 sx-question-list--date-more-recent-p)])
+ (setq tabulated-list-padding 1)
+ ;; Sorting by title actually sorts by date. It's what we want, but
+ ;; it's not terribly intuitive.
+ (setq tabulated-list-sort-key nil)
+ (add-hook 'tabulated-list-revert-hook
+ #'sx-question-list-refresh nil t)
+ ;; This is the default value, but we'll error out if the user has
+ ;; set it to nil.
+ (setq tabulated-list-use-header-line 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."
+ ;; This should be made into a (choice ...) of constants.
+ :type 'symbol
+ ;; Add a setter to protect the value.
+ :group 'sx-question-list)
+
+(sx--create-comparator sx-question-list--date-more-recent-p
+ "Non-nil if tabulated-entry A is newer than B."
+ #'> (lambda (x)
+ (cdr (assq sx-question-list-date-sort-method (car x)))))
+
+\f
+;;; Keybinds
+;; We need this quote+eval combo because `kbd' was a macro in 24.2.
+(mapc (lambda (x) (eval `(define-key sx-question-list-mode-map
+ (kbd ,(car x)) #',(cadr x))))
+ sx-question-list--key-definitions)
+
+(sx--define-conditional-key sx-question-list-mode-map "O" #'sx-question-list-order-by
+ (and (boundp 'sx-question-list--order) sx-question-list--order))
+
+(defun sx-question-list-hide (data)
+ "Hide question under point.
+Non-interactively, DATA is a question alist."
+ (interactive
+ (list (if (derived-mode-p 'sx-question-list-mode)
+ (tabulated-list-get-id)
+ (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)))
+
+(defun sx-question-list-mark-read (data)
+ "Mark as read question under point.
+Non-interactively, DATA is a question alist."
+ (interactive
+ (list (if (derived-mode-p 'sx-question-list-mode)
+ (tabulated-list-get-id)
+ (sx-user-error "Not in `sx-question-list-mode'"))))
+ (sx-question--mark-read data)
+ (sx-question-list-next 1)
+ (when (called-interactively-p 'any)
+ (sx-question-list-refresh 'redisplay 'noupdate)))
+
+(defun sx-question-list--unread-count ()
+ "Number of unread questions in current dataset, as a string."
+ (int-to-string
+ (cl-count-if-not
+ #'sx-question--read-p sx-question-list--dataset)))
+
+(defun sx-question-list--remove-excluded-tags (question-list)
+ "Return QUESTION-LIST, with some questions removed.
+Removes all questions hidden by the user, as well as those
+containing a tag in `sx-question-list-excluded-tags'."
+ (cl-remove-if (lambda (q)
+ (or (sx-question--hidden-p q)
+ (cl-intersection (let-alist q .tags)
+ sx-question-list-excluded-tags
+ :test #'string=)))
+ question-list))
+
+(defun sx-question-list-refresh (&optional redisplay no-update)
+ "Update the list of questions.
+If REDISPLAY is non-nil (or if interactive), also call `tabulated-list-print'.
+If the prefix argument NO-UPDATE is nil, query StackExchange for
+a new list before redisplaying."
+ (interactive "p\nP")
+ ;; Reset the mode-line unread count (we rebuild it here).
+ (unless no-update
+ (setq sx-question-list--pages-so-far 1))
+ (let* ((question-list
+ (or (and no-update sx-question-list--dataset)
+ (and (functionp sx-question-list--refresh-function)
+ (funcall sx-question-list--refresh-function))
+ (and (functionp sx-question-list--next-page-function)
+ (funcall sx-question-list--next-page-function 1))
+ sx-question-list--dataset))
+ ;; Preserve window positioning.
+ (window (get-buffer-window (current-buffer)))
+ (old-start (when window (window-start window))))
+ ;; The dataset contains everything. Hiding and filtering is done
+ ;; on the `tabulated-list-entries' below.
+ (setq sx-question-list--dataset question-list)
+ ;; Print the result.
+ (setq tabulated-list-entries
+ (mapcar sx-question-list--print-function
+ (sx-question-list--remove-excluded-tags
+ sx-question-list--dataset)))
+ (when redisplay
+ (tabulated-list-print 'remember))
+ (when window
+ (set-window-start window old-start)))
+ (sx-message "Done."))
+
+(defun sx-question-list-view-previous (n)
+ "Move cursor up N questions up and display this question.
+Displayed in `sx-question-mode--window', replacing any question
+that may currently be there."
+ (interactive "p")
+ (sx-question-list-view-next (- n)))
+
+(defun sx-question-list-view-next (n)
+ "Move cursor down N questions and display this question.
+Displayed in `sx-question-mode--window', replacing any question
+that may currently be there."
+ (interactive "p")
+ (sx-question-list-next n)
+ (sx-question-mode--display
+ (tabulated-list-get-id)
+ (sx-question-list--create-question-window)))
+
+(defun sx-question-list--create-question-window ()
+ "Create or find a window where a question can be displayed.
+
+If any current window displays a question, that window is
+returned. If none do, a new one is created such that the
+question-list window remains `sx-question-list-height' lines
+high (if possible)."
+ (or (sx-question-mode--get-window)
+ ;; Create a proper window.
+ (let ((window
+ (condition-case er
+ (split-window (selected-window) sx-question-list-height 'below)
+ (error
+ ;; If the window is too small to split, use any one.
+ (if (string-match
+ "Window #<window .*> too small for splitting"
+ (car (cdr-safe er)))
+ (next-window)
+ (error (cdr er)))))))
+ ;; Configure the window to be closed on `q'.
+ (set-window-prev-buffers window nil)
+ (set-window-parameter
+ window 'quit-restore
+ ;; See (info "(elisp) Window Parameters")
+ `(window window ,(selected-window) ,sx-question-mode--buffer))
+ window)))
+
+(defvar sx-question-list--last-refresh (current-time)
+ "Time of the latest refresh.")
+
+(defun sx-question-list-next (n)
+ "Move cursor down N questions.
+This does not update `sx-question-mode--window'."
+ (interactive "p")
+ (if (and (< n 0) (bobp))
+ (when (> (time-to-seconds
+ (time-subtract (current-time) sx-question-list--last-refresh))
+ 1)
+ (sx-question-list-refresh 'redisplay)
+ (setq sx-question-list--last-refresh (current-time)))
+ (forward-line n)
+ ;; If we were trying to move forward, but we hit the end.
+ (when (eobp)
+ ;; Try to get more questions.
+ (sx-question-list-next-page))
+ (sx-question-list--ensure-line-good-line-position)))
+
+(defun sx-question-list--ensure-line-good-line-position ()
+ "Scroll window such that current line is a good place.
+Check if we're at least 6 lines from the bottom. Scroll up if
+we're not. Do the same for 3 lines from the top."
+ ;; At least one entry below us.
+ (let ((lines-to-bottom (count-screen-lines (point) (window-end))))
+ (unless (>= lines-to-bottom 6)
+ (recenter (- 6))))
+ ;; At least one entry above us.
+ (let ((lines-to-top (count-screen-lines (point) (window-start))))
+ (unless (>= lines-to-top 3)
+ (recenter 3))))
+
+(defun sx-question-list-next-page ()
+ "Fetch and display the next page of questions."
+ (interactive)
+ ;; Stay at the last line.
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (functionp sx-question-list--next-page-function)
+ ;; Try to get more questions
+ (let ((list
+ (funcall sx-question-list--next-page-function
+ (1+ sx-question-list--pages-so-far))))
+ (if (null list)
+ (message "No further questions.")
+ ;; If it worked, increment the variable.
+ (cl-incf sx-question-list--pages-so-far)
+ ;; And update the dataset.
+ ;; @TODO: Check for duplicates.
+ (setq sx-question-list--dataset
+ (append sx-question-list--dataset list))
+ (sx-question-list-refresh 'redisplay 'no-update)
+ (forward-line 1)))))
+
+(defun sx-question-list-previous (n)
+ "Move cursor up N questions.
+This does not update `sx-question-mode--window'."
+ (interactive "p")
+ (sx-question-list-next (- n)))
+
+(defcustom sx-question-list-far-step-size 5
+ "How many questions `sx-question-list-next-far' skips."
+ :type 'integer
+ :group 'sx-question-list
+ :package-version '(sx-question-list . ""))
+
+(defun sx-question-list-next-far (n)
+ "Move cursor up N*`sx-question-list-far-step-size' questions.
+This does not update `sx-question-mode--window'."
+ (interactive "p")
+ (sx-question-list-next (* n sx-question-list-far-step-size)))
+
+(defun sx-question-list-previous-far (n)
+ "Move cursor up N questions.
+This does not update `sx-question-mode--window'."
+ (interactive "p")
+ (sx-question-list-next-far (- n)))
+
+(defun sx-question-list-switch-site (site)
+ "Switch the current site to SITE and display its questions.
+Retrieve completions from `sx-site-get-api-tokens'.
+Sets `sx-question-list--site' and then call
+`sx-question-list-refresh' with `redisplay'."
+ (interactive
+ (list (sx-completing-read
+ "Switch to site: " (sx-site-get-api-tokens)
+ (lambda (site) (not (equal site sx-question-list--site)))
+ t)))
+ (when (and (stringp site) (> (length site) 0))
+ (setq sx-question-list--site site)
+ (sx-question-list-refresh 'redisplay)))
+
+(defun sx-question-list-order-by (sort &optional ascend)
+ "Order questions in the current list by the method SORT.
+Sets `sx-question-list--order' and then calls
+`sx-question-list-refresh' with `redisplay'.
+
+With a prefix argument or a non-nil ASCEND, invert the sorting
+order."
+ (interactive
+ (list (when sx-question-list--order
+ (sx-question-list--interactive-order-prompt))
+ current-prefix-arg))
+ (unless sx-question-list--order
+ (sx-user-error "This list can't be reordered"))
+ (when (and sort (symbolp sort))
+ (setq sx-question-list--order sort)
+ (setq sx-question-list--descending (not ascend))
+ (sx-question-list-refresh 'redisplay)))
+
+(provide 'sx-question-list)
+;;; sx-question-list.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-question-mode.el --- major-mode for displaying questions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 provides a means to print questions with their answers
+;; and all comments. See the customizable group `sx-question-mode'.
+
+\f
+;;; Code:
+(eval-when-compile
+ (require 'rx))
+
+(require 'sx)
+(require 'sx-switchto)
+(require 'sx-question)
+(require 'sx-question-print)
+
+\f
+;;; Displaying a question
+(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].
+
+Common values for this variable are `pop-to-buffer' and `switch-to-buffer'."
+ :type 'function
+ :group 'sx-question-mode)
+
+(defvar sx-question-mode--buffer nil
+ "Buffer being used to display questions.")
+
+(defvar sx-question-mode--data nil
+ "The data of the question being displayed.")
+(make-variable-buffer-local 'sx-question-mode--data)
+
+(defun sx-question-mode--get-window ()
+ "Return a window displaying a question, or nil."
+ (get-window-with-predicate
+ (lambda (win)
+ (with-selected-window win
+ (derived-mode-p 'sx-question-mode)))
+ 'never))
+
+(defun sx-question-mode--display (data &optional window)
+ "Display question given by DATA on WINDOW.
+If WINDOW is nil, use selected one.
+
+Returns the question buffer."
+ (with-current-buffer
+ (sx-question-mode--display-buffer window)
+ (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.
+Also marks the question as read with `sx-question--mark-read'."
+ (sx--ensure-site data)
+ (sx-question--mark-read data)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (sx-question-mode)
+ (sx-question-mode--print-question data)
+ (current-buffer)))
+
+(defun sx-question-mode--display-buffer (window)
+ "Display and return the buffer used for displaying a question.
+Create `sx-question-mode--buffer' if necessary.
+If WINDOW is given, use that to display the buffer."
+ ;; Create the buffer if necessary.
+ (unless (buffer-live-p sx-question-mode--buffer)
+ (setq sx-question-mode--buffer
+ (generate-new-buffer "*sx-question*")))
+ (cond
+ ;; Window was given, use it.
+ ((window-live-p window)
+ (set-window-buffer window sx-question-mode--buffer))
+ ;; No window, but the buffer is already being displayed somewhere.
+ ((get-buffer-window sx-question-mode--buffer 'visible))
+ ;; Neither, so we create the window.
+ (t (funcall sx-question-mode-display-buffer-function
+ sx-question-mode--buffer)))
+ sx-question-mode--buffer)
+
+\f
+;;; Movement commands
+;; Sections are headers placed above a question's content or an
+;; answer's content, or above the list of comments. They are
+;; identified with the `sx-question-mode--section' text property.
+;; To move between sections, just search for the property. The value
+;; of the text-property is the depth of the section (1 for contents, 2
+;; for comments).
+(defcustom sx-question-mode-recenter-line 0
+ "Screen line to which we recenter after moving between sections.
+This is used as an argument to `recenter', only used if the end
+of section is outside the window.
+
+If nil, no recentering is performed."
+ :type '(choice (const :tag "Don't recenter" nil)
+ integer)
+ :group 'sx-question-mode)
+
+(defun sx-question-mode-next-section (&optional n)
+ "Move down to next section (question or answer) of this buffer.
+Prefix argument N moves N sections down or up."
+ (interactive "p")
+ (let ((count (if n (abs n) 1)))
+ (while (> count 0)
+ ;; This will either move us to the next section, or move out of
+ ;; the current one.
+ (unless (sx--goto-property-change 'sx-question-mode--section n)
+ ;; If all we did was move out the current one, then move again
+ ;; and we're guaranteed to reach the next section.
+ (sx--goto-property-change 'sx-question-mode--section n))
+ (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))))
+ (when (and (overlayp ov) (> (overlay-end ov) (window-end)))
+ (recenter sx-question-mode-recenter-line))))
+ (sx-message-help-echo)))
+
+(defun sx-question-mode-previous-section (&optional n)
+ "Move down to previous section (question or answer) of this buffer.
+Prefix argument moves N sections up or down."
+ (interactive "p")
+ (sx-question-mode-next-section (- (or n 1))))
+
+(defun sx-question-mode-hide-show-section (&optional _)
+ "Hide or show section under point.
+Optional argument _ is for `push-button'."
+ (interactive)
+ (let ((ov (or (sx-question-mode--section-overlays-at
+ (line-end-position))
+ (sx-question-mode--section-overlays-at (point)))))
+ (unless (overlayp ov)
+ (sx-user-error "Not inside a question or answer"))
+ (goto-char (overlay-start ov))
+ (forward-line 0)
+ (overlay-put
+ ov 'invisible
+ (null (overlay-get ov 'invisible)))))
+
+(defun sx-question-mode--section-overlays-at (pos)
+ "Return the highest priority section overlay at POS.
+A section overlay has a `sx-question-mode--section-content'
+property."
+ (cdr-safe (get-char-property-and-overlay
+ pos 'sx-question-mode--section-content nil)))
+
+\f
+;;; Major-mode constants
+(defconst sx-question-mode--key-definitions
+ '(
+ ("<down>" sx-question-mode-next-section)
+ ("<up>" sx-question-mode-previous-section)
+ ("n" sx-question-mode-next-section "Navigate")
+ ("p" sx-question-mode-previous-section "Navigate")
+ ("g" sx-question-mode-refresh)
+ ("v" sx-visit-externally)
+ ("u" sx-upvote "upvote")
+ ("d" sx-downvote "downvote")
+ ("q" quit-window)
+ ("SPC" scroll-up-command)
+ ("e" sx-edit "edit")
+ ("S" sx-search)
+ ("*" sx-favorite "star")
+ ("K" sx-delete "Delete")
+ ("s" sx-switchto-map "switch-to")
+ ("O" sx-question-mode-order-by "Order")
+ ("c" sx-comment "comment")
+ ("a" sx-answer "answer")
+ ("TAB" forward-button "Navigate")
+ ("<S-iso-lefttab>" backward-button)
+ ("<S-tab>" backward-button)
+ ("<backtab>" backward-button))
+ "List of key definitions for `sx-question-mode'.
+This list must follow the form described in
+`sx--key-definitions-to-header-line'.")
+
+(defconst sx-question-mode--header-line
+ (sx--key-definitions-to-header-line
+ sx-question-mode--key-definitions)
+ "Header-line used on the question list.")
+
+\f
+;;; Major-mode definition
+(defconst sx-question-mode--mode-line
+ '(" "
+ ;; `sx-question-mode--data' is guaranteed to have through
+ ;; `sx--ensure-site' already, so we use `let-alist' instead of
+ ;; `sx-assoc-let' to improve performance (since the mode-line is
+ ;; updated a lot).
+ (:propertize
+ (:eval (sx--pretty-site-parameter
+ (let-alist sx-question-mode--data .site_par)))
+ face mode-line-buffer-id)
+ " " mode-name
+ " ["
+ "Answers: "
+ (:propertize
+ (:eval (number-to-string (let-alist sx-question-mode--data .answer_count)))
+ face mode-line-buffer-id)
+ ", "
+ "Stars: "
+ (:propertize
+ (:eval (number-to-string (or (let-alist sx-question-mode--data .favorite_count) 0)))
+ face mode-line-buffer-id)
+ ", "
+ "Views: "
+ (:propertize
+ (:eval (number-to-string (let-alist sx-question-mode--data .view_count)))
+ face mode-line-buffer-id)
+ "] ")
+ "Mode-line construct to use in `sx-question-mode' buffers.")
+
+(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.
+
+Don't activate this mode directly. Instead, to print a question
+on the current buffer use
+`sx-question-mode--erase-and-print-question'.
+
+\\<sx-question-mode>
+\\{sx-question-mode}"
+ (setq header-line-format sx-question-mode--header-line)
+ (setq mode-line-format sx-question-mode--mode-line)
+ (buffer-disable-undo (current-buffer))
+ (set (make-local-variable 'nobreak-char-display) nil)
+ ;; Determine how to close this window.
+ (unless (window-parameter nil 'quit-restore)
+ (set-window-parameter
+ nil 'quit-restore
+ `(other window nil ,(current-buffer))))
+ ;; We call font-lock-region manually. See `sx-question-mode--insert-markdown'.
+ (font-lock-mode -1)
+ (remove-hook 'after-change-functions 'markdown-check-change-for-wiki-link t)
+ (remove-hook 'window-configuration-change-hook
+ 'markdown-fontify-buffer-wiki-links t))
+
+;; We need this quote+eval combo because `kbd' was a macro in 24.2.
+(mapc (lambda (x) (eval `(define-key sx-question-mode-map
+ (kbd ,(car x)) #',(cadr x))))
+ sx-question-mode--key-definitions)
+
+(defun sx-question-mode-refresh (&optional no-update)
+ "Refresh currently displayed question.
+Queries the API for any changes to the question or its answers or
+comments, and redisplays it.
+
+With non-nil prefix argument NO-UPDATE, just redisplay, don't
+query the api."
+ (interactive "P")
+ (sx-question-mode--ensure-mode)
+ (let ((point (point))
+ (line (count-screen-lines
+ (window-start) (point))))
+ (sx-question-mode--erase-and-print-question
+ (if no-update
+ sx-question-mode--data
+ (sx-assoc-let sx-question-mode--data
+ (sx-question-get-question .site_par .question_id))))
+ (goto-char point)
+ (when (equal (selected-window)
+ (get-buffer-window (current-buffer)))
+ (recenter line)))
+ (sx-message "Done."))
+
+(defun sx-question-mode--ensure-mode ()
+ "Ensures we are in question mode, erroring otherwise."
+ (unless (derived-mode-p 'sx-question-mode)
+ (error "Not in `sx-question-mode'")))
+
+(defun sx-question-mode-order-by (sort)
+ "Order answers in the current buffer by the method SORT.
+Sets `sx-question-list--order' and then calls
+`sx-question-list-refresh' with `redisplay'."
+ (interactive
+ (list (let ((order (sx-completing-read "Order answers by: "
+ (mapcar #'car sx-question-mode--sort-methods))))
+ (cdr-safe (assoc-string order sx-question-mode--sort-methods)))))
+ (when (and sort (functionp sort))
+ (setq sx-question-mode-answer-sort-function sort)
+ (sx-question-mode-refresh 'no-update)))
+
+(provide 'sx-question-mode)
+;;; sx-question-mode.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-question-print.el --- populating the question-mode buffer with content -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
+
+\f
+;;; Code:
+(require 'markdown-mode)
+(require 'sx-button)
+(require 'sx)
+(require 'sx-question)
+(require 'sx-babel)
+(require 'sx-user)
+
+(defvar sx-question-mode--data)
+
+(defgroup sx-question-mode nil
+ "Customization group for sx-question-mode."
+ :prefix "sx-question-mode-"
+ :tag "SX Question Mode"
+ :group 'sx)
+
+(defgroup sx-question-mode-faces '((sx-user custom-group))
+ "Customization group for the faces of `sx-question-mode'.
+Some faces of this mode might be defined in the `sx-user' group."
+ :prefix "sx-question-mode-"
+ :tag "SX Question Mode Faces"
+ :group 'sx-question-mode)
+
+\f
+;;; Faces and Variables
+(defface sx-question-mode-header
+ '((t :inherit font-lock-variable-name-face))
+ "Face used on the question headers in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-title
+ '((t :weight bold :inherit default))
+ "Face used on the question title in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-title-comments
+ '((t :inherit sx-question-mode-title))
+ "Face used on the question title in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-title "\n"
+ "String used before the question title at the header."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-header-author-format "\nAuthor: %d %r"
+ "String used to display the question author at the header.
+% constructs have special meaning here. See `sx-user--format'."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defface sx-question-mode-date
+ '((t :inherit font-lock-string-face))
+ "Face used on the question date in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-date "\nPosted on: "
+ "String used before the question date at the header."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defface sx-question-mode-score
+ '((t))
+ "Face used for the score in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-score-downvoted
+ '((t :inherit (font-lock-warning-face sx-question-mode-score)))
+ "Face used for downvoted score in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-score-upvoted
+ '((t :weight bold
+ :inherit (font-lock-function-name-face sx-question-mode-score)))
+ "Face used for downvoted score in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-header-tags "\nTags: "
+ "String used before the question tags at the header."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-header-score "\nScore: "
+ "String used before the question score at the header."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defface sx-question-mode-content-face
+ '((((background dark)) :background "#090909")
+ (((background light)) :background "#f4f4f4"))
+ "Face used on the question body in the question buffer.
+This shouldn't have a foreground, or this will interfere with
+font-locking."
+ :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-last-edit-format " (edited %s ago by %s)"
+ "Format used to describe last edit date in the header.
+First \"%s\" is replaced with the date and the second \"%s\" with
+the editor's name."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-separator
+ (concat (propertize (make-string 72 ?\s)
+ 'face '(underline sx-question-mode-header))
+ "\n")
+ "Separator used between header and body."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-answer-title "Answer"
+ "Title used at the start of \"Answer\" sections."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defface sx-question-mode-accepted
+ '((((background dark)) :foreground "LimeGreen"
+ :height 1.3 :inherit sx-question-mode-title)
+ (((background light)) :foreground "ForestGreen"
+ :height 1.3 :inherit sx-question-mode-title))
+ "Face used for accepted answers in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-closed
+ '((t :box 2 :inherit font-lock-warning-face))
+ "Face used for closed question header in the question buffer."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-closed-reason
+ `((t :box (:line-width 2 :color ,(face-attribute 'sx-question-mode-closed
+ :foreground nil t))
+ :inherit sx-question-mode-title))
+ "Face used for closed question header in the question buffer.
+Aesthetically, it's important that the color of this face's :box
+attribute match the color of the face `sx-question-mode-closed'."
+ :group 'sx-question-mode-faces)
+
+(defcustom sx-question-mode-answer-accepted-title "Accepted Answer"
+ "Title used at the start of accepted \"Answer\" section."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-comments-title " Comments"
+ "Title used at the start of \"Comments\" sections."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-comments-format "%s: %s\n"
+ "Format used to display comments.
+First \"%s\" is replaced with user name. Second \"%s\" is
+replaced with the comment."
+ :type 'string
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-pretty-links t
+ "If non-nil, markdown links are displayed in a compact form."
+ :type 'boolean
+ :group 'sx-question-mode)
+
+(defconst sx-question-mode--sort-methods
+ (let ((methods
+ '(("Higher-scoring" . sx-answer-higher-score-p)
+ ("Newer" . sx-answer-newer-p)
+ ("More active" . sx-answer-more-active-p))))
+ (append (mapcar (lambda (x) (cons (concat (car x) " first") (cdr x)))
+ methods)
+ (mapcar (lambda (x) (cons (concat (car x) " last")
+ (sx--invert-predicate (cdr x))))
+ methods))))
+
+(defcustom sx-question-mode-answer-sort-function
+ #'sx-answer-higher-score-p
+ "Function used to sort answers in the question buffer."
+ :type
+ (cons 'choice
+ (mapcar (lambda (x) `(const :tag ,(car x) ,(cdr x)))
+ sx-question-mode--sort-methods))
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-use-images (image-type-available-p 'imagemagick)
+ "Non-nil if SX should download and display images.
+By default, this is `t' if the `imagemagick' image type is
+available (checked with `image-type-available-p'). If this image
+type is not available, images won't work."
+ :type 'boolean
+ :group 'sx-question-mode)
+
+(defcustom sx-question-mode-image-max-width 550
+ "Maximum width, in pixels, of images in the question buffer."
+ :type 'integer
+ :group 'sx-question-mode)
+
+(defvar sx-question-mode-after-print-hook nil
+ "Hook run after the question has been printed.
+The hook functions are called without arguments with
+the `sx-question-mode' buffer current.
+The special variable `inhibit-read-only' is t while the hook functions run.
+This hook can be used for special formatting of parts of the question buffer.")
+
+\f
+;;; Functions
+;;;; Printing the general structure
+(defconst sx-question-mode--closed-mode-line-string
+ '(:propertize " [CLOSED] " face font-lock-warning-face)
+ "String indicating closed questions in the mode-line.")
+
+(defun sx-question-mode--print-question (question)
+ "Print a buffer describing QUESTION.
+QUESTION must be a data structure returned by `json-read'."
+ (when (sx--deleted-p question)
+ (sx-user-error "This is a deleted question"))
+ (setq sx-question-mode--data question)
+ ;; Clear the overlays
+ (mapc #'delete-overlay sx--overlays)
+ (setq sx--overlays nil)
+ ;; Print everything
+ (sx-assoc-let question
+ (when .closed_reason
+ (add-to-list 'mode-line-format sx-question-mode--closed-mode-line-string)
+ (sx-question-mode--print-close-reason .closed_reason .closed_date .closed_details))
+ (sx-question-mode--print-section question)
+ (mapc #'sx-question-mode--print-section
+ (cl-remove-if
+ #'sx--deleted-p
+ (cl-sort (copy-sequence .answers) sx-question-mode-answer-sort-function))))
+ (insert "\n\n ")
+ (insert-text-button "Write an Answer" :type 'sx-button-answer)
+ (run-hooks 'sx-question-mode-after-print-hook)
+ ;; Go up
+ (goto-char (point-min))
+ (sx-question-mode-next-section))
+
+(defun sx-question-mode--print-close-reason (reason date &optional details)
+ "Print a header explaining REASON and DATE.
+DATE is an integer.
+
+DETAILS, when given is an alist further describing the close."
+ (let ((l (point)))
+ (let-alist details
+ (insert "\n "
+ (propertize (format " %s as %s, %s ago. "
+ (if .on_hold "Put on hold" "Closed")
+ reason
+ (sx-time-since date))
+ 'face 'sx-question-mode-closed)
+ "\n")
+ (when .description
+ (insert (replace-regexp-in-string "<[^>]+>" "" .description)
+ "\n")))
+ (save-excursion
+ (goto-char l)
+ (search-forward " as " nil 'noerror)
+ (setq l (point))
+ (skip-chars-forward "^,")
+ (let ((ov (make-overlay l (point))))
+ (overlay-put ov 'face 'sx-question-mode-closed-reason)
+ (push ov sx--overlays)))))
+
+(defun sx-question-mode--maybe-print-accept-button ()
+ "Print accept button if you own this question."
+ (when (sx-assoc-let sx-question-mode--data
+ (ignore-errors
+ (= .owner.user_id
+ (cdr (assq 'user_id (sx-network-user .site_par))))))
+ (insert " ")
+ (insert-text-button "Accept" :type 'sx-button-accept)))
+
+(defun sx-question-mode--print-section (data)
+ "Print a section corresponding to DATA.
+DATA can represent a question or an answer."
+ ;; This makes `data' accessible through `sx--data-here'.
+ (sx--wrap-in-overlay
+ (list 'sx--data-here data)
+ (sx-assoc-let data
+ (insert sx-question-mode-header-title)
+ (insert-text-button
+ ;; Questions have title, Answers don't
+ (cond (.title)
+ (.is_accepted sx-question-mode-answer-accepted-title)
+ (t sx-question-mode-answer-title))
+ ;; Section level
+ 'sx-question-mode--section (if .title 1 2)
+ 'sx-button-copy .share_link
+ 'face (if .is_accepted 'sx-question-mode-accepted
+ 'sx-question-mode-title)
+ :type 'sx-question-mode-title)
+ (when (not (or .title .is_accepted))
+ (sx-question-mode--maybe-print-accept-button))
+
+ ;; Sections can be hidden with overlays
+ (sx--wrap-in-overlay
+ '(sx-question-mode--section-content t)
+
+ ;; Author
+ (insert
+ (sx-user--format
+ (propertize sx-question-mode-header-author-format
+ 'face 'sx-question-mode-header)
+ .owner))
+
+ ;; Date
+ (sx-question-mode--insert-header
+ sx-question-mode-header-date
+ (concat
+ (sx-time-seconds-to-date .creation_date)
+ (when .last_edit_date
+ (format sx-question-mode-last-edit-format
+ (sx-time-since .last_edit_date)
+ (sx-user--format "%d" .last_editor))))
+ 'sx-question-mode-date)
+
+ ;; Score and upvoted/downvoted status.
+ (sx-question-mode--insert-header
+ sx-question-mode-header-score
+ (format "%s%s" .score
+ (cond (.upvoted "↑") (.downvoted "↓") (t "")))
+ (cond (.upvoted 'sx-question-mode-score-upvoted)
+ (.downvoted 'sx-question-mode-score-downvoted)
+ (t 'sx-question-mode-score)))
+
+ ;; Tags
+ (when .title
+ ;; Tags
+ (sx-question-mode--insert-header
+ sx-question-mode-header-tags
+ (sx-tag--format-tags .tags .site_par)
+ nil))
+ ;; Body
+ (insert "\n" sx-question-mode-separator)
+ (sx--wrap-in-overlay
+ '(face sx-question-mode-content-face)
+ (insert "\n")
+ (sx-question-mode--insert-markdown .body_markdown)
+ (insert "\n" sx-question-mode-separator))
+ ;; Clean up comments manually deleted. The `append' call is
+ ;; to ensure `comments' is a list and not a vector.
+ (let ((comments (cl-remove-if #'sx--deleted-p .comments)))
+ (when comments
+ (insert "\n")
+ (insert-text-button
+ sx-question-mode-comments-title
+ 'face 'sx-question-mode-title-comments
+ 'sx-question-mode--section 3
+ 'sx-button-copy .share_link
+ :type 'sx-question-mode-title)
+ (sx--wrap-in-overlay
+ '(sx-question-mode--section-content t)
+ (insert "\n")
+ (sx--wrap-in-overlay
+ '(face sx-question-mode-content-face)
+ ;; Comments have their own `sx--data-here' property (so they can
+ ;; be upvoted too).
+ (mapc #'sx-question-mode--print-comment comments))
+ ;; If there are comments, we want part of this margin to go
+ ;; inside them, so the button gets placed beside the
+ ;; "Comments" header when you hide them.
+ (insert " ")))
+ ;; If there are no comments, we have to add this margin here.
+ (unless comments
+ (insert " ")))
+ (insert " ")
+ ;; This is where the "add a comment" button is printed.
+ (insert-text-button "Add a Comment"
+ :type 'sx-button-comment)
+ (insert "\n")))))
+
+(defun sx-question-mode--print-comment (comment-data)
+ "Print the comment described by alist COMMENT-DATA.
+The comment is indented, filled, and then printed according to
+`sx-question-mode-comments-format'."
+ (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 .upvoted "^" "")
+ " "))
+ (insert
+ (format sx-question-mode-comments-format
+ (sx-user--format "%d" .owner)
+ (substring
+ ;; We use temp buffer, so that image overlays don't get
+ ;; inserted with the comment.
+ (with-temp-buffer
+ ;; We fill with three spaces at the start, so the comment is
+ ;; slightly indented.
+ (sx-question-mode--insert-markdown (concat " " (sx--squash-whitespace .body_markdown)))
+ (buffer-string))
+ ;; 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.
+ARGS is a list of repeating values -- `header', `value', and
+`face'. `header' is given `sx-question-mode-header' as a face,
+where `value' is given `face' as its face.
+
+\(fn HEADER VALUE FACE [HEADER VALUE FACE] [HEADER VALUE FACE] ...)"
+ (while args
+ (insert
+ (propertize (pop args) 'face 'sx-question-mode-header)
+ (let ((header (pop args))
+ (face (pop args)))
+ (if face (propertize header 'face face)
+ header)))))
+
+\f
+;;;; Printing and Font-locking the content (body)
+(defvar sx-question-mode-bullet-appearance
+ (propertize (if (char-displayable-p ?•) "•" "*")
+ 'face 'markdown-list-face)
+ "String to be displayed as the bullet of markdown list items.")
+
+(defconst sx-question-mode--reference-regexp
+ (rx line-start (0+ blank) "[%s]:" (0+ blank)
+ (group-n 1 (1+ (not (any blank "\n\r")))))
+ "Regexp used to find the url of labeled links.
+E.g.:
+ [1]: https://...")
+
+(defconst sx-question-mode--link-regexp
+ ;; Done at compile time.
+ (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:"
+ (group-n 5 (+ (not (any " ]")))) "]")
+ (and (opt "!") "[" (group-n 1 (1+ (not (any "[]")))) "]"
+ (or (and "(" (group-n 2 (1+ (not (any ")")))) ")")
+ (and "[" (group-n 3 (1+ (not (any "]")))) "]")))
+ (group-n 4 (and "http" (opt "s") "://"
+ (>= 2 (any lower numeric "_%"))
+ "."
+ (>= 2 (any lower numeric "_%"))
+ (* (any lower numeric "-/._%&#?=;"))))))
+ "Regexp matching markdown links.")
+
+(defun sx-question-mode--process-line-breaks (beg end-marker)
+ "Process Markdown line breaks between BEG and END-MARKER.
+Double space at the end of a line becomes an invisible \"\\n\".
+Consecutive blank lines beyond the first are consensed.
+Assumes `marker-insertion-type' of END-MARKER is t."
+ (goto-char beg)
+ (while (search-forward-regexp
+ (rx line-start (* blank) "\n"
+ (group-n 1 (+ (any blank "\n"))))
+ end-marker 'noerror)
+ ;; An invisible newline ensures the previous text
+ ;; will get filled as a separate paragraph.
+ (replace-match "" nil nil nil 1))
+ (goto-char beg)
+ (while (search-forward-regexp " $" end-marker 'noerror)
+ ;; An invisible newline ensures the previous text
+ ;; will get filled as a separate paragraph.
+ (replace-match (propertize "\n" 'invisible t))))
+
+(defun sx-question-mode--process-markdown-in-region (beg end)
+ "Process Markdown text between BEG and END.
+This does not do Markdown font-locking. Instead, it fills text,
+propertizes links, inserts images, cleans up html comments, and
+font-locks code-blocks according to mode."
+ ;; Paragraph filling
+ (let ((paragraph-start
+ "\f\\|[ \t]*$\\|[ \t]*[*+-] \\|[ \t]*[0-9]+\\.[ \t]\\|[ \t]*: ")
+ (paragraph-separate "\\(?:[ \t\f]*\\|.* \\)$")
+ (adaptive-fill-first-line-regexp "\\`[ \t]*>[ \t]*?\\'")
+ (adaptive-fill-function #'markdown-adaptive-fill-function))
+ (save-restriction
+ (narrow-to-region beg end)
+ ;; html tags can span many paragraphs, so we handle them
+ ;; globally first.
+ (sx-question-mode--process-html-tags (point-min) (copy-marker (point-max)))
+ ;; And now the filling and other handlings.
+ (goto-char (point-min))
+ (while (null (eobp))
+ ;; Don't fill pre blocks.
+ (unless (sx-question-mode--dont-fill-here)
+ (let ((beg (point)))
+ (skip-chars-forward "\r\n[:blank:]")
+ (forward-paragraph)
+ (let ((end (point-marker)))
+ (set-marker-insertion-type end t)
+ ;; Turn markdown linebreaks into their final form
+ (sx-question-mode--process-line-breaks beg end)
+ ;; Compactify links by paragraph, so we don't linkify
+ ;; inside code-blocks. This will still linkify inside
+ ;; code tags, unfortunately.
+ (sx-question-mode--process-links beg end)
+ ;; Filling is done after all of the above, since those
+ ;; steps change the length of text.
+ (fill-region beg end)
+ (goto-char end)))))
+ (goto-char (point-max)))))
+
+(defconst sx-question-mode-hr
+ (propertize (make-string 72 ?―)
+ 'face 'markdown-header-rule-face))
+
+(defun sx-question-mode--insert-markdown (text)
+ "Return TEXT fontified according to `markdown-mode'."
+ (let ((beg (point)))
+ (insert
+ ;; Font-locking needs to be done in a temp buffer, because it
+ ;; affects the entire buffer even if we narrow.
+ (with-temp-buffer
+ (insert text)
+ ;; Trim whitespace
+ (goto-char (point-max))
+ (skip-chars-backward "\r\n[:blank:]")
+ (delete-region (point) (point-max))
+ (goto-char (point-min))
+ (skip-chars-forward "\r\n[:blank:]")
+ (forward-line 0)
+ (delete-region (point-min) (point))
+ ;; Font lock
+ (delay-mode-hooks (markdown-mode))
+ (font-lock-mode -1)
+ (when sx-question-mode-bullet-appearance
+ (font-lock-add-keywords ;; Bullet items.
+ nil
+ `((,(rx line-start (0+ blank) (group-n 1 (any "*+-")) blank)
+ 1 '(face nil display ,sx-question-mode-bullet-appearance) prepend))))
+ (font-lock-add-keywords ;; Highlight usernames.
+ nil
+ `((,(rx (or blank line-start)
+ (group-n 1 (and "@" (1+ (not space))))
+ symbol-end)
+ 1 font-lock-builtin-face)
+ ("^---+$" 0 '(face nil display ,sx-question-mode-hr))))
+ ;; Everything.
+ (font-lock-fontify-region (point-min) (point-max))
+ (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string))))
+ ;; This part can and should be done in place, this way it can
+ ;; create overlays.
+ (sx-question-mode--process-markdown-in-region beg (point))))
+
+\f
+;;; HTML tags
+(defconst sx-question-mode--html-tag-regexp
+ (rx "<" (group-n 1 "%s") (* (not (any ">"))) ">"))
+
+(defface sx-question-mode-sub-sup-tag
+ '((t :height 0.7))
+ "Face used on <sub> and <sup> tags."
+ :group 'sx-question-mode-faces)
+
+(defface sx-question-mode-kbd-tag
+ '((((background dark))
+ :height 0.9
+ :weight semi-bold
+ :box (:line-width 3 :style released-button :color "gray30"))
+ (((background light))
+ :height 0.9
+ :weight semi-bold
+ :box (:line-width 3 :style released-button :color "gray70")))
+ "Face used on <kbd> tags."
+ :group 'sx-question-mode-faces)
+
+(defun sx-question-mode--inside-code-p ()
+ "Return non-nil if point is inside code.
+This can be inline Markdown code or a Markdown code-block."
+ (save-match-data
+ (or (markdown-inline-code-at-point-p)
+ (save-excursion
+ (sx-question-mode--skip-and-fontify-pre 'dont-fontify)))))
+
+(defun sx-question-mode--standalone-tag-p (string)
+ "Return non-nil if STRING ends in \"/>\"."
+ (string-match "/[[:blank:]]*>\\'" string))
+
+(defun sx-question-mode--next-tag (tag &optional closing end)
+ "Move point to the next occurrence of html TAG, or return nil.
+Don't move past END.
+If CLOSING is non-nil, find a closing tag."
+ (search-forward-regexp
+ (format sx-question-mode--html-tag-regexp
+ (if closing
+ (concat "/[[:blank:]]*" tag)
+ tag))
+ end 'noerror))
+
+(defun sx-question-mode--process-html-tags (beg end-marker)
+ "Hide all html tags between BEG and END and possibly interpret them.
+END-MARKER should be a marker."
+ ;; This code understands nested html, but not if the same tag is
+ ;; nested in itself (e.g., <kbd><kbd></kbd></kbd>).
+ (set-marker-insertion-type end-marker t)
+ (goto-char beg)
+ (while (sx-question-mode--next-tag "[[:alpha:]]+" nil end-marker)
+ (unless (sx-question-mode--inside-code-p)
+ (let ((tag (match-string 1))
+ (full (match-string 0))
+ (l (match-beginning 0)))
+ (replace-match "")
+ (pcase tag
+ (`"hr"
+ (unless (looking-at-p "^") (insert "\n"))
+ (insert (propertize "---" 'display sx-question-mode-hr))
+ (unless (eq (char-after) ?\n) (insert "\n")))
+ (`"br" (insert "\n ")))
+ (when (and (not (sx-question-mode--standalone-tag-p full))
+ (sx-question-mode--next-tag tag 'closing))
+ (let ((r (copy-marker (match-beginning 0))))
+ ;; The code tag is special, because it quotes everything inside.
+ (if (string= tag "code")
+ (progn (replace-match "`")
+ (save-excursion (goto-char l) (insert "`")))
+ (replace-match "")
+ ;; Handle stuff between the two tags.
+ (save-match-data (sx-question-mode--process-html-tags l r))
+ (pcase tag
+ (`"kbd"
+ (add-text-properties l r '(face sx-question-mode-kbd-tag))
+ (when (looking-at-p
+ (format sx-question-mode--html-tag-regexp "kbd"))
+ (insert " ")))
+ (`"sub"
+ (add-text-properties
+ l r '(face sx-question-mode-sub-sup-tag display (raise -0.3))))
+ (`"sup"
+ (add-text-properties
+ l r '(face sx-question-mode-sub-sup-tag display (raise +0.3))))))))))))
+
+\f
+;;; Handling links
+(defun sx-question-mode--process-links (beg end-marker)
+ "Turn all markdown links between BEG and ENG into compact format.
+Image links are downloaded and displayed, if
+`sx-question-mode-use-images' is non-nil.
+Assumes `marker-insertion-type' of END-MARKER is t."
+ (goto-char beg)
+ (while (search-forward-regexp sx-question-mode--link-regexp end-marker t)
+ ;; Tags are tag-buttons.
+ (let ((tag (match-string-no-properties 5)))
+ (if (and tag (> (length tag) 0))
+ (progn (replace-match "")
+ (sx-tag--insert tag))
+ ;; Other links are link-buttons.
+ (let* ((text (match-string-no-properties 1))
+ (url (or (match-string-no-properties 2)
+ (match-string-no-properties 4)
+ (sx-question-mode-find-reference
+ (match-string-no-properties 3)
+ text)))
+ (full-text (match-string-no-properties 0))
+ (image-p (and sx-question-mode-use-images
+ (eq ?! (elt full-text 0)))))
+ (when (stringp url)
+ (replace-match "")
+ (sx-question-mode--insert-link
+ (cond (image-p (sx-question-mode--create-image url))
+ ((and sx-question-mode-pretty-links text))
+ ((not text) (sx--shorten-url url))
+ (t full-text))
+ url)))))))
+
+(defun sx-question-mode--create-image (url)
+ "Get and create an image from URL and insert it at POINT.
+The image will take the place of the character at POINT.
+Its size is bound by `sx-question-mode-image-max-width' and
+`window-body-width'."
+ (let* ((ov (make-overlay (point) (point) (current-buffer) t nil))
+ (callback
+ (lambda (data)
+ (let* ((image (create-image data 'imagemagick t))
+ (image-width (car (image-size image 'pixels))))
+ (overlay-put
+ ov 'display
+ (append image
+ (list :width (min sx-question-mode-image-max-width
+ (window-body-width nil 'pixel)
+ image-width))))))))
+ (sx-request-get-url url callback)
+ (overlay-put ov 'face 'default)
+ ov))
+
+(defun sx-question-mode--insert-link (text url)
+ "Return a link propertized version of TEXT-OR-IMAGE.
+URL is used as 'help-echo and 'url properties."
+ ;; Try to handle an image/link inside another link.
+ (when (eq (char-before) ?\[)
+ (insert "a")
+ (forward-char -2)
+ (if (looking-at sx-question-mode--link-regexp)
+ (progn (setq url (or (match-string-no-properties 2)
+ (match-string-no-properties 4)
+ (sx-question-mode-find-reference
+ (match-string-no-properties 3)
+ (if (stringp text) text "¶"))
+ url))
+ (replace-match ""))
+ (forward-char 1)
+ (delete-char 1)))
+ (unless (stringp text)
+ ;; Images need to be at the start of a line.
+ (unless (looking-at-p "^") (insert "\n"))
+ ;; And need an empty line above so they don't get wrapped into
+ ;; text when we do filling.
+ (insert (propertize "\n" 'display "")))
+ ;; Insert the link button.
+ (insert-text-button (if (stringp text) text "¶")
+ ;; Mouse-over
+ 'help-echo
+ (format sx-button--link-help-echo
+ ;; If TEXT is a shortened url, we don't shorten URL.
+ (propertize (if (and (stringp text)
+ (string-match "^https?:" text))
+ url (sx--shorten-url url))
+ 'face 'font-lock-function-name-face))
+ ;; For visiting and stuff.
+ 'sx-button-url url
+ 'sx-button-copy url
+ :type 'sx-button-link)
+ ;; Images need to be at the end of a line too.
+ (unless (stringp text)
+ (move-overlay text (1- (point)) (point) (current-buffer))
+ (insert (propertize "\n\n" 'display "\n"))))
+
+(defun sx-question-mode-find-reference (id &optional fallback-id)
+ "Find url identified by reference ID in current buffer.
+If ID is nil, use FALLBACK-ID instead."
+ (save-excursion
+ (save-match-data
+ (goto-char (point-min))
+ (when (search-forward-regexp
+ (format sx-question-mode--reference-regexp
+ (or id fallback-id))
+ nil t)
+ (match-string-no-properties 1)))))
+
+\f
+;;; 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 (&optional dont-fontify)
+ "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.
+
+If DONT-FONTIFY is non-nil, just return the result and possibly
+move point, don't create the code-block button."
+ (let ((beg (line-beginning-position)))
+ ;; To identify code-blocks we need to be at start of line.
+ (goto-char beg)
+ (when (fboundp 'markdown-syntax-propertize)
+ (markdown-syntax-propertize (point) (point-max)))
+ (when (markdown-match-pre-blocks (line-end-position))
+ (unless dont-fontify
+ (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."
+ (let ((end (save-excursion
+ (when (markdown-match-comments (line-end-position))
+ (point)))))
+ (when end
+ (delete-region (point) end)
+ (skip-chars-backward "[:blank:]")
+ (when (looking-at "^[:blank:]*\n")
+ (replace-match ""))
+ t)))
+
+(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."
+ (forward-line 0)
+ (when (looking-at-p (format sx-question-mode--reference-regexp ".+"))
+ ;; Returns non-nil
+ (forward-paragraph 1)
+ t))
+
+(provide 'sx-question-print)
+;;; sx-question-print.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-question.el --- question logic -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 provides an API for retrieving questions and defines
+;; additional logic for marking questions as read or hidden.
+
+\f
+;;; Code:
+
+(require 'sx)
+(require 'sx-filter)
+(require 'sx-method)
+
+(defun sx-question-get-questions (site &optional page keywords submethod)
+ "Get SITE questions. Return page PAGE (the first if nil).
+Return a list of question. Each question is an alist of
+properties returned by the API with an added (site SITE)
+property.
+
+KEYWORDS are added to the method call along with PAGE.
+
+`sx-method-call' is used with `sx-browse-filter'."
+ (sx-method-call 'questions
+ :keywords `((page . ,page) ,@keywords)
+ :site site
+ :auth t
+ :submethod submethod
+ :filter sx-browse-filter))
+
+(defun sx-question-get-question (site question-id)
+ "Query SITE for a QUESTION-ID and return it.
+If QUESTION-ID doesn't exist on SITE, raise an error."
+ (let ((res (sx-method-call 'questions
+ :id question-id
+ :site site
+ :auth t
+ :filter sx-browse-filter)))
+ (if res (elt res 0)
+ (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 res (elt res 0)
+ (error "Couldn't find answer %S in %S"
+ answer-id site))))
+
+(defun sx-question-get-from-comment (site comment-id)
+ "Get question from SITE to which COMMENT-ID belongs.
+If COMMENT-ID doesn't exist on SITE, raise an error.
+
+Note this requires two API requests. One for the comment and one
+for the post."
+ (let ((res (sx-method-call 'comments
+ :id comment-id
+ :site site
+ :auth t
+ :filter sx-browse-filter)))
+ (unless res
+ (error "Couldn't find comment %S in %S" comment-id site))
+ (sx-assoc-let (elt res 0)
+ (funcall (if (string= .post_type "answer")
+ #'sx-question-get-from-answer
+ #'sx-question-get-question)
+ .site_par
+ .post_id))))
+
+\f
+;;; Question Properties
+
+;;;; Read/unread
+(defvar sx-question--user-read-list nil
+ "Alist of questions read by the user.
+
+Each element has the form
+
+ (SITE . QUESTION-LIST)
+
+where each element in QUESTION-LIST has the form
+
+ (QUESTION_ID . LAST-VIEWED-DATE).")
+
+(defun sx-question--ensure-read-list (site)
+ "Ensure `sx-question--user-read-list' has been read from cache.
+If no cache exists for it, initialize one with SITE."
+ (unless sx-question--user-read-list
+ (setq sx-question--user-read-list
+ (sx-cache-get 'read-questions `'((,site))))))
+
+(defun sx-question--read-p (question)
+ "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_par)
+ (let ((ql (cdr (assoc .site_par sx-question--user-read-list))))
+ (and ql
+ (>= (or (cdr (assoc .question_id ql)) 0)
+ .last_activity_date)))))
+
+(defmacro sx-sorted-insert-skip-first (newelt list &optional predicate)
+ "Inserted NEWELT into LIST sorted by PREDICATE.
+This is designed for the (site id id ...) lists. So the first car
+is intentionally skipped."
+ `(let ((tail ,list)
+ (x ,newelt))
+ (while (and ;; We're not at the end.
+ (cdr-safe tail)
+ ;; We're not at the right place.
+ (funcall (or #',predicate #'<) x (cadr tail)))
+ (setq tail (cdr tail)))
+ (setcdr tail (cons x (cdr tail)))))
+
+(defun sx-question--mark-read (question)
+ "Mark QUESTION as being read until it is updated again.
+Returns nil if question (in its current state) was already marked
+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_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_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.
+ (when (or (not (numberp (cdr cell)))
+ (> .last_activity_date (cdr cell)))
+ (setcdr cell .last_activity_date)))
+ ;; Question wasn't present.
+ (t
+ (sx-sorted-insert-skip-first
+ q-cell site-cell
+ (lambda (x y) (> (or (car x) -1) (or (car y) -1))))))))
+ ;; Save the results.
+ ;; @TODO This causes a small lag on `j' and `k' as the list gets
+ ;; large. Should we do this on a timer?
+ (sx-cache-set 'read-questions sx-question--user-read-list)))
+
+\f
+;;;; Hidden
+(defvar sx-question--user-hidden-list nil
+ "Alist of questions hidden by the user.
+
+Each element has the form
+
+ (SITE QUESTION_ID QUESTION_ID ...)")
+
+(defun sx-question--ensure-hidden-list (site)
+ "Ensure the `sx-question--user-hidden-list' has been read from cache.
+
+If no cache exists for it, initialize one with SITE."
+ (unless sx-question--user-hidden-list
+ (setq sx-question--user-hidden-list
+ (sx-cache-get 'hidden-questions `'((,site))))))
+
+(defun sx-question--hidden-p (question)
+ "Non-nil if QUESTION has been hidden."
+ (sx-assoc-let question
+ (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_par sx-question--user-hidden-list)))
+ ;; If question already hidden, do nothing.
+ (unless (memq .question_id site-cell)
+ (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)))))
+
+\f
+;;;; Other data
+(defun sx-question--accepted-answer-id (question)
+ "Return accepted answer in QUESTION or nil if none exists."
+ (sx-assoc-let question
+ (and (integerp .accepted_answer_id)
+ .accepted_answer_id)))
+
+\f
+;;; Question Mode Answer-Sorting Functions
+(sx--create-comparator sx-answer-higher-score-p
+ "Return t if answer A has a higher score than answer B."
+ #'> (lambda (x) (cdr (assq 'score x))))
+
+(sx--create-comparator sx-answer-newer-p
+ "Return t if answer A was posted later than answer B."
+ #'> (lambda (x) (cdr (assq 'creation_date x))))
+
+(sx--create-comparator sx-answer-more-active-p
+ "Return t if answer A was updated after answer B."
+ #'> (lambda (x) (cdr (assq 'last_activity_date x))))
+
+(provide 'sx-question)
+;;; sx-question.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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:
+
+;; API requests are handled on three separate tiers:
+;;
+;; `sx-method-call':
+;;
+;; This is the function that should be used most often, since it
+;; runs necessary checks (authentication) and provides basic
+;; processing of the result for consistency.
+;;
+;; `sx-request-make':
+;;
+;; This is the fundamental function for interacting with the API.
+;; It makes no provisions for 'common' usage, but it does ensure
+;; data is retrieved successfully or an appropriate signal is
+;; thrown.
+;;
+;; `url.el' and `json.el':
+;;
+;; The whole solution is built upon `url-retrieve-synchronously'
+;; for making the request and `json-read-from-string' for parsing
+;; it into a properly symbolic data structure.
+;;
+;; When at all possible, use `sx-method-call'. There are specialized
+;; cases for the use of `sx-request-make' outside of sx-method.el, but
+;; these must be well-documented inline with the code.
+
+;;; Code:
+
+(require 'url)
+(require 'json)
+
+(require 'sx)
+(require 'sx-encoding)
+
+\f
+;;; Variables
+
+(defconst sx-request-api-key
+ "0TE6s1tveCpP9K5r5JNDNQ(("
+ "When passed, this key provides a higher request quota.")
+
+(defconst sx-request-api-version
+ "2.2"
+ "The current version of the API.")
+
+(defconst sx-request-api-root
+ (format "https://api.stackexchange.com/%s/" sx-request-api-version)
+ "The base URL to make requests from.")
+
+(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 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)
+
+(defvar sx-request-remaining-api-requests
+ nil
+ "The number of API requests remaining.
+Set by `sx-request-make'.")
+
+(defcustom sx-request-remaining-api-requests-message-threshold
+ 50
+ "Lower bound for printed warnings of API usage limits.
+After `sx-request-remaining-api-requests' drops below this
+number, `sx-request-make' will begin printing out the
+number of requests left every time it finishes a call."
+ :group 'sx
+ :type 'integer)
+
+(defvar sx-request-all-items-delay 0
+ "Delay in seconds with each `sx-request-all-items' iteration.
+It is good to use a reasonable delay to avoid rate-limiting.")
+
+\f
+;;; Making Requests
+(defvar sx--backoff-time nil)
+
+(defun sx-request--wait-while-backoff ()
+ (when sx--backoff-time
+ (message "Waiting for backoff time: %s" sx--backoff-time)
+ (let ((time (cadr (current-time))))
+ (if (> (- sx--backoff-time time) 1000)
+ ;; If backoff-time is more than 1000 seconds in the future,
+ ;; we've likely just looped around the "least significant"
+ ;; bits of `current-time'.
+ (setq sx--backoff-time time)
+ (when (< time sx--backoff-time)
+ (message "Backoff detected, waiting %s seconds" (- sx--backoff-time time))
+ (sleep-for (+ 0.3 (- sx--backoff-time time))))))))
+
+(defun sx-request-all-items (method &optional args request-method
+ stop-when)
+ "Call METHOD with ARGS until there are no more items.
+STOP-WHEN is a function that takes the entire response and
+returns non-nil if the process should stop.
+
+All other arguments are identical to `sx-request-make', but
+PROCESS-FUNCTION is given the default value of `identity' (rather
+than `sx-request-response-get-items') to allow STOP-WHEN to
+access the response wrapper."
+ ;; @TODO: Refactor. This is the product of a late-night jam
+ ;; session... it is not intended to be model code.
+ (declare (indent 1))
+ (let* ((return-value nil)
+ (current-page 1)
+ (stop-when (or stop-when #'sx-request-all-stop-when-no-more))
+ (process-function #'identity)
+ (response
+ (sx-request-make method `((page . ,current-page) ,@args)
+ request-method process-function)))
+ (while (not (funcall stop-when response))
+ (let-alist response
+ (setq current-page (1+ current-page)
+ return-value
+ (nconc return-value .items)))
+ (sleep-for sx-request-all-items-delay)
+ (setq response
+ (sx-request-make method `((page . ,current-page) ,@args)
+ request-method process-function)))
+ (nconc return-value
+ (cdr (assoc 'items response)))))
+
+;;; NOTE: Whenever this is arglist changes, `sx-request-fallback' must
+;;; also change.
+(defun sx-request-make (method &optional args request-method process-function)
+ "Make a request to the API, executing METHOD with ARGS.
+You should almost certainly be using `sx-method-call' instead of
+this function. REQUEST-METHOD is one of `get' (default) or `post'.
+
+Returns the entire response as processed by PROCESS-FUNCTION.
+This defaults to `sx-request-response-get-items'.
+
+The full set of arguments is built with
+`sx-request--build-keyword-arguments', prepending
+`sx-request-api-key' to receive a higher quota. It will also
+include user's `access_token` if it is available. This call is
+then resolved with `url-retrieve-synchronously' to a temporary
+buffer that it returns. The headers are then stripped using a
+search a blank line (\"\\n\\n\"). The main body of the response
+is then tested with `sx-encoding-gzipped-buffer-p' for
+compression. If it is compressed, `sx-request-unzip-program' is
+called to uncompress the response. The uncompressed response is
+then read with `json-read-from-string'.
+
+`sx-request-remaining-api-requests' is updated appropriately and
+the main content of the response is returned."
+ (declare (indent 1))
+ (sx-request--wait-while-backoff)
+ (let* ((url-automatic-caching t)
+ (url-inhibit-uncompression t)
+ (url-request-data (sx-request--build-keyword-arguments args nil))
+ (request-url (concat sx-request-api-root method))
+ (url-request-method (and request-method (upcase (symbol-name request-method))))
+ (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
+ ;; 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"
+ (let ((json-false nil)
+ (json-array-type 'list)
+ (json-null :null))
+ (json-read-from-string data)))))
+ (kill-buffer response-buffer)
+ (when (not response)
+ (error "Invalid response to the url request: %s" data))
+ ;; 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 .backoff
+ (message "Backoff received %s" .backoff)
+ (setq sx--backoff-time (+ (cadr (current-time)) .backoff)))
+ (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))
+ (funcall (or process-function #'sx-request-response-get-items)
+ response)))))))
+
+(defun sx-request-fallback (_method &optional _args _request-method _process-function)
+ "Fallback method when authentication is not available.
+This is for UI generation when the associated API call would
+require authentication.
+
+Currently returns nil."
+ '(()))
+
+\f
+;;; Our own generated data
+(defconst sx-request--data-url-format
+ "https://raw.githubusercontent.com/vermiculus/sx.el/data/data/%s.el"
+ "Url of the \"data\" directory inside the SX `data' branch.")
+
+(defun sx-request--read-buffer-data ()
+ "Return the buffer contents after any url headers.
+Error if url headers are absent or if they indicate something
+went wrong."
+ (goto-char (point-min))
+ (unless (string-match "200" (thing-at-point 'line))
+ (error "Page not found."))
+ (if (not (search-forward "\n\n" nil t))
+ (error "Headers missing; response corrupt")
+ (prog1 (buffer-substring (point) (point-max))
+ (kill-buffer (current-buffer)))))
+
+(defun sx-request-get-url (url &optional callback)
+ "Fetch and return data stored online at URL.
+If CALLBACK is nil, fetching is done synchronously and the
+data (buffer contents sans headers) is returned as a string.
+
+Otherwise CALLBACK must be a function of a single argument. Then
+`url-retrieve' is called asynchronously and CALLBACK is passed
+the retrieved data."
+ (let* ((url-automatic-caching t)
+ (url-inhibit-uncompression t)
+ (url-request-method "GET")
+ (url-request-extra-headers
+ '(("Content-Type" . "application/x-www-form-urlencoded")))
+ (callback-internal
+ (when callback
+ ;; @TODO: Error check in STATUS.
+ (lambda (_status)
+ (funcall callback (sx-request--read-buffer-data)))))
+ (response-buffer
+ (if callback (url-retrieve url callback-internal nil 'silent)
+ (url-retrieve-synchronously url))))
+ (unless callback
+ (if (not response-buffer)
+ (error "Something went wrong in `url-retrieve-synchronously'")
+ (with-current-buffer response-buffer
+ (sx-request--read-buffer-data))))))
+
+(defun sx-request-get-data (file)
+ "Fetch and return data stored online by SX.
+FILE is a string or symbol, the name of the file which holds the
+desired data, relative to `sx-request--data-url-format'. For
+instance, `tags/emacs' returns the list of tags on Emacs.SE."
+ (read (sx-request-get-url
+ (format sx-request--data-url-format file))))
+
+\f
+;;; Support Functions
+(defun sx-request--build-keyword-arguments (alist &optional kv-sep)
+ "Format ALIST as a key-value list joined with KV-SEP.
+If authentication is needed, include it also or error if it is
+not available.
+
+Build a \"key=value&key=value&...\"-style string with the elements
+of ALIST. If any value in the alist is nil, that pair will not
+be included in the return. If you wish to pass a notion of
+false, use the symbol `false'. Each element is processed with
+`sx--thing-as-string'."
+ ;; Add API key to list of arguments, this allows for increased quota
+ ;; automatically.
+ (let ((api-key (cons "key" sx-request-api-key))
+ (auth (car (sx-cache-get 'auth))))
+ (push api-key alist)
+ (when auth
+ (push auth alist))
+ (mapconcat
+ (lambda (pair)
+ (concat
+ (sx--thing-as-string (car pair))
+ "="
+ (sx--thing-as-string (cdr pair) kv-sep t)))
+ (delq nil (mapcar
+ (lambda (pair)
+ (when (cdr pair) pair))
+ alist))
+ "&")))
+
+\f
+;;; Response Processors
+(defun sx-request-response-get-items (response)
+ "Returns the items from RESPONSE."
+ (sx-assoc-let response
+ (sx-encoding-clean-content-deep .items)))
+
+(defun sx-request-all-stop-when-no-more (response)
+ (or (not response)
+ (not (cdr (assoc 'has_more response)))))
+
+(provide 'sx-request)
+;;; sx-request.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-search.el --- searching for questions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 search 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'.
+
+\f
+;;; Code:
+
+(require 'sx)
+(require 'sx-question-list)
+(require 'sx-question-mode)
+(require 'sx-tag)
+(require 'sx-interaction)
+
+(defvar sx-search--query-history nil
+ "Query history for interactive prompts.")
+
+\f
+;;; Basic function
+(defun sx-search-get-questions (site page query
+ &optional tags excluded-tags
+ &rest 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/advanced
+ :keywords `((page . ,page)
+ (q . ,query)
+ (tagged . ,tags)
+ (nottagged . ,excluded-tags)
+ ,@keywords)
+ :site site
+ :auth t
+ :filter sx-browse-filter))
+
+(defconst sx-search--order-methods
+ (cons '("Relevance" . relevance)
+ (default-value 'sx-question-list--order-methods))
+ "Alist of possible values to be passed to the `sort' keyword.")
+
+(defcustom sx-search-default-order 'activity
+ "Default ordering method used on new searches.
+Possible values are the cdrs of `sx-search--order-methods'."
+ :type (cons 'choice
+ (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c)))
+ (cl-remove-duplicates
+ sx-search--order-methods
+ :key #'cdr)))
+ :group 'sx-question-list)
+
+\f
+;;;###autoload
+(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-tag-multiple-read
+ site (concat "Tags" (when query " (optional)"))))
+ (unless (or query tags)
+ (sx-user-error "Must supply either QUERY or TAGS"))
+ (setq excluded-tags
+ (sx-tag-multiple-read site "Excluded tags (optional)")))
+ (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
+ (cons 'order (if sx-question-list--descending 'desc 'asc))
+ (cons 'sort sx-question-list--order))))
+ (setq sx-question-list--site site)
+ (setq sx-question-list--order sx-search-default-order)
+ (setq sx-question-list--order-methods sx-search--order-methods)
+ (sx-question-list-refresh 'redisplay)
+ (switch-to-buffer (current-buffer))))
+
+\f
+;;; Tag
+;;;###autoload
+(defun sx-search-tag-at-point (&optional pos)
+ "Follow tag under position POS or point."
+ (interactive)
+ (let ((tag (save-excursion
+ (when pos (goto-char pos))
+ (or (get-text-property (point) 'sx-tag)
+ (thing-at-point 'symbol))))
+ (meta (save-excursion
+ (when pos (goto-char pos))
+ (get-text-property (point) 'sx-tag-meta)))
+ (site (replace-regexp-in-string
+ (rx string-start "meta.") ""
+ (or sx-question-list--site
+ (sx-assoc-let sx-question-mode--data .site_par)))))
+ (sx-search (concat (when meta "meta.") site)
+ nil tag)))
+
+(provide 'sx-search)
+;;; sx-search.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 provides various pieces of site logic, such as retrieving
+;; the list of sites and the list of a user's favorited questions.
+
+;;; Code:
+
+(require 'sx-method)
+(require 'sx-cache)
+(require 'sx-filter)
+
+(defconst sx-site-browse-filter
+ (sx-filter-from-nil
+ ((site site_type
+ name
+ api_site_parameter
+ site_url
+ related_sites)
+ (related_site api_site_parameter
+ relation)))
+ "Filter for browsing sites.")
+
+(defun sx-site--get-site-list ()
+ "Return all sites with `sx-site-browse-filter'."
+ (sx-cache-get
+ 'site-list
+ '(sx-method-call 'sites
+ :pagesize 999
+ :filter sx-site-browse-filter)))
+
+(defcustom sx-site-favorites
+ nil
+ "List of favorite sites.
+Each entry is a string corresponding to a single site's
+api_site_parameter."
+ :group 'sx)
+
+(defun sx-site-get-api-tokens ()
+ "Return a list of all known site tokens."
+ (mapcar
+ (lambda (site) (cdr (assoc 'api_site_parameter site)))
+ (sx-site--get-site-list)))
+
+(provide 'sx-site)
+;;; sx-site.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-switchto.el --- keymap for navigating between pages -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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)
+
+\f
+;;; Keybinds
+;;;###autoload
+(define-prefix-command 'sx-switchto-map)
+
+(mapc (lambda (x) (define-key sx-switchto-map (car x) (cadr x)))
+ '(
+ ;; These imitate the site's G hotkey.
+ ("a" sx-ask)
+ ("h" sx-tab-frontpage)
+ ("m" sx-tab-meta-or-main)
+ ;; This is `n' on the site.
+ ("u" sx-tab-unanswered)
+ ;; These are extra things we can do, because we're awesome.
+ ("f" sx-tab-featured)
+ ("i" sx-inbox)
+ ("n" sx-tab-newest)
+ ("t" sx-tab-switch)
+ ("U" sx-tab-unanswered-my-tags)
+ ("v" sx-tab-topvoted)
+ ("w" sx-tab-week)
+ ("*" sx-tab-starred)
+ ))
+
+\f
+;;; These are keys which depend on context.
+;;;; For instance, it makes no sense to have `switch-site' bound to a
+;;;; key on a buffer with no `sx-question-list--site' variable.
+(defvar sx-question-list--site)
+(sx--define-conditional-key sx-switchto-map "s" #'sx-question-list-switch-site
+ (and (boundp 'sx-question-list--site) sx-question-list--site))
+
+(provide 'sx-switchto)
+;;; sx-switchto.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-tab.el --- functions for viewing different tabs -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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 provides a single macro to define 'tabs' to view lists of
+;; questions.
+
+;;; Tabs:
+
+;; - `sx-tab-all-questions' :: All questions.
+;; - `sx-tab-unanswered' :: Unanswered questions.
+;; - `sx-tab-unanswered-my-tags' :: Unanswered questions in your followed tags.
+;; - `sx-tab-featured' :: Featured questions.
+;; - `sx-tab-starred' :: Starred questions.
+
+;;; Code:
+
+(require 'sx)
+(require 'sx-question-list)
+(require 'sx-interaction)
+
+(defvar sx-tab--list nil
+ "List of the names of all defined tabs.")
+
+(defun sx-tab-switch (tab)
+ "Switch to another question-list TAB."
+ (interactive
+ (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)))))
+
+(defconst sx-tab--order-methods
+ `(,@(default-value 'sx-question-list--order-methods)
+ ("Hottest Now" . hot)
+ ("Weekly Hottest" . week)
+ ("Monthly Hottest" . month))
+ "Alist of possible values to be passed to the `sort' keyword.")
+
+(defcustom sx-tab-default-order 'activity
+ "Default ordering method used on `sx-tab-questions' and the likes.
+Possible values are the cdrs of `sx-tab--order-methods'."
+ :type (cons 'choice
+ (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c)))
+ (cl-remove-duplicates
+ sx-tab--order-methods
+ :key #'cdr)))
+ :group 'sx-question-list)
+
+(eval-and-compile
+ (defconst sx-tab--docstring-format
+ "Display a list of %s questions for SITE.
+The variable `sx-tab-default-order' can be used to customize the
+sorting of the resulting list.
+
+NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'.
+If SITE is nil, use `sx-default-site'."
+ "Format used on the docstring of `sx-tab-*' commands."))
+
+\f
+;;; The main macro
+(defmacro sx-tab--define (tab pager &optional printer refresher obsolete
+ &rest body)
+ "Define a StackExchange tab called TAB.
+TAB is a capitalized string.
+
+This defines a command `sx-tab-TAB' for displaying the tab,
+and a variable `sx-tab--TAB-buffer' for holding the buffer.
+
+The arguments PAGER, PRINTER, and REFRESHER, if non-nil, are
+respectively used to set the value of the variables
+`sx-question-list--print-function',
+`sx-question-list--refresh-function', and
+`sx-question-list--next-page-function'.
+
+If OBSOLETE is non-nil, it should be a string indicating the tab
+to use instead of this one.
+
+BODY is evaluated after activating the mode and setting these
+variables, but before refreshing the display."
+ (declare (indent 1) (debug t))
+ (let* ((name (downcase tab))
+ (buffer-variable
+ (intern (format "sx-tab--%s-buffer"
+ (if obsolete (downcase obsolete)
+ name))))
+ (function-name
+ (intern (concat "sx-tab-" name)))
+ (use-instead
+ (when obsolete (intern (concat "sx-tab-" (downcase obsolete))))))
+ `(progn
+ ,(unless obsolete
+ `(defvar ,buffer-variable nil
+ ,(format "Buffer where the %s questions are displayed." tab)))
+ (defun ,function-name (&optional no-update site)
+ ,(format sx-tab--docstring-format tab)
+ (interactive
+ (list current-prefix-arg
+ (sx--interactive-site-prompt)))
+ (sx-initialize)
+ (unless site (setq site sx-default-site))
+ ;; Create the buffer
+ (unless (buffer-live-p ,buffer-variable)
+ (setq ,buffer-variable
+ (generate-new-buffer
+ ,(format "*question-list: %s *" (or obsolete tab)))))
+ ;; Fill the buffer with content.
+ (with-current-buffer ,buffer-variable
+ (sx-question-list-mode)
+ (when ,printer (setq sx-question-list--print-function ,printer))
+ (when ,refresher (setq sx-question-list--refresh-function ,refresher))
+ (setq sx-question-list--next-page-function ,pager)
+ (setq sx-question-list--site site)
+ (setq sx-question-list--order 'activity)
+ (setq sx-question-list--current-tab ,(or obsolete tab))
+ ,@body
+ (sx-question-list-refresh 'redisplay no-update))
+ (switch-to-buffer ,buffer-variable))
+ ,(when obsolete
+ `(make-obsolete ',function-name ',use-instead nil))
+ ;; Add this tab to the list of existing tabs. So we can prompt
+ ;; the user with completion and stuff.
+ (unless ,obsolete
+ (add-to-list 'sx-tab--list ,tab)))))
+
+\f
+;;; Entry commands
+(sx-tab--define "All-Questions"
+ (sx-question-list--make-pager 'questions)
+ nil nil nil
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-all-questions "sx-tab" nil t)
+
+(sx-tab--define "Unanswered"
+ (sx-question-list--make-pager 'questions 'unanswered))
+;;;###autoload
+(autoload 'sx-tab-unanswered "sx-tab" nil t)
+
+(sx-tab--define "Unanswered-My-Tags"
+ (sx-question-list--make-pager 'questions 'unanswered/my-tags))
+;;;###autoload
+(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t)
+
+(sx-tab--define "Featured"
+ (sx-question-list--make-pager 'questions 'featured))
+;;;###autoload
+(autoload 'sx-tab-featured "sx-tab" nil t)
+
+(sx-tab--define "Starred"
+ (sx-question-list--make-pager 'me 'favorites))
+;;;###autoload
+(autoload 'sx-tab-starred "sx-tab" nil t)
+
+\f
+;;; Inter-modes navigation
+(defun sx-tab-meta-or-main ()
+ "Switch to the meta version of a main site, or vice-versa.
+Inside a question, go to the frontpage of the site this question
+belongs to."
+ (interactive)
+ (if (and (derived-mode-p 'sx-question-list-mode)
+ sx-question-list--site)
+ (sx-question-list-switch-site
+ (if (string-match "\\`meta\\." sx-question-list--site)
+ (replace-match "" :fixedcase nil sx-question-list--site)
+ (concat "meta." sx-question-list--site)))
+ (sx-tab-all-questions nil (sx--site (sx--data-here 'question)))))
+
+\f
+;;; Obsolete tabs
+(defconst sx-tab--basic-question-pager
+ (sx-question-list--make-pager 'questions))
+
+(sx-tab--define "FrontPage"
+ sx-tab--basic-question-pager
+ nil nil "All-Questions"
+ (setq sx-question-list--order 'activity)
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-frontpage "sx-tab" nil t)
+
+(sx-tab--define "Newest"
+ sx-tab--basic-question-pager
+ nil nil "All-Questions"
+ (setq sx-question-list--order 'creation)
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-newest "sx-tab" nil t)
+
+(sx-tab--define "TopVoted"
+ sx-tab--basic-question-pager
+ nil nil "All-Questions"
+ (setq sx-question-list--order 'votes)
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-topvoted "sx-tab" nil t)
+
+(sx-tab--define "Hot"
+ sx-tab--basic-question-pager
+ nil nil "All-Questions"
+ (setq sx-question-list--order 'hot)
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-hot "sx-tab" nil t)
+
+(sx-tab--define "Week"
+ sx-tab--basic-question-pager
+ nil nil "All-Questions"
+ (setq sx-question-list--order 'week)
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-week "sx-tab" nil t)
+
+(sx-tab--define "Month"
+ sx-tab--basic-question-pager
+ nil nil "All-Questions"
+ (setq sx-question-list--order 'month)
+ (setq sx-question-list--order-methods
+ sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-month "sx-tab" nil t)
+
+(provide 'sx-tab)
+;;; sx-tab.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-tag.el --- retrieving list of tags and handling tags -*- lexical-binding: t; -*-
+
+;; 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:
+
+
+\f
+;;; Code:
+(eval-when-compile
+ '(require 'cl-lib))
+
+(require 'sx)
+(require 'sx-method)
+(require 'sx-button)
+
+(defface sx-tag
+ '((t :underline nil :inherit font-lock-function-name-face))
+ "Face used on the question tags in the question buffer."
+ :group 'sx-question-mode-faces
+ :group 'sx-question-list-faces)
+
+\f
+;;; Getting the list from a site
+(defconst sx-tag-filter
+ (sx-filter-from-nil
+ (tag.name
+ tag.synonyms))
+ "Filter used when querying tags.")
+
+(defun sx-tag--get-all (site &optional no-synonyms)
+ "Retrieve all tags for SITE.
+If NO-SYNONYMS is non-nil, don't return synonyms."
+ (cl-reduce
+ (lambda (so-far tag)
+ (let-alist tag
+ (cons .name
+ (if no-synonyms so-far
+ (append .synonyms so-far)))))
+ (sx-method-call 'tags
+ :get-all t
+ :filter sx-tag-filter
+ :site site)
+ :initial-value nil))
+
+(defun sx-tag--get-some-tags-containing (site string)
+ "Return at most 100 tags for SITE containing STRING.
+Returns an array."
+ (sx-method-call 'tags
+ :auth nil
+ :filter sx-tag-filter
+ :site site
+ :keywords `((inname . ,string))))
+
+(defun sx-tag--get-some-tag-names-containing (site string)
+ "Return at most 100 tag names for SITE containing STRING.
+Returns a list."
+ (mapcar (lambda (x) (cdr (assoc 'name x)))
+ (sx-tag--get-some-tags-containing site string)))
+
+\f
+;;; Getting tags from our data branch. Without the API.
+;;;; @TODO: Once the cache is finished, this can probably be made into
+;;;; a cache variasble with 1 day expiration time.
+(defvar sx-tag-list-alist nil
+ "Alist where the tag list for each site is stored.
+Elements are of the type (SITE . TAG-LIST).")
+
+(defun sx-tag-list--get (site)
+ "Retrieve all tags from SITE in a single request.
+This does not access the API. Instead, it uses
+`sx-request-get-data', which accesses SX's tag cache."
+ (or (cdr (assoc site sx-tag-list-alist))
+ (let ((list (sx-request-get-data (concat "tags/" site))))
+ (push (cons site list) sx-tag-list-alist)
+ list)))
+
+\f
+;;; Check tag validity
+(defun sx-tag--invalid-name-p (site tags)
+ "Nil if TAGS exist in SITE.
+TAGS can be a string (the tag name) or a list of strings.
+Fails if TAGS is a list with more than 100 items.
+Return the list of invalid tags in TAGS."
+ (and (listp tags) (> (length tags) 100)
+ (error "Invalid argument. TAG has more than 100 items"))
+ (let ((result
+ (mapcar
+ (lambda (x) (cdr (assoc 'name x)))
+ (sx-method-call 'tags
+ :id (sx--thing-as-string tags)
+ :submethod 'info
+ :auth nil
+ :filter sx-tag-filter
+ :site site))))
+ (cl-remove-if (lambda (x) (member x result)) tags)))
+
+\f
+;;; Prompt the user for tags.
+(defvar sx-tag-history nil
+ "Tags history for interactive prompts.")
+
+;;; @TODO: Make it so that hitting BACKSPACE with an empty input
+;;; deletes a previously submitted tag.
+(defun sx-tag-multiple-read (site prompt &optional initial-value)
+ "Interactively read a list of tags for SITE.
+Call `sx-completing-read' multiple times, until input is empty,
+with completion options given by the tag list of SITE.
+Return a list of tags given by the user.
+
+PROMPT is a string displayed to the user and should not end with
+a space nor a colon. INITIAL-VALUE is a list of already-selected
+tags."
+ (let ((completion-list (sx-tag-list--get site))
+ (list (reverse initial-value))
+ (empty-string
+ (propertize "--\x000-some-string-representing-empty-\x000--"
+ 'display "DONE"))
+ input)
+ (while (not (string=
+ empty-string
+ (setq input (sx-completing-read
+ (concat prompt " ["
+ (mapconcat #'identity (reverse list) ",")
+ "]: ")
+ completion-list
+ nil 'require-match nil 'sx-tag-history
+ empty-string))))
+ (push input list))
+ (reverse list)))
+
+\f
+;;; Printing
+(defun sx-tag--format (tag &optional meta)
+ "Format and return TAG for display.
+If META is non-nil, the tag is for the meta site."
+ (with-temp-buffer
+ (sx-tag--insert tag meta)
+ (buffer-string)))
+
+(defun sx-tag--insert (tag &optional meta)
+ "Insert TAG button.
+If META is non-nil, the tag is for the meta site."
+ (insert-text-button (concat "[" tag "]")
+ 'sx-button-copy tag
+ 'sx-tag tag
+ 'sx-tag-meta meta
+ :type 'sx-button-tag))
+
+(defun sx-tag--format-tags (tags &optional site)
+ "Format and concatenate a sequence of TAGS.
+Returns a string of all tags in TAGS, separated by a space.
+
+SITE is the site to which the tags refer, it is only used to
+decide whether they are main or meta tags. SITE can also be t or
+nil, which respectively indicate meta and main."
+ (let ((is-meta
+ (if (stringp site) (string-match (rx string-start "meta.") site)
+ site)))
+ (mapconcat (lambda (tag) (sx-tag--format tag is-meta))
+ tags " ")))
+
+(provide 'sx-tag)
+;;; sx-tag.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-time.el --- time -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.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 provides functions for manipulating and displaying
+;; timestamps.
+
+;;; Code:
+
+(require 'time-date)
+
+(defconst sx-time-seconds-to-string
+ ;; (LIMIT NAME VALUE)
+ ;; We use an entry if the number of seconds in question is less than
+ ;; LIMIT, but more than the previous entry's LIMIT.
+ ;; For instance, if time is less than 100 sec, we write it in seconds;
+ ;; if it is between 100 and 6000 sec, we use minutes.
+ ;; VALUE is the actual number of seconds which NAME represents.
+ '((100 "s" 1)
+ (6000 "m" 60.0)
+ (108000 "h" 3600.0)
+ (3456000 "d" 86400.0)
+ (31622400 "mo" 2628000.0)
+ (nil "y" 31557600.0))
+ "Auxiliary variable used by `sx-time-since'.")
+
+(defun sx-time-since (time)
+ "Convert the time interval since TIME (in seconds) to a short string."
+ (let ((delay (- (float-time) time)))
+ (concat
+ (if (> 0 delay) "-" "")
+ (if (= 0 delay) "0s"
+ (setq delay (abs delay))
+ (let ((sts sx-time-seconds-to-string) here)
+ (while (and (car (setq here (pop sts)))
+ (<= (car here) delay)))
+ (concat (format "%.0f" (/ delay (car (cddr here))))
+ (cadr here)))))))
+
+(defcustom sx-time-date-format-year "%H:%M %e %b %Y"
+ "Format used for dates on a past year.
+See also `sx-time-date-format'."
+ :type 'string
+ :group 'sx)
+
+(defcustom sx-time-date-format "%H:%M - %d %b"
+ "Format used for dates on this year.
+See also `sx-time-date-format-year'."
+ :type 'string
+ :group 'sx)
+
+(defun sx-time-seconds-to-date (seconds)
+ "Return the integer SECONDS as a date string."
+ (let ((time (seconds-to-time seconds)))
+ (format-time-string
+ (if (string= (format-time-string "%Y")
+ (format-time-string "%Y" time))
+ sx-time-date-format
+ sx-time-date-format-year)
+ time)))
+
+(provide 'sx-time)
+;;; sx-time.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx-user.el --- handling and printing user information -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.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:
+
+\f
+;;; Code:
+(require 'sx)
+(require 'sx-button)
+
+(defgroup sx-user nil
+ "How users are displayed by SX."
+ :prefix "sx-user-"
+ :tag "SX User"
+ :group 'sx)
+
+(defcustom sx-question-mode-fallback-user
+ '(
+ (about_me . "")
+ (accept_rate . -1)
+ (account_id . -1)
+ (age . -1)
+ (answer_count . -1)
+ (badge_counts . ((bronze . -1) (silver . -1) (gold . -1)))
+ (creation_date . -1)
+ (display_name . "(unknown user)")
+ (down_vote_count . -1)
+ (is_employee . nil)
+ (last_access_date . -1)
+ (last_modified_date . -1)
+ (link . "")
+ (location . "")
+ (profile_image . ":(")
+ (question_count . -1)
+ (reputation . -1)
+ (reputation_change_day . -1)
+ (reputation_change_month . -1)
+ (reputation_change_quarter . -1)
+ (reputation_change_week . -1)
+ (reputation_change_year . -1)
+ (timed_penalty_date . -1)
+ (up_vote_count . -1)
+ (user_id . -1)
+ (user_type . does_not_exist)
+ (view_count . -1)
+ (website_url . "")
+ )
+ "The structure used to represent missing user information.
+NOOTE: SX relies on this variable containing all necessary user
+information. You may edit any of its fields, but you'll run into
+errors if you remove them."
+ :type '(alist :options ((about_me string)
+ (accept_rate integer)
+ (account_id integer)
+ (age integer)
+ (answer_count integer)
+ (badge_counts alist)
+ (creation_date integer)
+ (display_name string)
+ (down_vote_count integer)
+ (is_employee boolean)
+ (last_access_date integer)
+ (last_modified_date integer)
+ (link string)
+ (location string)
+ (profile_image string)
+ (question_count integer)
+ (reputation integer)
+ (reputation_change_day integer)
+ (reputation_change_month integer)
+ (reputation_change_quarter integer)
+ (reputation_change_week integer)
+ (reputation_change_year integer)
+ (timed_penalty_date integer)
+ (up_vote_count integer)
+ (user_id integer)
+ (user_type symbol)
+ (view_count integer)
+ (website_url string)))
+ :group 'sx-user)
+
+\f
+;;; Text properties
+(defface sx-user-name
+ '((t :inherit font-lock-builtin-face))
+ "Face used for user names."
+ :group 'sx-user)
+
+(defface sx-user-reputation
+ '((t :inherit font-lock-comment-face))
+ "Face used for user reputations."
+ :group 'sx-user)
+
+(defface sx-user-accept-rate
+ '((t))
+ "Face used for user accept-rates."
+ :group 'sx-user)
+
+(defvar sx-user--format-property-alist
+ `((?d button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
+ (?n button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
+ (?@ button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
+ (?r face sx-user-reputation)
+ (?a face sx-user-accept-rate))
+ "Alist relating % constructs with text properties.
+See `sx-user--format'.")
+
+\f
+;;; Formatting function
+(defun sx-user--format (format-string user)
+ "Use FORMAT-STRING to format the user object USER.
+The value is a copy of FORMAT-STRING, but with certain constructs
+replaced by text that describes the specified USER:
+
+%d is the display name.
+%@ is the display name in a format suitable for @mentions.
+%l is the link to the profile.
+%r is the reputation.
+%a is the accept rate.
+
+The string replaced in each of these construct is also given the
+text-properties specified in `sx-user--format-property-alist'.
+Specially, %d and %@ are turned into buttons with the
+`sx-button-user' category."
+ (sx-assoc-let (append user sx-question-mode-fallback-user)
+ (let* ((text (sx-format-replacements
+ format-string
+ `((?d . ,\.display_name)
+ (?n . ,\.display_name)
+ (?l . ,\.link)
+ (?r . ,\.reputation)
+ (?a . ,\.accept_rate)
+ (?@ . ,(when (string-match "%@" format-string)
+ (sx-user--@name .display_name)))
+ )
+ sx-user--format-property-alist)))
+ (if (< 0 (string-width .link))
+ (propertize text
+ ;; For visiting and stuff.
+ 'sx-button-url .link
+ 'sx-button-copy .link)
+ text))))
+
+\f
+;;; @name conversion
+(defconst sx-user--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 (display-name)
+ "Convert DISPLAY-NAME into an @mention.
+In order to correctly @mention the user, all whitespace is
+removed from DISPLAY-NAME and a series of unicode conversions are
+performed before it is returned.
+See `sx-user--ascii-replacement-list'.
+
+If all you need is the @name, this is very slightly faster than
+using `sx-user--format', but it doesn't do any sanity checking."
+ (concat "@" (sx--recursive-replace
+ sx-user--ascii-replacement-list display-name)))
+
+(provide 'sx-user)
+;;; sx-user.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2018 Sean Allred
+
+;; Author: Sean Allred <codeNOSPAMseanallred.com>
+;; URL: https://github.com/vermiculus/sx.el/
+;; Version: 0.3
+;; Keywords: help, hypermedia, tools
+;; 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
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines basic commands used by all other parts of SX.
+
+;;; Code:
+(require 'tabulated-list)
+
+(defconst sx-version "0.3" "Version of the `sx' package.")
+
+(defgroup sx nil
+ "Customization group for the `sx' package."
+ :prefix "sx-"
+ :tag "SX"
+ :group 'applications)
+
+\f
+;;; User commands
+(defun sx-version ()
+ "Print and return the version of the `sx' package."
+ (interactive)
+ (message "%s: %s" 'sx-version sx-version)
+ sx-version)
+
+;;;###autoload
+(defun sx-bug-report ()
+ "File a bug report about the `sx' package."
+ (interactive)
+ (if (featurep 'magithub)
+ (magithub-issue-new (magithub-repo "vermiculus/sx.el"))
+ (browse-url "https://github.com/vermiculus/sx.el/issues/new")))
+
+\f
+;;; 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_par (sx--site link)))))
+ ;; Try to strip a question or answer ID
+ (when (cond ;; Comment
+ ((or ;; If there's a #commentNUMBER_NUMBER at the end, we
+ ;; know it's a comment with that ID.
+ (string-match (rx "#comment" (group-n 1 (+ digit))
+ "_" (+ digit) string-end)
+ link)
+ ;; From inbox items
+ (string-match (rx "/posts/comments/"
+ ;; Comment ID
+ (group-n 1 (+ digit))
+ ;; Optional stuff at the end
+ (or (and (any "?#") (* any)) "")
+ string-end)
+ link))
+ (push '(type . comment) result))
+ ;; Answer
+ ((or ;; If there's a #NUMBER at the end, we know it's an
+ ;; answer with that ID.
+ (string-match (rx "#" (group-n 1 (+ digit)) string-end) link)
+ ;; From 'Share' button
+ (string-match (rx "/a/"
+ ;; Answer ID
+ (group-n 1 (+ digit)) "/"
+ ;; User ID
+ (+ digit)
+ ;; Garbage at the end
+ (optional (and (any "?#") (* any)))
+ string-end)
+ link)
+ ;; From URL
+ (string-match (rx "/questions/" (+ digit) "/"
+ ;; Question title
+ (+ (not (any "/"))) "/"
+ ;; Answer ID. If this is absent, we match on
+ ;; Question clause below.
+ (group-n 1 (+ digit))
+ (opt "/")
+ ;; Garbage at the end
+ (optional (and (any "?#") (* any)))
+ string-end)
+ link))
+ (push '(type . answer) result))
+ ;; Question
+ ((or ;; From 'Share' button
+ (string-match (rx "/q/"
+ ;; Question ID
+ (group-n 1 (+ digit))
+ ;; User ID
+ (optional "/" (+ digit))
+ ;; Garbage at the end
+ (optional (and (any "?#") (* any)))
+ string-end)
+ link)
+ ;; From URL
+ (string-match (rx "/questions/"
+ ;; Question ID
+ (group-n 1 (+ digit)) "/")
+ link))
+ (push '(type . question) result)))
+ (push (cons 'id (string-to-number (match-string-no-properties 1 link)))
+ result))
+ result))
+
+(defun sx--tree-paths (tree)
+ "Return a list of all paths in TREE.
+Adapted from http://stackoverflow.com/q/3019250."
+ (if (atom tree)
+ (list (list tree))
+ (apply #'append
+ (mapcar (lambda (node)
+ (mapcar (lambda (path)
+ (cons (car tree) path))
+ (sx--tree-paths node)))
+ (cdr tree)))))
+
+(defun sx--tree-expand (path-func tree)
+ "Apply PATH-FUNC to every path in TREE.
+Return the result. See `sx--tree-paths'."
+ (mapcar path-func
+ (apply #'append
+ (mapcar #'sx--tree-paths
+ tree))))
+
+(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))))
+
+(defun sx--pretty-site-parameter (site)
+ "Returned a pretty and capitalized version of string SITE."
+ (mapconcat #'capitalize
+ (split-string site "\\.")
+ " "))
+
+\f
+;;; Utility Functions
+(defun sx--split-string (string &optional separators)
+ "Split STRING into substrings bounded by matches for SEPARATORS."
+ (mapcar (lambda (s) (replace-regexp-in-string "\\` +\\| +\\'" "" s))
+ (split-string string separators 'omit-nulls)))
+
+(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-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'."
+ (message "[sx] %s" (apply #'format format-string args)))
+
+(defun sx-message-help-echo ()
+ "If there's a 'help-echo property under point, message it."
+ (let ((echo (get-text-property (point) 'help-echo)))
+ (when echo (message "%s" echo))))
+
+(defun sx--thing-as-string (thing &optional sequence-sep url-hexify)
+ "Return a string representation of THING.
+If THING is already a string, just return it.
+
+Optional argument SEQUENCE-SEP is the separator applied between
+elements of a sequence. If SEQUENCE-SEP is a list, use the first
+element for the top level joining, the second for the next level,
+etc. \";\" is used as a default.
+
+If optional argument URL-HEXIFY is non-nil, this function behaves
+as `url-hexify-string'; this option is only effective on strings
+and sequences of strings."
+ (let ((process (if url-hexify #'url-hexify-string #'identity))
+ (first-f (if (listp sequence-sep) #'car #'identity))
+ (rest-f (if (listp sequence-sep) #'cdr #'identity)))
+ (cond
+ ((stringp thing) (funcall process thing))
+ ((symbolp thing) (funcall process (symbol-name thing)))
+ ((numberp thing) (number-to-string thing))
+ ((sequencep thing)
+ (mapconcat (lambda (thing)
+ (sx--thing-as-string
+ thing (funcall rest-f sequence-sep) url-hexify))
+ thing (if sequence-sep
+ (funcall first-f sequence-sep)
+ ";"))))))
+
+(defun sx--shorten-url (url)
+ "Shorten URL hiding anything other than the domain.
+Paths after the domain are replaced with \"...\".
+Anything before the (sub)domain is removed."
+ (replace-regexp-in-string
+ ;; Remove anything after domain.
+ (rx (group-n 1 (and (1+ (any word ".")) "/"))
+ (1+ anything) string-end)
+ (eval-when-compile
+ (concat "\\1" (if (char-displayable-p ?…) "…" "...")))
+ ;; Remove anything before subdomain.
+ (replace-regexp-in-string
+ (rx string-start (or (and (0+ word) (optional ":") "//")))
+ "" url)))
+
+(defmacro sx--define-conditional-key (keymap key def &rest body)
+ "In KEYMAP, define key sequence KEY as DEF conditionally.
+This is like `define-key', except the definition \"disappears\"
+whenever BODY evaluates to nil."
+ (declare (indent 3)
+ (debug (form form form &rest sexp)))
+ `(define-key ,keymap ,key
+ '(menu-item
+ ,(format "maybe-%s" (or (car (cdr-safe def)) def)) ignore
+ :filter (lambda (&optional _)
+ (when (progn ,@body) ,def)))))
+
+(defun sx--goto-property-change (prop &optional direction)
+ "Move forward to the next change of text-property PROP.
+Return the new value of PROP at point.
+
+If DIRECTION is negative, move backwards instead."
+ (let ((func (if (and (numberp direction)
+ (< direction 0))
+ #'previous-single-property-change
+ #'next-single-property-change))
+ (limit (if (and (numberp direction)
+ (< direction 0))
+ (point-min) (point-max))))
+ (goto-char (funcall func (point) prop nil limit))
+ (get-text-property (point) prop)))
+
+(defun sx--find-in-buffer (type id)
+ "Move point to an object of TYPE and ID.
+That is, move forward from beginning of buffer until
+`sx--data-here' is an object of type TYPE with the respective id
+ID. If point is left at the of a line, move over the line break.
+
+TYPE is either question, answer, or comment.
+ID is an integer."
+ (let* ((id-symbol (cl-case type
+ (answer 'answer_id)
+ (comment 'comment_id)
+ (question 'question_id)))
+ (pos
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (or (eobp)
+ (let ((data (sx--data-here type t)))
+ (and data
+ (= id (or (cdr (assq id-symbol data))))))))
+ (forward-char 1))
+ (point))))
+ (if (equal pos (point-max))
+ (sx-message "Can't find the specified %s" type)
+ (goto-char pos)
+ (when (looking-at-p "$")
+ (forward-char 1)))))
+
+(defmacro sx--create-comparator (name doc compare-func get-func)
+ "Define a new comparator called NAME with documentation DOC.
+COMPARE-FUNC is a function that takes the return value of
+GET-FUNC and performs the actual comparison."
+ (declare (indent 1) (doc-string 2))
+ `(defun ,name (a b)
+ ,doc
+ (funcall ,compare-func
+ (funcall ,get-func a)
+ (funcall ,get-func b))))
+
+(defun sx--squash-whitespace (string)
+ "Return STRING with consecutive whitespace squashed together."
+ (replace-regexp-in-string "[ \r\n]+" " " string))
+
+(defun sx--deleted-p (data)
+ "Return non-nil if DATA represents a deleted object."
+ (eq (car data) 'deleted))
+
+(defun sx--invert-predicate (predicate)
+ "Return PREDICATE function with arguments inverted.
+For instance (sx--invert-predicate #'<) is the same as #'>.
+Note this is not the same as negating PREDICATE."
+ (lambda (&rest args) (apply predicate (reverse args))))
+
+\f
+;;; 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
+ "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)
+
+(defmacro sx--wrap-in-overlay (properties &rest body)
+ "Start a scope with overlay PROPERTIES and execute BODY.
+Overlay is pushed on the buffer-local variable `sx--overlays' and
+given PROPERTIES.
+
+Return the result of BODY."
+ (declare (indent 1)
+ (debug t))
+ `(let ((p (point-marker))
+ (result (progn ,@body))
+ ;; The first overlay is the shallowest. Any overlays created
+ ;; while the first one is still being created go deeper and
+ ;; deeper.
+ (sx--overlay-printing-depth (1+ sx--overlay-printing-depth)))
+ (let ((ov (make-overlay p (point)))
+ (props ,properties))
+ (while props
+ (overlay-put ov (pop props) (pop props)))
+ ;; Let's multiply by 10 just in case we ever want to put
+ ;; something in the middle.
+ (overlay-put ov 'priority (* 10 sx--overlay-printing-depth))
+ (push ov sx--overlays))
+ result))
+
+(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))
+
+(defun sx-format-replacements (format alist &optional property-alist)
+ "Use FORMAT-STRING to format the values in ALIST.
+ALIST is a list with elements of the form (CHAR . STRING).
+The value is a copy of FORMAT-STRING, but with certain constructs
+replaced by text as given by ALIST.
+
+The construct is a `%' character followed by any other character.
+The replacement is the STRING corresponding to CHAR in ALIST. In
+addition, if CHAR is also the car of an element in
+PROPERTY-ALIST, the cdr of that element should be a list of text
+properties which will be applied on the replacement.
+
+The %% construct is special, it is replaced with a single %, even
+if ALIST contains a different string at the ?% entry."
+ (let ((alist (cons '(?% . "%") alist)))
+ (with-temp-buffer
+ (insert format)
+ (goto-char (point-min))
+ (while (search-forward-regexp
+ (rx "%" (group-n 1 (* (any "-+ #0-9.")))) nil 'noerror)
+ (let* ((char (char-after))
+ ;; Understand flags
+ (flag (match-string 1))
+ (val (cdr-safe (assq char alist))))
+ (unless val
+ (error "Invalid format character: `%%%c'" char))
+ ;; Insert first, to preserve text properties.
+ (insert-and-inherit (format (concat "%" flag "s") val))
+ (when property-alist
+ (add-text-properties (match-end 0) (point)
+ (cdr-safe (assq char property-alist))))
+ ;; Delete the specifier body.
+ (delete-region (match-beginning 0)
+ (match-end 0))
+ ;; Delete `char-after'.
+ (delete-char 1)))
+ (buffer-string))))
+
+\f
+;;; Key definitions
+(defun sx--key-definitions-to-header-line (definitions)
+ "Return a `header-line-format' from DEFINITIONS.
+DEFINITIONS is a list where each element has one of the following two forms
+ (KEY COMMAND)
+ (KEY COMMAND DESCRIPTION)
+
+The latter are used to build the return value, the former are
+ignored."
+ (let ((ptize (lambda (x) `(:propertize ,x face mode-line-buffer-id)))
+ alist out)
+ (dolist (it definitions)
+ (when (> (length it) 2)
+ (let* ((key (car it))
+ (desc (elt it 2))
+ (cell (assoc desc alist)))
+ (if cell (push key (cdr cell))
+ (push (cons desc (list key)) alist)))))
+ (dolist (it alist out)
+ (let ((desc (car it))
+ (keys (cdr it)))
+ (push (list " "
+ (cons (funcall ptize (car keys))
+ (mapcar (lambda (k) `("," ,(funcall ptize k))) (cdr keys)))
+ (let ((match
+ (and (= 1 (length keys))
+ (string-match (regexp-quote (car keys)) desc))))
+ (if (and (numberp match) (= 0 match))
+ (substring desc (length (car keys)))
+ (concat ":" desc))))
+ out)))))
+
+\f
+(defcustom sx-init-hook nil
+ "Hook run when SX initializes.
+Run after `sx-init--internal-hook'."
+ :group 'sx
+ :type 'hook)
+
+(defvar sx-init--internal-hook nil
+ "Hook run when SX initializes.
+This is used internally to set initial values for variables such
+as filters.")
+
+(defmacro sx-init-variable (variable value &optional setter)
+ "Set VARIABLE to VALUE using SETTER.
+SETTER should be a function of two arguments. If SETTER is nil,
+`set' is used."
+ (eval
+ `(add-hook
+ 'sx-init--internal-hook
+ (lambda ()
+ (,(or setter #'setq) ,variable ,value))))
+ nil)
+
+(defvar sx-initialized nil
+ "Nil if sx hasn't been initialized yet.
+If it has, holds the time at which initialization happened.")
+
+(defun sx-initialize (&optional force)
+ "Run initialization hooks if they haven't been run yet.
+These are `sx-init--internal-hook' and `sx-init-hook'.
+
+If FORCE is non-nil, run them even if they've already been run."
+ (when (or force (not sx-initialized))
+ (prog1
+ (run-hooks 'sx-init--internal-hook
+ 'sx-init-hook)
+ (setq sx-initialized (current-time)))))
+
+(provide 'sx)
+;;; sx.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
projects / emacsconfig.git / commitdiff