Commit 5b04897f authored by David Byers's avatar David Byers
Browse files

Work on new face code. Face schemes are out and face variables are

in. This means that you can have different settings for different
sessions and servers. Your old settings should do nothing useful any
more. Everything will be customizable through kom-customize, but
that's not done yet.

You should restart Emacs to load these changes. Attempting to load
over a running elisp client will probably only lead to grief.

This commit has not been tested very much. You have been warned.


Detailed changes:
> 	Work on new face code:
> 	* view-text.el (lyskom-view-text): Send evaluated face properties
> 	to lyskom-format.
> 	(lyskom-print-text): Ditto.
>
> 	* utilities.el (lyskom-check-configuration): Send evaluated face
> 	properties to lyskom-format.
>
> 	* startup.el (lyskom): Send evaluated face properties to
> 	lyskom-format.
>
> 	* commands2.el (kom-status-conf): Send evaluated face properties
> 	to lyskom-format.
> 	(kom-status-person): Ditto.
> 	(lyskom-send-message): Ditto.
> 	(kom-obsolete-extended-command-binding): Ditto.
>
> 	* commands1.el (kom-delete-text): Send evaluated face properties
> 	to lyskom-format.
>
> 	* async.el (lyskom-show-logged-in-person): Send evaluated face
> 	properties to lyskom-format.
> 	(lyskom-show-logged-out-person): Ditto.
> 	(lyskom-format-as-personal-message): Ditto.
>
> 	* check-strings.el (lyskom-check-strings): Removed all
> 	face-related goop.
>
> 	* vars.el.in: Removed all face-related goop.
>
> 	* faces.el: New file.
>
> 	* startup.el (lyskom): Call lyskom-setup-faces-for-buffer, not
> 	lyskom-setup-faces.
>
> 	* option-edit.el (kom-customize): Evaluate face variables instead
> 	of quoting face names.
>
> 	* mship-edit.el (lp--format-entry): Evaluate face variables
> 	instead of quoting face names.
> 	(lp--redraw-entry-mark): Ditto.
>
> 	* lyskom-rest.el (kom-next-command): Evaluate face variables
> 	instead of quoting face names
> 	(lyskom-format-aux-help): Ditto.
>
> 	* lyskom-buttons.el (lyskom-button-add-links): Evaluate face
> 	variable kom-url-face instead of quoting face name.
> 	(lyskom-button-get-face): Evaluate the face found for the button
> 	type.
> 	(lyskom-generate-button): Evaluate face variables instead of
> 	quoting face names
> 	(lyskom-default-button): Ditto.
>
> 	* keyboard-menu.el (lyskom-keyboard-menu-highlight-selected):
> 	Evaluate face variable, instead of quoting face name
> 	kom-mark-face.
>
> 	More flexible date parser:
> 	* utilities.el (lyskom-all-prefixes): New function.
> 	(lyskom-parse-date): Permit prefixes for "days", "years",
> 	"months". Allow whitespace before and after input. Do not require
> 	minus sign when specifying number of days. Do not require
> 	whitespace separators in several places. Permit spaces around
> 	separators. Accept space as a separator.
>
parent 50b57656
2003-01-01 David Byers <david.byers@swipnet.se>
Work on new face code:
* view-text.el (lyskom-view-text): Send evaluated face properties
to lyskom-format.
(lyskom-print-text): Ditto.
* utilities.el (lyskom-check-configuration): Send evaluated face
properties to lyskom-format.
* startup.el (lyskom): Send evaluated face properties to
lyskom-format.
* commands2.el (kom-status-conf): Send evaluated face properties
to lyskom-format.
(kom-status-person): Ditto.
(lyskom-send-message): Ditto.
(kom-obsolete-extended-command-binding): Ditto.
* commands1.el (kom-delete-text): Send evaluated face properties
to lyskom-format.
* async.el (lyskom-show-logged-in-person): Send evaluated face
properties to lyskom-format.
(lyskom-show-logged-out-person): Ditto.
(lyskom-format-as-personal-message): Ditto.
* check-strings.el (lyskom-check-strings): Removed all
face-related goop.
* vars.el.in: Removed all face-related goop.
* faces.el: New file.
* startup.el (lyskom): Call lyskom-setup-faces-for-buffer, not
lyskom-setup-faces.
* option-edit.el (kom-customize): Evaluate face variables instead
of quoting face names.
* mship-edit.el (lp--format-entry): Evaluate face variables
instead of quoting face names.
(lp--redraw-entry-mark): Ditto.
* lyskom-rest.el (kom-next-command): Evaluate face variables
instead of quoting face names
(lyskom-format-aux-help): Ditto.
* lyskom-buttons.el (lyskom-button-add-links): Evaluate face
variable kom-url-face instead of quoting face name.
(lyskom-button-get-face): Evaluate the face found for the button
type.
(lyskom-generate-button): Evaluate face variables instead of
quoting face names
(lyskom-default-button): Ditto.
* keyboard-menu.el (lyskom-keyboard-menu-highlight-selected):
Evaluate face variable, instead of quoting face name
kom-mark-face.
More flexible date parser:
* utilities.el (lyskom-all-prefixes): New function.
(lyskom-parse-date): Permit prefixes for "days", "years",
"months". Allow whitespace before and after input. Do not require
minus sign when specifying number of days. Do not require
whitespace separators in several places. Permit spaces around
separators. Accept space as a separator.
Fix bug 921:
* commands1.el (kom-jump): Use lyskom-read-text-no-prefix-arg.
Print which text we're skipping comments from. Print special
......
......@@ -70,6 +70,7 @@ LANGUAGE-EL := $(LANGUAGES:=-strings.el) $(LANGUAGES:=-help.el)
# Finally, other source files.
SOURCES = komtypes.el \
clienttypes.el \
faces.el \
deferred-insert.el \
utilities.el \
completing-read.el \
......
......@@ -376,12 +376,12 @@ according to the value of FLAG."
(if conf-stat
(lyskom-format-insert-before-prompt 'has-entered-r conf-stat
(and kom-text-properties
'(face kom-presence-face))
`(face ,kom-presence-face))
server)
(lyskom-format-insert-before-prompt 'has-entered-r
(lyskom-get-string 'unknown-person)
(and kom-text-properties
'(face kom-presence-face))
`(face ,kom-presence-face))
server))))))
......@@ -407,12 +407,12 @@ according to the value of FLAG."
(if conf-stat
(lyskom-format-insert-before-prompt 'has-left-r conf-stat
(and kom-text-properties
'(face kom-presence-face))
`(face ,kom-presence-face))
server)
(lyskom-format-insert-before-prompt 'has-left-r
(lyskom-get-string 'unknown-person)
(and kom-text-properties
'(face kom-presence-face))
`(face ,kom-presence-face))
server))))))
......@@ -533,9 +533,9 @@ Non-nil NOBEEP means don't beep."
message
when
(when kom-async-highlight-dashed-lines
'(face kom-async-dashed-lines-face))
`(face ,kom-async-dashed-lines-face))
(when kom-async-highlight-text-body
'(face kom-async-text-body-face))))
`(face ,kom-async-text-body-face))))
((= (conf-stat->conf-no recipient) lyskom-pers-no) ; Private
(if (not nobeep) (lyskom-beep kom-ding-on-personal-messages sender))
(lyskom-format (lyskom-get-string-sol 'message-from)
......@@ -546,9 +546,9 @@ Non-nil NOBEEP means don't beep."
message
when
(when kom-async-highlight-dashed-lines
'(face kom-async-dashed-lines-face))
`(face ,kom-async-dashed-lines-face))
(when kom-async-highlight-text-body
'(face kom-async-text-body-face))))
`(face ,kom-async-text-body-face))))
(t ; Group message
(if (not nobeep) (lyskom-beep kom-ding-on-group-messages recipient))
(lyskom-format (lyskom-get-string-sol 'message-from-to)
......@@ -563,9 +563,9 @@ Non-nil NOBEEP means don't beep."
(t (lyskom-get-string 'unknown)))
when
(when kom-async-highlight-dashed-lines
'(face kom-async-dashed-lines-face))
`(face ,kom-async-dashed-lines-face))
(when kom-async-highlight-text-body
'(face kom-async-text-body-face)))))))
`(face ,kom-async-text-body-face)))))))
......
......@@ -36,8 +36,6 @@
(lcs-message t "Checking help")
(lcs-check-help)
(lcs-message t "Checking face schemes")
(lcs-check-face-schemes)
(lcs-message t "Checking variables")
(lcs-check-language-vars)
......@@ -57,23 +55,6 @@
(or noninteractive
(display-buffer lcs-message-buffer)))
(defun lcs-check-face-schemes ()
"Check that all face schemes seem to be OK."
(lyskom-traverse scheme lyskom-face-schemes
(let ((faces (delq 'property (mapcar 'car (cdr scheme))))
(tmp nil))
(lyskom-traverse expected-face lyskom-faces
(if (setq tmp (memq expected-face faces))
(progn (when (memq expected-face (cdr tmp))
(lcs-message nil "(%s) Duplicate face in scheme: %s"
(car scheme) expected-face))
(setq faces (delq expected-face faces)))
(lcs-message nil "(%s) Face scheme missing face: %s"
(car scheme) expected-face)))
(lyskom-traverse extra-face faces
(lcs-message nil "(%s) Face scheme contains unknown face: %s"
(car scheme) extra-face)))))
(defun lcs-check-language-vars ()
"Check that all language-specific variables exist in all languages"
(mapcar (lambda (var)
......
......@@ -135,7 +135,7 @@
num-marks))))))
(or (eq 0 num-comments)
(progn (lyskom-format-insert "%#1@%#2t\n"
'(face kom-warning-face)
`(face ,kom-warning-face)
(lyskom-get-string 'delete-commented-text-help))
(lyskom-beep t)
(and (lyskom-j-or-n-p
......
......@@ -310,7 +310,7 @@ otherwise: the conference is read with lyskom-completing-read."
"%#1@%-17#2s"
(if (membership-type->passive
(member->membership-type member))
'(face kom-dim-face)
`(face ,kom-dim-face)
nil)
(lyskom-format-time
'date-and-time
......@@ -330,7 +330,7 @@ otherwise: the conference is read with lyskom-completing-read."
(lyskom-return-membership-type (member->membership-type member))
(if (membership-type->passive
(member->membership-type member))
'(face kom-dim-face)
`(face ,kom-dim-face)
nil)
)
(when (and (member->created-by member)
......@@ -496,7 +496,7 @@ author of that text will be shown."
"%#1@%-17#2s"
(if (membership-type->passive
(membership->type membership))
'(face kom-dim-face)
`(face ,kom-dim-face)
nil)
(lyskom-format-time
'date-and-time
......@@ -521,7 +521,7 @@ author of that text will be shown."
(membership->type membership))
(if (membership-type->passive
(membership->type membership))
'(face kom-dim-face)
`(face ,kom-dim-face)
nil)
)
(when (and (membership->created-by membership)
......@@ -667,9 +667,9 @@ send. If DONTSHOW is non-nil, don't display the sent message."
lyskom-message-string
lyskom-message-recipient
(when kom-async-highlight-dashed-lines
'(face kom-async-dashed-lines-face))
`(face ,kom-async-dashed-lines-face))
(when kom-async-highlight-text-body
'(face kom-async-text-body-face)))
`(face ,kom-async-text-body-face)))
lyskom-pers-no
kom-filter-outgoing-messages))
(lyskom-format-insert-before-prompt
......@@ -2977,14 +2977,15 @@ ignoreras all inmatning tills du trycker enter n
Tryck p enter fr att fortstta.
----------------------------------------------------------------
"
'(face kom-warning-face))
`(face ,kom-warning-face))
;; Beep both visibly and audibly, if possible. We *want* to be annoying.
(let ((visible-bell t))
(ding))
(let ((visible-bell nil))
(ding))
(read-from-minibuffer
(lyskom-format "%#1@Tryck return eller enter fr att g vidare: " '(face kom-warning-face))))
(lyskom-format "%#1@Tryck return eller enter fr att g vidare: "
`(face ,kom-warning-face))))
(defun kom-obsolete-who-is-on-in-conference ()
......
......@@ -1817,13 +1817,6 @@ giving the command \"Save options\".\n\n")
(keyboard-cancel . "Cancel")
(keyboard-menu-help . "(choose: C-n, C-p; confirm: RET)")
(customize-help . "See the beginning of the buffer for more information")
(missing-faces . "\
Your text face scheme \"%#1s\" is missing the following faces:
%#2s
Using the default face in place of these faces.
")
(no-mule-warning . "\
......
;;;;; -*-coding: iso-8859-1;-*-
;;;;;
;;;;; $Id$
;;;;; Copyright (C) 1991-2002 Lysator Academic Computer Association.
;;;;;
;;;;; This file is part of the LysKOM Emacs LISP client.
;;;;;
;;;;; LysKOM 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)
;;;;; any later version.
;;;;;
;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;;;;; for more details.
;;;;;
;;;;; You should have received a copy of the GNU General Public License
;;;;; along with LysKOM; see the file COPYING. If not, write to
;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
;;;;; MA 02139, USA.
;;;;;
;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se.
;;;;;
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: faces.el
;;;;
;;;; Code to handle faces in LysKOM
;;;;
;;;; ================================================================
;;;; Faces in LysKOM
;;;;
;;;; There are a bunch of face variables that define witch face to use
;;;; in various roles. By using variables as a secnod level of
;;;; indirection it is possible to have divveret faces in different
;;;; buffers.
;;;;
;;;; The concept of face schemes that was used in versions up to
;;;; and including 0.47.1 is completely out the door.
;;;; ================================================================
;;;; TODO:
;;;;
;;;; Setup faces from resources? Do we need that any more? Or will
;;;; defface take care of it for us?
;;;;
;;;; Remove old code.
;;;;
;;;; In the customization buffer we need a new widget type that
;;;; can open customization of a face.
;;;;
;;;; The customization buffer should provide a choice for the
;;;; user of nil, the "factory default" and a specific face.
;;;;
;;;; Other than that, it's more or less done.
(setq lyskom-clientversion-long
(concat lyskom-clientversion-long
"$Id$\n"))
;;; ================================================================
;;; Face variables
;;;
;;; Aye, there are a lot of them.
;;;
(def-kom-var kom-active-face 'kom-face--plain--active-face
"*Face used for most \"clickable\" areas.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--active-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-url-face 'kom-face--plain--url-face
"*Face used for URLs.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--url-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-me-face 'kom-face--plain--me-face
"*Face used to show your own name.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--me-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-highlight-face 'kom-face--plain--highlight-face
"*Face used for various highlights.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--highlight.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-text-face 'kom-face--plain--text-face
"*Face used for text bodies.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--text-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-subject-face 'kom-face--plain--subject-face
"*Face used for subject lines.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--subject-fac.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-text-no-face 'kom-face--plain--text-no-face
"*Face used for text numbers.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--text-no-fac.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-friends-face 'kom-face--plain--friends-face
"*Face used for people in kom-friends.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--friends-fac.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-morons-face 'kom-face--plain--morons-face
"*Face used for people in kom-morons.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--morons-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-presence-face 'kom-face--plain--presence-face
"*Face used for presence messages.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--presence-f.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-first-line-face 'kom-face--plain--first-line-face
"*Face used for the first line header of each text.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--first-li.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-warning-face 'kom-face--plain--warning-face
"*Face used to display important warnings.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--warning-fac.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-mark-face 'kom-face--plain--mark-face
"*Face used for temporary marks.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--mark-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-dim-face 'kom-face--plain--dim-face
"*Face used to display dimmed items, such as passive memberships.
The value should be either a symbol naming a face or nil.
The default value is kom-face--plain--dim-face.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-text-body-face nil
"*Face to use to modify text bodies.
The value should be either a symbol naming a face or nil.
If this is set to nil, a face with a background that differs ever
so slightly from the default background will be created.
The default value is nil.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-dashed-lines-face nil
"*Face to use to modify the dashed lines before and after texts.
The value should be either a symbol naming a face or nil.
If this is set to nil, a face with a background that differs slightly
from the default background will be created.
The default value is nil.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-async-text-body-face nil
"*Face to use to modify asynchronos message bodies.
The value should be either a symbol naming a face or nil.
If this is set to nil, a face with a background that differs ever
so slightly from the default background will be created.
The default value is nil.
This is a LysKOM face variable."
server
inherited)
(def-kom-var kom-async-dashed-lines-face nil
"*Face to use to modify dashed lines around asynchronous messsages.
The value should be either a symbol naming a face or nil.
If this is set to nil, a face with a background that differs slightly
from the default background will be created.
The default value is nil.
This is a LysKOM face variable."
server
inherited)
;;; ================================================================
;;; Main entry points
(defun lyskom-setup-faces-for-buffer ()
"Set up faces for the current buffer."
(let ((faces (lyskom-generate-faces-for-background
(or (face-background 'default)
(frame-property (selected-frame) 'background-color)
"#ffffff"))))
;; We've generated default background faces. Now either use them
;; or lose them. If the user has selected specific faces, then
;; don't use the generated faces.
(unless (facep kom-text-body-face)
(setq kom-text-body-face (cdr (assq 'text-body faces))))
(unless (facep kom-dashed-lines-face)
(setq kom-dashed-lines-face (cdr (assq 'dashed-lines faces))))
(unless (facep kom-async-text-body-face)
(setq kom-async-text-body-face (cdr (assq 'async-text-body faces))))
(unless (facep kom-async-dashed-lines-face)
(setq kom-async-dashed-lines-face (cdr (assq 'async-dashed-lines faces))))
))
;;; ================================================================
;;; Background faces
;;;
;;; The faces for text backgrounds cannot be hard-coded. It's OK
;;; to hard-code some known alternatives, but in the general case
;;; we're better off calculating the colors.
;;;
;;; The user can specify faces for these properties, but can also
;;; specify "default", which means calculate the face.
;;;
(defvar lyskom-background-faces nil
"Pool of background faces.
This is an alist of `(COLOR . FACES)' elements, where COLOR is a
canonical representation of a background color and FACES is an
alist of automatically generated faces to use in that background.
Each element of FACES is of the form `(KEY . FACE-NAME)', where
KEY is one of `text-body', `dashed-lines', `async-text-body' or
`async-dashed-lines', and FACE-NAME is the name of the face to
use for the feature specified by KEY.
When the faces for a buffer are set, the client will look in this
pool for the appropriate faces. If none are found, new faces will
be generated and stored in the pool.
This list is not consulted at any other time.
See `lyskom-background-colors' for additional information.")
(defvar lyskom-background-colors
'(("#ffffff"
(text-body . "#f8f8ff")
(dashed-lines . "#e8e8ff")
(async-text-body . "#f8fff8")
(async-dashed-lines . "#e8ffe8"))
("#000000"
(text-body . "#080808")
(dashed-lines . "#101010")
(async-text-body . "#000020")
(async-dashed-lines . "#101030")))
"Specification for special background faces.
This is an alist of `(COLOR . SPEC)' elements, where COLOR is a color
name and SPEC is an alist specifying background colors to use when the
main background is COLOR. Elements in SPEC are `(KEY . COLOR)' where
KEY is one of `text-body', `dashed-lines', `async-text-body' or
`async-dashed-lines' and COLOR is the name of the background color to
use for the feature indicated by KEY.
This list is consulted only when generating new faces for a particular
background color. Changes to it after starting the client may have no
effect.
See `lyskom-background-faces' for additional information."
)
(defun lyskom-canonicalize-color (color)
"Create a canonical string name for color COLOR.
COLOR must be a string (a color name)"
(apply 'format
"#%02x%02x%02x"
(mapcar (lambda (x) (lsh x -8))
(lyskom-color-values color))))
(defun lyskom-generate-faces-for-background (background)
"Generate highlight faces for background BACKGROUND.
BACKGROUND must be a color name. This function updates
`lyskom-background-colors' and returns a list that has the same
structure as the value of an element in that list. See the documentation
for `lyskom-background-colors' for more information."
(let* ((color (lyskom-canonicalize-color background))
(cached (cdr (assoc color lyskom-background-faces))))
(unless cached
(let* ((text-body-face-name
(intern (format "lyskom-generated-text-body-face-%s" color)))
(dashed-lines-face-name
(intern (format "lyskom-generated-dashed-lines-face-%s" color)))
(async-text-body-face-name
(intern (format "lyskom-generated-async-text-body-face-%s" color)))
(async-dashed-lines-face-name
(intern (format "lyskom-generated-async-dashed-lines-face-%s" color)))
(predefined (cdr (assoc color lyskom-background-colors)))
(weak (lyskom-get-color-highlight (lyskom-color-values background) 0.025))
(strong (lyskom-get-color-highlight (lyskom-color-values background) 0.05))
(text-body-color (or (cdr (assq 'text-body predefined)) weak))
(dashed-lines-color (or (cdr (assq 'dashed-lines predefined)) strong))
(async-text-body-color (or (cdr (assq 'async-text-body predefined)) weak))
(async-dashed-lines-color (or (cdr (assq 'async-dashed-lines predefined)) strong))
)
(make-face text-body-face-name)
(set-face-background text-body-face-name text-body-color)
(make-face dashed-lines-face-name)
(set-face-background dashed-lines-face-name dashed-lines-color)
(make-face async-text-body-face-name)
(set-face-background async-text-body-face-name async-text-body-color)