lem/extensions/smart-parens-mode/smart-parens-mode.lisp at f880f1285f4c13846cfc2cb61570461b447790be · lem-project/lem · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
(defpackage :lem-smart-parens-mode
  (:use :cl :lem)
  (:export :smart-parens-mode))
(in-package :lem-smart-parens-mode)

(define-minor-mode smart-parens-mode
    (:name "smart-parens-mode"
     :keymap *smart-parens-keymap*))

;;; From paredit
(defun integer-char-p (char)
  (< (char-code #\0) (char-code char) (char-code #\9)))

(defun sharp-literal-p (char point)
  (with-point ((p point))
    (character-offset p -1)
    (and (character-at p)
         (char-equal (character-at p) char)
         (eql (character-at p -1) #\#))))

(defun sharp-n-literal-p (char point)
  (with-point ((p point))
    (character-offset p -1)
    (when (char-equal char (character-at p))
      (character-offset p -1)
      (skip-chars-backward p #'integer-char-p)
      (and (integer-char-p (character-at p))
           (eql (character-at p -1) #\#)))))

(defparameter *non-space-following-chars*
  '(#\Space #\( #\' #\` #\, #\[ #\{))

(defparameter *non-space-preceding-chars*
  '(#\Space #\) #\] #\}))

(defun non-space-following-context-p (&optional (p (current-point)))
  (or (start-line-p p)
      (find (character-at p -1)
            *non-space-following-chars*)
      (eql (character-at p -1) #\#)
      (and (eql (character-at p -1) #\@)
           (eql (character-at p -2) #\,))
      (sharp-literal-p #\' p)
      (sharp-literal-p #\. p)
      (sharp-literal-p #\S p)
      (sharp-literal-p #\C p)
      (sharp-literal-p #\+ p)
      (sharp-literal-p #\- p)
      (sharp-n-literal-p #\A p)
      (sharp-n-literal-p #\= p)))

(defun editor-insert-pair (open close)
  (let ((p (current-point)))
    (cond ((in-string-or-comment-p p)
           (insert-character p open))
          ((syntax-escape-point-p p 0)
           (insert-character p open))
          (t
           (unless (non-space-following-context-p p)
             (insert-character p #\Space))
           (insert-character p open)
           (insert-character p close)
           (unless (or (end-line-p p) (find (character-at p) *non-space-preceding-chars*))
             (insert-character p #\Space)
             (character-offset p -1))
           (character-offset p -1)))))

;;; smart parens specific code

(define-command smart-parens-insert-paren () ()
  (editor-insert-pair #\( #\)))

(define-command smart-parens-insert-bracket () ()
  (editor-insert-pair #\[ #\]))

(define-command smart-parens-insert-brace () ()
  (editor-insert-pair #\{ #\}))

(define-command smart-parens-insert-double-quote () ()
  (editor-insert-pair #\" #\"))

(define-command smart-parens-insert-single-quote () ()
  (editor-insert-pair #\' #\'))

(defun close-paren (given-char)
  (when (lem:syntax-open-paren-char-p given-char)
    (apply #'editor-insert-pair (lem:syntax-open-paren-char-p given-char))))

(define-key *smart-parens-keymap* "\"" 'smart-parens-insert-double-quote)
(define-key *smart-parens-keymap* "'" 'smart-parens-insert-single-quote)
(define-key *smart-parens-keymap* "(" 'smart-parens-insert-paren)
(define-key *smart-parens-keymap* "[" 'smart-parens-insert-bracket)
(define-key *smart-parens-keymap* "{" 'smart-parens-insert-brace)