Commit 56cb6971 authored by David O'Toole's avatar David O'Toole

fix dialog centering and other issues

parent cfbe3075
;; Captions and labels
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Captions%20and%20labels][Captions and labels:1]]
;; [[file:~/xelf/gui.org::*Captions%20and%20labels][Captions and labels:1]]
(in-package :xelf)
(defmethod set-caption-string ((self node) caption)
......@@ -40,7 +40,7 @@
;; Shell operations
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Shell%20operations][Shell operations:1]]
;; [[file:~/xelf/gui.org::*Shell%20operations][Shell operations:1]]
(defmethod drag ((self shell) x y)
(with-slots (target-x target-y) self
(setf target-x (- x (window-x)))
......@@ -186,7 +186,7 @@
;; Automatic layout
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Automatic%20layout][Automatic layout:1]]
;; [[file:~/xelf/gui.org::*Automatic%20layout][Automatic layout:1]]
(defmethod update :after ((self shell))
(layout self)
(mapc #'layout (%inputs self))
......@@ -199,7 +199,7 @@
;; Dialog box builder
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Dialog%20box%20builder][Dialog box builder:1]]
;; [[file:~/xelf/gui.org::*Dialog%20box%20builder][Dialog box builder:1]]
(defclass dialog (phrase)
((orientation :initform :vertical)
(no-background :initform nil)
......@@ -215,7 +215,11 @@
(draw-patch self x y (+ x width) (+ y height) :color color :style :rounded)))
(defmethod tap ((dialog dialog) x y)
(bring-to-front (or (parent dialog) dialog)))
(bring-to-front (or (parent dialog) dialog))
(tap (or (parent dialog) dialog) x y))
(defmethod freeze :after ((dialog dialog))
(mapc #'freeze (inputs dialog)))
(defmacro define-dialog (name arglist &body body)
`(progn
......@@ -354,7 +358,7 @@
;; System object
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*System%20object][System object:1]]
;; [[file:~/xelf/gui.org::*System%20object][System object:1]]
(defvar *system* nil)
(defclass system (node)
......@@ -372,10 +376,12 @@
(defun show-dialog (dialog title &key destroy-after-evaluate-p)
(let ((frame (make-frame title dialog :destroy-after-evaluate-p destroy-after-evaluate-p)))
(add-node (current-buffer) frame)
(layout dialog)
(layout frame)
(center frame)
(align-to-pixels frame)
(freeze dialog)
(mapc #'freeze (inputs dialog))
(close-menus *menubar*)
nil))
(defun do-cut ()
......@@ -423,9 +429,6 @@
(defun save-everything ()
(save-project :force))
(defun initialize ()
(setf *system* self))
(defun create-trash ()
(add-block (shell) (make-instance 'trash) 100 100))
......@@ -446,7 +449,7 @@
;; User dialogs
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*User%20dialogs][User dialogs:1]]
;; [[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))
......@@ -459,20 +462,21 @@
(define-dialog visit-buffer
((buffer-name (or (first *buffer-history*)
(buffer-name (current-buffer)))))
(switch-to-buffer buffer-name))
(at-next-update (switch-to-buffer buffer-name)))
(define-dialog create-buffer
((buffer-name (uniquify-buffer-name "*untitled-buffer*"))
(buffer-class '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 :buffer-name buffer-name)))
(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)))))
......@@ -499,16 +503,31 @@
(setf *title* title)
(setf *author* author)
(setf *author-contact* author)
(setf *width* width)
(setf *height* height)
(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))
(defclass buffer-list (text) ())
(defmethod tap :after ((buffer-list buffer-list) x y)
(with-slots (point-row) buffer-list
(at-next-update (switch-to-buffer (nth point-row (slot-value buffer-list 'buffer))))))
(defclass buffer-list-dialog (dialog)
((inputs :initform (list (make-instance 'buffer-list :text (all-buffer-names))))))
(defun show-buffer-list-dialog ()
(show-dialog (make-instance 'buffer-list-dialog) "Buffer list" :destroy-after-evaluate-p t))
;; User dialogs:1 ends here
;; Menu bar structure
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Menu%20bar%20structure][Menu bar structure:1]]
;; [[file:~/xelf/gui.org::*Menu%20bar%20structure][Menu bar structure:1]]
(defparameter *project-menu*
'(:label "Project"
:inputs
......@@ -564,10 +583,15 @@
(:label "Destroy buffer" :action show-destroy-buffer-dialog)
(:label "Save buffer in new file" :action show-save-buffer-in-new-file-dialog)
(:label "Revert buffer" :action show-revert-buffer-dialog)
(:label "Resize to background image" :action resize-to-background-image)
(:label "Resize to background image" :action do-resize-to-background-image)
(:label "Make snapshot" :action show-take-snapshot-dialog)
(:label "View clipboard" :action view-clipboard)
(:label "View buffer list" :action view-buffer-list))))
(:label "View buffer list" :action show-buffer-list-dialog))))
(defun do-resize-to-background-image ()
(if (background-image (current-buffer))
(resize-to-background-image (current-buffer))
(notify "No background image to resize to.")))
(defun do-show-buffer-properties-dialog ()
(show-buffer-properties-dialog (current-buffer)))
......@@ -672,7 +696,7 @@
;; Traveling nodes
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Traveling%20nodes][Traveling nodes:1]]
;; [[file:~/xelf/gui.org::*Traveling%20nodes][Traveling nodes:1]]
(defclass traveler (node)
((parent-buffer :initform nil)))
......@@ -688,7 +712,7 @@
;; Menubar class
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Menubar%20class][Menubar class:1]]
;; [[file:~/xelf/gui.org::*Menubar%20class][Menubar class:1]]
(defclass menubar (tree traveler)
((category :initform :menu)
(temporary :initform t)))
......@@ -788,7 +812,8 @@
(defmethod tap ((self menubar) x y)
(let ((target (hit self x y)))
(show-status (format nil "Hitting target ~S" target))
(when (not (object-eq target self))
(when (and (xelfp target)
(not (object-eq target self)))
(tap target x y))
(close-menus self)))
......@@ -804,7 +829,7 @@
;; Floating window frames
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Floating%20window%20frames][Floating window frames:1]]
;; [[file:~/xelf/gui.org::*Floating%20window%20frames][Floating window frames:1]]
(define-handle frame-close-button :close
:slots ((target-frame :initform nil :initarg :target-frame :accessor target-frame)))
......@@ -815,7 +840,12 @@
(defmethod layout ((self frame-close-button))
(resize self 20 20))
(defclass titlebar-label (label) ())
(defmethod tap ((self titlebar-label) x y)
(let ((it (parent (parent self))))
(when it
(tap it x y))))
(define-visual-macro titlebar
(:super phrase
......@@ -826,16 +856,11 @@
(dash :initform 1)
(category :initform :system))
:inputs (:close-button (make-instance 'frame-close-button)
:title (make-instance 'label :font "sans-bold-11" :read-only t :locked t))))
:title (make-instance 'titlebar-label :font "sans-bold-11" :read-only t :locked t))))
(defmethod set-title ((self titlebar) title)
(set-value (input-node self :title) title))
(defmethod tap ((self titlebar) x y)
(let ((it (parent (parent self))))
(when it
(tap it x y))))
(define-visual-macro frame
(:super phrase
:slots ((frozen :initform t)
......@@ -895,7 +920,7 @@
;; Context menus
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Context%20menus][Context menus:1]]
;; [[file:~/xelf/gui.org::*Context%20menus][Context menus:1]]
(defmethod make-method-menu-item ((self node) method target)
(assert (and target method (symbolp method)))
(let ((method-string (pretty-string method)))
......
This source diff could not be displayed because it is too large. You can view the blob instead.
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