[gtk-cffi-cvs] CVS cl-emacs
CVS User rklochkov
rklochkov at common-lisp.net
Sun May 13 16:20:49 UTC 2012
Update of /project/gtk-cffi/cvsroot/cl-emacs
In directory tiger.common-lisp.net:/tmp/cvs-serv17406
Modified Files:
keymap.lisp main.lisp package.lisp
Log Message:
Minor fixes
--- /project/gtk-cffi/cvsroot/cl-emacs/keymap.lisp 2011/09/15 10:43:25 1.1.1.1
+++ /project/gtk-cffi/cvsroot/cl-emacs/keymap.lisp 2012/05/13 16:20:49 1.2
@@ -3,8 +3,14 @@
(defparameter *entered-sequence* nil)
(defvar *global-keymap* nil)
+(let (keymap)
+ (defun gdk-keymap ()
+ (unless keymap
+ (setf keymap (make-instance 'keymap)))
+ keymap))
+
(defun base-keycode (key)
- (let ((keys (entries-for-keyval (make-instance 'keymap) key)))
+ (let ((keys (entries-for-keyval (gdk-keymap) key)))
(unless keys
(warn "No keycode. Bad key description ~a" key)
(return-from base-keycode nil))
@@ -17,7 +23,7 @@
(defun base-keyval (keycode)
(multiple-value-bind (keys keyvals)
- (entries-for-keycode (make-instance 'keymap) keycode)
+ (entries-for-keycode (gdk-keymap) keycode)
(iter
(for key in-vector keys)
(for keyval in-vector keyvals)
--- /project/gtk-cffi/cvsroot/cl-emacs/main.lisp 2011/09/15 17:21:22 1.2
+++ /project/gtk-cffi/cvsroot/cl-emacs/main.lisp 2012/05/13 16:20:49 1.3
@@ -1,8 +1,6 @@
;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: emacs; -*-
(in-package :emacs)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (gtk-init))
+(declaim (optimize safety debug))
(defvar *file*)
(defvar *region*)
@@ -24,13 +22,14 @@
(setf *entered-sequence* nil)
(setf ret t))
- (let* ((statusbar (object-by-id :status))
- (context-id (context-id statusbar :key-seq)))
- (if *entered-sequence*
- (statusbar-push statusbar context-id
- (keyseq->string *entered-sequence*))
- (statusbar-remove statusbar context-id))
- ret)))
+ (let ((statusbar (object-by-id :status)))
+ (when statusbar
+ (let ((context-id (context-id statusbar :key-seq)))
+ (if *entered-sequence*
+ (statusbar-push statusbar context-id
+ (keyseq->string *entered-sequence*))
+ (statusbar-remove statusbar context-id)))))
+ ret))
(defun trap-error-handler (condition buf)
(with-output-to-string (s buf)
@@ -40,6 +39,7 @@
(defun run-if-paired-parens ()
(let ((text (text (buffer (object-by-id :command))))
(parens 0))
+; (format t "~a~%" text)
(iter
(for c in-string text)
(case c
@@ -47,8 +47,7 @@
(#\) (progn
(incf parens -1)
(when (< parens 0) (return-from run-if-paired-parens nil))))))
- (when (eql parens 0)
-
+ (when (eql parens 0)
(let ((repl (text (buffer (object-by-id :repl))))
(buf (make-array '(0) :element-type 'base-char
:fill-pointer 0 :adjustable t)))
@@ -61,7 +60,9 @@
(with-output-to-string (s buf)
(format s "* ~a~%" condition))
(muffle-warning condition))))
- (format s "~a~%" (eval (read-from-string text))))
+ (let ((res (eval (read-from-string text))))
+ (setf *** ** ** * * res)
+ (format s "~a~%" res)))
(t (var) (trap-error-handler var buf))))
(setf (text (buffer (object-by-id :repl))) buf))
(setf (text (buffer (object-by-id :command))) ""))
@@ -128,48 +129,51 @@
(format nil "Saved ~a @ ~a" *file* *encoding*))))
-(global-set-key "C-x C-f" 'open-file)
-(global-set-key "C-x C-c" (lambda () (destroy (object-by-id :main))))
-(global-set-key "C-x C-s" 'save-file)
(defmacro act (&body body)
`(lambda (&rest rest)
(declare (ignore rest))
, at body))
-(show
- (gtk-model
- 'window :signals '(:destroy :gtk-main-quit
- :key-press-event on-key-press)
- :width 800 :height 600 :title "Editor" :id :main
- ('v-box
- :expand nil
- ('menu-bar
- ('menu-item
- :label "File"
- :submenu
- (gtk-model
- 'menu
- ('menu-item :label "Open"
- :signals `(:activate ,(act (open-file))))
- ('menu-item :label "Save"
- :signals `(:activate ,(act (save-file))))
- ('menu-item :label "Quit"
- :signals `(:activate
- ,(act (destroy (object-by-id :main))))))))
- :expand t
- ('h-paned
- :resize t
- ('scrolled-window
- ('text-view :id :text))
- ('v-paned
- ('scrolled-window :min-content-height 100
- ('text-view :id :command
- :signals '(:key-press-event on-command-key-press)))
- ('scrolled-window
- ('text-view :id :repl))))
- :expand nil
- ('statusbar :id :status))))
-(gtk-main)
+(defun run-emacs ()
+ (gtk-init)
+ (global-set-key "C-x C-f" 'open-file)
+ (global-set-key "C-x C-c" (lambda () (destroy (object-by-id :main))))
+ (global-set-key "C-x C-s" 'save-file)
+ (show
+ (gtk-model
+ 'window :signals '(:destroy :gtk-main-quit
+ :key-press-event on-key-press)
+ :width 800 :height 600 :title "Editor" :id :main
+ ('v-box
+ :expand nil
+ ('menu-bar
+ ('menu-item
+ :label "File"
+ :submenu
+ (gtk-model
+ 'menu
+ ('menu-item :label "Open"
+ :signals `(:activate ,(act (open-file))))
+ ('menu-item :label "Save"
+ :signals `(:activate ,(act (save-file))))
+ ('menu-item :label "Quit"
+ :signals `(:activate
+ ,(act (destroy (object-by-id :main))))))))
+ :expand t
+ ('h-paned
+ :resize t
+ ('scrolled-window
+ ('text-view :id :text))
+ ('v-paned
+ ('scrolled-window
+ :min-content-height 100
+ ('text-view :id :command
+ :signals '(:key-press-event on-command-key-press)))
+ ('scrolled-window
+ ('text-view :id :repl))))
+ :expand nil
+ ('statusbar :id :status))))
+ (gtk-main))
--- /project/gtk-cffi/cvsroot/cl-emacs/package.lisp 2011/09/15 10:43:25 1.1.1.1
+++ /project/gtk-cffi/cvsroot/cl-emacs/package.lisp 2012/05/13 16:20:49 1.2
@@ -1,4 +1,5 @@
;; -*- Mode: LISP; Syntax: COMMON-LISP; -*-
(defpackage :emacs
(:use :cl :gtk-cffi :gdk-cffi :alexandria :iterate)
- (:shadowing-import-from :gtk-cffi #:window #:image))
\ No newline at end of file
+ (:shadowing-import-from :gtk-cffi #:window #:image)
+ (:export #:run-emacs))
More information about the gtk-cffi-cvs
mailing list