4 #+cmu
(setf extensions
:*gc-notify-after
* (lambda (&rest r
))
5 extensions
:*gc-notify-before
* (lambda (&rest r
)))
8 "Run the lice environment."
11 (dformat +debug-v
+ "-- Start lice~%")
12 #+(or cmu sbcl
) (init-tty)
14 (setf *buffer-list
* nil
)
15 #+movitz
(init-commands)
16 (make-default-buffers)
17 (init-command-arg-types)
18 (setf *frame-list
* (list #+(or cmu sbcl
) (make-default-tty-frame (get-buffer "*scratch*"))
19 #+clisp
(make-default-clisp-frame (get-buffer "*scratch*"))
20 #+mcl
(make-default-mcl-frame (get-buffer "*scratch*"))
21 #+movitz
(make-default-movitz-frame (get-buffer "*scratch*")))
22 *current-frame
* (car *frame-list
*))
23 ;; for the scratch buffer
24 (set-buffer (get-buffer "*scratch*"))
25 (set-major-mode lisp-interaction-mode
)
31 (with-simple-restart (recursive-edit-top-level "Return to LiCE top level")
35 (with-simple-restart (recursive-edit-top-level "Return to LiCE top level")
38 #+(or cmu sbcl
) (shutdown-tty)
40 (dformat +debug-v
+ "-- End lice~%"))))
43 (defun init-commands ()
44 "Our special wikked hack."
45 (macrolet ((create-cmd (name &rest args
)
47 `(setf (gethash ',name
*commands
*)
51 :args
',(delete nil
(mapcar (lambda (a)
52 (when (listp a
) (second a
)))
56 (let ((,tmp
(list ,@(delete nil
(mapcar (lambda (a)
58 `(funcall (gethash ,(second a
) *command-arg-type-hash
*) ,@(cddr a
))))
60 ;; XXX: Is this a sick hack? We need to reset the
61 ;; prefix-arg at the right time. After the command
62 ;; is executed we can't because the universal
63 ;; argument code sets the prefix-arg for the next
64 ;; command. The Right spot seems to be to reset it
65 ;; once a command is about to be executed, and
66 ;; after the prefix arg has been gathered to be
67 ;; used in the command. Which is right here.
68 (setf *prefix-arg
* nil
)
69 ;; Note that we use the actual function. If the
70 ;; function is redefined, the command will
71 ;; continue to be defined and will call the
72 ;; function declared above, not the redefined one.
73 (apply #',name
,tmp
))))))))
74 (setf fundamental-mode
75 (make-instance 'major-mode
77 :map
(make-hash-table)
80 (make-instance 'major-mode
81 :name
"minibuffer mode"
82 :map
(let ((m (make-sparse-keymap)))
83 (define-key m
(make-instance 'key
:char
#\m
:control t
) 'exit-minibuffer
)
84 (define-key m
(make-instance 'key
:char
#\Newline
) 'exit-minibuffer
)
85 (define-key m
(make-instance 'key
:char
#\j
:control t
) 'exit-minibuffer
)
86 (define-key m
(make-instance 'key
:char
#\p
:meta t
) 'previous-history-element
)
87 (define-key m
(make-instance 'key
:char
#\n :meta t
) 'next-history-element
)
88 (define-key m
(make-instance 'key
:char
#\g
:control t
) 'abort-recursive-edit
)
91 minibuffer-complete-mode
92 (make-instance 'major-mode
93 :name
"minibuffer complete mode"
94 :map
(let ((m (make-sparse-keymap)))
95 (define-key m
(make-instance 'key
:char
#\m
:control t
) 'minibuffer-complete-and-exit
)
96 (define-key m
(make-instance 'key
:char
#\Newline
) 'minibuffer-complete-and-exit
)
97 (define-key m
(make-instance 'key
:char
#\j
:control t
) 'minibuffer-complete-and-exit
)
98 (define-key m
(make-instance 'key
:char
#\p
:meta t
) 'previous-history-element
)
99 (define-key m
(make-instance 'key
:char
#\n :meta t
) 'next-history-element
)
100 (define-key m
(make-instance 'key
:char
#\i
:control t
) 'minibuffer-complete
)
101 (define-key m
(make-instance 'key
:char
#\Tab
) 'minibuffer-complete
)
102 (define-key m
(make-instance 'key
:char
#\g
:control t
) 'abort-recursive-edit
)
104 :init-fn
(lambda ()))
105 lisp-interaction-mode
106 (make-instance 'major-mode
:name
"Lisp Interaction"
107 :map
(let ((m (make-sparse-keymap)))
108 (define-key m
(make-instance 'key
:char
#\j
:control t
) 'eval-print-last-sexp
)
110 :init-fn
(lambda ()))
111 *universal-argument-map
*
112 (let ((map (make-sparse-keymap)))
113 (define-key map t
'universal-argument-other-key
)
114 (define-key map
(kbd "C-u") 'universal-argument-more
)
115 (define-key map
(kbd "-") 'universal-argument-minus
)
116 (define-key map
(kbd "0") 'digit-argument
)
117 (define-key map
(kbd "1") 'digit-argument
)
118 (define-key map
(kbd "2") 'digit-argument
)
119 (define-key map
(kbd "3") 'digit-argument
)
120 (define-key map
(kbd "4") 'digit-argument
)
121 (define-key map
(kbd "5") 'digit-argument
)
122 (define-key map
(kbd "6") 'digit-argument
)
123 (define-key map
(kbd "7") 'digit-argument
)
124 (define-key map
(kbd "8") 'digit-argument
)
125 (define-key map
(kbd "9") 'digit-argument
)
127 (setf *mode-line-format
* (list "--:" ;; fake it for hype
130 ;; FIXME: add read-only stuff
131 (if (buffer-modified buffer
)
133 (if (buffer-modified buffer
)
137 (format nil
"~12,,,a" (buffer-name buffer
)))
141 (major-mode-name (buffer-major-mode buffer
))))))
142 (setf *commands
* (make-hash-table :size
100))
143 (create-cmd forward-sexp
)
144 (create-cmd backward-sexp
)
145 (create-cmd eval-last-sexp
)
146 (create-cmd eval-print-last-sexp
)
147 (create-cmd lisp-interaction-mode
)
148 (create-cmd ask-user
)
149 (create-cmd exit-minibuffer
)
150 (create-cmd abort-recursive-edit
)
151 (create-cmd minibuffer-complete-and-exit
)
152 (create-cmd next-history-element
(n :prefix
))
153 (create-cmd previous-history-element
)
154 (create-cmd minibuffer-complete
)
155 (create-cmd forward-char
(n :prefix
))
156 (create-cmd backward-char
(n :prefix
))
157 (create-cmd self-insert-command
(arg :prefix
))
159 (create-cmd next-line
(n :prefix
))
160 (create-cmd previous-line
(n :prefix
))
161 (create-cmd delete-backward-char
)
162 (create-cmd delete-char
)
163 (create-cmd beginning-of-line
)
164 (create-cmd end-of-line
)
165 (create-cmd erase-buffer
)
166 (create-cmd execute-extended-command
(n :prefix
))
167 (create-cmd switch-to-buffer
(buffer :buffer
"Switch To Buffer: " (buffer-name (other-buffer (current-buffer)))))
168 (create-cmd save-buffers-kill-emacs
())
169 (create-cmd kill-buffer
(buffer :buffer
"Kill buffer: " (buffer-name (current-buffer)) t
))
170 (create-cmd eval-expression
(s :string
"Eval: "))
171 (create-cmd exchange-point-and-mark
)
172 (create-cmd set-mark-command
)
173 (create-cmd scroll-up
)
174 (create-cmd scroll-down
)
175 (create-cmd end-of-buffer
)
176 (create-cmd beginning-of-buffer
)
177 (create-cmd split-window-vertically
)
178 (create-cmd split-window-horizontally
)
179 (create-cmd other-window
)
180 (create-cmd switch-to-buffer-other-window
(buffer :buffer
"Switch to buffer in other window: " (buffer-name (other-buffer (current-buffer)))))
181 (create-cmd delete-other-windows
)
182 (create-cmd keyboard-quit
)
183 (create-cmd kill-ring-save
)
184 (create-cmd kill-region
(beg :region-beginning
) (end :region-end
))
185 (create-cmd kill-line
)
187 (create-cmd yank-pop
)
188 (create-cmd universal-argument
)
189 (create-cmd universal-argument-more
(arg :raw-prefix
))
190 (create-cmd negative-argument
(arg :raw-prefix
))
191 (create-cmd digit-argument
(arg :raw-prefix
))
192 (create-cmd universal-argument-minus
(arg :raw-prefix
))
193 (create-cmd universal-argument-other-key
(arg :raw-prefix
))))
197 (asdf:oos
'asdf
:load-op
:lice
))
201 ;;(muerte.init::lice-genesis)
206 ;; ;; do stuff and then
208 ;; (setf a <a struct>)))
210 ;; ;; do stuff and then call..
215 (provide :lice-0.1
/main
)