git.chise.org Git - chise/xemacs-chise.git-/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: XEmacs Development Team
   7 ;; Keywords: content, gui, internal, dumped
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Synched up with: Not in FSF.
  27
  28 ;;; Commentary:
  29
  30 ;;
  31 ;; Simple search dialog
  32 ;;
  33 (defvar search-dialog-direction t)
  34 (defvar search-dialog-regexp nil)
  35 (defvar search-dialog nil)
  36
  37 (defun search-dialog-callback (parent image-instance event)
  38   (save-selected-frame
  39     (select-frame parent)
  40     (let ((domain (frame-selected-window  (event-channel event))))
  41       (funcall (if search-dialog-direction
  42                    (if search-dialog-regexp
  43                        're-search-forward
  44                      'search-forward)
  45                  (if search-dialog-regexp
  46                      're-search-backward
  47                    'search-backward))
  48                (glyph-image-property
  49                 (car (glyph-image-property
  50                       (nth 1 (glyph-image-property
  51                             search-dialog :items domain))
  52                       :items domain)) :text domain))
  53       (isearch-highlight (match-beginning 0) (match-end 0)))))
  54
  55 (defun make-search-dialog ()
  56   "Popup a search dialog box."
  57   (interactive)
  58   (let ((parent (selected-frame)))
  59     (make-dialog-box
  60      'general
  61      :parent parent
  62      :title "Search"
  63      :spec
  64      (setq search-dialog
  65            (make-glyph
  66             `[layout
  67               :orientation horizontal :justify left
  68               ;; neither the following height/width nor the identical one
  69               ;; below should be necessary! (see below)
  70               :height 11 :width 40
  71               :border [string :data "Search"]
  72               :items
  73               ([layout :orientation vertical :justify left
  74                        :items
  75                        ([string :data "Search for:"]
  76                         [button :descriptor "Match Case"
  77                                 :style toggle
  78                                 :selected (not case-fold-search)
  79                                 :callback (setq case-fold-search
  80                                                 (not case-fold-search))]
  81                         [button :descriptor "Regular Expression"
  82                                 :style toggle
  83                                 :selected search-dialog-regexp
  84                                 :callback (setq search-dialog-regexp
  85                                                 (not search-dialog-regexp))]
  86                         [button :descriptor "Forwards"
  87                                 :style radio
  88                                 :selected search-dialog-direction
  89                                 :callback (setq search-dialog-direction t)]
  90                         [button :descriptor "Backwards"
  91                                 :style radio
  92                                 :selected (not search-dialog-direction)
  93                                 :callback (setq search-dialog-direction nil)]
  94                         )]
  95                [layout :orientation vertical :justify left
  96                        :items
  97                        ([edit-field :width 15 :descriptor "" :active t
  98                                     :face default :initial-focus t]
  99                         [button :width 10 :descriptor "Find Next"
 100                                 :callback-ex
 101                                 (lambda (image-instance event)
 102                                   (search-dialog-callback ,parent
 103                                                           image-instance
 104                                                           event))]
 105                         [button :width 10 :descriptor "Cancel"
 106                                 :callback-ex
 107                                 (lambda (image-instance event)
 108                                   (isearch-dehighlight)
 109                                   (delete-frame
 110                                    (event-channel event)))])])]))
 111      ;; neither this height/width nor the identical one above should
 112      ;; be necessary! (in fact, if you omit the one above, the layout
 113      ;; sizes itself correctly; but the frame as a whole doesn't use
 114      ;; the layout's size, as it should.)
 115      :properties '(height 11 width 40))))