-
Notifications
You must be signed in to change notification settings - Fork 2
/
php-scratch.el
176 lines (149 loc) · 6.39 KB
/
php-scratch.el
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
;;; php-scratch.el --- A scratch buffer to interactively evaluate php code -*- lexical-binding: t -*-
;; Copyright © 2016 Tijs Mallaerts
;;
;; Author: Tijs Mallaerts <tijs.mallaerts@gmail.com>
;; Package-Requires: ((emacs "24.3") (s "1.11.0") (php-mode "1.17.0"))
;; Homepage: https://github.com/mallt/php-scratch
;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; A scratch buffer to interactively evaluate php code.
;; C-c C-e will evaluate the active region or current line.
;; C-c C-c will clear the state of the php scratch repl process.
;;; Code:
(require 'php-mode)
(require 's)
(require 'comint)
(defgroup php-scratch nil
"Php scratch buffer customizations."
:group 'processes)
(defcustom php-scratch-boris-command "boris"
"Path to the boris repl command."
:type 'string
:group 'php-scratch)
(defcustom php-scratch-use-overlays nil
"Controls whether overlays should be used to show results."
:type 'boolean
:group 'php-scratch)
(defun php-scratch--font-lock-string (string)
"Apply php font lock to STRING."
(with-temp-buffer
(php-mode)
(erase-buffer)
(insert string)
(font-lock-fontify-region (point-min) (point-max))
(buffer-string)))
(defun php-scratch--startup-process-filter (proc str)
"The filter for the startup of the php scratch repl PROC.
STR is the output string of the startup PROC."
(set-process-filter proc 'php-scratch--process-filter))
(defun php-scratch--show-result (str)
"Show the result STR."
(if php-scratch-use-overlays
(momentary-string-display (concat " => " str)
(if (region-active-p)
(region-end)
(line-end-position))
nil "")
(message "%s" str)))
(defun php-scratch--process-filter (proc str)
"The filter for the php scratch repl PROC.
STR is the output string of the PROC."
;; input command is returned by default, do not show this in minibuffer
(when (not (string= (replace-regexp-in-string "\r+$" "" str)
(process-get proc 'input-command)))
(let* ((split-str (split-string str "→"))
(output-str (if (or (string-match-p "error" str)
(equal 1 (length split-str)))
str
(nth 1 split-str)))
(res (mapconcat 'identity
(butlast (split-string output-str "\r"))
""))
(res2 (if (string= "" res)
(mapconcat 'identity
(butlast (split-string output-str "\n"))
"")
res))
(replace-arrow (replace-regexp-in-string "→" "" res2))
(trim (s-trim replace-arrow))
(font-lock (php-scratch--font-lock-string trim)))
(php-scratch--show-result font-lock))))
(defun php-scratch--process-sentinel (proc e)
"The sentinel of the php scratch repl PROC.
The sentinel is used to handle the clear state action. When the
value of E is killed, the php scratch buffer will be killed and
the php scratch repl process will be restarted."
(when (string= "killed\n" e)
(kill-buffer "*php-scratch-repl*")
(php-scratch--start-repl-process)))
(defun php-scratch--start-repl-process ()
"Start the php repl process."
(when (not (get-process "php-scratch-repl"))
(make-comint "php-scratch-repl" php-scratch-boris-command)
(let ((proc (get-process "php-scratch-repl")))
(set-process-query-on-exit-flag proc nil)
(set-process-filter proc 'php-scratch--startup-process-filter)
(process-send-string proc
"$this->setInspector(new \\Boris\\ExportInspector());\n"))))
(defun php-scratch-clear-state ()
"Clear the state of the php scratch repl process.
The repl process will be restarted in the background."
(interactive)
(let ((proc (get-process "php-scratch-repl")))
(set-process-sentinel proc 'php-scratch--process-sentinel)
(delete-process proc)))
(defun php-scratch-eval ()
"Evaluate the active region or current line."
(interactive)
(let* ((proc (get-process "php-scratch-repl"))
(reg-beg (if (region-active-p)
(region-beginning)
(line-beginning-position)))
(reg-end (if (region-active-p)
(region-end)
(line-end-position)))
(region (buffer-substring-no-properties reg-beg reg-end))
(command (concat (s-trim region) ";\n")))
(process-put proc 'input-command command)
(process-send-string proc command)))
(defun php-scratch-minibuffer-eval ()
"Read the php code in the minibuffer and evaluate it."
(interactive)
(let ((code (read-from-minibuffer "PHP eval: ")))
(with-temp-buffer
(insert code)
(set-mark (point-min))
(goto-char (point-max))
(exchange-point-and-mark)
(php-scratch-eval))))
(define-derived-mode php-scratch-mode
php-mode "php-scratch"
"Major mode for the php scratch buffer.")
(define-key php-scratch-mode-map (kbd "C-c C-e") 'php-scratch-eval)
(define-key php-scratch-mode-map (kbd "C-c C-c") 'php-scratch-clear-state)
(define-key php-scratch-mode-map (kbd "C-c M-:") 'php-scratch-minibuffer-eval)
;;;###autoload
(defun php-scratch ()
"Open the php scratch buffer and start the php scratch repl process."
(interactive)
(if (get-buffer "*php-scratch*")
(switch-to-buffer "*php-scratch*")
(when (not php-scratch-boris-command)
(user-error "%s" "Error: the variable php-scratch-boris-command is not set."))
(php-scratch--start-repl-process)
(get-buffer-create "*php-scratch*")
(switch-to-buffer "*php-scratch*")
(php-scratch-mode)
(insert "/* php scratch buffer */\n")))
(provide 'php-scratch)
;;; php-scratch.el ends here