cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-interactive.el

   1 ;;; xwem-interactive.el --- XWEM interactive interface.
   2
   3 ;; Copyright (C) 2003-2004 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Thu Dec 18 05:49:52 MSK 2003
   8 ;; Keywords: xwem, xlib
   9 ;; X-CVS: $Id: xwem-interactive.el,v 1.13 2005-04-04 19:54:12 lg Exp $
  10
  11 ;; This file is part of XWEM.
  12
  13 ;; XWEM is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26 ;; 02111-1307, USA.
  27
  28 ;;; Synched up with: Not in FSF
  29
  30 ;;; Commentary:
  31
  32 ;;
  33
  34 ;;; Code:
  35 \f
  36 (eval-when-compile
  37   ;; Shutup compiler
  38   (defvar iswitchb-buflist nil)
  39   (autoload 'iswitchb-read-buffer "iswitchb")
  40   )
  41
  42 (require 'xlib-xlib)
  43
  44 (require 'xwem-struct)
  45 (require 'xwem-loaddefs)
  46
  47 \f
  48 (defcustom xwem-completing-read-type 'iswitchb
  49   "*Type of interactive client reading.
  50 Possible values are `iswitchb', requires iswitchb package, or
  51 `complete' uses standard `completing-read'."
  52   :type '(choice (const :tag "Iswitchb" iswitchb)
  53                  (const :tag "Standard" complete))
  54   :group 'xwem-misc)
  55
  56 ;;; Internal variables
  57
  58 (defvar xwem-interactively nil
  59   "Non-nil when xwem in interactive mode.
  60 Internal variabel, do not modify.")
  61
  62 ;; Save read-from-minibuffer for further use
  63 (eval-and-compile
  64   (define-function 'read-from-minibuffer-for-xwem
  65     (symbol-function 'read-from-minibuffer)))
  66
  67 (defmacro xwem-interactive (&rest ispec)
  68   "Just like `interactive', but accepts xwem specific arguments.
  69 Code letters available are:
  70 s -- String.
  71 k -- Single key.
  72 K -- Key sequence that executes command.
  73 c -- Client.
  74 f -- Existing file.
  75 F -- Possible non-existing file.
  76 p -- Prefix argument as number.
  77 P -- Prefix argument in raw form.
  78 C -- Command.
  79 e -- External command."
  80   (let ((is (cond ((and (= (length ispec) 1)
  81                         (stringp (car ispec)))
  82                    (setq ispec (car ispec))
  83                    (split-string ispec "\n"))
  84
  85                   (t ispec))))
  86
  87     (if (not (stringp ispec))
  88         `(interactive (let ((xwem-interactively t))
  89                         (prog1 (progn ,@ispec)
  90                           (setq xwem-prefix-arg nil))))
  91
  92       `(interactive (prog1 (xwem-interactive-ilist (quote ,is))
  93                       (setq xwem-prefix-arg nil))))
  94     ))
  95
  96 (defmacro define-xwem-command (funsym args docstring inter &rest body)
  97   "Same as `xwem-defun', but make FUNSYM to be interactive command.
  98 INTER is actually a for of `xwem-interactive'."
  99   `(defun ,funsym ,args
 100      ,docstring
 101      ,(macroexpand inter)
 102      ;; Maybe run command without GCing at all
 103      (let ((gc-cons-threshold (if xwem-commands-inhibit-gc
 104                                   xwem-commands-gc-cons-threshold
 105                                 gc-cons-threshold)))
 106        ,@body)))
 107 (put 'define-xwem-command 'lisp-indent-function 'defun)
 108
 109 (defmacro xwem-under-minibuffer (&rest forms)
 110   "Evaluate FORM under XWEM's minibuffer focus."
 111   `(progn
 112      (xwem-client-set-property
 113       (xwem-minib-cl xwem-minibuffer) 'skip-deselect t)
 114      (xwem-select-client (xwem-minib-cl xwem-minibuffer))
 115      (xwem-unwind-protect
 116          (progn ,@forms)
 117        (xwem-client-set-property
 118         (xwem-minib-cl xwem-minibuffer) 'skip-deselect nil)
 119        (xwem-select-last-or-other-client
 120         (xwem-minib-cl xwem-minibuffer) nil t))))
 121
 122 \f
 123 (defun xwem-interactive-p ()
 124   "Return non-nil when xwem in interactive mode."
 125   xwem-interactively)
 126
 127 ;; `read-from-minibuffer' variant for use by XWEM.
 128 (defun xwem-read-from-minibuffer (prompt &optional initial-contents keymap
 129                                          readp history abbrev-table
 130                                          &rest notused)
 131   "Read data from xwem minibuffer.
 132 Arguments PROMPT, INITIAL-CONTENTS, KEYMAP, READP, HISTORY and
 133 ABBREV-TABLE are same as for `read-from-minibuffer'."
 134   (xwem-kbd-stop-grabbing)
 135
 136   (xwem-under-minibuffer
 137    (prog1 (let ((special-display-buffer-names
 138                  (and (boundp 'xwem-special-display-buffer-names)
 139                       (symbol-value 'xwem-special-display-buffer-names))))
 140             (read-from-minibuffer-for-xwem prompt initial-contents keymap
 141                                            readp history abbrev-table))
 142      (xwem-clear-message))))
 143
 144 (defmacro with-xwem-read-from-minibuffer (&rest forms)
 145   "Execute FORMS using xwem `read-from-minibuffer.'"
 146   `(let ((saved-read-frome-minibuffer
 147           (symbol-function 'read-from-minibuffer-for-xwem)))
 148     (xwem-unwind-protect
 149         (progn
 150           (fset 'read-from-minibuffer
 151                 (symbol-function 'xwem-read-from-minibuffer))
 152           ,@forms)
 153       (fset 'read-from-minibuffer saved-read-frome-minibuffer))))
 154
 155 (defun xwem-completing-read (prompt table &optional predicate require-match
 156                                     initial-contents history)
 157   "XWEM awared varian of `completing-read'."
 158   (with-xwem-read-from-minibuffer
 159    (completing-read prompt table predicate require-match
 160                     initial-contents history)))
 161
 162 (defun xwem-read-command (prompt)
 163   "Just like `read-command', but for XWEM.
 164 Argument PROMPT is same as for `read-command'."
 165
 166   (with-xwem-read-from-minibuffer
 167    (read-command prompt)))
 168
 169 (defvar xwem-read-filename-history nil
 170   "Default history for reading filenames.")
 171
 172 (defun xwem-read-filename (prompt &optional dir default must-match
 173                                   initial-contents history)
 174   "Just like `read-file-name', but for XWEM.
 175 PROMPT, DIR, DEFAULT, MUST-MATCH, INITIAL-CONTENTS and HISTORY are
 176 same as for `read-file-name'."
 177   (with-xwem-read-from-minibuffer
 178    (let ((use-dialog-box nil))          ; block dialogs
 179      (read-file-name prompt dir default must-match initial-contents
 180                      (or history 'xwem-read-filename-history)))))
 181
 182 (defun xwem-read-external-command (prompt)
 183   "Read for external command using PROMPT."
 184   (xwem-launcher-query prompt))
 185
 186 (defun xwem-read-client (prompt &optional clients)
 187   "Read for client name prompting PROMPT and return xwem client.
 188 CLIENTS specifies list of clients to select from, default is `xwem-clients'.
 189 NOTE: Uses"
 190   (unless clients
 191     (setq clients xwem-clients))
 192
 193   (with-xwem-read-from-minibuffer
 194    (let* ((clns (mapcar #'(lambda (cl)
 195                             (cons (xwem-client-name cl clients) cl))
 196                         clients))
 197           (name (cond ((eq xwem-completing-read-type 'iswitchb)
 198                        (xwem-misc-completing-read-using-iswitchb
 199                         prompt (mapcar 'car clns)))
 200                       ((eq xwem-completing-read-type 'complete)
 201                        (completing-read prompt clns))
 202                       (t (error 'xwem-error
 203                                 "Invalid `xwem-completing-read-type'"
 204                                 xwem-completing-read-type)))))
 205
 206      ;; Find appopriate client
 207      (while (and clns (not (string= (caar clns) name)))
 208        (setq clns (cdr clns)))
 209      (cdar clns))))
 210
 211 (defun xwem-read-frame (prompt &optional frames)
 212   "Read for frame prompting PROMPT and return xwem frame.
 213 FRAMES is a list of frames to select from, default is `xwem-frames-list'."
 214   (unless frames
 215     (setq frames (xwem-frames-list)))
 216
 217   (with-xwem-read-from-minibuffer
 218    (let* ((frms (mapcar #'(lambda (frm)
 219                             (cons (xwem-frame-name frm) frm))
 220                         frames))
 221           (name (cond ((eq xwem-completing-read-type 'iswitchb)
 222                        (xwem-misc-completing-read-using-iswitchb prompt
 223                          (mapcar 'xwem-frame-name frms)))
 224                       ((eq xwem-completing-read-type 'complete)
 225                        (completing-read prompt frms))
 226                       (t (error 'xwem-error
 227                                 "Invalid `xwem-completing-read-type'"
 228                                 xwem-completing-read-type)))))
 229
 230      ;; Find appopriate frame
 231      (while (and frms (not (string= (caar frms) name)))
 232        (setq frms (cdr frms)))
 233      (cdar frms))))
 234
 235 ;; For `xwem-interactive' take a look at xwem-macros.el
 236 (defun xwem-interactive-ilist (spec)
 237   "Return list valid for `interactive'.
 238 SPEC is specification of list items."
 239   (let ((xwem-interactively t))
 240     (declare (special xwem-interactively))
 241
 242     ;; XXX if ?* mean wait keyrelease
 243     (when (and spec (eq (aref (car spec) 0) ?*))
 244       (when (and xwem-last-xevent
 245                  (= (X-Event-type xwem-last-xevent) X-KeyPress))
 246         (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent)))
 247
 248       ;; Remove ?* from first element in SPEC
 249       (if (= (length (car spec)) 1)
 250           (setq spec (cdr spec))
 251         (setq spec (cons (substring (car spec) 1) (cdr spec)))))
 252
 253     ;; XXX if ?_ is first than command need to run with ungrabbed
 254     ;; keyboard.
 255     (when (and spec (eq (aref (car spec) 0) ?_))
 256       (xwem-kbd-stop-grabbing)
 257
 258       ;; Remove ?_ from first element in SPEC
 259       (if (= (length (car spec)) 1)
 260           (setq spec (cdr spec))
 261         (setq spec (cons (substring (car spec) 1) (cdr spec)))))
 262
 263     (mapcar #'(lambda (el)
 264                 (let ((code (aref el 0))
 265                       (prompt (substring el 1)))
 266                   (cond ((eq code ?P) xwem-prefix-arg)
 267                         ((eq code ?p) (prefix-numeric-value xwem-prefix-arg))
 268
 269                         ((eq code ?k) (xwem-read-key prompt))
 270                         ((eq code ?K) (xwem-read-key-sequence prompt))
 271                         ((eq code ?c) (xwem-read-client prompt))
 272                         ((eq code ?f) (xwem-read-filename prompt nil nil t))
 273                         ((eq code ?F) (xwem-read-filename prompt))
 274                         ((eq code ?s) (xwem-read-from-minibuffer prompt))
 275                         ((eq code ?C) (xwem-read-command prompt))
 276                         ((eq code ?c) (xwem-read-client prompt))
 277                         ((eq code ?e) (xwem-read-external-command prompt))
 278                         )))
 279             spec)))
 280
 281 \f
 282 (provide 'xwem-interactive)
 283
 284 ;;; xwem-interactive.el ends here