-;;; cus-edit.el --- Tools for customizing Emacs and Lisp packages.
+;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
options))))
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))
- (message "Creating customization items ...%2d%%done" 100)
+ (message "Creating customization items ...done")
(unless (eq custom-buffer-style 'tree)
(mapc 'custom-magic-reset custom-options))
(message "Creating customization setup...")
((and (boundp 'preloaded-file-list)
(member load preloaded-file-list)))
((assoc load load-history))
- ((assoc (locate-library load) load-history))
+ ;; This was just (assoc (locate-library load) load-history)
+ ;; but has been optimized not to load locate-library
+ ;; if not necessary.
+ ((let (found (regexp (regexp-quote load)))
+ (dolist (loaded load-history)
+ (and (string-match regexp (car loaded))
+ (eq (locate-library load) (car loaded))
+ (setq found t)))
+ found))
+ ;; Without this, we would load cus-edit recursively.
+ ;; We are still loading it when we call this,
+ ;; and it is not in load-history yet.
+ ((equal load "cus-edit"))
(t
(condition-case nil
- ;; Without this, we would load cus-edit recursively.
- ;; We are still loading it when we call this,
- ;; and it is not in load-history yet.
- (or (equal load "cus-edit")
- (load-library load))
+ (load-library load)
(error nil))))))))
(defun custom-load-widget (widget)
:tag "Attributes"
:extra-offset 12
:button-args '(:help-echo "Control whether this attribute has any effect.")
+ :convert-widget 'custom-face-edit-convert-widget
:args (mapcar (lambda (att)
(list 'group
:inline t
(nth 1 att)))
custom-face-attributes))
+(defun custom-face-edit-convert-widget (widget)
+ "Convert :args as widget types in WIDGET."
+ (widget-put
+ widget
+ :args (mapcar (lambda (arg)
+ (widget-convert arg
+ :deactivate 'custom-face-edit-deactivate
+ :activate 'custom-face-edit-activate
+ :delete 'custom-face-edit-delete))
+ (widget-get widget :args)))
+ widget)
+
+(defun custom-face-edit-deactivate (widget)
+ "Make face widget WIDGET inactive for user modifications."
+ (unless (widget-get widget :inactive)
+ (let ((tag (custom-face-edit-attribute-tag widget))
+ (from (copy-marker (widget-get widget :from)))
+ (to (widget-get widget :to))
+ (value (widget-value widget))
+ (inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (save-excursion
+ (goto-char from)
+ (widget-default-delete widget)
+ (insert tag ": *\n")
+ (widget-put widget :inactive
+ (cons value (cons from (- (point) from))))))))
+
+(defun custom-face-edit-activate (widget)
+ "Make face widget WIDGET inactive for user modifications."
+ (let ((inactive (widget-get widget :inactive))
+ (inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (when (consp inactive)
+ (save-excursion
+ (goto-char (car (cdr inactive)))
+ (delete-region (point) (+ (point) (cdr (cdr inactive))))
+ (widget-put widget :inactive nil)
+ (widget-apply widget :create)
+ (widget-value-set widget (car inactive))
+ (widget-setup)))))
+
+(defun custom-face-edit-delete (widget)
+ "Remove widget from the buffer."
+ (let ((inactive (widget-get widget :inactive))
+ (inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (if (not inactive)
+ ;; Widget is alive, we don't have to do anything special
+ (widget-default-delete widget)
+ ;; WIDGET is already deleted because we did so to inactivate it;
+ ;; now just get rid of the label we put in its place.
+ (delete-region (car (cdr inactive))
+ (+ (car (cdr inactive)) (cdr (cdr inactive))))
+ (widget-put widget :inactive nil))))
+
+
+(defun custom-face-edit-attribute-tag (widget)
+ "Returns the first :tag property in WIDGET or one of its children."
+ (let ((tag (widget-get widget :tag)))
+ (or (and (not (equal tag "")) tag)
+ (let ((children (widget-get widget :children)))
+ (while (and (null tag) children)
+ (setq tag (custom-face-edit-attribute-tag (pop children))))
+ tag))))
+
;;; The `custom-display' Widget.
(define-widget 'custom-display 'menu-choice
(defconst custom-face-selected (widget-convert 'custom-face-selected)
"Converted version of the `custom-face-selected' widget.")
-(defun custom-filter-face-spec (spec filter-index default-filter)
+(defun custom-filter-face-spec (spec filter-index &optional default-filter)
"Return a canonicalized version of SPEC using.
FILTER-INDEX is the index in the entry for each attribute in
`custom-face-attributes' at which the appropriate filter function can be
(defun custom-pre-filter-face-spec (spec)
"Return SPEC changed as necessary for editing by the face customization widget.
SPEC must be a full face spec."
- (custom-filter-face-spec
- spec 2
- (lambda (value)
- (cond ((eq value 'unspecified) nil)
- ((eq value nil) 'off)
- (t value)))))
+ (custom-filter-face-spec spec 2))
(defun custom-post-filter-face-spec (spec)
"Return the customized SPEC in a form suitable for setting the face."
- (custom-filter-face-spec
- spec 3
- (lambda (value)
- (cond ((eq value nil) 'unspecified)
- ((eq value 'off) nil)
- (t value)))))
+ (custom-filter-face-spec spec 3))
(defun custom-face-value-create (widget)
"Create a list of the display specifications for WIDGET."
(unless (widget-get widget :custom-form)
(widget-put widget :custom-form custom-face-default-form))
(let* ((symbol (widget-value widget))
- (spec (or (get symbol 'saved-face)
+ (spec (or (get symbol 'customized-face)
+ (get symbol 'saved-face)
(get symbol 'face-defface-spec)
;; Attempt to construct it.
(list (list t (custom-face-attributes-get
"Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
- (value (widget-value child))
+ (value (custom-post-filter-face-spec (widget-value child)))
(comment-widget (widget-get widget :comment-widget))
(comment (widget-value comment-widget)))
(when (equal comment "")
(setq comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
- (face-spec-set symbol value)
+ (if (face-spec-choose value)
+ (face-spec-set symbol value)
+ ;; face-set-spec ignores empty attribute lists, so just give it
+ ;; something harmless instead.
+ (face-spec-set symbol '((t :foreground unspecified))))
(put symbol 'saved-face value)
(put symbol 'customized-face nil)
(put symbol 'face-comment comment)
"Return the file name for saving customizations."
(setq custom-file
(or custom-file
- user-init-file
- (read-file-name "File for customizations: "
- "~/" nil nil ".emacs"))))
+ (let ((user-init-file user-init-file)
+ (default-init-file
+ (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
+ (when (null user-init-file)
+ (if (or (file-exists-p default-init-file)
+ (and (eq system-type 'windows-nt)
+ (file-exists-p "~/_emacs")))
+ ;; Started with -q, i.e. the file containing
+ ;; Custom settings hasn't been read. Saving
+ ;; settings there would overwrite other settings.
+ (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (setq user-init-file default-init-file))
+ user-init-file))))
(defun custom-save-delete (symbol)
"Visit `custom-file' and delete all calls to SYMBOL from it.
(setq first (point)))))))
(if first
(goto-char first)
- (goto-char (point-max)))))
+ ;; Move in front of local variables, otherwise long Custom
+ ;; entries would make them ineffective.
+ (let ((pos (point-max))
+ (case-fold-search t))
+ (save-excursion
+ (goto-char (point-max))
+ (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
+ 'move)
+ (when (search-forward "Local Variables:" nil t)
+ (setq pos (line-beginning-position))))
+ (goto-char pos)))))
(defun custom-save-variables ()
"Save all customized variables in `custom-file'."
(princ "\n"))
(princ "(custom-set-variables
;; custom-set-variables was added by Custom -- don't edit or cut/paste it!
- ;; Your init file must only contain one such instance.\n")
+ ;; Your init file should contain only one such instance.\n")
(mapcar
(lambda (symbol)
(let ((value (get symbol 'saved-value))
(princ "\n"))
(princ "(custom-set-faces
;; custom-set-faces was added by Custom -- don't edit or cut/paste it!
- ;; Your init file must only contain one such instance.\n")
+ ;; Your init file should contain only one such instance.\n")
(mapcar
(lambda (symbol)
(let ((value (get symbol 'saved-face))
(setq name "Customize"))
`(,name
:filter (lambda (&rest junk)
- (cdr (custom-menu-create ',symbol)))))
+ (custom-menu-create ',symbol))))
;;; The Custom Mode.