git.chise.org Git - chise/xemacs-chise.git.1/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      :autosize t
  64      :spec
  65      (setq search-dialog
  66            (make-glyph
  67             `[layout
  68               :orientation horizontal
  69               :vertically-justify top
  70               :horizontally-justify center
  71               :border [string :data "Search"]
  72               :items
  73               ([layout :orientation vertical
  74                        :justify top     ; implies left also
  75                        :items
  76                        ([string :data "Search for:"]
  77                         [button :descriptor "Match Case"
  78                                 :style toggle
  79                                 :selected (not case-fold-search)
  80                                 :callback (setq case-fold-search
  81                                                 (not case-fold-search))]
  82                         [button :descriptor "Regular Expression"
  83                                 :style toggle
  84                                 :selected search-dialog-regexp
  85                                 :callback (setq search-dialog-regexp
  86                                                 (not search-dialog-regexp))]
  87                         [button :descriptor "Forwards"
  88                                 :style radio
  89                                 :selected search-dialog-direction
  90                                 :callback (setq search-dialog-direction t)]
  91                         [button :descriptor "Backwards"
  92                                 :style radio
  93                                 :selected (not search-dialog-direction)
  94                                 :callback (setq search-dialog-direction nil)]
  95                         )]
  96                [layout :orientation vertical
  97                        :vertically-justify top
  98                        :horizontally-justify right
  99                        :items
 100                        ([edit-field :width 15 :descriptor "" :active t
 101                                     :initial-focus t]
 102                         [button :width 10 :descriptor "Find Next"
 103                                 :callback-ex
 104                                 (lambda (image-instance event)
 105                                   (search-dialog-callback ,parent
 106                                                           image-instance
 107                                                           event))]
 108                         [button :width 10 :descriptor "Cancel"
 109                                 :callback-ex
 110                                 (lambda (image-instance event)
 111                                   (isearch-dehighlight)
 112                                   (delete-frame
 113                                    (event-channel event)))])])]))
 114      ;; These are no longer strictly necessary, but not setting a size
 115      ;; at all yields a much more noticeable resize since the initial
 116      ;; frame is so big.
 117      :properties `(height ,(widget-logical-to-character-height 6)
 118                           width ,(widget-logical-to-character-width 39))
 119      )))