|
| 1 | +#!/usr/bin/env cl |
| 2 | + |
| 3 | +(load "~/quicklisp/setup.lisp") |
| 4 | +(ql:quickload "uiop") |
| 5 | + |
| 6 | +(defun string-to-list (input-string char) |
| 7 | + "Converts a string containing NewLine characters into a list of strings." |
| 8 | + (let* ((temp-chars '()) |
| 9 | + (items '())) |
| 10 | + (labels ((to-string (chars) |
| 11 | + (coerce (reverse chars) 'string)) |
| 12 | + (collect-item () |
| 13 | + (push (to-string temp-chars) items) |
| 14 | + (setf temp-chars '()))) |
| 15 | + (mapc (lambda (c) |
| 16 | + (cond ((eql c char) (collect-item)) |
| 17 | + (t (push c temp-chars)))) |
| 18 | + (coerce input-string 'list)) |
| 19 | + (collect-item) |
| 20 | + (reverse items)))) |
| 21 | + |
| 22 | +(defun get-result-from-system (command-string) |
| 23 | + "Gets the result of execution of the supplied command string in the |
| 24 | +underlying system." |
| 25 | + (uiop:run-program command-string |
| 26 | + :output '(:string :stripped t) |
| 27 | + :error-output t |
| 28 | + :ignore-error-status t)) |
| 29 | + |
| 30 | +(defun get-list-from-system (command-string) |
| 31 | + "Executes the supplied command string in the underlying system and returns |
| 32 | +a list." |
| 33 | + (string-to-list (get-result-from-system command-string) |
| 34 | + #\Newline)) |
| 35 | + |
| 36 | +(defun execute-in-system (command-string) |
| 37 | + "Executes the supplied command string in the underlying system." |
| 38 | + (uiop:run-program command-string |
| 39 | + :input :interactive |
| 40 | + :output :interactive |
| 41 | + :error-output t |
| 42 | + :ignore-error-status t)) |
| 43 | + |
| 44 | +(defun get-orientation (position) |
| 45 | + "Gets direction string for xrandr." |
| 46 | + (if (string-equal position "left") |
| 47 | + "--left-of" |
| 48 | + "--right-of")) |
| 49 | + |
| 50 | +(defun connect-external-displays (primary-device external-devices position) |
| 51 | + "Connects all supplied connected displays." |
| 52 | + (if (not (member position '("left" "right") :test #'string-equal)) |
| 53 | + (princ "Please specify \"left/right\"!") |
| 54 | + (execute-in-system (concatenate 'string |
| 55 | + "xrandr --output " |
| 56 | + "\"" primary-device "\"" |
| 57 | + " --auto " |
| 58 | + (apply #'concatenate 'string |
| 59 | + (mapcar (lambda (d) |
| 60 | + (concatenate 'string |
| 61 | + "--output " |
| 62 | + "\"" d "\"" |
| 63 | + " --auto " (get-orientation position) " " |
| 64 | + "\"" primary-device "\" ")) |
| 65 | + external-devices)))))) |
| 66 | + |
| 67 | +(defun disconnect-external-displays (primary-device external-devices) |
| 68 | + "Connects all supplied connected displays." |
| 69 | + (execute-in-system (concatenate 'string |
| 70 | + "xrandr --output " |
| 71 | + "\"" primary-device "\"" |
| 72 | + " --auto " |
| 73 | + (apply #'concatenate 'string |
| 74 | + (mapcar (lambda (d) |
| 75 | + (concatenate 'string |
| 76 | + "--output " |
| 77 | + "\"" d "\"" |
| 78 | + " --off ")) |
| 79 | + external-devices))))) |
| 80 | + |
| 81 | +(let* ((args (uiop:command-line-arguments))) |
| 82 | + (if (not (member (first args) '("connect" "disconnect") :test #'string-equal)) |
| 83 | + (princ "Please specify \"connect/disconnect\"!") |
| 84 | + (Let* ((connected-devices (concatenate 'list |
| 85 | + (mapcar (lambda (x) |
| 86 | + (car (string-to-list x #\ ))) |
| 87 | + (remove-if-not (lambda (x) |
| 88 | + (string-equal (cadr (string-to-list x #\ )) "connected")) |
| 89 | + (get-list-from-system "xrandr"))))) |
| 90 | + (primary-device (car connected-devices)) |
| 91 | + (external-devices (cdr connected-devices)) |
| 92 | + (orientation (second args))) |
| 93 | + (if (string-equal (car args) "connect") |
| 94 | + (connect-external-displays primary-device external-devices orientation) |
| 95 | + (disconnect-external-displays primary-device external-devices))))) |
0 commit comments