>From eae3f0ca0d483d32eb5e01eb25e9e9ddaafe303f Mon Sep 17 00:00:00 2001 From: Max Mikhanosha Date: Sat, 18 Jun 2011 23:05:16 -0400 Subject: [PATCH] Add customizable colors for selected item in the menu. (set-msg-hl-fg-color COLOR) (set-msg-hl-bg-color COLOR) if both are NIL then reverse video is used. If one of them is NIL then default background/foreground is used in its place. The escapec codes ^R/^B continue to work inside highlighted row. --- color.lisp | 161 +++++++++++++++++++++++++++++++++++------------------- primitives.lisp | 5 ++ screen.lisp | 26 +++++++++- 3 files changed, 134 insertions(+), 58 deletions(-) diff --git a/color.lisp b/color.lisp index 425feb7..a9edb5d 100644 --- a/color.lisp +++ b/color.lisp @@ -177,63 +177,110 @@ then call (update-color-map).") (*background* nil) (*reverse* nil) (*color-stack* '()) - (*color-map* (screen-color-map-normal screen))) - (when draw - (when (or (not px) - (/= (xlib:drawable-width px) (xlib:drawable-width win)) - (/= (xlib:drawable-height px) (xlib:drawable-height win))) - (when px (xlib:free-pixmap px)) - (setf px (xlib:create-pixmap :drawable win - :width (xlib:drawable-width win) - :height (xlib:drawable-height win) - :depth (xlib:drawable-depth win)) - (ccontext-px cc) px)) - (xlib:with-gcontext (gc :foreground (xlib:gcontext-background gc)) - (xlib:draw-rectangle px gc 0 0 (xlib:drawable-width px) (xlib:drawable-height px) t))) - (loop for s in strings - ;; We need this so we can track the row for each element - for i from 0 to (length strings) - do (let ((x 0) (off 0) (len (length s))) - (loop - for st = 0 then (+ en (1+ off)) - as en = (position #\^ s :start st) - do (progn - (let ((en (cond ((and en (= (1+ en) len)) nil) - ((and en (char= #\^ (char s (1+ en)))) (1+ en)) - (t en)))) - (when draw - (xlib:draw-image-glyphs px gc - (+ padx x) - (+ pady (* i height) - (xlib:font-ascent (screen-font screen))) - (subseq s st en) - :translate #'translate-id - :size 16)) - (setf x (+ x (xlib:text-width (screen-font screen) (subseq s st en) :translate #'translate-id)) - width (max width x))) - (when (and en (< (1+ en) len)) - ;; right-align rest of string? - (if (char= #\> (char s (1+ en))) - (progn - (when draw - (setf x (- (xlib:drawable-width px) (* 2 padx) - ;; get width of rest of s - (render-strings screen cc padx pady - (list (subseq s (+ en 2))) - '() nil)) - width (- (xlib:drawable-width px) (* 2 padx)))) - (setf off 1)) - (setf off (set-color screen cc s (1+ en)))))) - while en)) - when (find i highlights :test 'eql) - do (when draw (invert-rect screen px - 0 (* i height) - (xlib:drawable-width px) - height))) - (when draw - (xlib:copy-area px gc 0 0 (xlib:drawable-width px) (xlib:drawable-height px) win 0 0)) - (set-color screen cc "n" 0) - width)) + (*color-map* (screen-color-map-normal screen)) + (select-fg (screen-select-fg-color screen)) + (select-fg-bright (screen-select-bright-color screen)) + (select-bg (screen-select-bg-color screen)) + (saved-fg (ccontext-default-fg cc)) + (saved-fg-bright (ccontext-default-bright cc)) + (saved-bg (ccontext-default-bg cc)) + (have-select-colors-p (or select-fg select-bg)) + (last-select-p nil)) + (flet ((reset-colors-to-normal () + (setf (ccontext-default-fg cc) saved-fg + (ccontext-default-bright cc) saved-fg-bright + (ccontext-default-bg cc) saved-bg) + (setf (xlib:gcontext-foreground gc) + (if *reverse* + (get-bg-color screen cc *background*) + (get-fg-color screen cc *foreground*)) + (xlib:gcontext-background gc) + (if *reverse* + (get-fg-color screen cc *foreground*) + (get-bg-color screen cc *background*))))) + (when draw + (when (or (not px) + (/= (xlib:drawable-width px) (xlib:drawable-width win)) + (/= (xlib:drawable-height px) (xlib:drawable-height win))) + (when px (xlib:free-pixmap px)) + (setf px (xlib:create-pixmap :drawable win + :width (xlib:drawable-width win) + :height (xlib:drawable-height win) + :depth (xlib:drawable-depth win)) + (ccontext-px cc) px)) + (xlib:with-gcontext (gc :foreground (xlib:gcontext-background gc)) + (xlib:draw-rectangle px gc 0 0 (xlib:drawable-width px) (xlib:drawable-height px) t))) + (loop for s in strings + ;; We need this so we can track the row for each element + for i from 0 to (length strings) + when (and draw have-select-colors-p) + do (let ((select-p (find i highlights :test 'eql))) + (cond ((and select-p (not last-select-p)) + ;; set colors to select colors. Note we are + ;; overriding default colors in CC with select + ;; ones, so codes like reverse continue to work + (when select-fg + (setf (xlib:gcontext-foreground gc) select-fg) + (setf (ccontext-default-fg cc) select-fg) + (setf (ccontext-default-bright cc) select-fg-bright)) + (when select-bg + (setf (xlib:gcontext-background gc) select-bg) + (setf (ccontext-default-bg cc) select-bg) + (xlib:with-gcontext + (gc :foreground (xlib:gcontext-background gc)) + (xlib:draw-rectangle px gc + 0 (* i height) + (xlib:drawable-width px) + height t)))) + ((and last-select-p (not select-p)) + (reset-colors-to-normal))) + (setf last-select-p select-p)) + do (let ((x 0) (off 0) (len (length s))) + (loop + for st = 0 then (+ en (1+ off)) + as en = (position #\^ s :start st) + do (progn + (let ((en (cond ((and en (= (1+ en) len)) nil) + ((and en (char= #\^ (char s (1+ en)))) (1+ en)) + (t en)))) + (when draw + (xlib:draw-image-glyphs px gc + (+ padx x) + (+ pady (* i height) + (xlib:font-ascent (screen-font screen))) + (subseq s st en) + :translate #'translate-id + :size 16)) + (setf x (+ x (xlib:text-width (screen-font screen) (subseq s st en) :translate #'translate-id)) + width (max width x))) + (when (and en (< (1+ en) len)) + ;; right-align rest of string? + (if (char= #\> (char s (1+ en))) + (progn + (when draw + (setf x (- (xlib:drawable-width px) (* 2 padx) + ;; get width of rest of s + (render-strings screen cc padx pady + (list (subseq s (+ en 2))) + '() nil)) + width (- (xlib:drawable-width px) (* 2 padx)))) + (setf off 1)) + (setf off (set-color screen cc s (1+ en)))))) + while en)) + when (and draw (not have-select-colors-p) + (find i highlights :test 'eql)) + do (invert-rect screen px + 0 (* i height) + (xlib:drawable-width px) + height) + finally (when (and draw have-select-colors-p last-select-p) + (reset-colors-to-normal))) + + (when draw + (xlib:copy-area px gc 0 0 (xlib:drawable-width px) (xlib:drawable-height px) win 0 0)) + + (set-color screen cc "n" 0) + width))) ;;; FIXME: It would be nice if the output of this parser was used to ;;; draw the text, but the current drawing implementation is probably diff --git a/primitives.lisp b/primitives.lisp index 005236e..b9472e0 100644 --- a/primitives.lisp +++ b/primitives.lisp @@ -419,6 +419,11 @@ Use the window's resource name. (win-bg-color :initform nil :accessor screen-win-bg-color) (focus-color :initform nil :accessor screen-focus-color) (unfocus-color :initform nil :accessor screen-unfocus-color) + ;; Stringlist selected item highlight colors. If both nil then + ;; it reverts back to reverse video + (select-fg-color :initform nil :accessor screen-select-fg-color) + (select-bright-color :initform nil :accessor screen-select-bright-color) + (select-bg-color :initform nil :accessor screen-select-bg-color) (msg-border-width :initform nil :accessor screen-msg-border-width) (frame-outline-width :initform nil :accessor screen-frame-outline-width) (font :initform nil :accessor screen-font) diff --git a/screen.lisp b/screen.lisp index 92782e2..91885f4 100644 --- a/screen.lisp +++ b/screen.lisp @@ -36,7 +36,9 @@ set-unfocus-color set-msg-border-width set-frame-outline-width - set-font)) + set-font + set-select-fg-color + set-select-bg-color)) ;; Screen helper functions @@ -287,6 +289,28 @@ there is more than one frame." there is more than one frame." (set-any-color screen-unfocus-color color)) +(defun set-select-fg-color (color) + "Set background color for highlighted / selected row in message +window." + (if color + (dolist (s *screen-list*) + (let ((color (lookup-color s color)) + (bright (lookup-color s color))) + (adjust-color bright 0.25) + (setf (screen-select-fg-color s) (alloc-color s color)) + (setf (screen-select-bright-color s) (alloc-color s bright)))) + (dolist (s *screen-list*) + (setf (screen-select-fg-color s) nil + (screen-select-bright-color s) nil))) + (update-colors-all-screens)) + +(defun set-select-bg-color (color) + "Set background color for highlighted / selected row in message +window." + (dolist (s *screen-list*) + (setf (screen-select-bg-color s) (and color (alloc-color s color)))) + (update-colors-all-screens)) + (defun set-msg-border-width (width) "Set the border width for the message bar and input bar." -- 1.7.3.4