| Paste number 81072: | a weekend with lambda-gtk |
| Pasted by: | fusss |
| When: | 8 months, 1 week ago |
| Share: | Tweet this! | http://paste.lisp.org/+1QK0 |
| Channel: | #lisp |
| Paste contents: |
(gtk:define-signal-handler quit-signal :void (widget data)
widget data
(gtk:main-quit))
(gtk:define-signal-handler delete-signal :int (widget event data)
widget event data
(format t "delete-event ocurred~%")
gtk:+false+)
(gtk:define-signal-handler motion-notify :int (widget event)
widget event
(gtk:window-set-position widget gtk:win-pos-mouse)
(gtk:window-set-title widget (format nil "(~a, ~a)" (gdk:eventmotion.x event) (gdk:eventmotion.y event)))
(g:signal-emit-by-name widget "expose_event")
(format t "motion-notify~%")
(force-output)
gtk:+false+)
(gtk:define-signal-handler button-clicked :void (widget data)
(let* ((popup (gtk:window-new gtk:window-popup)))
(gtk:container-add widget popup)))
;; (defgui button (gtk-button)
;; (label
;; callback
;; parent))
;; (make-gui 'button :label "Hello World" :callback #'(lambda (gui data)
;; (bar))
;; :parent window) ==>
;; (make-gui class &args)
(defun foo ()
(gtk:init-ensure)
(gtk:rc-parse "theme/win32.gtkrc")
(let* ((main-window (gtk:window-new gtk:window-toplevel))
(scroll (gtk:scrolled-window-new (g:nullptr) (g:nullptr)))
(viewport (gtk:viewport-new (gtk:scrolled-window-get-hadjustment scroll)
(gtk:scrolled-window-get-vadjustment scroll)))
(vbox (gtk:vbox-new gtk:+false+ 5)))
(gtk:scrolled-window-set-policy scroll gtk:policy-automatic gtk:policy-automatic)
(gtk:scrolled-window-add-with-viewport scroll vbox)
(gtk:container-add main-window scroll)
(dolist (pkg (list-all-packages))
(gtk:box-pack-end vbox (gtk:button-new-with-label (package-name pkg))
gtk:+true+ gtk:+true+ 0))
(gtk:window-set-title main-window "Main Window")
(gtk:window-set-default-size main-window 200 300)
(gtk:window-set-position main-window gtk:win-pos-mouse)
(gtk:widget-show-all main-window)
(g:signal-connect main-window "motion_notify_event" (g:callback motion-notify) (g:nullptr))
(g:signal-connect main-window "delete" (g:callback delete-signal) (g:nullptr))
(g:signal-connect main-window "destroy" (g:callback quit-signal) (g:nullptr))
(gtk:main)))
(foo)
(defun editor ()
(gtk:init-ensure)
(gtk:rc-parse "theme/win32.gtkrc")
(let* ((main-window (gtk:window-new gtk:window-toplevel))
(vpaned (gtk:vpaned-new)))
(gtk:paned-add1 vpaned (gtk:button-new-with-label "foo"))
(gtk:paned-add2 vpaned (gtk:button-new-with-label "bar"))
(gtk:window-set-title main-window "Main Window")
(gtk:window-set-default-size main-window 200 300)
(gtk:container-add main-window vpaned)
(gtk:widget-show-all main-window)
; (g:signal-connect button "clicked" (g:callback button-clicked) (g:nullptr))
(g:signal-connect main-window "motion_notify_event" (g:callback motion-notify) (g:nullptr))
(g:signal-connect main-window "delete" (g:callback delete-signal) (g:nullptr))
(g:signal-connect main-window "destroy" (g:callback quit-signal) (g:nullptr))
(gtk:main)))
(editor)
(gtk:define-signal-handler button-clicked :void (widget data)
(let* ((popup (gtk:window-new gtk:window-popup)))
(format t "button_press_event~%")
(force-output))
gtk:+false+)
; gtk:text-buffer-set-text
(defun main-window ()
(let* ((main-window (gtk:window-new gtk:window-toplevel))
(vbox (gtk:vbox-new gtk:+false+ 0))
(notebook (gtk:notebook-new))
(url (gtk:label-new "cliki.net"))
(text-view (gtk:text-view-new))
(text-buffer (gtk:text-view-get-buffer text-view))
(scrolled-win (gtk:scrolled-window-new (g:nullptr) (g:nullptr)))
(menu-bar (gtk:menu-bar-new))
(tool-bar (gtk:toolbar-new))
(backward (gtk:button-new-from-stock "gtk-go-back"))
(forward (gtk:button-new-from-stock "gtk-go-forward"))
(file (gtk:menu-item-new-with-label "File"))
(edit (gtk:menu-item-new-with-label "Edit"))
(help (gtk:menu-item-new-with-label "Help"))
(file-menu (gtk:menu-new))
(edit-menu (gtk:menu-new))
(help-menu (gtk:menu-new))
(status-bar (gtk:statusbar-new))
(sb-context (gtk:statusbar-get-context-id status-bar "help"))
(event-box (gtk:event-box-new))
(label (gtk:label-new "double click me")))
(gtk:widget-set-size-request main-window 600 400)
(gtk:menu-item-set-submenu file file-menu)
(gtk:menu-shell-append file-menu (gtk:image-menu-item-new-from-stock "gtk-new" (g:nullptr)))
(gtk:menu-item-set-submenu edit edit-menu)
(gtk:menu-item-set-submenu help help-menu)
(gtk:menu-shell-append menu-bar file)
(gtk:menu-shell-append menu-bar edit)
(gtk:menu-shell-append menu-bar help)
(gtk:toolbar-set-style tool-bar gtk:toolbar-both)
(gtk::toolbar-insert tool-bar backward 0)
(gtk:toolbar-insert tool-bar forward 1)
(gtk:container-add main-window vbox)
(gtk:widget-show vbox)
(gtk:container-add scrolled-win text-view)
(gtk:notebook-append-page notebook scrolled-win url)
(gtk:box-pack-start vbox menu-bar gtk:+false+ gtk:+false+ 2)
(gtk:box-pack-start vbox notebook gtk:+true+ gtk:+true+ 2)
(gtk:box-pack-start vbox status-bar gtk:+false+ gtk:+true+ 2)
(gtk:widget-show-all main-window)
(g:signal-connect event-box "button_press_event" (g:callback button-clicked) label)
(g:signal-connect main-window "delete" (g:callback delete-signal) (g:nullptr))
(g:signal-connect main-window "destroy" (g:callback quit-signal) (g:nullptr))
(gtk:main)))
(main-window)
;(main-window)
(let* ((main-dialog (gtk:dialog-new))
; (handle-box (gtk:handle-box-new))
(toolbar (gtk:toolbar-new))
(text (gtk:entry-new))
(icon (gtk:image-new-from-file "logo.xpm")))
(gtk:toolbar-insert toolbar icon 0);;"Back" "Go Back" "Private"
;; icon
;; ;(gtk:image-new-from-stock "gtk-go-back"
;; ; gtk:icon-size-button)
;; delete-signal
;; (g:nullptr))))
(gtk:window-set-title main-dialog "Dialog test")
(gtk:widget-set-size-request main-dialog 600 300)
(gtk:toolbar-insert toolbar text 0)
(gtk:widget-show text)
(gtk:widget-realize main-dialog)
(gtk:toolbar-set-orientation toolbar gtk:orientation-horizontal)
(gtk:toolbar-set-style toolbar gtk:toolbar-both)
(gtk:container-add main-dialog toolbar)
(let ((entry (gtk:entry-new)))
(g:signal-connect main-dialog "delete" (g:callback delete-signal) (g:nullptr))
(g:signal-connect main-dialog "destroy" (g:callback quit-signal) (g:nullptr))
(gtk:widget-show toolbar)
(gtk:widget-show-all main-dialog)
(gtk:main)))
(defun daaqad-samee (magaca salaan)
(let* ((main-dialog (gtk:window-new gtk:window-toplevel))
(button (gtk:button-new-with-label salaan)))
(gtk:window-set-title main-dialog magaca)
(gtk:widget-set-size-request main-dialog 600 300)
(gtk:container-add main-dialog button)
(g:signal-connect main-dialog "delete" (g:callback delete-signal) (g:nullptr))
(g:signal-connect main-dialog "destroy" (g:callback quit-signal) (g:nullptr))
(gtk:widget-show-all main-dialog)
(gtk:main)))
(daaqad-samee "iska waran" "maxamad hebelow")
(defmethod contain ((layout row-layout))
(contain-layout (gtk:vbox-new gtk:+false+ 0)
layout))
(defmethod contain ((layout column-layout))
(contain-layout (gtk:hbox-new gtk:+false+ 0)
layout))
(defun layout-fill (layout)
(if (layout-resizable-p layout)
gtk:+true+))
(defun layout-expand (layout)
gtk:+true+)
(defmethod append-child ((parent layout) child)
(gtk:box-pack-end parent child))
(defun contain-layout (box layout)
(gtk:init-ensure)
(let ((main-window (gtk:window-new gtk:window-toplevel)))
(dolist (child (reparent-layouts box (layout-children layout)))
(gtk:box-pack-end box child
(layout-fill layout)
(layout-expand layout)
(layout-spacing layout)))
(gtk:container-add main-window box)
(g:signal-connect main-window "delete" (g:callback delete-signal) (g:nullptr))
(g:signal-connect main-window "destroy" (g:callback quit-signal) (g:nullptr))
(gtk:widget-show-all main-window)
(gtk:main)))
(contain (make-instance 'column-layout
:resizable-p t
:children (list (gtk:button-new-with-label "Foo")
(gtk:button-new-with-label "Bar"))))
(contain (make-instance 'row-layout
:resizable-p nil
:children (list (gtk:button-new-with-label "Foo")
(gtk:button-new-with-label "Bar"))))
(contain (make-instance 'row-layout
:children (list (gtk:button-new-with-label "Foo")
(gtk:button-new-with-label "Bar"))
))
(contain (make-instance 'column-layout
:children (list (gtk:button-new-with-label "Foo")
(gtk:button-new-with-label "Bar"))
:spacing 5
))
(defmacro horizontally (&rest children)
`(contain (make-instance 'column-layout
:children (list ,@children))))
(defmacro vertically (&rest children)
`(contain (make-instance 'row-layout
:children (list ,@children))))
This paste has no annotations.