/usr/lib/gcl-2.6.12/gcl-tk/demos/mkdialog.lisp is in gcl 2.6.12-47.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | ;;# mkDialog w msgArgs list list '...
(in-package "TK")
;;
;; Create a dialog box with a message and any number of buttons at
;; the bottom.
;;
;; Arguments:
;; w - Name to use for new top-level window.
;; msgArgs - List of arguments to use when creating the message of the
;; dialog box (e.g. :text, justifcation, etc.)
;; list - A two-element list that describes one of the buttons that
;; will appear at the bottom of the dialog. The first element
;; gives the text to be displayed in the button and the second
;; gives the command to be invoked when the button is invoked.
(defun mkDialog (w msgArgs &rest args)
(if (winfo :exists w :return 'boolean) (destroy w))
(toplevel w :class "Dialog")
(wm :title w "Dialog box")
(wm :iconname w "Dialog")
;; Create two frames in the main window. The top frame will hold the
;; message and the bottom one will hold the buttons. Arrange them
;; one above the other, with any extra vertical space split between
;; them.
(frame (conc w '.top) :relief "raised" :border 1)
(frame (conc w '.bot) :relief "raised" :border 1)
(pack (conc w '.top) (conc w '.bot) :side "top" :fill "both" :expand "yes")
;; Create the message widget and arrange for it to be centered in the
;; top frame.
(apply 'message (conc w '.top.msg) :justify "center"
:font :Adobe-times-medium-r-normal--*-180* msgArgs)
(pack (conc w '.top.msg) :side "top" :expand "yes" :padx 3 :pady 3)
;; Create as many buttons as needed and arrange them from left to right
;; in the bottom frame. Embed the left button in an additional sunken
;; frame to indicate that it is the default button, and arrange for that
;; button to be invoked as the default action for clicks and returns in
;; the dialog.
(if (> (length args) 0)
(let ((i 1) arg)
(setq arg (nth 0 args))
(frame (conc w '.bot.0) :relief "sunken" :border 1)
(pack (conc w '.bot.0) :side "left" :expand "yes" :padx 10 :pady 10)
(button (conc w '.bot.0.button) :text (nth 0 arg)
:command `(progn ,(nth 1 arg)(destroy ',w)))
(pack (conc w '.bot.0.button) :expand "yes" :padx 6 :pady 6)
(bind w "<Return>" `(progn ,(nth 1 arg)(destroy ',w)))
(focus w)
(dolist (arg (cdr args))
(setq i (+ i 1))
(button (conc w '.bot. i) :text (nth 0 arg)
:command `(progn ,(nth 1 arg)(destroy ',w)))
(pack (conc w '.bot. i) :side "left" :expand "yes" :padx 10)
)
))
(bind w "<Any-Enter>" `(focus ',w))
(focus w)
)
|