[gnus] / lisp / custom.el

;;; custom.el --- User friendly customization support.

;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.

;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: help
;; Version: 0.5

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; WARNING: This package is still under construction and not all of
;; the features below are implemented.
;;
;; This package provides a framework for adding user friendly
;; customization support to Emacs.  Having to do customization by
;; editing a text file in some arcane syntax is user hostile in the
;; extreme, and to most users emacs lisp definitely count as arcane.
;;
;; The intent is that authors of emacs lisp packages declare the
;; variables intended for user customization with `custom-declare'.
;; Custom can then automatically generate a customization buffer with
;; `custom-buffer-create' where the user can edit the package
;; variables in a simple and intuitive way, as well as a menu with
;; `custom-menu-create' where he can set the more commonly used
;; variables interactively.
;;
;; It is also possible to use custom for modifying the properties of
;; other objects than the package itself, by specifying extra optional
;; arguments to `custom-buffer-create'.
;;
;; Custom is inspired by OPEN LOOK property windows.

;;; Todo:  
;;
;; - Toggle documentation in three states `none', `one-line', `full'.
;; - Function to generate an XEmacs menu from a CUSTOM.
;; - Write TeXinfo documentation.
;; - Make it possible to hide sections by clicking at the level.
;; - Declare AUC TeX variables.
;; - Declare (ding) Gnus variables.
;; - Declare Emacs variables.
;; - Implement remaining types.
;; - XEmacs port.
;; - Allow `URL', `info', and internal hypertext buttons.
;; - Support meta-variables and goal directed customization.
;; - Make it easy to declare custom types independently.
;; - Make it possible to declare default value and type for a single
;;   variable, storing the data in a symbol property.
;; - Syntactic sugar for CUSTOM declarations.
;; - Use W3 for variable documentation.

;;; Code:

(eval-when-compile
  (require 'cl))

;;; Compatibility:

(defun custom-xmas-add-text-properties (start end props &optional object)
  (add-text-properties start end props object)
  (put-text-property start end 'start-open t object)
  (put-text-property start end 'end-open t object))

(defun custom-xmas-put-text-property (start end prop value &optional object)
  (put-text-property start end prop value object)
  (put-text-property start end 'start-open t object)
  (put-text-property start end 'end-open t object))

(defun custom-xmas-extent-start-open ()
  (map-extents (lambda (extent arg)
                 (set-extent-property extent 'start-open t))
               nil (point) (min (1+ (point)) (point-max))))
                  
(if (string-match "XEmacs\\|Lucid" emacs-version)
    (progn
      (fset 'custom-add-text-properties 'custom-xmas-add-text-properties)
      (fset 'custom-put-text-property 'custom-xmas-put-text-property)
      (fset 'custom-extent-start-open 'custom-xmas-extent-start-open)
      (fset 'custom-set-text-properties
            (if (fboundp 'set-text-properties)
                'set-text-properties))
      (fset 'custom-buffer-substring-no-properties
            (if (fboundp 'buffer-substring-no-properties)
                'buffer-substring-no-properties
              'custom-xmas-buffer-substring-no-properties)))
  (fset 'custom-add-text-properties 'add-text-properties)
  (fset 'custom-put-text-property 'put-text-property)
  (fset 'custom-extent-start-open 'ignore)
  (fset 'custom-set-text-properties 'set-text-properties)
  (fset 'custom-buffer-substring-no-properties 
        'buffer-substring-no-properties))

(defun custom-xmas-buffer-substring-no-properties (beg end)
  "Return the text from BEG to END, without text properties, as a string."
  (let ((string (buffer-substring beg end)))
    (custom-set-text-properties 0 (length string) nil string)
    string))

;; XEmacs and Emacs 19.29 facep does different things.
(if (fboundp 'find-face)
    (fset 'custom-facep 'find-face)
  (fset 'custom-facep 'facep))

(if (custom-facep 'underline)
    ()
  ;; No underline face in XEmacs 19.12.
  (and (fboundp 'make-face)
       (funcall (intern "make-face") 'underline))
  ;; Must avoid calling set-face-underline-p directly, because it
  ;; is a defsubst in emacs19, and will make the .elc files non
  ;; portable!
  (or (and (fboundp 'face-differs-from-default-p)
           (face-differs-from-default-p 'underline))
      (and (fboundp 'set-face-underline-p)
           (funcall 'set-face-underline-p 'underline t))))

(defun custom-xmas-set-text-properties (start end props &optional buffer)
  (if (null buffer)
      (if props
          (while props
            (custom-put-text-property 
             start end (car props) (nth 1 props) buffer)
            (setq props (nthcdr 2 props)))
        (remove-text-properties start end ()))))

(or (fboundp 'event-point)
    ;; Missing in Emacs 19.29.
    (defun event-point (event)
      "Return the character position of the given mouse-motion, button-press,
or button-release event.  If the event did not occur over a window, or did
not occur over text, then this returns nil.  Otherwise, it returns an index
into the buffer visible in the event's window."
      (posn-point (event-start event))))

(eval-when-compile
  (defvar x-colors nil)
  (defvar custom-button-face nil)
  (defvar custom-field-uninitialized-face nil)
  (defvar custom-field-invalid-face nil)
  (defvar custom-field-modified-face nil)
  (defvar custom-field-face nil)
  (defvar custom-mouse-face nil)
  (defvar custom-field-active-face nil))

;; We can't easily check for a working intangible.
(defconst intangible (if (and (boundp 'emacs-minor-version)
                              (or (> emacs-major-version 19)
                                  (and (> emacs-major-version 18)
                                       (> emacs-minor-version 28))))
                         (setq intangible 'intangible)
                       (setq intangible 'intangible-if-it-had-been-working))
  "The symbol making text intangible.")