Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
lyskom-elisp-client
lyskom-elisp-client
Commits
43d0037b
Commit
43d0037b
authored
May 08, 2002
by
David Byers
Browse files
Implement automatic color selection for highlight faces.
Added key bindings forkom-filter-subject.
parent
191f96cd
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/ChangeLog
View file @
43d0037b
2002-05-08 David Byers <david.byers@swipnet.se>
Automatic color selection for highlight colors:
* compatibility.el (lyskom-color-values): Smarter definition that
can handle both strings and specifiers in XEmacs.
* vars.el.in (lyskom-face-schemes): Added incredibly ugly hack to
put properties in lyskom-face-schemes.
* utilities.el (lyskom-get-color-highlight): Modified to take list
of RGB and distance from 0 to 1.
Bug 525:
* swedish-strings.el (lyskom-sv-mode-map): Bind fm till
kom-filter-recipient.
* english-strings.el (lyskom-en-mode-map): Bind fr till
kom-filter-recipient.
2002-05-07 David Byers <david.byers@swipnet.se>
Every KOM client needs color model conversion code:
...
...
src/compatibility.el
View file @
43d0037b
...
...
@@ -597,17 +597,20 @@ Otherwise treat \\ in NEWTEXT string as special:
;;; ================================================================
;;; Color stuff
(
defun
lyskom-color-values
(
color
&optional
frame
)
(
defun
lyskom-color-values
(
color
)
nil
)
(
eval-and-compile
(
cond
((
fboundp
'color-values
)
(
fset
'lyskom-color-values
'color-values
))
((
fboundp
'x-color-values
)
(
fset
'lyskom-color-values
'x-color-values
))
((
fboundp
'make-specifier
)
(
defun
lyskom-color-values
(
color
&optional
frame
)
(
let
((
spec
(
make-specifier
'color
)))
(
set-specifier
spec
color
)
(
color-rgb-components
spec
))))))
((
and
(
fboundp
'color-rgb-components
)
(
fboundp
'make-specifier
))
(
defun
lyskom-color-values
(
color
)
(
when
(
stringp
color
)
(
let
((
spec
nil
))
(
set-specifier
(
setq
spec
(
make-specifier
'color
))
color
)
(
setq
color
spec
)))
(
color-rgb-components
color
)))
((
fboundp
'x-color-values
)
(
fset
'lyskom-color-values
'x-color-values
))))
;;; ======================================================================
...
...
src/english-strings.el
View file @
43d0037b
...
...
@@ -2222,6 +2222,7 @@ Number of sessions: %21#1d (total)
(define-key lyskom-en-mode-map (kbd "
f
s
") 'kom-filter-subject)
(define-key lyskom-en-mode-map (kbd "
f
a
") 'kom-filter-author)
(define-key lyskom-en-mode-map (kbd "
f
c
") 'kom-filter-text)
(define-key lyskom-en-mode-map (kbd "
f
r
") 'kom-filter-recipient)
(define-key lyskom-en-mode-map (kbd "
w
w
") 'kom-who-is-on)
(define-key lyskom-en-mode-map (kbd "
w
c
") 'kom-who-is-on-in-conference)
(define-key lyskom-en-mode-map (kbd "
w
p
") 'kom-who-is-present-in-conference)
...
...
src/swedish-strings.el
View file @
43d0037b
...
...
@@ -2682,6 +2682,7 @@ Visar vilka som f
(define-key lyskom-sv-mode-map (kbd "
f
[
") 'kom-filter-subject)
(define-key lyskom-sv-mode-map (kbd "
f
f
") 'kom-filter-author)
(define-key lyskom-sv-mode-map (kbd "
f
i
") 'kom-filter-text)
(define-key lyskom-sv-mode-map (kbd "
f
m
") 'kom-filter-recipient)
(define-key lyskom-sv-mode-map (kbd "
v
i
") 'kom-who-is-on)
(define-key lyskom-sv-mode-map (kbd "
v
m
") 'kom-who-is-on-in-conference)
(define-key lyskom-sv-mode-map (kbd "
v
n
") 'kom-who-is-present-in-conference)
...
...
src/utilities.el
View file @
43d0037b
...
...
@@ -858,6 +858,9 @@ for strings."
;;; Faces
;;;
(
make-face
'lyskom-weak-highlight-face
)
(
make-face
'lyskom-strong-highlight-face
)
(
defun
lyskom-set-face-foreground
(
face
color
)
(
condition-case
nil
(
set-face-foreground
face
color
)
...
...
@@ -877,26 +880,47 @@ for strings."
(
defun
lyskom-set-face-scheme
(
scheme
)
"Set the LysKOM color and face scheme to SCHEME. Valid schemes are listed
in lyskom-face-schemes."
(
let
((
tmp
(
assoc
scheme
lyskom-face-schemes
)))
(
let
((
tmp
(
assoc
scheme
lyskom-face-schemes
))
(
properties
nil
)
(
background
(
or
(
face-background
'default
)
(
frame-property
(
selected-frame
)
'background-color
))))
(
when
(
and
tmp
(
fboundp
'copy-face
)
(
fboundp
'lyskom-set-face-foreground
)
(
fboundp
'lyskom-set-face-background
))
(
mapcar
(
lambda
(
spec
)
(
if
(
elt
spec
1
)
(
lyskom-copy-face
(
elt
spec
1
)
(
elt
spec
0
))
(
make-face
(
elt
spec
0
)))
(
when
(
elt
spec
2
)
(
lyskom-set-face-foreground
(
elt
spec
0
)
(
elt
spec
2
)))
(
when
(
elt
spec
3
)
(
lyskom-set-face-background
(
elt
spec
0
)
(
elt
spec
3
))))
(
cdr
tmp
)))))
;; If we have a background color, then compute the highlight colors
(
when
background
(
lyskom-set-face-background
'lyskom-strong-highlight-face
(
lyskom-get-color-highlight
(
lyskom-color-values
background
)
0.05
))
(
lyskom-set-face-background
'lyskom-weak-highlight-face
(
lyskom-get-color-highlight
(
lyskom-color-values
background
)
0.025
)))
;; Traverse face specifications in the face scheme
(
lyskom-traverse
spec
(
cdr
tmp
)
(
if
(
eq
'property
(
car
spec
))
(
setq
properties
(
cons
(
cons
(
elt
spec
1
)
(
elt
spec
2
))
properties
))
(
if
(
elt
spec
1
)
(
lyskom-copy-face
(
elt
spec
1
)
(
elt
spec
0
))
(
make-face
(
elt
spec
0
)))
(
when
(
elt
spec
2
)
(
lyskom-set-face-foreground
(
elt
spec
0
)
(
elt
spec
2
)))
(
when
(
elt
spec
3
)
(
lyskom-set-face-background
(
elt
spec
0
)
(
elt
spec
3
)))))
;; Check that the background color of the default face is what
;; the face scheme expects. If not, copy the computed highlight
;; faces to the real highlight faces.
(
when
(
and
background
(
assq
'expected-background
properties
))
(
unless
(
equal
(
lyskom-color-values
(
cdr
(
assq
'expected-background
properties
)))
(
lyskom-color-values
background
))
(
copy-face
'lyskom-strong-highlight-face
'kom-dashed-lines-face
)
(
copy-face
'lyskom-weak-highlight-face
'kom-text-body-face
))))))
(
defun
lyskom-face-resource
(
face-name
attr
type
)
(
if
(
eq
(
lyskom-emacs-version
)
'xemacs
)
;; XEmac style
;; XEmac
s
style
(
let
((
val
(
x-get-resource
(
concat
face-name
".attribute"
attr
)
(
concat
"Face.Attribute"
attr
)
type
)))
...
...
@@ -934,23 +958,20 @@ also reads the proper X resources."
(
error
'default
))))
(
lyskom-set-face-scheme
kom-default-face-scheme
)
(
if
(
eq
(
console-type
)
'x
)
(
mapcar
(
function
(
lambda
(
face
)
(
let*
((
face-name
(
symbol-name
face
))
(
fg
(
lyskom-face-resource
face-name
"Foreground"
'string
))
(
bg
(
lyskom-face-resource
face-name
"Background"
'string
))
(
bl
(
lyskom-face-resource
face-name
"Bold"
'boolean
))
(
it
(
lyskom-face-resource
face-name
"Italic"
'boolean
))
(
ul
(
lyskom-face-resource
face-name
"Underline"
'boolean
)))
(
if
fg
(
set-face-foreground
face
fg
))
(
if
bg
(
set-face-background
face
bg
))
(
if
(
eq
bl
'on
)
(
lyskom-modify-face
'bold
face
))
(
if
(
eq
bl
'off
)
(
lyskom-modify-face
'unbold
face
))
(
if
(
eq
it
'on
)
(
lyskom-modify-face
'italic
face
))
(
if
(
eq
it
'off
)
(
lyskom-modify-face
'unitalic
face
))
(
if
ul
(
set-face-underline-p
face
(
eq
ul
'on
))))))
lyskom-faces
)))
(
lyskom-traverse
face
lyskom-faces
(
let*
((
face-name
(
symbol-name
face
))
(
fg
(
lyskom-face-resource
face-name
"Foreground"
'string
))
(
bg
(
lyskom-face-resource
face-name
"Background"
'string
))
(
bl
(
lyskom-face-resource
face-name
"Bold"
'boolean
))
(
it
(
lyskom-face-resource
face-name
"Italic"
'boolean
))
(
ul
(
lyskom-face-resource
face-name
"Underline"
'boolean
)))
(
if
fg
(
set-face-foreground
face
fg
))
(
if
bg
(
set-face-background
face
bg
))
(
if
(
eq
bl
'on
)
(
lyskom-modify-face
'bold
face
))
(
if
(
eq
bl
'off
)
(
lyskom-modify-face
'unbold
face
))
(
if
(
eq
it
'on
)
(
lyskom-modify-face
'italic
face
))
(
if
(
eq
it
'off
)
(
lyskom-modify-face
'unitalic
face
))
(
if
ul
(
set-face-underline-p
face
(
eq
ul
'on
)))))))
;;; ============================================================
...
...
@@ -1432,14 +1453,15 @@ in the 20th century")
(
defun
lyskom-get-color-highlight
(
color
distance
)
"Create a highlight color for COLOR that is DISTANCE away.
COLOR is a string naming the color and DISTANCE is a non-negative
integer no larger than 255, that in some way specifies how far
away from the original color the new color should be."
(
let*
((
hls
(
lyskom-rgb-to-hls
(
lyskom-string-to-rgb
color
)))
COLOR is a list of R G and B components from 0 to 65535.
DISTANCE is a non-negative integer no larger than 1.0, that in some
way specifies how far away from the original color the new color
should be."
(
let*
((
hls
(
lyskom-rgb-to-hls
(
mapcar
(
lambda
(
x
)
(
/
x
65535.0
))
color
)))
(
l
(
elt
hls
1
)))
(
if
(
>
l
0.6
)
(
setq
l
(
-
l
(
/
distance
255.0
)
))
(
setq
l
(
+
l
(
/
distance
255.0
)
)))
(
setq
l
(
-
l
distance
))
(
setq
l
(
+
l
distance
)))
(
cond
((
>
l
1.0
)
(
setq
l
1.0
))
((
<
l
0.0
)
(
setq
l
0.0
)))
(
aset
hls
1
l
)
...
...
@@ -1555,50 +1577,50 @@ has the bug in that algorithm fixed)."
;;; (setq g (+ g step)))
;;; (setq r (+ r step)))))
;;;
(defun lyskom-test-auto-colors ()
;;;
(make-face 'test-1)
;;;
(make-face 'test-2)
;;;
(make-face 'test-default)
;;;
(while t
;;;
(let ((foreground (read-from-minibuffer "Foreground: "))
;;;
(background (read-from-minibuffer "Background: ")))
;;;
(pop-to-buffer (get-buffer-create "*kom*-test"))
;;;
(erase-buffer)
;;;
(set-face-foreground 'test-default foreground)
;;;
(set-face-background 'test-default background)
;;;
(set-face-background 'test-1 (lyskom-get-color-highlight background
16
))
;;;
(set-face-background 'test-2 (lyskom-get-color-highlight background
8
))
;;;
(let ((lyskom-buffer (current-buffer)))
;;;
(lyskom-format-insert "\
;;;
%#3@Lsa nsta fotnot...
;;;
8408827 idag 00:40 /1 rad/ Lunkwill/CH ( Auf das Universum! )
;;;
Fotnot till text 8408825 av Lunkwill/CH ( Auf das Universum! )
;;;
Mottagare: Ntverk, Internet, LysNET, Sunet... <30873>
;;;
Mottagare: SUBnet (Stngstadens och LiU:s) studentbostadsnt <12152>
;;;
Mottagare: Lunkwill/CH ( Auf das Universum! ) <2092>
;;;
rende: Vrmtet
;;;
%[%#1$------------------------------------------------------------
;;;
%]%[%#2$Och tack s mycket fr frklaringarna! =)
;;;
%]%[%#1$(8408827) /Lunkwill/CH ( Auf das Universum! )/------
;;;
%]G till nsta mte...
;;;
SUN erfarenhetsutbyte - 1 olst
;;;
Lsa nsta text...
;;;
8408823 idag 00:39 /4 rader/ Erik Persson, Lysato(r)
;;;
Kommentar till text 8407161 av Dejan (ngot desperat)
;;;
Mottagare: SUN erfarenhetsutbyte <23622>
;;;
rende: Skapa partitionstabell
;;;
%[%#1$------------------------------------------------------------
;;;
%]%[%#2$Om du nu vill spela Fibre Channel med IDE-RAID s gr du ver n efter
;;;
vatten. Det finns redan IDE-RAID med FC-interface. Dock har jag inte
;;;
sett ngon som stdjer ngot annat n FC-AL vilket r lite
;;;
begrnsande.
;;;
%]%[%#1$(8408823) ------------------------------------------
;;;
%]G till nsta mte...
;;;
;;;
;;;
;;;
"
;;;
'(face test-1)
;;;
'(face test-2)
;;;
'(face test-default))))))
;;;(defun lyskom-test-auto-colors ()
;;; (make-face 'test-1)
;;; (make-face 'test-2)
;;; (make-face 'test-default)
;;; (while t
;;; (let ((foreground (read-from-minibuffer "Foreground: "))
;;; (background (read-from-minibuffer "Background: ")))
;;; (pop-to-buffer (get-buffer-create "*kom*-test"))
;;; (erase-buffer)
;;; (set-face-foreground 'test-default foreground)
;;; (set-face-background 'test-default background)
;;; (set-face-background 'test-1 (lyskom-get-color-highlight
(x-color-values
background
) 0.05
))
;;; (set-face-background 'test-2 (lyskom-get-color-highlight
(x-color-values
background
) 0.025
))
;;; (let ((lyskom-buffer (current-buffer)))
;;; (lyskom-format-insert "\
;;;%#3@Lsa nsta fotnot...
;;;8408827 idag 00:40 /1 rad/ Lunkwill/CH ( Auf das Universum! )
;;;Fotnot till text 8408825 av Lunkwill/CH ( Auf das Universum! )
;;;Mottagare: Ntverk, Internet, LysNET, Sunet... <30873>
;;;Mottagare: SUBnet (Stngstadens och LiU:s) studentbostadsnt <12152>
;;;Mottagare: Lunkwill/CH ( Auf das Universum! ) <2092>
;;;rende: Vrmtet
;;;%[%#1$------------------------------------------------------------
;;;%]%[%#2$Och tack s mycket fr frklaringarna! =)
;;;%]%[%#1$(8408827) /Lunkwill/CH ( Auf das Universum! )/------
;;;%]G till nsta mte...
;;;SUN erfarenhetsutbyte - 1 olst
;;;Lsa nsta text...
;;;8408823 idag 00:39 /4 rader/ Erik Persson, Lysato(r)
;;;Kommentar till text 8407161 av Dejan (ngot desperat)
;;;Mottagare: SUN erfarenhetsutbyte <23622>
;;;rende: Skapa partitionstabell
;;;%[%#1$------------------------------------------------------------
;;;%]%[%#2$Om du nu vill spela Fibre Channel med IDE-RAID s gr du ver n efter
;;;vatten. Det finns redan IDE-RAID med FC-interface. Dock har jag inte
;;;sett ngon som stdjer ngot annat n FC-AL vilket r lite
;;;begrnsande.
;;;%]%[%#1$(8408823) ------------------------------------------
;;;%]G till nsta mte...
;;;
;;;
;;;
;;;"
;;; '(face test-1)
;;; '(face test-2)
;;; '(face test-default))))))
;;;
src/vars.el.in
View file @
43d0037b
...
...
@@ -2925,6 +2925,7 @@ the value of kom-tell-phrases for fun.")
(
kom-first-line-face
bold
nil
nil
)
(
kom-dim-face
default
"gray"
nil
)
(
kom-dashed-lines-face
nil
nil
"#e8e8ff"
)
(
property
expected-background
"white"
)
)
(
bark
(
kom-active-face
default
"Gold"
"Black"
)
...
...
@@ -2943,6 +2944,7 @@ the value of kom-tell-phrases for fun.")
(
kom-friends-face
nil
"Gold"
"Black"
)
(
kom-morons-face
nil
"Gold"
"Black"
)
(
kom-warning-face
bold
"Red"
nil
)
(
property
expected-background
"black"
)
)
(
black-and-tan
(
kom-text-body-face
nil
nil
"#f8f8f0"
)
...
...
@@ -2961,6 +2963,7 @@ the value of kom-tell-phrases for fun.")
(
kom-first-line-face
bold
nil
nil
)
(
kom-dim-face
default
"gray"
nil
)
(
kom-dashed-lines-face
nil
nil
"#f0f0e0"
)
(
property
expected-background
"white"
)
)
(
inverse
(
kom-text-body-face
nil
nil
"#080808"
)
...
...
@@ -2979,6 +2982,7 @@ the value of kom-tell-phrases for fun.")
(
kom-first-line-face
nil
nil
"black"
)
(
kom-dim-face
default
"gray"
nil
)
(
kom-dashed-lines-face
nil
nil
black
)
(
property
expected-background
"black"
)
)
(
monochrome
(
kom-text-body-face
nil
nil
nil
)
...
...
@@ -2997,6 +3001,7 @@ the value of kom-tell-phrases for fun.")
(
kom-warning-face
bold
nil
nil
)
(
kom-first-line-face
bold
nil
nil
)
(
kom-dim-face
default
nil
nil
)
(
property
expected-background
"white"
)
)
(
minimal
(
kom-text-body-face
nil
nil
nil
)
...
...
@@ -3015,6 +3020,7 @@ the value of kom-tell-phrases for fun.")
(
kom-first-line-face
nil
nil
nil
)
(
kom-dashed-lines-face
nil
nil
nil
)
(
kom-dim-face
default
nil
nil
)
(
property
expected-background
"white"
)
)
(
highlight
(
kom-text-body-face
nil
nil
"#f8f8ff"
)
...
...
@@ -3033,6 +3039,7 @@ the value of kom-tell-phrases for fun.")
(
kom-first-line-face
nil
nil
"lavender"
)
(
kom-dashed-lines-face
nil
nil
"lavender"
)
(
kom-dim-face
default
"gray"
nil
)
(
property
expected-background
"white"
)
))
"*Face schemes for LysKOM.
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment