xwem / lisp / xwem-help.el

Full commit
;;; xwem-help.el --- Getting help in XWEM.

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

;; Author: Zajcev Evgeny <>
;; Created: 1 Sep 2003
;; Keywords: xlib, xwem
;; 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
;; 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:

;; Help subsystem.  Entry point is `H-h'.

;;; Code:
;;; Some help stuff
(defun xwem-logo-string ()
  "Return textified XWEM's logo string."
  (concat (xwem-str-with-faces "X" (list 'bold-italic))
	  (xwem-str-with-faces "W" (list 'bold-italic 'red))
	  (xwem-str-with-faces "E" (list 'bold-italic 'green))
	  (xwem-str-with-faces "M" (list 'bold-italic 'blue))))

;;;###autoload(autoload 'xwem-help "xwem-help" "" t)
(define-xwem-command xwem-help ()
  "Display some help info."

       (insert "Hello, this is help for ")
       (insert (xwem-logo-string))
       (insert "\n\n"))
       (insert "TODO: here is some description for ")
       (insert (xwem-logo-string))
       (insert " stuff.\n"))
     (insert "\n")
     ;; Frames config
       (insert "---=== Frames Info ===---\n\n")
       (insert (format "You have %d frames now and [%d] frame is selected.\n"
		       (length xwem-frames-list) (xwem-frame-num (xwem-frame-selected))))
       (insert "\n"))

     ;; Clients
     ;; Maybe use tree-widget package to display this info?
     (let ((curr-classn "")
	   (curr-classi ""))
       (insert "---=== Clients Info ===---\n")
	(lambda (el)
	  (let ((clclass (xwem-hints-wm-class (xwem-cl-hints el)))
		(clgeom (xwem-cl-xgeom el)))
	    (when (not (string= curr-classn (cadr clclass)))
	      (setq curr-classn (cadr clclass))
	      (insert (format "\n= Begin for class name: <%s> =\n" curr-classn)))
	    (when (not (string= curr-classi (car clclass)))
	      (setq curr-classi (car clclass))
	      (insert (format "\n- Class instance: <%s> -\n" curr-classi)))
	    (insert (format "WM-NAME: <%s>, Geom: %dx%d+%d+%d\n"
			    (xwem-hints-wm-name (xwem-cl-hints el))
			    (X-Geom-width clgeom)
			    (X-Geom-height clgeom)
			    (X-Geom-x clgeom)
			    (X-Geom-y clgeom)))))
	(sort (copy-list xwem-clients)
	      (lambda (el1 el2) (let ((cl1-clas (xwem-hints-wm-class (xwem-cl-hints el1)))
				      (cl1-name (xwem-hints-wm-name (xwem-cl-hints el1)))
				      (cl2-clas (xwem-hints-wm-class (xwem-cl-hints el2)))
				      (cl2-name (xwem-hints-wm-name (xwem-cl-hints el2))))
				  ;; Sort by class name, than by class
				  ;; instance, than by wm-name.
				  (or (string-lessp (cadr cl1-clas) (cadr cl2-clas))
				      (and (string= (cadr cl1-clas) (cadr cl2-clas))
					   (string-lessp (car cl1-clas) (car cl2-clas)))
				      (and (string= (car cl1-clas) (car cl2-clas))
					   (string-lessp cl1-name cl2-name))))))
       (insert "\n"))

       (insert "---=== Bindings for `")
       (insert (xwem-str-with-faces "xwem-global-map" 'font-lock-keyword-face))
       (insert "' ===---\n"))
     (describe-bindings-internal xwem-global-map)))

;;;###autoload(autoload 'xwem-help-for-help "xwem-help" "" t)
(define-xwem-command xwem-help-for-help ()
  "Help for XWEM's help system."

   (insert "Here should be Help-for-Help!\n\n")
   (insert (format "Help prefix is %s, Keys are:\n"
		   (substitute-command-keys "\\<xwem-global-map>\\[xwem-help-prefix]")))
   (describe-bindings-internal 'xwem-help-prefix)

;;;###autoload(autoload 'xwem-describe-prefix-bindings "xwem-help" "" t)
(define-xwem-command xwem-describe-prefix-bindings (keys)
  "Describe the bindings of the prefix used to reach this command."
  (xwem-interactive (list xwem-this-command-keys))

   (let ((prefix (make-vector (1- (length keys)) nil))
	 (i 0))

     (while (< i (length prefix))
       (aset prefix i (aref keys i))
       (setq i (1+ i)))

     (insert (format "Key bindings for %s" (key-description prefix)))
     (insert ":\n")
     (describe-bindings-internal xwem-global-map nil nil prefix nil)

;;;###autoload(autoload 'xwem-help-describe-bindings "xwem-help" "" t)
(define-xwem-command xwem-help-describe-bindings ()
  "Describe XWEM's bindings."

   (insert "XWEM global Keybindings:\n")
   (describe-bindings-internal xwem-global-map)

;;;###autoload(autoload 'xwem-help-describe-key1 "xwem-help" "" t)
(define-xwem-command xwem-help-describe-key1 (key)
  "Describe KEY"
  (xwem-interactive (list xwem-this-command-keys))

  (let ((dfn (xwem-kbd-key-binding key xwem-global-map))
	(keystr (key-description key)))

    (if (or (null dfn) (integerp dfn))
	(xwem-message 'info "%s is undefined." keystr)
       (insert keystr)
       (insert " runs ")
       (if (symbolp dfn)
	   (insert (format "`%s'" dfn))
	 (insert (format "%s" dfn)))
       (insert "\n\n")
       (cond ((or (stringp dfn) (vectorp dfn))
	      (let ((cmd (key-binding dfn)))
		(if (not cmd)
		    (insert "a keyboard macro")
		  (insert "a keyboard macro which runs the command ")
		  (insert cmd)
		  (insert ":\n\n")
		  (when (documentation cmd)
		    (insert (documentation cmd))))))
	     ((and (consp dfn) (not (eq 'lambda (car-safe dfn))))
	      (let ((describe-function-show-arglist nil))
		(describe-function-1 (car dfn))))
	     ((symbolp dfn)
	      (describe-function-1 dfn))
	     ((documentation dfn)
	      (insert (documentation dfn)))
	     (t (insert "not documented"))))
;;;###autoload(autoload 'xwem-help-describe-key "xwem-help" "" t)
(define-xwem-command xwem-help-describe-key (keys)
  "Describe keysequence."
  (xwem-interactive "KDescribe key: ")

  (xwem-help-describe-key1 keys))

;;;###autoload(autoload 'xwem-help-frames "xwem-help" "" t)
(define-xwem-command xwem-help-frames ()
  "Help for XWEM's frames."
  ;; TODO: write me
  (xwem-message 'info "`xwem-help-frames' is not written yet.")

;;;###autoload(autoload 'xwem-help-wins "xwem-help" "" t)
(define-xwem-command xwem-help-wins ()
  "Help for XWEM's windows."
  ;; TODO: write me
  (xwem-message 'info "`xwem-help-wins' is not written yet.")

;; TODO: we should write something similar to ibuffer or
;; electric-buffer-list to operate on cliets, switching, getting stat,
;; etc.
;;;###autoload(autoload 'xwem-help-clients "xwem-help" "" t)
(define-xwem-command xwem-help-clients ()
  "Help for XWEM's clients."
  ;; TODO: write me
  (xwem-message 'info "`xwem-help-clients' is not written yet.")

;;;###autoload(autoload 'xwem-help-where-is "xwem-help" "" t)
(define-xwem-command xwem-help-where-is (dfn &optional paste)
  "Where-is for XWEM."
  (xwem-interactive "CXWEM where is command: \nP")

  (let* ((keys (where-is-internal dfn (list xwem-global-map)))
         (msg (if keys (format "%s is on %s" dfn (sorted-key-descriptions keys))
                (format "%s is not on any keys" dfn))))
    (if paste
        (xwem-key-send-ekeys msg)
      (xwem-message 'info msg))))
(provide 'xwem-help)

;;; xwem-help.el ends here