X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fdialog.el;h=235d13594583fce9811954d7ae4a6cff964fa5a2;hb=35a46b890bfd96a72831943c7c715886343ea727;hp=4b3f2848e474f1ae2002592ddf82c90bcb1ad994;hpb=dbf2768f7b146e97e37a27316f70bb313f1acf15;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/dialog.el b/lisp/dialog.el
index 4b3f284..235d135 100644
--- a/lisp/dialog.el
+++ b/lisp/dialog.el
@@ -195,6 +195,8 @@ The keywords allowed for `general' are
   The frame is made a child of this frame (defaults to the selected frame).
 :properties
   Additional properties of the frame, as well as `dialog-frame-plist'.
+:autosize
+  If t the frame is sized to exactly fit the widgets given by :spec.
 
 ---------------------------------------------------------------------------
 
@@ -547,7 +549,9 @@ The keywords allowed are
 				   'internal-make-dialog-box-exit did)
 				  (remove-hook 'delete-dialog-box-hook
 					       ',sym))))
-		       (add-hook 'delete-dialog-box-hook sym)
+		       (if (framep id)
+			   (add-hook 'delete-frame-hook sym)
+			 (add-hook 'delete-dialog-box-hook sym))
 		       (mapc 'disable-frame frames)
 		       (block nil
 			 (while t
@@ -568,6 +572,7 @@ The keywords allowed are
 	     (:parent (selected-frame))
 	     :modal
 	     :properties
+	     :autosize
 	     :spec)
 	    ()
 	  (flet ((create-dialog-box-frame ()
@@ -615,6 +620,7 @@ The keywords allowed are
 					    vertical-scrollbar-visible-p nil
 					    horizontal-scrollbar-visible-p nil
 					    unsplittable t
+					    internal-border-width 8
 					    left ,(+ fleft (- (/ fwidth 2)
 							      (/ (* dfwidth
 								    fontw)
@@ -625,6 +631,19 @@ The keywords allowed are
 							       2)))))))
 		     (set-face-foreground 'modeline [default foreground] frame)
 		     (set-face-background 'modeline [default background] frame)
+		     ;; resize before mapping
+		     (when cl-autosize
+		       (set-frame-pixel-size 
+			frame
+			(image-instance-width 
+			 (glyph-image-instance cl-spec 
+					       (frame-selected-window frame)))
+			(image-instance-height 
+			 (glyph-image-instance cl-spec 
+					       (frame-selected-window frame)))))
+		     ;; somehow, even though the resizing is supposed
+		     ;; to be while the frame is not visible, a
+		     ;; visible resize is perceptible
 		     (unless unmapped (make-frame-visible frame))
 		     (let ((newbuf (generate-new-buffer " *dialog box*")))
 		       (set-buffer-dedicated-frame newbuf frame)