Reformatted.
[chise/xemacs-chise.git.1] / 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      )))