Commit 25a25a48 authored by David Byers's avatar David Byers
Browse files

More kinds of fruit added to the salad.

Fixed bugs 471, 472, 479.

Note that loading this version in an Emacs with an old version loaded
might fail.
parent d4bfff97
2002-04-25 David Byers <david.byers@swipnet.se>
* view-text.el (lyskom-print-text): Use kom-highlight-text-body to
control highlighting text body. Use kom-highlight-first-line to
control highlighting of first line. Print first line using a
single format string. Use kom-highlight-dashed-lines to control
highlighting of dashed lines.
* vars.el.in (lyskom-face-schemes): Updated kom-first-line-face to
not inherit from default and not be invisible by default.
(kom-highlight-first-line): New variable.
(kom-highlight-dashed-lines): New variable.
(kom-highlight-text-body): Renamed from
kom-color-text-background.
Fix bug 479:
* lyskom-rest.el (lyskom-format-aux): Track depth of subformats.
(lyskom-format-aux-help): Record format-state depth with delayed
properties and delayed overlays.
(lyskom-tweak-format-state): Only add properties for delayed
property lists that are at the same current format-state depth.
Only set end positions for overlays that were created at the
current format-state depth.
2002-04-24 David Byers <david.byers@swipnet.se>
* header.el: Added a check for obsolete read-kbd-macro (found in
......
......@@ -546,61 +546,76 @@ The element last pushed is first in the list."
;;; ================================================================
;;; format-state
(defun make-format-state (format-string
start
argl
result)
(cons 'format-state
(vector format-string start argl (length argl) result nil nil nil)))
(defsubst format-state-p (arg)
(eq 'format-state (car-safe arg)))
(defsubst format-state->format-string (arg)
(elt (cdr arg) 0))
(defsubst set-format-state->format-string (arg str)
(aset (cdr arg) 0 str))
(defsubst format-state->start (arg)
(elt (cdr arg) 1))
(defsubst set-format-state->start (arg pos)
(aset (cdr arg) 1 pos))
(defsubst format-state->args (arg)
(elt (cdr arg) 2))
(defsubst set-format-state->args (arg argl)
(aset (cdr arg) 2 argl)
(aset (cdr arg) 3 (length argl)))
(defsubst format-state->args-length (arg)
(elt (cdr arg) 3))
(defsubst format-state->result (arg)
(elt (cdr arg) 4))
(defsubst set-format-state->result (arg output-list)
(aset (cdr arg) 4 output-list))
(defsubst format-state->delayed-propl (arg)
(elt (cdr arg) 5))
(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))
(defsubst set-format-state->delayed-content (arg string)
(aset (cdr arg) 6 string))
(def-komtype format-state
format-string
start
argl
length
result
delayed-propl
delayed-overlays
delayed-content
depth)
;;
;;
;;
;; (defun make-format-state (format-string
;; start
;; argl
;; result)
;; (cons 'format-state
;; (vector format-string start argl (length argl) result nil nil nil nil)))
;;
;; (defsubst format-state-p (arg)
;; (eq 'format-state (car-safe arg)))
;;
;; (defsubst format-state->format-string (arg)
;; (elt (cdr arg) 0))
;;
;; (defsubst set-format-state->format-string (arg str)
;; (aset (cdr arg) 0 str))
;;
;; (defsubst format-state->start (arg)
;; (elt (cdr arg) 1))
;;
;; (defsubst set-format-state->start (arg pos)
;; (aset (cdr arg) 1 pos))
;;
;; (defsubst format-state->args (arg)
;; (elt (cdr arg) 2))
;;
;; (defsubst set-format-state->args (arg argl)
;; (aset (cdr arg) 2 argl)
;; (aset (cdr arg) 3 (length argl)))
;;
;; (defsubst format-state->args-length (arg)
;; (elt (cdr arg) 3))
;;
;; (defsubst format-state->result (arg)
;; (elt (cdr arg) 4))
;;
;; (defsubst set-format-state->result (arg output-list)
;; (aset (cdr arg) 4 output-list))
;;
;; (defsubst format-state->delayed-propl (arg)
;; (elt (cdr arg) 5))
;;
;; (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))
;;
;; (defsubst set-format-state->delayed-content (arg string)
;; (aset (cdr arg) 6 string))
;;
;; (defsubst
;;; ================================================================
......
......@@ -875,8 +875,7 @@ Help: \\[describe-mode] ---")
(which-conf-to-link . "Add link to conference: ")
; From view-text.el:
(line . " /1 line/ ")
(lines ." /%#1d lines/ ")
(view-text-first-line . "%#7$%#2@%#1n %#3s /%#4n line%#4?d%[%]%[s%]/ %#5P%#6?b%[%#6s%]%[%]\n")
(marked-by-you . "Marked by you (type: %#1s).\n")
(marked-by-you-and-others . "Marked by you (type: %#2s) and %#1?d%[someone else%]%[%#1d others%].\n")
......@@ -3450,8 +3449,15 @@ 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.")
(kom-highlight-first-line-doc . "\
When this is on, the first line (with text number, date and author) is
shown with a different format than normal text.")
(kom-highlight-dashed-lines-doc . "\
When this is on, the lines before and after the text body is shown with
a different format than normal text.")
(kom-highlight-text-body-doc . "\
When this is on, the text body is shown with a different format than
normal text.")
;;
......@@ -3621,7 +3627,9 @@ 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:")
(kom-highlight-first-line-tag . "Color fist line:")
(kom-highlight-dashed-lines-tag . "Color dashed lines:")
(kom-highlight-text-body-tag . "Color text backgrounds:")
)
)
......
......@@ -1194,11 +1194,16 @@ Deferred insertions and overlays are not supported."
lyskom-buffer)
(set-buffer lyskom-buffer))
(condition-case error
(setq state (lyskom-format-aux (make-format-state
(setq state (lyskom-format-aux (lyskom-create-format-state
fmt
0
argl
"")
(length argl)
""
nil
nil
nil
0)
allow-defer))
(lyskom-format-error
(error "LysKOM internal error formatting %s: %s%s"
......@@ -1215,7 +1220,9 @@ Deferred insertions and overlays are not supported."
(defun lyskom-format-aux (format-state allow-defer)
(let ((format-length (length (format-state->format-string format-state)))
(set-format-state->depth format-state
(1+ (format-state->depth format-state)))
(let ((format-length (length (format-state->format-string format-state)))
(arg-no nil)
(pad-length nil)
(format-letter nil)
......@@ -1316,7 +1323,10 @@ Deferred insertions and overlays are not supported."
?0
?\ )
allow-defer))))))
(lyskom-tweak-format-state format-state))
(lyskom-tweak-format-state format-state)
(set-format-state->depth format-state
(1- (format-state->depth format-state)))
format-state)
(defun lyskom-format-aux-help (format-state
......@@ -1338,17 +1348,16 @@ Deferred insertions and overlays are not supported."
((< pad-length 0) (- 0 pad-length))
(t pad-length))))
(if (and arg-no
(< (format-state->args-length format-state) arg-no))
(< (format-state->length format-state) arg-no))
(signal 'lyskom-format-error (list 'lyskom-format
": too few arguments")))
(if arg-no
(setq arg (nth (1- arg-no) (format-state->args format-state))))
(setq arg (nth (1- arg-no) (format-state->argl format-state))))
(if (format-props-p arg)
(setq propl (format-props->propl arg)
arg (format-props->arg arg)))
(cond
;;
;; Format a string or symbol by simply inserting it into the
......@@ -1359,7 +1368,7 @@ Deferred insertions and overlays are not supported."
((symbolp arg) (symbol-name arg))
(t (signal 'lyskom-format-error
(list 'lyskom-format
": argument error"))))))
": argument error (expected string)"))))))
;;
;; Format a number by conferting it to a string and inserting
;; it into the result list
......@@ -1372,7 +1381,7 @@ Deferred insertions and overlays are not supported."
arg)
(signal 'lyskom-internal-error
(list 'lyskom-format
": argument error")))))
": argument error (expected int)")))))
;;
;; Format a character by converting it to a string and inserting
;; it into the result list
......@@ -1382,14 +1391,14 @@ Deferred insertions and overlays are not supported."
((characterp arg) (char-to-string arg))
(t (signal 'lyskom-internal-error
(list 'lyskom-format
": argument error"))))))
": argument error (expected char)"))))))
;;
;; Format a literal percent character by inserting a string
;; containing it into the result list
;;
((= format-letter ?%)
(setq result "%"))
;;
;; Format a command name somewhat specially
;;
......@@ -1418,8 +1427,9 @@ Deferred insertions and overlays are not supported."
((= format-letter ?@)
(set-format-state->delayed-propl
format-state
(cons (cons (length (format-state->result format-state))
arg)
(cons (vector (length (format-state->result format-state))
arg
(format-state->depth format-state))
(format-state->delayed-propl format-state))))
;;
......@@ -1431,7 +1441,8 @@ Deferred insertions and overlays are not supported."
format-state
(cons (vector (length (format-state->result format-state))
nil
arg)
arg
(format-state->depth format-state))
(format-state->delayed-overlays format-state)))))
;;
;; Format a subformat list by recursively formatting the contents
......@@ -1565,7 +1576,7 @@ Deferred insertions and overlays are not supported."
(setq arg tmp)
(uconf-stat->name arg)
)))
;; The argument is an integer and we do not permit
;; deferred printing
((integerp arg)
......@@ -1576,7 +1587,7 @@ Deferred insertions and overlays are not supported."
'conference-does-not-exist)
arg)
(uconf-stat->name conf-stat))))
;; We got a conf-stat, and can use it directly
((lyskom-conf-stat-p arg)
(if face-flag
......@@ -1597,7 +1608,7 @@ Deferred insertions and overlays are not supported."
;; Something went wrong
(t (signal 'lyskom-internal-error
(list 'lyskom-format
": argument error")))))
": argument error (expected conf)")))))
(if (and (not colon-flag)
(or (lyskom-conf-stat-p arg)
(lyskom-uconf-stat-p arg)
......@@ -1625,7 +1636,7 @@ Deferred insertions and overlays are not supported."
(int-to-string (uconf-stat->conf-no arg)))
(t (signal 'lyskom-internal-error
(list 'lyskom-format
": argument error")))))
": argument error (expected conf)")))))
(if (not colon-flag)
(setq propl
(append
......@@ -1643,7 +1654,7 @@ Deferred insertions and overlays are not supported."
(text-stat->text-no arg)))
(t (signal 'lyskom-internal-error
(list 'lyskom-format
": argument error")))))
": argument error (expected text-no)")))))
(if (not colon-flag)
(setq propl
(append (lyskom-default-button 'text arg) propl))))
......@@ -1655,7 +1666,7 @@ Deferred insertions and overlays are not supported."
(setq result (cond ((stringp arg) (lyskom-button-transform-text arg))
(t (signal 'lyskom-internal-error
(list 'lyskom-format
": argument error")))))
": argument error (expected subject)")))))
(if (and (not colon-flag)
(not (lyskom-face-default-p 'kom-subject-face)))
(setq propl (append (list 'face 'kom-subject-face) propl))))
......@@ -1680,7 +1691,7 @@ Deferred insertions and overlays are not supported."
(car arg)))
(t (signal 'lyskom-internal-error
(list 'lyskom-format
": argument error"))))))
": argument error (expected text)"))))))
;;
......@@ -1719,15 +1730,15 @@ Deferred insertions and overlays are not supported."
;;
;; The format letter was unknown
;;
(t (signal 'lyskom-internal-error
(list 'lyskom-format-help format-letter))))
;;
;; Pad the result to the appropriate length
;; Fix flags so text props go in the right places anyway
;;
(cond ((or (null pad-length)
(null result)) nil)
((> abs-length (lyskom-string-width result))
......@@ -1816,15 +1827,21 @@ Deferred insertions and overlays are not supported."
(defun lyskom-tweak-format-state (format-state)
(let ((dp (format-state->delayed-propl format-state)))
(while dp
(add-text-properties (car (car dp))
(length (format-state->result format-state))
(cdr (car dp))
(format-state->result format-state))
(setq dp (cdr dp)))
(set-format-state->delayed-propl format-state nil))
(when (eq (format-state->depth format-state)
(aref (car dp) 2))
(add-text-properties (aref (car dp) 0)
(length (format-state->result format-state))
(aref (car dp) 1)
(format-state->result format-state))
(set-format-state->delayed-propl
format-state
(delq (car dp) (format-state->delayed-propl format-state))))
(setq dp (cdr dp))))
(lyskom-traverse overlay-spec (format-state->delayed-overlays format-state)
(unless (aref overlay-spec 1)
(unless (or (aref overlay-spec 1)
(not (eq (format-state->depth format-state)
(aref overlay-spec 3))))
(aset overlay-spec 1 (length (format-state->result format-state)))))
format-state)
......
......@@ -182,7 +182,10 @@
[kom-smileys]
[kom-w3-simplify-body]
"\n"
[kom-color-text-background]
[kom-highlight-first-line]
[kom-highlight-dashed-lines]
[kom-highlight-text-body]
"\n"
[kom-dashed-lines]
[kom-long-lines]
[kom-text-footer-format]
......@@ -481,7 +484,10 @@ customize buffer but do not save them to the server."
"List of user variables not in lyskom-custom-variables.")
(defvar lyskom-custom-variables
'((kom-color-text-background (toggle (on off)))
'(
(kom-highlight-first-line (toggle (on off)))
(kom-highlight-dashed-lines (toggle (on off)))
(kom-highlight-text-body (toggle (on off)))
(kom-personal-messages-in-window (open-window))
(kom-write-texts-in-window (open-window))
(kom-list-membership-in-window (open-window))
......
......@@ -875,8 +875,7 @@ Annat se \\[describe-mode] ---")
(which-conf-to-link . "Lgg in lnk till mte: ")
;; From view-text.el:
(line . " /1 rad/ ")
(lines ." /%#1d rader/ ")
(view-text-first-line . "%#7$%#2@%#1n %#3s /%#4n rad%#4?d%[%]%[er%]/ %#5P%#6?b%[%#6s%]%[%]\n")
(marked-by-you . "Markerad av dig (typ: %#1s).\n")
(marked-by-you-and-others . "Markerad av dig (typ: %#2s) och %#1?d%[ngon annan%]%[%#1d andra%].\n")
......@@ -3905,9 +3904,16 @@ 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.")
(kom-highlight-first-line-doc . "\
Om detta r pslaget s visas frsta raden i varje inlgg (den med
inlggsnummer, datum och frfattare) med ett annorlunda utseende n
normal text.")
(kom-highlight-dashed-lines-doc . "\
Om detta r pslaget s visas raderna fre och efter inlggstexten med
ett annorlunda utseende n normal text.")
(kom-highlight-text-body-doc . "\
Om detta r pslaget s visas inlggstexter med ett annorlunda utseende
n normal text.")
;;
......@@ -4077,7 +4083,9 @@ 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:")
(kom-highlight-first-line-tag . "Annorlunda bakgrundsfrg p frsta raden:")
(kom-highlight-dashed-lines-tag . "Annorlunda bakgrundsfrg fre och efter inlggstexten:")
(kom-highlight-text-body-tag . "Annorlunda bakgrundsfrg p inlggstexten:")
)
)
......
......@@ -101,13 +101,23 @@ are in the list.")
;;; User flags
(def-kom-var kom-color-text-background t
(def-kom-var kom-highlight-text-body 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-highlight-first-line t
"*If t, use kom-first-line-face to highlight the first line of each text."
server
)
(def-kom-var kom-highlight-dashed-lines t
"*If t, use kom-dashed-lines-face to highlight dashed lines around texts."
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.
......@@ -2787,12 +2797,13 @@ the value of kom-tell-phrases for fun.")
'(kom-active-face kom-url-face kom-me-face kom-highlight-face
kom-text-face kom-subject-face kom-text-no-face
kom-friends-face kom-morons-face kom-presence-face
kom-first-line-face kom-warning-face kom-mark-face)
kom-first-line-face kom-warning-face kom-mark-face
kom-text-body-face kom-dashed-lines-face)
"This is a list of the faces that LysKOM uses.")
(def-kom-var lyskom-face-schemes
'((default
(kom-text-background-face nil nil "#f8f8ff")
(kom-text-body-face nil nil "#f8f8ff")
(kom-active-face default "blue4" nil)
(kom-url-face default "BlueViolet" nil)
(kom-me-face bold "blue3" "lavender")
......@@ -2805,10 +2816,12 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "dim gray" nil)
(kom-mark-face bold "blue3" "lavender")
(kom-warning-face bold "red" nil)
(kom-first-line-face default nil nil)
(kom-dim-face default "gray" nil))
(kom-first-line-face bold nil nil)
(kom-dim-face default "gray" nil)
(kom-dashed-lines-face nil nil "#e8e8ff")
)
(inverse
(kom-text-background-face nil nil "#080808")
(kom-text-body-face nil nil "#080808")
(kom-active-face default "lightblue" nil)
(kom-url-face default "Moccasin" nil)
(kom-me-face bold "gold" "black")
......@@ -2821,10 +2834,12 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "grey" nil)
(kom-mark-face default "gold" "black")
(kom-warning-face bold "red" nil)
(kom-first-line-face default nil nil)
(kom-dim-face default "gray" nil))
(kom-first-line-face nil nil "black")
(kom-dim-face default "gray" nil)
(kom-first-line-face nil nil "black")
)
(monochrome
(kom-text-background-face nil nil nil)
(kom-text-body-face nil nil nil)
(kom-active-face default nil nil)
(kom-url-face default nil nil)
(kom-me-face bold nil nil)
......@@ -2837,10 +2852,12 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic nil nil)
(kom-mark-face bold nil "black")
(kom-warning-face bold nil nil)
(kom-first-line-face default nil nil)
(kom-dim-face default nil nil))
(kom-first-line-face bold nil nil)
(kom-dim-face default nil nil)
(kom-first-line-face bold nil nil)
)
(minimal
(kom-text-background-face nil nil nil)
(kom-text-body-face nil nil nil)
(kom-active-face default nil nil)
(kom-url-face default nil nil)
(kom-me-face default nil "lavender")
......@@ -2853,10 +2870,12 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "dim gray" nil)
(kom-mark-face default nil "black")
(kom-warning-face bold nil nil)
(kom-first-line-face default nil nil)
(kom-dim-face default nil nil))
(kom-first-line-face nil nil nil)
(kom-dim-face default nil nil)
(kom-first-line-face nil nil nil)
)
(highlight
(kom-text-background-face nil nil "#f8f8ff")
(kom-text-body-face nil nil "#f8f8ff")
(kom-active-face default nil "aliceblue")
(kom-url-face default nil "yellow")
(kom-me-face bold "darkblue" "thistle")
......@@ -2869,8 +2888,9 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "dim gray" nil)
(kom-mark-face bold "darkblue" "thistle")
(kom-warning-face bold "yellow" "red")
(kom-first-line-face default nil "lavender")
(kom-first-line-face nil nil "lavender")
(kom-dim-face default "gray" nil)
(kom-first-line-face nil nil "lavender")
))
"Face schemes for LysKOM.
......
......@@ -65,7 +65,6 @@ Note that this function must not be called asynchronously."
(filter (and filter-active
(lyskom-filter-text-p text-no)))
(start nil)
(end nil)
(todo nil)
(lyskom-last-text-format-flags nil))
(cond ((eq filter 'skip-text) (lyskom-filter-prompt text-no 'filter-text)
......@@ -99,8 +98,11 @@ Note that this function must not be called asynchronously."
;; Use a marker, because the buffer may lose data
;; at the top if kom-max-buffer-size is set.
(setq start (point-max-marker))
(lyskom-format-insert "%#2@%[%#1n%] " text-stat (list 'lyskom-text-start
(text-stat->text-no text-stat)))
(let ((mx-date (car (lyskom-get-aux-item (text-stat->aux-items text-stat) 21)))
(mx-from (car (lyskom-get-aux-item (text-stat->aux-items text-stat) 17)))
(mx-author (car (lyskom-get-aux-item (text-stat->aux-items text-stat) 16)))
......@@ -111,56 +113,32 @@ Note that this function must not be called asynchronously."
(mx-headers (lyskom-get-aux-item (text-stat->aux-items text-stat) 24))