;;;; -*- sawfish -*-
;;;;Time-stamp: <01/01/19 05:32:16 friedel>
;; by Friedrich Delgado Friedrichs <friedel@nomaden.org>

;;;; Redefine the (display-message) function to use customized
;;;; attributes.

;;;; Requires (fancy-message) from merlin/message.jl
;;;; and merlin/util.jl

;;;;;;;;;;;;;;;;;;
;; INSTALLATION ;;
;;;;;;;;;;;;;;;;;;

;; Create a directory ~/.sawfish/lisp/friedel and then put this file there:
;;   mkdir -p ~/.sawfish/lisp/friedel
;;   mv custom-message.jl ~/.sawfish/lisp/friedel

;; Then require 'friedel.custom-messages in your ~/.sawfishrc and
;; choose some ugly properties in the sawfish customization
;; (Appearance -> Messages)

(define-structure friedel.custom-message
    (export display-message)
    (open rep
	  rep.regexp
	  sawfish.wm.custom
	  sawfish.wm.misc
	  sawfish.wm.colors
	  merlin.util
	  merlin.message)

  (defgroup messages "Messages" :group appearance)

  (defcustom custom-messages-position
    (cons (/ (screen-width) 2) (/ (screen-height) 2))
    "Position of the message window"
    :group (appearance messages)
    :type (pair (labelled "Vertical:" number)
		(labelled "Horizontal:" number))
    :require friedel.custom-message)

  (defcustom custom-messages-gravity
    'center
    "Gravity of message relative to position"
    :group (appearance messages)
    :type (set north-west north north-east 
	       west center east
	       south-west south south-east)
    :require friedel.custom-message)
    
  (defcustom custom-messages-font
    default-font
    "Message font"
    :group (appearance messages)
    :type font
    :require friedel.custom-message)

  (defcustom custom-messages-background
    (get-color "white")
    "Background of message window"
    :group (appearance messages)
    :type color
    :require friedel.custom-message)

  (defcustom custom-messages-foreground
    (get-color "black")
    "Foreground of message window"
    :group (appearance messages)
    :type color
    :require friedel.custom-message)

  (defcustom custom-messages-border
    (get-color "black")
    "Border of message window"
    :group (appearance messages)
    :type color
    :require friedel.custom-message)

  (defcustom custom-messages-x-justify
    'center
    "Justification of message"
    :group (appearance messages)
    :type (set left center right) ;;and number, but that does not work...
    :require friedel.custom-message)
 
;; There seems to be a bug in merlin.message which prevents number
;; justification from working, which i was too lazy to investigate,
;; and so i commented this out :-/
;  (defcustom custom-messages-x-number
;    0
;    "numerical justification if \"number\" is selected above"
;    :group (appearance messages)
;    :type (number -30 30)
;    :require friedel.custom-message)

  (defcustom custom-messages-spacing
    1
    "interline spacing"
    :group (appearance messages)
    :type (number 0 30)
    :require friedel.custom-message)

  (defcustom custom-messages-padding
    (cons 4 4)
    "outer padding"
    :group (appearance messages)
    :type (pair (labelled "Vertical:" number)
		(labelled "Horizontal:" number))
    :require friedel.custom-message)

  (defcustom custom-messages-borderwidth
    1
    "Border width of message window"
    :group (appearance messages)
    :type (number 0 30)
    :require friedel.custom-message)

  (defun custom-message (text)
    (if (null text)
	(hide-fancy-message)
      (progn
	(fancy-message 
	 (string-split "\n" text)
	 `((position . ,custom-messages-position)
	   (gravity . ,custom-messages-gravity)
	   (font . ,custom-messages-font)
	   (foreground . ,custom-messages-foreground)
	   (background . ,custom-messages-background)
	   (border-color . ,custom-messages-border)
	   (x-justify . ,custom-messages-x-justify)
	   (spacing . ,custom-messages-spacing)
	   (padding . ,custom-messages-padding)
	   (border-width . ,custom-messages-borderwidth))))))

  (defun display-message (text)
    (custom-message text))

  (provide 'friedel.custom-message))