Source

xwem / lisp / xwem-interactive.el

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

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; 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
				  most-positive-fixnum
				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)

  (let ((gc-cons-threshold most-positive-fixnum)) ; inhibit GCing
    (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)))
    (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)))

(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
   (read-file-name prompt dir default must-match initial-contents 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 (lambda (cl) (car cl)) 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 (lambda (frm) (xwem-frame-name frm)) 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