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

Last change on this file since 773 was 773, checked in by gb, 15 years ago

Key events are interned, so don't make them mutable.

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