]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/sotlisp/sotlisp.el
Merge commit '68160bad14b031b069f30f1bd494ba4f252321c1'
[gnu-emacs-elpa] / packages / sotlisp / sotlisp.el
index 6e4bb1168b0dc4e9f1c73b56133e785171577c79..a4cd9dca38dfa3efb80df60e67abd902ac4b24a0 100644 (file)
@@ -2,11 +2,11 @@
 
 ;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
 
-;; Author: Artur Malabarba  <bruce.connor.am@>
+;; Author: Artur Malabarba <emacs@endlessparentheses.com>
 ;; URL: https://github.com/Malabarba/speed-of-thought-lisp
 ;; Keywords: convenience, lisp
 ;; Package-Requires: ((emacs "24.1"))
-;; Version: 1.2
+;; Version: 1.5.1
 
 ;; 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
@@ -80,7 +80,6 @@
 ;; 
 ;;   (with-temp-buffer (insert text))
 
-\f
 ;;; Code:
 
 ;;; Predicates
   "Non-nil if point is at the start of a sexp.
 Specially, avoids matching inside argument lists."
   (and (eq (char-before) ?\()
-       (not (sotlisp--looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))
+       (not (sotlisp--looking-back "(\\(defun\\s-+.*\\|\\(lambda\\|dolist\\|dotimes\\)\\s-+\\)("))
+       (save-excursion
+         (forward-char -1)
+         (condition-case er
+             (progn
+               (backward-up-list)
+               (forward-sexp -1)
+               (not
+                (looking-at-p (rx (* (or (syntax word) (syntax symbol) "-"))
+                                  "let" symbol-end))))
+           (error t)))
        (not (string-match (rx (syntax symbol)) (string last-command-event)))))
 
 (defun sotlisp--function-quote-p ()
@@ -253,10 +262,13 @@ The space char is not included.  Any \"$\" are also removed."
     ("dfv" . "defvar $ t\n  \"\"")
     ("dk" . "define-key ")
     ("dl" . "dolist (it $)")
+    ("dt" . "dotimes (it $)")
     ("dmp" . "derived-mode-p '")
+    ("dm" . "defmacro $ ()\n  \"\"\n  ")
     ("dr" . "delete-region ")
     ("dv" . "defvar $ t\n  \"\"")
     ("e" . "error \"$\"")
+    ("ef" . "executable-find ")
     ("efn" . "expand-file-name ")
     ("eol" . "end-of-line")
     ("f" . "format \"$\"")
@@ -268,6 +280,7 @@ The space char is not included.  Any \"$\" are also removed."
     ("fp" . "functionp ")
     ("frp" . "file-readable-p ")
     ("fs" . "forward-sexp 1")
+    ("fu" . "funcall ")
     ("fw" . "forward-word 1")
     ("g" . "goto-char ")
     ("gc" . "goto-char ")
@@ -296,11 +309,14 @@ The space char is not included.  Any \"$\" are also removed."
     ("lp" . "listp ")
     ("m" . "message \"$%s\"")
     ("mb" . "match-beginning 0")
+    ("mc" . "mapcar ")
+    ("mct" . "mapconcat ")
     ("me" . "match-end 0")
     ("ms" . "match-string 0")
     ("msn" . "match-string-no-properties 0")
     ("msnp" . "match-string-no-properties 0")
     ("msp" . "match-string-no-properties 0")
+    ("mt" . "mapconcat ")
     ("n" . "not ")
     ("nai" . "newline-and-indent$")
     ("nl" . "forward-line 1")
@@ -312,6 +328,7 @@ The space char is not included.  Any \"$\" are also removed."
     ("pa" . "point-max$")
     ("pg" . "plist-get ")
     ("pi" . "point-min$")
+    ("pz" . "propertize ")
     ("r" . "require '")
     ("ra" . "use-region-p$")
     ("rap" . "use-region-p$")
@@ -324,8 +341,8 @@ The space char is not included.  Any \"$\" are also removed."
     ("rris" . "replace-regexp-in-string ")
     ("rrs" . "replace-regexp-in-string ")
     ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")
-    ("rsb" . "re-search-backward $ nil 'noerror")
-    ("rsf" . "re-search-forward $ nil 'noerror")
+    ("rsb" . "re-search-backward \"$\" nil 'noerror")
+    ("rsf" . "re-search-forward \"$\" nil 'noerror")
     ("s" . "setq ")
     ("sb" . "search-backward $ nil 'noerror")
     ("sbr" . "search-backward-regexp $ nil 'noerror")
@@ -335,7 +352,7 @@ The space char is not included.  Any \"$\" are also removed."
     ("sf" . "search-forward $ nil 'noerror")
     ("sfr" . "search-forward-regexp $ nil 'noerror")
     ("sic" . "self-insert-command")
-    ("sl" . "string<")
+    ("sl" . "setq-local ")
     ("sm" . "string-match \"$\"")
     ("smd" . "save-match-data")
     ("sn" . "symbol-name ")
@@ -349,6 +366,8 @@ The space char is not included.  Any \"$\" are also removed."
     ("sw" . "selected-window$")
     ("syp" . "symbolp ")
     ("tap" . "thing-at-point 'symbol")
+    ("tf" . "thread-first ")
+    ("tl" . "thread-last ")
     ("u" . "unless ")
     ("ul" . "up-list")
     ("up" . "unwind-protect\n(progn $)")
@@ -360,6 +379,7 @@ The space char is not included.  Any \"$\" are also removed."
     ("wl" . "when-let (($))")
     ("we" . "window-end")
     ("ws" . "window-start")
+    ("wsw" . "with-selected-window ")
     ("wtb" . "with-temp-buffer")
     ("wtf" . "with-temp-file ")
     )
@@ -443,8 +463,11 @@ If `speed-of-thought-mode' is already on, call ON."
 ;;; The local minor-mode
 (define-minor-mode sotlisp-mode
   nil nil " SoT"
-  '(([M-return] . sotlisp-newline-and-parentheses)
+  `(([M-return] . sotlisp-newline-and-parentheses)
     ([C-return] . sotlisp-downlist-newline-and-parentheses)
+    (,(kbd "C-M-;") . ,(if (fboundp 'comment-or-uncomment-sexp)
+                           #'comment-or-uncomment-sexp
+                         #'sotlisp-comment-or-uncomment-sexp))
     ("\C-cf"    . sotlisp-find-or-define-function)
     ("\C-cv"    . sotlisp-find-or-define-variable)))
 
@@ -511,8 +534,9 @@ removes hooks and abbrevs."
   "`push-mark' and move above this defun."
   (push-mark)
   (beginning-of-defun)
-  (when (looking-back "^;;;###autoload\\s-*\n")
-    (forward-line -1)))
+  (forward-line -1)
+  (unless (looking-at "^;;;###autoload\\s-*\n")
+    (forward-line 1)))
 
 (defun sotlisp--function-at-point ()
   "Return name of `function-called-at-point'."
@@ -587,5 +611,97 @@ With a prefix argument, defines a `defvar' instead of a `defcustom'."
                     (if prefix "" "\n  :type 'boolean")
                     ")\n\n")))))))
 
+\f
+;;; Comment sexp
+(defun sotlisp-uncomment-sexp (&optional n)
+  "Uncomment a sexp around point."
+  (interactive "P")
+  (let* ((initial-point (point-marker))
+         (inhibit-field-text-motion t)
+         (p)
+         (end (save-excursion
+                (when (elt (syntax-ppss) 4)
+                  (re-search-backward comment-start-skip
+                                      (line-beginning-position)
+                                      t))
+                (setq p (point-marker))
+                (comment-forward (point-max))
+                (point-marker)))
+         (beg (save-excursion
+                (forward-line 0)
+                (while (and (not (bobp))
+                            (= end (save-excursion
+                                     (comment-forward (point-max))
+                                     (point))))
+                  (forward-line -1))
+                (goto-char (line-end-position))
+                (re-search-backward comment-start-skip
+                                    (line-beginning-position)
+                                    t)
+                (ignore-errors
+                  (while (looking-at comment-start-skip)
+                    (forward-char -1))
+                  (unless (looking-at "[\n\r[:blank]]")
+                    (forward-char 1)))
+                (point-marker))))
+    (unless (= beg end)
+      (uncomment-region beg end)
+      (goto-char p)
+      ;; Indentify the "top-level" sexp inside the comment.
+      (ignore-errors
+        (while (>= (point) beg)
+          (backward-prefix-chars)
+          (skip-chars-backward "\r\n[:blank:]")
+          (setq p (point-marker))
+          (backward-up-list)))
+      ;; Re-comment everything before it. 
+      (ignore-errors
+        (comment-region beg p))
+      ;; And everything after it.
+      (goto-char p)
+      (forward-sexp (or n 1))
+      (skip-chars-forward "\r\n[:blank:]")
+      (if (< (point) end)
+          (ignore-errors
+            (comment-region (point) end))
+        ;; If this is a closing delimiter, pull it up.
+        (goto-char end)
+        (skip-chars-forward "\r\n[:blank:]")
+        (when (eq 5 (car (syntax-after (point))))
+          (delete-indentation))))
+    ;; Without a prefix, it's more useful to leave point where
+    ;; it was.
+    (unless n
+      (goto-char initial-point))))
+
+(defun sotlisp--comment-sexp-raw ()
+  "Comment the sexp at point or ahead of point."
+  (pcase (or (bounds-of-thing-at-point 'sexp)
+             (save-excursion
+               (skip-chars-forward "\r\n[:blank:]")
+               (bounds-of-thing-at-point 'sexp)))
+    (`(,l . ,r)
+     (goto-char r)
+     (skip-chars-forward "\r\n[:blank:]")
+     (save-excursion
+       (comment-region l r))
+     (skip-chars-forward "\r\n[:blank:]"))))
+
+(defun sotlisp-comment-or-uncomment-sexp (&optional n)
+  "Comment the sexp at point and move past it.
+If already inside (or before) a comment, uncomment instead.
+With a prefix argument N, (un)comment that many sexps."
+  (interactive "P")
+  (if (or (elt (syntax-ppss) 4)
+          (< (save-excursion
+               (skip-chars-forward "\r\n[:blank:]")
+               (point))
+             (save-excursion
+               (comment-forward 1)
+               (point))))
+      (sotlisp-uncomment-sexp n)
+    (dotimes (_ (or n 1))
+      (sotlisp--comment-sexp-raw))))
+
 (provide 'sotlisp)
 ;;; sotlisp.el ends here