Subject: [PATCH] gnu: cool-retro-term: Update to 1.0.1.

From: Eric Bavier <[email-masked]>
Date: Wed, 4 Apr 2018 08:33:13 -0500

Hello Guix,

This patch updates cool-retro-term to version 1.0.1.

This version added a new font, Knight-TV (GPL).  Rather than adjust the
patch that removes non-free font support, I took the liberty of
implementing a snippet that does the work.  IMHO this is a bit clearer
and more future-proof than the large patch.

`~Eric
From f4fa9801601259280ebd13c2334fd89bc5d689b6 Mon Sep 17 00:00:00 2001
From: Eric Bavier <[email-masked]>
Date: Wed, 21 Mar 2018 00:04:12 -0500
Subject: [PATCH] gnu: cool-retro-term: Update to 1.0.1.

* gnu/packages/terminals.scm (cool-retro-term): Update to 1.0.1.
[source]: Programmatically remove fonts.
[arguments]: Simplify 'configure phase and use 'invoke'.  Add 'install-man
phase.  'let*' -> 'let' where possible.
* gnu/packages/patches/cool-retro-term-remove-non-free-fonts.patch: Delete.
* gnu/local.mk (dist_patch_DATA): Remove it.
---
 gnu/local.mk                                       |   1 -
 .../cool-retro-term-remove-non-free-fonts.patch    | 205 ---------------------
 gnu/packages/terminals.scm                         | 178 ++++++++++++------
 3 files changed, 123 insertions(+), 261 deletions(-)
 delete mode 100644 gnu/packages/patches/cool-retro-term-remove-non-free-fonts.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 2705fb37a..2d9e11264 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -606,7 +606,6 @@ dist_patch_DATA =						\
   %D%/packages/patches/cool-retro-term-dont-check-uninit-member.patch	\
   %D%/packages/patches/cool-retro-term-fix-array-size.patch	\
   %D%/packages/patches/cool-retro-term-memory-leak-1.patch	\
-  %D%/packages/patches/cool-retro-term-remove-non-free-fonts.patch	\
   %D%/packages/patches/cpio-CVE-2016-2037.patch			\
   %D%/packages/patches/cpufrequtils-fix-aclocal.patch		\
   %D%/packages/patches/cracklib-CVE-2016-6318.patch		\
diff --git a/gnu/packages/patches/cool-retro-term-remove-non-free-fonts.patch b/gnu/packages/patches/cool-retro-term-remove-non-free-fonts.patch
deleted file mode 100644
index 7a033df41..000000000
--- a/gnu/packages/patches/cool-retro-term-remove-non-free-fonts.patch
+++ /dev/null
@@ -1,205 +0,0 @@
-From 96ceffdfdcedd3ae33c46b11357aa2518e0a6152 Mon Sep 17 00:00:00 2001
-From: Petter <[email-masked]>
-Date: Thu, 27 Apr 2017 18:55:10 +0200
-Subject: [PATCH] Remove non-free fonts from settings menu
-
---- a/app/qml/ApplicationSettings.qml
-+++ b/app/qml/ApplicationSettings.qml
-@@ -409,7 +409,7 @@
-             obj_string: '{"ambientLight":0.16,"backgroundColor":"#000000","bloom":0.4,"brightness":0.5,"flickering":0.1,"contrast":0.85,"fontName":"TERMINUS_SCALED","fontColor":"#0ccc68","frameName":"SIMPLE_WHITE_FRAME","glowingLine":0.2,"horizontalSync":0.16,"jitter":0.18,"burnIn":0.45,"staticNoise":0.1,"rasterization":0,"screenCurvature":0.1,"windowOpacity":1,"chromaColor":0,"saturationColor":0,"rbgShift":0,"fontWidth":1.0,"useCustomCommand":false,"customCommand":""}'
-             builtin: true
-         }
--        ListElement{
-+        /*ListElement{
-             text: "Default Scanlines"
-             obj_string: '{"ambientLight":0.16,"backgroundColor":"#000000","bloom":0.4,"brightness":0.5,"flickering":0.1,"contrast":0.85,"fontName":"COMMODORE_PET","fontColor":"#00ff5b","frameName":"SIMPLE_WHITE_FRAME","glowingLine":0.2,"horizontalSync":0.14,"jitter":0.11,"burnIn":0.4,"staticNoise":0.05,"rasterization":1,"screenCurvature":0.1,"windowOpacity":1,"chromaColor":0,"saturationColor":0,"rbgShift":0,"fontWidth":1.0,"useCustomCommand":false,"customCommand":""}'
-             builtin: true
-@@ -433,7 +433,7 @@
-             text: "IBM Dos"
-             obj_string: '{"ambientLight":0.16,"backgroundColor":"#000000","bloom":0.4,"brightness":0.5,"flickering":0.07,"contrast":0.85,"fontName":"IBM_DOS","fontColor":"#ffffff","frameName":"SIMPLE_WHITE_FRAME","glowingLine":0.13,"horizontalSync":0,"jitter":0.16,"burnIn":0.3,"staticNoise":0.03,"rasterization":0,"screenCurvature":0.1,"windowOpacity":1,"chromaColor":1,"saturationColor":0,"rbgShift":0.35,"fontWidth":1.0,"useCustomCommand":false,"customCommand":""}'
-             builtin: true
--        }
-+        }*/
-         ListElement{
-             text: "IBM 3278"
-             obj_string: '{"ambientLight":0.1,"backgroundColor":"#000000","bloom":0.15,"brightness":0.5,"flickering":0,"contrast":0.85,"fontName":"IBM_3278","fontColor":"#0ccc68","frameName":"SIMPLE_WHITE_FRAME","glowingLine":0,"horizontalSync":0,"jitter":0,"burnIn":0.6,"staticNoise":0,"rasterization":0,"screenCurvature":0.1,"windowOpacity":1,"chromaColor":0,"saturationColor":0,"rbgShift":0,"fontWidth":1.0,"useCustomCommand":false,"customCommand":""}'
-diff --git a/app/qml/FontPixels.qml b/app/qml/FontPixels.qml
-index 6ff85da..6f0d0ba 100644
---- a/app/qml/FontPixels.qml
-+++ b/app/qml/FontPixels.qml
-@@ -32,7 +32,7 @@ QtObject{
-     property bool lowResolutionFont: true
- 
-     property ListModel fontlist: ListModel{
--        ListElement{
-+        /*ListElement{
-             name: "COMMODORE_PET"
-             text: "Commodore PET (1977)"
-             source: "fonts/1977-commodore-pet/COMMODORE_PET.ttf"
-@@ -40,7 +40,7 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.8
--        }
-+        }*/
-         ListElement{
-             name: "PROGGY_TINY"
-             text: "Proggy Tiny (Modern)"
-@@ -68,7 +68,7 @@ QtObject{
-             baseScaling: 3.0
-             fontWidth: 1.0
-         }
--        ListElement{
-+        /*ListElement{
-             name: "APPLE_II"
-             text: "Apple ][ (1977)"
-             source: "fonts/1977-apple2/PrintChar21.ttf"
-@@ -76,8 +76,8 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.9
--        }
--        ListElement{
-+        }*/
-+        /*ListElement{
-             name: "ATARI_400"
-             text: "Atari 400-800 (1979)"
-             source: "fonts/1979-atari-400-800/ATARI400800_original.TTF"
-@@ -85,8 +85,8 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.8
--        }
--        ListElement{
-+        }*/
-+        /*ListElement{
-             name: "COMMODORE_64"
-             text: "Commodore 64 (1982)"
-             source: "fonts/1982-commodore64/C64_Pro_Mono_v1.0-STYLE.ttf"
-@@ -94,6 +94,6 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.8
--        }
-+        }*/
-     }
- }
-diff --git a/app/qml/FontScanlines.qml b/app/qml/FontScanlines.qml
-index eebf00b..410d7b6 100644
---- a/app/qml/FontScanlines.qml
-+++ b/app/qml/FontScanlines.qml
-@@ -32,7 +32,7 @@ QtObject{
-     property bool lowResolutionFont: true
- 
-     property ListModel fontlist: ListModel{
--        ListElement{
-+        /*ListElement{
-             name: "COMMODORE_PET"
-             text: "Commodore PET (1977)"
-             source: "fonts/1977-commodore-pet/COMMODORE_PET.ttf"
-@@ -40,7 +40,7 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.7
--        }
-+        }*/
-         ListElement{
-             name: "PROGGY_TINY"
-             text: "Proggy Tiny (Modern)"
-@@ -68,7 +68,7 @@ QtObject{
-             baseScaling: 3.0
-             fontWidth: 1.0
-         }
--        ListElement{
-+        /*ListElement{
-             name: "APPLE_II"
-             text: "Apple ][ (1977)"
-             source: "fonts/1977-apple2/PrintChar21.ttf"
-@@ -76,8 +76,8 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.8
--        }
--        ListElement{
-+        }*/
-+        /*ListElement{
-             name: "ATARI_400"
-             text: "Atari 400-800 (1979)"
-             source: "fonts/1979-atari-400-800/ATARI400800_original.TTF"
-@@ -85,8 +85,8 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.7
--        }
--        ListElement{
-+        }*/
-+        /*ListElement{
-             name: "COMMODORE_64"
-             text: "Commodore 64 (1982)"
-             source: "fonts/1982-commodore64/C64_Pro_Mono_v1.0-STYLE.ttf"
-@@ -94,6 +94,6 @@ QtObject{
-             pixelSize: 8
-             baseScaling: 4.0
-             fontWidth: 0.7
--        }
-+        }*/
-     }
- }
-diff --git a/app/qml/Fonts.qml b/app/qml/Fonts.qml
-index ad20844..882808a 100644
---- a/app/qml/Fonts.qml
-+++ b/app/qml/Fonts.qml
-@@ -80,7 +80,7 @@
-             fontWidth: 1.0
-             lowResolutionFont: true
-         }
--        ListElement{
-+        /*ListElement{
-             name: "COMMODORE_PET_SCALED"
-             text: "Commodore PET (1977)"
-             source: "fonts/1977-commodore-pet/COMMODORE_PET.ttf"
-@@ -89,7 +89,7 @@
-             baseScaling: 3.5
-             fontWidth: 0.7
-             lowResolutionFont: true
--        }
-+        }*/
-         ListElement{
-             name: "PROGGY_TINY_SCALED"
-             text: "Proggy Tiny (Modern)"
-@@ -100,7 +100,7 @@
-             fontWidth: 0.9
-             lowResolutionFont: true
-         }
--        ListElement{
-+        /*ListElement{
-             name: "APPLE_II_SCALED"
-             text: "Apple ][ (1977)"
-             source: "fonts/1977-apple2/PrintChar21.ttf"
-@@ -149,7 +149,7 @@
-             baseScaling: 2.0
-             fontWidth: 1.0
-             lowResolutionFont: true
--        }
-+        }*/
-         ListElement{
-             name: "HERMIT"
-             text: "HD: Hermit (Modern)"
-@@ -177,7 +177,7 @@
-             fontWidth: 1.0
-             lowResolutionFont: false
-         }
--        ListElement{
-+        /*ListElement{
-             name: "MONACO"
-             text: "HD: Monaco (Modern)"
-             source: "fonts/modern-monaco/monaco.ttf"
-@@ -185,7 +185,7 @@
-             pixelSize: 30
-             fontWidth: 1.0
-             lowResolutionFont: false
--        }
-+        }*/
-         ListElement{
-             name: "INCONSOLATA"
-             text: "HD: Inconsolata (Modern)"
diff --git a/gnu/packages/terminals.scm b/gnu/packages/terminals.scm
index 6f3453670..e8b035720 100644
--- a/gnu/packages/terminals.scm
+++ b/gnu/packages/terminals.scm
@@ -440,11 +440,11 @@ embedded kernel situations.")
     (license license:expat)))
 
 (define-public cool-retro-term
-  (let ((commit "e48719fa44e5307df71dbd0fad234f8a6a53f863")
+  (let ((commit "dd799cf5c0eda92cf44f3938c0c2dcae5651a99e")
         (revision "1"))
     (package
       (name "cool-retro-term")
-      (version (string-append "1.0.0-" revision "." (string-take commit 7)))
+      (version (string-append "1.0.1-" revision "." (string-take commit 7)))
       (source (origin
                 (method git-fetch)
                 (file-name (string-append name "-" version "-checkout"))
@@ -453,34 +453,111 @@ embedded kernel situations.")
                       (commit commit)
                       (recursive? #t)))
                 (sha256
-                 (base32 "1sgqbirninkvgwchr35zgn5vzqvsmrf3cp7lqady1xgrawb8lsz3"))
+                 (base32 "08mrvj8zk9ck15q90ipjzza1acnnsjhprv2rxg8yyck0xl9p40jd"))
                 (patches
-                 (search-patches "cool-retro-term-remove-non-free-fonts.patch"
-                                 "cool-retro-term-fix-array-size.patch"
+                 (search-patches "cool-retro-term-fix-array-size.patch"
                                  "cool-retro-term-dont-check-uninit-member.patch"
                                  "cool-retro-term-memory-leak-1.patch"))
-                (modules '((guix build utils)))
+                (modules '((guix build utils)
+                           (srfi srfi-1)
+                           (srfi srfi-26)
+                           (ice-9 rdelim)
+                           (ice-9 regex)))
                 (snippet
-                 '(for-each (lambda (font)
-                              (delete-file-recursively
-                               (string-append "app/qml/fonts/" font))
-                              (substitute* '("app/qml/resources.qrc")
-                                (((string-append "<file>fonts/" font ".*"))
-                                 "")))
-                            '(;"1971-ibm-3278"     ; BSD 3-clause
-                              "1977-apple2"        ; Non-Free
-                              "1977-commodore-pet" ; Non-Free
-                              "1979-atari-400-800" ; Non-Free
-                              "1982-commodore64"   ; Non-Free
-                              "1985-atari-st"      ; ?
-                              "1985-ibm-pc-vga"    ; Unclear
-                              ;"modern-fixedsys-excelsior" ; Redistributable
-                              ;"modern-hermit"     ; SIL
-                              ;"modern-inconsolata"; SIL
-                              ;"modern-pro-font-win-tweaked" ; X11
-                              ;"modern-proggy-tiny"; X11
-                              ;"modern-terminus"   ; SIL
-                              "modern-monaco"))))) ; Apple non-free
+                 '(let* ((fonts '(;"1971-ibm-3278"     ; BSD 3-clause
+                                  ;"1975-knight-tv"    ; GPL
+                                  "1977-apple2"        ; Non-Free
+                                  "1977-commodore-pet" ; Non-Free
+                                  "1979-atari-400-800" ; Non-Free
+                                  "1982-commodore64"   ; Non-Free
+                                  "1985-atari-st"      ; ?
+                                  "1985-ibm-pc-vga"    ; Unclear
+                                  ;"modern-fixedsys-excelsior" ; Redistributable
+                                  ;"modern-hermit"     ; SIL
+                                  ;"modern-inconsolata"; SIL
+                                  ;"modern-pro-font-win-tweaked" ; X11
+                                  ;"modern-proggy-tiny"; X11
+                                  ;"modern-terminus"   ; SIL
+                                  "modern-monaco"))    ; Apple Non-Free
+                         (name-rx (make-regexp " *name: *\"([^\"]*)\""))
+                         (source-rx (make-regexp " *source: \"fonts/([^/]*)[^\"]*\""))
+                         (fontname-rx (make-regexp "\"fontName\":\"([^\"]*).*"))
+                         (names
+                          ;; Gather font names from all Fonts*.qml files.
+                          ;; These will be used to remove items from the
+                          ;; default profiles.
+                          (fold
+                           (lambda (font-file names)
+                             (call-with-input-file font-file
+                               (lambda (port)
+                                 (let loop ((name #f) (names names))
+                                   (let ((line (read-line port)))
+                                     (cond
+                                      ((eof-object? line) (pk 'names names))
+                                      ((regexp-exec name-rx line)
+                                       => (lambda (m)
+                                            (loop (match:substring m 1) names)))
+                                      ((regexp-exec source-rx line)
+                                       => (lambda (m)
+                                            (let ((font (match:substring m 1)))
+                                              (if (member font fonts)
+                                                  (loop #f (lset-adjoin string=?
+                                                                        names name))
+                                                  (loop #f names)))))
+                                      (else (loop name names))))))))
+                           '() (find-files "app/qml" "Font.*\\.qml"))))
+                    ;; Remove the font files themselves
+                    (for-each (lambda (font)
+                                (delete-file-recursively
+                                 (string-append "app/qml/fonts/" font)))
+                              fonts)
+                    ;; Remove mention of those fonts in the source
+                    (substitute* "app/qml/resources.qrc"
+                      (((string-append " *<file>fonts/("
+                                       (string-join fonts "|")
+                                       ").*"))
+                       ""))
+                    (for-each
+                     (lambda (file)
+                       (let ((start-rx (make-regexp " *ListElement\\{"))
+                             (end-rx   (make-regexp " *\\}")))
+                        (with-atomic-file-replacement file
+                          (lambda (in out)
+                            (let loop ((line-buffer '())
+                                       (hold? #f)
+                                       (discard? #f))
+                              (let ((line (read-line in 'concat)))
+                                (cond
+                                 ((eof-object? line) #t) ;done
+                                 ((regexp-exec start-rx line)
+                                  (loop (cons line line-buffer) #t #f))
+                                 ((or (regexp-exec source-rx line)
+                                      (regexp-exec fontname-rx line))
+                                  => (lambda (m)
+                                       (let ((font-or-name (match:substring m 1)))
+                                         (if (or (member font-or-name fonts)
+                                                 (member font-or-name names))
+                                             (loop '() #f #t)
+                                             (loop (cons line line-buffer)
+                                                   hold? #f)))))
+                                 ((regexp-exec end-rx line)
+                                  (unless discard?
+                                          (for-each (cut display <> out)
+                                                    (reverse line-buffer))
+                                          (display line out))
+                                  (loop '() #f #f))
+                                 (hold? (loop (cons line line-buffer)
+                                              hold? discard?))
+                                 (discard? (loop line-buffer #f #t))
+                                 (else (display line out)
+                                       (loop '() #f #f)))))))))
+                     '("app/qml/FontPixels.qml"
+                       "app/qml/FontScanlines.qml"
+                       "app/qml/Fonts.qml"
+                       "app/qml/ApplicationSettings.qml"))
+                    ;; Final substitution for default scanline and pixel fonts
+                    (substitute* "app/qml/ApplicationSettings.qml"
+                      (("COMMODORE_PET") "PROGGY_TINY"))))))
       (build-system gnu-build-system)
       (inputs
        `(("qtbase" ,qtbase)
@@ -492,46 +569,37 @@ embedded kernel situations.")
          (modify-phases %standard-phases
            (replace 'configure
              (lambda* (#:key outputs #:allow-other-keys)
-               (let* ((out (assoc-ref outputs "out"))
-                      (share (string-append out "/share")))
+               (let ((out (assoc-ref outputs "out")))
                  (substitute* '("qmltermwidget/qmltermwidget.pro")
                    (("INSTALL_DIR = \\$\\$\\[QT_INSTALL_QML\\]")
                     (string-append "INSTALL_DIR = " out "/lib/qt5/qml")))
-                 (substitute* '("app/app.pro")
-                   (("target.path \\+= /usr")
-                    (string-append "target.path += " out))
-                   (("icon32.path = /usr/share")
-                    (string-append "icon32.path = " share))
-                   (("icon64.path = /usr/share")
-                    (string-append "icon64.path = " share))
-                   (("icon128.path = /usr/share")
-                    (string-append "icon128.path = " share))
-                   (("icon256.path = /usr/share")
-                    (string-append "icon256.path = " share)))
-                 (zero? (system* "qmake")))))
-           (add-before 'install 'fix-Makefiles
-             (lambda* (#:key outputs #:allow-other-keys)
-               (let* ((out (assoc-ref outputs "out")))
-                 (substitute* '("Makefile")
-                   (("\\$\\(INSTALL_ROOT\\)/usr") out)))))
+                 (substitute* '("cool-retro-term.pro" "app/app.pro")
+                   (("/usr") out))
+                 (invoke "qmake"))))
            (add-after 'install 'wrap-executable
              (lambda* (#:key inputs outputs #:allow-other-keys)
-               (let* ((out (assoc-ref outputs "out"))
-                      (qml "/lib/qt5/qml"))
+               (let ((out (assoc-ref outputs "out"))
+                     (qml "/lib/qt5/qml"))
                  (wrap-program (string-append out "/bin/cool-retro-term")
                    `("QML2_IMPORT_PATH" ":" prefix
                      (,(string-append out qml)
-                      ,(string-append
-                        (assoc-ref inputs "qtdeclarative") qml)
-                      ,(string-append
-                        (assoc-ref inputs "qtgraphicaleffects") qml)
-                      ,(string-append
-                        (assoc-ref inputs "qtquickcontrols") qml)))))))
+                      ,@(map (lambda (i)
+                               (string-append (assoc-ref inputs i) qml))
+                             '("qtdeclarative"
+                               "qtgraphicaleffects"
+                               "qtquickcontrols")))))
+                 #t)))
            (add-after 'install 'add-alternate-name
              (lambda* (#:key outputs #:allow-other-keys)
-               (let* ((bin (string-append (assoc-ref outputs "out") "/bin")))
+               (let ((bin (string-append (assoc-ref outputs "out") "/bin")))
                  (symlink (string-append bin "/cool-retro-term")
-                          (string-append bin "/crt"))))))))
+                          (string-append bin "/crt")))))
+           (add-after 'install 'install-man
+             (lambda* (#:key outputs #:allow-other-keys)
+               (let ((mandir (string-append (assoc-ref outputs "out")
+                                            "/share/man/man1")))
+                 (install-file "packaging/debian/cool-retro-term.1" mandir)
+                 #t))))))
       (synopsis "Terminal emulator")
       (description
        "Cool-retro-term (crt) is a terminal emulator which mimics the look and
-- 
2.16.2