Merge branch 'gtklos-doc'

extensions/gtklos/demos/demos.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; demos.stk  -- Run all the STklos demos
 ;;;;
-;;;; Copyright © 2009-2022 Erick Gallesio - Polytech'Nice-Sophia <eg@unice.fr>
+;;;; Copyright © 2009-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -29,13 +29,17 @@
               (lambda ()
                 (read-from-string (format "(~A)" (read-line))))))
 
+(define (exit-demo . ignore)
+  (eprintf "Terminating the GTKlos demo.\nBye.\n")
+  (exit 0))
+
 
 (define (main args)
   (let* ((win   (make <vwindow> #:title "Run a GTklos demo" :width 400))
          (label (make <label>  #:text "\n<b>Choose a demo below</b>\n" #:parent win))
          (grid  (make <grid>   #:parent win :column-homogeneous #t))
          (bye   (make <button> :text "\nExit\n" :parent win
-                               :command (lambda _ (exit 0)))))
+                               :command exit-demo)))
 
     ;; Fill the grid with demos
     (let Loop ((top 0)
@@ -59,5 +63,9 @@
               (if (zero? (modulo (+ left 1) 4))
                   (Loop (+ top 1) 0    (cdr lst))
                   (Loop top (+ left 1) (cdr lst)))))))
+
+    ;; Terminate the demo if window is closed
+    (event-connect win "delete-event" exit-demo)
+
     ;; GTk starts
     (gtk-main)))

extensions/gtklos/demos/dialog.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; dialog.stk -- Dialog box
 ;;;;
-;;;; Copyright © 2001-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2001-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -51,8 +51,8 @@ to create the dialog.
   (let* ((win (make <demo-window> :title "Dialog Demo" :x 100 :y 100
                     :file "dialog" :border-width 15
                     :message *dialog-msg*)))
-    (make-dialog win "Error"    'error '(ok))
-    (make-dialog win "Info"     'info '(ok))
-    (make-dialog win "Question" 'question '(yes no))
-    (make-dialog win "Warning"  'warning '("More information" cancel))
+    (make-dialog win "Error"    'error '("gtk-ok"))
+    (make-dialog win "Info"     'info '("gtk-ok"))
+    (make-dialog win "Question" 'question '("gtk-yes" "gtk-no"))
+    (make-dialog win "Warning"  'warning '("More information" "gtk-cancel"))
     (gtk-main)))

extensions/gtklos/demos/event.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; event.stk  -- Demo showing event management in GTklos
 ;;;;
-;;;; Copyright © 2002-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2002-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -82,7 +82,8 @@ output.
                      #f))
     (event-connect txt "key-press-event"
                    (lambda (w e)
-                     (printf "Keypress: [~A] (keysym: [~A] modifiers [~A]\n"
-                             (event-char e) (event-keyval e) (event-modifiers e))
+                     (printf "Keypress: [~A] (keyval: [~A] keycode: [~A] mod. [~A]\n"
+                             (event-char e) (event-keyval e) (event-keycode e)
+                             (event-modifiers e))
                      #f))
     (gtk-main)))

extensions/gtklos/demos/menu2.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; menu1.stk          -- GTK+ Menu Demo
 ;;;;
-;;;; Copyright © 2009-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2009-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -29,9 +29,9 @@
 Menu Bar Demo (version 2)
 
 This demo just shows a simple menu bar with simple menus.
-This time we use the <b>add-menubar-items!</b> function which
-allow a simpler code (comare the source code of this version
-and the same demo wher everything is done bt hand).
+This time, we use the <b>add-menubar-items!</b> function which
+allow a simpler code (compare the source code of this version
+and the same demo where everything is done bt hand).
 ")
 
 
@@ -47,13 +47,13 @@ and the same demo wher everything is done bt hand).
 
     (add-items-to-menubar mb
         `(("Item 1"
-             ("Item 1 / 1"   :action ,action)
-             ("Item 1 / 2"   :action ,action))
+             ("Item 1 / 1"   :command ,action)
+             ("Item 1 / 2"   :command ,action))
           ("Item 2"
-             ("Item 2 / 1"   :action ,action)
-             ("Item 2 / 2"   :action ,action))
+             ("Item 2 / 1"   :command ,action)
+             ("Item 2 / 2"   :command ,action))
           ()                    ;; Use an empty list to make space
           ("Item 3"
-             ("Item 3 / 1"   :action ,action)
-             ("Item 3 / 2"   :action ,action))))
+             ("Item 3 / 1"   :command ,action)
+             ("Item 3 / 2"   :command ,action))))
     (gtk-main)))

extensions/gtklos/demos/menu3.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; menu3.stk          -- GTK+ Menu Demo
 ;;;;
-;;;; Copyright © 2009-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2009-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -44,37 +44,37 @@ menus.
      (mb   (make <menu-bar> :parent win)))
     (add-items-to-menubar mb
                            `(("File"
-                                 ("Load"   :action ,action)
-                                 ("Save"   :action ,action)
+                                 ("Load"   :command ,action)
+                                 ("Save"   :command ,action)
                                  (""       :type   :separator)
-                                 ("Quit"   :action ,(lambda _ (exit 0))))
+                                 ("Quit"   :command ,(lambda _ (exit 0))))
                              ("Edit"
-                                 ("Copy"   :action ,action)
-                                 ("Cut"    :action ,action)
-                                 ("Paste"  :action ,action))
+                                 ("Copy"   :command ,action)
+                                 ("Cut"    :command ,action)
+                                 ("Paste"  :command ,action))
                              ("Cascade"
                                  ("  1  " :type :cascade
-                                  :menu (("One"  :action ,action)
-                                         ("Un"   :action ,action)
-                                         ("Eins" :action ,action)))
+                                  :menu (("One"  :command ,action)
+                                         ("Un"   :command ,action)
+                                         ("Eins" :command ,action)))
                                  ("  2  " :type :cascade
-                                  :menu (("Two"  :action ,action)
-                                         ("Deux" :action ,action)
-                                         ("Zwei" :action ,action)))
-                                 ("  3  " :action ,action)
-                                 ("  4  " :action ,action))
+                                  :menu (("Two"  :command ,action)
+                                         ("Deux" :command ,action)
+                                         ("Zwei" :command ,action)))
+                                 ("  3  " :command ,action)
+                                 ("  4  " :command ,action))
                              ("Check"
-                                 ("option1" :type :check :action ,action)
-                                 ("option2" :type :check :action ,action :value #t))
+                                 ("option1" :type :check :command ,action)
+                                 ("option2" :type :check :command ,action :value #t))
                              ("Radio"
-                                 ("radio1 group1" :type :radio :action ,action)
-                                 ("radio2 group1" :type :radio :action ,action :value #t)
+                                 ("radio1 group1" :type :radio :command ,action)
+                                 ("radio2 group1" :type :radio :command ,action :value #t)
                                  (""       :type :separator)
-                                 ("radio1 group2" :type :radio :action ,action :first #t)
-                                 ("radio2 group2" :type :radio :action ,action))
+                                 ("radio1 group2" :type :radio :command ,action :first #t)
+                                 ("radio2 group2" :type :radio :command ,action))
                              ()  ;; Add an empty list to make space
                              ;; Now "Help" will be on the right part of the tool-bar
                              ("Help"
-                                 ("About"     :action ,action)
-                                 ("More Info" :action ,action))))
+                                 ("About"     :command ,action)
+                                 ("More Info" :command ,action))))
     (gtk-main)))

extensions/gtklos/demos/radiobutton.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; radiobutton.stk            -- GTK Radio Button Demo
 ;;;;
-;;;; Copyright © 2000-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2000-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -40,7 +40,7 @@ Some GTklos radio buttons and two buttons to give them life.
           #:border-width 10
           #:sibling leader
           #:command (lambda (w e)
-                      (let ((sel (group-selected w)))
+                      (let ((sel (radio-selected w)))
                         (when (eq? w sel)
                           ;; Show only a message when selected (not on de-selection)
                           (printf "Radio group #~s: ~s\n" group (text sel)))))))
@@ -74,15 +74,15 @@ Some GTklos radio buttons and two buttons to give them life.
         (make <button> #:text "Radio #2 selected"
                        #:parent buttons
                        #:command (lambda (w e)
-                                   (let ((sel (group-selected r1)))
+                                   (let ((sel (radio-selected r1)))
                                      (printf "Radio group #2: ~s\n" (text sel)))))
         (make <button> #:text "Change Radio 2"
                        #:parent buttons
                        #:command (let ((l (list r1 r2 r3 r4 r5)))
                                    (set-cdr! (last-pair l) l)   ; make the list circular
                                    (lambda (w e)
                                      (set! l (cdr l))
-                                     (set! (group-selected r1) (car l)))))))
+                                     (set! (radio-selected r1) (car l)))))))
     (gtk-main)
     0))
 

extensions/gtklos/demos/scroll2.stk

@@ -1,7 +1,7 @@
 ;;;;
-;;;; scroll2.stk	-- GTklos Scroll Widget Demo
+;;;; scroll2.stk        -- GTklos Scroll Widget Demo
 ;;;;
-;;;; Copyright © 2002-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2002-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -41,7 +41,7 @@ radio buttons located at the top of this window.
         #:border-width 10
         #:sibling leader
         #:command (lambda (w e)
-                    (let ((sel (group-selected w)))
+                    (let ((sel (radio-selected w)))
                       (when (eq? w sel)
                         (set! (window-placement scroll) (text sel)))))))
 
@@ -78,20 +78,22 @@ radio buttons located at the top of this window.
     (make <check-button> #:text "Vertical Scroll"
                          #:value #t
                          #:command (lambda (chk e)
-                                     (set! (vpolicy scroll) (if (value chk) 'automatic 'never)))
+                                     (set! (vpolicy scroll)
+                                           (if (value chk) 'automatic 'never)))
                          #:parent frm2)
     (make <check-button> #:text "Horizontal Scroll"
                          #:value #t
                          #:command (lambda (chk e)
-                                     (set! (hpolicy scroll) (if (value chk) 'automatic 'never)))
+                                     (set! (hpolicy scroll)
+                                           (if (value chk) 'automatic 'never)))
                          #:parent frm2)
 
 
 
     ;; Build a set of  buttons in the scroll
-    (dotimes (i 60)
+    (dotimes (i 100)
       (make <button>
             #:text (format "Button #~A" i)
-            #:parent (list grid #:top (quotient i 5) #:left (modulo i 5))
+            #:parent (list grid #:top (quotient i 10) #:left (modulo i 10))
             #:command (lambda _ (eprintf "You have clicked on button #~A\n" i))))
     (gtk-main)))

extensions/gtklos/demos/sedit.stk

@@ -1,7 +1,7 @@
 ;;;;
 ;;;; sedit.stk  -- A small editor written in STklos
 ;;;;
-;;;; Copyright © 2000-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright © 2000-2024 Erick Gallesio <eg@stklos.net>
 ;;;;
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -33,13 +33,19 @@
 ;;;; message on the standard error port.
 ;;;;
 (define (graphical-handler c)
-  (describe c)
   (make-simple-message-dialog "Error ..."
                   'error
                   (format "\n\n~A: ~A\n\n"
                       (condition-ref c 'location)
                       (condition-ref c 'message))
-                  '(ok)))
+                  :buttons '("gtk-ok")))
+
+(define (make-file-selector-dialog . args)
+  (let* ((dlg (apply make <file-dialog> args))
+         (res (dialog-run dlg)))
+    (destroy dlg)
+    res))
+
 
 ;;;;
 ;;;; I/O Operations
@@ -50,6 +56,8 @@
     (text-read-file *text* f)))
 
 
+
+
 (define (open-a-file . _)
   (with-handler graphical-handler
      (let ((f (make-file-selector-dialog #:title "Open File ..."
@@ -61,10 +69,10 @@
 (define (save-as . _)
   (with-handler graphical-handler
      (let ((f (make-file-selector-dialog #:title "Save as ..."
-                                         #:type 'save
+                                         #:dialog-type 'save
                                          #:value (and  *current-file* ""))))
        (when f
-         (if (and (file-exists? f) (not (file-is-regular? f)))
+         (if (or (file-exists? f) (not (file-is-regular? f)))
              (error "buffer cannot be saved in ~S" f)
              (begin
                (set! *current-file* f)
@@ -96,7 +104,7 @@
                    "\n"
                    "This is a simple demo of an editor written\n"
                    "using STklos (version " (version) ")\n")
-                  '(ok)))
+                  :buttons '("gtk-ok")))
 
 
 ;;;;
@@ -116,18 +124,18 @@
     ;; Fill the menu
     (add-items-to-menubar menus
         `(("File"
-             ("Open"          #:action ,open-a-file)
-             ("Save"          #:action ,save-file)
-             ("Save As ..."   #:action ,save-as)
+             ("Open"          #:command ,open-a-file)
+             ("Save"          #:command ,save-file)
+             ("Save As ..."   #:command ,save-as)
              (""              #:type   #:separator)
-             ("Quit"          #:action ,quit-editor))
+             ("Quit"          #:command ,quit-editor))
           ("Edit"
-             ("Cut"           #:action ,cut-sel)
-             ("Copy"          #:action ,copy-sel)
-             ("Paste"         #:action ,paste-sel))
+             ("Cut"           #:command ,cut-sel)
+             ("Copy"          #:command ,copy-sel)
+             ("Paste"         #:command ,paste-sel))
           ()
           ("Help"
-             ("About"       #:action ,about-editor))))
+             ("About"         #:command ,about-editor))))
     ;; Fill the toolbar
     (add-items-to-toolbar tb
         `((:icon-name "document-open"    #:command ,open-a-file #:tooltip "Open file")

extensions/gtklos/doc/Makefile.am

@@ -9,7 +9,8 @@ TOP   =../../..
 SPP   = $(TOP)/src/stklos -q -I $(TOP)/lib -I ../lib -f $(TOP)/utils/stklos-pp.stk --
 MAIN  = gtklos
 DOCS  = buttons.adoc canvases.adoc containers.adoc dialogs.adoc \
-        displays.adoc events.adoc gtklos.adoc intro.adoc misc.adoc texts.adoc
+        displays.adoc events.adoc gtklos.adoc gtk-misc.adoc intro.adoc \
+        misc.adoc texts.adoc
 SCM   = gendoc.stk
 SRC   = $(DOCS) $(SCM)
 

extensions/gtklos/doc/Makefile.in

@@ -294,7 +294,8 @@ TOP = ../../..
 SPP = $(TOP)/src/stklos -q -I $(TOP)/lib -I ../lib -f $(TOP)/utils/stklos-pp.stk --
 MAIN = gtklos
 DOCS = buttons.adoc canvases.adoc containers.adoc dialogs.adoc \
-        displays.adoc events.adoc gtklos.adoc intro.adoc misc.adoc texts.adoc
+        displays.adoc events.adoc gtklos.adoc gtk-misc.adoc intro.adoc \
+        misc.adoc texts.adoc
 
 SCM = gendoc.stk
 SRC = $(DOCS) $(SCM)