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
   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 ;;;###autoload
 126 (defun tiny-replace-this-sexp ()
 127   "Eval and replace the current sexp.
 128 On error go up list and try again."
 129   (interactive)
 130   (if (region-active-p)
 131       (let ((s (buffer-substring-no-properties
 132                 (region-beginning)
 133                 (region-end))))
 134         (delete-region (region-beginning)
 135                        (region-end))
 136         (insert (format "%s" (eval (read s)))))
 137     (catch 'success
 138       (while t
 139         (ignore-errors
 140           (unless (looking-back ")")
 141             (error "Bad location"))
 142           (let ((sexp (preceding-sexp)))
 143             (if (eq (car sexp) 'lambda)
 144                 (error "Lambda evaluates to itself")
 145               (let ((value (eval sexp)))
 146                 (kill-sexp -1)
 147                 (insert (format "%s" value))
 148                 (throw 'success t)))))
 149         ;; if can't replace, go up list
 150         (condition-case nil
 151             (tiny-up-list)
 152           (error
 153            (message "reached the highest point, couldn't eval.")
 154            (throw 'success nil)))))))
 155
 156 (defun tiny-up-list ()
 157   "An `up-list' that can exit from string.
 158 Must throw an error when can't go up further."
 159   (interactive)
 160   ;; check if inside string
 161   (let ((p (nth 8 (syntax-ppss))))
 162     (when (eq (char-after p) ?\")
 163       ;; go to beginning for string
 164       (goto-char p)))
 165   (up-list))
 166
 167 (defun tiny-mapconcat ()
 168   "Format output of `tiny-mapconcat-parse'.
 169 Defaults are used in place of null values."
 170   (let ((parsed (tiny-mapconcat-parse)))
 171     (when parsed
 172       (let* ((n1 (or (nth 0 parsed) "0"))
 173              (s1 (or (nth 1 parsed) " "))
 174              (n2 (nth 2 parsed))
 175              (expr (or (nth 3 parsed) "x"))
 176              (lexpr (read expr))
 177              (n-have (if (and (listp lexpr) (eq (car lexpr) 'list))
 178                          (1- (length lexpr))
 179                        0))
 180              (expr (if (zerop n-have) `(list ,lexpr) lexpr))
 181              (n-have (if (zerop n-have) 1 n-have))
 182              (tes (tiny-extract-sexps (or (nth 4 parsed) "%s")))
 183              (fmt (car tes))
 184              (n-need (cl-count nil (cdr tes)))
 185              (idx -1)
 186              (format-expression
 187               (concat "(mapconcat (lambda(x) (let ((lst %s)) (format %S "
 188                       (mapconcat (lambda (x)
 189                                    (or x
 190                                        (if (>= (1+ idx) n-have)
 191                                            "x"
 192                                          (format "(nth %d lst)" (incf idx)))))
 193                                  (cdr tes)
 194                                  " ")
 195                       ")))(number-sequence %s %s) \"%s\")")))
 196         (unless (>= (read n1) (read n2))
 197           (format
 198            format-expression
 199            expr
 200            (replace-regexp-in-string "\\\\n" "\n" fmt)
 201            n1
 202            n2
 203            s1))))))
 204
 205 (defconst tiny-format-str
 206   (let ((flags "[+ #-0]\\{0,1\\}")
 207         (width "[0-9]*")
 208         (precision "\\(?:\\.[0-9]+\\)?")
 209         (character "[sdoxXefgcS]?"))
 210     (format "\\(%s%s%s%s\\)("
 211             flags width precision character)))
 212
 213 (defun tiny-extract-sexps (str)
 214   "Return (STR & FORMS).
 215 Each element of FORMS corresponds to a `format'-style % form in STR.
 216
 217   * %% forms are skipped
 218   * %(sexp) is replaced with %s in STR, and put in FORMS
 219   * the rest of forms are untouched in STR, and put as nil in FORMS"
 220   (let ((start 0)
 221         forms beg fexp)
 222     (condition-case nil
 223         (while (setq beg (string-match "%" str start))
 224           (setq start (1+ beg))
 225
 226           (cond ((= ?% (aref str (1+ beg)))
 227                  (incf start))
 228
 229                 ((and (eq beg (string-match tiny-format-str str beg))
 230                       (setq fexp (match-string-no-properties 1 str)))
 231                  (incf beg (length fexp))
 232                  (destructuring-bind (sexp . end)
 233                      (read-from-string str beg)
 234                    (push
 235                     (replace-regexp-in-string "(date" "(tiny-date"
 236                                               (substring str beg end))
 237                     forms)
 238                    (setq str (concat (substring str 0 beg)
 239                                      (if (string= fexp "%") "s" "")
 240                                      (substring str end)))))
 241                 (t (push nil forms))))
 242       (error (message "Malformed sexp: %s" (substring str beg))))
 243     (cons str (nreverse forms))))
 244
 245 (defun tiny-mapconcat-parse ()
 246   "Try to match a snippet of this form:
 247 m[START][SEPARATOR]END[EXPR]|[FORMAT]
 248
 249 * START     - integer (defaults to 0)
 250 * SEPARATOR - string  (defaults to \" \")
 251 * END       - integer (required)
 252 * EXPR      - Lisp expression: function body with argument x (defaults to x)
 253   Parens are optional if it's unambiguous:
 254   - `(* 2 (+ x 3))'  <-> *2+x3
 255   - `(exp x)'        <-> expx
 256   A closing paren may be added to resolve ambiguity:
 257   - `(* 2 (+ x 3) x) <-> *2+x3)
 258 * FORMAT    - string, `format'-style (defaults to \"%s\")
 259   | separator can be omitted if FORMAT starts with %.
 260
 261 Return nil if nothing was matched, otherwise
 262  (START SEPARATOR END EXPR FORMAT)"
 263   (let ((case-fold-search nil)
 264         n1 s1 n2 expr fmt str
 265         n-uses)
 266     (when (catch 'done
 267             (cond
 268               ;; either start with a number
 269               ((looking-back "\\bm\\(-?[0-9]+\\)\\([^\n]*?\\)")
 270                (setq n1 (match-string-no-properties 1)
 271                      str (match-string-no-properties 2)
 272                      tiny-beg (match-beginning 0)
 273                      tiny-end (match-end 0))
 274                (when (zerop (length str))
 275                  (setq n2 n1
 276                        n1 nil)
 277                  (throw 'done t)))
 278               ;; else capture the whole thing
 279               ((looking-back "\\bm\\([^%|\n]*[0-9][^\n]*\\)")
 280                (setq str (match-string-no-properties 1)
 281                      tiny-beg (match-beginning 0)
 282                      tiny-end (match-end 0))
 283                (when (zerop (length str))
 284                  (throw 'done nil)))
 285               (t (throw 'done nil)))
 286             ;; at this point, `str' should be either [sep]<num>[expr][fmt]
 287             ;; or [expr][fmt]
 288             ;;
 289             ;; First, try to match [expr][fmt]
 290             (string-match "^\\(.*?\\)|?\\(%.*\\)?$" str)
 291             (setq expr (match-string-no-properties 1 str))
 292             (setq fmt (match-string-no-properties 2 str))
 293             ;; If it's a valid expression, we're done
 294             (when (setq expr (tiny-tokenize expr))
 295               (setq n2 n1
 296                     n1 nil)
 297               (throw 'done t))
 298             ;; at this point, `str' is [sep]<num>[expr][fmt]
 299             (if (string-match "^\\([^\n0-9]*?\\)\\(-?[0-9]+\\)\\(.*\\)?$" str)
 300                 (setq s1 (match-string-no-properties 1 str)
 301                       n2 (match-string-no-properties 2 str)
 302                       str (match-string-no-properties 3 str))
 303               ;; here there's only n2 that was matched as n1
 304               (setq n2 n1
 305                     n1 nil))
 306             ;; match expr_fmt
 307             (unless (zerop (length str))
 308               (if (or (string-match "^\\([^\n%|]*?\\)|\\([^\n]*\\)?$" str)
 309                       (string-match "^\\([^\n%|]*?\\)\\(%[^\n]*\\)?$" str))
 310                   (progn
 311                     (setq expr (tiny-tokenize (match-string-no-properties 1 str)))
 312                     (setq fmt (match-string-no-properties 2 str)))
 313                 (error "Couldn't match %s" str)))
 314             t)
 315       (when (equal expr "")
 316         (setq expr nil))
 317       (list n1 s1 n2 expr fmt))))
 318
 319 ;; TODO: check for arity: this doesn't work: exptxy
 320 (defun tiny-tokenize (str)
 321   "Transform shorthand Lisp expression STR to proper Lisp."
 322   (if (equal str "")
 323       ""
 324     (ignore-errors
 325       (let ((i 0) (j 1)
 326             (len (length str))
 327             sym s out allow-spc
 328             (n-paren 0)
 329             (expect-fun t))
 330         (while (< i len)
 331           (setq s (substring str i j))
 332           (when (cond
 333                   ((string= s "x")
 334                    (push s out)
 335                    (push " " out))
 336                   ((string= s " ")
 337                    (if allow-spc
 338                        t
 339                      (error "Unexpected \" \"")))
 340                   ;; special syntax to read chars
 341                   ((string= s "?")
 342                    (setq s (format "%s" (read (substring str i (incf j)))))
 343                    (push s out)
 344                    (push " " out))
 345                   ((string= s ")")
 346                    ;; expect a close paren only if it's necessary
 347                    (if (>= n-paren 0)
 348                        (decf n-paren)
 349                      (error "Unexpected \")\""))
 350                    (when (string= (car out) " ")
 351                      (pop out))
 352                    (push ")" out)
 353                    (push " " out))
 354                   ((string= s "(")
 355                    ;; open paren is used sometimes
 356                    ;; when there are numbers in the expression
 357                    (setq expect-fun t)
 358                    (incf n-paren)
 359                    (push "(" out))
 360                   ((progn (setq sym (intern-soft s))
 361                           (cond
 362                             ;; general functionp
 363                             ((not (eq t (help-function-arglist sym)))
 364                              (setq expect-fun)
 365                              (setq allow-spc t)
 366                              ;; (when (zerop n-paren) (push "(" out))
 367                              (unless (equal (car out) "(")
 368                                (push "(" out)
 369                                (incf n-paren))
 370                              t)
 371                             ((and sym (boundp sym) (not expect-fun))
 372                              t)))
 373                    (push s out)
 374                    (push " " out))
 375                   ((numberp (read s))
 376                    (let* ((num (string-to-number (substring str i)))
 377                           (num-s (format "%s" num)))
 378                      (push num-s out)
 379                      (push " " out)
 380                      (setq j (+ i (length num-s)))))
 381                   (t
 382                    (incf j)
 383                    nil))
 384             (setq i j)
 385             (setq j (1+ i))))
 386         ;; last space
 387         (when (string= (car out) " ")
 388           (pop out))
 389         (concat
 390          (apply #'concat (nreverse out))
 391          (make-string n-paren ?\)))))))
 392
 393 (defun tiny-date (s &optional shift)
 394   "Return date representation of S.
 395 `org-mode' format is used.
 396 Optional SHIFT argument is the integer amount of days to shift."
 397   (let* ((ct (decode-time (current-time)))
 398          (time (apply 'encode-time
 399                       (org-read-date-analyze
 400                        s nil
 401                        ct)))
 402          (formatter
 403           (if (equal (cl-subseq ct 1 3)
 404                      (cl-subseq (decode-time time) 1 3))
 405               "%Y-%m-%d %a"
 406             "%Y-%m-%d %a %H:%M")))
 407     (when shift
 408       (setq time (time-add time (days-to-time shift))))
 409     (format-time-string formatter time)))
 410
 411 (provide 'tiny)
 412 ;;; tiny.el ends here