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 | #:export (hexchat-configuration |
25 | hexchat-configuration-servlist |
26 | hexchat-configuration-log-dir |
27 | hexchat-configuration-scrollback-dir |
28 | |
29 | hexchat-server |
30 | hexchat-server-name |
31 | hexchat-server-identities |
32 | hexchat-server-real-name |
33 | hexchat-server-encoding |
34 | hexchat-server-servers |
35 | hexchat-server-flags |
36 | |
37 | hexchat-home)) |
38 | |
39 | (define-record-type* <hexchat-server> |
40 | hexchat-server make-hexchat-server |
41 | hexchat-server? |
42 | (name hexchat-server-name) |
43 | (identities hexchat-server-identities |
44 | (default '())) |
45 | (real-name hexchat-server-real-name |
46 | (default #f)) |
47 | (encoding hexchat-server-encoding |
48 | (default 'utf8)) |
49 | (servers hexchat-server-servers) |
50 | (flags hexchat-server-flags |
51 | (default '(cycle global honor-proxy)))) |
52 | |
53 | |
54 | (define (generate-hexchat-servlist servers) |
55 | (define (generate-encoding encoding) |
56 | (match encoding |
57 | ((? string? e) e) |
58 | ('utf8 "UTF-8 (Unicode)") |
59 | ('UTF8 "UTF-8 (Unicode)") |
60 | ('utf-8 "UTF-8 (Unicode)") |
61 | ('UTF-8 "UTF-8 (Unicode)"))) |
62 | (define (generate-flags flags) |
63 | (apply + 0 0 |
64 | ;; Values according to src/common/servlist.h |
65 | (map (lambda (f) |
66 | (match f |
67 | ('cycle 1) |
68 | ('global 2) |
69 | ('ssl 4) |
70 | ('auto-connect 8) |
71 | ('honor-proxy 16) |
72 | ('allow-invalid-certificates 32) |
73 | ('favorite 64))) |
74 | flags))) |
75 | (define (generate-hexchat-server server) |
76 | (match server |
77 | (($ <hexchat-server> name identities real-name encoding servers flags) |
78 | (apply |
79 | string-append |
80 | "N=" name "\n" |
81 | (match identities |
82 | ('() "") |
83 | ((I) (string-append "I=" I "\n")) |
84 | ((I i) (string-append "I=" I "\n" "i=" i "\n"))) |
85 | (if real-name |
86 | (string-append "R=" real-name "\n") |
87 | "") |
88 | "E=" (generate-encoding encoding) "\n" |
89 | "F=" (number->string (generate-flags flags)) "\n" |
90 | (map |
91 | (lambda (server) |
92 | (string-append "S=" server "\n")) |
93 | servers))))) |
94 | (string-join (map generate-hexchat-server servers) "\n")) |
95 | |
96 | (define-record-type* <hexchat-configuration> |
97 | hexchat-configuration make-hexchat-configuration |
98 | hexchat-configuration? |
99 | (servlist hexchat-configuration-servlist) |
100 | (log-dir hexchat-configuration-log-dir) |
101 | (scrollback-dir hexchat-configuraton-scrollback-dir)) |
102 | |
103 | (define (hexchat-home config) |
104 | (computed-file "hexchat-home" |
105 | (match config |
106 | (($ <hexchat-configuration> servlist log-dir scrollback-dir) |
107 | #~(let ((servlist.conf #$(plain-file "servlist.conf" (generate-hexchat-servlist servlist))) |
108 | (hexchat-dir (string-append #$output "/.config/hexchat"))) |
109 | (use-modules (guix build utils)) |
110 | (mkdir-p hexchat-dir) |
111 | (symlink #$log-dir (string-append hexchat-dir "/logs")) |
112 | (symlink #$scrollback-dir (string-append hexchat-dir "/scrollback")) |
113 | (copy-file servlist.conf (string-append hexchat-dir "/servlist.conf"))))) |
114 | #:options |
115 | '(#:local-build? #t |
116 | #:modules ((guix build utils))))) |