[Openmcl-devel] Handling Ctrl-C

[Devon Sean McCullough]

> On Apr 30, 2018, at 2:40 PM, Ron Garret <ron at flownet.com> wrote:
> You need to put the terminal in raw mode.

Lol, now you have two problems.

> On Apr 30, 2018, at 11:32 AM, Zach Beane <xach at xach.com> wrote:
>> I'd like to run my own code when Clozure CL gets a ctrl-c in a terminal. I've tried handling ccl:interrupt-signal-condition but it still lands in the break loop. Is there anything else I can do?

Maybe patch a catch into level-1/l1-events.lisp: force-break-in-listener
and co-opt some existing hooks, awful but who has time to do it well?

		Peace
			—Devon

P.S. This seems to work but tested once only

$ ccl -n
Welcome to Clozure Common Lisp Version 1.11-r16635  (DarwinX8664)!

CCL is developed and maintained by Clozure Associates. For more information
about CCL visit http://ccl.clozure.com.  To enquire about Clozure's Common Lisp
consulting services e-mail info at clozure.com or visit http://www.clozure.com.

? (in-package #:ccl)

(defmethod force-break-in-listener ((p process))
  (process-interrupt p
		     #'(lambda ()
                         (multiple-value-bind (vars inits old-vals) (%check-error-globals)
                           (progv vars old-vals
                             (mapcar (lambda (v f) (set v (funcall f))) vars inits)
                             (let ((condition (make-condition 'interrupt-signal-condition))
                                   (*top-error-frame* (%current-exception-frame)))
                               (ignoring-without-interrupts
				 (catch 'suppress-break-loop
                                   (when *invoke-debugger-hook-on-interrupt*
                                     (let* ((hook *debugger-hook*)
                                            (*debugger-hook* nil))
                                       (when hook
					 (funcall hook condition hook))))
                                   (%break-in-frame *top-error-frame* condition)
                      #<Package "CCL">
? ear-input *terminal-io*)))))))))

(in-package #:cl-user)

(defun print-foo (&rest args)
  "Princ (print-foo ...), finish-output and suppress the ^C break loop."
  (format t "(print-foo~{ ~S~})"
	  args)
  (finish-output)
  (throw 'ccl::suppress-break-loop nil))

(setq ccl::*inhibit-abort* nil
      ccl::*debugger-hook* 'print-foo
      ccl::*invoke-debugger-hook-on-interrupt* t)#<STANDARD-METHOD FORCE-BREAK-IN-LISTENER (PROCESS)>

? (sleep 9)
^C(print-foo #<INTERRUPT-SIGNAL-CONDITION #x3020004A052D> PRINT-FOO)
^C(print-foo #<INTERRUPT-SIGNAL-CONDITION #x3020004DFE4D> PRINT-FOO)
NIL
?