Mercurial > emacs
changeset 18336:325190603227
Synched with 1.9924.
| author | Per Abrahamsen <abraham@dina.kvl.dk> |
|---|---|
| date | Thu, 19 Jun 1997 11:30:04 +0000 |
| parents | 6f48844ce1a9 |
| children | c87e4cdfcc71 |
| files | lisp/cus-edit.el lisp/wid-edit.el |
| diffstat | 2 files changed, 103 insertions(+), 42 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/cus-edit.el Thu Jun 19 11:19:24 1997 +0000 +++ b/lisp/cus-edit.el Thu Jun 19 11:30:04 1997 +0000 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9920 +;; Version: 1.9924 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -643,7 +643,7 @@ (let ((children custom-options)) (mapcar (lambda (child) (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) + (widget-apply child :custom-reset-saved))) children))) (defun custom-reset-standard (&rest ignore) @@ -652,7 +652,7 @@ (let ((children custom-options)) (mapcar (lambda (child) (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) + (widget-apply child :custom-reset-standard))) children))) ;;; The Customize Commands @@ -801,10 +801,10 @@ (let ((found nil)) (message "Looking for faces...") (mapcar (lambda (symbol) - (setq found (cons (list symbol 'custom-face) found))) - (nreverse (mapcar 'intern + (push (list symbol 'custom-face) found)) + (nreverse (mapcar 'intern (sort (mapcar 'symbol-name (face-list)) - 'string<)))) + 'string-lessp)))) (custom-buffer-create found "*Customize Faces*")) (if (stringp symbol) @@ -838,11 +838,10 @@ (mapatoms (lambda (symbol) (and (get symbol 'customized-face) (custom-facep symbol) - (setq found (cons (list symbol 'custom-face) found))) + (push (list symbol 'custom-face) found)) (and (get symbol 'customized-value) (boundp symbol) - (setq found - (cons (list symbol 'custom-variable) found))))) + (push (list symbol 'custom-variable) found)))) (if found (custom-buffer-create found "*Customize Customized*") (error "No customized user options")))) @@ -855,11 +854,10 @@ (mapatoms (lambda (symbol) (and (get symbol 'saved-face) (custom-facep symbol) - (setq found (cons (list symbol 'custom-face) found))) + (push (list symbol 'custom-face) found)) (and (get symbol 'saved-value) (boundp symbol) - (setq found - (cons (list symbol 'custom-variable) found))))) + (push (list symbol 'custom-variable) found)))) (if found (custom-buffer-create found "*Customize Saved*") (error "No saved user options")))) @@ -867,27 +865,55 @@ ;;;###autoload (defun customize-apropos (regexp &optional all) "Customize all user options matching REGEXP. -If ALL (e.g., started with a prefix key), include options which are not -user-settable." +If ALL is `options', include only options. +If ALL is `faces', include only faces. +If ALL is `groups', include only groups. +If ALL is t (interactively, with prefix arg), include options which are not +user-settable, as well as faces and groups." (interactive "sCustomize regexp: \nP") (let ((found nil)) (mapatoms (lambda (symbol) (when (string-match regexp (symbol-name symbol)) - (when (get symbol 'custom-group) - (setq found (cons (list symbol 'custom-group) found))) - (when (custom-facep symbol) - (setq found (cons (list symbol 'custom-face) found))) - (when (and (boundp symbol) + (when (and (not (memq all '(faces options))) + (get symbol 'custom-group)) + (push (list symbol 'custom-group) found)) + (when (and (not (memq all '(options groups))) + (custom-facep symbol)) + (push (list symbol 'custom-face) found)) + (when (and (not (memq all '(groups faces))) + (boundp symbol) (or (get symbol 'saved-value) (get symbol 'standard-value) - (if all - (get symbol 'variable-documentation) - (user-variable-p symbol)))) - (setq found - (cons (list symbol 'custom-variable) found)))))) - (if found - (custom-buffer-create found "*Customize Apropos*") - (error "No matches")))) + (if (memq all '(nil options)) + (user-variable-p symbol) + (get symbol 'variable-documentation)))) + (push (list symbol 'custom-variable) found))))) + (if (not found) + (error "No matches") + (custom-buffer-create (sort (sort found + ;; Apropos should always be sorted. + 'custom-sort-items-alphabetically) + custom-buffer-order-predicate) + "*Customize Apropos*")))) + +;;;###autoload +(defun customize-apropos-options (regexp &optional arg) + "Customize all user options matching REGEXP. +With prefix arg, include options which are not user-settable." + (interactive "sCustomize regexp: \nP") + (customize-apropos regexp (or arg 'options))) + +;;;###autoload +(defun customize-apropos-faces (regexp) + "Customize all user faces matching REGEXP." + (interactive "sCustomize regexp: \n") + (customize-apropos regexp 'faces)) + +;;;###autoload +(defun customize-apropos-groups (regexp) + "Customize all user groups matching REGEXP." + (interactive "sCustomize regexp: \n") + (customize-apropos regexp 'groups)) ;;; Buffer. @@ -1006,6 +1032,31 @@ options)))) (unless (eq (preceding-char) ?\n) (widget-insert "\n")) + (when (= (length options) 1) + (message "Creating parent links...") + (let* ((entry (nth 0 options)) + (name (nth 0 entry)) + (type (nth 1 entry)) + parents) + (mapatoms (lambda (symbol) + (let ((group (get symbol 'custom-group))) + (when (assq name group) + (when (eq type (nth 1 (assq name group))) + (push symbol parents)))))) + (when parents + (widget-insert "\nParent groups:") + (mapcar (lambda (group) + (widget-insert " ") + (widget-create 'link + :tag (custom-unlispify-tag-name group) + :help-echo (format "\ +Create customize buffer for `%S' group." group) + :action (lambda (widget &rest ignore) + (customize-group + (widget-value widget))) + group)) + parents) + (widget-insert ".\n")))) (message "Creating customization magic...") (mapcar 'custom-magic-reset custom-options) (message "Creating customization setup...") @@ -2356,8 +2407,10 @@ (custom-magic-reset widget)) ;;; The `custom-save-all' Function. - -(defcustom custom-file "~/.emacs" +;;;###autoload +(defcustom custom-file (if (featurep 'xemacs) + "~/.xemacs-custom" + "~/.emacs") "File used for storing customization information. If you change this from the default \"~/.emacs\" you need to explicitly load that file for the settings to take effect." @@ -2481,14 +2534,19 @@ ;;; Menu support (unless (string-match "XEmacs" emacs-version) - (defconst custom-help-menu '("Customize" - ["Update menu..." custom-menu-update t] - ["Group..." customize-group t] - ["Variable..." customize-variable t] - ["Face..." customize-face t] - ["Saved..." customize-saved t] - ["Set..." customize-customized t] - ["Apropos..." customize-apropos t]) + (defconst custom-help-menu + '("Customize" + ["Update menu..." custom-menu-update t] + ["Group..." customize-group t] + ["Variable..." customize-variable t] + ["Face..." customize-face t] + ["Saved..." customize-saved t] + ["Set..." customize-customized t] + ["--" custom-menu-sep t] + ["Apropos..." customize-apropos t] + ["Group apropos..." customize-apropos-groups t] + ["Variable apropos..." customize-apropos-options t] + ["Face apropos..." customize-apropos-faces t]) ;; This menu should be identical to the one defined in `menu-bar.el'. "Customize menu")
--- a/lisp/wid-edit.el Thu Jun 19 11:19:24 1997 +0000 +++ b/lisp/wid-edit.el Thu Jun 19 11:30:04 1997 +0000 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9920 +;; Version: 1.9924 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -296,8 +296,11 @@ (when widget-field-add-space (insert-and-inherit " ")) (setq to (point))) - (add-text-properties (1- to) to ;to (1+ to) - '(front-sticky nil start-open t read-only to)) + (if widget-field-add-space + (add-text-properties (1- to) to + '(front-sticky nil start-open t read-only to)) + (add-text-properties to (1+ to) + '(front-sticky nil start-open t read-only to))) (add-text-properties (1- from) from '(rear-nonsticky t end-open t read-only from)) (let ((map (widget-get widget :keymap)) @@ -2653,8 +2656,8 @@ (goto-char from) (while (re-search-forward regexp to t) (let ((name (match-string 1)) - (begin (match-beginning 0)) - (end (match-end 0))) + (begin (match-beginning 1)) + (end (match-end 1))) (when (funcall predicate name) (push (widget-convert-button type begin end :value name) buttons)))))