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

   1 ;;; xwem-edprops.el --- Interactively edit xwem client's properties.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Wed Oct 27 11:15:39 MSD 2004
   7 ;; Keywords: xwem, edit
   8 ;; X-CVS: $Id: xwem-edprops.el,v 1.2 2005-04-04 19:54:11 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; Mode to edit xwem client's properties.
  32
  33 ;;; Code:
  34 (require 'xwem-load)
  35
  36 \f
  37 ;; Various stuff
  38 (defvar xwem-edprops-mode-hook nil
  39   "*Hooks to call when entering xwem edprops mode.")
  40
  41 (defvar xwem-edprops-allowed-values
  42   '(numberp characterp stringp symbolp)
  43   "List of allowed types of property value.")
  44
  45 (defvar xwem-edprops-client nil)
  46 (make-variable-buffer-local 'xwem-client-edprops-client)
  47
  48 (defvar xwem-edprops-mode nil
  49   "Non-nil mean xwem edprops mode is enabled.")
  50 (make-variable-buffer-local 'xwem-edprops-mode)
  51 (set-default 'xwem-edprops-mode nil)
  52
  53 (defvar xwem-edprops-map
  54   (let ((map (make-sparse-keymap)))
  55     (define-key map "\C-c\C-c" 'xwem-edprops-finish)
  56     (define-key map "\C-c\C-q" 'xwem-edprops-quit)
  57     map)
  58   "Keymap when editing client properties.")
  59
  60 (or (assq 'xwem-edprops-mode minor-mode-alist)
  61     (setq minor-mode-alist
  62           (cons (list 'xwem-edprops-mode
  63                       " XWEM-edprops")
  64                 minor-mode-alist)))
  65
  66 (or (assq 'xwem-edprops-mode minor-mode-map-alist)
  67     (setq minor-mode-map-alist
  68           (cons (cons 'xwem-edprops-mode
  69                       xwem-edprops-map)
  70                 minor-mode-map-alist)))
  71
  72 \f
  73 (defun xwem-edprops-quit (cl)
  74   "Quit editing properties for CL discarding changes."
  75   (interactive (list xwem-edprops-client))
  76
  77   (set-buffer-modified-p nil)
  78   (kill-buffer (current-buffer)))
  79
  80 (defun xwem-edprops-finish (cl)
  81   "Finish editing properties for CL, saving changes."
  82   (interactive (list xwem-edprops-client))
  83
  84   (set-buffer-modified-p nil)
  85   (let ((nplist (read (buffer-string)))
  86         (oplist (xwem-cl-plist cl)))
  87     (kill-buffer (current-buffer))
  88
  89     ;; Remove all supported properties that not in NPLIST
  90     (while oplist
  91       (when (and (xwem-property-supported-p (car oplist))
  92                  (not (plist-get nplist (car oplist))))
  93         (xwem-message 'info "Removing property %S ..\n" (car oplist))
  94         (xwem-client-set-property cl (car oplist) nil))
  95       (setq oplist (cddr oplist)))
  96
  97     (xwem-cl-apply-plist cl nplist)))
  98
  99 (defun xwem-edprops-mode ()
 100   "Enable xwem-edprops mode in current buffer."
 101   (setq xwem-edprops-mode t)
 102
 103   (run-hooks 'xwem-edprops-mode-hook))
 104
 105 ;;;###autoload(autoload 'xwem-edit-client-properties "xwem-edprops" "Interactively edit client's properties." t)
 106 (define-xwem-command xwem-edit-client-properties (cl)
 107   "Interactive edit CL's properties."
 108   (xwem-interactive (list (xwem-cl-selected)))
 109
 110   (when (eq cl (xwem-dummy-client))
 111     (error "XWEM Can't edit properties for dummy client"))
 112
 113   (with-current-buffer (get-buffer-create " *CL-PROPS*")
 114     (kill-all-local-variables)
 115     (setq xwem-edprops-client cl)
 116
 117     (emacs-lisp-mode)
 118     (setq xwem-edprops-mode t)          ; enable edprops mode
 119
 120     (erase-buffer)
 121     (insert ";; Bindings:\n")
 122     (insert ";;   ") (where-is 'xwem-edprops-finish t) (insert "\n")
 123     (insert ";;   ") (where-is 'xwem-edprops-quit t) (insert "\n")
 124
 125     (insert
 126      "\n"
 127      ";; XWEM Client\n\n"
 128      (format ";;   Manage mode: %s\n" (upcase (symbol-name (xwem-cl-manage-type cl))))
 129      (format ";;   Name: %s\n" (xwem-client-name cl))
 130      (format ";;   Class: %S\n" (xwem-hints-wm-class (xwem-cl-hints cl)))
 131      (format ";;   Command: %S\n" (xwem-hints-wm-command (xwem-cl-hints cl)))
 132      "(\n\n")
 133     (save-excursion
 134       (mapc (lambda (kv)
 135               (when (loop for tt in xwem-edprops-allowed-values
 136                       if (funcall tt (cdr kv)) return t)
 137                 (insert (format "%S %S\n" (car kv) (cdr kv)))))
 138             (plist-to-alist (xwem-cl-plist cl)))
 139
 140       (insert "\n\f\n;;; Supported properties:\n")
 141       (let ((print-level 4))            ; Restrict huge output
 142         (mapc (lambda (sp)
 143                 (unless (memq (car sp) (xwem-cl-plist cl))
 144                   (insert (format "; %S %S\n" (car sp) (xwem-client-property cl (car sp))))))
 145               xwem-supported-client-properties))
 146       (insert "\n)"))
 147
 148     ;; Enter editing properties mode
 149     (xwem-edprops-mode)
 150
 151     (xwem-special-popup-frame (current-buffer))
 152     ))
 153 \f
 154
 155 (provide 'xwem-edprops)
 156
 157 ;;; xwem-edprops.el ends here