;;; shm-transform.el --- General code transformations
;; 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/add-operand ()
"When in an infix application, figure out the operator and add
a new operand. E.g.
foo <> bar|
will give you
foo <> bar <> |
or
foo <> |bar
will give you
foo <> | <> bar
This is more convenient than typing out the same operator."
(interactive)
(let* ((current-pair (shm-current-node-pair))
(current (cdr current-pair))
(parent-pair (shm-node-parent current-pair))
(parent (cdr parent-pair)))
(cond
((eq 'InfixApp (shm-node-cons parent))
(let ((qop
(or (shm-get-qop-string (cdr (shm-node-previous current-pair)))
(shm-get-qop-string (cdr (shm-node-next current-pair))))))
(cond
(qop
(cond
((= (point) (shm-node-start current))
(let ((point (point)))
(shm-insert-string (concat " " qop " "))
(goto-char point)))
((= (point) (shm-node-end current))
(shm-insert-string (concat " " qop " ")))
(t (error "Please go to the start or end of the node to indicate direction."))))
(t (error "Unable to figure out the operator.")))))
(t (error "Not in an infix application.")))))
(defun shm/raise ()
"Raise the expression up one, replacing its parent."
(interactive)
(let* ((current-pair (shm-current-node-pair))
(current (cdr current-pair))
(parent-pair (shm-node-parent current-pair (shm-node-type current)))
(parent (cdr parent-pair)))
(if 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)))
(error "No matching parent!"))))
(defun shm-get-qop-string (node)
"Get the string of the operator, if the node is an operator."
(when (string= (shm-node-type-name node) "QOp")
(buffer-substring-no-properties (shm-node-start node)
(shm-node-end node))))
(provide 'shm-transform)