cgit.sxemacs.org Git - packages/blob - xemacs-packages/jde/lisp/efc-xemacs.el

   1 ;;; efc-xemacs.el -- Emacs Foundation Classes using XEmacs gui features.
   2
   3 ;; Author: Andy Piper <andy@xemacs.org>
   4 ;; Maintainer: Andy Piper
   5 ;; Keywords: lisp, tools, classes gui
   6
   7 ;; Copyright (C) 2002, 2003, 2004 Andy Piper.
   8 ;; Copyright (C) 2001, 2002 Paul Kinnucan.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, US
  24 ;;; Commentary:
  25
  26 ;; This package contains a set of eieio-based foundation classes
  27 ;; for XEmacs.
  28
  29 ;; Please send bug reports and enhancement suggestions
  30 ;; to Andy Piper at <andy@xemacs.org>
  31
  32 ;;; Code:
  33
  34 (require 'eieio)
  35 (require 'efc)
  36
  37 ;; Install ourselves as the default option function,
  38 ;; only if this version of XEmacs supports native widgets.
  39 (when (and (fboundp 'make-dialog-box)
  40            use-dialog-box)
  41   (setq efc-query-options-function 'efc-xemacs-query-options))
  42
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;;                                                                            ;;
  45 ;; Option Dialog                                                              ;;
  46 ;;                                                                            ;;
  47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48
  49 (defclass efc-xemacs-option-dialog (efc-dialog)
  50   ((options        :initarg :options
  51                    :documentation
  52                    "Options from from which to choose.")
  53    (radio-buttons  :initarg :radio-buttons
  54                    :documentation
  55                    "Buttons for selecting options.")
  56    (text           :initarg :text
  57                    :type string
  58                    :initform "Select option."
  59                    :documentation
  60                    "Text to be inserted at top of dialog.")
  61    (selection      :initarg :selection
  62                    :initform nil
  63                    :documentation
  64                    "Option chosen by the user."))
  65    "This dialog allows a user to choose one of a set of OPTIONS by clicking
  66 a radio button next to the option. The dialog sets SELECTION to the option
  67 chosen by the user when the user selects the OK button on the dialog. This
  68 dialog uses recursive edit to emulate a modal dialog.")
  69
  70 (defmethod initialize-instance ((this efc-xemacs-option-dialog) &rest fields)
  71   "Dialog constructor."
  72   (call-next-method))
  73
  74 (defmethod efc-dialog-show ((this efc-xemacs-option-dialog))
  75   "Shows the options dialog buffer. After showing the dialog buffer,
  76 this method invokes recursive-edit to emulate the behavior of a modal
  77 dialog. This suspends the current command until the user has selected
  78 an option or canceled the dialog. See `efc-dialog-ok' and
  79 `efc-dialog-cancel' for more information."
  80   (efc-xemacs-option-dialog-show this))
  81
  82 ;; This is hack to get round a bug in XEmacs' treatment of :selected
  83 (defvar efc-xemacs-option-dialog-selection nil)
  84
  85 (defun efc-xemacs-option-dialog-show (this)
  86   (let ((parent (selected-frame)))
  87     (unless (oref this selection)
  88       (oset this selection (car (oref this options))))
  89     (setq efc-xemacs-option-dialog-selection (oref this selection))
  90     (oset
  91      this selection
  92      (make-dialog-box
  93       'general
  94       :parent parent
  95       :title (oref this title)
  96       :modal t
  97       :autosize t
  98       :spec (make-glyph
  99              `[layout :orientation vertical
 100                       :justify center
 101                       :border [string :data ,(oref this text)]
 102                       :items ([layout :orientation vertical
 103                                       :horizontally-justify left
 104                                       :vertically-justify center
 105                                       :items
 106                                       ,(mapcar
 107                                         (lambda (x)
 108                                           (vector
 109                                            'button :descriptor x
 110                                            :style 'radio
 111                                            :selected
 112                                            (list 'efc-xemacs-option-dialog-action this x)
 113                                            :callback
 114                                            (list 'efc-xemacs-option-dialog-select this x)))
 115                                         (oref this options))]
 116                               [layout :orientation horizontal
 117                                       :justify center
 118                                       :items
 119                                       ([button :descriptor "Ok"
 120                                                :callback-ex
 121                                                (lambda (image-instance event)
 122                                                  (efc-xemacs-dialog-ok ,this event))]
 123                                        [button :descriptor "Cancel"
 124                                                :callback-ex 'efc-xemacs-dialog-cancel
 125                                                ])])]))
 126       )))
 127
 128 (defun efc-xemacs-option-dialog-select (this item)
 129   (oset this selection item)
 130   (setq efc-xemacs-option-dialog-selection item))
 131
 132 (defun efc-xemacs-option-dialog-action (this item)
 133 ; This doesn't work for some reason I don't understand
 134 ;  (equal item (oref this selection))
 135   (equal efc-xemacs-option-dialog-selection item))
 136
 137 (defun efc-xemacs-dialog-ok (image-instance event)
 138   "Invoked when the user selects the OK button on the options
 139 dialog. Sets the :selection field of THIS to the option chosen by the
 140 user and kills the dialog window."
 141   (delete-frame (event-channel event))
 142   (dialog-box-finish efc-xemacs-option-dialog-selection))
 143
 144 (defun efc-xemacs-dialog-cancel (image-instance event)
 145   "Invoked when the user clicks the dialog's Cancel button.  Invokes
 146 the default cancel method, sets the :selection field of THIS to nil,
 147 and kills the dialog window."
 148   (delete-frame (event-channel event))
 149   (dialog-box-cancel))
 150
 151 (defun efc-xemacs-query-options (options &optional prompt title)
 152   "Ask user to choose among a set of options."
 153   (let ((dialog
 154          (efc-xemacs-option-dialog
 155           (or title "Option Dialog")
 156           :title (or title "Option Dialog")
 157           :text (if prompt prompt "Select option:")
 158           :options options)))
 159     (efc-dialog-show dialog)
 160     (oref dialog selection)))
 161
 162 ;(defun efc-xemacs-test()
 163 ;  (interactive)
 164 ;  (message (efc-query-options (list "one" "two" "three")
 165 ;                             "Select an option.")))
 166
 167 ;(defun efc-xemacs-test-ok()
 168 ;  (interactive)
 169 ;  (let ((dialog
 170 ;        (efc-dialog
 171 ;         "Ok cancel dialog"
 172 ;         :title "Ok cancel dialog")))
 173 ;    (efc-dialog-show dialog)))
 174
 175 (provide 'efc-xemacs)