(in-package :stumpwm)
(defun union-mild (a b) (union a b :test 'equalp))

(defun ends-with (x y) 
  (and
    (>= (length x) (length y))
    (equalp y (subseq x (- (length x) (length y)) (length x)))))

(defun starts-with (x y) 
  (and
    (>= (length x) (length y))
    (equalp y (subseq x 0 (length y)))))

(defun is-room (x s)
  (or
   (equal (window-role x) s)
   (equal (window-title x) s)
   (and
    (equal (window-class x) "Vacuum")
    (equal
     (cl-ppcre:regex-replace-all "address@hidden" s "")
     (cl-ppcre:regex-replace-all " .*" (window-title x) "")
     )
    )
   ))

(defun deftags (x)
  (unless 
    (find "no-auto-tags" (window-tags x) :test 'equalp)
    (reduce 
      #'union-mild 
      (list
	(mapcar (lambda(x) (cl-ppcre:regex-replace-all " " x "-"))
		(list 
		  (window-class x)
		  (concatenate 'string "i/" (window-res x))
		  (concatenate 'string "c/" (window-class x))
		  (concatenate 'string "r/" (window-role x))
		  (concatenate 'string "w/" 
			       (write-to-string 
				 (xlib:window-id 
				   (window-xwin x))))
		  ))
	(if (and 
	      (or 
		(equal (window-class x) "Carrier")
		(equal (window-class x) "Pidgin")
		) 
	      (equal (window-role x) "buddy_list")) 
	  (list 
	    ;"1" 
	    "im" "conversation" "base") nil)
	(if (or
	      (equal (window-title x) "Main 'screen' instance")
	      )
	  (list 
	    ;"0" 
	    "base" "sh") nil)
	(if (and 
	      (or 
		(equal (window-class x) "Carrier")
		(equal (window-class x) "Pidgin")
		) 
	      (equal (window-role x) "conversation")) 
	  (list 
	    ;"2" 
	    "im" "base") nil)
	(if (and
	      (equal (window-class x) "Gajim.py")
	      (equal (window-role x) "roster")
	      )
	  (list 
	    ;"2" 
	    "0"
	    "im" "base") nil)
	(if (and
	      (equal (window-class x) "psi")
	      )
	  (list 
	    "im" "base") nil)
	(if (and
	      (equal (window-class x) "Vacuum")
	      )
	  (list 
	    "im" "base") nil)
	(if (and
	      (equal (window-class x) "psi")
	      (equal (window-res x) "main")
	      )
	  (list 
	    ;"2" 
	    "0"
	    ) nil)
	(if (and
	      (equal (window-class x) "Vacuum")
	      (starts-with (window-title x) "Vacuum-IM - ")
	      )
	  (list 
	    ;"2" 
	    "0"
	    ) nil)
	(if (and
	      (equal (window-class x) "Gajim.py")
	      )
	  (list "im" "base" "gajim") nil)
	(if (or
	      (and
		(equal (window-class x) "Gajim.py")
		(not (equal (window-role x) "roster"))
		)
	      (and
		(equal (window-class x) "psi")
		(equal (window-res x) "groupchat")
		)
	      (and
		(equal (window-class x) "Vacuum")
		(ends-with (window-title x) " - Conference")
		)
	      )
	  (cond
	    ((is-room x "address@hidden")
	     (list "15"))
	    ((is-room x "address@hidden") 
	     (list "15"))
	    ((is-room x "address@hidden")
	     (list "14"))
	    ((is-room x "address@hidden")
	     (list "13"))
	    ((is-room x "address@hidden") 
	     (list "12"))
	    ((is-room x "address@hidden") 
	     (list "11"))
	    ((is-room x "address@hidden")
	     (list "10"))
	    ((is-room x "address@hidden")
	     (list "9"))
	    ((is-room x "address@hidden")
	     (list "8"))
	    ((is-room x "address@hidden")
	     (list "7"))
	    ((is-room x "address@hidden")
	     (list "6"))
	    ((is-room x "address@hidden")
	     (list "5"))
	    ((is-room x "address@hidden")
	     (list "4"))
	    ((is-room x "address@hidden")
	     (list "3"))
	    ((is-room x "address@hidden")
	     (list "2"))
	    ((is-room x "address@hidden")
	     (list "1"))
	    (t nil)
	    ) nil)
	(if (and 
	      (or
		(equal (window-class x) "Thunderbird-bin")
		(equal (window-class x) "Mail")
		(equal (window-class x) "Shredder")
		(equal (window-class x) "Lanikai")
		)
	      )
	  (list "mail" "tb" "base") nil)
	(if (and
	      (or
		(equal (window-class x) "Thunderbird-bin")
		(equal (window-class x) "Mail")
		(equal (window-class x) "Shredder")
		)
	      (equal (window-type x) :Normal)
	      (> (length (window-title x)) 8)
	      (not (equal (subseq (window-title x) 0 8) "Compose:"))
	      (not (equal (subseq (window-title x) 0 6) "Write:"))
	      )
	  (list 
	    ;"3"
	    ) nil)
	(if (and   
	      (equal (window-res x) "Navigator")
	      )
	  (list 
	    ;"4" 
	    "browser" "ff" "www" "base") nil)
	(if (or
	      (equal (window-res x) "Browser")
	      (equal (window-class x) "Minefield")
	      (equal (window-class x) "Firefox")
	      (equal (window-class x) "Iceweasel")
	      (equal (window-class x) "Shiretoko")
	      (equal (window-class x) "Namoroka")
	      (equal (window-class x) "Tumucumaque")
	      (equal (window-class x) "Aurora")
	      )
	  (list "browser" "ff" "www" "base" "heavy-browser") nil)
	(if (or
	      (equalp (window-class x) "chrome")
	      ) 
	  (list "chrome" "heavy-browser"))
	(if (or
	      (equal (window-class x) "webkit-program-GtkLauncher")
	      (equal (window-class x) "Webkit-program-GtkLauncher")
	      )
	  (list 
	    ;"5" 
	    "browser" "webkit" "base" "wk" "light-browser") nil)
	(if (or
	      (equal (window-class x) ".midori-wrapped")
	      )
	  (list 
	    ;"5" 
	    "midori" "browser" "webkit" "base" "wk") nil)
	(if (or
	      (equal (window-class x) "Carrier")
	      (equal (window-class x) "Pidgin")
	      (equal (window-class x) "Thunderbird-bin")
	      (equal (window-class x) "Mail")
	      (equal (window-class x) "Shredder")
	      (equal (window-res x) "Navigator")
	      (equal (window-class x) "Gajim.py")
	      )
	  (list "web" "base"))
	(if (or
	      (equal (window-res x) "xterm")
	      (equal (window-res x) "urxvt")
	      (equal (window-res x) "rxvt")
	      )
	  (list "shell" "term"))
	(if (or
	      (equal (window-title x) "su shell")
	      )
	  (list 
	    ;"9" 
	    "root" "admin" "base"))
	(if (or
	      (equal (window-class x) "xmoto")
	      (equalp (window-class x) "warmux")
	      (equalp (window-class x) "tbe")
	      (equalp (window-class x) "glob2")
	      (equalp (window-class x) "widelands")
	      (equalp (window-class x) "liquidwar6")
	      (equal (window-class x) "Sand")
	      )
	  (list "games"))
	(if (or
	      (equal (window-class x) "display")
	      (equal (window-class x) ".wrapped-evince")
	      (equal (window-class x) ".evince-wrapped")
	      (equal (window-class x) "Xpdf")
	      (equal (window-class x) "MuPDF")
	      (equal (window-class x) "XSane")
	      (equal (window-res x) "gv")
	      (equal (window-class x) "Djview")
	      (equal (window-class x) "GQview")
	      (equal (window-class x) "Geeqie")
	      )
	  (list "viewers" "view" "base"))
	(if
	  (or
	    (equalp (window-title x) "qemu")
	    (equalp (window-class x) "qemu")
	    (starts-with (window-class x) "qemu-")
	    )
	  (list "qemu"))
	(if (or
	      (equal (window-res x) "VCLSalFrame")
	      (equal (window-res x) "VCLSalFrame.DocumentWindow")
	      )
	  (list "ooo" "openoffice" "oo.o" "view" "base"))
	(if (or
	      (equalp (window-res x) "gimp")
	      (equalp (window-class x) ".wrapped-inkscape")
	      (equalp (window-class x) ".inkscape-wrapped")
	      (equalp (window-res x) "xfig")
	      (equalp (window-res x) "drgeo")
	      (equalp (window-res x) "kig")
	      )
	  (list "graphics" "editor"))
	(if (or
	      (equalp (window-res x) "xfig")
	      (equalp (window-res x) "drgeo")
	      (equalp (window-res x) "kig")
	      )
	  (list "geom" "geometry"))
	(if (and
	      (or
		(equal (window-res x) "xterm")
		(equal (window-res x) "urxvt")
		(equal (window-res x) "rxvt")
		)
	      (> (length (window-title x)) 12)
	      (equal (subseq (window-title x) 0 12) "ssh session:")
	      )
	  (list "ssh" "base"))
	(if (and
	      (or
		(equal (window-res x) "xterm")
		(equal (window-res x) "urxvt")
		(equal (window-res x) "rxvt")
		)
	      (or
		(equal (window-title x) "web-streams")
		(equal (window-title x) "emails")
		)
	      )
	  (list "web-streams" "viewers" "view"))
	(if (or
	      (equal (window-title x) "Gateway6 monitoring")
	      (equal (window-title x) "Local IRC ghost")
	      )
	  (list "monitor"))
	(if (or
	      (equal (window-title x) "zsh")
	      (equal (window-title x) "sh")
	      (equal (window-title x) "su shell")
	      (equal (window-title x) "bash")
	      )
	  (list "open-shell"))
	(if (or
	      (equalp (window-res x) "vncviewer")
	      (equalp (window-class x) "Vncviewer")
	      (equalp (window-class x) "Gvncviewer")
	      )
	  (list "vnc" "ssh"))
	(if (or
	      (equal (window-class x) "Linuxdcpp")
	      (ends-with (window-title x) "(BitTornado)")
	      )
	  (list "p2p"))
	(if (or
	      (equal (window-class x) "Linuxdcpp")
	      )
	  (list "dc" "150"))
	(if (or
	      (equal (window-class x) "bittornado")
	      (ends-with (window-title x) "(BitTornado)")
	      )
	  (list "bt" "160"))
	(if (or
	      (equal (window-title x) "input-history (~/.local/share/uzbl) - VIM")
	      (equal (window-title x) "input-history + (~/.local/share/uzbl) - VIM")
	      (ends-with (window-title x) ".local/share/uzbl/forms) - VIM")
	      (equal (window-class x) ".uzbl-wrapped")
	      (equal (window-class x) ".uzbl-core-wrapped")
	      (equal (window-class x) ".wrapped-uzbl")
	      )
	  (list "uzbl" "light-browser"))
	(if (or
	      (equal (window-title x) "input-history (~/.local/share/uzbl) - VIM")
	      (ends-with (window-title x) ".local/share/uzbl/forms) - VIM")
	      (equal (window-class x) ".uzbl-wrapped")
	      (equal (window-class x) ".uzbl-core-wrapped")
	      (equal (window-class x) "uzbl")
	      (equal (window-class x) ".wrapped-uzbl")
	      (equal (window-class x) "Links")
	      (equal (window-class x) ".midori-wrapped")
	      (equal (window-class x) ".wrapped-midori")
	      )
	  (list "light-browser" "browser"))
	(if (and
	      (equal (window-class x) "Lazarus")
	      (starts-with (window-title x) "Lazarus IDE"))
	  (list "lazarus-ide-window"))
	(if (and
	      (equal (window-class x) "Lazarus")
	      (starts-with (window-title x) "Messages"))
	  (list "lazarus-message-window"))
	(if (and
	      (equal (window-class x) "Lazarus")
	      (starts-with (window-title x) "Object Inspector"))
	  (list "lazarus-inspector-window"))
	(if (and
	      (equal (window-class x) "Dia")
	      (equal (window-role x) "toolbox_window"))
	  (list "dia-toolbar"))
	(if (and
	      (equal (window-class x) "Gimp")
	      (equal (window-role x) "gimp-toolbox"))
	  (list "gimp-toolbar"))
	(if (or
	      (equalp (window-title x) "Limp")
	      )
	  (list "Limp")
	  )
	(if (or
	      (starts-with (window-title x) "SQuirreL SQL")
	      )
	  (list "SquirrelSQL" "editor" "sql")
	  )
	(if
	  (equalp (window-class x) "org-hypergraphdb-viewer-hgvdesktop")
	  (list "editor" "HGDB" "HGDBViewer" "GraphDB")
	  )
	(if
	  (equalp (window-class x) "freemind-main-FreeMindStarter")
	  (list "editor" "freemind" "mindmap")
	  )
	(if
	  (equalp (window-class x) "tufts-vue-VUE")
	  (list "editor" "vue" "mindmap")
	  )
	(if
	  (equal (window-title x) "XWatchSystem")
	  (list "xwatchsystem" "999"))
	))))