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

Use pretty colors to show selection in kom-handle-membership

parent c27b5a86
2000-03-21 David Byers <>
* compatibility.el (lyskom-make-face): New function.
(find-face): New compatibility function.
(face-background-name): New compatibility function.
* macros.el: Removed lyskom-make-face.
* mship-edit.el (lp--entry-set-background): New function.
(lp--entry-update-extents): New function.
(lp--format-entry): Set background according to selected status.
(lp--redraw-entry-mark): Same here.
(lp--print-entry): Update entry extents when done.
(lp--erase-entry): Same here.
* lyskom-rest.el (kom-next-command): Set the priority of the
scroll indicator extent to something high so it overrides whatever
is already on that line.
2000-03-16 David Byers <>
* mship-edit.el: Renamed set-lp--entry-pri-and-pos to
......@@ -8,6 +27,7 @@
since lyskom-update-membership-positions will.
(lp--update-membership): Don't update position or priority unless
(lp--quit): New command.
2000-03-15 David Byers <>
......@@ -5,6 +5,17 @@ Att g
** Blockera eller klara av att man ger kommandon i bufferten medan den
håller på att uppdateras.
** Stöd för att helt dölja ett medlemskap i kom-handle-membership. Man
vill kanske dölja alla man inte har olästa i, eller alla som man
inte har varit inne i på jättelänge
** Stöd för att hajlajta medlemskap i kom-handle-membership. Man vill
kanske hajlajta allt som uppfyller ett visst kriterium (eller
anti-hajlajta allt annat). Man vill kunna hajlajta alla markerade.
** Man vill kunna skicka user-agent och proxy-authorization till
HTTP-proxyn. Se specen för HTTP 1.1, kapitel 11 och RFC 2069.
......@@ -356,6 +356,17 @@ property and a property with the value nil."
(lyskom-provide-function reset-face (face &optional locale tag-set exact-p)
(lyskom-provide-function face-background-name (face)
(face-background face))
(lyskom-provide-function find-face (face)
(and (facep face) face))
(defun lyskom-make-face (name temporary)
"Like make-face in XEmacs"
(lyskom-xemacs-or-gnu (make-face name nil temporary)
(make-face name)))
;;; ======================================================================
;;; Event stuff
......@@ -214,6 +214,7 @@ If the optional argument REFETCH is non-nil, all caches are cleared and
(forward-char 1)
(set-extent-priority overlay 1000)
(set-extent-face overlay 'kom-mark-face)
(add-timeout 2
......@@ -225,6 +226,7 @@ If the optional argument REFETCH is non-nil, all caches are cleared and
(forward-char 1)
(overlay-put overlay 'face 'kom-mark-face)
(overlay-put overlay 'priority 1000)
(run-at-time 2 nil
......@@ -245,17 +245,6 @@ All the forms in BIND-LIST are evaluated before and symbols are bound."
", ")))))))
;;; ================================================================
;;; Faces
(defmacro lyskom-make-face (name &rest body)
(` (if (memq (, name) (face-list))
(,@ body))))
(put 'lyskom-make-face 'lisp-indent-function 1)
;;; ============================================================
;;; Keymap handling
......@@ -85,6 +85,8 @@
membership ; The membership
selected ; Selected or not
state ; Expanded display or not
invisible ; Non-nil when invisible
extents ; Alist of extents of this entry
(defvar lp--last-format-string nil)
......@@ -97,6 +99,52 @@
(defvar lp--list-end-marker nil)
(defvar lp--selected-entry-list nil)
;;; ============================================================
;;; Stuff
(defun lp--entry-set-background (entry color)
"Use extents or overlays to set the background of ENTRY to COLOR."
(if (null color)
(let* ((extent (assq 'color (lp--entry->extents entry))))
(when extent
(delete-extent (cdr extent))
(delete-overlay (cdr extent)))
(set-lp--entry->extents entry
(delq extent (lp--entry->extents entry)))))
(let* ((extent (cdr (assq 'color (lp--entry->extents entry))))
(facename (intern (format "lyskom-%s-background" color)))
(face (or (find-face facename) (lyskom-make-face facename t))))
(unless extent
(setq extent (make-extent (lp--entry->start-marker entry)
(lp--entry->end-marker entry)))
(setq extent (make-overlay (lp--entry->start-marker entry)
(lp--entry->end-marker entry) nil t)))
(set-lp--entry->extents entry (cons (cons 'color extent)
(lp--entry->extents entry))))
(set-face-background face color)
(lyskom-xemacs-or-gnu (progn (set-extent-property extent 'end-open t)
(set-extent-property extent 'start-open t)
(set-extent-property extent 'priority 1000)
(set-extent-property extent 'face face))
(progn (overlay-put extent 'priority 1000)
(overlay-put extent 'face face))))))
(defun lp--entry-update-extents (entry)
(let ((extents (lp--entry->extents entry)))
(while extents
(progn (set-extent-property (cdr (car extents)) 'end-open t)
(set-extent-property (cdr (car extents)) 'start-open t)
(set-extent-endpoints (cdr (car extents))
(lp--entry->start-marker entry)
(lp--entry->end-marker entry)))
(progn (move-overlay (cdr (car extents))
(or (lp--entry->start-marker entry) 0)
(or (lp--entry->end-marker entry) 0))))
(setq extents (cdr extents)))))
;;; ============================================================
......@@ -262,11 +310,16 @@ only recomputed if the window width changes."
(lyskom-get-string 'Passive-mt-type)
(lp--entry->membership entry))))
'(lp--unread t))))
'(lp--unread t)
(if defer-info
(lyskom-replace-deferred defer-info string)
(lyskom-insert-at-point string)))))
(lyskom-insert-at-point string))
(if (lp--entry->selected entry)
(lp--entry-set-background entry (face-background-name 'kom-mark-face))
(lp--entry-set-background entry nil)))))
(defun lp--format-entry-expansion (conf-stat defer-info)
(let ((entry nil))
......@@ -307,6 +360,7 @@ The start and end markers of the entry are adjusted"
(set-lp--entry->start-marker entry (point-marker))
(lp--format-insert-entry entry)
(set-lp--entry->end-marker entry (point-marker))
(lp--entry-update-extents entry)
(forward-char 1)))
(defun lp--erase-entry (entry)
......@@ -315,7 +369,8 @@ The start and end markers of the entry are adjusted"
(delete-region (lp--entry->start-marker entry)
(1+ (lp--entry->end-marker entry)))
(set-lp--entry->start-marker entry nil)
(set-lp--entry->end-marker entry nil)))
(set-lp--entry->end-marker entry nil)
(lp--entry-update-extents entry)))
(defun lp--redraw-entry-mark (entry)
"Redraw the mark for ENTRY."
......@@ -323,6 +378,9 @@ The start and end markers of the entry are adjusted"
(goto-char (lp--entry->start-marker entry))
(insert (if (lp--entry->selected entry) ?* ?\ ))
(if (lp--entry->selected entry)
(lp--entry-set-background entry (face-background-name 'kom-mark-face))
(lp--entry-set-background entry nil))
(delete-char 1))))
(defun lp--redraw-entry (entry)
......@@ -526,7 +584,9 @@ entry priority"
(membership->priority mship)
(when pos
(goto-char (lp--entry->start-marker elem))
......@@ -1157,6 +1217,7 @@ entry with an adjacent priority."
(define-key lp--mode-map (kbd "H") 'lp--toggle-secret)
(define-key lp--mode-map (kbd "P") 'lp--toggle-passive)
(define-key lp--mode-map (kbd "C-c C-c") 'lp--quit)
(define-key lp--mode-map (kbd "q") 'lp--quit)
(define-key lp--mode-map (kbd (lyskom-keys 'button2up)) 'kom-button-click)
(define-key lp--mode-map (kbd (lyskom-keys 'button2)) 'kom-mouse-null)
......@@ -1248,11 +1309,10 @@ Entry to this mode runs lyskom-prioritize-mode-hook."
(defun lp--create-buffer ()
"Create a buffer for managing memberships."
(let ((buf (lyskom-get-buffer-create 'prioritize
(concat (buffer-name) "-prioritize")
(concat (buffer-name) "-membership")
(entry-list nil))
;;; First cache all the conf stats
(set-buffer buf)
(let ((buffer-read-only nil))
......@@ -1278,7 +1338,9 @@ Medlemskap f
(membership->priority mship)
(lp--print-entry entry)
(setq entry-list (cons entry entry-list))))
(lp--set-entry-list (nreverse entry-list))
......@@ -1288,7 +1350,7 @@ Medlemskap f
Markera medlemskap: SPC Markera område: C-w Flytta markerade: C-y
Sätt prioritet: p Öka prioritet: + Minska prioritet: -
Flytta upp: M-p Flytta ned: M-n Ändra flaggor: I,H,P
Avsluta och spara: C-c C-c Mer hjälp: C-h m
Avsluta: C-c C-c Mer hjälp: C-h m
Supports Markdown
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