sway.scm 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
  3. ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
  4. ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
  5. ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
  6. ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
  7. ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
  8. ;;;
  9. ;;; This file is part of GNU Guix.
  10. ;;;
  11. ;;; GNU Guix is free software; you can redistribute it and/or modify
  12. ;;; it under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation, either version 3 of the License, or
  14. ;;; (at your option) any later version.
  15. ;;;
  16. ;;; GNU Guix is distributed in the hope that it will be useful,
  17. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; You should have received a copy of the GNU General Public License
  22. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  23. ;; I can use man 5 sway to learn more about the config file format
  24. ;; You can run sway directly from a tty, or via a Wayland-compatible login manager.
  25. ;; CONFIGURATION
  26. ;; sway searches for a config file in the following locations, in this order:
  27. ;; 1. ~/.sway/config
  28. ;; 2. $XDG_CONFIG_HOME/sway/config (suggested location)
  29. ;; 3. ~/.i3/config
  30. ;; 4. $XDG_CONFIG_HOME/i3/config
  31. ;; 5. /etc/sway/config
  32. ;; 6. /etc/i3/config
  33. ;;
  34. ;; or sway -c specifies a config file
  35. (define-module (gnu services sway)
  36. #:use-module (guix gexp)
  37. #:use-module (guix records)
  38. #:use-module (guix packages)
  39. #:use-module (gnu packages admin)
  40. ;; #:autoload (gnu packages ci) (cuirass)
  41. ;; #:autoload (gnu packages version-control) (git)
  42. #:use-module (gnu packages wm)
  43. #:use-module (gnu services)
  44. #:use-module (gnu services base)
  45. #:use-module (gnu services shepherd)
  46. #:use-module (gnu services dbus)
  47. #:use-module (gnu services admin)
  48. #:use-module (gnu system shadow)
  49. #:use-module (ice-9 match)
  50. #:use-module (srfi srfi-1)
  51. #:export (
  52. sway-configuration
  53. sway-configuration?
  54. sway-configuration-sway
  55. sway-configuration-user
  56. sway-configuration-group
  57. sway-configuration-sway-variables
  58. sway-configuration-bindsyms
  59. sway-configuration-raw-content
  60. sway-configuration-file
  61. sway-variables-configuration
  62. sway-variables-configuration?
  63. sway-variables-configuration-background-image
  64. sway-variables-configuration-mod-key
  65. sway-variables-configuration-letter-left
  66. sway-variables-configuration-letter-down
  67. sway-variables-configuration-letter-up
  68. sway-variables-configuration-letter-right
  69. sway-variables-configuration-default-terminal
  70. sway-variables-configuration-application-launcher
  71. sway-variables-configuration-keyboard-layout
  72. sway-variables-configuration-xkb-options
  73. sway-variables-configuration-tap-to-click?
  74. sway-variables-configuration-natural-scroll?
  75. sway-variables-configuration-middle-emulation?
  76. ;; basic bindsyms
  77. %sway-basic-bindsyms
  78. ;; focus bindsyms
  79. %sway-focus-bindsyms
  80. ;; moving around bindsyms
  81. ;; maybe the below should just be a big list %switch-to-workspaces and
  82. ;; %move-container-to-workspaces
  83. %sway-moving-around-bindsyms
  84. ;; layout bindsyms
  85. %sway-layout-bindsyms
  86. ;; scratchpad bindsyms
  87. %sway-scratchpad-bindsyms
  88. ;; this is (flatten (list all the above %*-bindsyms)
  89. %sway-bindsyms
  90. sway-bindsym
  91. sway-bindsym?
  92. sway-bindsym-whole-window
  93. sway-bindsym-border
  94. sway-bindsym-exclude-titlebar
  95. sway-bindsym-release
  96. sway-bindsym-locked
  97. sway-bindsym-to-code
  98. sway-bindsym-input-device
  99. sway-bindsym-no-warm
  100. sway-bindsym-no-repeat
  101. sway-bindsym-group
  102. sway-bindsym-key-combo
  103. sway-bindsym-command
  104. sway-bindsym-command-arguments
  105. sway-status-bar-configuration
  106. sway-status-bar-configuration?
  107. sway-status-bar-position-configuration
  108. sway-status-bar-status-command-configuration
  109. sway-status-bar-status-line-color-configuration
  110. sway-status-bar-background-color-configuration
  111. sway-status-bar-inactive-workspace-colors-configuration
  112. ;; pango-markup-enabled? todo
  113. sway-service-type
  114. ))
  115. ;;;; Commentary:
  116. ;;; This file provides a shepherd service to run the sway window
  117. ;;; manager.
  118. ;;;; Code:
  119. (define-record-type* <sway-status-bar-configuration>
  120. sway-status-bar-configuration make-sway-status-bar-configuration
  121. sway-status-bar-configuration?
  122. (position sway-status-bar-configuration-position
  123. (default 'top))
  124. (status-command sway-status-bar-configuration-status-command
  125. (default "while date +'%Y-%m-%d %l:%M:%S %p'; do sleep 1; done"))
  126. (pango-markup-enabled? sway-status-bar-configuration-pango-markup-enabled
  127. (default #f))
  128. (status-line-color sway-status-bar-configuration-status-line-color
  129. (default "#ffffff"))
  130. (background-color sway-status-bar-configuration-background-color
  131. (default "#323232"))
  132. (inactive-workspace-colors sway-status-bar-configuration-inactive-workspace-colors
  133. (default '("#32323200 #32323200 #5c5c5c"))))
  134. (define-record-type* <sway-variables-configuration>
  135. sway-variables-configuration make-sway-variables-configuration
  136. sway-variables?
  137. ;; TODO figure out how to set dimensions for desktop background image
  138. (background-image sway-variables-configuration-background-image
  139. (default "Sway_Wallpaper_Blue_1920x1080.png"))
  140. (mod-key sway-variables-configuration-mod
  141. (default "Mod4"))
  142. ;; direction letters
  143. (letter-left sway-variables-configuration-left
  144. (default "h"))
  145. (letter-right sway-variables-configuration-right
  146. (default "l"))
  147. (letter-up sway-variables-configuration-up
  148. (default "k"))
  149. (letter-down sway-variables-configuration-down
  150. (default "j"))
  151. ;; TODO set this default up to be a terminal name
  152. (default-terminal sway-variables-configuration-default-terminal
  153. (default "urxvt")) ;; TODO make this a package object
  154. ;; set this to dmenu or whatever I am using now
  155. (application-launcher sway-variables-configuration-application-launcher
  156. (default "dmenu")) ;; TODO SET to package object
  157. ;; TODO get this layout from the OS keyboard layout record
  158. (keyboard-layout sway-variables-configuration-keyboard-layouts ;;list of strings keyboard layouts that you want to use
  159. (default '()))
  160. (xkb-options sway-variables-configuration-xkb-options ;;list of strings of xkb-options that you want like "ctrl:swapcaps"
  161. (default '()))
  162. (tap-to-click? sway-variables-configuration-tap-to-click?
  163. (default #f))
  164. (natural-scroll? sway-variables-configuration-natural-scroll?
  165. (default #t))
  166. (middle-emulation? sway-variables-configuration-middle-emulation?
  167. (default #f)))
  168. (define-record-type* <sway-bindsym>
  169. sway-bindsym make-sway-bindsym
  170. sway-bindsym?
  171. (whole-window sway-bindsym-whole-window
  172. (default #f))
  173. (border sway-bindsym-border
  174. (default #f))
  175. (exclude-titlebar sway-bindsym-exclude-titlebar
  176. (default #f))
  177. (release sway-bindsym-release
  178. (default #f))
  179. (locked sway-bindsym-locked
  180. (default #f))
  181. (to-code sway-bindsym-to-code
  182. (default #f))
  183. (input-device sway-bindsym-input-device
  184. (default #nil))
  185. (no-warn sway-bindsym-no-warn
  186. (default #f))
  187. (no-repeat sway-bindsym-no-repeat
  188. (default #f))
  189. (group sway-bindsym-group
  190. (default #f))
  191. (key-combo sway-bindsym-key-combo
  192. (default ""))
  193. (command sway-bindsym-command ;string or <package>
  194. (default ""))
  195. (command-arguments sway-bindsym-arguments
  196. (default #f)))
  197. ;; basic bindsyms-configuration
  198. (define %sway-basic-bindsyms
  199. (list
  200. (sway-bindsym
  201. (key-combo "$mod+Return")
  202. (command "$term")) ;; set to launch default terminal
  203. (sway-bindsym
  204. (key-combo "$mod+Shift+q")
  205. (command "kill"))
  206. (sway-bindsym
  207. (key-combo "$mod+d")
  208. (command "$menu"))
  209. (sway-bindsym
  210. (key-combo "$mod normal")
  211. (command "normal"))
  212. (sway-bindsym
  213. (key-combo "$mod+Shift+c")
  214. (command "reload"))
  215. (sway-bindsym
  216. (key-combo "$mod+Shift+e")
  217. (command "reload"))))
  218. ;; moving around bindsyms-configuration
  219. (define %sway-moving-around-bindsyms
  220. (list
  221. (sway-bindsym
  222. (key-combo "$mod+$left")
  223. (command "focus left"))
  224. (sway-bindsym
  225. (key-combo "$mod+$down")
  226. (command "focus down"))
  227. (sway-bindsym
  228. (key-combo "$mod+$up")
  229. (command "focus up"))
  230. (sway-bindsym
  231. (key-combo "$mod+$right")
  232. (command "focus right"))
  233. (sway-bindsym
  234. (key-combo "$mod+Left")
  235. (command "focus left"))
  236. (sway-bindsym
  237. (key-combo "$mod+Down")
  238. (command "focus down"))
  239. (sway-bindsym
  240. (key-combo "$mod+Up")
  241. (command "focus up"))
  242. (sway-bindsym
  243. (key-combo "$mod+Right")
  244. (command "focus Right"))
  245. ;; Move the focused window with the same, but add Shift
  246. (sway-bindsym
  247. (key-combo "$mod+Shift+$left")
  248. (command "move left"))
  249. (sway-bindsym
  250. (key-combo "$mod+Shift+$down")
  251. (command "move down"))
  252. (sway-bindsym
  253. (key-combo "$mod+Shift+$up")
  254. (command "move up"))
  255. (sway-bindsym
  256. (key-combo "$mod+Shift+$right")
  257. (command "move right"))
  258. (sway-bindsym
  259. (key-combo "$mod+Shift+Left")
  260. (command "move left"))
  261. (sway-bindsym
  262. (key-combo "$mod+Shift+Down")
  263. (command "move down"))
  264. (sway-bindsym
  265. (key-combo "$mod+Shift+Up")
  266. (command "move up"))
  267. (sway-bindsym
  268. (key-combo "$mod+Shift+Right")
  269. (command "move Right"))))
  270. ;; workspace bindsyms-configuration
  271. (define %sway-workspace-bindsyms
  272. (list
  273. (sway-bindsym
  274. (key-combo "$mod+1")
  275. (command "workspace number 1"))
  276. (sway-bindsym
  277. (key-combo "$mod+1")
  278. (command "workspace number 2"))
  279. (sway-bindsym
  280. (key-combo "$mod+3")
  281. (command "workspace number 3"))
  282. (sway-bindsym
  283. (key-combo "$mod+4")
  284. (command "workspace number 4"))
  285. (sway-bindsym
  286. (key-combo "$mod+5")
  287. (command "workspace number 5"))
  288. (sway-bindsym
  289. (key-combo "$mod+6")
  290. (command "workspace number 6"))
  291. (sway-bindsym
  292. (key-combo "$mod+7")
  293. (command "workspace number 7"))
  294. (sway-bindsym
  295. (key-combo "$mod+8")
  296. (command "workspace number 8"))
  297. (sway-bindsym
  298. (key-combo "$mod+9")
  299. (command "workspace number 9"))
  300. (sway-bindsym
  301. (key-combo "$mod+10")
  302. (command "workspace number 10"))
  303. ;; Move focused container to workspace
  304. (sway-bindsym
  305. (key-combo "$mod+Shift+1")
  306. (command "move container to workspace 1"))
  307. (sway-bindsym
  308. (key-combo "$mod+Shift+2")
  309. (command "move container to workspace 2"))
  310. (sway-bindsym
  311. (key-combo "$mod+Shift+3")
  312. (command "move container to workspace 3"))
  313. (sway-bindsym
  314. (key-combo "$mod+Shift+4")
  315. (command "move container to workspace 4"))
  316. (sway-bindsym
  317. (key-combo "$mod+Shift+5")
  318. (command "move container to workspace 5"))
  319. (sway-bindsym
  320. (key-combo "$mod+Shift+6")
  321. (command "move container to workspace 6"))
  322. (sway-bindsym
  323. (key-combo "$mod+Shift+7")
  324. (command "move container to workspace 7"))
  325. (sway-bindsym
  326. (key-combo "$mod+Shift+8")
  327. (command "move container to workspace 8"))
  328. (sway-bindsym
  329. (key-combo "$mod+Shift+9")
  330. (command "move container to workspace 9"))
  331. (sway-bindsym
  332. (key-combo "$mod+Shift+10")
  333. (command "move container to workspace 10"))))
  334. ;; layout bindsyms-configuration
  335. (define %sway-layout-bindsyms
  336. (list
  337. (sway-bindsym
  338. (key-combo "$mod+b")
  339. (command "splith"))
  340. ;;bindsym $mod+b splith
  341. (sway-bindsym
  342. (key-combo "$mod+v")
  343. (command "splitv"))
  344. ;; Switch the current container between different layout styles
  345. (sway-bindsym
  346. (key-combo "$mod+s")
  347. (command "layout stacking"))
  348. (sway-bindsym
  349. (key-combo "$mod+w")
  350. (command "layout tabbed"))
  351. (sway-bindsym
  352. (key-combo "$mod+e")
  353. (command "layout toggle split"))
  354. ;; Make the current focus fullscreen
  355. (sway-bindsym
  356. (key-combo "$mod+f")
  357. (command "fullscreen"))
  358. ;; Toggle the current focus between tiling and floating mode
  359. (sway-bindsym
  360. (key-combo "$mod+Shift+space")
  361. (command "floating toggle"))
  362. ;; Swap focus between the tiling area and the floating area
  363. (sway-bindsym
  364. (key-combo "$mod+space")
  365. (command "focus mode_toggle"))
  366. ;; Move focus to the parent container
  367. (sway-bindsym
  368. (key-combo "$mod+a")
  369. (command "focus parent"))
  370. ;; Resizing containers:
  371. ;; TODO how am I handling resizing containers???
  372. ;; TODO let users edit "resize" variable so that they can modify how much each keypress
  373. ;; resizes containers.
  374. ;; this code is hardcoded into the service definition
  375. ;; mode "resize" {
  376. ;; # left will shrink the containers width
  377. ;; # right will grow the containers width
  378. ;; # up will shrink the containers height
  379. ;; # down will grow the containers height
  380. ;; bindsym $left resize shrink width 10px
  381. ;; bindsym $down resize grow height 10px
  382. ;; bindsym $up resize shrink height 10px
  383. ;; bindsym $right resize grow width 10px
  384. ;; # Ditto, with arrow keys
  385. ;; bindsym Left resize shrink width 10px
  386. ;; bindsym Down resize grow height 10px
  387. ;; bindsym Up resize shrink height 10px
  388. ;; bindsym Right resize grow width 10px
  389. ;; # Return to default mode
  390. ;; bindsym Return mode "default"
  391. ;; bindsym Escape mode "default"
  392. ;; }
  393. ;; bindsym $mod+r mode "resize"
  394. (sway-bindsym
  395. (key-combo "$mod+r")
  396. (command "\"resize\""))))
  397. ;; scratchpad bindsyms
  398. (define %sway-scratchpad-bindsyms
  399. (list
  400. (sway-bindsym
  401. (key-combo "$mod+Shift+minus")
  402. (command "move scratchpad"))
  403. ;; Show the next scratchpad window or hide the focused scratchpad window.
  404. ;; If there are multiple scratchpad windows, this command cycles through them.
  405. (sway-bindsym
  406. (key-combo "$mod+minus")
  407. (command "scratchpad show"))))
  408. (define (flatten . lst)
  409. "Return a list that recursively concatenates all sub-lists of LST."
  410. (define (flatten1 head out)
  411. (if (list? head)
  412. (fold-right flatten1 out head)
  413. (cons head out)))
  414. (fold-right flatten1 '() lst))
  415. (define %sway-bindsyms
  416. (flatten (list
  417. %sway-basic-bindsyms
  418. %sway-layout-bindsyms
  419. %sway-workspace-bindsyms
  420. %sway-moving-around-bindsyms
  421. %sway-scratchpad-bindsyms)))
  422. ;; FIX ME TODO (sway-configuration) causes an error.
  423. ;; BUT (sway-configuration (sway "sway")) works.
  424. ;; why does sway not evaluate to the sway package?
  425. (define-record-type* <sway-configuration>
  426. sway-configuration make-sway-configuration
  427. sway-configuration?
  428. ;; enable|disable
  429. (sway sway-configuration-package ;package
  430. (default sway))
  431. (user sway-configuration-user ;string
  432. (default "sway"))
  433. (group sway-configuration-group ;string
  434. (default "sway"))
  435. (variables sway-configuration-variables
  436. (default (sway-variables-configuration)))
  437. (bindsyms sway-configuration-bindsyms
  438. (default %sway-bindsyms))
  439. (status-bar sway-configuration-status-bar
  440. (default (sway-status-bar-configuration)))
  441. (raw-content sway-configuration-raw-content
  442. (default ""))
  443. (file sway-configuration-file ;file-like object
  444. (default #f)))
  445. (define emit-sway-variables-configuration
  446. (match-lambda
  447. (($ <sway-variables-configuration> background-image mod-key letter-left letter-down letter-up letter-right
  448. default-terminal application-launcher keyboard-layout xkb-options
  449. tap-to-click? natural-scroll? middle-emulation?)
  450. (list
  451. "### Variables\n"
  452. "# Logo key. Use Mod1 for Alt\n"
  453. "set $mod " mod-key "\n"
  454. "# Home row direction keys, like vim\n"
  455. "set $left " letter-left "\n"
  456. "set $down " letter-down "\n"
  457. "set $up " letter-up "\n"
  458. "set $right " letter-right "\n"
  459. "set $term " default-terminal "\n" ;;TODO potentially use a gexp to point to default-terminal package
  460. ;; TODO deal with application-launcher
  461. "### Output configuration\n"
  462. "# Default Wallpaper\n"
  463. "output * bg " background-image " fill\n" ;;TODO use a gexp to copy the background image into the store
  464. ;; TODO deal with swayidle and sway lock
  465. "### Input configuration\n"
  466. (cond [(or tap-to-click? natural-scroll? middle-emulation? (not (null? keyboard-layout))
  467. (not (null? xkb-options)))
  468. (list
  469. "input * " "{ \n"
  470. (if tap-to-click?
  471. "\t tap enabled\n"
  472. "")
  473. (if natural-scroll?
  474. "\t natural_scroll enabled\n"
  475. "")
  476. (if middle-emulation?
  477. "\t middle_emulation enabled\n"
  478. "")
  479. ;; TODO xkb-layout should be gotten from the keyboard layout,
  480. ;; which should specify it in the environment The keymap can
  481. ;; also be configured using environment variables
  482. ;; (XKB_DEFAULT_LAYOUT, XKB_DEFAULT_VARIANT, etc.) when starting
  483. ;; sway, with config options taking precedence over environment
  484. ;; variables.
  485. ;; TODO xkb-layout the arch linux wiki page shows
  486. ;; this https://wiki.archlinux.org/index.php/Sway#Keymap input *
  487. ;; { xkb_layout "us,de,ru" xkb_variant "colemak,,typewriter"
  488. ;; xkb_options "grp:win_space_toggle" }
  489. (cond [(not (null? xkb-options))
  490. (list
  491. "xkb_options "
  492. (substring (let loop ([list xkb-options])
  493. (cond [(null? list)
  494. ""]
  495. [else (string-append "," (car list)
  496. (loop (cdr list)))])) 1))]
  497. [else ""])
  498. "\n} \n" ;; end input
  499. )]
  500. [else ""])
  501. ))))
  502. ;; <sway-bindsym> -> string
  503. (define (emit-bindsym sway-bindsym)
  504. (string-append (sway-bindsym-key-combo sway-bindsym) " " (sway-bindsym-command sway-bindsym) "\n"))
  505. ;; list of <sway-bindsym> -> string
  506. (define (emit-list-of-bindsyms sway-bindsyms-list)
  507. (let loop ([sway-bindsyms-list (flatten sway-bindsyms-list)])
  508. (cond [(null? sway-bindsyms-list)
  509. '()]
  510. [else
  511. (let ([sway-bindsym (cond [(package? (sway-bindsym-command (car sway-bindsyms-list)))
  512. ;;TODO gexp <package> -> string /gnu/store/stahesunteah/bin/<package>
  513. ]
  514. [else (sway-bindsym-key-combo (car sway-bindsyms-list))])])
  515. (cons (string-append
  516. " " sway-bindsym "\n")
  517. (loop (cdr sway-bindsyms-list))))])))
  518. (define emit-sway-status-bar-configuration
  519. (match-lambda
  520. (($ <sway-status-bar-configuration> position status-command pango-markup-enabled?
  521. status-line-color background-color
  522. inactive-workspace-colors)
  523. (list
  524. "#\n"
  525. "# Status Bar:\n"
  526. "#\n"
  527. "# Read man 5 sway-bar-configuration for more information about this section."
  528. "bar {\n"
  529. "\t position " (symbol->string position) "\n"
  530. "\t # When the status_command prints a new line to stdout, swaybar updates.\n"
  531. "\t # The default just shows the current date and time.\n"
  532. "\t status_command " status-command "\n"
  533. "\t colors {\n"
  534. "\t\t statusline " status-line-color "\n"
  535. "\t\t background " background-color "\n"
  536. "\t\t inactive_workspace "
  537. (let loop ([list inactive-workspace-colors])
  538. (cond [(null? list)
  539. ""]
  540. [else (string-append (car list) " "
  541. (loop (cdr list)))]))
  542. "\n"
  543. "\t }\n"
  544. "}\n"
  545. ))))
  546. ;; TODO deal with a sway config-file
  547. (define emit-sway-configuration
  548. (match-lambda
  549. (($ <sway-configuration> sway user group sway-variables-configuration
  550. bindsyms sway-status-bar-configuration raw-content
  551. file)
  552. (flatten
  553. (list
  554. (emit-sway-variables-configuration sway-variables-configuration)
  555. (emit-list-of-bindsyms bindsyms)
  556. ;; Todo
  557. (emit-sway-status-bar-configuration sway-status-bar-configuration)
  558. )))))
  559. ;; Maybe put this code in a guix test?
  560. ;; (define config (sway-configuration
  561. ;; (variables
  562. ;; (sway-variables-configuration
  563. ;; (letter-left "n")
  564. ;; (letter-right "s")
  565. ;; (letter-up "t")
  566. ;; (letter-down "h")
  567. ;; (mod-key "Mod1")
  568. ;; (default-terminal "allcritty")
  569. ;; (xkb-options (list "ctrl:swapcaps"
  570. ;; "shift:breaks_caps"))))
  571. ;; (bindsyms
  572. ;; (list
  573. ;; %sway-basic-bindsyms
  574. ;; %sway-moving-around-bindsyms
  575. ;; (sway-bindsym (key-combo "$mod+Shift+Return")
  576. ;; (command "$term -e fish"))))
  577. ;; (status-bar
  578. ;; (sway-status-bar-configuration
  579. ;; (status-command "echo 'hello world!'")
  580. ;; (status-line-color "blue")
  581. ;; (inactive-workspace-colors (list "red" "green" "yellow"))))))
  582. ;;
  583. ;; (display (let loop ([list (emit-sway-configuration config)])
  584. ;; (cond [(null? list)
  585. ;; ""]
  586. ;; [else (string-append (car list)
  587. ;; (loop (cdr list)))])))
  588. (define (default-sway-config config)
  589. (match-record
  590. config
  591. <sway-configuration>
  592. (sway user group variables bindsyms status-bar raw-content file)
  593. (apply mixed-text-file "config.in"
  594. (emit-sway-configuration config))))
  595. (define (sway-activation config)
  596. (match-record config
  597. <sway-configuration>
  598. (sway file)
  599. #~(begin
  600. (use-modules (guix build utils))
  601. ;; (format #t "creating nginx log directory '~a'~%" #$log-directory)
  602. ;; (mkdir-p #$log-directory)
  603. ;; Start-up logs. Once configuration is loaded, nginx switches to
  604. ;; log-directory.
  605. ;; do something with recording sway's logs.
  606. ;;(mkdir-p (string-append #$run-directory "/logs"))
  607. ;; Check configuration file syntax.
  608. (system* (string-append #$sway "/bin/sway")
  609. "-c" #$(or file
  610. (default-sway-config config))
  611. ;; "-p" #$run-directory
  612. "-t"))))
  613. (define (sway-shepherd-service config)
  614. "Return a <shepherd-service> for the Sway service with CONFIG."
  615. (let* ([sway (sway-configuration-sway config)]
  616. [user (sway-configuration-sway config)]
  617. [group (sway-configuration-sway group)]
  618. [file (sway-configuration-sway file)])
  619. (list (shepherd-service
  620. (documentation "Run Sway.")
  621. (provision '(sway))
  622. (requirement '(user-processes dbus-system elogind udev virtual-terminal syslogd))
  623. ;;(requirement '(guix-daemon networking))
  624. (start #~(make-forkexec-constructor
  625. ;; TODO change this line to
  626. ;; exec dbus-run-session sway
  627. (list (string-append #$sway "/bin/sway")
  628. '("-c") file)
  629. ;; #:environment-variables
  630. ;; (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
  631. ;; (string-append "GIT_EXEC_PATH=" #$git
  632. ;; "/libexec/git-core"))
  633. #:user #$user
  634. #:group #$group
  635. ;;#:log-file #$log-file
  636. ))
  637. (stop #~(make-kill-destructor
  638. (list (string-append #$sway "/bin/swaymsg"
  639. '("exit")))))))))
  640. (define sway-service-type
  641. (service-type
  642. (name 'sway)
  643. (extensions
  644. (list
  645. ;; (service-extension profile-service-type ;for 'info sway'
  646. ;; (compose list sway-configuration-sway shepherd-root-service-type))
  647. (service-extension polkit-service-type sway-service-type)
  648. ;; all gnome, xfce, mate, use this profile-service-type, which I'm guessing means
  649. ;; to start the service after the user has logged in.
  650. (service-extension profile-service-type
  651. (compose list sway-configuration-package))
  652. ;; activation service type is a procedure that returns a gexp which is a code snippet to run at
  653. ;; activation time. example at boot
  654. (service-extension activation-service-type sway-activation)
  655. ;;(service-extension account-service-type sway-account)
  656. ;; if people define %desktop-services, then we don't need it.
  657. ;; if this service goes in the services/wm.scm, include elogind
  658. ;;(service-extension elogind-service-type)
  659. ))
  660. (default-value (sway-configuration))
  661. (description "Run the sway window manager.")))