source: trunk/ccl/hemlock/src/cocoa-hemlock.lisp @ 760

Last change on this file since 760 was 760, checked in by gb, 16 years ago

Handle control-g (abort-event) in GET-KEY-EVENT.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.8 KB
Line 
1;;; -*- Mode: Lisp; Package: Hemlock-Internals -*-
2;;;
3;;; **********************************************************************
4;;; Hemlock was written as part of the CMU Common Lisp project at
5;;; Carnegie Mellon University, and has been placed in the public domain.
6
7(in-package :hemlock-internals)
8
9(defstruct (frame-event-queue (:include ccl::locked-dll-header))
10  (signal (ccl::make-semaphore)))
11
12(defstruct (buffer-operation (:include ccl::dll-node))
13  (thunk nil))
14
15
16(defun enqueue-key-event (q event)
17  (ccl::locked-dll-header-enqueue event q)
18  (ccl::signal-semaphore (frame-event-queue-signal q)))
19
20(defun dequeue-key-event (q)
21  (unless (listen-editor-input q)
22    (let* ((document (buffer-document (current-buffer))))
23      (when document
24        (document-set-point-position document))))
25  (ccl::wait-on-semaphore (frame-event-queue-signal q))
26  (ccl::locked-dll-header-dequeue q))
27
28
29(defun unget-key-event (event q)
30  (ccl::with-locked-dll-header (q)
31    (ccl::insert-dll-node-after event q))
32  (ccl::signal-semaphore (frame-event-queue-signal q)))
33
34(defun timed-wait-for-key-event (q seconds)
35  (let* ((signal (frame-event-queue-signal q)))
36    (when (ccl:timed-wait-on-semaphore signal seconds)
37      (ccl:signal-semaphore signal)
38      t)))
39
40
41
42 
43
44(defun buffer-windows (buffer)
45  (let* ((doc (buffer-document buffer)))
46    (when doc
47      (document-panes doc))))
48
49(defvar *current-window* ())
50
51(defvar *window-list* ())
52(defun current-window ()
53  "Return the current window.  The current window is specially treated by
54  redisplay in several ways, the most important of which is that is does
55  recentering, ensuring that the Buffer-Point of the current window's
56  Window-Buffer is always displayed.  This may be set with Setf."
57  *current-window*)
58
59(defun %set-current-window (new-window)
60  #+not-yet
61  (invoke-hook hemlock::set-window-hook new-window)
62  (activate-hemlock-view new-window)
63  (setq *current-window* new-window))
64
65;;; This is a public variable.
66;;;
67(defvar *last-key-event-typed* ()
68  "This variable contains the last key-event typed by the user and read as
69   input.")
70
71(defvar *input-transcript* ())
72
73(defparameter editor-abort-key-events (list #k"Control-g" #k"Control-G"))
74
75(defmacro abort-key-event-p (key-event)
76  `(member ,key-event editor-abort-key-events))
77
78
79(defun get-key-event (q &optional ignore-pending-aborts)
80  (do* ((e (dequeue-key-event q) (dequeue-key-event q)))
81       ((typep e 'hemlock-ext:key-event)
82        (unless ignore-pending-aborts
83          (when (abort-key-event-p e)
84            (beep)
85            (throw 'editor-top-level-catcher nil)))
86        (setq *last-key-event-typed* e))
87    (if (typep e 'buffer-operation)
88      (funcall (buffer-operation-thunk e)))))
89
90(defun listen-editor-input (q)
91  (ccl::with-locked-dll-header (q)
92    (not (eq (ccl::dll-header-first q) q))))
Note: See TracBrowser for help on using the repository browser.