gergely/my-emacs-d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Install the sx package

Browse Source
This commit is contained in:
Gergely Polonkai 2016-09-22 15:58:26 +00:00
parent b4084cd616
commit 1f4e059413
29 changed files with 6722 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

196
elpa/sx-20160125.1601/sx-auth.el Normal file
View File

@ -0,0 +1,196 @@
;;; sx-auth.el --- user authentication -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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
"http://seanallred.com/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
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 . ,(url-hexify-string
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:

154
elpa/sx-20160125.1601/sx-autoloads.el Normal file
View File

@ -0,0 +1,154 @@
;;; sx-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "sx" "sx.el" (22499 64016 771000 0))
;;; Generated autoloads from sx.el
(autoload 'sx-bug-report "sx" "\
File a bug report about the `sx' package.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "sx-auth" "sx-auth.el" (22499 64016 736000
;;;;;; 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
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)
;;;***
;;;### (autoloads nil "sx-inbox" "sx-inbox.el" (22499 64016 832000
;;;;;; 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)
;;;***
;;;### (autoloads nil "sx-interaction" "sx-interaction.el" (22499
;;;;;; 64016 748000 0))
;;; Generated autoloads from sx-interaction.el
(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)
;;;***
;;;### (autoloads nil "sx-search" "sx-search.el" (22499 64016 829000
;;;;;; 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)
;;;***
;;;### (autoloads nil "sx-switchto" "sx-switchto.el" (22499 64016
;;;;;; 752000 0))
;;; Generated autoloads from sx-switchto.el
(define-prefix-command 'sx-switchto-map)
;;;***
;;;### (autoloads nil "sx-tab" "sx-tab.el" (22499 64016 778000 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)
;;;***
;;;### (autoloads nil nil ("sx-babel.el" "sx-button.el" "sx-cache.el"
;;;;;; "sx-compose.el" "sx-encoding.el" "sx-favorites.el" "sx-filter.el"
;;;;;; "sx-load.el" "sx-method.el" "sx-networks.el" "sx-notify.el"
;;;;;; "sx-pkg.el" "sx-question-list.el" "sx-question-mode.el" "sx-question-print.el"
;;;;;; "sx-question.el" "sx-request.el" "sx-site.el" "sx-tag.el"
;;;;;; "sx-time.el" "sx-user.el") (22499 64016 864121 943000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; sx-autoloads.el ends here

133
elpa/sx-20160125.1601/sx-babel.el Normal file
View File

@ -0,0 +1,133 @@
;;; sx-babel.el --- font-locking pre blocks according to language -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains functions and a variable for font-locking the
;; content of markdown pre blocks according to their language. The
;; main configuration point, for both the user and the developer is
;; the variable `sx-babel-major-mode-alist', which see.
;;; Code:
(require 'sx-button)
(defvar sx-babel-major-mode-alist
`((,(rx (or "*" "#+")) org-mode)
(,(rx (or "[" "(" ";" "#(")) emacs-lisp-mode)
;; @TODO: Make shell-mode work here. Currently errors because it
;; needs a process. `sh-mode' isn't as nice.
(,(rx (or "$ " "# ")) sh-mode)
;; 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)
;;; 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:

215
elpa/sx-20160125.1601/sx-button.el Normal file
View File

@ -0,0 +1,215 @@
;;; sx-button.el --- defining buttons -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This file defines 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.
;;; 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")
;;; 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)
;;; 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)))))
;;; 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.")
;;; 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:

119
elpa/sx-20160125.1601/sx-cache.el Normal file
View File

@ -0,0 +1,119 @@
;;; sx-cache.el --- caching -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:

355
elpa/sx-20160125.1601/sx-compose.el Normal file
View File

@ -0,0 +1,355 @@
;;; sx-compose.el --- major-mode for composing questions and answers -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file defines `sx-compose-mode' and its auxiliary functions and
;; variables. In order to use `sx-compose-mode', it is vital that the
;; variable `sx-compose--send-function' be set. Otherwise it's just a
;; regular markdown buffer.
;;
;; In order to help avoid mistakes, there is the function
;; `sx-compose-create'. This is the preferred way of activating the
;; mode. It creates a buffer, activates the major mode, and sets the
;; `send-function' variable according to the arguments it is given.
;;; Code:
(require 'markdown-mode)
(require 'sx)
(require 'sx-tag)
(defgroup sx-compose-mode nil
"Customization group for sx-compose-mode."
:prefix "sx-compose-mode-"
:tag "SX compose Mode"
:group 'sx)
;;; Faces and Variables
(defvar sx-compose-before-send-hook nil
"Hook run before POSTing to the API.
Functions are called without arguments and should return non-nil.
Returning nil indicates something went wrong and the sending will
be aborted. In this case, the function is responsible for
notifying the user.
Current buffer is the compose-mode buffer whose content is about
to be POSTed.")
(defvar sx-compose-after-send-functions nil
"Hook run after POSTing to the API.
Functions on this hook should take two arguments, the
`sx-compose-mode' buffer (which not be live) and the data
returned by `sx-compose--send-function' (usually the object
created by the API). They are only called if the transaction
succeeds.")
(defvar sx-compose--send-function nil
"Function used by `sx-compose-send' to send the data.
Is invoked between `sx-compose-before-send-hook' and
`sx-compose-after-send-functions'.")
(defconst sx-compose--question-headers
(concat
#("Title: " 0 7 (intangible t read-only t rear-nonsticky t))
"%s"
#("\n" 0 1 (read-only t))
#("Tags : " 0 7 (read-only t intangible t rear-nonsticky t))
"%s"
#("\n" 0 1 (read-only t rear-nonsticky t))
#("________________________________________\n"
0 41 (read-only t rear-nonsticky t intangible t
sx-compose-separator t))
"\n")
"Headers inserted when composing a new question.
Used by `sx-compose-create'.")
(defconst sx-compose--header-line
'(" "
(:propertize "C-c C-c" face mode-line-buffer-id)
": Finish and Send"
(sx-compose--is-question-p
(" "
(:propertize "C-c C-q" face mode-line-buffer-id)
": Insert tags"))
" "
(:propertize "C-c C-k" face mode-line-buffer-id)
": Discard Draft")
"Header-line used on `sx-compose-mode' drafts.")
(defvar sx-compose--is-question-p nil
"Non-nil if this `sx-compose-mode' buffer is a question.")
(make-variable-buffer-local 'sx-compose--is-question-p)
(defvar sx-compose--site nil
"Site which the curent compose buffer belongs to.")
(make-variable-buffer-local 'sx-compose--site)
;;; Major-mode
(define-derived-mode sx-compose-mode markdown-mode "Compose"
"Major mode for coposing questions and answers.
Most of the functionality comes from `markdown-mode'. This mode
just implements some extra features related to posting to the
API.
This mode won't function if `sx-compose--send-function' isn't
set. To make sure you set it correctly, you can create the
buffer with the `sx-compose-create' function.
If creating a question draft, the `sx-compose--is-question-p'
variable should also be set to enable more functionality.
\\<sx-compose-mode>
\\{sx-compose-mode}"
(setq header-line-format sx-compose--header-line)
(add-hook 'sx-compose-after-send-functions
#'sx-compose-quit nil t)
(add-hook 'sx-compose-after-send-functions
#'sx-compose--copy-as-kill nil t))
(define-key sx-compose-mode-map "\C-c\C-c" #'sx-compose-send)
(define-key sx-compose-mode-map "\C-c\C-k" #'sx-compose-quit)
(sx--define-conditional-key
sx-compose-mode-map "\C-c\C-q" #'sx-compose-insert-tags
sx-compose--is-question-p)
(defun sx-compose-send ()
"Finish composing current buffer and send it.
Calls `sx-compose-before-send-hook', POSTs the the current buffer
contents to the API, then calls `sx-compose-after-send-functions'."
(interactive)
(when (run-hook-with-args-until-failure
'sx-compose-before-send-hook)
(let ((result (funcall sx-compose--send-function))
(buf (current-buffer)))
(run-hook-wrapped
'sx-compose-after-send-functions
(lambda (func)
(with-demoted-errors
"[sx] Error encountered AFTER sending post, but the post was sent successfully: %s"
(funcall func buf result))
nil)))))
(defun sx-compose-insert-tags ()
"Prompt for a tag list for this draft and insert them."
(interactive)
(save-excursion
(let* ((old (sx-compose--goto-tag-header))
(new
(save-match-data
(mapconcat
#'identity
(sx-tag-multiple-read sx-compose--site "Tags" old)
" "))))
(if (match-string 1)
(replace-match new :fixedcase nil nil 1)
(insert new)))))
;;; Functions for use in hooks
(defun sx-compose-quit (buffer _)
"Close BUFFER's window and kill it."
(interactive (list (current-buffer) nil))
(when (buffer-live-p buffer)
(let ((w (get-buffer-window buffer)))
(when (window-live-p w)
(ignore-errors (delete-window w))))
(kill-buffer buffer)))
(defun sx-compose--copy-as-kill (buffer _)
"Copy BUFFER contents to the kill-ring."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(kill-new (buffer-string)))))
(defun sx-compose--goto-tag-header ()
"Move to the \"Tags:\" header.
Match data is set so group 1 encompasses any already inserted
tags. Return a list of already inserted tags."
(goto-char (point-min))
(unless (search-forward-regexp
(rx bol "Tags : " (group-n 1 (* not-newline)) eol)
(next-single-property-change (point-min) 'sx-compose-separator)
'noerror)
(error "No Tags header found"))
(save-match-data
(sx--split-string (match-string 1) (rx (any space ",;")))))
(defun sx-compose--check-tags ()
"Check if tags in current compose buffer are valid."
(save-excursion
(let ((invalid-tags
(sx-tag--invalid-name-p
sx-compose--site (sx-compose--goto-tag-header))))
(if invalid-tags
;; If the user doesn't want to create the tags, we return
;; nil and sending is aborted.
(y-or-n-p (format "Following tags don't exist. Create them? %s " invalid-tags))
t))))
;;; Functions to help preparing buffers
(defun sx-compose-create (site parent &optional before-functions after-functions)
"Create an `sx-compose-mode' buffer.
SITE is the site where it will be posted.
If composing questions, PARENT is nil.
If composing answers, it is the `question_id'.
If editing answers or questions, it should be the alist data
related to that object.
Each element of BEFORE-FUNCTIONS and AFTER-FUNCTIONS are
respectively added locally to `sx-compose-before-send-hook' and
`sx-compose-after-send-functions'."
(or (integerp parent) (listp parent)
(error "Invalid PARENT"))
(let ((is-question
(and (listp parent)
(or (null parent)
(cdr (assoc 'title parent))))))
(with-current-buffer (sx-compose--get-buffer-create site parent)
(sx-compose-mode)
(setq sx-compose--site site)
(setq sx-compose--is-question-p is-question)
(setq sx-compose--send-function
(if (consp parent)
(sx-assoc-let parent
(lambda () (sx-method-call (cond
(.title 'questions)
(.comment_id 'comments)
(t 'answers))
:auth 'warn
:url-method 'post
:filter sx-browse-filter
:site site
:keywords (sx-compose--generate-keywords is-question)
:id (or .comment_id .answer_id .question_id)
:submethod 'edit)))
(lambda () (sx-method-call 'questions
:auth 'warn
:url-method 'post
:filter sx-browse-filter
:site site
:keywords (sx-compose--generate-keywords is-question)
:id parent
:submethod (if parent 'answers/add 'add)))))
;; Reverse so they're left in the same order.
(dolist (it (reverse before-functions))
(add-hook 'sx-compose-before-send-hook it nil t))
(dolist (it (reverse after-functions))
(add-hook 'sx-compose-after-send-functions it nil t))
(when is-question
(add-hook 'sx-compose-before-send-hook #'sx-compose--check-tags nil t))
;; If the buffer is empty, the draft didn't exist. So prepare the
;; question.
(when (or (string= (buffer-string) "")
(y-or-n-p "Draft buffer exists. Reset it? "))
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
(erase-buffer)
(when (consp parent)
(insert (cdr (assoc 'body_markdown parent))))
(when is-question
(sx-compose--print-question-headers
(when (consp parent) parent))
(unless (consp parent)
(goto-char (point-min))
(goto-char (line-end-position))))))
;; Return the buffer
(current-buffer))))
(defun sx-compose--print-question-headers (question)
"Print question headers for the compose buffer.
If QUESTION is non-nil, fill the headers with the data from
QUESTION."
(sx-assoc-let question
(goto-char (point-min))
(insert
(format sx-compose--question-headers
(or .title "") (mapconcat #'identity .tags " ")))))
(defun sx-compose--generate-keywords (is-question)
"Reading current buffer, generate a keywords alist.
Keywords meant to be used in `sx-method-call'.
`body' is read as the `buffer-string'. If IS-QUESTION is non-nil,
other keywords are read from the header "
(goto-char (point-min))
`(,@(when is-question
(let ((inhibit-point-motion-hooks t)
(header-end
(next-single-property-change
(point-min) 'sx-compose-separator))
keywords)
;; Read the Title.
(unless (search-forward-regexp
"^Title: *\\(.*\\) *$" header-end 'noerror)
(error "No Title header found"))
(push (cons 'title (match-string 1)) keywords)
;; And the tags
(goto-char (point-min))
(unless (search-forward-regexp "^Tags : *\\([^[:space:]].*\\) *$"
header-end 'noerror)
(error "No Tags header found"))
(push (cons 'tags (sx--split-string (match-string 1) "[[:space:],;]"))
keywords)
;; And move past the header so it doesn't get sent.
(goto-char (next-single-property-change
header-end 'sx-compose-separator))
keywords))
(body . ,(buffer-substring-no-properties (point) (point-max)))))
(defun sx-compose--get-buffer-create (site data)
"Get or create a buffer for use with `sx-compose-mode'.
SITE is the site for which composing is aimed (just used to
uniquely identify the buffers).
If DATA is nil, get a fresh compose buffer.
If DATA is an integer, try to find an existing buffer
corresponding to that integer, otherwise create one.
If DATA is an alist (question or answer data), like above but use
the id property."
(cond
((null data)
(generate-new-buffer
(format "*sx draft question %s*" site)))
((integerp data)
(get-buffer-create
(format "*sx draft answer %s %s*"
site data)))
(t
(get-buffer-create
(sx-assoc-let data
(format "*sx draft edit %s %s %s*"
site
(cond (.title "question")
(.comment_id "comment")
(t "answer"))
(or .comment_id .answer_id .question_id)))))))
(provide 'sx-compose)
;;; sx-compose.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

179
elpa/sx-20160125.1601/sx-encoding.el Normal file
View File

@ -0,0 +1,179 @@
;;; sx-encoding.el --- encoding -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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)
;;;; 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. \"&quot;\") 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 &quot;
(or (plist-get plist (intern ss))
;; Handle things like &#39;
(char-to-string
(string-to-number
;; Skip the `#'
(substring ss 1))))))))
(replace-regexp-in-string "&[^; ]*;" get-function string)))
;;;; 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))))
;;;; 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
(equal (substring (string-as-unibyte data) 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:

83
elpa/sx-20160125.1601/sx-favorites.el Normal file
View File

@ -0,0 +1,83 @@
;;; sx-favorites.el --- starred questions -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:

172
elpa/sx-20160125.1601/sx-filter.el Normal file
View File

@ -0,0 +1,172 @@
;;; sx-filter.el --- handles retrieval of filters -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:
;;; Dependencies
(require 'sx)
(require 'sx-cache)
(require 'sx-request)
;;; 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\")
...)")
;;; 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))))
;;; 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))))
;;; 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:

216
elpa/sx-20160125.1601/sx-inbox.el Normal file
View File

@ -0,0 +1,216 @@
;;; sx-inbox.el --- base inbox logic -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'sx)
(require 'sx-filter)
(require 'sx-method)
(require 'sx-question-list)
(require 'sx-interaction)
;;; 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)
(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))
;;; 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))
;;; Keybinds
(mapc (lambda (x) (define-key sx-inbox-mode-map (car x) (cadr x)))
'(
("t" nil)
("a" nil)
("h" nil)
("m" sx-inbox-mark-read)
([?\r] sx-display)
))
;;; print-info
(defun sx-inbox--print-info (data)
"Convert `json-read' DATA into tabulated-list format.
This is the default printer used by `sx-inbox'. It assumes DATA
is an alist containing the elements:
`answer_id', `body', `comment_id', `creation_date', `is_unread',
`item_type', `link', `question_id', `site', `title'."
(list
data
(sx-assoc-let data
(vector
(list
(concat (capitalize
(replace-regexp-in-string
"_" " " (or .item_type .notification_type)))
(cond (.answer_id " on Answer at:")
(.question_id " on:")))
'face 'font-lock-keyword-face)
(list
(concat (sx-time-since .creation_date)
sx-question-list-ago-string)
'face 'sx-question-list-date)
(list
(propertize
" " 'display
(concat "\n " (propertize .title 'face 'sx-question-list-date) "\n"
(let ((col fill-column))
(with-temp-buffer
(setq fill-column col)
(insert " " .body)
(fill-region (point-min) (point-max))
(buffer-string))))
'face 'default))))))
;;; Entry commands
(defvar sx-inbox--buffer nil
"Buffer being used to display inbox.")
;;;###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:

577
elpa/sx-20160125.1601/sx-interaction.el Normal file
View File

@ -0,0 +1,577 @@
;;; sx-interaction.el --- voting, commenting, and other interaction -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file holds a series of functions for performing arbitrary
;; interactions with arbitrary objects (objects here always mean the
;; alist of a question, answer, or comment). All commands take at
;; least a DATA argument corresponding to the object which, when
;; called interactively, is always derived from the context at point
;; (usually using the `sx--data-here' function).
;;
;; Interactions represented here involve voting, commenting, asking,
;; answering, editing.
;;
;; These are commands are meant to be available throughout the
;; interface. So it didn't make sense to put them in a specific
;; module. They also rely on a lot of dependencies, so they couldn't
;; be put in sx.el.
;;; Code:
(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)
;;; 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))))
;;; 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)))))
(defun sx-open-link (link)
"Visit element given by LINK inside Emacs.
Element can be a question, answer, or comment."
(interactive
(let ((def (with-temp-buffer
(save-excursion (yank))
(thing-at-point 'url))))
(list (read-string (concat "Link (" def "): ") nil nil def))))
;; 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"
'(add-to-list 'org-store-link-functions #'sx-org-get-link))
;;; 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))))
;;; 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)))
;;; 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)))
;;; 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)))))
;;; 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)
;;; 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))))))))
;;; 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)))))))
;;; 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:

56
elpa/sx-20160125.1601/sx-load.el Normal file
View File

@ -0,0 +1,56 @@
;;; sx-load.el --- load all files of the SX package -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(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:

184
elpa/sx-20160125.1601/sx-method.el Normal file
View File

@ -0,0 +1,184 @@
;;; sx-method.el --- method calls -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:

105
elpa/sx-20160125.1601/sx-networks.el Normal file
View File

@ -0,0 +1,105 @@
;;; sx-networks.el --- user network information -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:

86
elpa/sx-20160125.1601/sx-notify.el Normal file
View File

@ -0,0 +1,86 @@
;;; sx-notify.el --- mode-line notifications -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'sx)
(require 'sx-inbox)
;;; mode-line notification
(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)
;;; 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:

11
elpa/sx-20160125.1601/sx-pkg.el Normal file
View File

@ -0,0 +1,11 @@
(define-package "sx" "20160125.1601" "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"))
:url "https://github.com/vermiculus/sx.el/" :keywords
'("help" "hypermedia" "tools"))
;; Local Variables:
;; no-byte-compile: t
;; End:

674
elpa/sx-20160125.1601/sx-question-list.el Normal file
View File

@ -0,0 +1,674 @@
;;; sx-question-list.el --- major-mode for navigating questions list -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; 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)
;;; 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)
;;; 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)))
;;; 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)))))
;;; 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:

309
elpa/sx-20160125.1601/sx-question-mode.el Normal file
View File

@ -0,0 +1,309 @@
;;; sx-question-mode.el --- major-mode for displaying questions -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides a means to print questions with their answers
;; and all comments. See the customizable group `sx-question-mode'.
;;; Code:
(eval-when-compile
(require 'rx))
(require 'sx)
(require 'sx-switchto)
(require 'sx-question)
(require 'sx-question-print)
;;; 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."
(car-safe
(cl-member-if
(lambda (x) (with-selected-window x
(derived-mode-p 'sx-question-mode)))
(window-list nil 'never nil))))
(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)
;;; 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)))
;;; 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.")
;;; 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:

816
elpa/sx-20160125.1601/sx-question-print.el Normal file
View File

@ -0,0 +1,816 @@
;;; sx-question-print.el --- populating the question-mode buffer with content -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require '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)
;;; 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)
;;; 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 .answers sx-question-mode-answer-sort-function))))
(insert "\n\n ")
(insert-text-button "Write an Answer" :type 'sx-button-answer)
;; 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)))))
;;;; 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))))
;;; 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-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))))))))))))
;;; 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)))))
;;; 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:

236
elpa/sx-20160125.1601/sx-question.el Normal file
View File

@ -0,0 +1,236 @@
;;; sx-question.el --- question logic -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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.
;;; 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))))
;;; 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)))
;;;; 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)))))
;;;; 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)))
;;; 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:

338
elpa/sx-20160125.1601/sx-request.el Normal file
View File

@ -0,0 +1,338 @@
;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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)
;;; 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.")
;;; 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."
'(()))
;;; 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))))
;;; 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))
"&")))
;;; 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:

153
elpa/sx-20160125.1601/sx-search.el Normal file
View File

@ -0,0 +1,153 @@
;;; sx-search.el --- searching for questions -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Implements 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'.
;;; 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.")
;;; 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)
;;;###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))))
;;; 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:

68
elpa/sx-20160125.1601/sx-site.el Normal file
View File

@ -0,0 +1,68 @@
;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:

63
elpa/sx-20160125.1601/sx-switchto.el Normal file
View File

@ -0,0 +1,63 @@
;;; sx-switchto.el --- keymap for navigating between pages -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'sx)
;;; 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)
))
;;; 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:

253
elpa/sx-20160125.1601/sx-tab.el Normal file
View File

@ -0,0 +1,253 @@
;;; sx-tab.el --- functions for viewing different tabs -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file 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."))
;;; 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)))))
;;; 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)
;;; 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)))))
;;; 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:

179
elpa/sx-20160125.1601/sx-tag.el Normal file
View File

@ -0,0 +1,179 @@
;;; 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:
;;; 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)
;;; 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)))
;;; Getting tags from our data branch. Without the API.
;;;; @TODO: Once the cache is finished, this can probably be made into
;;;; a cache variasble with 1 day expiration time.
(defvar sx-tag-list-alist nil
"Alist where the tag list for each site is stored.
Elements are of the type (SITE . TAG-LIST).")
(defun sx-tag-list--get (site)
"Retrieve all tags from SITE in a single request.
This does not access the API. Instead, it uses
`sx-request-get-data', which accesses SX's tag cache."
(or (cdr (assoc site sx-tag-list-alist))
(let ((list (sx-request-get-data (concat "tags/" site))))
(push (cons site list) sx-tag-list-alist)
list)))
;;; Check tag validity
(defun sx-tag--invalid-name-p (site tags)
"Nil if TAGS exist in SITE.
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)))
;;; 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)))
;;; 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:

84
elpa/sx-20160125.1601/sx-time.el Normal file
View File

@ -0,0 +1,84 @@
;;; sx-time.el --- time -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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:

203
elpa/sx-20160125.1601/sx-user.el Normal file
View File

@ -0,0 +1,203 @@
;;; sx-user.el --- handling and printing user information -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'sx)
(require 'sx-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)
;;; 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'.")
;;; 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))))
;;; @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:

505
elpa/sx-20160125.1601/sx.el Normal file
View File

@ -0,0 +1,505 @@
;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
;; Author: Sean Allred <code@seanallred.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)
;;; 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)
(browse-url "https://github.com/vermiculus/sx.el/issues/new"))
;;; Site
(defun sx--site (data)
"Get the site in which DATA belongs.
DATA can be a question, answer, comment, or user (or any object
with a `link' property).
DATA can also be the link itself."
(let ((link (if (stringp data) data
(cdr (assoc 'link data)))))
(when (stringp link)
(replace-regexp-in-string
(rx string-start
"http" (optional "s") "://"
(or
(sequence
(group-n 1 (+ (not (any "/"))))
".stackexchange")
(group-n 2 (+ (not (any "/")))))
"." (+ (not (any ".")))
"/" (* any)
string-end)
"\\1\\2" link))))
(defun sx--ensure-site (data)
"Add a `site' property to DATA if it doesn't have one. Return DATA.
DATA can be a question, answer, comment, or user (or any object
with a `link' property)."
(when data
(let-alist data
(unless .site_par
;; @TODO: Change this to .site.api_site_parameter sometime
;; after February.
(setcdr data (cons (cons 'site_par
(or (cdr (assq 'api_site_parameter .site))
(sx--site data)))
(cdr data)))))
data))
(defun sx--link-to-data (link)
"Convert string LINK into data that can be displayed."
(let ((result (list (cons 'site_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 "\\.")
" "))
;;; 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))))
;;; 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))))
;;; 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)))))
(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: