+ ;; #### sometimes the buffer gets changed temporarily. I don't know
+ ;; why this is, so protect against it.
+ (save-excursion
+ (if (and (null fmt) (null args))
+ (prog1 nil
+ (clear-progress-display label nil))
+ (let ((str (apply 'format fmt args)))
+ (display-progress-display label str value)
+ str))))
+
+;;
+;; Simple search dialog
+;;
+(defvar search-dialog-direction t)
+(defvar search-dialog-text
+ (make-glyph
+ [edit-field :width 15 :descriptor "" :active t :face default]))
+
+(defun search-dialog-callback (parent image-instance event)
+ (save-selected-frame
+ (select-frame parent)
+ (funcall (if search-dialog-direction
+ 'search-forward 'search-backward)
+ (image-instance-property
+ (glyph-image-instance search-dialog-text
+ (frame-selected-window
+ (event-channel event))) :text))
+ (isearch-highlight (match-beginning 0) (match-end 0))))
+
+(defun make-search-dialog ()
+ "Popup a search dialog box."
+ (interactive)
+ (let* ((parent (selected-frame)))
+ (set-buffer-dedicated-frame
+ (get-buffer-create "Dialog")
+ (make-dialog-box
+ (make-glyph
+ `[layout
+ :orientation horizontal :justify left
+ :height 10 :width 40
+ :border [string :data "Search"]
+ :items
+ ([layout :orientation vertical :justify left
+ :items
+ ([string :data "Search for:"]
+ [button :descriptor "Match case"
+ :style toggle
+ :selected (not case-fold-search)
+ :callback (setq case-fold-search
+ (not case-fold-search))]
+ [button :descriptor "Forwards"
+ :style radio
+ :selected search-dialog-direction
+ :callback (setq search-dialog-direction t)]
+ [button :descriptor "Backwards"
+ :style radio
+ :selected (not search-dialog-direction)
+ :callback (setq search-dialog-direction nil)]
+ )]
+ [layout :orientation vertical :justify left
+ :items
+ (search-dialog-text
+ [button :width 10 :descriptor "Find Next"
+ :callback-ex
+ (lambda (image-instance event)
+ (search-dialog-callback ,parent
+ image-instance event))]
+ [button :width 10 :descriptor "Cancel"
+ :callback-ex
+ (lambda (image-instance event)
+ (isearch-dehighlight)
+ (delete-frame
+ (event-channel event)))])])])
+ '(height 10 width 40)))))