guix-home-manager/home/hexchat.scm

hexchat.scm

1
;;; Guix Home Manager.
2
;;;
3
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
4
;;;
5
;;; This program is free software: you can redistribute it and/or modify
6
;;; it under the terms of the GNU General Public License as published by
7
;;; the Free Software Foundation, either version 3 of the License, or
8
;;; (at your option) any later version.
9
;;;
10
;;; This program is distributed in the hope that it will be useful,
11
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
;;; GNU General Public License for more details.
14
;;;
15
;;; You should have received a copy of the GNU General Public License
16
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18
(define-module (home hexchat)
19
  #:use-module (guix build utils)
20
  #:use-module (guix gexp)
21
  #:use-module (guix records)
22
  #:use-module (gnu packages lxde)
23
  #:use-module (ice-9 match)
24
  #:use-module (home)
25
  #:export (hexchat-configuration
26
            hexchat-configuration-servlist
27
            hexchat-configuration-log-dir
28
            hexchat-configuration-scrollback-dir
29
30
            hexchat-server
31
            hexchat-server-name
32
            hexchat-server-identities
33
            hexchat-server-real-name
34
            hexchat-server-encoding
35
            hexchat-server-servers
36
            hexchat-server-flags
37
38
            hexchat-home-type))
39
40
(define-record-type* <hexchat-server>
41
  hexchat-server make-hexchat-server
42
  hexchat-server?
43
  (name       hexchat-server-name)
44
  (identities hexchat-server-identities
45
              (default '()))
46
  (real-name  hexchat-server-real-name
47
              (default #f))
48
  (encoding   hexchat-server-encoding
49
              (default 'utf8))
50
  (servers    hexchat-server-servers)
51
  (flags      hexchat-server-flags
52
              (default '(cycle global honor-proxy))))
53
54
55
(define (generate-hexchat-servlist servers)
56
  (define (generate-encoding encoding)
57
    (match encoding
58
      ((? string? e) e)
59
      ('utf8 "UTF-8 (Unicode)")
60
      ('UTF8 "UTF-8 (Unicode)")
61
      ('utf-8 "UTF-8 (Unicode)")
62
      ('UTF-8 "UTF-8 (Unicode)")))
63
  (define (generate-flags flags)
64
    (apply + 0 0
65
      ;; Values according to src/common/servlist.h
66
      (map (lambda (f)
67
             (match f
68
               ('cycle 1)
69
               ('global 2)
70
               ('ssl 4)
71
               ('auto-connect 8)
72
               ('honor-proxy 16)
73
               ('allow-invalid-certificates 32)
74
               ('favorite 64)))
75
           flags)))
76
  (define (generate-hexchat-server server)
77
    (match server
78
      (($ <hexchat-server> name identities real-name encoding servers flags)
79
       (apply
80
         string-append
81
         "N=" name "\n"
82
         (match identities
83
           ('() "")
84
           ((I) (string-append "I=" I "\n"))
85
           ((I i) (string-append "I=" I "\n" "i=" i "\n")))
86
         (if real-name
87
             (string-append "R=" real-name "\n")
88
             "")
89
         "E=" (generate-encoding encoding) "\n"
90
         "F=" (number->string (generate-flags flags)) "\n"
91
         (map
92
           (lambda (server)
93
             (string-append "S=" server "\n"))
94
           servers)))))
95
  (string-join (map generate-hexchat-server servers) "\n"))
96
97
(define-record-type* <hexchat-configuration>
98
  hexchat-configuration make-hexchat-configuration
99
  hexchat-configuration?
100
  (servlist       hexchat-configuration-servlist)
101
  (log-dir        hexchat-configuration-log-dir)
102
  (scrollback-dir hexchat-configuraton-scrollback-dir))
103
104
(define hexchat-home-type
105
  (home-type
106
    (name 'hexchat)
107
    (extensions
108
      (list
109
        (home-extension
110
          (target root-home-type)
111
          (compute
112
            (lambda (config)
113
              (match config
114
                (($ <hexchat-configuration> servlist log-dir scrollback-dir)
115
                 (let ((servlist.conf (plain-file "servlist.conf" (generate-hexchat-servlist servlist))))
116
                   `((".config/hexchat/servlist.conf" ,servlist.conf)
117
                     (".config/hexchat/logs" ,log-dir)
118
                     (".config/hexchat/scrollback" ,scrollback-dir))))))))))))
119