Christophe Weblog Wiki Code Publications Music
whitespace
[squeeze-el.git] / squeeze.el
1 (defgroup squeeze nil
2   "Interact with Squeezebox media servers"
3   :prefix "squeeze-" 
4   :group 'applications)
5
6 (defcustom squeeze-server-address "localhost"
7   "Address for the Squeezebox server"
8   :group 'squeeze)
9 (defcustom squeeze-server-port 9090
10   "Port number for the Squeezebox server"
11   :group 'squeeze)
12
13 (defvar squeeze-mode-map
14   (let ((map (make-sparse-keymap)))
15     (define-key map (kbd "TAB") 'completion-at-point)
16     map))
17
18 (defun squeeze-unhex-and-decode-utf8-string (string)
19   (decode-coding-string (url-unhex-string string) 'utf-8))
20
21 (define-derived-mode squeeze-mode comint-mode "Squeeze"
22   "Major mode for interacting with the Squeezebox Server CLI.\\<squeeze-mode-map>"
23   (add-to-list 'completion-at-point-functions 'squeeze-complete-command-at-point)
24   (add-hook 'comint-preoutput-filter-functions 'squeeze-unhex-and-decode-utf8-string nil t)
25   (add-hook 'comint-preoutput-filter-functions 'squeeze-update-state nil t))
26
27 (defvar squeeze-control-mode-map
28   (let ((map (make-sparse-keymap)))
29     (define-key map (kbd "SPC") 'squeeze-control-toggle-power)
30     (define-key map (kbd "f") 'squeeze-control-play-favorite)
31     (define-key map (kbd "g") 'squeeze-control-refresh)
32     (define-key map (kbd "+") 'squeeze-control-volume-up)
33     (define-key map (kbd "-") 'squeeze-control-volume-down)
34     (define-key map (kbd "t") 'squeeze-control-toggle-syncgroup-display)
35     map))
36
37 (define-derived-mode squeeze-control-mode special-mode "SqueezeControl"
38   "Major mode for controlling Squeezebox Servers.\\<squeeze-control-mode-map>")
39
40 (defvar squeeze-control-inhibit-display nil)
41
42 (lexical-let ((buffer ""))
43   (defun squeeze-update-state (string)
44     (if (cl-position ?\n string)
45         (let (done-something)
46           (setq string (concat buffer string))
47           (dolist (line (split-string string "\n"))
48             (when (squeeze-update-state-from-line line)
49               (setq done-something t)))
50           (when done-something
51             (unless squeeze-control-inhibit-display
52               (squeeze-control-display-players)))
53           (setq buffer ""))
54       (setq buffer (concat buffer string)))
55     string))
56
57 (defconst squeeze-player-line-regexp
58   "^\\(\\(?:[0-9a-f]\\{2\\}%3A\\)\\{5\\}[0-9a-f]\\{2\\}\\) ")
59
60 (defun squeeze-find-player (id)
61   (dolist (player squeeze-players)
62     (when (string= id (squeeze-player-playerid player))
63       (return player))))
64
65 (defun squeeze-update-power (player state)
66   (if state
67       (setf (squeeze-player-power player) state)
68     (let ((current (squeeze-player-power player)))
69       (setf (squeeze-player-power player)
70             (cond ((string= current "0") "1")
71                   ((string= current "1") "0"))))))
72
73 (defun squeeze-update-mixer-volume (player value)
74   (let ((current (squeeze-player-volume player))
75         (number (string-to-number value)))
76     (if (string-match "^[-+]" value)
77         (setf (squeeze-player-volume player)
78               (and current (max 0 (min 100 (+ current number)))))
79       (setf (squeeze-player-volume player) number))))
80
81 (defun squeeze-update-state-from-line (string)
82   (cond
83    ((string-match "^players 0" string)
84     (setq squeeze-players (squeeze-parse-players-line string))
85     t)
86    ((string-match "^syncgroups" string)
87     (setq squeeze-syncgroups (squeeze-parse-syncgroups-line string))
88     t)
89    ((string-match squeeze-player-line-regexp string)
90     (let ((substring (substring string (match-end 0)))
91           (id (url-unhex-string (match-string 1 string))))
92       (cond
93        ((string-match "^power\\(?: \\([01]\\)\\)?" substring)
94         (let ((state (match-string 1 substring))
95               (player (squeeze-find-player id)))
96           (squeeze-update-power player state))
97         t)
98        ((string-match "^mixer volume \\(\\(?:-\\|%2B\\)?[0-9]*\\)" substring)
99         (let ((value (url-unhex-string (match-string 1 substring)))
100               (player (squeeze-find-player id)))
101           (squeeze-update-mixer-volume player value))
102         t))))))
103
104 (defface squeeze-player-face
105   '((t))
106   "Face for displaying players"
107   :group 'squeeze)
108 (defface squeeze-player-on-face
109   '((t :weight bold :inherit squeeze-player-face))
110   "Face for displaying players which are on"
111   :group 'squeeze)
112 (defface squeeze-player-off-face
113   '((t :weight light :inherit squeeze-player-face))
114   "Face for displaying players which are off"
115   :group 'squeeze)
116
117 (defface squeeze-mixer-face
118   '((t :weight bold))
119   "Face for displaying mixer information"
120   :group 'squeeze)
121 (defface squeeze-mixer-muted-face
122   '((t :weight light :inherit squeeze-mixer-face))
123   "Face for displaying mixer information when muted"
124   :group 'squeeze)
125 (defface squeeze-mixer-quiet-face
126   '((t :foreground "green3" :inherit squeeze-mixer-face))
127   "Face for quiet volume"
128   :group 'squeeze)
129 (defface squeeze-mixer-medium-face
130   '((t :foreground "gold" :inherit squeeze-mixer-face))
131   "Face for medium volume"
132   :group 'squeeze)
133 (defface squeeze-mixer-loud-face
134   '((t :foreground "OrangeRed1" :inherit squeeze-mixer-face))
135   "Face for loud volume"
136   :group 'squeeze)
137 (defface squeeze-mixer-muted-quiet-face
138   '((t :inherit (squeeze-mixer-muted-face squeeze-mixer-quiet-face)))
139   "Face for quiet volume when muted")
140 (defface squeeze-syncgroup-face
141   '((t :slant italic))
142   "Face for syncgroups"
143   :group 'squeeze)
144
145 (defun squeeze-mixer-compute-bar (vol width)
146   (let* ((exact (* width (/ vol 100.0)))
147          (nfull (floor exact))
148          (frac (- exact nfull))
149          (nblank (floor (- width exact))))
150     (format "%s%s%s"
151             (make-string nfull ?█)
152             (if (= width (+ nfull nblank))
153                 ""
154               (string (aref " ▏▎▍▌▋▊▉█" (floor (+ frac 0.0625) 0.125))))
155             (make-string nblank ? ))))
156
157 (defun squeeze-mixer-make-bar (vol width)
158   (let ((bar (squeeze-mixer-compute-bar vol width))
159         (lo (floor (* 0.65 width)))
160         (hi (floor (* 0.9 width))))
161     (concat "▕"
162             (propertize (substring bar 0 lo) 'face 'squeeze-mixer-quiet-face)
163             (propertize (substring bar lo hi) 'face 'squeeze-mixer-medium-face)
164             (propertize (substring bar hi) 'face 'squeeze-mixer-loud-face)
165             (propertize "▏" 'intangible t))))
166
167 (defvar squeeze-players ())
168 (defvar squeeze-syncgroups ())
169
170 (defun squeeze-send-string (control &rest arguments)
171   (let* ((process (get-buffer-process "*squeeze*"))
172          (string (apply #'format control arguments))
173          (length (length string)))
174     (unless (and (> length 0) (char-equal (aref string (1- length)) ?\n))
175       (setq string (format "%s\n" string)))
176     (if process
177         (comint-send-string process string)
178       (error "can't find squeeze process"))))
179
180 (defun squeeze-control-query-syncgroups ()
181   (interactive)
182   (squeeze-send-string "syncgroups ?"))
183
184 (defun squeeze-control-query-players ()
185   (interactive)
186   (squeeze-send-string "players 0"))
187
188 (defun squeeze-control-toggle-power (&optional id)
189   (interactive)
190   (unless id
191     (setq id (get-text-property (point) 'squeeze-playerid)))
192   (squeeze-send-string "%s power" id))
193
194 (defun squeeze-control-play-favorite (&optional favorite id)
195   (interactive "nFavourite: ")
196   (unless id
197     (setq id (get-text-property (point) 'squeeze-playerid)))
198   (squeeze-send-string "%s favorites playlist play item_id:%d" id favorite))
199
200 (defun squeeze-control-query-power (&optional id)
201   (interactive)
202   (unless id
203     (setq id (get-text-property (point) 'squeeze-playerid)))
204   (when id
205     (squeeze-send-string "%s power ?" id)))
206
207 (defun squeeze-control-volume-up (&optional id inc)
208   (interactive)
209   (unless inc (setq inc 5))
210   (unless id
211     (setq id (get-text-property (point) 'squeeze-playerid)))
212   (when id
213     (squeeze-send-string "%s mixer volume %+d" id inc)))
214
215 (defun squeeze-control-volume-down (&optional id inc)
216   (interactive)
217   (unless inc (setq inc 5))
218   (unless id
219     (setq id (get-text-property (point) 'squeeze-playerid)))
220   (when id
221     (squeeze-send-string "%s mixer volume %+d" id (- inc))))
222
223 (defun squeeze-control-volume-set (id val)
224   (interactive)
225   (squeeze-send-string "%s mixer volume %d" id val))
226
227 (defun squeeze-control-query-mixer-volume (&optional id)
228   (interactive)
229   (unless id
230     (setq id (get-text-property (point) 'squeeze-playerid)))
231   (when id
232     (squeeze-send-string "%s mixer volume ?" id)))
233
234 (defun squeeze-control-player-face (player)
235   (let ((power (squeeze-player-power player)))
236     (cond ((string= power "1") 'squeeze-player-on-face)
237           ((string= power "0") 'squeeze-player-off-face)
238           (t 'squeeze-player-face))))
239
240 (defun squeeze-control-listen ()
241   (squeeze-send-string "listen 1"))
242
243 (defun squeeze-accept-process-output ()
244   (while (accept-process-output (get-buffer-process "*squeeze*") 0.1 nil t)))
245
246 (defun squeeze-control-refresh ()
247   (interactive)
248   (let ((squeeze-control-inhibit-display t))
249     (squeeze-control-query-players)
250     (squeeze-accept-process-output)
251     (squeeze-control-query-syncgroups)
252     (dolist (player squeeze-players)
253       (squeeze-control-query-power (squeeze-player-playerid player))
254       (squeeze-control-query-mixer-volume (squeeze-player-playerid player))))
255   (squeeze-accept-process-output)
256   (squeeze-control-display-players))
257
258 (defvar squeeze-control-mixer-map
259   (let ((map (make-sparse-keymap)))
260     (define-key map (kbd "RET") 'squeeze-control-mixer-set-volume)
261     (define-key map [mouse-1] 'squeeze-control-mixer-mouse-1)
262     map))
263
264 (defun squeeze-control-compute-volume (pos)
265   (let* ((end (next-single-property-change pos 'keymap))
266          (start (previous-single-property-change end 'keymap)))
267     (/ (* 100 (- (point) start)) (- end start 1))))
268
269 (defun squeeze-control-mixer-mouse-1 (event)
270   (interactive "e")
271   (let* ((pos (cadadr event))
272          (val (squeeze-control-compute-volume pos))
273          (id (get-text-property pos 'squeeze-playerid)))
274     (squeeze-control-volume-set id val)))
275
276 (defun squeeze-control-mixer-set-volume ()
277   (interactive)
278   (let* ((val (squeeze-control-compute-volume (point)))
279          (id (get-text-property (point) 'squeeze-playerid)))
280     (squeeze-control-volume-set id val)))
281
282 (defvar squeeze-control-display-syncgroups nil)
283
284 (defun squeeze-control-toggle-syncgroup-display ()
285   (interactive)
286   (setf squeeze-control-display-syncgroups
287         (not squeeze-control-display-syncgroups))
288   (squeeze-control-display-players))
289
290 (defun squeeze-control-insert-player (player)
291   (insert (propertize (format "%20s" (squeeze-player-name player))
292                       'face (squeeze-control-player-face player)
293                       'squeeze-playerid (squeeze-player-playerid player)))
294   (when (squeeze-player-volume player)
295     (insert (propertize
296              (squeeze-mixer-make-bar (squeeze-player-volume player) 28)
297              'squeeze-playerid (squeeze-player-playerid player)
298              'keymap squeeze-control-mixer-map
299              'pointer 'hdrag
300              'rear-nonsticky '(keymap))))
301   (insert (propertize "\n" 'intangible t)))
302
303 (defun squeeze-control-display-players ()
304   (interactive)
305   (with-current-buffer (get-buffer-create "*squeeze-control*")
306     (let ((saved (point)))
307       (squeeze-control-mode)
308       (read-only-mode -1)
309       (erase-buffer)
310       (cond
311        (squeeze-control-display-syncgroups
312         (let ((syncgroups squeeze-syncgroups)
313               (seen))
314           (while syncgroups
315             (let ((names (getf syncgroups :names))
316                   (members (split-string (getf syncgroups :members) ",")))
317               (insert (propertize names 'face 'squeeze-syncgroup-face) "\n")
318               (dolist (member members)
319                 (let ((player (squeeze-find-player member)))
320                   (squeeze-control-insert-player player)
321                   (push player seen))))
322             (setq syncgroups (cddddr syncgroups)))
323           (insert (propertize "No syncgroup" 'face 'squeeze-syncgroup-face) "\n")
324           (dolist (player squeeze-players)
325             (unless (member player seen)
326               (squeeze-control-insert-player player)))))
327        (t
328         (dolist (player squeeze-players)
329           (squeeze-control-insert-player player))
330         (read-only-mode 1)))
331       (goto-char saved))))
332
333 (cl-defstruct (squeeze-player (:constructor squeeze-make-player))
334   playerindex playerid uuid ip name model isplayer displaytype canpoweroff connected power volume)
335
336 (defun squeeze-string-plistify (string start end)
337   (unless end
338     (setq end (length string)))
339   (save-match-data
340     (let (result)
341       (loop
342        (if (string-match "\\([a-z]+\\)%3A\\([^ \n]+\\)" string start)
343            (let ((mend (match-end 0)))
344              (when (> mend end)
345                (return))
346              (push (intern (format ":%s" (substring string (match-beginning 1) (match-end 1)))) result)
347              (push (decode-coding-string
348                     (url-unhex-string (substring string (match-beginning 2) (match-end 2)))
349                     'utf-8)
350                    result)
351              (setq start mend))
352          (return)))
353       (nreverse result))))
354
355 (defun squeeze-parse-syncgroups-line (string)
356   (let ((syncgroupspos (string-match "^syncgroups " string))
357         (startpos (match-end 0)))
358     (when startpos
359       (squeeze-string-plistify string startpos (length string)))))
360
361 (defun squeeze-parse-count (string)
362   (save-match-data
363     (let ((countpos (string-match "count%3A\\([0-9]*\\)\\>" string)))
364       (if countpos
365           (string-to-number
366            (substring string (match-beginning 1) (match-end 1)))
367         (let ((kind
368                (progn (string-match "^\\([a-z]*\\) " string)
369                       (substring string (match-beginning 1) (match-end 1)))))
370           (message "no count found in %s line" kind)
371           nil)))))
372
373 (defun squeeze-parse-players-line (string)
374   (let ((count (squeeze-parse-count string))
375         (startpos (string-match "playerindex" string))
376         result endpos)
377     (dotimes (i (1- count))
378       (setq endpos (progn (string-match " connected%3A[0-1] " string startpos)
379                           (match-end 0)))
380       (push (apply 'squeeze-make-player (squeeze-string-plistify string startpos endpos)) result)
381       (setq startpos endpos))
382     (push (apply 'squeeze-make-player (squeeze-string-plistify string startpos (length string))) result)
383     result))
384
385
386 (defun squeeze-complete-command-at-point ()
387   (save-excursion
388     (list (progn (backward-word) (point))
389           (progn (forward-word) (point))
390           '(;; General commands and queries
391             "login" "can" "version" "listen" "subscribe" "pref"
392             "logging" "getstring" "setsncredentials" "debug"
393             "exit" "shutdown"
394
395             ;; Player commands and queries
396             "player" "count" "id" "uuid" "name" "ip" "model" "isplayer"
397             "displaytype" "canpoweroff" "?" "signalstrength" "connected"
398             "sleep" "sync" "syncgroups" "power" "mixer" "volume" "muting"
399             "bass" "treble" "pitch" "show" "display" "linesperscreen"
400             "displaynow" "playerpref" "button" "ir" "irenable"
401             "connect" "client" "forget" "disconnect" "players"
402             
403             ;; Database commands and queries
404             "rescan" "rescanprogress" "abortscan" "wipecache" "info"
405             "total" "genres" "artists" "albums" "songs" "years"
406             "musicfolder" "playlists" "tracks" "new" "rename" "delete"
407             "edit" "songinfo" "titles" "search" "pragma"
408
409             ;; Playlist commands and queries
410             "play" "stop" "pause" "mode" "time" "genre" "artist" "album"
411             "title" "duration" "remote" "current_title" "path" "playlist"
412             "add" "insert" "deleteitem" "move" "delete" "preview" "resume"
413             "save" "loadalbum" "addalbum" "loadtracks" "addtracks"
414             "insertalbum" "deletealbum" "clear" "zap" "name" "url"
415             "modified" "playlistsinfo" "index" "shuffle" "repeat"
416             "playlistcontrol"
417
418             ;; Compound queries
419             "serverstatus" "status" "displaystatus" "readdirectory"
420
421             ;; Notifications
422
423             ;; Alarm commands and queries
424             "alarm" "alarms"
425
426             ;; Plugins commands and queries
427             "favorites"
428             ))))
429
430 (defun squeeze-read-server-parameters (address port)
431   (let ((host (read-string "Host: " nil nil address))
432         (port (read-number "Port: " port)))
433     (cons host port)))
434
435 (defun squeeze (&optional address port)
436   (interactive)
437   (unless address (setq address squeeze-server-address))
438   (unless port (setq port squeeze-server-port))
439   (when current-prefix-arg
440     (let ((parameters (squeeze-read-server-parameters address port)))
441       (setq address (car parameters)
442             port (cdr parameters))))
443   (let ((buffer (make-comint-in-buffer "squeeze" nil (cons address port))))
444     (switch-to-buffer buffer)
445     (squeeze-mode)))
446
447 (defun squeeze-control (&optional address port)
448   (interactive)
449   (unless address (setq address squeeze-server-address))
450   (unless port (setq port squeeze-server-port))
451   (when current-prefix-arg
452     (let ((parameters (squeeze-read-server-parameters address port)))
453       (setq address (car parameters)
454             port (cdr parameters))))
455   (let ((current-prefix-arg nil))
456     (squeeze address port))
457   (let ((buffer (get-buffer-create "*squeeze-control*")))
458     (switch-to-buffer buffer)
459     (squeeze-control-listen)
460     (squeeze-control-refresh)
461     (squeeze-control-display-players)))
462
463 (provide 'squeeze)