stumpwm/igv.lisp @ 8e22b36e5cba

(in-package :stumpwm-user)

(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 igv-alignment-tracks ()
  (str:split #\, (send-igv-command "alignmentTrackNames ," :want-resp t)))

(defvar *igv/supplementary-alignments* t)

(defun igv/select-reads% ()
  (dolist (track-name (igv-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 igv/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 igv/clear-read-selections% ()
  (dolist (track-name (igv-alignment-tracks))
    (send-igv-command (format nil "clearSelections ~A" track-name))))

(defcommand igv/toggle-supplementary-alignments () ()
  (callf *igv/supplementary-alignments* #'not)
  (send-igv-command
    (format nil "preference SAM.FILTER_SUPPLEMENTARY_ALIGNMENTS ~A"
            (if *igv/supplementary-alignments* "FALSE" "TRUE")))
  (echo (if *igv/supplementary-alignments*
            "Supplementary alignments now on."
            "Supplementary alignments now off.")))

(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/clear-read-selections () ()
  (igv/clear-read-selections%))

(defcommand igv/select-reads () ()
  (igv/select-reads%))

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

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

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