stumpwm/igv.lisp @ a65fd2691c94 default tip

(defpackage :stumpwm-user/igv
  (:use :cl :losh)
  (:import-from :stumpwm :defcommand :echo :run-shell-command)
  (:export
    :igv/supplementary-on
    :igv/supplementary-off
    :igv/group-none
    :igv/group-selected
    :igv/clear-read-selections
    :igv/select-reads
    :igv/goto
    :igv/goto-read
    :igv/zoom-in
    :igv/zoom-out
    :igv/init))

(in-package :stumpwm-user/igv)


;;;; Implementation -----------------------------------------------------------
(defun send-igv-command (string &key want-resp)
  (usocket:with-client-socket (socket stream "127.0.0.1" 60151)
    ;; Do this here instead of passing :timeout above because that only sets
    ;; *read* timeout and we don't want to permahang stump when IGV hangs and
    ;; can't read.
    (setf (sb-impl::fd-stream-timeout (usocket:socket-stream socket)) 5.0f0)
    (unwind-protect (progn (write-line string stream)
                           (force-output stream)
                           (when want-resp
                             (read-line stream)))
      (usocket:socket-close socket))))

(defun send-igv-batch-file (path)
  (send-igv-command (alexandria:read-file-into-string path)))

(defun alignment-tracks% ()
  (str:split #\, (send-igv-command "alignmentTrackNames ," :want-resp t)))

(defun group% (option)
  (send-igv-command (format nil "group ~A" (ecase option
                                             ((:selected) "selected")
                                             ((nil) "none")))))

(defun select-reads% ()
  (dolist (track-name (alignment-tracks%))
    (let ((read-names (ppcre:all-matches-as-strings
                        "[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}"
                        (pbpaste))))
      (send-igv-command (format nil "selectByName ~A ~A ," track-name (str:join "," read-names)))
      (echo (format nil "Selected ~D read~:P." (length read-names))))))

(defun goto% ()
  (ppcre:register-groups-bind (chr start end)
      ("(chr[A-Za-z0-9_]+)[\\s:]+([\\d,]+)(?:[\\s-]+)?([\\d,]+)?" (pbpaste))
    (send-igv-command (format nil "goto ~A:~A~@[-~A~]" chr start end))))

(defun goto-start% ()
  (send-igv-command "goto chr1:1-1000"))

(defun clear-read-selections% ()
  (dolist (track-name (alignment-tracks%))
    (send-igv-command (format nil "clearSelections ~A" track-name))))

(defun zoom-in% ()
  (send-igv-command "zoomin"))

(defun zoom-out% ()
  (send-igv-command "zoomout"))


;;;; Commands -----------------------------------------------------------------
(defcommand igv/supplementary-on () ()
  (send-igv-command "preference SAM.FILTER_SUPPLEMENTARY_ALIGNMENTS FALSE")
  (echo "Supplementary alignments now on."))

(defcommand igv/supplementary-off () ()
  (send-igv-command "preference SAM.FILTER_SUPPLEMENTARY_ALIGNMENTS TRUE")
  (echo "Supplementary alignments now off."))

(defcommand igv/group-none () ()
  (group% nil))

(defcommand igv/group-selected () ()
  (group% :selected))

(defcommand igv/clear-read-selections () ()
  (clear-read-selections%))

(defcommand igv/select-reads () ()
  (select-reads%)
  (group% :selected))

(defcommand igv/goto () ()
  (goto%))

(defcommand igv/goto-start () ()
  (goto-start%))

(defcommand igv/zoom-in () ()
  (zoom-in%))

(defcommand igv/zoom-out () ()
  (zoom-out%))

(defcommand igv/goto-read () ()
  (clear-read-selections%)
  (goto%)
  (select-reads%))

(defcommand igv/init () ()
  (send-igv-batch-file "/home/sjl/bin/igv.batch"))

(defcommand igv/minimera () ()
  ; hack because h-m is taken
  (run-shell-command "~/src/minimera/contrib/minimera-clipboard.sh"))