haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

refactor utop-set-state, utop-cannot-edit, utop-process-line 

Make them all use pcase and and gets rid of some duplicate code in the process
This commit is contained in:
Rudi Grinberg 2017-08-15 12:56:11 -04:00
parent e838896e53
commit afca031099
1 changed files with 127 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
src/top/utop.el
View File

@ -358,34 +358,25 @@ it is started."
"Change the utop state and mode-line-process."
(setq utop-state state)
(setq mode-line-process
(cond
((eq state 'edit)
": idle")
((eq state 'comp)
": completion")
((eq state 'hist)
": history")
((eq state 'wait)
": running")
((eq state 'copy)
": copying")
((eq state 'done)
(let ((status (process-status utop-process)) (code (process-exit-status utop-process)))
(pcase state
('edit ": idle")
('comp ": completion")
('hist ": history")
('wait ": running")
('copy ": copying")
('done
(let ((status (process-status utop-process))
(code (process-exit-status utop-process)))
(cond
((and (eq status 'exit) (= code 0))
": exited[0]")
((eq status 'exit)
(let ((msg (concat ": exited[" (int-to-string code) "]")))
((or (eq status 'exit) (eq status 'signal))
(let* ((status-name (pcase status ('exit "exited") ('signal "killed")))
(msg (concat ": " status-name "[" (int-to-string code) "]")))
(add-text-properties 0 (length msg) '(face bold) msg)
msg))
((eq status 'signal)
(let ((msg (concat ": killed[" (int-to-string code) "]")))
(add-text-properties 0 (length msg) '(face bold) msg)
msg))
(t
": unknown"))))
(t
": unknown"))))
(else ": unknown"))))
(_ ": unknown"))))
(defun utop-send-data (cmd)
"Send current input to utop"
@ -450,17 +441,14 @@ it is started."
;; +-----------------------------------------------------------------+
(defun utop-cannot-edit ()
(cond
((eq utop-state 'wait)
(signal 'text-read-only '("You cannot edit the buffer while ocaml is evaluating a phrase")))
((eq utop-state 'done)
(signal 'text-read-only '("You cannot edit the buffer when ocaml is not running")))
((eq utop-state 'comp)
(signal 'text-read-only '("You cannot edit the buffer while waiting for completion")))
((eq utop-state 'copy)
(signal 'text-read-only '("You cannot edit the buffer while waiting for copy of last input")))
((eq utop-state 'hist)
(signal 'text-read-only '("You cannot edit the buffer while waiting for history")))))
(signal
'text-read-only
(pcase utop-state
('wait "You cannot edit the buffer while ocaml is evaluating a phrase")
('done "You cannot edit the buffer when ocaml is not running")
('comp "You cannot edit the buffer while waiting for completion")
('copy "You cannot edit the buffer while waiting for copy of last input")
('hist "You cannot edit the buffer while waiting for history"))))
(defun utop-before-change (start stop)
(unless utop-inhibit-check
@ -587,18 +575,18 @@ it is started."
;; Extract the command and its argument
(string-match "\\`\\([a-z-]*\\):\\(.*\\)\\'" line)
(let ((command (match-string 1 line)) (argument (match-string 2 line)))
(cond
(pcase command
;; Output on stdout
((string= command "stdout")
("stdout"
(utop-insert-output argument 'utop-stdout))
;; Output on stderr
((string= command "stderr")
("stderr"
(utop-insert-output argument 'utop-stderr))
;; Synchronisation of the phrase terminator
((string= command "phrase-terminator")
("phrase-terminator"
(setq utop-phrase-terminator argument))
;; A new prompt
((string= command "prompt")
("prompt"
(let ((prompt (apply utop-prompt ())))
;; Insert the new prompt
(utop-insert-prompt prompt)
@ -612,7 +600,7 @@ it is started."
(utop-eval-input nil t nil utop-initial-mode)
(setq utop-initial-mode nil))))
;; Input has been accepted
((string= command "accept")
("accept"
;; Add a newline character at the end of the buffer
(goto-char (point-max))
(insert "\n")
@ -633,7 +621,7 @@ it is started."
(setq utop-prompt-min (point-max))
(setq utop-prompt-max (point-max)))
;; Continue editiong
((string= command "continue")
("continue"
;; Add a newline character at the position where the user
;; pressed enter
(when utop-pending-position
@ -642,14 +630,14 @@ it is started."
;; Reset the state
(utop-set-state 'edit))
;; Part of a history entry
((string= command "history-data")
("history-data"
(cond
(utop-pending-entry
(setq utop-pending-entry (concat utop-pending-entry "\n" argument)))
(t
(setq utop-pending-entry argument))))
;; End of history data
((string= command "history-end")
("history-end"
(progn
(cond
((eq utop-state 'copy)
@ -663,23 +651,23 @@ it is started."
;; Resume edition
(utop-set-state 'edit)))
;; We are at a bound of history
((string= command "history-bound")
("history-bound"
;; Just resume edition
(utop-set-state 'edit))
;; Complete with a word
((string= command "completion-word")
("completion-word"
(utop-set-state 'edit)
(with-current-buffer utop-complete-buffer (insert argument))
;; Hide completion
(minibuffer-hide-completions))
;; Start of completion
((string= command "completion-start")
("completion-start"
(setq utop-completion nil))
;; A new possible completion
((string= command "completion")
("completion"
(push argument utop-completion))
;; End of completion
((string= command "completion-stop")
("completion-stop"
(utop-set-state 'edit)
(if (> (length utop-completion) 1)
(with-current-buffer utop-complete-buffer