tlc window handling improvement, dot(1) usage
* lisp/tla+-mode.el (tla+-tlc-depth): tune depth parameter, default to 1000 now. (tla+-tlc-workers): tune worker threads (at least 2 threads should be used by default) (tla+-dot-convert, tla+-dot-binary): dot(1) customization variables. (tla+-run-dot): elisp function to run dot(1) and convert the state graph to a PNG file (tla+-run-model): automatically generate the PNG output file, change the window handling. It seems better to only show the tlc buffer output once (when it is a newly created buffer). The user may kill it, or arrange it in such a way that the output can be read by another tlc model check run. Also: set the bufffer to readonly. (tlc-widget-example): remove the cfgname; seems that the lambda expressions do not see the cfgname anyway so I have to reconstruct it. * ChangeLog: add a changelog file
This commit is contained in:
Christian Barthel
parent
b84b64612a
commit
6ba78769a5
22
ChangeLog
Normal file
22
ChangeLog
Normal file
@ -0,0 +1,22 @@
|
||||
2020-08-02 Christian Barthel <bch@online.de>
|
||||
|
||||
* lisp/tla+-mode.el (tla+-tlc-depth): tune depth
|
||||
parameter, default to 1000 now.
|
||||
(tla+-tlc-workers): tune worker threads (at least
|
||||
2 threads should be used by default)
|
||||
(tla+-dot-convert, tla+-dot-binary): dot(1)
|
||||
customization variables.
|
||||
(tla+-run-dot): elisp function to run dot(1) and
|
||||
convert the state graph to a PNG file
|
||||
(tla+-run-model): automatically generate the PNG
|
||||
output file, change the window handling. It
|
||||
seems better to only show the tlc buffer output
|
||||
once (when it is a newly created buffer). The
|
||||
user may kill it, or arrange it in such a way
|
||||
that the output can be read by another tlc model
|
||||
check run. Also: set the bufffer to readonly.
|
||||
(tlc-widget-example): remove the cfgname; seems
|
||||
that the lambda expressions do not see the cfgname
|
||||
anyway so I have to reconstruct it.
|
||||
|
||||
|
||||
@ -88,7 +88,7 @@
|
||||
:group 'tla+)
|
||||
|
||||
(defcustom tla+-tlc-depth
|
||||
" -depth 100 "
|
||||
" -depth 1000 "
|
||||
"Tell `TLC' to do max. X steps (default: 100)"
|
||||
:type 'string
|
||||
:group 'tla+)
|
||||
@ -100,7 +100,7 @@
|
||||
:group 'tla+)
|
||||
|
||||
(defcustom tla+-tlc-workers
|
||||
" -workers 1 "
|
||||
" -workers 2 "
|
||||
"Tell `TLC' how many threads to generate."
|
||||
:type 'string
|
||||
:group 'tla+)
|
||||
@ -111,7 +111,15 @@
|
||||
"Assoc list for TLC Options"
|
||||
:type 'string)
|
||||
|
||||
(defcustom tla+-dot-convert
|
||||
"out.png"
|
||||
"If non-nil, convert states.dot to the filename given by the string"
|
||||
:type 'string)
|
||||
|
||||
(defcustom tla+-dot-binary
|
||||
"dot"
|
||||
"path to dot binary"
|
||||
:type 'string)
|
||||
|
||||
|
||||
;; -------------------------------------------------------------------
|
||||
@ -573,6 +581,12 @@ Operation:
|
||||
(tla+/find-error-marks)
|
||||
(other-window 1))))
|
||||
|
||||
(defun tla+-run-dot ()
|
||||
(let ((cmd (format "%s -Tpng states.dot > %s"
|
||||
tla+-dot-binary
|
||||
tla+-dot-convert)))
|
||||
(shell-command-to-string cmd)))
|
||||
|
||||
(defun tla+-run-model (cfgfile)
|
||||
"Run the tlc2.TLC Model checker
|
||||
Run the tlc2.TLC model checker on a TLA+ buffer with a given
|
||||
@ -592,8 +606,11 @@ Note: The TLA+ specification file is a relative path.
|
||||
(file-name-base (buffer-file-name))
|
||||
".cfg" ))))
|
||||
(let* ((filename (buffer-file-name))
|
||||
(tlcbuffer (get-buffer-create
|
||||
(format "*tlc2.TLC* [%s]" (buffer-name))))
|
||||
(tlcbufname (format "*tlc2.TLC* [%s]" (buffer-name)))
|
||||
;(tlcbuffer (get-buffer-create
|
||||
; (format "*tlc2.TLC* [%s]" (buffer-name))))
|
||||
(tlcbuffer (get-buffer tlcbufname))
|
||||
(cubuffer (current-buffer))
|
||||
;; XXX: tlc2.TLC -config /full/path/to/TLA.cfg TLA.tla
|
||||
;; not sure why the tla file itself should not be a
|
||||
;; full path?
|
||||
@ -623,19 +640,27 @@ Note: The TLA+ specification file is a relative path.
|
||||
opt-workers " "
|
||||
" -config " cfgfile " "
|
||||
finame))
|
||||
(output (shell-command-to-string cmd)))
|
||||
(output (shell-command-to-string cmd))
|
||||
(dot (tla+-run-dot)))
|
||||
(save-excursion
|
||||
(split-window-below)
|
||||
(other-window 1)
|
||||
(if tlcbuffer
|
||||
(progn
|
||||
(switch-to-buffer tlcbuffer)
|
||||
(setq buffer-read-only nil)
|
||||
(erase-buffer)
|
||||
(insert output)
|
||||
(tla+/find-error-marks)
|
||||
(setq buffer-read-only 't)
|
||||
(switch-to-buffer cubuffer))
|
||||
(progn
|
||||
(let ((newbuf (get-buffer-create tlcbufname)))
|
||||
(split-window-below)
|
||||
(other-window 1)
|
||||
;(message "marked")
|
||||
(message (concat "cmd: " cmd))
|
||||
)))
|
||||
|
||||
(switch-to-buffer newbuf)
|
||||
(insert output)
|
||||
(tla+/find-error-marks)
|
||||
(setq buffer-read-only 't)
|
||||
(other-window 1)))))))
|
||||
|
||||
|
||||
(defun tla+-run-pluscal ()
|
||||
@ -930,9 +955,8 @@ The procedure works by:
|
||||
(defun tlc-widget-example (filename)
|
||||
"Create the widgets from the Widget manual."
|
||||
(interactive)
|
||||
(let* ((cfgname (replace-regexp-in-string
|
||||
".tla$" ".cfg" filename))
|
||||
(cfgtlc (concat cfgname "tlcopt")))
|
||||
(let ((cfgname (replace-regexp-in-string
|
||||
".tla$" ".cfg" filename)))
|
||||
(switch-to-buffer (format "*TLC Configuration* [%s]"
|
||||
cfgname))
|
||||
(kill-all-local-variables)
|
||||
@ -1025,6 +1049,10 @@ The procedure works by:
|
||||
(widget-create 'checkbox
|
||||
:notify
|
||||
(lambda (&rest ignore)
|
||||
(let ((cfgtlc
|
||||
(replace-regexp-in-string ".*\\[\\(.*\\)\\].*"
|
||||
"\\1tlcopt"
|
||||
(buffer-name))))
|
||||
(tla+/read-options cfgtlc)
|
||||
(let ((value
|
||||
(cdr
|
||||
@ -1039,7 +1067,7 @@ The procedure works by:
|
||||
cfgtlc
|
||||
'tla+-tlc-deadlock
|
||||
" ")
|
||||
)))
|
||||
))))
|
||||
nil
|
||||
)
|
||||
|
||||
@ -1047,6 +1075,10 @@ The procedure works by:
|
||||
(widget-create 'checkbox
|
||||
:notify
|
||||
(lambda (&rest ignore)
|
||||
(let ((cfgtlc
|
||||
(replace-regexp-in-string ".*\\[\\(.*\\)\\].*"
|
||||
"\\1"
|
||||
(buffer-name))))
|
||||
(tla+/read-options cfgtlc)
|
||||
(let ((value
|
||||
(cdr
|
||||
@ -1061,7 +1093,7 @@ The procedure works by:
|
||||
cfgtlc
|
||||
'tla+-tlc-simulate
|
||||
" ")
|
||||
)))
|
||||
))))
|
||||
nil)
|
||||
|
||||
|
||||
@ -1072,10 +1104,14 @@ The procedure works by:
|
||||
:help-echo "Choose -depth"
|
||||
:notify
|
||||
(lambda (widget &rest ignore)
|
||||
(let ((cfgtlc
|
||||
(replace-regexp-in-string ".*\\[\\(.*\\)\\].*"
|
||||
"\\1"
|
||||
(buffer-name))))
|
||||
(tla+/add-option cfgtlc
|
||||
'tla+-tlc-depth
|
||||
(format " -depth %s "
|
||||
(widget-value widget))))
|
||||
(widget-value widget)))))
|
||||
'(item :tag "100" :value "100")
|
||||
'(choice-item "250" )
|
||||
'(choice-item "300" )
|
||||
@ -1090,10 +1126,14 @@ The procedure works by:
|
||||
:help-echo "Choose -workers"
|
||||
:notify
|
||||
(lambda (widget &rest ignore)
|
||||
(let ((cfgtlc
|
||||
(replace-regexp-in-string ".*\\[\\(.*\\)\\].*"
|
||||
"\\1"
|
||||
(buffer-name))))
|
||||
(tla+/add-option cfgtlc
|
||||
'tla+-tlc-workers
|
||||
(format " -workers %s "
|
||||
(widget-value widget))))
|
||||
(widget-value widget)))))
|
||||
'(item :tag "1" :value "1")
|
||||
'(choice-item "2" )
|
||||
'(choice-item "4" )
|
||||
|
||||
Loading…
Reference in New Issue
Block a user