Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 848:0cb55b2a2c66

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-05-17 18:28:45 by adrian] Re: [PATCH] Re: [Proposal] Changes to Custom <7kn6e8e6.fsf@ispras.ru>
author adrian
date Fri, 17 May 2002 18:28:45 +0000
parents 616e133a0ce6
children 6f3d0f871934
comparison
equal deleted inserted replaced
847:74899b430f18 848:0cb55b2a2c66
341 341
342 ;;; Unlispify. 342 ;;; Unlispify.
343 343
344 (defvar custom-prefix-list nil 344 (defvar custom-prefix-list nil
345 "List of prefixes that should be ignored by `custom-unlispify'") 345 "List of prefixes that should be ignored by `custom-unlispify'")
346
347 (defcustom custom-save-pretty-print t
348 "Non-nil means pretty-print values of customized variables if available."
349 :group 'customize
350 :type 'boolean)
351
346 352
347 (defcustom custom-unlispify-menu-entries t 353 (defcustom custom-unlispify-menu-entries t
348 "Display menu entries as words instead of symbols if non nil." 354 "Display menu entries as words instead of symbols if non nil."
349 :group 'custom-menu 355 :group 'custom-menu
350 :type 'boolean) 356 :type 'boolean)
3377 (backward-sexp) 3383 (backward-sexp)
3378 (point)) 3384 (point))
3379 (point)) 3385 (point))
3380 (throw 'found nil)))))) 3386 (throw 'found nil))))))
3381 3387
3388 (defun custom-save-delete-any (&rest symbols)
3389 "Delete the call to any symbol among SYMBOLS in `custom-file'.
3390 Leave the point at the end of the file."
3391 (let ((find-file-hooks nil)
3392 (auto-mode-alist nil))
3393 (set-buffer (find-file-noselect custom-file)))
3394 (goto-char (point-min))
3395 (condition-case nil
3396 (while (not (eobp))
3397 (let ((sexp (read (current-buffer))))
3398 (when (and (listp sexp)
3399 (memq (car sexp) symbols))
3400 (delete-region (save-excursion
3401 (backward-sexp)
3402 (point))
3403 (point))
3404 (while (and (eolp) (not (eobp)))
3405 (delete-region (point) (prog2 (forward-line 1) (point))))
3406 )))
3407 (end-of-file nil)))
3408
3409 (defsubst custom-save-variable-p (symbol)
3410 "Return non-nil if symbol SYMBOL is a customized variable."
3411 (and (symbolp symbol)
3412 (let ((spec (car-safe (get symbol 'theme-value))))
3413 (or (and spec (eq (car spec) 'user)
3414 (eq (second spec) 'set))
3415 (get symbol 'saved-variable-comment)
3416 ;; support non-themed vars
3417 (and (null spec) (get symbol 'saved-value))))))
3418
3419 (defun custom-save-variable-internal (symbol)
3420 "Print variable SYMBOL to the standard output.
3421 SYMBOL must be a customized variable."
3422 (let ((requests (get symbol 'custom-requests))
3423 (now (not (or (get symbol 'standard-value)
3424 (and (not (boundp symbol))
3425 (not (eq (get symbol 'force-value)
3426 'rogue))))))
3427 (comment (get symbol 'saved-variable-comment))
3428 ;; Print everything, no placeholders `...'
3429 (print-level nil)
3430 (print-length nil))
3431 (unless (custom-save-variable-p symbol)
3432 (error 'wrong-type-argument "Not a customized variable" symbol))
3433 (princ "\n '(")
3434 (prin1 symbol)
3435 (princ " ")
3436 ;; This comment stuff is in the way ####
3437 ;; Is (eq (third spec) (car saved-value)) ????
3438 ;; (prin1 (third spec))
3439 ;; XEmacs -- pretty-print value if available
3440 (if (and custom-save-pretty-print
3441 (fboundp 'pp))
3442 ;; To suppress bytecompiler warning
3443 (with-fboundp 'pp
3444 (pp (car (get symbol 'saved-value))))
3445 (prin1 (car (get symbol 'saved-value))))
3446 (when (or now requests comment)
3447 (princ (if now " t" " nil")))
3448 (when (or comment requests)
3449 (princ " ")
3450 (prin1 requests))
3451 (when comment
3452 (princ " ")
3453 (prin1 comment))
3454 (princ ")")))
3455
3382 (defun custom-save-variables () 3456 (defun custom-save-variables ()
3383 "Save all customized variables in `custom-file'." 3457 "Save all customized variables in `custom-file'."
3384 (save-excursion 3458 (save-excursion
3385 (custom-save-delete 'custom-load-themes) 3459 (custom-save-delete 'custom-load-themes)
3386 (custom-save-delete 'custom-reset-variables) 3460 (custom-save-delete 'custom-reset-variables)
3387 (custom-save-delete 'custom-set-variables) 3461 (custom-save-delete 'custom-set-variables)
3462 ;; This leaves point at the end of file.
3463 ;; Adrian Aichner <adrian@xemacs.org> stated it is
3464 ;; a bad behavior <npak@ispras.ru>
3465 ;;(custom-save-delete-any 'custom-load-themes
3466 ;; 'custom-reset-variables
3467 ;; 'custom-set-variables)
3388 (custom-save-loaded-themes) 3468 (custom-save-loaded-themes)
3389 (custom-save-resets 'theme-value 'custom-reset-variables nil) 3469 (custom-save-resets 'theme-value 'custom-reset-variables nil)
3390 (let ((standard-output (current-buffer))) 3470 (let ((standard-output (current-buffer))
3471 ;; To make nconc work
3472 (sorted-list (make-list 1 t)))
3473 ;; First create a sorted list of saved variables.
3474 (mapatoms
3475 (lambda (symbol)
3476 (when (custom-save-variable-p symbol)
3477 (nconc sorted-list (list symbol)))))
3478 (setq sorted-list (sort (cdr sorted-list) 'string<))
3479
3391 (unless (bolp) 3480 (unless (bolp)
3392 (princ "\n")) 3481 (princ "\n"))
3393 (princ "(custom-set-variables") 3482 (princ "(custom-set-variables")
3394 (mapatoms (lambda (symbol) 3483 (mapc 'custom-save-variable-internal
3395 (let ((spec (car-safe (get symbol 'theme-value))) 3484 sorted-list)
3396 (requests (get symbol 'custom-requests)) 3485 (princ ")")
3397 (now (not (or (get symbol 'standard-value) 3486 (unless (looking-at "\n")
3398 (and (not (boundp symbol)) 3487 (princ "\n")))))
3399 (not (eq (get symbol 'force-value)
3400 'rogue))))))
3401 (comment (get symbol 'saved-variable-comment)))
3402 (when (or (and spec (eq (car spec) 'user)
3403 (eq (second spec) 'set)) comment
3404 ;; support non-themed vars
3405 (and (null spec) (get symbol 'saved-value)))
3406 (princ "\n '(")
3407 (prin1 symbol)
3408 (princ " ")
3409 ;; This comment stuff is in the way ####
3410 ;; Is (eq (third spec) (car saved-value)) ????
3411 ;; (prin1 (third spec))
3412 ;; XEmacs -- pretty-print value if available
3413 (if-fboundp 'pp
3414 (pp (car (get symbol 'saved-value)))
3415 (prin1 (car (get symbol 'saved-value))))
3416 (when (or now requests comment)
3417 (princ (if now " t" " nil")))
3418 (when (or comment requests)
3419 (princ " ")
3420 (prin1 requests))
3421 (when comment
3422 (princ " ")
3423 (prin1 comment))
3424 (princ ")")))))
3425 (princ ")")
3426 (unless (looking-at "\n")
3427 (princ "\n")))))
3428 3488
3429 (defvar custom-save-face-ignoring nil) 3489 (defvar custom-save-face-ignoring nil)
3430 3490
3491 (defsubst custom-save-face-p (symbol)
3492 "Return non-nil if SYMBOL is a customized face."
3493 (let ((theme-spec (car-safe (get symbol 'theme-face)))
3494 (comment (get symbol 'saved-face-comment)))
3495 (or (and (not (memq symbol custom-save-face-ignoring))
3496 ;; Don't print default face here.
3497 (or (and theme-spec
3498 (eq (car theme-spec) 'user)
3499 (eq (second theme-spec) 'set))
3500 ;; cope with non-themed faces
3501 (and (null theme-spec)
3502 (get symbol 'saved-face))))
3503 comment)))
3504
3431 (defun custom-save-face-internal (symbol) 3505 (defun custom-save-face-internal (symbol)
3432 (let ((theme-spec (car-safe (get symbol 'theme-face))) 3506 "Print face SYMBOL to the standard output.
3433 (comment (get symbol 'saved-face-comment)) 3507 SYMBOL must be a customized face."
3508 (let ((comment (get symbol 'saved-face-comment))
3434 (now (not (or (get symbol 'face-defface-spec) 3509 (now (not (or (get symbol 'face-defface-spec)
3435 (and (not (find-face symbol)) 3510 (and (not (find-face symbol))
3436 (not (eq (get symbol 'force-face) 'rogue))))))) 3511 (not (eq (get symbol 'force-face) 'rogue))))))
3437 (when (or (and (not (memq symbol custom-save-face-ignoring)) 3512 ;; Print everything, no placeholders `...'
3438 ;; Don't print default face here. 3513 (print-level nil)
3439 (or (and theme-spec 3514 (print-length nil))
3440 (eq (car theme-spec) 'user) 3515 (if (memq symbol custom-save-face-ignoring)
3441 (eq (second theme-spec) 'set)) 3516 ;; Do nothing
3442 ;; cope with non-themed faces 3517 nil
3443 (and (null theme-spec) 3518 ;; Print face
3444 (get symbol 'saved-face)))) comment) 3519 (unless (custom-save-face-p symbol)
3520 (error 'wrong-type-argument "Not a customized face" symbol))
3445 (princ "\n '(") 3521 (princ "\n '(")
3446 (prin1 symbol) 3522 (prin1 symbol)
3447 (princ " ") 3523 (princ " ")
3448 (prin1 (get symbol 'saved-face)) 3524 (prin1 (get symbol 'saved-face))
3449 (if (or comment now) 3525 (if (or comment now)
3450 (princ (if now " t" " nil"))) 3526 (princ (if now " t" " nil")))
3451 (when comment 3527 (when comment
3452 (princ " ") 3528 (princ " ")
3453 (prin1 comment)) 3529 (prin1 comment))
3454 (princ ")")))) 3530 (princ ")"))))
3455 3531
3456 (defun custom-save-faces () 3532 (defun custom-save-faces ()
3457 "Save all customized faces in `custom-file'." 3533 "Save all customized faces in `custom-file'."
3458 (save-excursion 3534 (save-excursion
3459 (custom-save-delete 'custom-reset-faces) 3535 (custom-save-delete 'custom-reset-faces)
3460 (custom-save-delete 'custom-set-faces) 3536 (custom-save-delete 'custom-set-faces)
3537 ;; This leaves point at the end of file.
3538 ;; Adrian Aichner <adrian@xemacs.org> stated it is
3539 ;; a bad behavior <npak@ispras.ru>
3540 ;;(custom-save-delete-any 'custom-reset-faces
3541 ;; 'custom-set-faces)
3461 (custom-save-resets 'theme-face 'custom-reset-faces '(default)) 3542 (custom-save-resets 'theme-face 'custom-reset-faces '(default))
3462 (let ((standard-output (current-buffer))) 3543 (let ((standard-output (current-buffer))
3544 ;; To make nconc work
3545 (sorted-list (make-list 1 t)))
3546 ;; Create a sorted list of faces
3547 (mapatoms
3548 (lambda (symbol)
3549 (when (custom-save-face-p symbol)
3550 (nconc sorted-list (list symbol)))))
3551 (setq sorted-list (sort (cdr sorted-list) 'string<))
3552
3463 (unless (bolp) 3553 (unless (bolp)
3464 (princ "\n")) 3554 (princ "\n"))
3465 (princ "(custom-set-faces") 3555 (princ "(custom-set-faces")
3466 ;; The default face must be first, since it affects the others. 3556 ;; The default face must be first, since it affects the others.
3467 (custom-save-face-internal 'default) 3557 (when (custom-save-face-p 'default)
3558 (custom-save-face-internal 'default))
3468 (let ((custom-save-face-ignoring '(default))) 3559 (let ((custom-save-face-ignoring '(default)))
3469 (mapatoms #'custom-save-face-internal)) 3560 (mapc 'custom-save-face-internal
3561 sorted-list))
3470 (princ ")") 3562 (princ ")")
3471 (unless (looking-at "\n") 3563 (unless (looking-at "\n")
3472 (princ "\n"))))) 3564 (princ "\n")))))
3473 3565
3566 (defmacro make-custom-save-resets-mapper (property setter)
3567 "Create a mapper for `custom-save-resets'."
3568 `(lambda (object)
3569 (let ((spec (car-safe (get object (quote ,property))))
3570 (print-level nil)
3571 (print-length nil))
3572 (with-boundp '(ignored-special started-writing)
3573 (when (and (not (memq object ignored-special))
3574 (eq (car spec) 'user)
3575 (eq (second spec) 'reset))
3576 ;; Do not write reset statements unless necessary.
3577 (unless started-writing
3578 (setq started-writing t)
3579 (unless (bolp)
3580 (princ "\n"))
3581 (princ "(")
3582 (princ (quote ,setter))
3583 (princ "\n '(")
3584 (prin1 object)
3585 (princ " ")
3586 (prin1 (third spec))
3587 (princ ")")))))))
3588
3589 (defconst custom-save-resets-mapper-alist
3590 (eval-when-compile
3591 (list (list 'theme-value 'custom-reset-variables
3592 (byte-compile
3593 (make-custom-save-resets-mapper
3594 'theme-value 'custom-reset-variables)))
3595 (list 'theme-face 'custom-reset-faces
3596 (byte-compile
3597 (make-custom-save-resets-mapper
3598 'theme-face 'custom-reset-faces)))))
3599 "Never use it.
3600 Hashes several heavily used functions for `custom-save-resets'")
3601
3474 (defun custom-save-resets (property setter special) 3602 (defun custom-save-resets (property setter special)
3603 (declare (special ignored-special))
3475 (let (started-writing ignored-special) 3604 (let (started-writing ignored-special)
3476 (setq ignored-special ignored-special) ;; suppress byte-compiler warning
3477 ;; (custom-save-delete setter) Done by caller 3605 ;; (custom-save-delete setter) Done by caller
3478 (let ((standard-output (current-buffer)) 3606 (let ((standard-output (current-buffer))
3479 (mapper `(lambda (object) 3607 (mapper (let ((triple (assq property custom-save-resets-mapper-alist)))
3480 (let ((spec (car-safe (get object (quote ,property))))) 3608 (if (and triple (eq (second triple) setter))
3481 (when (and (not (memq object ignored-special)) 3609 (third triple)
3482 (eq (car spec) 'user) 3610 (make-custom-save-resets-mapper property setter)))))
3483 (eq (second spec) 'reset))
3484 ;; Do not write reset statements unless necessary.
3485 (unless started-writing
3486 (setq started-writing t)
3487 (unless (bolp)
3488 (princ "\n"))
3489 (princ "(")
3490 (princ (quote ,setter))
3491 (princ "\n '(")
3492 (prin1 object)
3493 (princ " ")
3494 (prin1 (third spec))
3495 (princ ")")))))))
3496 (mapc mapper special) 3611 (mapc mapper special)
3497 (setq ignored-special special) 3612 (setq ignored-special special)
3498 (mapatoms mapper) 3613 (mapatoms mapper)
3499 (when started-writing 3614 (when started-writing
3500 (princ ")\n")))) 3615 (princ ")\n")))))
3501 )
3502 3616
3503 3617
3504 (defun custom-save-loaded-themes () 3618 (defun custom-save-loaded-themes ()
3505 (let ((themes (reverse (get 'user 'theme-loads-themes))) 3619 (let ((themes (reverse (get 'user 'theme-loads-themes)))
3506 (standard-output (current-buffer))) 3620 (standard-output (current-buffer))
3621 (print-level nil)
3622 (print-length nil))
3507 (when themes 3623 (when themes
3508 (unless (bolp) (princ "\n")) 3624 (unless (bolp) (princ "\n"))
3509 (princ "(custom-load-themes") 3625 (princ "(custom-load-themes")
3510 (mapc (lambda (theme) 3626 (mapc (lambda (theme)
3511 (princ "\n '") 3627 (princ "\n '")