Commit 097076ca authored by David O'Toole's avatar David O'Toole

tidy up gui code

parent 735ec9c2
;; Captions and labels
;; Captions and labels (commands.lisp)
;; [[file:~/xelf/gui.org::*Captions%20and%20labels][Captions and labels:1]]
;; [[file:~/xelf/gui.org::*Captions%20and%20labels%20(commands.lisp)][Captions and labels (commands.lisp):1]]
(in-package :xelf)
(defmethod set-caption-string ((self node) caption)
......@@ -35,7 +35,7 @@
(defmethod draw-caption ((self node) expression)
(draw-caption-string self (fancy-format-expression expression)))
;; Captions and labels:1 ends here
;; Captions and labels (commands.lisp):1 ends here
;; Shell operations
......@@ -205,11 +205,6 @@
(no-background :initform nil)
(style :initform :rounded)))
;; (defmethod draw-expanded :around ((self dialog) &optional label)
;; (if (typep (parent self) (find-class 'frame))
;; (mapc #'draw (inputs self))
;; (call-next-method)))
(defmethod draw-background ((self dialog) &key color)
(with-slots (x y width height) self
(draw-patch self x y (+ x width) (+ y height) :color color :style :rounded)))
......@@ -422,14 +417,6 @@
(align-to-pixels notice)
(bring-to-front notice)))
(defun show-help ()
(let ((help (make-instance 'text :text *help-text*)))
(add-node (current-buffer) help (window-x) (window-y))
(layout help)
(center help)
(align-to-pixels help)
(bring-to-front help)))
(defun save-before-exit ())
(defun create-project ())
......@@ -463,63 +450,54 @@
;; [[file:~/xelf/gui.org::*User%20dialogs][User dialogs:1]]
;; (define-dialog rename-buffer
;; ((new-name (slot-value (current-buffer) 'buffer-name)))
;; (rename-buffer (current-buffer) new-name))
;; (define-dialog resize-buffer
;; ((width (slot-value (current-buffer) 'width))
;; (height (slot-value (current-buffer) 'height)))
;; (resize (current-buffer) width height))
(define-dialog visit-buffer
((buffer-name (or (first *buffer-history*)
(define-dialog visit-buffer
((buffer-name (or (first *buffer-history*)
(buffer-name (current-buffer)))))
(at-next-update (switch-to-buffer buffer-name)))
(define-dialog create-buffer
((buffer-name (uniquify-buffer-name "*untitled*"))
(buffer-class (class-name (class-of (current-buffer)))))
(at-next-update
(switch-to-buffer (make-instance buffer-class :buffer-name buffer-name))))
(define-dialog paste-as-new-buffer
((buffer-name (uniquify-buffer-name "*pasted-buffer*"))
(buffer-class (class-name (class-of (current-buffer))))
(offset-x 0)
(offset-y 0))
(at-next-update
(let ((buffer (make-instance buffer-class :buffer-name buffer-name)))
(switch-to-buffer buffer-name)
(paste (current-buffer) offset-x offset-y)
(trim-conservatively (current-buffer)))))
(define-properties-dialog buffer-properties
(buffer-name width height z-sort-p background-image background-color
window-scrolling-speed horizontal-scrolling-margin vertical-scrolling-margin))
(defmethod apply-properties :after ((dialog buffer-properties-dialog) &optional buffer)
(notify (format nil "Applied buffer properties to ~S." buffer))
(let ((buffer (or buffer (current-buffer))))
(with-slots (height width buffer-name) buffer
(resize buffer width height)
(rename-buffer buffer buffer-name))))
(define-properties-dialog project-properties
(path width height scale-output-to-window frame-rate resizable author author-contact title license))
(defmethod apply-properties :after ((dialog project-properties-dialog) &optional project)
(with-slots (name path resizable scale-output-to-window frame-rate title author author-contact
width height license) project
(setf *scale-output-to-window* scale-output-to-window)
(set-frame-rate frame-rate)
(setf *title* title)
(setf *author* author)
(setf *author-contact* author)
(setf *screen-width* width)
(setf *screen-height* height)
(setf *resizable* resizable))
(notify (format nil "Applied project properties to ~S." project)))
(at-next-update (switch-to-buffer buffer-name)))
(define-dialog create-buffer
((buffer-name (uniquify-buffer-name "*untitled*"))
(buffer-class (class-name (class-of (current-buffer)))))
(at-next-update
(switch-to-buffer (make-instance buffer-class :buffer-name buffer-name))))
(define-dialog paste-as-new-buffer
((buffer-name (uniquify-buffer-name "*pasted-buffer*"))
(buffer-class (class-name (class-of (current-buffer))))
(offset-x 0)
(offset-y 0))
(at-next-update
(let ((buffer (make-instance buffer-class :buffer-name buffer-name)))
(switch-to-buffer buffer-name)
(paste (current-buffer) offset-x offset-y)
(trim-conservatively (current-buffer)))))
(define-properties-dialog buffer-properties
(buffer-name width height z-sort-p background-image background-color
window-scrolling-speed horizontal-scrolling-margin vertical-scrolling-margin))
(defmethod apply-properties :after ((dialog buffer-properties-dialog) &optional buffer)
(notify (format nil "Applied buffer properties to ~S." buffer))
(let ((buffer (or buffer (current-buffer))))
(with-slots (height width buffer-name) buffer
(resize buffer width height)
(rename-buffer buffer buffer-name))))
(define-properties-dialog project-properties
(path width height scale-output-to-window frame-rate resizable author author-contact title license))
(defmethod apply-properties :after ((dialog project-properties-dialog) &optional project)
(with-slots (name path resizable scale-output-to-window frame-rate title author author-contact
width height license) project
(setf *scale-output-to-window* scale-output-to-window)
(set-frame-rate frame-rate)
(setf *title* title)
(setf *author* author)
(setf *author-contact* author)
(setf *screen-width* width)
(setf *screen-height* height)
(setf *resizable* resizable))
(notify (format nil "Applied project properties to ~S." project)))
(defun all-buffer-names ()
(loop for name being the hash-keys of *buffers* collect name))
......
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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