structured-haskell-mode 1.0.3 → 1.0.4
raw patch · 15 files changed
+455/−167 lines, 15 filesdep ~haskell-src-exts
Dependency ranges changed: haskell-src-exts
Files
- elisp/shm-ast.el +11/−7
- elisp/shm-case-split.el +57/−7
- elisp/shm-customizations.el +1/−1
- elisp/shm-fold.el +70/−0
- elisp/shm-indent.el +90/−51
- elisp/shm-insert-del.el +31/−22
- elisp/shm-layout.el +49/−26
- elisp/shm-manipulation.el +35/−8
- elisp/shm-nav.el +1/−1
- elisp/shm-node.el +6/−0
- elisp/shm-simple-indent.el +2/−2
- elisp/shm-slot.el +27/−19
- elisp/shm-tests.el +29/−1
- elisp/shm.el +25/−2
- structured-haskell-mode.cabal +21/−20
elisp/shm-ast.el view
@@ -114,11 +114,11 @@ "stmt" "decl") start end)))- (cl-flet ((bail ()- (when shm-display-quarantine- (shm-quarantine-overlay start end))- (setq shm-lighter " SHM!")- nil))+ (let ((bail (lambda ()+ (when shm-display-quarantine+ (shm-quarantine-overlay start end))+ (setq shm-lighter " SHM!")+ nil))) (if parsed-ast (progn (when (bound-and-true-p structured-haskell-repl-mode)@@ -133,8 +133,8 @@ (shm-delete-overlays (point-min) (point-max) 'shm-quarantine) (shm/init) ast)- (bail))))- (bail)))))))))+ (funcall bail))))+ (funcall bail))))))))) (defun shm-font-lock-region (start end) "When in a REPL, we don't typically have font locking, so we@@ -622,5 +622,9 @@ (let* ((vector (save-excursion (goto-char start) (shm-decl-ast)))) (elt vector 0)))++(defun shm-current-node-string ()+ "Get the text of the current shm node"+ (shm-node-string (shm-current-node))) (provide 'shm-ast)
elisp/shm-case-split.el view
@@ -23,6 +23,7 @@ ;;; Code: (require 'shm)+(require 'shm-ast) (require 'haskell-process) (defun shm-case-split-insert-pattern (alts)@@ -56,7 +57,7 @@ (let ((column (current-column))) (loop for alt in alts do (progn (when (/= column (current-column))- (newline)+ (insert "\n") (indent-to column)) (insert (car alt)) (loop for i from 1 to (cdr alt)@@ -144,6 +145,31 @@ ;; Backend based on haskell-process.el +(defun shm-trim-string (string)+ "Remove white spaces in beginning and ending of STRING.+White space here is any of: space, tab, emacs newline (line feed, ASCII 10)."+ (replace-regexp-in-string "\\`[ \t\n]*" "" (replace-regexp-in-string "[ \t\n]*\\'" "" string)))++(defun haskell-process-get-type (expr)+ "Get the type of the given expression or name."+ (let ((reply+ (haskell-process-queue-sync-request (haskell-process)+ (format ":t %s\n" expr))))+ (shm-trim-string (car (last (split-string reply " :: "))))))++(defun shm-cleanup-type-string-for-case (s)+ "Remove constraints and replace polymorphic type variables with+ () to allow shm/case-split to work in more cases."+ (let* ((clean-s (car+ (last+ (mapcar 'shm-trim-string+ (split-string s "=>"))))))+ (if s+ (let ((case-fold-search nil))+ (replace-regexp-in-string "\\b[a-z_][A-Za-z_]*\\b" "()" clean-s))+ s)))++ (defun haskell-process-get-data-type (name) "Get the data type definition of the given name." (let ((reply@@ -151,19 +177,43 @@ (format ":i %s\n" name)))) (car (split-string reply "[\n\t ]+-- Defined ")))) -(defun shm/case-split (name)- "Do a case split on NAME at point."+(defun shm/case-split (name &optional expr-string)+ "Prompt for a type then do a case split based on it." (interactive (list (read-from-minibuffer "Type: "))) (save-excursion- (let ((column (current-column)))- (insert "case undefined ")- (shm-evaporate (- (point) (+ 1 (length "undefined")))- (- (point) 1))+ (let ((column (current-column))+ (case-expr (if expr-string+ expr-string+ "undefined")))+ (insert (concat "case " case-expr " "))+ (if (not expr-string)+ (shm-evaporate (- (point) (+ 1 (length "undefined")))+ (- (point) 1))) (insert "of\n") (indent-to (+ column 2)) (shm-case-split-insert-alts (shm-case-split-alts-from-data-decl (haskell-process-get-data-type name))))))++(defun shm/case-split-shm-node ()+ "Do a case split based on the current node expression type."+ (interactive)+ (let* ((expr (shm-current-node-string))+ (expr-type (haskell-process-get-type expr))+ (clean-expr (shm-cleanup-type-string-for-case expr-type)))+ (if expr-type+ (progn+ (shm/kill-node)+ (shm/case-split clean-expr expr)))))++(defun shm/do-case-split (arg)+ "Without prefix, calculate type of current node expression and replace it+ with a case expression based on its type. With prefix, insert a case expression based+ on the type given at the prompt."+ (interactive "P")+ (if arg+ (call-interactively 'shm/case-split)+ (call-interactively 'shm/case-split-shm-node))) (defun shm/expand-pattern (name) "Expand a pattern match on a data type."
elisp/shm-customizations.el view
@@ -158,7 +158,7 @@ (defcustom shm-pragmas '("LANGUAGE" "OPTIONS_GHC" "INCLUDE" "DEPRECATED" "WARNING" "INLINE" "NOINLINE" "INLINABLE" "CONLIKE" "LINE" "RULES"- "SPECIALIZE" "UNPACK" "SOURCE")+ "SPECIALIZE" "UNPACK" "SOURCE" "SCC") "Pragmas supported." :group 'shm :type 'list)
+ elisp/shm-fold.el view
@@ -0,0 +1,70 @@+;;; shm-fold.el --- Code folding.++;; Copyright (c) 2014 Chris Done. All rights reserved.++;; This file is free software; you can redistribute it and/or modify+;; it under the terms of the GNU General Public License as published by+;; the Free Software Foundation; either version 3, or (at your option)+;; any later version.++;; This file is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with this program. If not, see <http://www.gnu.org/licenses/>.++;;; Code:++(defun shm-fold ()+ "Fold either the region or the node at point."+ (interactive)+ (if (region-active-p)+ (shm-fold-region (region-beginning)+ (region-end))+ (let ((current (shm-current-node)))+ (shm-fold-region (shm-node-start current)+ (shm-node-end current)))))++(defun shm-fold-toggle-decl ()+ "Toggle the folding or unfolding of the declaration."+ (interactive)+ (let* ((points (shm-decl-points))+ (o (car (remove-if-not (lambda (o)+ (overlay-get o 'folded-decl))+ (overlays-in (car points)+ (cdr points))))))+ (if o+ (delete-overlay o)+ (shm-fold-decl))))++(defun shm-fold-decl ()+ "Fold the current declaration."+ (interactive)+ (let* ((points (shm-decl-points))+ (beg (save-excursion (goto-char (car points))+ (line-end-position)))+ (end (cdr points)))+ (when (> end beg)+ (shm-fold-region beg end 'folded-decl))))++(defun shm-fold-region (beg end &optional prop)+ "Hide region."+ (let ((o (make-overlay beg end)))+ (overlay-put o 'invisible t)+ (overlay-put o 'intangible t)+ (overlay-put o 'after-string "...")+ (overlay-put o 'hide-region t)+ (overlay-put o prop t)))++(defun shm-fold-region-undo ()+ "Undo the hidden region at point."+ (interactive)+ (mapcar (lambda (o)+ (when (overlay-get o 'hide-region)+ (delete-overlay o)))+ (overlays-in (- (point) 1)+ (+ (point) 1))))++(provide 'shm-fold)
elisp/shm-indent.el view
@@ -18,6 +18,7 @@ ;;; Code: (require 'shm-layout)+(require 'shm-simple-indent) (defun shm/delete-indentation () "Send the node up one line."@@ -143,6 +144,8 @@ with it." (interactive) (cond+ ((not (shm-current-node))+ (shm/simple-indent)) ((and (shm-in-string) (not (= (shm-node-start (shm-current-node)) (point))))@@ -243,19 +246,7 @@ (or (eq 'List (shm-node-cons parent)) (eq 'Tuple (shm-node-cons parent)) (eq 'QualStmt (shm-node-cons parent))))- (let* ((first-item-on-line (save-excursion- (goto-char (shm-node-start current))- (search-backward-regexp "[[,][ ]*")- (= (current-column)- (shm-node-start-column parent)))))- (shm-newline)- (indent-to (shm-node-start-column parent))- (insert ",")- (when first-item-on-line- (insert (make-string (- (shm-node-start-column current)- (current-column))- ? )))- (shm-set-node-overlay parent-pair)))+ (shm-newline-indent-listish current parent parent-pair)) ;; Lambdas indents k spaces inwards ((eq 'Lambda (shm-node-cons current)) (shm-newline)@@ -274,7 +265,8 @@ ;; Indentation for function application. ((and parent (or (eq 'App (shm-node-cons parent))- (eq 'TyApp (shm-node-cons parent))))+ (eq 'TyApp (shm-node-cons parent))+ (eq 'ConDecl (shm-node-cons parent)))) (let ((column (save-excursion (if (/= (shm-node-start-line current)@@ -385,48 +377,14 @@ (let ((alt (cdr (shm-node-parent parent-pair)))) (indent-to (+ (shm-node-start-column alt) (shm-indent-spaces)))))- ;; Copy infix operators similar to making new list/tuple- ;; separators- ((and parent- (eq 'InfixApp (shm-node-cons parent)))- (let* ((operand-pair (shm-node-previous current-pair))- (operand (cdr operand-pair))- (string (buffer-substring-no-properties (shm-node-start operand)- (shm-node-end operand))))- (cond- (dragging- (shm-newline)- (indent-to (shm-node-start-column parent)))- ((save-excursion (goto-char (shm-node-end operand))- (= (point) (line-end-position)))- (insert " " string)- (shm-newline)- (indent-to (shm-node-start-column current)))- (t- (shm-newline)- (indent-to (shm-node-start-column operand))- (insert string " "))))) ;; Infix operators ((and parent (eq 'InfixApp (shm-node-cons parent))) (shm-newline) (indent-to (+ (shm-node-start-column parent))))- ;; ((eq 'Alt (shm-node-cons current))- ;; (shm-newline)- ;; (indent-to (shm-node-start-column current))- ;; (when shm-auto-insert-skeletons- ;; (save-excursion (insert "_ -> undefined"))- ;; (shm-evaporate (point) (+ (point) 1))- ;; (shm-evaporate (+ (point) (length "_ -> "))- ;; (+ (point) (length "_ -> undefined")))))- ;; Commenting out this behaviour for now- ;; ((string= "Match" (shm-node-type-name current))- ;; (let ((name (cdr (shm-node-child-pair current-pair))))- ;; (shm-newline)- ;; (indent-to (shm-node-start-column current))- ;; (insert (buffer-substring-no-properties (shm-node-start name)- ;; (shm-node-end name))- ;; " ")))+ ((and parent+ (eq 'Paren (shm-node-cons parent)))+ (shm-newline-indent-listish current parent parent-pair)) ;; Default indentation just copies the current node's indentation ;; level. Generally works reliably, but has less than favourable ;; indentation sometimes. It just serves as a catch-all.@@ -434,6 +392,77 @@ (shm-newline) (indent-to (shm-node-start-column current)))))) +(defun shm-newline-indent-listish (current parent parent-pair)+ "Indent and insert a comma for a list-ish syntactical node."+ (let* ((first-item-on-line (and (not (looking-at ","))+ (save-excursion+ (goto-char (shm-node-start current))+ (search-backward-regexp "[[,][ ]*")+ (= (current-column)+ (shm-node-start-column parent)))))+ (go-back (and first-item-on-line+ (= (point) (shm-node-start current))))+ (already-have-comma (looking-back ",")))+ (shm-newline)+ (indent-to (shm-node-start-column parent))+ ;; Don't insert duplicate commas.+ (unless (or (looking-at ",") already-have-comma)+ (insert ","))+ (when go-back+ (let ((column (current-column)))+ (forward-line -1)+ (forward-char column)))+ (when first-item-on-line+ (insert (make-string (- (shm-node-start-column current)+ (current-column))+ ? )))+ (unless (or (looking-back ",")+ (looking-at ","))+ (insert " "))+ (shm-set-node-overlay parent-pair)))++;; Copy infix operators similar to making new list/tuple+;; separators+;; ((and parent+;; (eq 'InfixApp (shm-node-cons parent)))+;; (let* ((operand-pair (shm-node-previous current-pair))+;; (operand (cdr operand-pair))+;; (string (buffer-substring-no-properties (shm-node-start operand)+;; (shm-node-end operand))))+;; (cond+;; (dragging+;; (shm-newline)+;; (indent-to (shm-node-start-column parent)))+;; ((save-excursion (goto-char (shm-node-end operand))+;; (= (point) (line-end-position)))+;; (insert " " string)+;; (shm-newline)+;; (indent-to (shm-node-start-column current)))+;; (t+;; (shm-newline)+;; (indent-to (shm-node-start-column operand))+;; (insert string " ")))))++;; A case for shm-newline-indent which will copy a case-alt. Not+;; determined how to best include this feature yet.+;;+;; ((eq 'Alt (shm-node-cons current))+;; (shm-newline)+;; (indent-to (shm-node-start-column current))+;; (when shm-auto-insert-skeletons+;; (save-excursion (insert "_ -> undefined"))+;; (shm-evaporate (point) (+ (point) 1))+;; (shm-evaporate (+ (point) (length "_ -> "))+;; (+ (point) (length "_ -> undefined")))))+;; Commenting out this behaviour for now+;; ((string= "Match" (shm-node-type-name current))+;; (let ((name (cdr (shm-node-child-pair current-pair))))+;; (shm-newline)+;; (indent-to (shm-node-start-column current))+;; (insert (buffer-substring-no-properties (shm-node-start name)+;; (shm-node-end name))+;; " ")))+ (defun shm-auto-insert-field-prefix (current parent) "Auto insert prefixes of fields in record declarations. Example: @@ -468,5 +497,15 @@ "Normal `newline' does funny business. What we want is to literally insert a newline and no more." (insert "\n"))++(defun shm/split-line ()+ "Split line."+ (interactive)+ (if (shm-literal-insertion)+ (call-interactively 'split-line)+ (save-excursion+ (let ((column (current-column)))+ (insert "\n")+ (indent-to column))))) (provide 'shm-indent)
elisp/shm-insert-del.el view
@@ -63,28 +63,32 @@ (shm-auto-insert-skeletons (cond ((and (looking-back "[^a-zA-Z0-9_]do")- (or (eolp)- (looking-at "[])}]")))+ (shm-nothing-following-p)) (shm-auto-insert-do)) ((and (looking-back " <-") (let ((current (shm-current-node))) (when current (or (eq 'Do (shm-node-cons current)) (string= "Stmt" (shm-node-type-name current))))))- (shm-auto-insert-stmt 'qualifier))- ((looking-back "[^a-zA-Z0-9_]case")+ (if (bound-and-true-p structured-haskell-repl-mode)+ (insert " ")+ (shm-auto-insert-stmt 'qualifier)))+ ((and (looking-back "[^a-zA-Z0-9_]case")+ (shm-nothing-following-p)) (shm-auto-insert-case))- ((looking-back "[^a-zA-Z0-9_]if")+ ((and (looking-back "[^a-zA-Z0-9_]if")+ (shm-nothing-following-p)) (shm-auto-insert-if))- ((looking-back "[^a-zA-Z0-9_]let")+ ((and (looking-back "[^a-zA-Z0-9_]let")+ (shm-nothing-following-p)) (cond ((let ((current (shm-current-node))) (and current (or (not (or (eq 'Do (shm-node-cons current)) (eq 'BDecls (shm-node-cons current)) (string= "Stmt" (shm-node-type-name current))))- (bound-and-true-p structured-haskell-repl-mode)))- (shm-auto-insert-let)))+ (bound-and-true-p structured-haskell-repl-mode))))+ (shm-auto-insert-let)) ((not (bound-and-true-p structured-haskell-repl-mode)) (shm-auto-insert-stmt 'let)))) ((and (looking-back "module")@@ -95,6 +99,11 @@ (t (shm-insert-string " ")))) (t (shm-insert-string " ")))))) +(defun shm-nothing-following-p ()+ "Is there nothing following me (other than closing delimiters)?"+ (or (eolp)+ (looking-at "[])},;]")))+ (defun shm/double-quote () "Insert double quotes. @@ -278,6 +287,9 @@ delete-backward-char (let ((case-fold-search nil)) (cond+ ((region-active-p)+ (delete-region (region-beginning)+ (region-end))) ;; These cases are “gliders”. They simply move over the character ;; backwards. These could be handled all as one regular ;; expression, but in the interest of clarity—for now—they are left@@ -306,22 +318,19 @@ ;; otherwise break everything, so, "if", "of", "case", "do", ;; etc. if deleted. ((and (shm-prevent-parent-deletion-p)- (looking-back "[^A-Zaz0-9_]do ?")- (not (or (eolp)- (looking-at "[])}]"))))+ (looking-back "[^A-Za-z0-9_']do ?")+ (shm-nothing-following-p)) nil) ; do nothing ((and (shm-prevent-parent-deletion-p) (looking-back " <-")- (not (or (eolp)- (looking-at "[])}]"))))+ (shm-nothing-following-p)) (forward-char -3)) ((and (shm-prevent-parent-deletion-p) (looking-back " <- ")- (not (or (eolp)- (looking-at "[])}]"))))+ (shm-nothing-following-p)) (forward-char -4)) ((and (shm-prevent-parent-deletion-p)- (looking-back "[^A-Zaz0-9_]of ?"))+ (looking-back "[^A-Za-z0-9_]of ?")) (search-backward-regexp "[ ]*of")) ((and (shm-prevent-parent-deletion-p) (or (looking-at "of$")@@ -333,12 +342,12 @@ (looking-at "-> ?")) (forward-char -1)) ((and (shm-prevent-parent-deletion-p)- (looking-back "[^A-Zaz0-9_]then ?"))+ (looking-back "[^A-Za-z0-9_]then ?")) (search-backward-regexp "[^ ][ ]*then") (unless (or (looking-at "$") (looking-at " ")) (forward-char 1))) ((and (shm-prevent-parent-deletion-p)- (looking-back "[^A-Zaz0-9_]else ?"))+ (looking-back "[^A-Za-z0-9_]else ?")) (search-backward-regexp "[^ ][ ]*else") (unless (or (looking-at "$") (looking-at " ")) (forward-char 1)))@@ -347,10 +356,10 @@ (when (looking-at "[ ]*where$") (delete-region (line-beginning-position) (line-end-position)))) ((and (shm-prevent-parent-deletion-p)- (looking-back "[^A-Zaz0-9_]if ?"))+ (looking-back "[^A-Za-z0-9_]if ?")) nil) ; do nothing ((and (shm-prevent-parent-deletion-p)- (looking-back "[^A-Zaz0-9_]case ?"))+ (looking-back "[^A-Za-z0-9_]case ?")) nil) ; do nothing ((and (shm-prevent-parent-deletion-p) (and (looking-at "= ")@@ -360,7 +369,7 @@ (or (and (looking-back " = ") (not (looking-at "$")) (not (looking-at " ")))- (and (looking-back "=")+ (and (looking-back "[\w ]=") (looking-at " ")))) (search-backward-regexp "[ ]+=[ ]*" (line-beginning-position)@@ -522,7 +531,7 @@ (save-excursion (back-to-indentation) (point)))))) (save-excursion- (newline)+ (insert "\n") (indent-to column) (insert "undefined") (forward-word -1)
elisp/shm-layout.el view
@@ -167,18 +167,28 @@ this underside dangling vs not. But that will be implemented as a separate function rather than hard-coded into this one specific operation."- (let ((column (current-column))- (line (line-beginning-position))- (start (point)))- (let ((string- (with-temp-buffer- (funcall do-insert)- (buffer-string))))- (insert (if (shm-in-string)- (replace-regexp-in-string- "\n" "\\\\n\\\\\n\\\\"- string)- string)))+ (let* ((column (current-column))+ (line (line-beginning-position))+ (start (point))+ (string+ (with-temp-buffer+ (funcall do-insert)+ (buffer-string)))+ (swinging+ (with-temp-buffer+ (insert string)+ (get-text-property (point-min) 'shm-swinging-expr)))+ (current-node-pair+ (when swinging+ (shm-current-node-pair)))+ (furthest-parent+ (when current-node-pair+ (shm-find-furthest-parent-on-line current-node-pair))))+ (insert (if (shm-in-string)+ (replace-regexp-in-string+ "\n" "\\\\n\\\\\n\\\\"+ string)+ string)) (when (and (= line (line-beginning-position)) (not no-adjust-dependents)) (shm-adjust-dependents start (- (current-column)@@ -187,20 +197,14 @@ (goto-char (region-end))) (let ((end (point))) (cond- ((save-excursion (goto-char start)- (looking-at " "))- (let ((current-pair (shm-current-node-pair)))- (when (and current-pair (= (point-max) (point)) current-pair)- (let ((node (cdr (shm-find-furthest-parent-on-line current-pair))))- (goto-char end)- (indent-rigidly start- end- (+ (shm-indent-spaces)- (shm-node-indent-column node)))- (delete-region start- (save-excursion- (goto-char start)- (search-forward-regexp "[ ]+" (line-end-position) t 1)))))))+ (swinging+ (when furthest-parent+ (let ((node (cdr furthest-parent)))+ (goto-char end)+ (indent-rigidly start+ end+ (+ (shm-indent-spaces)+ (shm-node-indent-column node)))))) (t (goto-char end) (indent-rigidly start end column))) (push-mark)@@ -298,6 +302,25 @@ (when (looking-at "^$") (delete-region (1- (point)) (point)))+ (when (> (count-lines (point-min)+ (point-max))+ 1)+ (let* ((first-line-col (save-excursion (goto-char (point-min))+ (back-to-indentation)+ (current-column)))+ (second-line-col (save-excursion (goto-char (point-min))+ (forward-line)+ (back-to-indentation)+ (current-column))))+ (when (> first-line-col second-line-col)+ (goto-char (point-min))+ (indent-rigidly (line-beginning-position)+ (line-end-position)+ (- first-line-col))+ (put-text-property (point-min)+ (point-max)+ 'shm-swinging-expr+ t)))) ;; Finally, the actual save. (funcall (if save-it save-it 'clipboard-kill-ring-save) (point-min)
elisp/shm-manipulation.el view
@@ -70,13 +70,18 @@ (parent (cdr parent-pair)) (actual-parent-pair (shm-node-parent current-pair))) (cond+ ((and parent+ (or (shm-node-app-p current)+ (eq (shm-node-cons current) 'TyFun))+ (shm-node-paren-p parent))+ (let* ((grandparent-pair (shm-node-parent parent-pair (shm-node-type current)))+ (grandparent (cdr grandparent-pair)))+ (when grandparent+ (shm-raise-to current grandparent)))) (parent- (if (string= (shm-node-type current)- (shm-node-type parent))- (let ((shm/raise-code (shm-kill-node 'buffer-substring-no-properties nil nil t)))- (shm-kill-node 'buffer-substring-no-properties parent)- (shm-insert-indented (lambda () (insert shm/raise-code)))- (shm/reparse))))+ (when (string= (shm-node-type current)+ (shm-node-type parent))+ (shm-raise-to current parent))) ((and (eq 'UnGuardedRhs (shm-node-cons (cdr actual-parent-pair))) (eq 'Lambda (shm-node-cons current))) (goto-char (shm-node-start current))@@ -91,6 +96,28 @@ (t (error "No matching parent!"))))) +(defun shm-raise-to (current parent)+ "Raise the current node and replace PARENT."+ (let ((shm/raise-code (shm-kill-node 'buffer-substring-no-properties current nil t)))+ (shm-kill-node 'buffer-substring-no-properties parent)+ (shm-insert-indented (lambda () (insert shm/raise-code)))+ (shm/reparse)))++(defun shm/splice ()+ "Splice the current children wrapped in parens into the parent.++foo (a b c) -> foo a b c++Only parenthesized nodes are supported at the moment."+ (interactive)+ (let* ((current-pair (shm-current-node-pair))+ (current (cdr current-pair))+ (parent-pair (shm-node-parent current-pair))+ (parent (cdr parent-pair)))+ (if (and parent (shm-node-paren-p parent))+ (shm-raise-to current parent)+ (message "Unsupported node type for splicing!"))))+ (defun shm/split-list () "Split the current list into two lists by the nearest comma." (interactive)@@ -122,9 +149,9 @@ ((shm-in-comment) (save-excursion (unless (looking-at "{-")- (search-backward-regexp "{" nil nil 1))+ (search-backward-regexp "{-" nil nil 1)) (delete-region (point) (+ 2 (point)))- (search-forward-regexp "}" nil nil 1)+ (search-forward-regexp "-}" nil nil 1) (delete-region (- (point) 2) (point)))) (current (save-excursion
@@ -61,7 +61,7 @@ (search-forward-regexp "where[ \n]*")) (t (unless (= (line-beginning-position) (point))- (newline))+ (insert "\n")) (let ((indent (shm-node-start-column (cdr (shm-node-parent (cons i rhs)))))) (indent-to (+ 2 indent))
elisp/shm-node.el view
@@ -106,4 +106,10 @@ (eq (shm-node-cons node) 'InfixApp) (eq (shm-node-cons node) 'TyApp))) +(defun shm-node-paren-p (node)+ "Is the given node a paren of some kind?"+ (or (eq (shm-node-cons node) 'Paren)+ (eq (shm-node-cons node) 'PParen)+ (eq (shm-node-cons node) 'TyParen)))+ (provide 'shm-node)
elisp/shm-simple-indent.el view
@@ -91,10 +91,10 @@ "[^ ]" (line-end-position) t 1)))) (when end (cons start (1- end))))))) (if start-end- (progn (newline)+ (progn (insert "\n") (insert (buffer-substring-no-properties (car start-end) (cdr start-end))))- (newline)))))+ (insert "\n"))))) (defun shm/simple-indent-newline-indent () "Make a newline on the current column and indent on step."
elisp/shm-slot.el view
@@ -60,6 +60,14 @@ (shm-insert-string "undefined") (shm-evaporate point (point))))) +(defun shm/insert-underscore ()+ "Insert underscore."+ (interactive)+ (save-excursion+ (let ((point (point)))+ (shm-insert-string "_")+ (shm-evaporate point (point)))))+ (defun shm-auto-insert-do () "Insert template @@ -76,7 +84,7 @@ (shm/reparse) (save-excursion (shm-evaporate (point) (+ (point) (length "undefined")))))- (t (newline)+ (t (insert "\n") (indent-to column) (let ((next-point (point))) (insert "undefined")@@ -154,32 +162,32 @@ let | in {undefined}" (delete-region (- (point) 3) (point)) ;; If needs to be nested this way. Don't change it.- (cl-flet- ((evaporate-in ()- (forward-char 4)- (save-excursion- (forward-word)- (forward-char 1)- (shm-evaporate (point) (+ (point) (length "undefined"))))))+ (let+ ((evaporate-in (lambda ()+ (forward-char 4)+ (save-excursion+ (forward-word)+ (forward-char 1)+ (shm-evaporate (point) (+ (point) (length "undefined"))))))) (if (bound-and-true-p structured-haskell-repl-mode) (let ((points (shm-decl-points))) (if points (if (= (point) (car points))+ (progn (shm-insert-indented+ (lambda () (insert "let _ = undefined")))+ (search-forward "_")+ (shm-evaporate (1- (point)) (point))+ (forward-word 1)+ (forward-word -1)+ (shm-evaporate (point) (+ (point) (length "undefined")))+ (search-backward "_")) (progn (shm-insert-indented- (lambda () (insert "let _ = undefined")))- (search-forward "_")- (shm-evaporate (1- (point)) (point))- (forward-word 1)- (forward-word -1)- (shm-evaporate (point) (+ (point) (length "undefined")))- (search-backward "_"))- (progn (shm-insert-indented- (lambda () (insert "let in undefined")))- (evaporate-in)))+ (lambda () (insert "let in undefined")))+ (funcall evaporate-in))) (insert "let "))) (progn (shm-insert-indented (lambda () (insert "let \nin undefined")))- (evaporate-in))))+ (funcall evaporate-in)))) (shm/reparse)) (defun shm-auto-insert-module ()
elisp/shm-tests.el view
@@ -23,6 +23,25 @@ (defvar shm-tests-that-dont-run-in-batch-mode (list+ (list :name "swinging-expr-yanking"+ :start-buffer-content "main = do+ x+ z+ y++foo = undefined+"+ :start-cursor 8+ :finish-cursor 17+ :current-node-overlay '(17 31)+ :end-buffer-content "main = a++foo = do+ x+ z+ y+"+ :kbd [134217739 97 1 14 14 6 6 6 6 6 6 delete 25]) (list :name "yanking" :start-buffer-content "main = (case undefined of _ -> undefined@@ -421,9 +440,18 @@ :start-cursor 37 :finish-cursor 8 :current-node-overlay '(8 11)- :end-buffer-content "main = foo bar bu+ :end-buffer-content "main = bar bu " :kbd "\341\362\341\362")+ (list :name "splice"+ :start-buffer-content "main = foo (bar)+"+ :start-cursor 13+ :finish-cursor 12+ :current-node-overlay '(12 15)+ :end-buffer-content "main = foo bar+"+ :kbd "\363") (list :name "kill-line" :start-buffer-content "main = do foo bar
elisp/shm.el view
@@ -54,16 +54,18 @@ (define-key map (kbd ":") 'shm/:) (define-key map (kbd "SPC") 'shm/space) (define-key map (kbd "C-c C-u") 'shm/insert-undefined)+ (define-key map (kbd "C-c C-_") 'shm/insert-underscore) (define-key map (kbd "M-;") 'shm/comment) (define-key map (kbd "C-c C-e") 'shm/export)+ (define-key map (kbd "C-M-o") 'shm/split-line) ;; Indentation- (define-key map (kbd "C-j") 'shm/newline-indent)+ (define-key map (kbd "C-j") 'shm/newline-indent-proxy) (define-key map (kbd "M-)") 'paredit-close-round-and-newline) (define-key map (kbd "C-c C-^") 'shm/swing-up) (define-key map (kbd "C-c C-j") 'shm/swing-down) (define-key map (kbd "TAB") 'shm/tab) (define-key map (kbd "<backtab>") 'shm/backtab)- (define-key map (kbd "RET") 'shm/simple-indent-newline-same-col)+ (define-key map (kbd "RET") 'shm/ret-proxy) (define-key map (kbd "C-<return>") 'shm/simple-indent-newline-indent) ;; Deletion (define-key map (kbd "DEL") 'shm/del)@@ -93,6 +95,7 @@ ;; Splitting, slurping, barfing, etc. (define-key map (kbd "C-+") 'shm/add-operand) (define-key map (kbd "M-r") 'shm/raise)+ (define-key map (kbd "M-s") 'shm/splice) (define-key map (kbd "C-c C-q") 'shm/qualify-import) map) "Structural editing operations keymap. Any key bindings in this@@ -126,6 +129,7 @@ (define-key map (kbd ":") 'shm/:) (define-key map (kbd "SPC") 'shm/space) (define-key map (kbd "C-c C-u") 'shm/insert-undefined)+ (define-key map (kbd "C-c C-_") 'shm/insert-underscore) (define-key map (kbd "M-;") 'shm/comment) ;; Navigation (define-key map (kbd "C-M-f") 'shm/forward-node)@@ -156,6 +160,7 @@ ;; Splitting, slurping, barfing, etc. (define-key map (kbd "C-+") 'shm/add-operand) (define-key map (kbd "M-r") 'shm/raise)+ (define-key map (kbd "M-s") 'shm/splice) (define-key map (kbd "C-c C-q") 'shm/qualify-import) map) "Structural editing operations keymap for in the REPL. This@@ -191,6 +196,8 @@ ;; Kill the timer. (cancel-timer shm-parsing-timer) (setq shm-parsing-timer nil)+ ;; Kill self-insert hooks.+ (remove-hook 'post-self-insert-hook 'shm-post-self-insert t) ;; Delete all markers. (mapc (lambda (pair) (mapc #'shm-node-delete-markers@@ -234,5 +241,21 @@ (shm/simple-indent-backtab)) (t (shm/jump-to-previous-slot))))++(defun shm/ret-proxy ()+ "Run `shm/simple-indent-newline-same-col', or in electric mode+ run `shm/newline-indent' (swaps behaviour)."+ (interactive)+ (if (bound-and-true-p electric-indent-mode)+ (call-interactively 'shm/newline-indent)+ (call-interactively 'shm/simple-indent-newline-same-col)))++(defun shm/newline-indent-proxy ()+ "Run `shm/newline-indent', or in electric mode+ run `simple-indent-newline-same-col' (swaps behaviour)."+ (interactive)+ (if (bound-and-true-p electric-indent-mode)+ (call-interactively 'shm/simple-indent-newline-same-col)+ (call-interactively 'shm/newline-indent))) (provide 'shm)
structured-haskell-mode.cabal view
@@ -1,5 +1,5 @@ name: structured-haskell-mode-version: 1.0.3+version: 1.0.4 synopsis: Structured editing Emacs mode for Haskell description: Structured editing Emacs mode for Haskell. homepage: https://github.com/chrisdone/structured-haskell-mode@@ -11,34 +11,35 @@ category: Development build-type: Simple cabal-version: >=1.8-data-files: elisp/shm-case-split.el+data-files: elisp/shm-ast-documentation.el+ elisp/shm-ast.el+ elisp/shm-case-split.el elisp/shm-constraint.el- elisp/shm-yank-kill.el- elisp/shm-indent.el- elisp/shm.el- elisp/shm-debug.el elisp/shm-customizations.el- elisp/shm-macros.el- elisp/shm-layout.el- elisp/shm-ast.el- elisp/shm-evaporate.el- elisp/shm-simple-indent.el- elisp/shm-type.el- elisp/shm-node.el+ elisp/shm-debug.el elisp/shm-edit-string.el+ elisp/shm.el+ elisp/shm-evaporate.el+ elisp/shm-fold.el+ elisp/shm-indent.el elisp/shm-in.el- elisp/shm-tests.el- elisp/shm-overlays.el- elisp/shm-test.el- elisp/shm-manipulation.el- elisp/shm-slot.el elisp/shm-insert-del.el+ elisp/shm-layout.el+ elisp/shm-macros.el+ elisp/shm-manipulation.el elisp/shm-nav.el- elisp/shm-ast-documentation.el+ elisp/shm-node.el+ elisp/shm-overlays.el+ elisp/shm-simple-indent.el+ elisp/shm-slot.el+ elisp/shm-test.el+ elisp/shm-tests.el+ elisp/shm-type.el+ elisp/shm-yank-kill.el executable structured-haskell-mode main-is: Main.hs ghc-options: -O2 -Wall hs-source-dirs: src build-depends: base >= 4 && < 5,- haskell-src-exts >= 1.14.0+ haskell-src-exts == 1.15.*