Source

xwem / lisp / xwem-interactive.el

Full commit
;;; xwem-interactive.el --- XWEM interactive interface.

;; Copyright (C) 2003-2004 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;;         Steve Youngs  <steve@youngs.au.com>
;; Created: Thu Dec 18 05:49:52 MSK 2003
;; Keywords: xwem, xlib
;; X-CVS: $Id$

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; 

;;; Code:

(eval-when-compile
  ;; Shutup compiler
  (defvar iswitchb-buflist nil)
  (autoload 'iswitchb-read-buffer "iswitchb")
  )

(require 'xlib-xlib)

(require 'xwem-struct)
(require 'xwem-loaddefs)


(defcustom xwem-completing-read-type 'iswitchb
  "*Type of interactive client reading.
Possible values are `iswitchb', requires iswitchb package, or
`complete' uses standard `completing-read'."
  :type '(choice (const :tag "Iswitchb" iswitchb)
                 (const :tag "Standard" complete))
  :group 'xwem-misc)

;;; Internal variables

(defvar xwem-interactively nil
  "Non-nil when xwem in interactive mode.
Internal variabel, do not modify.")

;; Save read-from-minibuffer for further use
(eval-and-compile
  (define-function 'read-from-minibuffer-for-xwem
    (symbol-function 'read-from-minibuffer)))

(defmacro xwem-interactive (&rest ispec)
  "Just like `interactive', but accepts xwem specific arguments.
Code letters available are:
s -- String.
k -- Single key.
K -- Key sequence that executes command.
c -- Client.
f -- Existing file.
F -- Possible non-existing file.
p -- Prefix argument as number.
P -- Prefix argument in raw form.
C -- Command.
e -- External command."
  (let ((is (cond ((and (= (length ispec) 1)
                        (stringp (car ispec)))
                   (setq ispec (car ispec))
                   (split-string ispec "\n"))

                  (t ispec))))

    (if (not (stringp ispec))
        `(interactive (let ((xwem-interactively t))
                        (prog1 (progn ,@ispec)
                          (setq xwem-prefix-arg nil))))

      `(interactive (prog1 (xwem-interactive-ilist (quote ,is))
                      (setq xwem-prefix-arg nil))))
    ))

(defmacro define-xwem-command (funsym args docstring inter &rest body)
  "Same as `xwem-defun', but make FUNSYM to be interactive command.
INTER is actually a for of `xwem-interactive'."
  `(defun ,funsym ,args
     ,docstring
     ,(macroexpand inter)
     ;; Maybe run command without GCing at all
     (let ((gc-cons-threshold (if xwem-commands-inhibit-gc
                                  xwem-commands-gc-cons-threshold
                                gc-cons-threshold)))
       ,@body)))
(put 'define-xwem-command 'lisp-indent-function 'defun)

(defmacro xwem-under-minibuffer (&rest forms)
  "Evaluate FORM under XWEM's minibuffer focus."
  `(progn
     (xwem-client-set-property
      (xwem-minib-cl xwem-minibuffer) 'skip-deselect t)
     (xwem-select-client (xwem-minib-cl xwem-minibuffer))
     (xwem-unwind-protect
         (progn ,@forms)
       (xwem-client-set-property
        (xwem-minib-cl xwem-minibuffer) 'skip-deselect nil)
       (xwem-select-last-or-other-client
        (xwem-minib-cl xwem-minibuffer) nil t))))


(defun xwem-interactive-p ()
  "Return non-nil when xwem in interactive mode."
  xwem-interactively)

;; `read-from-minibuffer' variant for use by XWEM.
(defun xwem-read-from-minibuffer (prompt &optional initial-contents keymap
                                         readp history abbrev-table
                                         &rest notused)
  "Read data from xwem minibuffer.
Arguments PROMPT, INITIAL-CONTENTS, KEYMAP, READP, HISTORY and
ABBREV-TABLE are same as for `read-from-minibuffer'."
  (xwem-kbd-stop-grabbing)

  (xwem-under-minibuffer
   (prog1 (let ((special-display-buffer-names
                 (and (boundp 'xwem-special-display-buffer-names)
                      (symbol-value 'xwem-special-display-buffer-names))))
            (read-from-minibuffer-for-xwem prompt initial-contents keymap
                                           readp history abbrev-table))
     (xwem-clear-message))))

(defmacro with-xwem-read-from-minibuffer (&rest forms)
  "Execute FORMS using xwem `read-from-minibuffer.'"
  `(let ((saved-read-frome-minibuffer
          (symbol-function 'read-from-minibuffer-for-xwem)))
    (xwem-unwind-protect
        (progn
          (fset 'read-from-minibuffer
                (symbol-function 'xwem-read-from-minibuffer))
          ,@forms)
      (fset 'read-from-minibuffer saved-read-frome-minibuffer))))

(defun xwem-completing-read (prompt table &optional predicate require-match
                                    initial-contents history)
  "XWEM awared varian of `completing-read'."
  (with-xwem-read-from-minibuffer
   (completing-read prompt table predicate require-match
                    initial-contents history)))
  
(defun xwem-read-command (prompt)
  "Just like `read-command', but for XWEM.
Argument PROMPT is same as for `read-command'."

  (with-xwem-read-from-minibuffer
   (read-command prompt)))

(defvar xwem-read-filename-history nil
  "Default history for reading filenames.")

(defun xwem-read-filename (prompt &optional dir default must-match
                                  initial-contents history)
  "Just like `read-file-name', but for XWEM.
PROMPT, DIR, DEFAULT, MUST-MATCH, INITIAL-CONTENTS and HISTORY are
same as for `read-file-name'."
  (with-xwem-read-from-minibuffer
   (let ((use-dialog-box nil))		; block dialogs
     (read-file-name prompt dir default must-match initial-contents
		     (or history 'xwem-read-filename-history)))))

(defun xwem-read-external-command (prompt)
  "Read for external command using PROMPT."
  (xwem-launcher-query prompt))

(defun xwem-read-client (prompt &optional clients)
  "Read for client name prompting PROMPT and return xwem client.
CLIENTS specifies list of clients to select from, default is `xwem-clients'.
NOTE: Uses"
  (unless clients
    (setq clients xwem-clients))

  (with-xwem-read-from-minibuffer
   (let* ((clns (mapcar #'(lambda (cl)
                            (cons (xwem-client-name cl clients) cl))
                        clients))
          (name (cond ((eq xwem-completing-read-type 'iswitchb)
                       (xwem-misc-completing-read-using-iswitchb
                        prompt (mapcar 'car clns)))
                      ((eq xwem-completing-read-type 'complete)
                       (completing-read prompt clns))
                      (t (error 'xwem-error
                                "Invalid `xwem-completing-read-type'"
                                xwem-completing-read-type)))))

     ;; Find appopriate client
     (while (and clns (not (string= (caar clns) name)))
       (setq clns (cdr clns)))
     (cdar clns))))

(defun xwem-read-frame (prompt &optional frames)
  "Read for frame prompting PROMPT and return xwem frame.
FRAMES is a list of frames to select from, default is `xwem-frames-list'."
  (unless frames
    (setq frames (xwem-frames-list)))

  (with-xwem-read-from-minibuffer
   (let* ((frms (mapcar #'(lambda (frm)
                            (cons (xwem-frame-name frm) frm))
                        frames))
          (name (cond ((eq xwem-completing-read-type 'iswitchb)
                       (xwem-misc-completing-read-using-iswitchb prompt
                         (mapcar 'xwem-frame-name frms)))
                      ((eq xwem-completing-read-type 'complete)
                       (completing-read prompt frms))
                      (t (error 'xwem-error
                                "Invalid `xwem-completing-read-type'"
                                xwem-completing-read-type)))))

     ;; Find appopriate frame
     (while (and frms (not (string= (caar frms) name)))
       (setq frms (cdr frms)))
     (cdar frms))))

;; For `xwem-interactive' take a look at xwem-macros.el
(defun xwem-interactive-ilist (spec)
  "Return list valid for `interactive'.
SPEC is specification of list items."
  (let ((xwem-interactively t))
    (declare (special xwem-interactively))

    ;; XXX if ?* mean wait keyrelease
    (when (and spec (eq (aref (car spec) 0) ?*))
      (when (and xwem-last-xevent
                 (= (X-Event-type xwem-last-xevent) X-KeyPress))
        (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent)))

      ;; Remove ?* from first element in SPEC
      (if (= (length (car spec)) 1)
          (setq spec (cdr spec))
        (setq spec (cons (substring (car spec) 1) (cdr spec)))))

    ;; XXX if ?_ is first than command need to run with ungrabbed
    ;; keyboard.
    (when (and spec (eq (aref (car spec) 0) ?_))
      (xwem-kbd-stop-grabbing)

      ;; Remove ?_ from first element in SPEC
      (if (= (length (car spec)) 1)
          (setq spec (cdr spec))
        (setq spec (cons (substring (car spec) 1) (cdr spec)))))

    (mapcar #'(lambda (el)
                (let ((code (aref el 0))
                      (prompt (substring el 1)))
                  (cond ((eq code ?P) xwem-prefix-arg)
                        ((eq code ?p) (prefix-numeric-value xwem-prefix-arg))
                      
                        ((eq code ?k) (xwem-read-key prompt))
                        ((eq code ?K) (xwem-read-key-sequence prompt))
                        ((eq code ?c) (xwem-read-client prompt))
                        ((eq code ?f) (xwem-read-filename prompt nil nil t))
                        ((eq code ?F) (xwem-read-filename prompt))
                        ((eq code ?s) (xwem-read-from-minibuffer prompt))
                        ((eq code ?C) (xwem-read-command prompt))
                        ((eq code ?c) (xwem-read-client prompt))
                        ((eq code ?e) (xwem-read-external-command prompt))
                        )))
            spec)))


(provide 'xwem-interactive)

;;; xwem-interactive.el ends here