;;; tcl-digraphs.el --- Emacs Minor Mode for Tcl
;; Copyright 2020 SIEMENS AG.
;; SPDX-License-Identifier: MIT-0
;; Author: Michael Kaelbling <michael.kaelbling@siemens.com>
;; Keywords: Tcl, Tcl/Tk, digraph, keyboard shortcut
;; Version: 4.1.2
;; This file is not part of GNU Emacs.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
(defgroup tcl-digraphs nil
"Customizations for tcl-digraphs."
:group 'tcl)
(defcustom tcl-digraph-prefix ";"
"*Prefix key"
:type 'string
:group 'tcl-digraphs)
(defun tcl--insert (prefix suffix n)
"Insert text before and after the active-region or point.
PREFIX is the text to precede the active-region or point.
SUFFIX is the text to follow the active-region or point.
N is the number of characters to back-up after inserting SUFFIX."
(let ((beg (if (region-active-p) (region-beginning) (point)))
(end (+ (if (region-active-p) (region-end) (point))
(length prefix))))
(goto-char beg)
(if prefix (insert prefix))
(push-mark)
(goto-char end)
(if suffix (insert suffix))
(when n (backward-char n))))
(defun lambda-key (keymap key def)
"Workaround `define-key' to provide documentation."
(set 'sym (make-symbol (documentation def)))
(fset sym def)
(define-key keymap key sym))
(defconst tcl-digraph-map
(let ((map (make-sparse-keymap)))
(lambda-key map [t] '(lambda () "handle event <t>"
(interactive "*")
(unless (eq last-input-event 'delete)
(insert tcl-digraph-prefix)
(unless
(eq last-input-event 'escape)
(add-to-list
'unread-command-events
last-input-event)))))
(lambda-key map "," '(lambda ()
"insert curly cut } {§"
(interactive "*") (insert "} {")))
(lambda-key map "/" '(lambda (P)
"append splice » \\¬§"
(interactive "*P")
(move-end-of-line 1)
(if (not P) (just-one-space))
(insert "\\") (newline)))
(lambda-key map ";" '(lambda ()
"insert data semicolon \\;§"
(interactive "*") (insert "\\;")))
(lambda-key map "=" '(lambda ()
"insert expression [expr {¶§}]"
(interactive "*")
(tcl--insert "[expr {" "}]" 2)))
(lambda-key map "?" '(lambda ()
"describe minor mode"
(interactive)
(describe-minor-mode
'tcl-digraph-minor-mode)))
(lambda-key map "[" '(lambda ()
"insert command [¶§]"
(interactive "*")
(tcl--insert "[" "]" 1)))
(lambda-key map "]" '(lambda ()
"append command » [§]"
(interactive "*")
(move-end-of-line 1) (just-one-space)
(insert "[]") (backward-char 1)))
(lambda-key map "a" '(lambda (P)
"insert args $args§ ¦ {*}$args§"
(interactive "*P")
(insert (if P "$args" "{*}$args"))))
(lambda-key map "b" '(lambda ()
"append blockquote » {§}"
(interactive "*")
(move-end-of-line 1) (just-one-space)
(insert "{}") (backward-char 1)))
(lambda-key map "c" '(lambda ()
"insert command [¶§]"
(interactive "*")
(tcl--insert "[" "]" 1)))
(lambda-key map "d" '(lambda (P)
"insert dollar-sign $¶§"
(interactive "*P")
(if P (tcl--insert "${" "}" 1)
(insert "$"))))
(lambda-key map "e" '(lambda ()
"append else » else {¬§¬}"
(interactive "*")
(move-end-of-line 1) (just-one-space)
(insert "else {}") (backward-char 1)
(newline) (tcl-indent-command)
(move-beginning-of-line 1)
(open-line 1) (tcl-indent-command)))
(lambda-key map "f" '(lambda ()
"append elseif » elseif {§}"
(interactive "*")
(move-end-of-line 1) (just-one-space)
(insert "elseif {}")
(backward-char 1)))
(lambda-key map "n" '(lambda ()
"insert not-parens !(¶§)"
(interactive "*")
(tcl--insert "!(" ")" 1)))
(lambda-key map "o" '(lambda ()
"insert and open block {¬§¬}"
(interactive "*")
(insert "{}") (backward-char 1)
(newline) (tcl-indent-command)
(move-beginning-of-line 1)
(open-line 1) (tcl-indent-command)))
(lambda-key map "p" '(lambda ()
"insert parentheses (¶§)"
(interactive "*")
(tcl--insert "(" ")" 1)))
(lambda-key map "q" '(lambda ()
"insert quotes \"¶§\""
(interactive "*")
(tcl--insert "\"" "\"" 1)))
(lambda-key map "s" '(lambda (P)
"insert set [set ¶§] ¦ $¶§"
(interactive "*P")
(if P (tcl--insert "$" "" 0)
(tcl--insert "[set " "]" 1))))
(lambda-key map "t" '(lambda (P)
"append then » {¬§¬} ¦ » then {¬§¬}"
(interactive "*P")
(move-end-of-line 1) (just-one-space)
(when P
(insert "then ")
;; lest `tcl-indent-command'
;; (c) 2019 chock ...
(set 'current-prefix-arg nil))
(indent "{}")
(backward-char 1)
(newline) (tcl-indent-command)
(move-beginning-of-line 1)
(open-line 1) (tcl-indent-command)))
(lambda-key map "u" '(lambda (P)
"insert until clause ![¶§] ¦ {![¶§]}"
(interactive "*P")
(if (and (looking-at-p "}") (not P))
(tcl--insert "![" "]" 1)
(tcl--insert "{![" "]}" 2))))
(lambda-key map "v" '(lambda ()
"insert verbatim quote {¶§}"
(interactive "*")
(tcl--insert "{" "}" 1)))
(lambda-key map "w" '(lambda (P)
"insert while clause [¶§] ¦ {[¶§]}"
(interactive "*P")
(if (and (looking-at-p "}") (not P))
(tcl--insert "[" "]" 1)
(tcl--insert "{[" "]}" 2))))
(lambda-key map "x" '(lambda (P)
"insert expander {*}§ ¦ {*}$args§"
(interactive "*P")
(insert (if P "{*}$args" "{*}"))))
(lambda-key map "{" '(lambda ()
"insert curly quote {¶§}"
(interactive "*")
(tcl--insert "{" "}" 1)))
(lambda-key map "}" '(lambda ()
"append curly quote » {§}"
(interactive "*")
(move-end-of-line 1) (just-one-space)
(insert "{}") (backward-char 1)))
map)
"Keymap behind the `tcl-digraph-minor-mode' prefix key.")
(defconst tcl-digraph-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map tcl-digraph-prefix tcl-digraph-map)
map)
"Keymap for `tcl-digraph-minor-mode'.")
(put 'tcl-digraph-minor-mode :included t)
(define-minor-mode tcl-digraph-minor-mode
"The `tcl-digraph-minor-mode' 4.1 bindings.
Undefined digraphs ignore the prefix; ESC will insert just
the prefix; and DEL will cancel the digraph. Some special
symbols are used in the description: a \\='§' shows where the
cursor will be positioned, while \\='¶' represents the active
region before expansion, a \\='¬' is a newline, and \\='»' shows
that the expansion is put at the end of the line, with \\='¦'
appearing between a simple expansion and an expansion with
a \\[universal-argument] prefix. The 4.1 digraphs are:
\\{tcl-digraph-minor-mode-map}
"
:lighter " T;c;l" :global nil :init-value nil
:keymap tcl-digraph-minor-mode-map)
(provide 'tcl-digraphs)
;;; tcl-digraphs.el ends here