Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 95 lines (77 sloc) 2.972 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
(define-structure sawflibs.xmobar
  (export activate-xmobar
          activate-xmobar-prop)

  (open rep
        rep.system
        rep.io.processes
        rep.io.timers
        sawfish.wm.misc
        sawfish.wm.windows
        sawfish.wm.workspace)

  (define %max-width 80)
  (define %foreground "")
  (define %hilite "")

  (define (xmobar-fg color txt)
    (format #f "<fc=%s>%s</fc> " color txt))

  (define (ws-string)
    (apply concat
           (mapcar (lambda (n)
                     (xmobar-fg (if (equal n current-workspace) %hilite
                                  %foreground)
                                (if (numberp n) (1+ n) n)))
                   (sort (cons current-workspace
                               (remove current-workspace
                                       (all-workspaces)))))))

  (define (adjust-width s m)
    (if (> (length s) m)
        (concat (substring s 0 (- m 3)) "...")
      s))

  (define (status-string w)
    (let ((name (adjust-width (if w (window-name w) "") %max-width))
          (ws (ws-string)))
       (format #f "%s %s" ws name)))

  (define %xmobar-proc nil)
  (define %xmobar-prop nil)

  (define (output-ws-status w)
    (let ((txt (status-string w)))
      (when %xmobar-prop (set-x-property 'root %xmobar-prop txt 'ATOM 8))
      (when %xmobar-proc (format %xmobar-proc "%s\n" txt))))

  (define (start-xmobar cfg)
    (when %xmobar-proc (kill-process %xmobar-proc))
    (setq %xmobar-proc (make-process))
    (start-process %xmobar-proc "xmobar" cfg)
    (output-ws-status (input-focus)))

  (define (focus-hook w #!rest ign)
    (output-ws-status w))

  (define (property-hook w prop #!rest ign)
    (when (and (member prop '(WM_NAME _NET_WM_ICON_NAME _NET_WM_NAME))
               (eq w (input-focus)))
      (output-ws-status w)))

  (define (enter-ws-hook wsl)
    (when (workspace-empty-p (car wsl)) (output-ws-status nil)))

  (define (remove-from-ws-hook w wsl #!rest ign)
    (enter-ws-hook wsl))

  (define (setup-hooks)
    (unless (or %xmobar-proc %xmobar-prop)
      (add-hook 'focus-in-hook focus-hook)
      (add-hook 'property-notify-hook property-hook)
      (add-hook 'enter-workspace-hook enter-ws-hook)
      (add-hook 'remove-from-workspace-hook remove-from-ws-hook)))

  (define (setup-text width highlight foreground)
    (setq %max-width width)
    (setq %foreground foreground)
    (setq %hilite highlight))

  (define (activate-xmobar cfg #!key
                           (width 80)
                           (highlight "lightgoldenrod3")
                           (foreground "grey50"))
    (setup-text width highlight foreground)
    (setup-hooks)
    (start-xmobar cfg))

  (define (activate-xmobar-prop name #!key
                                (width 80)
                                (highlight "lightgoldenrod3")
                                (foreground "grey50"))
    (setup-text width highlight foreground)
    (setup-hooks)
    (setq %xmobar-prop name)))
Something went wrong with that request. Please try again.