Commit 518fa386 authored by David O'Toole's avatar David O'Toole

tidy up

parent b4532d7c
diff -c /home/dto/quicklisp.2017-03-21/dists/quicklisp/software/lispbuilder-20160825-git/lispbuilder-sdl/sdl/video.lisp /home/dto/Desktop/video.lisp
*** /home/dto/quicklisp.2017-03-21/dists/quicklisp/software/lispbuilder-20160825-git/lispbuilder-sdl/sdl/video.lisp 2017-03-20 19:37:52.662250152 -0400
--- /home/dto/Desktop/video.lisp 2017-03-29 18:56:40.477534378 -0400
***************
*** 284,292 ****
(cond
((cffi:null-pointer-p listmodes) nil)
((equal (cffi:pointer-address listmodes)
! (load-time-value (cffi:pointer-address
! (cffi:inc-pointer
! (cffi:make-pointer 0) -1))))
t)
(t
(do ((i 0 (1+ i)))
--- 284,291 ----
(cond
((cffi:null-pointer-p listmodes) nil)
((equal (cffi:pointer-address listmodes)
! (load-time-value (ldb (byte (* 8
! (cffi:foreign-type-size :pointer)) 0) -1)))
t)
(t
(do ((i 0 (1+ i)))
Diff finished. Wed Mar 29 18:57:10 2017
......@@ -171,19 +171,19 @@
(center dialog))
(defmethod rename-buffer-dialog ((self system))
(show-dialog (make-instance 'rename-buffer*)))
(show-dialog (make-instance 'rename-buffer-dialog)))
(defmethod visit-buffer-dialog ((self system))
(show-dialog (make-instance 'visit-buffer)))
(show-dialog (make-instance 'visit-buffer-dialog)))
(defmethod resize-buffer-dialog ((self system))
(show-dialog (make-instance 'resize-buffer)))
(show-dialog (make-instance 'resize-buffer-dialog)))
(defmethod create-buffer-dialog ((self system))
(show-dialog (make-instance 'create-buffer)))
(show-dialog (make-instance 'create-buffer-dialog)))
(defmethod paste-as-new-buffer-dialog ((self system))
(show-dialog (make-instance 'paste-as-new-buffer)))
(show-dialog (make-instance 'paste-as-new-buffer-dialog)))
(defmethod edit-cut ((self system))
(cut (current-buffer)))
......@@ -242,25 +242,25 @@
;; TODO destroy textures
(exit-xelf))
(define-command rename-buffer*
(define-dialog rename-buffer-dialog
((new-name (slot-value (current-buffer) 'buffer-name)))
(rename (current-buffer) new-name))
(define-command resize-buffer
(define-dialog resize-buffer-dialog
((width (slot-value (current-buffer) 'width))
(height (slot-value (current-buffer) 'height)))
(resize (current-buffer) width height))
(define-command visit-buffer
(define-dialog visit-buffer-dialog
((buffer-name (or (first *buffer-history*)
(buffer-name (current-buffer)))))
(switch-to-buffer buffer-name))
(define-command create-buffer
(define-dialog create-buffer-dialog
((buffer-name (uniquify-buffer-name "*untitled-buffer*")))
(switch-to-buffer (make-instance 'buffer :name buffer-name)))
(define-command paste-as-new-buffer
(define-dialog paste-as-new-buffer-dialog
((buffer-name (uniquify-buffer-name "*pasted-buffer*")))
(switch-to-buffer (make-instance 'buffer :name buffer-name))
(paste (current-buffer))
......
......@@ -895,8 +895,9 @@ See sidebar for more commands to try.
(defun clear-terminal () (setf *terminal-lines* nil))
(defun last-terminal-line () (first *terminal-lines*))
(defun add-terminal-line (string)
(when (and string (not (string= string (last-terminal-line))))
(defun add-terminal-line (string)
(setf string (coerce string 'simple-string))
(when (and string (not (string= string (coerce (last-terminal-line) 'simple-string))))
(push string *terminal-lines*)))
(defun format-terminal (format-string &rest args)
......@@ -1464,9 +1465,11 @@ See sidebar for more commands to try.
(let* ((class (class-of node))
(new-node (allocate-instance class)))
(flet ((slot-definition-name (slot)
#+ecl (clos::slot-definition-name slot)
#+ccl (ccl:slot-definition-name slot)
#+sbcl (sb-mop:slot-definition-name slot))
(class-slots (class)
#+ecl (clos::class-slots class)
#+ccl (ccl:class-slots class)
#+sbcl (sb-mop:class-slots class)))
(let ((slots (mapcar #'slot-definition-name (class-slots class))))
......
......@@ -977,8 +977,9 @@ above.
(defun clear-terminal () (setf *terminal-lines* nil))
(defun last-terminal-line () (first *terminal-lines*))
(defun add-terminal-line (string)
(when (and string (not (string= string (last-terminal-line))))
(defun add-terminal-line (string)
(setf string (coerce string 'simple-string))
(when (and string (not (string= string (coerce (last-terminal-line) 'simple-string))))
(push string *terminal-lines*)))
(defun format-terminal (format-string &rest args)
......@@ -1561,9 +1562,11 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(let* ((class (class-of node))
(new-node (allocate-instance class)))
(flet ((slot-definition-name (slot)
#+ecl (clos::slot-definition-name slot)
#+ccl (ccl:slot-definition-name slot)
#+sbcl (sb-mop:slot-definition-name slot))
(class-slots (class)
#+ecl (clos::class-slots class)
#+ccl (ccl:class-slots class)
#+sbcl (sb-mop:class-slots class)))
(let ((slots (mapcar #'slot-definition-name (class-slots class))))
......@@ -2875,7 +2878,6 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(when (and (< left x right)
(< top y bottom))
(draw-highlight self)))))))
#+end_src
* Command shell (shell.lisp)
......@@ -3032,7 +3034,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
** Interactive command forms
#+begin_src lisp :tangle shell.lisp
(defmacro define-command (name arglist &body body)
(defmacro define-dialog (name arglist &body body)
(labels ((arglist-input-forms (argument-forms)
(mapcar #'(lambda (f)
`(make-sentence
......@@ -3301,19 +3303,19 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(center dialog))
(defmethod rename-buffer-dialog ((self system))
(show-dialog (make-instance 'rename-buffer*)))
(show-dialog (make-instance 'rename-buffer-dialog)))
(defmethod visit-buffer-dialog ((self system))
(show-dialog (make-instance 'visit-buffer)))
(show-dialog (make-instance 'visit-buffer-dialog)))
(defmethod resize-buffer-dialog ((self system))
(show-dialog (make-instance 'resize-buffer)))
(show-dialog (make-instance 'resize-buffer-dialog)))
(defmethod create-buffer-dialog ((self system))
(show-dialog (make-instance 'create-buffer)))
(show-dialog (make-instance 'create-buffer-dialog)))
(defmethod paste-as-new-buffer-dialog ((self system))
(show-dialog (make-instance 'paste-as-new-buffer)))
(show-dialog (make-instance 'paste-as-new-buffer-dialog)))
(defmethod edit-cut ((self system))
(cut (current-buffer)))
......@@ -3376,25 +3378,25 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
** User Commands
#+begin_src lisp :tangle commands.lisp
(define-command rename-buffer*
(define-dialog rename-buffer-dialog
((new-name (slot-value (current-buffer) 'buffer-name)))
(rename (current-buffer) new-name))
(define-command resize-buffer
(define-dialog resize-buffer-dialog
((width (slot-value (current-buffer) 'width))
(height (slot-value (current-buffer) 'height)))
(resize (current-buffer) width height))
(define-command visit-buffer
(define-dialog visit-buffer-dialog
((buffer-name (or (first *buffer-history*)
(buffer-name (current-buffer)))))
(switch-to-buffer buffer-name))
(define-command create-buffer
(define-dialog create-buffer-dialog
((buffer-name (uniquify-buffer-name "*untitled-buffer*")))
(switch-to-buffer (make-instance 'buffer :name buffer-name)))
(define-command paste-as-new-buffer
(define-dialog paste-as-new-buffer-dialog
((buffer-name (uniquify-buffer-name "*pasted-buffer*")))
(switch-to-buffer (make-instance 'buffer :name buffer-name))
(paste (current-buffer))
......
......@@ -313,7 +313,8 @@ current-time
cut
default-events
default-project-directories
define
define-node-macro
define-dialog
define-buffer
define-resource
defproject
......
......@@ -133,7 +133,7 @@
;; (bind-event self '(:g :control) 'close-shell)
;; (bind-event self '(:escape) 'close-shell))
(defmacro define-command (name arglist &body body)
(defmacro define-dialog (name arglist &body body)
(labels ((arglist-input-forms (argument-forms)
(mapcar #'(lambda (f)
`(make-sentence
......
* Task list
** TODO [#A] fix command dialogs
** TODO [#A] fix data entry widget validation
** TODO [#A] create buffer switch menu
** TODO [#A] context-menus
** TODO [#A] fix command dialogs
** TODO [#A] fix can't drag item out of shell
** TODO [#A] command undo/redo
** TODO [#B] context-menus
** TODO [#A] fix disappearing shell prompt when click
** TODO [#B] fix can't drag item out of shell
** TODO [#B] command undo/redo
** TODO [#A] scrolling the buffer window
** TODO [#B] fix disappearing shell prompt
** TODO [#B] hand me a tile / reference
** TODO [#B] save-buffer
** TODO [#B] load-buffer
......@@ -25,7 +25,7 @@
** TODO [#B] (paste (get-selection (find-buffer "palette")))
** TODO [#B] recover sidebar
** TODO [#B] test multiline text edit
** TODO [#B] fix any move handle should move group
** TODO [#A] fix any move handle should move group
** TODO [#B] choose and export more accessor names for buffer/node slots
** TODO [#B] Document how to clear all caches
** TODO [#B] should block widgets be marked as :collision-type nil?
......
......@@ -25,7 +25,7 @@
;; start the buffer running
(switch-to-buffer plong)
(at-next-update
(add-node (current-buffer) (make-instance 'xelf::resize-buffer) 200 200)
(add-node (current-buffer) (make-instance 'xelf::resize-buffer-dialog) 200 200)
(add-node (current-buffer)
(xelf::open-frame
"Buffers"
......
......@@ -3997,7 +3997,7 @@ Returns a newly allocated list."
(run-hook '*after-startup-hook*)
(message "Finished initializing Xelf for project ~A." *project*)
(hide-terminal)
(load-user-init-file)
#-ecl (load-user-init-file)
(sdl:with-events ()
(:quit-event () (prog1 t (shut-down)))
(:video-resize-event (:w w :h h)
......
......@@ -4892,7 +4892,7 @@ This section needs to be cleaned up.
(run-hook '*after-startup-hook*)
(message "Finished initializing Xelf for project ~A." *project*)
(hide-terminal)
(load-user-init-file)
#-ecl (load-user-init-file)
(sdl:with-events ()
(:quit-event () (prog1 t (shut-down)))
(:video-resize-event (:w w :h h)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment