aboutsummaryrefslogtreecommitdiff
path: root/sx.el
diff options
context:
space:
mode:
Diffstat (limited to 'sx.el')
-rw-r--r--sx.el306
1 files changed, 170 insertions, 136 deletions
diff --git a/sx.el b/sx.el
index 8e3e5d3..62484b7 100644
--- a/sx.el
+++ b/sx.el
@@ -1,4 +1,4 @@
-;;; sx.el --- core functions of the sx package.
+;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes. -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Sean Allred
@@ -6,7 +6,7 @@
;; URL: https://github.com/vermiculus/sx.el/
;; Version: 0.1
;; Keywords: help, hypermedia, tools
-;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0"))
+;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0.3"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -31,12 +31,11 @@
(defconst sx-version "0.1" "Version of the `sx' package.")
(defgroup sx nil
- "Customization group for sx-question-mode."
+ "Customization group for the `sx' package."
:prefix "sx-"
:tag "SX"
:group 'applications)
-
;;; User commands
(defun sx-version ()
@@ -52,12 +51,111 @@
(browse-url "https://github.com/vermiculus/sx.el/issues/new"))
+;;; Site
+(defun sx--site (data)
+ "Get the site in which DATA belongs.
+DATA can be a question, answer, comment, or user (or any object
+with a `link' property).
+DATA can also be the link itself."
+ (let ((link (if (stringp data) data
+ (cdr (assoc 'link data)))))
+ (when (stringp link)
+ (replace-regexp-in-string
+ (rx string-start
+ "http" (optional "s") "://"
+ (or
+ (sequence
+ (group-n 1 (+ (not (any "/"))))
+ ".stackexchange")
+ (group-n 2 (+ (not (any "/")))))
+ "." (+ (not (any ".")))
+ "/" (* any)
+ string-end)
+ "\\1\\2" link))))
+
+(defun sx--ensure-site (data)
+ "Add a `site' property to DATA if it doesn't have one. Return DATA.
+DATA can be a question, answer, comment, or user (or any object
+with a `link' property)."
+ (when data
+ (let-alist data
+ (unless .site_par
+ ;; @TODO: Change this to .site.api_site_parameter sometime
+ ;; after February.
+ (setcdr data (cons (cons 'site_par
+ (or (cdr (assq 'api_site_parameter .site))
+ (sx--site data)))
+ (cdr data)))))
+ data))
+
+(defun sx--link-to-data (link)
+ "Convert string LINK into data that can be displayed."
+ (let ((result (list (cons 'site (sx--site link)))))
+ ;; Try to strip a question or answer ID
+ (when (or
+ ;; Answer
+ (and (or (string-match
+ ;; From 'Share' button
+ (rx "/a/"
+ ;; Question ID
+ (group (+ digit))
+ ;; User ID
+ "/" (+ digit)
+ ;; Answer ID
+ (group (or (sequence "#" (* any)) ""))
+ string-end) link)
+ (string-match
+ ;; From URL
+ (rx "/questions/" (+ digit) "/"
+ (+ (not (any "/"))) "/"
+ ;; User ID
+ (optional (group (+ digit)))
+ (optional "/")
+ (group (or (sequence "#" (* any)) ""))
+ string-end) link))
+ (push '(type . answer) result))
+ ;; Question
+ (and (or (string-match
+ ;; From 'Share' button
+ (rx "/q/"
+ ;; Question ID
+ (group (+ digit))
+ ;; User ID
+ (optional "/" (+ digit))
+ ;; Answer or Comment ID
+ (group (or (sequence "#" (* any)) ""))
+ string-end) link)
+ (string-match
+ ;; From URL
+ (rx "/questions/"
+ ;; Question ID
+ (group (+ digit))
+ "/") link))
+ (push '(type . question) result)))
+ (push (cons 'id (string-to-number (match-string-no-properties 1 link)))
+ result))
+ result))
+
+(defmacro sx-assoc-let (alist &rest body)
+ "Use ALIST with `let-alist' to execute BODY.
+`.site_par' has a special meaning, thanks to `sx--ensure-site'.
+If ALIST doesn't have a `site' property, one is created using the
+`link' property."
+ (declare (indent 1) (debug t))
+ (require 'let-alist)
+ `(progn
+ (sx--ensure-site ,alist)
+ ,(macroexpand
+ `(let-alist ,alist ,@body))))
+
+
;;; Browsing filter
(defvar sx-browse-filter
'((question.body_markdown
question.comments
question.answers
question.last_editor
+ question.last_activity_date
question.accepted_answer_id
question.link
question.upvoted
@@ -78,6 +176,7 @@
comment.comment_id
answer.answer_id
answer.last_editor
+ answer.last_activity_date
answer.link
answer.share_link
answer.owner
@@ -91,6 +190,29 @@ See `sx-question-get-questions' and `sx-question-get-question'.")
;;; Utility Functions
+(defun sx-completing-read (&rest args)
+ "Like `completing-read', but possibly use ido.
+All ARGS are passed to `completing-read' or `ido-completing-read'."
+ (apply (if ido-mode #'ido-completing-read #'completing-read)
+ args))
+
+(defun sx--multiple-read (prompt hist-var)
+ "Interactively query the user for a list of strings.
+Call `read-string' multiple times, until the input is empty.
+
+PROMPT is a string displayed to the user and should not end with
+a space nor a colon. HIST-VAR is a quoted symbol, indicating a
+list in which to store input history."
+ (let (list input)
+ (while (not (string=
+ ""
+ (setq input (read-string
+ (concat prompt " ["
+ (mapconcat #'identity list ",")
+ "]: ")
+ "" hist-var))))
+ (push input list))
+ list))
(defmacro sx-sorted-insert-skip-first (newelt list &optional predicate)
"Inserted NEWELT into LIST sorted by PREDICATE.
@@ -105,6 +227,12 @@ is intentionally skipped."
(setq tail (cdr tail)))
(setcdr tail (cons x (cdr tail)))))
+(defun sx-user-error (format-string &rest args)
+ "Like `user-error', but prepend FORMAT-STRING with \"[sx]\".
+See `format'."
+ (signal 'user-error
+ (list (apply #'format (concat "[sx] " format-string) args))))
+
(defun sx-message (format-string &rest args)
"Display FORMAT-STRING as a message with ARGS.
See `format'."
@@ -142,50 +270,6 @@ and sequences of strings."
(funcall first-f sequence-sep)
";"))))))
-(defun sx--filter-data (data desired-tree)
- "Filter DATA and return the DESIRED-TREE.
-
-For example:
-
- (sx--filter-data
- '((prop1 . value1)
- (prop2 . value2)
- (prop3
- (test1 . 1)
- (test2 . 2))
- (prop4 . t))
- '(prop1 (prop3 test2)))
-
-would yield
-
- ((prop1 . value1)
- (prop3
- (test2 . 2)))"
- (if (vectorp data)
- (apply #'vector
- (mapcar (lambda (entry)
- (sx--filter-data
- entry desired-tree))
- data))
- (delq
- nil
- (mapcar (lambda (cons-cell)
- ;; @TODO the resolution of `f' is O(2n) in the worst
- ;; case. It may be faster to implement the same
- ;; functionality as a `while' loop to stop looking the
- ;; list once it has found a match. Do speed tests.
- ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e.
- (let ((f (or (memq (car cons-cell) desired-tree)
- (assoc (car cons-cell) desired-tree))))
- (when f
- (if (and (sequencep (cdr cons-cell))
- (sequencep (elt (cdr cons-cell) 0)))
- (cons (car cons-cell)
- (sx--filter-data
- (cdr cons-cell) (cdr f)))
- cons-cell))))
- data))))
-
(defun sx--shorten-url (url)
"Shorten URL hiding anything other than the domain.
Paths after the domain are replaced with \"...\".
@@ -197,45 +281,17 @@ Anything before the (sub)domain is removed."
(eval-when-compile
(concat "\\1" (if (char-displayable-p ?…) "…" "...")))
;; Remove anything before subdomain.
- (replace-regexp-in-string
+ (replace-regexp-in-string
(rx string-start (or (and (0+ word) (optional ":") "//")))
"" url)))
-(defun sx--unindent-text (text)
- "Remove indentation from TEXT.
-Primarily designed to extract the content of markdown code
-blocks."
- (with-temp-buffer
- (insert text)
- (goto-char (point-min))
- (let (result)
- ;; Get indentation of each non-blank line
- (while (null (eobp))
- (skip-chars-forward "[:blank:]")
- (unless (looking-at "$")
- (push (current-column) result))
- (forward-line 1))
- (when result
- ;; Build a regexp with the smallest indentation
- (let ((rx (format "^ \\{0,%s\\}"
- (apply #'min result))))
- (goto-char (point-min))
- ;; Use this regexp to remove that much indentation
- ;; throughout the buffer.
- (while (and (null (eobp))
- (search-forward-regexp rx nil 'noerror))
- (replace-match "")
- (forward-line 1)))))
- ;; Return the buffer
- (buffer-string)))
-
;;; Printing request data
(defvar sx--overlays nil
"Overlays created by sx on this buffer.")
(make-variable-buffer-local 'sx--overlays)
-(defvar sx--overlay-printing-depth 0
+(defvar sx--overlay-printing-depth 0
"Track how many overlays we're printing on top of each other.
Used for assigning higher priority to inner overlays.")
(make-variable-buffer-local 'sx--overlay-printing-depth)
@@ -264,71 +320,50 @@ Return the result of BODY."
(push ov sx--overlays))
result))
+(defvar sx--ascii-replacement-list
+ '(("[:space:]" . "")
+ ("àåáâäãåą" . "a")
+ ("èéêëę" . "e")
+ ("ìíîïı" . "i")
+ ("òóôõöøőð" . "o")
+ ("ùúûüŭů" . "u")
+ ("çćčĉ" . "c")
+ ("żźž" . "z")
+ ("śşšŝ" . "s")
+ ("ñń" . "n")
+ ("ýÿ" . "y")
+ ("ğĝ" . "g")
+ ("ř" . "r")
+ ("ł" . "l")
+ ("đ" . "d")
+ ("ß" . "ss")
+ ("Þ" . "th")
+ ("ĥ" . "h")
+ ("ĵ" . "j")
+ ("^[:ascii:]" . ""))
+ "List of replacements to use for non-ascii characters.
+Used to convert user names into @mentions.")
+
(defun sx--user-@name (user)
"Get the `display_name' of USER prepended with @.
In order to correctly @mention the user, all whitespace is
removed from the display name before it is returned."
(sx-assoc-let user
(when (stringp .display_name)
- (concat "@" (replace-regexp-in-string
- "[[:space:]]" "" .display_name)))))
+ (concat "@" (sx--recursive-replace
+ sx--ascii-replacement-list .display_name)))))
+
+(defun sx--recursive-replace (alist string)
+ "Replace each car of ALIST with its cdr in STRING."
+ (if alist
+ (sx--recursive-replace
+ (cdr alist)
+ (let ((kar (car alist)))
+ (replace-regexp-in-string
+ (format "[%s]" (car kar)) (cdr kar) string)))
+ string))
-;;; Assoc-let
-(defun sx--site (data)
- "Get the site in which DATA belongs.
-DATA can be a question, answer, comment, or user (or any object
-with a `link' property).
-DATA can also be the link itself."
- (let ((link (if (stringp data) data
- (cdr (assoc 'link data)))))
- (when (stringp link)
- (replace-regexp-in-string
- "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$"
- "\\1\\2" link))))
-
-(defun sx--deep-dot-search (data)
- "Find symbols somewhere inside DATA which start with a `.'.
-Returns a list where each element is a cons cell. The car is the
-symbol, the cdr is the symbol without the `.'."
- (cond
- ((symbolp data)
- (let ((name (symbol-name data)))
- (when (string-match "\\`\\." name)
- ;; Return the cons cell inside a list, so it can be appended
- ;; with other results in the clause below.
- (list (cons data (intern (replace-match "" nil nil name)))))))
- ((not (listp data)) nil)
- (t (apply
- #'append
- (remove nil (mapcar #'sx--deep-dot-search data))))))
-
-(defmacro sx-assoc-let (alist &rest body)
- "Use dotted symbols let-bound to their values in ALIST and execute BODY.
-Dotted symbol is any symbol starting with a `.'. Only those
-present in BODY are letbound, which leads to optimal performance.
-The .site symbol is special, it is derived from the .link symbol
-using `sx--site'.
-
-For instance, the following code
-
- (sx-assoc-let alist
- (list .title .body))
-
-is equivalent to
-
- (let ((.title (cdr (assoc 'title alist)))
- (.body (cdr (assoc 'body alist))))
- (list .title .body))"
- (declare (indent 1) (debug t))
- (let* ((symbol-alist (sx--deep-dot-search body))
- (has-site (assoc '.site symbol-alist)))
- `(let ,(append
- (when has-site `((.site (sx--site (cdr (assoc 'link ,alist))))))
- (mapcar (lambda (x) `(,(car x) (cdr (assoc ',(cdr x) ,alist))))
- (remove '(.site . site) (delete-dups symbol-alist))))
- ,@body)))
-
(defcustom sx-init-hook nil
"Hook run when SX initializes.
Run after `sx-init--internal-hook'."
@@ -378,5 +413,4 @@ If FORCE is non-nil, run them even if they've already been run."
;; Local Variables:
;; indent-tabs-mode: nil
-;; lexical-binding: t
;; End: