diff options
Diffstat (limited to 'sx.el')
-rw-r--r-- | sx.el | 306 |
1 files changed, 170 insertions, 136 deletions
@@ -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: |