Commits

Anonymous committed 7d1c9b4

Apply changes made by Steve Youngs.

  • Participants
  • Parent commits c81f179

Comments (0)

Files changed (2)

+2008-11-13  Steve Youngs  <steve@sxemacs.org>
+
+	* slider.el: Add compatibility code for SXEmacs.
+	(slider-new): Use it.
+	(slider-set): Use it.
+	(slider-activate-arrow-or-bar): Use it.
+
 2003-10-31  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.15 released.
 
 ;; Code:
 ;;
+;;; Compatibility.
+
+;; There is a bug in XEmacs extents where the order of extent glyphs
+;; can get messed up when you have zero-length extents.  SXEmacs has
+;; this fixed, but because it is such a long-standing bug code like
+;; this was written against the "buggy" extent api and so "breaks"
+;; when used with non-buggy extents.  Hence this compatibility snippet
+;; here.  --SY.
+(eval-and-compile
+  (if (featurep 'sxemacs)
+      (progn
+	(fset #'slider-set-glyph #'set-extent-end-glyph)
+	(fset #'slider-glyph #'extent-end-glyph))
+    (fset #'slider-set-glyph #'set-extent-begin-glyph)
+    (fset #'slider-glyph #'extent-begin-glyph)))
+
 ;;; First of all we'll define the needed variables.
 
 
     (insert-string "  ")
     (goto-char (1- (point)))
 
-    (setq slider (make-extent (1- (point)) (1+ (point))))
+    (setq slider (make-extent (point) (point)))
     (set-extent-property slider 'keymap slider-bar-keymap)
     (set-extent-property slider 'read-only read-only)
     (set-extent-property slider 'start-open t)
     (set-extent-property tmp 'slider-down slider-right-down)
     ;; initializing the display:
     ;; left arrow glyph:
-    (set-extent-begin-glyph (aref left-vector 0) slider-left-up)
+    (slider-set-glyph (aref left-vector 0) slider-left-up)
     ;; the left bar is invisible, so make the knob glyph:
-    (set-extent-begin-glyph knob slider-knob)
+    (slider-set-glyph knob slider-knob)
     ;; the right part of the bar is fully visible
     (let ((count 0))
       (while (< count number-of-bars)
-	(set-extent-begin-glyph (aref right-vector count) slider-element)
+	(slider-set-glyph (aref right-vector count) slider-element)
 	(setq count (1+ count))))
     ;; the right arrow glyph
-    (set-extent-begin-glyph (aref right-vector number-of-bars) slider-right-up)
+    (slider-set-glyph (aref right-vector number-of-bars) slider-right-up)
     ;; put some needed information into the knob's properties.
     (set-extent-property knob 'slider-action 'slider-drag-knob)
     (set-extent-keymap knob slider-knob-keymap)
 	       abs-value min max)
       (let ((count 1))
 	(while (<= count step)
-	  (set-extent-begin-glyph
+	  (slider-set-glyph
 	   (aref (extent-property slider 'slider-left)
 		 count) 
 	   slider-element)
 	  (setq count (1+ count)))
 	(while (<= count length)
-	  (set-extent-begin-glyph
+	  (slider-set-glyph
 	   (aref (extent-property slider 'slider-left)
 		 count)
 	   nil)
 	  (setq count (1+ count))))
       (let ((count 0))
 	(while (< count step)
-	  (set-extent-begin-glyph
+	  (slider-set-glyph
 	   (aref (extent-property slider 'slider-right)
 		 count) 
 	   nil)
 	  (setq count (1+ count)))
 	(while (< count length)
-	  (set-extent-begin-glyph
+	  (slider-set-glyph
 	   (aref (extent-property slider 'slider-right)
 		 count) 
 	   slider-element)
 	 up-glyph down-glyph)
     ;; make the glyph look pressed
     (cond  ((setq down-glyph (extent-property extent 'slider-down))
-	    (setq up-glyph (extent-begin-glyph extent))
-	    (set-extent-begin-glyph extent down-glyph)))
+	    (setq up-glyph (slider-glyph extent))
+	    (slider-set-glyph extent down-glyph)))
     (while mouse-down
       (if (input-pending-p)
 	  (setq event (next-event event))
       (if (button-release-event-p event)
 	  (setq mouse-down nil)))
     ;; make the glyph look released
-    (if down-glyph (set-extent-begin-glyph extent up-glyph))))
+    (if down-glyph (slider-set-glyph extent up-glyph))))
 
 (defun slider-activate-knob (event)
   (interactive "e")