;;; sx.el --- core functions of the sx package. ;; Copyright (C) 2014 Sean Allred ;; Author: Sean Allred ;; 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")) ;; 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 . ;;; Commentary: ;; This file defines basic commands used by all other parts of SX. ;;; Code: (require 'tabulated-list) (defconst sx-version "0.1" "Version of the `sx' package.") (defgroup sx nil "Customization group for sx-question-mode." :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")) ;;; Browsing filter (defvar sx-browse-filter '((question.body_markdown question.comments question.answers question.last_editor question.accepted_answer_id question.link question.upvoted question.downvoted question.question_id question.share_link user.display_name comment.owner comment.body_markdown comment.body comment.link comment.edited comment.creation_date comment.upvoted comment.score comment.post_type comment.post_id comment.comment_id answer.answer_id answer.last_editor answer.link answer.share_link answer.owner answer.body_markdown answer.upvoted answer.downvoted answer.comments) (user.profile_image shallow_user.profile_image)) "The filter applied when retrieving question data. See `sx-question-get-questions' and `sx-question-get-question'.") ;;; Utility Functions (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. (,(or predicate #'<) x (cadr tail))) (setq tail (cdr tail))) (setcdr tail (cons x (cdr tail))))) (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--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 \"...\". 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))) (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 "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--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))))) ;;; 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'." :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.") (defun sx--< (property x y &optional predicate) "Non-nil if PROPERTY attribute of alist X is less than that of Y. With optional argument PREDICATE, use it instead of `<'." (funcall (or predicate #'<) (cdr (assoc property x)) (cdr (assoc property y)))) (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 ;; lexical-binding: t ;; End: