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