[sawfish] improved prompt.jl [Sergey I. Sharybi]



commit 377151bf8efff55ce93836a387feadd89d5ccab0
Author: chrisb <zanghar freenet de>
Date:   Sat May 16 16:33:30 2009 +0200

    improved prompt.jl [Sergey I. Sharybi]
---
 ChangeLog                      |    3 ++
 lisp/sawfish/wm/autoload.jl    |    1 +
 lisp/sawfish/wm/util/prompt.jl |   58 ++++++++++++++++++++++++++++++++++++---
 man/news.texi                  |    2 +
 4 files changed, 59 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index e309dd6..f34a2cb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,6 @@
+2009-05-16  Christopher Bratusek <zanghar freenet de>
+	* lisp/sawfish/wm/util/prompt.jl: improved prompt.jl [Sergey I. Sharybi]
+
 2009-05-08  Christopher Bratusek <zanghar freenet de>
 	* lisp/sawfish/wm/placement.jl: interactive placement mode now also for dialogs
 
diff --git a/lisp/sawfish/wm/autoload.jl b/lisp/sawfish/wm/autoload.jl
index eed1584..ce43a6f 100644
--- a/lisp/sawfish/wm/autoload.jl
+++ b/lisp/sawfish/wm/autoload.jl
@@ -136,6 +136,7 @@
 (defgroup match-window "Matched Windows" :layout single :require sawfish.wm.ext.match-window)
 (defgroup tooltips "Tooltips" :group appearance :require sawfish.wm.ext.tooltips)
 (defgroup window-history "History" :group match-window :require sawfish.wm.ext.window-history)
+(defgroup messages "Messages" :group misc :require sawfish.wm.util.prompt)
 (autoload-placement-mode 'first-fit 'sawfish.wm.placement.smart #:for-normal t)
 (autoload-placement-mode 'best-fit 'sawfish.wm.placement.smart #:for-normal t)
 (autoload-placement-mode 'best-fit-group 'sawfish.wm.placement.smart #:for-normal t)
diff --git a/lisp/sawfish/wm/util/prompt.jl b/lisp/sawfish/wm/util/prompt.jl
index 45859ec..bc2522f 100644
--- a/lisp/sawfish/wm/util/prompt.jl
+++ b/lisp/sawfish/wm/util/prompt.jl
@@ -1,11 +1,12 @@
 ;; prompt.jl -- read line from user
 ;; Time-stamp: <2000-02-25 22:02:54 tjp>
 ;;
+;; Copyright (C) 2008 Sergey I. Sharybin <sharybin nm ru>
 ;; Copyright (C) 2000 Topi Paavola <tjp iki fi>
 ;;   
 ;; This file is free software; you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+:q;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; Commentary:
@@ -53,9 +54,23 @@
 	  rep.regexp
 	  rep.data.ring
 	  sawfish.wm.misc
+	  sawfish.wm.colors
 	  sawfish.wm.events
 	  sawfish.wm.custom
-	  sawfish.wm.commands)
+	  sawfish.wm.commands
+	  sawfish.wm.fonts)
+
+  (defgroup messages "Messages" :group misc)
+
+(defcustom prompt-font default-font
+  "Font for prompt: \\w"
+  :type font
+  :group (misc messages))
+
+(defcustom prompt-color (cons (get-color "black") (get-color "white"))
+    "Prompt message's colors."
+    :type (pair (labelled "Foreground:" color) (labelled "Background:" color))
+    :group (misc messages))
 
   (define-structure-alias prompt sawfish.wm.util.prompt)
 
@@ -102,6 +117,25 @@ displayed. See the `display-message' function for more details.")
   (defvar prompt-completions-outdated nil)
   (defvar prompt-history-pos nil)
   (defvar prompt-saved nil)
+  (defvar prompt-attr nil)
+
+
+;; From merlin
+;; But maybe better if we'd include this util?
+
+  ;; string/font -> font
+  (define (prompt-fontify font)
+    (if (stringp font) (get-font font) font))
+
+  ;; string/color -> color
+  (define (prompt-colorify color)
+    (if (stringp color) (get-color color) color))
+
+  ;; assq with default
+  (define (prompt-assqd key alist default)
+    (if (assq key alist)
+      (assq key alist)
+      (cons key default)))
 
   (defun prompt-exit ()
     "Cancel string input."
@@ -266,12 +300,23 @@ displayed. See the `display-message' function for more details.")
 		      (prompt-display-fun prompt-result)
 		   prompt-result))
 	 (completions (prompt-format-completions)))
-      (display-message (concat completions
+     (let
+       (
+         (fg (prompt-colorify (cdr (prompt-assqd 'foreground prompt-attr (car prompt-color)))))
+         (bg (prompt-colorify (cdr (prompt-assqd 'background prompt-attr (cdr prompt-color)))))
+         (font (prompt-fontify (cdr (prompt-assqd 'font prompt-attr prompt-font))))
+       )
+       (display-message
+         (concat completions
 			      (when completions "\n\n")
 			       prompt-prompt
 			       (substring result 0 prompt-position)
 			       ?| (substring result prompt-position))
-		       `((position . ,prompt-window-position)))))
+		       `((position . ,prompt-window-position)
+             (foreground . ,fg)
+             (background . ,bg)
+             (font . , font)
+             )))))
 
   ;; Insert all unbound keys to result.
   (defun prompt-unbound-callback ()
@@ -285,7 +330,7 @@ displayed. See the `display-message' function for more details.")
       (prompt-update-display)
       t))
 
-  (defun prompt (#!optional title start)
+  (defun prompt (#!optional title start attributes)
     "Prompt the user for a string."
     (unless (stringp title)
       (setq title "Enter string:"))
@@ -300,6 +345,7 @@ displayed. See the `display-message' function for more details.")
 		  (prompt-position (length prompt-result))
 		  (prompt-history-pos 0)
 		  (prompt-saved nil)
+		  (prompt-attr attributes)
 		  (prompt-completion-position nil)
 		  (prompt-completions nil)
 		  (prompt-completions-outdated t)
@@ -340,6 +386,7 @@ displayed. See the `display-message' function for more details.")
   (defun prompt-for-command (#!optional title)
     (prompt-for-symbol title commandp commandp))
 
+
 ;;; autoloads
 
   (autoload 'prompt-for-file "sawfish/wm/util/prompt-extras")
@@ -352,6 +399,7 @@ displayed. See the `display-message' function for more details.")
   (autoload 'prompt-for-window "sawfish/wm/util/prompt-wm")
   (autoload 'prompt-for-workspace "sawfish/wm/util/prompt-wm")
 
+
 ;;; init keymap
 
   (bind-keys prompt-keymap
diff --git a/man/news.texi b/man/news.texi
index e6d31b6..7852714 100644
--- a/man/news.texi
+++ b/man/news.texi
@@ -94,6 +94,8 @@ To use the old style, put @code{(define-special-variable customize-program "sawf
 @item Added cycle-among-groups(,-backwards) commands (cycle between the most recently used window of groups) [Fernando Carmano Varo]
 
 @item Interactive placement-mode now also for transients [Christopher Bratusek]
+
+ item Improved prompt.jl (allows changing font, fg and bg color) [Sergey I. Sharybi]
 @end itemize
 
 @item Other changes:



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]