code.delx.au - gnu-emacs-elpa/blob - packages/tiny/tiny.el

   1 ;;; tiny.el --- Quickly generate linear ranges in Emacs
   2
   3 ;; Copyright (C) 2013-2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
   6 ;; URL: https://github.com/abo-abo/tiny
   7 ;; Version: 0.1.1
   8 ;; Keywords: convenience
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; To set it up, just bind e.g.:
  28 ;;
  29 ;;     (global-set-key (kbd "C-;") 'tiny-expand)
  30 ;;
  31 ;; Usage:
  32 ;; This extension's main command is `tiny-expand'.
  33 ;; It's meant to quickly generate linear ranges, e.g. 5, 6, 7, 8.
  34 ;; Some elisp proficiency is an advantage, since you can transform
  35 ;; your numeric range with an elisp expression.
  36 ;;
  37 ;; There's also some emphasis on the brevity of the expression to be
  38 ;; expanded: e.g. instead of typing (+ x 2), you can do +x2.
  39 ;; You can still do the full thing, but +x2 would save you some
  40 ;; key strokes.
  41 ;;
  42 ;; You can test out the following snippets
  43 ;; by positioning the point at the end of the expression
  44 ;; and calling `tiny-expand' (default shortcut is C-;):
  45 ;;
  46 ;; m10
  47 ;; m5 10
  48 ;; m5,10
  49 ;; m5 10*xx
  50 ;; m5 10*xx%x
  51 ;; m5 10*xx|0x%x
  52 ;; m25+x?a%c
  53 ;; m25+x?A%c
  54 ;; m97,122(string x)
  55 ;; m97,122stringxx
  56 ;; m97,120stringxupcasex
  57 ;; m97,120stringxupcasex)x
  58 ;; m\n;; 10|%(+ x x) and %(* x x) and %s
  59 ;; m10*2+3x
  60 ;; m\n;; 10expx
  61 ;; m5\n;; 20expx%014.2f
  62 ;; m7|%(expt 2 x)
  63 ;; m, 7|0x%02x
  64 ;; m10|%0.2f
  65 ;; m1\n14|*** TODO http://emacsrocks.com/e%02d.html
  66 ;; m1\n10|convert img%s.jpg -monochrome -resize 50%% -rotate 180 img%s_mono.pdf
  67 ;; (setq foo-list '(m1 11+x96|?%c))
  68 ;; m1\n10listx+x96|convert img%s.jpg -monochrome -resize 50%% -rotate 180 img%c_mono.pdf
  69 ;; m1\n10listxnthxfoo-list|convert img%s.jpg -monochrome -resize 50%% -rotate 180 img%c_mono.pdf
  70 ;; m\n;; 16list*xxx)*xx%s:%s:%s
  71 ;; m\n8|**** TODO Learning from Data Week %(+ x 2) \nSCHEDULED: <%(date "Oct 7" (* x 7))> DEADLINE: <%(date "Oct 14" (* x 7))>
  72 ;;
  73 ;; As you might have guessed, the syntax is as follows:
  74 ;; m[<range start:=0>][<separator:= >]<range end>[Lisp expr]|[format expr]
  75 ;;
  76 ;; x is the default var in the elisp expression.  It will take one by one
  77 ;; the value of all numbers in the range.
  78 ;;
  79 ;; | means that elisp expr has ended and format expr has begun.
  80 ;; It can be omitted if the format expr starts with %.
  81 ;; The keys are the same as for format.
  82 ;; In addition %(sexp) forms are allowed.  The sexp can depend on x.
  83 ;;
  84 ;; Note that multiple % can be used in the format expression.
  85 ;; In that case:
  86 ;; * if the Lisp expression returns a list, the members of this list
  87 ;;   are used in the appropriate place.
  88 ;; * otherwise, it's just the result of the expression repeated as
  89 ;;   many times as necessary.
  90
  91 ;;; Code:
  92
  93 (eval-when-compile
  94   (require 'cl))
  95 (require 'help-fns)
  96 (require 'org)
  97
  98 (defvar tiny-beg nil
  99   "Last matched snippet start position.")
 100
 101 (defvar tiny-end nil
 102   "Last matched snippet end position.")
 103
 104 ;;;###autoload
 105 (defun tiny-expand ()
 106   "Expand current snippet.
 107 It polls the expander functions one by one
 108 if they can expand the thing at point.
 109 First one to return a string succeeds.
 110 These functions are expected to set `tiny-beg' and `tiny-end'
 111 to the bounds of the snippet that they matched.
 112 At the moment, only `tiny-mapconcat' is supported.
 113 `tiny-mapconcat2' should be added to expand rectangles."
 114   (interactive)
 115   (let ((str (tiny-mapconcat)))
 116     (when str
 117       (delete-region tiny-beg tiny-end)
 118       (insert str)
 119       (tiny-replace-this-sexp))))
 120
 121 (defun tiny-setup-default ()
 122   "Setup shortcuts."
 123   (global-set-key (kbd "C-;") 'tiny-expand))
 124
 125 (defalias 'tiny--preceding-sexp
 126     (if (fboundp 'elisp--preceding-sexp)
 127         'elisp--preceding-sexp
 128       'preceding-sexp))
 129
 130 ;;;###autoload
 131 (defun tiny-replace-this-sexp ()
 132   "Eval and replace the current sexp.
 133 On error go up list and try again."
 134   (interactive)
 135   (if (region-active-p)
 136       (let ((s (buffer-substring-no-properties
 137                 (region-beginning)
 138                 (region-end))))
 139         (delete-region (region-beginning)
 140                        (region-end))
 141         (insert (format "%s" (eval (read s)))))
 142     (catch 'success
 143       (while t
 144         (ignore-errors
 145           (unless (looking-back ")" (line-beginning-position))
 146             (error "Bad location"))
 147           (let ((sexp (tiny--preceding-sexp)))
 148             (if (eq (car sexp) 'lambda)
 149                 (error "Lambda evaluates to itself")
 150               (let ((value (eval sexp)))
 151                 (kill-sexp -1)
 152                 (insert (format "%s" value))
 153                 (throw 'success t)))))
 154         ;; if can't replace, go up list
 155         (condition-case nil
 156             (tiny-up-list)
 157           (error
 158            (message "reached the highest point, couldn't eval.")
 159            (throw 'success nil)))))))
 160
 161 (defun tiny-up-list ()
 162   "An `up-list' that can exit from string.
 163 Must throw an error when can't go up further."
 164   (interactive)
 165   ;; check if inside string
 166   (let ((p (nth 8 (syntax-ppss))))
 167     (when (eq (char-after p) ?\")
 168       ;; go to beginning for string
 169       (goto-char p)))
 170   (up-list))
 171
 172 (defun tiny-mapconcat ()
 173   "Format output of `tiny-mapconcat-parse'.
 174 Defaults are used in place of null values."
 175   (let ((parsed (tiny-mapconcat-parse)))
 176     (when parsed
 177       (let* ((n0 (or (nth 0 parsed) "0"))
 178              (n1 (nth 1 parsed))
 179              (s1 (cond ((null n1)
 180                         " ")
 181                        ((equal n1 "m")
 182                         "")
 183                        (t
 184                         n1)))
 185              (n2 (nth 2 parsed))
 186              (expr (or (nth 3 parsed) "x"))
 187              (lexpr (read expr))
 188              (n-have (if (and (listp lexpr) (eq (car lexpr) 'list))
 189                          (1- (length lexpr))
 190                        0))
 191              (expr (if (zerop n-have) `(list ,lexpr) lexpr))
 192              (n-have (if (zerop n-have) 1 n-have))
 193              (tes (tiny-extract-sexps (or (nth 4 parsed) "%s")))
 194              (fmt (car tes))
 195              (n-need (cl-count nil (cdr tes)))
 196              (idx -1)
 197              (format-expression
 198               (concat "(mapconcat (lambda(x) (let ((lst %s)) (format %S "
 199                       (mapconcat (lambda (x)
 200                                    (or x
 201                                        (if (>= (1+ idx) n-have)
 202                                            "x"
 203                                          (format "(nth %d lst)" (incf idx)))))
 204                                  (cdr tes)
 205                                  " ")
 206                       ")))(number-sequence %s %s) \"%s\")")))
 207         (unless (>= (read n0) (read n2))
 208           (format
 209            format-expression
 210            expr
 211            (replace-regexp-in-string "\\\\n" "\n" fmt)
 212            n0
 213            n2
 214            s1))))))
 215
 216 (defconst tiny-format-str
 217   (let ((flags "[+ #-0]\\{0,1\\}")
 218         (width "[0-9]*")
 219         (precision "\\(?:\\.[0-9]+\\)?")
 220         (character "[sdoxXefgcS]?"))
 221     (format "\\(%s%s%s%s\\)("
 222             flags width precision character)))
 223
 224 (defun tiny-extract-sexps (str)
 225   "Return (STR & FORMS).
 226 Each element of FORMS corresponds to a `format'-style % form in STR.
 227
 228   * %% forms are skipped
 229   * %(sexp) is replaced with %s in STR, and put in FORMS
 230   * the rest of forms are untouched in STR, and put as nil in FORMS"
 231   (let ((start 0)
 232         forms beg fexp)
 233     (condition-case nil
 234         (while (setq beg (string-match "%" str start))
 235           (setq start (1+ beg))
 236
 237           (cond ((= ?% (aref str (1+ beg)))
 238                  (incf start))
 239
 240                 ((and (eq beg (string-match tiny-format-str str beg))
 241                       (setq fexp (match-string-no-properties 1 str)))
 242                  (incf beg (length fexp))
 243                  (destructuring-bind (sexp . end)
 244                      (read-from-string str beg)
 245                    (push
 246                     (replace-regexp-in-string "(date" "(tiny-date"
 247                                               (substring str beg end))
 248                     forms)
 249                    (setq str (concat (substring str 0 beg)
 250                                      (if (string= fexp "%") "s" "")
 251                                      (substring str end)))))
 252                 (t (push nil forms))))
 253       (error (message "Malformed sexp: %s" (substring str beg))))
 254     (cons str (nreverse forms))))
 255
 256 (defun tiny-mapconcat-parse ()
 257   "Try to match a snippet of this form:
 258 m[START][SEPARATOR]END[EXPR]|[FORMAT]
 259
 260 * START     - integer (defaults to 0)
 261 * SEPARATOR - string  (defaults to \" \")
 262 * END       - integer (required)
 263 * EXPR      - Lisp expression: function body with argument x (defaults to x)
 264   Parens are optional if it's unambiguous:
 265   - `(* 2 (+ x 3))'  <-> *2+x3
 266   - `(exp x)'        <-> expx
 267   A closing paren may be added to resolve ambiguity:
 268   - `(* 2 (+ x 3) x) <-> *2+x3)
 269 * FORMAT    - string, `format'-style (defaults to \"%s\")
 270   | separator can be omitted if FORMAT starts with %.
 271
 272 Return nil if nothing was matched, otherwise
 273  (START SEPARATOR END EXPR FORMAT)"
 274   (let ((case-fold-search nil)
 275         n1 s1 n2 expr fmt str
 276         n-uses)
 277     (when (catch 'done
 278             (cond
 279               ;; either start with a number
 280               ((looking-back "\\bm\\(-?[0-9]+\\)\\([^\n]*?\\)"
 281                              (line-beginning-position))
 282                (setq n1 (match-string-no-properties 1)
 283                      str (match-string-no-properties 2)
 284                      tiny-beg (match-beginning 0)
 285                      tiny-end (match-end 0))
 286                (when (zerop (length str))
 287                  (setq n2 n1
 288                        n1 nil)
 289                  (throw 'done t)))
 290               ;; else capture the whole thing
 291               ((looking-back "\\bm\\([^%|\n]*[0-9][^\n]*\\)"
 292                              (line-beginning-position))
 293                (setq str (match-string-no-properties 1)
 294                      tiny-beg (match-beginning 0)
 295                      tiny-end (match-end 0))
 296                (when (zerop (length str))
 297                  (throw 'done nil)))
 298               (t (throw 'done nil)))
 299             ;; at this point, `str' should be either [sep]<num>[expr][fmt]
 300             ;; or [expr][fmt]
 301             ;;
 302             ;; First, try to match [expr][fmt]
 303             (string-match "^\\(.*?\\)|?\\(%.*\\)?$" str)
 304             (setq expr (match-string-no-properties 1 str))
 305             (setq fmt (match-string-no-properties 2 str))
 306             ;; If it's a valid expression, we're done
 307             (when (setq expr (tiny-tokenize expr))
 308               (setq n2 n1
 309                     n1 nil)
 310               (throw 'done t))
 311             ;; at this point, `str' is [sep]<num>[expr][fmt]
 312             (if (string-match "^\\([^\n0-9]*?\\)\\(-?[0-9]+\\)\\(.*\\)?$" str)
 313                 (setq s1 (match-string-no-properties 1 str)
 314                       n2 (match-string-no-properties 2 str)
 315                       str (match-string-no-properties 3 str))
 316               ;; here there's only n2 that was matched as n1
 317               (setq n2 n1
 318                     n1 nil))
 319             ;; match expr_fmt
 320             (unless (zerop (length str))
 321               (if (or (string-match "^\\([^\n%|]*?\\)|\\([^\n]*\\)?$" str)
 322                       (string-match "^\\([^\n%|]*?\\)\\(%[^\n]*\\)?$" str))
 323                   (progn
 324                     (setq expr (tiny-tokenize (match-string-no-properties 1 str)))
 325                     (setq fmt (match-string-no-properties 2 str)))
 326                 (error "Couldn't match %s" str)))
 327             t)
 328       (when (equal expr "")
 329         (setq expr nil))
 330       (list n1 s1 n2 expr fmt))))
 331
 332 ;; TODO: check for arity: this doesn't work: exptxy
 333 (defun tiny-tokenize (str)
 334   "Transform shorthand Lisp expression STR to proper Lisp."
 335   (if (equal str "")
 336       ""
 337     (ignore-errors
 338       (let ((i 0) (j 1)
 339             (len (length str))
 340             sym s out allow-spc
 341             (n-paren 0)
 342             (expect-fun t))
 343         (while (< i len)
 344           (setq s (substring str i j))
 345           (when (cond
 346                   ((string= s "x")
 347                    (push s out)
 348                    (push " " out))
 349                   ((string= s " ")
 350                    (if allow-spc
 351                        t
 352                      (error "Unexpected \" \"")))
 353                   ;; special syntax to read chars
 354                   ((string= s "?")
 355                    (setq s (format "%s" (read (substring str i (incf j)))))
 356                    (push s out)
 357                    (push " " out))
 358                   ((string= s ")")
 359                    ;; expect a close paren only if it's necessary
 360                    (if (>= n-paren 0)
 361                        (decf n-paren)
 362                      (error "Unexpected \")\""))
 363                    (when (string= (car out) " ")
 364                      (pop out))
 365                    (push ")" out)
 366                    (push " " out))
 367                   ((string= s "(")
 368                    ;; open paren is used sometimes
 369                    ;; when there are numbers in the expression
 370                    (setq expect-fun t)
 371                    (incf n-paren)
 372                    (push "(" out))
 373                   ((progn (setq sym (intern-soft s))
 374                           (cond
 375                             ;; general functionp
 376                             ((not (eq t (help-function-arglist sym)))
 377                              (setq expect-fun nil)
 378                              (setq allow-spc t)
 379                              ;; (when (zerop n-paren) (push "(" out))
 380                              (unless (equal (car out) "(")
 381                                (push "(" out)
 382                                (incf n-paren))
 383                              t)
 384                             ((and sym (boundp sym) (not expect-fun))
 385                              t)))
 386                    (push s out)
 387                    (push " " out))
 388                   ((numberp (read s))
 389                    (let* ((num (string-to-number (substring str i)))
 390                           (num-s (format "%s" num)))
 391                      (push num-s out)
 392                      (push " " out)
 393                      (setq j (+ i (length num-s)))))
 394                   (t
 395                    (incf j)
 396                    nil))
 397             (setq i j)
 398             (setq j (1+ i))))
 399         ;; last space
 400         (when (string= (car out) " ")
 401           (pop out))
 402         (concat
 403          (apply #'concat (nreverse out))
 404          (make-string n-paren ?\)))))))
 405
 406 (defun tiny-date (s &optional shift)
 407   "Return date representation of S.
 408 `org-mode' format is used.
 409 Optional SHIFT argument is the integer amount of days to shift."
 410   (let* ((ct (decode-time (current-time)))
 411          (time (apply 'encode-time
 412                       (org-read-date-analyze
 413                        s nil
 414                        ct)))
 415          (formatter
 416           (if (equal (cl-subseq ct 1 3)
 417                      (cl-subseq (decode-time time) 1 3))
 418               "%Y-%m-%d %a"
 419             "%Y-%m-%d %a %H:%M")))
 420     (when shift
 421       (setq time (time-add time (days-to-time shift))))
 422     (format-time-string formatter time)))
 423
 424 (provide 'tiny)
 425 ;;; tiny.el ends here