;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+;; Author: Artur Malabarba <bruce.connor.am@>
+;; URL: https://github.com/Malabarba/speed-of-thought-lisp
;; Keywords: convenience, lisp
;; Package-Requires: ((emacs "24.1"))
-;; Version: 0
+;; Version: 1.4
;; 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
(bound-and-true-p paredit-mode)
(bound-and-true-p smartparens-mode)))
+(defun sotlisp--looking-back (regexp)
+ (string-match
+ (concat regexp "\\'")
+ (buffer-substring (line-beginning-position) (point))))
+
(defun sotlisp--function-form-p ()
"Non-nil if point is at the start of a sexp.
Specially, avoids matching inside argument lists."
(and (eq (char-before) ?\()
- (not (looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))
+ (not (sotlisp--looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))
(not (string-match (rx (syntax symbol)) (string last-command-event)))))
(defun sotlisp--function-quote-p ()
"Non-nil if point is at a sharp-quote."
- (looking-back "#'"))
+ (ignore-errors
+ (save-excursion
+ (forward-char -2)
+ (looking-at-p "#'"))))
+
+(defun sotlisp--code-p ()
+ (save-excursion
+ (let ((r (point)))
+ (beginning-of-defun)
+ (let ((pps (parse-partial-sexp (point) r)))
+ (not (or (elt pps 3)
+ (elt pps 4)))))))
(defun sotlisp--function-p ()
"Non-nil if point is at reasonable place for a function name.
(save-excursion
(ignore-errors
(skip-chars-backward (rx alnum))
- (or (sotlisp--function-form-p)
- (sotlisp--function-quote-p)))))
+ (and (sotlisp--code-p)
+ (or (sotlisp--function-form-p)
+ (sotlisp--function-quote-p))))))
(defun sotlisp--whitespace-p ()
"Non-nil if current `self-insert'ed char is whitespace."
+ (sotlisp--whitespace-char-p last-command-event))
+(make-obsolete 'sotlisp--whitespace-p 'sotlisp--whitespace-char-p "1.2")
+
+(defun sotlisp--whitespace-char-p (char)
+ "Non-nil if CHAR is has whitespace syntax."
(ignore-errors
- (string-match (rx space) (string last-command-event))))
+ (string-match (rx space) (string char))))
\f
;;; Expansion logic
(sotlisp--auto-paired-p))
(forward-char 1)))
+(defun sotlisp--post-expansion-cleanup ()
+ "Do some processing conditioned on the expansion done.
+If the command that triggered the expansion was a whitespace
+char, perform the steps below and return t.
+
+If the expansion ended in a $, delete it and call
+`sotlisp--maybe-skip-closing-paren'.
+If it ended in a space and there's a space ahead, delete the
+space ahead."
+ ;; Inform `expand-abbrev' that `self-insert-command' should not
+ ;; trigger, by returning non-nil on SPC.
+ (when (sotlisp--whitespace-char-p last-command-event)
+ ;; And maybe move out of closing paren if expansion ends with $.
+ (if (eq (char-before) ?$)
+ (progn (delete-char -1)
+ (setq sotlisp--needs-moving nil)
+ (sotlisp--maybe-skip-closing-paren))
+ (when (and (sotlisp--whitespace-char-p (char-after))
+ (sotlisp--whitespace-char-p (char-before)))
+ (delete-char 1)))
+ t))
+
(defvar sotlisp--function-table (make-hash-table :test #'equal)
"Table where function abbrev expansions are stored.")
(skip-chars-backward (rx alnum))
(let* ((name (buffer-substring (point) r))
(expansion (gethash name sotlisp--function-table)))
- (delete-region (point) r)
- (if (sotlisp--function-quote-p)
- ;; After #' use the simple expansion.
- (insert (sotlisp--simplify-function-expansion expansion))
- ;; Inside a form, use the full expansion.
- (insert expansion)
- (when (string-match "\\$" expansion)
- (setq sotlisp--needs-moving t))))
- ;; Inform `expand-abbrev' that `self-insert-command' should not
- ;; trigger, by returning non-nil on SPC.
- (when (sotlisp--whitespace-p)
- ;; And maybe move out of closing paren if expansion ends with $.
- (when (eq (char-before) ?$)
- (delete-char -1)
- (setq sotlisp--needs-moving nil)
- (sotlisp--maybe-skip-closing-paren))
- t)))
+ (if (not expansion)
+ (progn (goto-char r) nil)
+ (delete-region (point) r)
+ (if (sotlisp--function-quote-p)
+ ;; After #' use the simple expansion.
+ (insert (sotlisp--simplify-function-expansion expansion))
+ ;; Inside a form, use the full expansion.
+ (insert expansion)
+ (when (string-match "\\$" expansion)
+ (setq sotlisp--needs-moving t)))
+ ;; Must be last.
+ (sotlisp--post-expansion-cleanup)))))
(put 'sotlisp--expand-function 'no-self-insert t)
("bc" . "forward-char -1")
("bfn" . "buffer-file-name")
("bl" . "buffer-list$")
+ ("blp" . "buffer-live-p ")
("bn" . "buffer-name")
("bod" . "beginning-of-defun")
("bol" . "forward-line 0$")
("i" . "insert ")
("ie" . "ignore-errors ")
("ii" . "interactive")
+ ("il" . "if-let (($))")
("ir" . "indent-region ")
("jcl" . "justify-current-line ")
("jl" . "delete-indentation")
("k" . "kbd \"$\"")
("kb" . "kill-buffer")
("kn" . "kill-new ")
+ ("kp" . "keywordp ")
("l" . "lambda ($)")
("la" . "looking-at \"$\"")
("lap" . "looking-at-p \"$\"")
("ntr" . "narrow-to-region ")
("ow" . "other-window 1")
("p" . "point$")
+ ("pm" . "point-marker$")
("pa" . "point-max$")
("pg" . "plist-get ")
("pi" . "point-min$")
("s" . "setq ")
("sb" . "search-backward $ nil 'noerror")
("sbr" . "search-backward-regexp $ nil 'noerror")
- ("scb" . "skip-chars-backward \"$\r\n[:blank:]\"")
- ("scf" . "skip-chars-forward \"$\r\n[:blank:]\"")
+ ("scb" . "skip-chars-backward \"$\\r\\n[:blank:]\"")
+ ("scf" . "skip-chars-forward \"$\\r\\n[:blank:]\"")
("se" . "save-excursion")
("sf" . "search-forward $ nil 'noerror")
("sfr" . "search-forward-regexp $ nil 'noerror")
("wcb" . "with-current-buffer ")
("wf" . "write-file ")
("wh" . "while ")
- ("wl" . "window-list nil 'nominibuffer")
+ ("wl" . "when-let (($))")
+ ("we" . "window-end")
+ ("ws" . "window-start")
+ ("wsw" . "with-selected-window ")
("wtb" . "with-temp-buffer")
("wtf" . "with-temp-file ")
)
\f
;;; The global minor-mode
-(defvar speed-of-thought-turn-on-hook '(sotlisp-turn-on-everywhere)
+(defvar speed-of-thought-turn-on-hook '()
"Hook run once when `speed-of-thought-mode' is enabled.
Note that `speed-of-thought-mode' is global, so this is not run
on every buffer.
See `sotlisp-turn-on-everywhere' for an example of what a
function in this hook should do.")
-(defvar speed-of-thought-turn-off-hook '(sotlisp-turn-off-everywhere)
+(defvar speed-of-thought-turn-off-hook '()
"Hook run once when `speed-of-thought-mode' is disabled.
Note that `speed-of-thought-mode' is global, so this is not run
on every buffer.
function in this hook should do.")
;;;###autoload
-(define-minor-mode speed-of-thought-mode nil nil nil nil
+(define-minor-mode speed-of-thought-mode
+ nil nil nil nil
:global t
(run-hooks (if speed-of-thought-mode
'speed-of-thought-turn-on-hook
'speed-of-thought-turn-off-hook)))
+;;;###autoload
+(defun speed-of-thought-hook-in (on off)
+ "Add functions ON and OFF to `speed-of-thought-mode' hooks.
+If `speed-of-thought-mode' is already on, call ON."
+ (add-hook 'speed-of-thought-turn-on-hook on)
+ (add-hook 'speed-of-thought-turn-off-hook off)
+ (when speed-of-thought-mode (funcall on)))
+
\f
;;; The local minor-mode
+(define-minor-mode sotlisp-mode
+ nil nil " SoT"
+ `(([M-return] . sotlisp-newline-and-parentheses)
+ ([C-return] . sotlisp-downlist-newline-and-parentheses)
+ (,(kbd "C-M-;") . ,(if (boundp '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)))
+
(defun sotlisp-turn-on-everywhere ()
"Call-once function to turn on sotlisp everywhere.
Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
(with-current-buffer b
(when (derived-mode-p 'emacs-lisp-mode)
(sotlisp-mode 1))))
- (buffer-list)))
+ (buffer-list)))
(defun sotlisp-turn-off-everywhere ()
"Call-once function to turn off sotlisp everywhere.
(with-current-buffer b
(when (derived-mode-p 'emacs-lisp-mode)
(sotlisp-mode -1))))
- (buffer-list)))
+ (buffer-list)))
-(define-minor-mode sotlisp-mode nil nil " SoT"
- '(([M-return] . sotlisp-newline-and-parentheses)
- ([C-return] . sotlisp-downlist-newline-and-parentheses)
- ("\C-cf" . sotlisp-find-or-define-function)
- ("\C-cv" . sotlisp-find-or-define-variable)))
+(speed-of-thought-hook-in #'sotlisp-turn-on-everywhere #'sotlisp-turn-off-everywhere)
\f
;;; Commands
(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