;;; tcl-digraphs.el --- Emacs Minor Mode for Tcl script files ;; Copyright (C) 2018, 2019 Michael Kaelbling, SIEMENS AG. ;; Author: Michael Kaelbling <[email protected]> ;; Author: Peter Spjuth peter dot spjuth at gmail dot com ;; Keywords: Tcl, Tcl/Tk, digraph, keyboard shortcut ;; Version: 3.5 ;; This file is not part of GNU Emacs. ;; 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 ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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)))) (when prefix (goto-char beg) (insert prefix)) (when suffix (goto-char end) (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 () "insert unmapped key" (interactive "*") (if (eq last-input-event 'delete) () (insert tcl-digraph-prefix) (if (not (eq last-input-event 'escape)) (add-to-list 'unread-command-events last-input-event))))) (define-key map "#" 'comment-dwim) (lambda-key map "," '(lambda () "insert } {" (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 \\;" (interactive "*") (insert "\\;"))) (lambda-key map "[" '(lambda () "insert command-quote []" (interactive "*") (tcl--insert "[" "]" 1))) (lambda-key map "]" '(lambda () "append command-quote []" (interactive "*") (move-end-of-line 1) (just-one-space) (insert "[]") (backward-char 1))) (lambda-key map "?" '(lambda () "describe minor mode" (interactive) (describe-minor-mode 'tcl-digraph-minor-mode))) (lambda-key map "a" '(lambda (P) "insert $args" (interactive "*P") (insert (if P "{*}$args" "$args")))) (lambda-key map "b" '(lambda () "append a block-quote {}" (interactive "*") (move-end-of-line 1) (just-one-space) (insert "{}") (backward-char 1))) (lambda-key map "c" '(lambda () "insert command-quote []" (interactive "*") (tcl--insert "[" "]" 1))) (lambda-key map "d" '(lambda (P) "insert dereference $" (interactive "*P") (if P (tcl--insert "${" "}" 1) (insert "$")))) (lambda-key map "e" '(lambda () "append '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' {}" (interactive "*") (move-end-of-line 1) (just-one-space) (insert "elseif {}") (backward-char 1))) (lambda-key map "h" '(lambda (P c) "insert HTML entity" (interactive "*P\nc") (cond ((and (>= c 0) (< c 32)) (insert (format "[&x24%02X]" c))) ((= c 32) (insert (if P "[&x2420]" "[ ]"))) ;␠SP ((= c 34) (insert "["]")) ((= c 38) (insert "[&]")) ((= c 39) (insert "[&apos]")) ((= c ?-) (insert "[­]")) ;soft- ((= c ?<) (insert "[<]")) ((= c ?>) (insert "[>]")) ((= c ?B) (insert "[&x2422]")) ;␢/b ((= c ?b) (insert "[&x2423]")) ;␣ ((= c ?h) (insert "[&hellip]")) ((= c ?n) (insert "[&x2424]")) ;NL ((= c ?p) (insert 182)) ;¶ ((= c ?s) (insert 167)) ;§ ((= c ?|) (insert 166)) ;¦ ((= c 127) (insert "[&x2421]"));␡DEL (t (insert (format "[&%d]" c)))))) (lambda-key map "n" '(lambda () "insert 'not-parens' !()" (interactive "*") (tcl--insert "!(" ")" 1))) (lambda-key map "o" '(lambda () "insert open { § }" (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 ]" (interactive "*P") (if P (insert "$") (tcl--insert "[set " "]" 1)))) (lambda-key map "t" '(lambda () "append 'then' { § }" (interactive "*") (move-end-of-line 1) (just-one-space) (insert "{}") (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 an until block ![] | {![]}" (interactive "*P") (if (and (looking-at-p "}") (not P)) (tcl--insert "![" "]" 1) (tcl--insert "{![" "]}" 2)))) (lambda-key map "v" '(lambda () "insert curly-quote {}" (interactive "*") (tcl--insert "{" "}" 1))) (lambda-key map "w" '(lambda (P) "insert a while block [] | {[]}" (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 verbatim quote {}" (interactive "*") (tcl--insert "{" "}" 1))) (lambda-key map "}" '(lambda () "append verbatim 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'. Undefined digraphs are inserted as is; ESC will insert just the prefix; and DEL will cancel the digraph. The digraphs are: \\{tcl-digraph-minor-mode-map} " :lighter " T;c;l" :global nil :init-value nil :keymap tcl-digraph-minor-mode-map :version "3.4") (provide 'tcl-digraphs) ;;; tcl-digraphs.el ends here