X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/daab7802cdb5efacc482dddc5714c853b49bfac6..55aab326a1213fac44ff0ec2a8df34cc3f79e205:/packages/sotlisp/sotlisp.el diff --git a/packages/sotlisp/sotlisp.el b/packages/sotlisp/sotlisp.el index 6e4bb1168..a4cd9dca3 100644 --- a/packages/sotlisp/sotlisp.el +++ b/packages/sotlisp/sotlisp.el @@ -2,11 +2,11 @@ ;; Copyright (C) 2014, 2015 Free Software Foundation, Inc. -;; Author: Artur Malabarba +;; Author: Artur Malabarba ;; 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)) - ;;; Code: ;;; Predicates @@ -99,7 +98,17 @@ "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"))))))) + +;;; 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