xwem / lisp / xwem-help.el

;;; 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:
(require 'xwem-load)
(require 'xwem-misc)

(defmacro xwem-help-display (title &rest forms)
  "Evaluate FORMS in special emacs frame and xwem help buffer."
  `(let ((temp-buffer-show-function 'xwem-special-popup-frame))
      (lambda ()
	(set-buffer standard-output)
      (format "xwem %s" (or ,title "")))))
(put 'xwem-help-display 'lisp-indent-function 'defun)

;;; 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."

  (xwem-help-display nil
   (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 (cdr 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 (cdr cl1-clas) (cdr cl2-clas))
                                    (and (string= (cdr cl1-clas) (cdr 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"))

   ;; Bindings
   (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."

  (xwem-help-display "help-for-help"
   (let ((heading (gettext "key             binding\n---             -------\n")))
     (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))

(defun xwem-describe-prefix-bindings-1 (map keys title)
  "For keymap MAP describe prefix KEYS.
If KEYS is nil describe all keymap."
  (setq map (xwem-kbd-fixup-keymap map))
  (when (and (keymapp map)
             (or (null keys)
                 (lookup-key map keys t)))
    (let ((heading (gettext "key             binding\n---             -------\n")))
      (insert title "\n" heading)
      (describe-bindings-internal map nil nil keys))))
(put 'xwem-describe-prefix-bindings-1 'lisp-indent-function 2)
;;;###autoload(autoload 'xwem-describe-prefix-bindings "xwem-help" "" t)
(define-xwem-command xwem-describe-prefix-bindings (prefix)
  "Describe the bindings of the PREFIX used to reach this command."
  (xwem-interactive (list xwem-this-command-keys))

  ;; Adjust prefix, cut last key
  (when prefix
    (setq prefix (vconcat (butlast (append prefix nil)))))

  (xwem-help-display (format "%s prefix" (key-description prefix))
   (when prefix
     (insert (format "Key bindings starting with `%s':\n" (key-description prefix))))

   ;; Minor modes bindings
   (mapc (lambda (mimap)
           (when (eval (car mimap))
             (xwem-describe-prefix-bindings-1 (cdr mimap) prefix
               (format "\nMinor mode bindings for `%S':" (eval (car mimap))))))

   ;; Local bindings
   (xwem-describe-prefix-bindings-1 (xwem-local-map xwem-event-client) prefix
     (format "\n%s major mode bindings:"
             (upcase (symbol-name (xwem-cl-manage-type xwem-event-client)))))

   ;; Finally global bindings
   (xwem-describe-prefix-bindings-1 xwem-global-map prefix
     (format "\nGlobal bindings:"))

   ;; Frame bindings
   (xwem-describe-prefix-bindings-1 'xwem-frame-prefix prefix
     (format "\nFrame bindings:"))

   ;; Root bindings.  Really need?
   (xwem-describe-prefix-bindings-1 'xwem-root-prefix prefix
     (format "\nRoot bindings:"))

;;;###autoload(autoload 'xwem-help-describe-bindings "xwem-help" "" t)
(define-xwem-command xwem-help-describe-bindings ()
  "Describe all current bindings."
  (xwem-describe-prefix-bindings nil))

;;;###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-get-binding key))
	(keystr (key-description key)))

    (if (or (null dfn) (integerp dfn))
	(xwem-message 'info "%s is undefined." keystr)
      (xwem-help-display (format "key `%s'" 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 (xwem-kbd-get-binding dfn)))
		(if (not cmd)
		    (insert "a keyboard macro")
		  (insert "a keyboard macro which runs the command\n")
		  (insert (format "`%S'" 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 'todo "`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 'todo "`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 'todo "`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