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