cgit.sxemacs.org Git - sxemacs/blob - lisp/dialog-items.el

   1 ;;; dialog-items.el --- Dialog-box content for XEmacs
   2
   3 ;; Copyright (C) 2000 Andy Piper.
   4 ;; Copyright (C) 2000 Ben Wing.
   5
   6 ;; Maintainer: SXEmacs Development Team
   7 ;; Keywords: content, gui, internal, dumped
   8
   9 ;; This file is part of SXEmacs.
  10
  11 ;; SXEmacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; SXEmacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Synched up with: Not in FSF.
  25
  26 ;;; Commentary:
  27
  28 ;;
  29 ;; Simple search dialog
  30 ;;
  31 (defvar search-dialog-direction t)
  32 (defvar search-dialog-regexp nil)
  33 (defvar search-dialog nil)
  34
  35 (defun search-dialog-callback (parent image-instance event)
  36   (save-selected-frame
  37     (select-frame parent)
  38     (let ((domain (frame-selected-window  (event-channel event))))
  39       (funcall (if search-dialog-direction
  40                    (if search-dialog-regexp
  41                        're-search-forward
  42                      'search-forward)
  43                  (if search-dialog-regexp
  44                      're-search-backward
  45                    'search-backward))
  46                (glyph-image-property
  47                 (car (glyph-image-property
  48                       (nth 1 (glyph-image-property
  49                             search-dialog :items domain))
  50                       :items domain)) :text domain))
  51       (isearch-highlight (match-beginning 0) (match-end 0)))))
  52
  53 (defun make-search-dialog ()
  54   "Popup a search dialog box."
  55   (interactive)
  56   (let ((parent (selected-frame)))
  57     (make-dialog-box
  58      'general
  59      :parent parent
  60      :title "Search"
  61      :autosize t
  62      :spec
  63      (setq search-dialog
  64            (make-glyph
  65             `[layout
  66               :orientation horizontal
  67               :vertically-justify top
  68               :horizontally-justify center
  69               :border [string :data "Search"]
  70               :items
  71               ([layout :orientation vertical
  72                        :justify top     ; implies left also
  73                        :items
  74                        ([string :data "Search for:"]
  75                         [button :descriptor "Match Case"
  76                                 :style toggle
  77                                 :selected (not case-fold-search)
  78                                 :callback (setq case-fold-search
  79                                                 (not case-fold-search))]
  80                         [button :descriptor "Regular Expression"
  81                                 :style toggle
  82                                 :selected search-dialog-regexp
  83                                 :callback (setq search-dialog-regexp
  84                                                 (not search-dialog-regexp))]
  85                         [button :descriptor "Forwards"
  86                                 :style radio
  87                                 :selected search-dialog-direction
  88                                 :callback (setq search-dialog-direction t)]
  89                         [button :descriptor "Backwards"
  90                                 :style radio
  91                                 :selected (not search-dialog-direction)
  92                                 :callback (setq search-dialog-direction nil)]
  93                         )]
  94                [layout :orientation vertical
  95                        :vertically-justify top
  96                        :horizontally-justify right
  97                        :items
  98                        ([edit-field :width 15 :descriptor "" :active t
  99                                     :initial-focus t]
 100                         [button :width 10 :descriptor "Find Next"
 101                                 :callback-ex
 102                                 (lambda (image-instance event)
 103                                   (search-dialog-callback ,parent
 104                                                           image-instance
 105                                                           event))]
 106                         [button :width 10 :descriptor "Cancel"
 107                                 :callback-ex
 108                                 (lambda (image-instance event)
 109                                   (isearch-dehighlight)
 110                                   (delete-frame
 111                                    (event-channel event)))])])]))
 112      ;; These are no longer strictly necessary, but not setting a size
 113      ;; at all yields a much more noticeable resize since the initial
 114      ;; frame is so big.
 115      :properties `(height ,(widget-logical-to-character-height 6)
 116                           width ,(widget-logical-to-character-width 39))
 117      )))