- [GUI] improved help window.

src/constants.lisp

@@ -21,10 +21,11 @@
        +program-name+
        ,(format nil "~a (original name: \"tinmop\")" +program-name+)))
 
-(define-constant +help-about-message+
+(define-constant +help-about-message-no-uri+
     (format nil
             "~a
-Copyright (C) 2019,2020,2021,2022,2023  cage
+
+Copyright © cage
 
 This program is free software:  you can redistribute it and/or modify
 it under the terms of the  GNU General Public License as published by
@@ -37,13 +38,14 @@ MERCHANTABILITY or  FITNESS FOR  A PARTICULAR  PURPOSE.  See  the GNU
 General Public License for more details.
 
 You should have received a copy of the GNU General Public License
-along with this program.
+along with this program."
+            (actual-program-name))
+  :test #'string=)
 
-For bug report please point your browser to:
-
-~a"
-            (actual-program-name)
-            +issue-tracker+)
+(define-constant +help-about-message+
+    (format nil
+            "~a~%For bug report please point your browser to:~2%~a~2%Enjoy!"
+            +help-about-message-no-uri+ +issue-tracker+)
   :test #'string=)
 
 (define-constant +welcome-message+

src/gui/client/menu-command.lisp

@@ -4,13 +4,46 @@
   (let ((master gui-goodies:*toplevel*))
     (gui:with-toplevel (toplevel :master master :title (_ "About"))
       (gui:transient toplevel master)
-      (let* ((editor (make-instance 'gui:scrolled-text
-                                    :master toplevel
-                                    :cursor gui:+standard-cursor+
-                                    :use-horizontal-scrolling-p nil
-                                    :read-only t)))
-        (setf (gui:text editor) (format nil +help-about-message+))
-        (gui:pack editor :fill :both)))))
+      (let* ((font         (gui-goodies:make-font "sans" 12 nil nil nil))
+             (link-font    (gui-goodies:make-font "sans" 12 :bold nil t))
+             (text-widget  (make-instance 'gui:scrolled-text
+                                          :font   font
+                                          :master toplevel
+                                          :cursor gui:+standard-cursor+
+                                          :use-horizontal-scrolling-p nil
+                                          :read-only t))
+             (button-frame (make-instance 'gui:frame :master toplevel))
+             (close-button (make-instance 'gui:button
+                                          :image   icons:*cross*
+                                          :master  button-frame
+                                          :command (lambda ()
+                                                     (gui:exit-from-toplevel toplevel)))))
+        (setf (gui:text text-widget) (format nil +help-about-message-no-uri+))
+        (gui:make-link-button text-widget
+                              `(:line 1 :char 0)
+                              `(:line 1 :char :end)
+                              link-font
+                              (gui-goodies:parse-color "blue")
+                              (gui-goodies:parse-color "white")
+                              (lambda ()
+                                (os-utils:xdg-open +package-url+)))
+        (gui:append-line text-widget "For bug report please point your browser to:")
+        (gui:append-line text-widget "")
+        (gui:append-text text-widget +issue-tracker+)
+        (let ((last-line (gui:maximum-lines-number text-widget)))
+          (gui:make-link-button text-widget
+                                `(:line ,last-line :char 0)
+                                (gui:make-indices-end)
+                                link-font
+                                (gui-goodies:parse-color "blue")
+                                (gui-goodies:parse-color "white")
+                                (lambda ()
+                                  (os-utils:xdg-open +issue-tracker+))))
+        (gui-goodies:attach-tooltips (close-button (_ "Close")))
+        (gui:grid text-widget  0 0 :sticky :news)
+        (gui:grid button-frame 1 0 :sticky :s)
+        (gui:grid close-button 0 0 :sticky :n)
+        (gui:wait-complete-redraw)))))
 
 (defun quit ()
   (gui:break-mainloop)

src/package.lisp

@@ -46,6 +46,7 @@
    :alexandria
         :config)
   (:export
+   :+help-about-message-no-uri+
    :+help-about-message+
    :+welcome-message+
    :+http-code-ok+