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