changeset 18087:05c70aa62552

Synched with 1.9903
author Per Abrahamsen <abraham@dina.kvl.dk>
date Sun, 01 Jun 1997 08:04:57 +0000
parents dbae3eb8b351
children be8a62ae8d21
files lisp/cus-edit.el lisp/wid-edit.el
diffstat 2 files changed, 51 insertions(+), 26 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/cus-edit.el	Sun Jun 01 06:41:08 1997 +0000
+++ b/lisp/cus-edit.el	Sun Jun 01 08:04:57 1997 +0000
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.9901
+;; Version: 1.9903
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -1141,8 +1141,7 @@
       (insert "   ")
       (push (widget-create-child-and-convert 
 	     widget 'choice-item 
-	     :help-echo "\
-Change the state of this item."
+	     :help-echo "Change the state of this item."
 	     :format (if hidden "%t" "%[%t%]")
 	     :button-prefix 'widget-push-button-prefix
 	     :button-suffix 'widget-push-button-suffix
@@ -1214,19 +1213,24 @@
 	 (level (widget-get widget :custom-level)))
     (cond ((eq escape ?l)
 	   (when level 
+	     (insert-char ?\  (1- level))
 	     (if (eq state 'hidden)
-		 (insert-char ?- (* 2 level))
-	       (insert "/" (make-string (1- (* 2 level)) ?-)))))
+		 (insert-char ?- (1+ level))
+	       (insert "/")
+	       (insert-char ?- level))))
 	  ((eq escape ?e)
 	   (when (and level (not (eq state 'hidden)))
-	     (insert "\n\\" (make-string (1- (* 2 level)) ?-) " "
-		     (widget-get widget :tag) " group end ")
-	     (insert (make-string (- 75 (current-column)) ?-) "/\n")))
+	     (insert "\n")
+	     (insert-char ?\  (1- level))
+	     (insert "\\")
+	     (insert-char ?-  level)
+	     (insert " " (widget-get widget :tag) " group end ")
+	     (insert-char ?- (- 75 (current-column) level))
+	     (insert "/\n")))
 	  ((eq escape ?-)
-	   (when level 
-	     (if (eq state 'hidden)
-		 (insert-char ?- (- 77 (current-column)))		 
-	       (insert (make-string (- 76 (current-column)) ?-) "\\"))))
+	   (when (and level (not (eq state 'hidden)))
+	     (insert-char ?- (- 76 (current-column) level))
+	     (insert "\\")))
 	  ((eq escape ?L)
 	   (push (widget-create-child-and-convert
 		  widget 'visibility
--- a/lisp/wid-edit.el	Sun Jun 01 06:41:08 1997 +0000
+++ b/lisp/wid-edit.el	Sun Jun 01 08:04:57 1997 +0000
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9901
+;; Version: 1.9903
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -109,6 +109,27 @@
 	(display-error obj buf)
 	(buffer-string buf)))))
 
+(when (let ((a "foo"))
+	(put-text-property 1 2 'foo 1 a)
+	(put-text-property 1 2 'bar 2 a)
+	(set-text-properties 1 2 nil a)
+	(text-properties-at 1 a))
+  ;; XEmacs 20.2 and earlier had a buggy set-text-properties.
+  (defun set-text-properties (start end props &optional buffer-or-string)
+    "Completely replace properties of text from START to END.
+The third argument PROPS is the new property list.
+The optional fourth argument, BUFFER-OR-STRING,
+is the string or buffer containing the text."
+    (map-extents #'(lambda (extent ignored)
+		     (remove-text-properties
+		      start end
+		      (list (extent-property extent 'text-prop)
+			    nil)
+		      buffer-or-string)
+		     nil)
+		 buffer-or-string start end nil nil 'text-prop)
+    (add-text-properties start end props buffer-or-string)))
+
 ;;; Customization.
 
 (defgroup widgets nil
@@ -253,10 +274,16 @@
 (defun widget-specify-text (from to)
   ;; Default properties.
   (add-text-properties from to (list 'read-only t
+				     ;; Emacs is sticky.
 				     'front-sticky t
-				     'start-open t
-				     'end-open t
-				     'rear-nonsticky nil)))
+				     'rear-nonsticky nil
+				     ;; XEmacs is non-sticky.
+				     'start-open nil
+				     'end-open nil
+				     ;; This is because `insert'
+				     ;; inherit sticky text properties
+				     ;; in XEmacs but not in Emacs. 
+				     )))
 
 (defun widget-specify-field (widget from to)
   ;; Specify editable button for WIDGET between FROM and TO.
@@ -351,21 +378,18 @@
 					    'face face)))
     (add-text-properties to (1+ to) (list 'local-map map
 					  'keymap map))))
-
 (defun widget-specify-button (widget from to)
   ;; Specify button for WIDGET between FROM and TO.
   (let ((face (widget-apply widget :button-face-get))
-	(help-echo (widget-get widget :help-echo))
-	(help-property (if (featurep 'balloon-help)
-			   'balloon-help
-			 'help-echo)))
+	(help-echo (widget-get widget :help-echo)))
     (unless (or (null help-echo) (stringp help-echo))
       (setq help-echo 'widget-mouse-help))
     (add-text-properties from to (list 'button widget
 				       'mouse-face widget-mouse-face
 				       'start-open t
 				       'end-open t
-				       help-property help-echo
+				       'balloon-help help-echo
+				       'help-echo help-echo
 				       'face face))))
 
 (defun widget-mouse-help (extent)
@@ -1051,7 +1075,7 @@
   "Kill to end of field or end of line, whichever is first."
   (interactive)
   (let ((field (get-text-property (point) 'field))
-	(newline (save-excursion (search-forward "\n")))
+	(newline (save-excursion (forward-line 1)))
 	(next (next-single-property-change (point) 'field)))
     (if (and field (> newline next))
 	(kill-region (point) next)
@@ -1661,9 +1685,6 @@
 		      (eq (char-after (1- to)) ?\ ))
 	    (setq to (1- to)))
 	  (let ((result (buffer-substring-no-properties from to)))
-	    (when (string-match "XEmacs" emacs-version)
-	      ;; XEmacs 20.1 bug: b-s-n-p doesn't clear all properties. 
-	      (setq result (format "%s" result)))
 	    (when secret
 	      (let ((index 0))
 		(while (< (+ from index) to)