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

Bug fix in slow mode.

Bug fix in starting Netscape
Ability to draw dimmed entries in kom-handle-membership.
parent a198cc61
2001-04-25 David Byers <davby@ida.liu.se>
* mship-edit.el (lyskom-read-time): Don't use lyskom-client-date.
* slow.el (lyskom-slow-start-of-line-pos): New function.
(kom-slow-click-or-yank): Use it.
2001-03-20 David Byers <davby@ida.liu.se>
* lyskom-buttons.el (lyskom-view-url-netscape): Use
lyskom-accept-process-output instead of accept-process-output to
minimize the likelyhood of an infinite resource-consuming loop.
2001-02-01 David Byers <davby@ida.liu.se>
* mship-edit.el (lp--create-buffer): Set initial state according
to who added the membership.
(lp--update-buffer): Same here.
(lp--format-insert-entry): Draw expanded only according to state,
no matter who added the membership.
(lp--expand-all): New command.
(lp--contract-all): New command.
* compatibility.el (lyskom-face-foreground-name): New function.
* mship-edit.el (lp--entry-set-background): Operate in the correct
buffer. Make sure endpoints of extent are non-nil.
(lp--entry-set-foreground): New function.
(lp--format-entry): Color passive entries gray.
* vars.el.in (lyskom-face-schemes): Added kom-dim-face.
2001-04-24 Johan Sundstrm <jhs@lysator.liu.se> 2001-04-24 Johan Sundstrm <jhs@lysator.liu.se>
* utilities.el (lyskom-set-alist): New function. * utilities.el (lyskom-set-alist): New function.
......
...@@ -36,7 +36,7 @@ ...@@ -36,7 +36,7 @@
# makefile too! # makefile too!
# #
CLIENTVERSION = 0.46.1 CLIENTVERSION = 0.46.2-BETA-1
DOCFILES=NEWS-0.46 NEWS-0.46.1 DOCFILES=NEWS-0.46 NEWS-0.46.1
DEBIANCLIENTVERSION = $(shell echo $(CLIENTVERSION) | tr - .) DEBIANCLIENTVERSION = $(shell echo $(CLIENTVERSION) | tr - .)
......
...@@ -457,9 +457,13 @@ property and a property with the value nil." ...@@ -457,9 +457,13 @@ property and a property with the value nil."
(lyskom-provide-function reset-face (face &optional locale tag-set exact-p) (lyskom-provide-function reset-face (face &optional locale tag-set exact-p)
) )
(lyskom-provide-function face-background-name (face) (lyskom-provide-function lyskom-face-background-name (face)
(face-background face)) (face-background face))
(lyskom-provide-function lyskom-face-foreground-name (face)
(face-foreground face))
(lyskom-provide-function find-face (face) (lyskom-provide-function find-face (face)
(and (facep face) face)) (and (facep face) face))
......
...@@ -914,7 +914,7 @@ that, starts a new one." ...@@ -914,7 +914,7 @@ that, starts a new one."
(exit nil)) (exit nil))
(lyskom-url-manager-starting manager) (lyskom-url-manager-starting manager)
(while (eq status 'run) (while (eq status 'run)
(accept-process-output) (lyskom-accept-process-output)
(setq status (process-status proc))) (setq status (process-status proc)))
(setq exit (process-exit-status proc)) (setq exit (process-exit-status proc))
(cond ((and (eq status 'exit) (cond ((and (eq status 'exit)
......
...@@ -180,33 +180,70 @@ This function does not tell the server about the change." ...@@ -180,33 +180,70 @@ This function does not tell the server about the change."
(defun lp--entry-set-background (entry color) (defun lp--entry-set-background (entry color)
"Use extents or overlays to set the background of ENTRY to COLOR." "Use extents or overlays to set the background of ENTRY to COLOR."
(if (null color) (save-excursion
(let* ((extent (assq 'color (lp--entry->extents entry)))) (set-buffer (marker-buffer (lp--entry->start-marker entry)))
(when extent (if (null color)
(let* ((extent (assq 'color (lp--entry->extents entry))))
(when extent
(lyskom-xemacs-or-gnu
(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
(lyskom-xemacs-or-gnu
(setq extent (make-extent (or (lp--entry->start-marker entry) 0)
(or (lp--entry->end-marker entry) 0)))
(setq extent (make-overlay (or (lp--entry->start-marker entry) 0)
(or (lp--entry->end-marker entry) 0)
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-set-foreground (entry color)
"Use extents or overlays to set the foreground of ENTRY to COLOR."
(save-excursion
(set-buffer (marker-buffer (lp--entry->start-marker entry)))
(if (null color)
(let* ((extent (assq 'fcolor (lp--entry->extents entry))))
(when extent
(lyskom-xemacs-or-gnu
(delete-extent (cdr extent))
(delete-overlay (cdr extent)))
(set-lp--entry->extents entry
(delq extent (lp--entry->extents entry)))))
(let* ((extent (cdr (assq 'fcolor (lp--entry->extents entry))))
(facename (intern (format "lyskom-%s-foreground" color)))
(face (or (find-face facename) (lyskom-make-face facename t))))
(unless extent
(lyskom-xemacs-or-gnu (lyskom-xemacs-or-gnu
(delete-extent (cdr extent)) (setq extent (make-extent (or (lp--entry->start-marker entry) 0)
(delete-overlay (cdr extent))) (or (lp--entry->end-marker entry) 0)))
(set-lp--entry->extents entry (setq extent (make-overlay (or (lp--entry->start-marker entry) 0)
(delq extent (lp--entry->extents entry))))) (or (lp--entry->end-marker entry) 0)
nil t)))
(let* ((extent (cdr (assq 'color (lp--entry->extents entry)))) (set-lp--entry->extents entry (cons (cons 'fcolor extent)
(facename (intern (format "lyskom-%s-background" color))) (lp--entry->extents entry))))
(face (or (find-face facename) (lyskom-make-face facename t)))) (set-face-foreground face color)
(unless extent (lyskom-xemacs-or-gnu (progn (set-extent-property extent 'end-open t)
(lyskom-xemacs-or-gnu (set-extent-property extent 'start-open t)
(setq extent (make-extent (lp--entry->start-marker entry) (set-extent-property extent 'priority 1000)
(lp--entry->end-marker entry))) (set-extent-property extent 'face face))
(setq extent (make-overlay (lp--entry->start-marker entry) (progn (overlay-put extent 'priority 1000)
(lp--entry->end-marker entry) nil t))) (overlay-put extent 'face face)))))))
(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))))))
(defmacro lp--save-excursion (&rest body) (defmacro lp--save-excursion (&rest body)
...@@ -258,10 +295,7 @@ only recomputed if the window width changes." ...@@ -258,10 +295,7 @@ only recomputed if the window width changes."
entry)) entry))
(lp--format-entry mship-conf-stat entry)) (lp--format-entry mship-conf-stat entry))
(when (or (eq (lp--entry->state entry) 'expanded) (when (eq (lp--entry->state entry) 'expanded)
(not (memq (membership->created-by
(lp--entry->membership entry))
(list lyskom-pers-no 0 'contracted))))
(lyskom-insert-at-point "\n ") (lyskom-insert-at-point "\n ")
(if (null adder-conf-stat) (if (null adder-conf-stat)
(lyskom-format-insert-at-point (lyskom-format-insert-at-point
...@@ -330,8 +364,13 @@ only recomputed if the window width changes." ...@@ -330,8 +364,13 @@ only recomputed if the window width changes."
(lyskom-replace-deferred defer-info string) (lyskom-replace-deferred defer-info string)
(lyskom-insert-at-point string)) (lyskom-insert-at-point string))
(if (membership-type->passive
(membership->type (lp--entry->membership entry)))
(lp--entry-set-foreground entry (lyskom-face-foreground-name 'kom-dim-face))
(lp--entry-set-foreground entry nil))
(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 (lyskom-face-background-name 'kom-mark-face))
(lp--entry-set-background entry nil))))) (lp--entry-set-background entry nil)))))
...@@ -394,9 +433,10 @@ The start and end markers of the entry are adjusted" ...@@ -394,9 +433,10 @@ The start and end markers of the entry are adjusted"
(goto-char (lp--entry->start-marker entry)) (goto-char (lp--entry->start-marker entry))
(insert (if (lp--entry->selected entry) ?* ?\ )) (insert (if (lp--entry->selected entry) ?* ?\ ))
(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 (lyskom-face-background-name 'kom-mark-face))
(lp--entry-set-background entry nil)) (lp--entry-set-background entry nil))
(delete-char 1)))) (delete-char 1)
(lp--entry-update-extents entry))))
(defun lp--redraw-entry (entry) (defun lp--redraw-entry (entry)
"Redraw the entry ENTRY." "Redraw the entry ENTRY."
...@@ -606,7 +646,10 @@ entry priority" ...@@ -606,7 +646,10 @@ entry priority"
(membership->priority mship) (membership->priority mship)
mship mship
nil nil
'normal (if (memq (membership->created-by mship)
(list lyskom-pers-no 0))
'contracted
'expanded)
t t
nil))) nil)))
(when pos (when pos
...@@ -948,11 +991,11 @@ size of the list." ...@@ -948,11 +991,11 @@ size of the list."
(lp--select-entries (list entry) (not (lp--entry->selected entry)))))) (lp--select-entries (list entry) (not (lp--entry->selected entry))))))
(defun lp--select-region (start end) (defun lp--select-region (start end)
"Select all entries in the region. "Select all entries in the region. With prefix arg, deselect.
START and END are the starting and ending points of the region." START and END are the starting and ending points of the region."
(interactive "r") (interactive "r")
(let ((entry-list (lp--map-region start end 'identity))) (let ((entry-list (lp--map-region start end 'identity)))
(lp--select-entries entry-list t))) (lp--select-entries entry-list (not current-prefix-arg))))
(defun lp--select-prioriy (priority) (defun lp--select-prioriy (priority)
"Select all entries with a priority PRIORITY. "Select all entries with a priority PRIORITY.
...@@ -1257,6 +1300,36 @@ entry with an adjacent priority." ...@@ -1257,6 +1300,36 @@ entry with an adjacent priority."
(if (eq (lp--entry->state entry) 'expanded) 'contracted 'expanded)) (if (eq (lp--entry->state entry) 'expanded) 'contracted 'expanded))
(lp--redraw-entry entry)))) (lp--redraw-entry entry))))
(defun lp--expand-all (arg)
"Expand all entries.
With prefix arg, expand only those that were created by someone else."
(interactive "P")
(let ((hidden-list (list lyskom-pers-no 0)))
(mapcar (lambda (entry)
(when (and (or (null arg)
(not (memq (membership->created-by
(lp--entry->membership entry))
hidden-list)))
(not (eq (lp--entry->state entry) 'expanded)))
(set-lp--entry->state entry 'expanded)
(lp--redraw-entry entry)))
(lp--all-entries))))
(defun lp--contract-all (arg)
"Contract all entries.
With prefix arg, contract only those that were created by self."
(interactive "P")
(let ((hidden-list (list lyskom-pers-no 0)))
(mapcar (lambda (entry)
(when (and (or (null arg)
(memq (membership->created-by
(lp--entry->membership entry))
hidden-list))
(not (eq (lp--entry->state entry) 'contracted)))
(set-lp--entry->state entry 'contracted)
(lp--redraw-entry entry)))
(lp--all-entries))))
(defun lp--quit () (defun lp--quit ()
"Remove the membership buffer and quit" "Remove the membership buffer and quit"
(interactive) (interactive)
...@@ -1310,6 +1383,7 @@ entry with an adjacent priority." ...@@ -1310,6 +1383,7 @@ entry with an adjacent priority."
(define-key lp--mode-map (kbd "C-w") 'lp--select-region) (define-key lp--mode-map (kbd "C-w") 'lp--select-region)
(define-key lp--mode-map (kbd "C-y") 'lp--yank) (define-key lp--mode-map (kbd "C-y") 'lp--yank)
(define-key lp--mode-map (kbd "#") 'lp--select-priority) (define-key lp--mode-map (kbd "#") 'lp--select-priority)
(define-key lp--mode-map (kbd "M-#") 'lp--select-priority)
(define-key lp--mode-map (kbd "M-DEL") 'lp--deselect-all) (define-key lp--mode-map (kbd "M-DEL") 'lp--deselect-all)
(define-key lp--mode-map (kbd "C-p") 'lp--previous-entry) (define-key lp--mode-map (kbd "C-p") 'lp--previous-entry)
(define-key lp--mode-map (kbd "<up>") 'lp--previous-entry) (define-key lp--mode-map (kbd "<up>") 'lp--previous-entry)
...@@ -1376,6 +1450,7 @@ entry with an adjacent priority." ...@@ -1376,6 +1450,7 @@ entry with an adjacent priority."
"Pop up a buffer to manage memberships in" "Pop up a buffer to manage memberships in"
(interactive) (interactive)
(set-buffer (lp--create-buffer)) (set-buffer (lp--create-buffer))
(lyskom-wait-queue 'deferred)
(lp--mode) (lp--mode)
(lp--first-entry)) (lp--first-entry))
...@@ -1450,7 +1525,10 @@ Medlemskap f ...@@ -1450,7 +1525,10 @@ Medlemskap f
(membership->priority mship) (membership->priority mship)
mship mship
nil nil
'normal (if (memq (membership->created-by mship)
(list lyskom-pers-no 0))
'contracted
'expanded)
t t
nil))) nil)))
(lp--print-entry entry) (lp--print-entry entry)
...@@ -1468,6 +1546,49 @@ Medlemskap f ...@@ -1468,6 +1546,49 @@ Medlemskap f
)))) ))))
(defun lyskom-read-time (prompt)
(let ((data nil)
(time nil))
(while (not time)
(setq data (read-from-minibuffer prompt data))
(setq time (parse-time-string data))
(if (not (or (elt time 4) (elt time 5)))
(setq time nil)
(setq time
(lyskom-create-time (or (elt time 0) 0)
(or (elt time 1) 0)
(or (elt time 2) 0)
(or (elt time 3) 1)
(or (elt time 4) 1)
(- (or (elt time 5) (elt (decode-time (current-time)) 5)) 1900)
nil
nil
nil))))
time))
(defun lp--hide-memberships-by-date (arg)
(interactive "P")
(let ((old-entries nil)
(old-time (lyskom-read-time (if arg
"Hide memberships read after: "
"Hide memberships not read since: "))))
(mapcar (lambda (entry)
(cond ((and arg
(not (lyskom-time-greater
old-time
(membership->last-time-read
(lp--entry->membership entry)))))
(setq old-entries (cons entry old-entries)))
((and (not arg)
(lyskom-time-greater old-time
(membership->last-time-read
(lp--entry->membership entry))))
(setq old-entries (cons entry old-entries)))
))
(lp--all-entries))
(lp--entry-set-visible old-entries nil)))
(defun lp--hide-entry () (defun lp--hide-entry ()
(interactive) (interactive)
(let ((entry (lp--entry-at (point)))) (let ((entry (lp--entry-at (point))))
...@@ -1475,7 +1596,11 @@ Medlemskap f ...@@ -1475,7 +1596,11 @@ Medlemskap f
(defun lp--show-all () (defun lp--show-all ()
(interactive) (interactive)
(lp--entry-set-visible (lp--all-entries) t)) (let ((elements nil))
(mapcar (lambda (entry) (unless (lp--entry->visible entry)
(setq elements (cons entry elements))))
(lp--all-entries))
(lp--entry-set-visible elements t)))
(provide 'mship-edit) (provide 'mship-edit)
......
...@@ -51,10 +51,9 @@ ...@@ -51,10 +51,9 @@
(define-key lyskom-slow-mode-map (kbd "M-TAB") 'kom-previous-link) (define-key lyskom-slow-mode-map (kbd "M-TAB") 'kom-previous-link)
(define-key lyskom-slow-mode-map (kbd "C-i") 'kom-expand-slow-command-or-next-link) (define-key lyskom-slow-mode-map (kbd "C-i") 'kom-expand-slow-command-or-next-link)
(define-key lyskom-slow-mode-map (kbd "M-C-i") 'kom-previous-link) (define-key lyskom-slow-mode-map (kbd "M-C-i") 'kom-previous-link)
(define-key lyskom-slow-mode-map (kbd (lyskom-keys 'button2)) 'kom-slow-click-or-yank) (define-key lyskom-slow-mode-map (kbd (lyskom-keys 'button2up)) 'kom-slow-click-or-yank)
(define-key lyskom-slow-mode-map (kbd (lyskom-keys 'button2up)) 'kom-mouse-null) (define-key lyskom-slow-mode-map (kbd (lyskom-keys 'button3up)) 'kom-popup-menu)
(define-key lyskom-slow-mode-map (kbd (lyskom-keys 'button3)) 'kom-popup-menu)
(define-key lyskom-slow-mode-map (kbd (lyskom-keys 'button3up)) 'kom-mouse-null)
(defun lyskom-slow-start-of-line () (defun lyskom-slow-start-of-line ()
...@@ -71,6 +70,10 @@ ...@@ -71,6 +70,10 @@
(when (looking-at "\\(\\s-+\\)") (when (looking-at "\\(\\s-+\\)")
(goto-char (match-end 0))))) (goto-char (match-end 0)))))
(defun lyskom-slow-start-of-line-pos ()
"Return the starting position for entry text on the current line."
(save-excursion (lyskom-slow-start-of-line) (point)))
(defun lyskom-get-entered-slow-command () (defun lyskom-get-entered-slow-command ()
"Get the text that the user has entered after the last prompt. "Get the text that the user has entered after the last prompt.
...@@ -93,10 +96,10 @@ Currently the prompt is assumed to be on the last line of the buffer." ...@@ -93,10 +96,10 @@ Currently the prompt is assumed to be on the last line of the buffer."
(interactive "@e") (interactive "@e")
(let ((pos (event-closest-point event))) (let ((pos (event-closest-point event)))
(if (and (lyskom-slow-on-prompt-line pos) (if (and (lyskom-slow-on-prompt-line pos)
(<= (lyskom-slow-start-of-line) pos))) (<= (lyskom-slow-start-of-line-pos) pos))
(let ((fn (lookup-key global-map (this-command-keys)))) (let ((fn (lookup-key global-map (this-command-keys))))
(when (commandp fn) (call-interactively fn))) (when (commandp fn) (call-interactively fn)))
(kom-button-click event))) (kom-button-click event))))
(defun kom-slow-button-press () (defun kom-slow-button-press ()
"Run kom-button-press unless on the prompt line." "Run kom-button-press unless on the prompt line."
......
...@@ -2284,7 +2284,8 @@ the value of kom-tell-phrases for fun.") ...@@ -2284,7 +2284,8 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "dim gray" nil) (kom-presence-face italic "dim gray" nil)
(kom-mark-face bold "blue3" "lavender") (kom-mark-face bold "blue3" "lavender")
(kom-warning-face bold "red" nil) (kom-warning-face bold "red" nil)
(kom-first-line-face default nil nil)) (kom-first-line-face default nil nil)
(kom-dim-face default "gray" nil))
(inverse (inverse
(kom-active-face default "lightblue" nil) (kom-active-face default "lightblue" nil)
(kom-url-face default "Moccasin" nil) (kom-url-face default "Moccasin" nil)
...@@ -2298,7 +2299,8 @@ the value of kom-tell-phrases for fun.") ...@@ -2298,7 +2299,8 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "grey" nil) (kom-presence-face italic "grey" nil)
(kom-mark-face default "gold" "black") (kom-mark-face default "gold" "black")
(kom-warning-face bold "red" nil) (kom-warning-face bold "red" nil)
(kom-first-line-face default nil nil)) (kom-first-line-face default nil nil)
(kom-dim-face default "gray" nil))
(monochrome (monochrome
(kom-active-face default nil nil) (kom-active-face default nil nil)
(kom-url-face default nil nil) (kom-url-face default nil nil)
...@@ -2312,7 +2314,8 @@ the value of kom-tell-phrases for fun.") ...@@ -2312,7 +2314,8 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic nil nil) (kom-presence-face italic nil nil)
(kom-mark-face bold nil "black") (kom-mark-face bold nil "black")
(kom-warning-face bold nil nil) (kom-warning-face bold nil nil)
(kom-first-line-face default nil nil)) (kom-first-line-face default nil nil)
(kom-dim-face default nil nil))
(minimal (minimal
(kom-active-face default nil nil) (kom-active-face default nil nil)
(kom-url-face default nil nil) (kom-url-face default nil nil)
...@@ -2326,7 +2329,8 @@ the value of kom-tell-phrases for fun.") ...@@ -2326,7 +2329,8 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "dim gray" nil) (kom-presence-face italic "dim gray" nil)
(kom-mark-face default nil "black") (kom-mark-face default nil "black")
(kom-warning-face bold nil nil) (kom-warning-face bold nil nil)
(kom-first-line-face default nil nil)) (kom-first-line-face default nil nil)
(kom-dim-face default nil nil))
(highlight (highlight
(kom-active-face default nil "aliceblue") (kom-active-face default nil "aliceblue")
(kom-url-face default nil "yellow") (kom-url-face default nil "yellow")
...@@ -2340,7 +2344,9 @@ the value of kom-tell-phrases for fun.") ...@@ -2340,7 +2344,9 @@ the value of kom-tell-phrases for fun.")
(kom-presence-face italic "dim gray" nil) (kom-presence-face italic "dim gray" nil)
(kom-mark-face bold "darkblue" "thistle") (kom-mark-face bold "darkblue" "thistle")
(kom-warning-face bold "yellow" "red") (kom-warning-face bold "yellow" "red")
(kom-first-line-face default nil "lavender"))) (kom-first-line-face default nil "lavender")
(kom-dim-face default "gray" nil)
))
"Face schemes for LysKOM. "Face schemes for LysKOM.
This variable is an association list that defines the face and color This variable is an association list that defines the face and color
......
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