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

Bugfixes

Updates to tree-edit.el
Better selection of charset for texts in Gnu Emacs
Limit number of overlays in buffer
Fixed default value when prompting for text numbers
Fixed text-no strategy for kom-private-answer-previous
parent 430bd7ac
2002-07-23 David Byers <david.byers@swipnet.se>
* lyskom-rest.el (lyskom-limited-make-overlay): New function
limits the number of overlays created.
(lyskom-special-insert-overlay): Use it.
(lyskom-format-insert-overlays): Use it.
* vars.el.in (kom-max-overlays): New variable.
(lyskom-overlay-pool): New variable.
2002-07-22 David Byers <david.byers@swipnet.se>
* mime.el (lyskom-mime-string-charset): Smarter selection of
coding system for Gnu Emacs. We still use our list whenever
possible, but if we can't find a coding system, we fall back on
Emacs' list of coding systems. Not done for XEmacs (yet).
* utilities.el (lyskom-read-text-no-prefix-arg): Prompt only after
computing a suitable default. That way we get a default value in
the prompt (which is a good thing).
2002-07-21 David Byers <david.byers@swipnet.se>
* edit-text.el (lyskom-edit-send-check-recipients): Support
recipient type in send-comments-to.
2002-07-20 David Byers <david.byers@swipnet.se>
* english-strings.el,swedish-strings.el: Add "Mozilla" in all
places where we say "Netscape".
* vars.el.in (kom-netscape-command): Clarify that mozilla and
netscape use the same settings.
(kom-url-managers): Say "Mozilla" in netscape manager.
2002-07-18 David Byers <david.byers@swipnet.se>
* tree-edit.el (tree-edit-compute-prefix): Made nonrecursive.
(tree-edit-compute-prefix-internal): Removed.
(tree-edit-adjust-markers): Made nonrecursive.
(tree-edit-draw): Made nonrecursive.
* vars.el.in (lyskom-text-buttons): Eliminate brackets and semis
at end of URLs.
* utilities.el (lyskom-pick-text-no-strategy-alist): Correct
strategy for kom-private-answer-previous.
2002-06-30 David Byers <david.byers@swipnet.se>
Temporary fix:
* commands1.el (lyskom-list-pers-print): Allocate five characters
for person numbers.
(lyskom-list-created-conferences-2): Same.
(kom-list-re): Same.
2002-07-16 Johan Sundström <jhs@lysator.liu.se>
* lyskom-rest.el (kom-go-to-next-conf): Treat prefix arguments as
......
......@@ -1653,7 +1653,7 @@ Those that you are not a member in will be marked with an asterisk."
(defun lyskom-list-pers-print (conf-z)
"Print name of the person CONF-NO for kom-list-persons."
(lyskom-format-insert "%[%#1@%4#2:p %#2P%]\n"
(lyskom-format-insert "%[%#1@%5#2:p %#2P%]\n"
(lyskom-default-button 'pers (conf-z-info->conf-no conf-z))
conf-z))
......@@ -1760,7 +1760,7 @@ Those that you are not a member in will be marked with an asterisk."
(conf-stat->supervisor cs)
(conf-stat->super-conf cs))))
(aset counter 3 (1+ (elt counter 3)))
(lyskom-format-insert "%[%#1@%4#2:m %#3c %4#4s %#5s %#2M%]\n"
(lyskom-format-insert "%[%#1@%5#2:m %#3c %4#4s %#5s %#2M%]\n"
(lyskom-default-button 'conf (conf-stat->conf-no cs))
cs
(lyskom-list-conf-membership-char (conf-stat->conf-no cs))
......@@ -1864,7 +1864,7 @@ be converted so that the search is case sensitive."
(if (conf-z-info-list->conf-z-infos conf-list)
(lyskom-traverse czi (conf-z-info-list->conf-z-infos conf-list)
(lyskom-format-insert
"%[%#1@%4#2:m %#3c %#2:M%]\n"
"%[%#1@%5#2:m %#3c %#2:M%]\n"
(lyskom-default-button
'conf (conf-z-info->conf-no czi))
czi
......@@ -2906,7 +2906,7 @@ Uses Protocol A version 8 calls"
format-string-2
""
(lyskom-return-username who-info)
(concat "(" (who-info->doing-what who-info) ")"))))
(concat "(" (string-replace-match "\n" (who-info->doing-what who-info) " ") ")"))))
(setq who-list (cdr who-list)))
(lyskom-insert (concat (make-string (- (lyskom-window-width) 1) ?-)
......@@ -3036,7 +3036,7 @@ Uses Protocol A version 9 calls"
format-string-2
""
username
(concat "(" (dynamic-session-info->what-am-i-doing who-info)
(concat "(" (string-replace-match "\n" (dynamic-session-info->what-am-i-doing who-info) " ")
")"))))
(if kom-show-since-and-when
(let ((active
......@@ -3459,6 +3459,8 @@ WHO-INFOS that are potential sessions."
(who-info->doing-what info))
(match-string 1 (who-info->doing-what info))
(who-info->doing-what info))))
(when (string-match "\n" string)
(string-replace-match "\n" string " "))
(if (string= string "")
(lyskom-get-string 'unknown-doing-what)
string))
......@@ -3506,6 +3508,8 @@ WHO-INFOS that are potential sessions."
(match-string
1 (dynamic-session-info->what-am-i-doing info))
(dynamic-session-info->what-am-i-doing info))))
(when (string-match "\n" string)
(string-replace-match "\n" string " "))
(if (string= string "")
(lyskom-get-string 'unknown-doing-what)
string))
......
......@@ -343,6 +343,8 @@ string to search in."
(lyskom-provide-function decode-coding-string (str coding-system) (copy-sequence str))
(lyskom-provide-function string-bytes (str) (length str))
(lyskom-provide-function check-coding-system (name) (error "No such coding system"))
(lyskom-provide-function find-coding-systems-for-charsets (cs) nil)
(lyskom-provide-function coding-system-get (cs prop) nil)
(lyskom-provide-function string-width (str) (length str))
(lyskom-provide-function char-width (c) 1)
(lyskom-provide-function find-charset-string (str) '(ascii))
......
......@@ -899,7 +899,7 @@ Cannot be called from a callback."
'conf-stat->conf-no))
;;
;; Filter the list. Remote all authors that are direct recipients
;; Filter the list. Remove all authors that are direct recipients
;; or whose send-comments-to is a direct recipient or who are
;; listed in kom-dont-check-commented-authors
;;
......@@ -907,14 +907,21 @@ Cannot be called from a callback."
(lyskom-traverse author raw-author-list
(let ((send-comments-to
(car (lyskom-get-aux-item (conf-stat->aux-items author) 33))))
(if (and send-comments-to
(string-match "^\\([0-9]+\\)"
(aux-item->data send-comments-to)))
(setq send-comments-to
(string-to-number
(match-string 1 (aux-item->data send-comments-to))))
(setq send-comments-to nil))
(when send-comments-to
(cond ((string-match "^\\([0-9]+\\)\\s-+\\([0-9]+\\)" (aux-item->data send-comments-to))
(setq send-comments-to
(cons (string-to-number
(match-string 1 (aux-item->data send-comments-to)))
(string-to-number
(match-string 2 (aux-item->data send-comments-to))))))
((string-match "^\\([0-9]+\\)"
(aux-item->data send-comments-to))
(setq send-comments-to
(cons (string-to-number
(match-string 1 (aux-item->data send-comments-to)))
0)))
(t (setq send-comments-to nil))))
(cond
......@@ -929,7 +936,7 @@ Cannot be called from a callback."
;; Author has a zero send-comments-to
((and send-comments-to (zerop send-comments-to)))
((and send-comments-to (zerop (car send-comments-to))))
;; We don't have permission to send stuff to the author's
;; send-comments-to or to the author if there is no
......@@ -937,7 +944,7 @@ Cannot be called from a callback."
((or (and send-comments-to
(not (lyskom-is-permitted-author
(blocking-do 'get-conf-stat send-comments-to))))
(blocking-do 'get-conf-stat (car send-comments-to)))))
(and (not send-comments-to)
(not (lyskom-is-permitted-author author)))))
......@@ -986,29 +993,40 @@ Cannot be called from a callback."
(lyskom-traverse author authors-to-ask-about
(let ((send-comments-to
(car (lyskom-get-aux-item (conf-stat->aux-items author) 33))))
(if (and send-comments-to
(string-match "^\\([0-9]+\\)"
(aux-item->data send-comments-to)))
(setq send-comments-to
(string-to-number
(match-string 1 (aux-item->data send-comments-to))))
(setq send-comments-to nil))
(when send-comments-to
(cond ((string-match "^\\([0-9]+\\)\\s-+\\([0-9]+\\)" (aux-item->data send-comments-to))
(setq send-comments-to
(cons (string-to-number
(match-string 1 (aux-item->data send-comments-to)))
(string-to-number
(match-string 2 (aux-item->data send-comments-to))))))
((string-match "^\\([0-9]+\\)"
(aux-item->data send-comments-to))
(setq send-comments-to
(cons (string-to-number
(match-string 1 (aux-item->data send-comments-to)))
0)))
(t (setq send-comments-to nil))))
(when (lyskom-j-or-n-p
(lyskom-format 'add-recipient-p
author
send-comments-to))
(car send-comments-to)))
(setq extra-headers
(nconc (list (if (lyskom-j-or-n-p
(lyskom-format
'really-add-as-recpt-q
(or send-comments-to author)))
'RECPT
'CC-RECPT)
(or send-comments-to
(conf-stat->conf-no author)))
extra-headers)))))))
(nconc
(list
(cond ((and send-comments-to
(eq (cdr send-comments-to) 0)) 'RECPT)
((and send-comments-to
(eq (cdr send-comments-to) 1)) 'CC-RECPT)
((and send-comments-to
(eq (cdr send-comments-to) 15)) 'BCC-RECPT)
(t (if (lyskom-j-or-n-p
(lyskom-format 'really-add-as-recpt-q author))
'RECPT
'CC-RECPT)))
(conf-stat->conf-no author))
extra-headers)))))))
extra-headers))
(defun lyskom-send-enriched (message)
......
......@@ -1794,6 +1794,7 @@ have been removed, you can fix the problem by giving the command
(keyboard-cancel . "Cancel")
(keyboard-menu-help . "(choose: C-n, C-p; confirm: RET)")
(customize-help . "See the beginning of the buffer for more information")
))
......@@ -1902,7 +1903,7 @@ have been removed, you can fix the problem by giving the command
(kom-review-all-marked-texts . "Review all marked (texts)")
(kom-add-recipient . "Add recipient")
(kom-add-copy . "Add (recipient of) carbon copy")
(kom-add-bcc . "Addera (recipient of) blind carbon copy")
(kom-add-bcc . "Add (recipient of) blind carbon copy")
(kom-sub-recipient . "Remove recipient")
(kom-move-text . "Move text")
(kom-move-text-tree . "Move tree")
......@@ -2632,8 +2633,8 @@ Select whether to execute command or keyboard macro.")
(viewer-program . "Web browser")
(no-viewer . "(ingenting valt)")
(default-viewer . "Browse-URL (all)")
(netscape-viewer . "Netscape Navigator (all)")
(windows-viewer . "Windows default or Netscape (all)")
(netscape-viewer . "Netscape/Mozilla (all)")
(windows-viewer . "Windows default or Netscape/Mozilla (all)")
(emacs-w3-viewer . "Emacs W3 mode (HTTP, Goper, FTP)")
(emacs-general-viewer . "Emacs (FTP, Telnet, Mail)")
(emacs-dired-viewer . "Emacs Dired (FTP)")
......@@ -3280,7 +3281,7 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
This setting specifies the command to use to start NCSA Mosaic.")
(kom-netscape-command-doc . "\
This setting specifies the command to use to start Netscape.")
This setting specifies the command to use to start Netscape or Mozilla.")
(kom-galeon-command-doc . "\
This setting specifies the command to use to start Galeon.")
......@@ -3686,7 +3687,7 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
(kom-url-viewer-preferences-tag . "Open URLs using the following program:")
(kom-windows-browser-command-tag . "Command to start a web browser on Windows:")
(kom-mosaic-command-tag . "Command to start NCSA Mosaic:")
(kom-netscape-command-tag . "Command to start Netscape Navigator:")
(kom-netscape-command-tag . "Command to start Netscape/Mozilla:")
(kom-galeon-command-tag . "Command to start Galeon:")
(kom-symbolic-marks-alist-tag . "Symbolic mark types:")
......
......@@ -1178,14 +1178,29 @@ Args: FORMAT-STRING &rest ARGS"
result))
result))
(defun lyskom-limited-make-overlay (start end)
(let ((val (lyskom-xemacs-or-gnu
(make-extent start end)
(make-overlay start end))))
(when (lyskom-plusp kom-max-overlays)
(let ((old (nthcdr (1- kom-max-overlays) lyskom-overlay-pool))) ;
(setq lyskom-overlay-pool
(lyskom-nbutlast lyskom-overlay-pool
(- (length lyskom-overlay-pool)
kom-max-overlays)))
(mapcar 'delete-overlay old))
(setq lyskom-overlay-pool (cons val lyskom-overlay-pool)))
val))
(defun lyskom-special-insert-overlay (start end args)
(lyskom-xemacs-or-gnu
(let ((overlay (make-extent start end)))
(let ((overlay (lyskom-limited-make-overlay start end)))
(while args
(set-extent-property overlay (car args) (car (cdr args)))
(setq args (nthcdr 2 args)))
(set-extent-priority overlay 1000))
(let ((overlay (make-overlay start end)))
(let ((overlay (lyskom-limited-make-overlay start end)))
(while args
(overlay-put overlay (car args) (car (cdr args)))
(setq args (nthcdr 2 args))))))
......@@ -1197,15 +1212,15 @@ Args: FORMAT-STRING &rest ARGS"
"Insert delayed overlays according to FORMAT-STATE."
(lyskom-traverse overlay (format-state->delayed-overlays format-state)
(lyskom-xemacs-or-gnu
(let ((overlay (make-extent (+ start (aref overlay 0))
(+ start (aref overlay 1))))
(let ((overlay (lyskom-limited-make-overlay (+ start (aref overlay 0))
(+ start (aref overlay 1))))
(args (aref overlay 2)))
(while args
(set-extent-property overlay (car args) (car (cdr args)))
(setq args (nthcdr 2 args)))
(set-extent-priority overlay 1000))
(let ((overlay (make-overlay (+ start (aref overlay 0))
(+ start (aref overlay 1))))
(let ((overlay (lyskom-limited-make-overlay (+ start (aref overlay 0))
(+ start (aref overlay 1))))
(args (aref overlay 2)))
(while args
(overlay-put overlay (car args) (car (cdr args)))
......
......@@ -66,14 +66,23 @@
(defun lyskom-mime-string-charset (data)
(let ((cs (find-charset-string data))
(tmp lyskom-charset-alist)
(system lyskom-server-coding-system))
(while (and tmp cs)
(if (lyskom-subset-p cs (car (car tmp)))
(setq system (cdr (car tmp)) tmp nil)
(setq tmp (cdr tmp))))
system))
(let* ((cs (find-charset-string data))
(tmp lyskom-charset-alist)
(best-guess (let ((system nil))
(while (and tmp cs)
(if (lyskom-subset-p cs (car (car tmp)))
(setq system (cdr (car tmp)) tmp nil)
(setq tmp (cdr tmp))))
system)))
(or
best-guess
(lyskom-xemacs-or-gnu
lyskom-server-coding-system
(let ((coding (find-coding-systems-for-charsets cs)))
(while (null (coding-system-get (car coding) 'mime-charset))
(setq coding (cdr coding)))
(coding-system-get (car coding) 'mime-charset)))
lyskom-server-coding-system)))
(defun lyskom-mime-charset-coding-system (charset)
(condition-case nil
......
......@@ -1229,7 +1229,8 @@ functions and variables that are connected with the lyskom-buffer."
(signal 'lyskom-protocol-error err))
(lyskom-parse-incomplete (signal (car err) (cdr err)))
(error (delete-region (point-min) lyskom-parse-pos)
(signal (car err) (cdr err))))
(signal (car err) (cdr err)))
)
(goto-char (point-min))
(if (looking-at "[ \n]+")
(delete-region (match-beginning 0) (match-end 0)))
......
......@@ -1806,6 +1806,7 @@ kommandot \"Spara variabler\".\n\n")
(keyboard-cancel . "Avbryt")
(keyboard-menu-help . "(vlj: C-n, C-p; bekrfta: RET)")
(customize-help . "Se brjan av bufferten fr mer information")
))
(lyskom-language-var local lyskom-month-names sv
......@@ -2684,8 +2685,8 @@ kommandot \"Spara variabler\".\n\n")
(viewer-program . "WWW-lsare")
(no-viewer . "(ingenting valt)")
(default-viewer . "Browse-URL (alla)")
(netscape-viewer . "Netscape Navigator (alla)")
(windows-viewer . "Windows standard eller Netscape (alla)")
(netscape-viewer . "Netscape/Mozilla (alla)")
(windows-viewer . "Windows standard eller Netscape/Mozilla (alla)")
(emacs-w3-viewer . "Emacs W3-mode (HTTP, Goper, FTP)")
(emacs-general-viewer . "Emacs (FTP, Telnet, Mail)")
(emacs-dired-viewer . "Emacs Dired (FTP)")
......@@ -3342,7 +3343,7 @@ i servern. Annars sparas det i din .emacs.")
Mosaic.")
(kom-netscape-command-doc . "\
Denna instllning anger kommandot fr att kra Netscape.")
Denna instllning anger kommandot fr att kra Netscape eller Mozilla.")
(kom-galeon-command-doc . "\
Denna instllning anger kommandot fr att kra Galeon.")
......@@ -3746,7 +3747,7 @@ i servern. Annars sparas det i din .emacs.")
(kom-url-viewer-preferences-tag . "ppna URLer med fljande program:")
(kom-windows-browser-command-tag . "Kommando fr att starta en WWW-lsare i Windows:")
(kom-mosaic-command-tag . "Kommando fr att starta NCSA Mosaic:")
(kom-netscape-command-tag . "Kommando fr att starta Netscape Navigator:")
(kom-netscape-command-tag . "Kommando fr att starta Netscape eller Mozilla:")
(kom-galeon-command-tag . "Kommando fr att starta Galeon:")
(kom-symbolic-marks-alist-tag . "Symboliska markeringstyper:")
......
......@@ -39,25 +39,132 @@
;;;;
;;;; TODO
;;;;
;;;; Cache hanging-indent-strings 'cos it'll be expensive to do
;;;; make-string so many times.
;;;;
;;;; Compile tree styles?
;;;;
;;;; Have a link from each child to the root, and store tree
;;;; style in the root (or perhaps let tree-get-property
;;;; traverse the parent links so we can do inherited
;;;; properties).
;;;;
;;;; Make it possible to collapse all but the first line of a
;;;; multiline item (with minimal redrawing, please).
;;;;
;;;; Optimize drawing a bit. Right now, if we attach a node, we
;;;; redraw the parent (and therefore all the children). This is
;;;; easy, but some trees are really deep (we hit max-specpdl-size
;;;; in one example), so doing this is needlessly expensive.
;;;;
;;;; Allow us to set a prefix length for the entire tree and have
;;;; prefixes to the items. These are text snippets to display to
;;;; the far left of the tree.
;;;;
;;;; Make it possible to collapse the parent of a node. Doing this
;;;; means that we don't display the entire path to the node, just
;;;; a marker saying that this node is underneath something else.
;;;;
;;;; Implement incremental computation of children, so that we can
;;;; set the prune attribute of a node and register a callback to
;;;; compute children of the node.
;;;;
;;;; Implement incremental computation of parent nodes.
;;;;
;;;; Document tree node properties
;;;; - prune
;;;; - leaf
;;;; - prune (don't draw the subtree)
;;;; - leaf (don't allow move-up and friends to attach a subtree)
;;;; - hanging-indent (hanging indent of multiline items, string or int)
;;;;
(defvar tree-edit-indent-level 3
"*Number of characters to indent each level in the tree editor.")
(defvar tree-edit-indent-a (concat "|" (make-string (1- tree-edit-indent-level) ?\ )))
(defvar tree-edit-indent-b (make-string tree-edit-indent-level ?\ ))
(defvar tree-edit-item-header (concat "+"
(make-string
(- tree-edit-indent-level 2) ?-)
" "))
(defvar tree-edit-kill-buffer nil
"Buffer containing the most recently killed tree.")
;;; ============================================================
;;; Drawing styles
(defvar tree-edit-current-style 'compact)
(defvar tree-edit-styles
'((default . ((indent-a . "| ")
(indent-b . " ")
(before-children . "|\n")
(after-children . "\n")
(item-header . tree-edit-item-header)
(last-item-header . tree-edit-last-item-header)))
(compact . ((indent-a . "| ")
(indent-b . " ")
(before-children . nil)
(after-children . nil)
(item-header . tree-edit-item-header)
(last-item-header . tree-edit-last-item-header)))
(semi-compact . ((indent-a . "| ")
(indent-b . " ")
(before-children . nil)
(after-children . "\n")
(item-header . tree-edit-item-header)
(last-item-header . tree-edit-last-item-header)))
(very-compact . ((indent-a . "|")
(indent-b . " ")
(before-children . nil)
(after-children . nil)
(item-header . "+")
(last-item-header . "`")))
"Definitions of tree styles.
Each item in this list is a definition of a tree style. A
definition is a cons whose car is the name of the style (a
symbol) and the cdr is an alist specifying the style.
The following keys must be present in the alist defining the
style:
indent-a The string to print to the right of items
that is used to connect children of a node,
when there are additional children at this
level. Normally a vertical bar and some
whitespace.
indent-b The string to print to the right of items
to indent them when there are no additional
children at this level. Normally some
whitespace.
before-children The string to print before the first child of
a node. This string will be prefixed as the
parent node.
after-children The string to print after the last child of
a node. This string will be prefixed as the
parent node.
item-header The header of an item. Normally this connects
the indent-a printed on the prevous line with
the current item and the indent-a below.
last-item-header The header used for the last child of a
node. This item usually connects the indent-a
printed on the previous line with the indent-b
printed on the next line.
IMPORTANT: The lenghts of indent-a, indent-b and last-item-header
must be the same for all nodes at the same level in
the tree.
The cdrs of each item in the defining alist is either a string;
the name of a function (a symbol) that returns a string or nil;
or nil (in which case nothing is printed).
"
))
(defun tree-edit-get-style-data (item &optional style)
(cdr (assq item (cdr (assq (or style tree-edit-current-style)
tree-edit-styles)))))
;;; ============================================================
;;; Error symbols
......@@ -195,44 +302,79 @@ If there is no property PROPERTY for NODE, return DEFAULT."
;;; Basic drawing
(defun tree-edit-insert-part (part tree prefix)
(let ((fn (tree-edit-get-style-data part)))
(cond ((functionp fn) (setq fn (funcall fn tree)))
((and (symbolp fn) (boundp fn))
(setq fn (symbol-value fn))))
(cond ((null fn))
((stringp fn)
(insert (tree-edit-prefix-string prefix))
(insert fn)))))
(defun tree-edit-prefix-string (prefix)
"Return a string of spaces and bars according to values in PREFIX.
Used to draw the spaces and bars before a tree entry. Any strings
in PREFIX are included verbatim."
(apply 'concat (mapcar (lambda (x)
(cond ((stringp x) x)
(x tree-edit-indent-a)
(t tree-edit-indent-b))) prefix)))
(x (tree-edit-get-style-data 'indent-a))
(t (tree-edit-get-style-data 'indent-b))))
prefix)))
(defun tree-edit-compute-prefix (tree)
"Compute the prefix for subtree TREE.
Returns a list of nil and non-nil values specifying where to draw
vertical lines and where to not draw vertical lines."
(when tree
(nreverse (tree-edit-compute-prefix-internal (tree-node->parent tree)))))
(let ((result nil)
(tree (tree-node->parent tree)))
(while tree
(setq result (cons (tree-node-next-sibling tree) result))
(setq tree (tree-node->parent tree)))
result))
(defun tree-edit-compute-prefix-internal (tree)
"Compute the prefix for TREE.
Returns a list of non-nil and nil that specifies the indentation for
TREE when drawn in the buffer."
(when tree
(cons (tree-node-next-sibling tree)
(tree-edit-compute-prefix-internal (tree-node->parent tree)))))
(defun tree-edit-adjust-markers (tree)
(while (and tree
(tree-node->end tree)
(tree-node->children tree))
(let ((kids (tree-node->children tree)))
(while kids
(when (and (tree-node->end (car kids))
(> (tree-node->end (car kids))