Commit a85880b3 authored by David Byers's avatar David Byers
Browse files

Separate background color on texts.

WARNING: This version will NOT work with XEmacs. It uses overlays.
Overlays are not supported in XEmacs and I have not written code
that falls back on extents if overlays are not available.
parent 71fcf6e2
......@@ -8,7 +8,7 @@ CONTENTS
1 .................................... The Format String
2 .................................... Format Directives
2.1 ................................ Format nLetters
2.1 ................................ Format Letters
2.2 ................................ Format Arguments
2.3 ................................ Format Flags
3 .................................... Formatting Functions
......@@ -69,7 +69,14 @@ c - Interpret and insert an integer as a single character.
one of the lyskom-format-insert functions was called. The extent
of the format in the buffer is to the end of the current subformat
string or the entire format string if processing is at the top
level.
level.
$ - Start an overlay. The argument is a property list containing the
properties to set on the overlay. Overlays are only available when
calling lyskom-format-insert and lyskom-format-insert-at-point.
The extent of the overlay in the buffer is to the end of the
current subformat string or the entire format string if processing
is at the top level.
[ - Begin subformat. This directive does not use an argument.
......
......@@ -72,6 +72,13 @@ c - Interpret and insert an integer as a single character.
string or the entire format string if processing is at the top
level.
$ - Start an overlay. The argument is a property list containing the
properties to set on the overlay. Overlays are only available when
calling lyskom-format-insert and lyskom-format-insert-at-point.
The extent of the overlay in the buffer is to the end of the
current subformat string or the entire format string if processing
is at the top level.
[ - Begin subformat. This directive does not use an argument.
] - Exit subformat. This directive does not use an argument.
......@@ -103,8 +110,8 @@ n - The argument must be an integer or a text-stat. The integer or
r - The argument is a string and will be formatted as a subject line.
? - A conditional. The type of argument depends on letter-options.
Currently implemented letter-options are "d" for one-or-more and
"b" for booleans.
Currently implemented letter-options are "d" for one-or-more, "b"
for booleans and "z" for zero/nonzero.
D - Deferred text. [Describe further ...]
......@@ -280,3 +287,8 @@ strings correctly.
Internal housekeeping routine. This function is used to apply text
properties to a format state primarily when the @ format letter has
been used.
(lyskom-format-insert-overlays [start] [format-state])
Internal function that creates the overlays specified in the format
string.
2002-04-23 David Byers <david.byers@swipnet.se>
Alternate text background color:
* utilities.el (lyskom-set-face-scheme): Don't always copy default
face. Only copy a face when we explicitly ask for it.
* view-text.el (lyskom-print-text): Optionally use
kom-text-background-face on texts.
2002-04-22 David Byers <david.byers@swipnet.se>
Alternate text background color:
* vars.el.in (kom-color-text-background): New variable.
* lyskom-rest.el (lyskom-format-aux-help): Added support for $
(overlay) format specifier.
(lyskom-format-insert-overlays): New function.
(lyskom-format-insert): Call lyskom-format-insert-overlays.
(lyskom-format-insert-at-point): Call
lyskom-format-insert-overlays.
* clienttypes.el (make-format-state): Added delayed-overlays to
format state.
2002-04-22 Per Cederqvist <ceder@ceder.dyndns.org>
* lyskom-rest.el: Fix language selection code. The default case,
......
......@@ -551,7 +551,7 @@ The element last pushed is first in the list."
argl
result)
(cons 'format-state
(vector format-string start argl (length argl) result nil nil)))
(vector format-string start argl (length argl) result nil nil nil)))
(defsubst format-state-p (arg)
(eq 'format-state (car-safe arg)))
......@@ -590,6 +590,12 @@ The element last pushed is first in the list."
(defsubst set-format-state->delayed-propl (arg propl)
(aset (cdr arg) 5 propl))
(defsubst format-state->delayed-overlays (arg)
(elt (cdr arg) 7))
(defsubst set-format-state->delayed-overlays (arg overlays)
(aset (cdr arg) 7 overlays))
(defsubst format-state->delayed-content (arg)
(elt (cdr arg) 6))
......
......@@ -3450,6 +3450,8 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
(kom-extended-status-information-doc . "\
When this is on, additional information may be shown by commands that
display person, conference and server status.")
(kom-color-text-background-doc . "\
When this is on, texts are shown with an alternate background color.")
;;
......@@ -3619,6 +3621,7 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
(kom-auto-review-faqs-tag . "Review new FAQs automatically:")
(kom-auto-list-faqs-tag . "List new FAQs automatically:")
(kom-extended-status-information-tag . "Extended status information:")
(kom-color-text-background-tag . "Color text backgrounds:")
)
)
......
......@@ -1063,16 +1063,16 @@ The strings buffered are printed before the prompt by lyskom-update-prompt."
(insert " ")
(backward-char)
(remove-text-properties (point) (+ (point) 1) (text-properties-at (point)))
(lyskom-do-insert string)
(lyskom-do-insert string)
(delete-char 1))
(goto-char oldpoint))
(let ((window (get-buffer-window (current-buffer))))
(if (and window
(not (pos-visible-in-window-p (point) window)))
;; This mease that the prompt has been pushed off the bottom
(save-selected-window
(select-window window)
(recenter -1)))))))
(not (pos-visible-in-window-p (point) window)))
;; This mease that the prompt has been pushed off the bottom
(save-selected-window
(select-window window)
(recenter -1)))))))
(defun lyskom-message (format-string &rest args)
......@@ -1103,7 +1103,7 @@ Args: FORMAT-STRING &rest ARGS"
(defvar lyskom-format-format
"%\\(=\\)?\\(-?[0-9]+\\)?\\(#\\([0-9]+\\)\\)?\\(:\\)?\\(&\\)?\\([][@MmPpnrtsdoxcCSDF?]\\)"
"%\\(=\\)?\\(-?[0-9]+\\)?\\(#\\([0-9]+\\)\\)?\\(:\\)?\\(&\\)?\\([][$@MmPpnrtsdoxcCSDF?]\\)"
"regexp matching format string parts.")
(defun lyskom-insert-string (atom)
......@@ -1115,6 +1115,16 @@ Args: FORMAT-STRING &rest ARGS"
(defun lyskom-format (format-string &rest argl)
(format-state->result (lyskom-do-format format-string argl)))
(defun lyskom-format-insert-overlays (start format-state)
"Insert delayed overlays according to FORMAT-STATE."
(lyskom-traverse overlay (format-state->delayed-overlays format-state)
(let ((overlay (make-overlay (+ start (aref overlay 0))
(+ start (aref overlay 1))))
(args (aref overlay 2)))
(while args
(overlay-put overlay (car args) (car (cdr args)))
(setq args (nthcdr 2 args))))))
(defun lyskom-format-insert (format-string &rest argl)
"Format and insert a string according to FORMAT-STRING.
The string is inserted at the end of the buffer with `lyskom-insert'."
......@@ -1122,13 +1132,16 @@ The string is inserted at the end of the buffer with `lyskom-insert'."
;; We have to use a marker, because lyskom-insert may trim
;; the buffer size.
(start (point-max-marker))
(deferred (format-state->delayed-content state)))
(deferred (format-state->delayed-content state))
(insert-start (point-max)))
(lyskom-insert (format-state->result state))
(lyskom-format-insert-overlays insert-start state)
(while deferred
(let ((defer-info (car deferred))
(m (make-marker)))
(set-marker m (+ start (defer-info->pos defer-info)))
(set-defer-info->pos defer-info m)
(set-defer-info->pos defer-info m)
(lyskom-defer-insertion defer-info)
(setq deferred (cdr deferred))))
(set-marker start nil)))
......@@ -1140,11 +1153,12 @@ The string is inserted at point."
(start (point))
(deferred (format-state->delayed-content state)))
(lyskom-insert-at-point (format-state->result state))
(lyskom-format-insert-overlays start state)
(while deferred
(let ((defer-info (car deferred))
(m (make-marker)))
(set-marker m (+ start (defer-info->pos defer-info)))
(set-defer-info->pos defer-info m)
(set-defer-info->pos defer-info m)
(lyskom-defer-insertion defer-info)
(setq deferred (cdr deferred))))))
......@@ -1154,7 +1168,7 @@ The string is inserted just before the prompt, and if the prompt is not
currently visible the text is queued to be inserted when the prompt
reappears.
Note that it is not allowed to use deferred insertions in the text."
Deferred insertions and overlays are not supported."
(lyskom-insert-before-prompt
(format-state->result (lyskom-do-format format-string argl))))
......@@ -1400,6 +1414,19 @@ Note that it is not allowed to use deferred insertions in the text."
(cons (cons (length (format-state->result format-state))
arg)
(format-state->delayed-propl format-state))))
;;
;; Format an overlay
;;
((= format-letter ?$)
(when arg
(let ((overlay (make-overlay 0 0)))
(set-format-state->delayed-overlays
format-state
(cons (vector (length (format-state->result format-state))
nil
arg)
(format-state->delayed-overlays format-state))))))
;;
;; Format a subformat list by recursively formatting the contents
;; of the list, augmenting the result and format state
......@@ -1780,7 +1807,6 @@ Note that it is not allowed to use deferred insertions in the text."
(set-format-state->start format-state (match-end 0)))))))
(defun lyskom-tweak-format-state (format-state)
(let ((dp (format-state->delayed-propl format-state)))
(while dp
......@@ -1790,6 +1816,11 @@ Note that it is not allowed to use deferred insertions in the text."
(format-state->result format-state))
(setq dp (cdr dp)))
(set-format-state->delayed-propl format-state nil))
(lyskom-traverse overlay-spec (format-state->delayed-overlays format-state)
(unless (aref overlay-spec 1)
(aset overlay-spec 1 (length (format-state->result format-state)))))
format-state)
......
......@@ -182,6 +182,7 @@
[kom-smileys]
[kom-w3-simplify-body]
"\n"
[kom-color-text-background]
[kom-dashed-lines]
[kom-long-lines]
[kom-text-footer-format]
......@@ -480,7 +481,8 @@ customize buffer but do not save them to the server."
"List of user variables not in lyskom-custom-variables.")
(defvar lyskom-custom-variables
'((kom-personal-messages-in-window (open-window))
'((kom-color-text-background (toggle (on off)))
(kom-personal-messages-in-window (open-window))
(kom-write-texts-in-window (open-window))
(kom-list-membership-in-window (open-window))
(kom-edit-filters-in-window (open-window))
......
......@@ -3905,6 +3905,9 @@ i servern. Annars sparas det i din .emacs.")
Om detta r pslaget so visas extra statusinformation i kommandona
Status (fr) person, Status (fr) mte och Status (fr) servern
(om sdan information finns tillgnglig).")
(kom-color-text-background-doc . "\
Om detta r pslaget s visas inlggstexter med en annorlunda
bakgrundsfrg n resten av LysKOM.")
;;
......@@ -4074,6 +4077,7 @@ i servern. Annars sparas det i din .emacs.")
(kom-auto-review-faqs-tag . "Visa nya FAQer automatiskt:")
(kom-auto-list-faqs-tag . "Lista nya FAQer automatiskt:")
(kom-extended-status-information-tag . "Utkad statusinformation:")
(kom-color-text-background-tag . "Annorlunda bakgrundsfrg p inlgg:")
)
)
......
......@@ -883,13 +883,14 @@ in lyskom-face-schemes."
(fboundp 'lyskom-set-face-foreground)
(fboundp 'lyskom-set-face-background))
(mapcar
(function
(lambda (spec)
(lyskom-copy-face (or (elt spec 1) 'default) (elt spec 0))
(if (elt spec 2)
(lyskom-set-face-foreground (elt spec 0) (elt spec 2)))
(if (elt spec 3)
(lyskom-set-face-background (elt spec 0) (elt spec 3)))))
(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)))))
......
......@@ -101,6 +101,13 @@ are in the list.")
;;; User flags
(def-kom-var kom-color-text-background t
"*If t, use an alternate background color for texts in LysKOM.
If nil, do not use an alternate background. Other values are reserved
for future use."
server
)
(def-kom-var kom-extended-status-information t
"*If t, list extended status information for all objects in LysKOM.
Extended status information include such information as read FAQs.
......@@ -2785,6 +2792,7 @@ the value of kom-tell-phrases for fun.")
(def-kom-var lyskom-face-schemes
'((default
(kom-text-background-face nil nil "#f8f8ff")
(kom-active-face default "blue4" nil)
(kom-url-face default "BlueViolet" nil)
(kom-me-face bold "blue3" "lavender")
......@@ -2800,6 +2808,7 @@ the value of kom-tell-phrases for fun.")
(kom-first-line-face default nil nil)
(kom-dim-face default "gray" nil))
(inverse
(kom-text-background-face nil nil "#080808")
(kom-active-face default "lightblue" nil)
(kom-url-face default "Moccasin" nil)
(kom-me-face bold "gold" "black")
......@@ -2815,6 +2824,7 @@ the value of kom-tell-phrases for fun.")
(kom-first-line-face default nil nil)
(kom-dim-face default "gray" nil))
(monochrome
(kom-text-background-face nil nil nil)
(kom-active-face default nil nil)
(kom-url-face default nil nil)
(kom-me-face bold nil nil)
......@@ -2830,6 +2840,7 @@ the value of kom-tell-phrases for fun.")
(kom-first-line-face default nil nil)
(kom-dim-face default nil nil))
(minimal
(kom-text-background-face nil nil nil)
(kom-active-face default nil nil)
(kom-url-face default nil nil)
(kom-me-face default nil "lavender")
......@@ -2845,6 +2856,7 @@ the value of kom-tell-phrases for fun.")
(kom-first-line-face default nil nil)
(kom-dim-face default nil nil))
(highlight
(kom-text-background-face nil nil "#f8f8ff")
(kom-active-face default nil "aliceblue")
(kom-url-face default nil "yellow")
(kom-me-face bold "darkblue" "thistle")
......
......@@ -903,8 +903,14 @@ Args: TEXT-STAT TEXT MARK-AS-READ TEXT-NO FLAT-REVIEW."
pos nil
truncated t)))))
(let ((lyskom-current-function-phase 'body))
(lyskom-format-insert "%#1t\n" (cons text-stat body)))
(let ((lyskom-current-function-phase 'body)
(start (point)))
(lyskom-format-insert "%#2$%#1t\n"
(cons text-stat body)
(and kom-color-text-background
'(face kom-text-background-face)))
; (overlay-put (make-overlay start (point)) 'face 'foo-face)
)
;; Indicate that the text was truncated
(if truncated
......@@ -919,7 +925,10 @@ Args: TEXT-STAT TEXT MARK-AS-READ TEXT-NO FLAT-REVIEW."
(lyskom-insert
(make-string kom-text-header-dash-length ?-)))
(lyskom-insert "\n")
(lyskom-format-insert "%#1t\n" (cons text-stat str))
(lyskom-format-insert "%#2$%#1t\n"
(cons text-stat str)
(and kom-color-text-background
'(face kom-text-background-face)))
(setq lyskom-current-subject "")))
(sit-for 0)
(let* ((lyskom-current-function-phase 'footer)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment