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