diff options
Diffstat (limited to 'emacs.d/nxhtml/util/cus-new-user.el')
| -rw-r--r-- | emacs.d/nxhtml/util/cus-new-user.el | 803 |
1 files changed, 0 insertions, 803 deletions
diff --git a/emacs.d/nxhtml/util/cus-new-user.el b/emacs.d/nxhtml/util/cus-new-user.el deleted file mode 100644 index c727425..0000000 --- a/emacs.d/nxhtml/util/cus-new-user.el +++ /dev/null @@ -1,803 +0,0 @@ -;;; cus-new-user.el --- Customize some important options -;; -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Created: 2009-07-10 Fri -;; Version: 0.2 -;; Last-Updated: 2009-07-10 Fri -;; URL: -;; Keywords: -;; Compatibility: -;; -;; Features that might be required by this library: -;; -;; None -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Customize significant options for which different user -;; environment expectations might dictate different defaults. -;; -;; After an idea of Scot Becker on Emacs Devel. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program 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 3, or -;; (at your option) any later version. -;; -;; This program 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 this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth -;; Floor, Boston, MA 02110-1301, USA. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(defvar cusnu-my-skin-widget nil) - -(defvar cusnu-insert-os-spec-fun nil) - -;;(customize-for-new-user) -;;;###autoload -(defun customize-for-new-user (&optional name) - "Show special customization page for new user. -" - (interactive) - ;;(setq debug-on-error t) - ;;(setq buffer-read-only t) - (require 'cus-edit) - (let ((inhibit-read-only t) - fill-pos) - (pop-to-buffer (custom-get-fresh-buffer (or name "*Customizations for New Users*"))) - (buffer-disable-undo) - (Custom-mode) - (erase-buffer) - (widget-insert (propertize "Easy Customization for New Users\n" 'face '(:weight bold :height 1.5))) - (setq fill-pos (point)) - (widget-insert - "Below are some custom options that new users often may want to -tweak since they may make Emacs a bit more like what they expect from -using other software in their environment. - -After this, at the bottom of this page, is a tool for exporting your own specific options. -You choose which to export, make a description and give the group of options a new and click a button. -Then you just mail it or put it on the web for others to use. - -Since Emacs runs in many environment and an Emacs user may use -several of them it is hard to decide by default what a user -wants/expects. Therefor you are given the possibility to easily -do those changes here. - -Note that this is just a collection of normal custom options. -There are no new options here. - - -") - (fill-region fill-pos (point)) - - ;; Normal custom buffer header - (let ((init-file (or custom-file user-init-file))) - ;; Insert verbose help at the top of the custom buffer. - (when custom-buffer-verbose-help - (widget-insert "Editing a setting changes only the text in this buffer." - (if init-file - " -To apply your changes, use the Save or Set buttons. -Saving a change normally works by editing your init file." - " -Currently, these settings cannot be saved for future Emacs sessions, -possibly because you started Emacs with `-q'.") - "\nFor details, see ") - (widget-create 'custom-manual - :tag "Saving Customizations" - "(emacs)Saving Customizations") - (widget-insert " in the ") - (widget-create 'custom-manual - :tag "Emacs manual" - :help-echo "Read the Emacs manual." - "(emacs)Top") - (widget-insert ".")) - (widget-insert "\n") - ;; The custom command buttons are also in the toolbar, so for a - ;; time they were not inserted in the buffer if the toolbar was in use. - ;; But it can be a little confusing for the buffer layout to - ;; change according to whether or nor the toolbar is on, not to - ;; mention that a custom buffer can in theory be created in a - ;; frame with a toolbar, then later viewed in one without. - ;; So now the buttons are always inserted in the buffer. (Bug#1326) -;;; (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p))) - (if custom-buffer-verbose-help - (widget-insert "\n - Operate on all settings in this buffer that are not marked HIDDEN:\n")) - (let ((button (lambda (tag action active help icon) - (widget-insert " ") - (if (eval active) - (widget-create 'push-button :tag tag - :help-echo help :action action)))) - (commands custom-commands)) - (apply button (pop commands)) ; Set for current session - (apply button (pop commands)) ; Save for future sessions - (if custom-reset-button-menu - (progn - (widget-insert " ") - (widget-create 'push-button - :tag "Reset buffer" - :help-echo "Show a menu with reset operations." - :mouse-down-action 'ignore - :action 'custom-reset)) - (widget-insert "\n") - (apply button (pop commands)) ; Undo edits - (apply button (pop commands)) ; Reset to saved - (apply button (pop commands)) ; Erase customization - (widget-insert " ") - (pop commands) ; Help (omitted) - (apply button (pop commands)))) ; Exit - (widget-insert "\n\n") - - (widget-insert (propertize "\nThis part is for your own use\n" 'face '(:weight bold :height 1.5))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Editor emulator level - - (widget-insert "\n") - (setq fill-pos (point)) - (widget-insert -"Emacs can emulate some common editing behaviours (and some uncommon too). -For the most common ones you can decide if you want to use them here: -") - (fill-region fill-pos (point)) - (cusnu-mark-part-desc fill-pos (point)) - - ;; CUA Mode - (cusnu-insert-options '((cua-mode custom-variable))) - - ;; Viper Mode - (widget-insert "\n") - (widget-insert (propertize "Viper" 'face 'custom-variable-tag)) - (widget-insert ":") - (setq fill-pos (point)) - (widget-insert " - Viper is currently set up in a special way, please see the - command `viper-mode'. You can use custom to set up most of - it. However if you want to load Viper at startup you must - explicitly include \(require 'viper) in your .emacs. -") - (fill-region fill-pos (point)) - - ;; Viper Mode - (backward-delete-char 1) - (cusnu-insert-options '((viper-mode custom-variable))) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; OS specific - - (widget-insert "\n") - (setq fill-pos (point)) - (widget-insert (format "OS specific options (%s): \n" system-type)) - (fill-region fill-pos (point)) - (cusnu-mark-part-desc fill-pos (point)) - - (if cusnu-insert-os-spec-fun - (funcall cusnu-insert-os-spec-fun) - (widget-insert "No OS specific customizations.\n")) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Disputed settings - - (widget-insert "\n") - (setq fill-pos (point)) - (widget-insert -"Some old time Emacs users want to change the options below: -") - (fill-region fill-pos (point)) - (cusnu-mark-part-desc fill-pos (point)) - - (cusnu-insert-options '((global-visual-line-mode custom-variable))) - (cusnu-insert-options '((word-wrap custom-variable))) - (cusnu-insert-options '((blink-cursor-mode custom-variable))) - (cusnu-insert-options '((tool-bar-mode custom-variable))) - (cusnu-insert-options '((tooltip-mode custom-variable))) - ;;(cusnu-insert-options '((initial-scratch-message custom-variable))) - - (widget-insert "\n") - (widget-insert (propertize "\n\nThis part is for exporting to others\n\n" 'face '(:weight bold :height 1.5))) - (setq fill-pos (point)) - (widget-insert -"My skin options - This is for exporting custom options to other users -\(or maybe yourself on another computer). -This works the following way: - -- You add a description of your options and the options you want to export below. -Then you click on `Export my skin options'. -This creates a file that you can send to other Emacs users. -They simply open that file in Emacs and follow the instructions there to test your options -and maybe save them for later use if they like them. -\(You can follow the instructions yourself to see how it works.) - -Please change the group symbol name to something specific for you. -") - (fill-region fill-pos (point)) - (cusnu-mark-part-desc fill-pos (point)) - - (widget-insert "\n") - (set (make-local-variable 'cusnu-my-skin-widget) - (car - (cusnu-insert-options '((cusnu-my-skin-options custom-variable))))) - (widget-insert "\n") - (widget-create 'push-button - :tag "Export my skin options " - :action (lambda (&rest ignore) - (let ((use-dialog-box nil)) - (call-interactively 'cusnu-export-my-skin-options)))) - (widget-insert "\n") - (widget-create 'push-button - :tag "Customize my skin options " - :action (lambda (&rest ignore) - (let ((use-dialog-box nil)) - (call-interactively 'cusnu-customize-my-skin-options)))) - (widget-insert "\n") - (widget-create 'push-button - :tag "Reset those options to saved values" - :action (lambda (&rest ignore) - (let ((use-dialog-box nil)) - (call-interactively 'cusnu-reset-my-skin-options)))) - - ;; Finish setup buffer - (mapc 'custom-magic-reset custom-options) - (cusnu-make-xrefs) - (widget-setup) - (buffer-enable-undo) - (goto-char (point-min))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Example on Emacs+Emacw32 -(eval-when-compile (require 'emacsw32 nil t)) -(when (fboundp 'emacsw32-version) - (defun cusnu-emacsw32-show-custstart (&rest args) - (emacsw32-show-custstart)) - (setq cusnu-insert-os-spec-fun 'cusnu-insert-emacsw32-specific-part) - (defun cusnu-insert-emacsw32-specific-part () - (cusnu-insert-options '((w32-meta-style custom-variable))) - (widget-insert "\n") - (widget-insert (propertize "EmacsW32" 'face 'custom-variable-tag)) - (widget-insert " - Easy setup for Emacs+EmacsW32.") - (widget-insert "\n ") - (widget-create 'push-button :tag "Customize EmacsW32" - ;;:help-echo help - :action 'cusnu-emacsw32-show-custstart) - (widget-insert "\n"))) -;; End example -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun cusnu-mark-part-desc (beg end) - (let ((ovl (make-overlay beg end))) - (overlay-put ovl 'face 'highlight))) - -(defun cusnu-make-xrefs (&optional beg end) - (save-restriction - (when (or beg end) - (unless beg (setq beg (point-min))) - (unless end (setq end (point-max))) - (narrow-to-region beg end)) - (let ((here (point))) - (goto-char (point-min)) - (cusnu-help-insert-xrefs 'cusnu-help-xref-button) - (goto-char here)))) - -(defun widget-info-link-action (widget &optional event) - "Open the info node specified by WIDGET." - (info-other-window (widget-value widget))) - -(defun widget-documentation-string-value-create (widget) - ;; Insert documentation string. - (let ((doc (widget-value widget)) - (indent (widget-get widget :indent)) - (shown (widget-get (widget-get widget :parent) :documentation-shown)) - (start (point))) - (if (string-match "\n" doc) - (let ((before (substring doc 0 (match-beginning 0))) - (after (substring doc (match-beginning 0))) - button) - (when (and indent (not (zerop indent))) - (insert-char ?\s indent)) - (insert before ?\s) - (widget-documentation-link-add widget start (point)) - (setq button - (widget-create-child-and-convert - widget (widget-get widget :visibility-widget) - :help-echo "Show or hide rest of the documentation." - :on "Hide Rest" - :off "More" - :always-active t - :action 'widget-parent-action - shown)) - (when shown - (setq start (point)) - (when (and indent (not (zerop indent))) - (insert-char ?\s indent)) - (insert after) - (widget-documentation-link-add widget start (point)) - (cusnu-make-xrefs start (point)) - ) - (widget-put widget :buttons (list button))) - (when (and indent (not (zerop indent))) - (insert-char ?\s indent)) - (insert doc) - (widget-documentation-link-add widget start (point)))) - (insert ?\n)) -(defun cusnu-help-xref-button (match-number type what &rest args) - (let ((beg (match-beginning match-number)) - (end (match-end match-number))) - (if nil - (let ((ovl (make-overlay beg end))) - (overlay-put ovl 'face 'highlight)) - (let* ((tag (match-string match-number)) - (value what) - (wid-type (cond - ((eq type 'help-variable) - 'variable-link) - ((eq type 'help-function) - 'function-link) - ((eq type 'help-info) - 'custom-manual) - (t nil))) - ) - (when wid-type - (delete-region beg end) - (backward-char) - ;;(tag action active help icon) - (widget-create wid-type - ;;tag - :value value - :tag tag - :keymap custom-mode-link-map - :follow-link 'mouse-face - :button-face 'custom-link - :mouse-face 'highlight - :pressed-face 'highlight - ;;:help-echo help - ))))) - ) - -;; Override default ... ;-) -(define-widget 'documentation-link 'link - "Link type used in documentation strings." - ;;:tab-order -1 - :help-echo "Describe this symbol" - :button-face 'custom-link - :action 'widget-documentation-link-action) - -(defun cusnu-xref-niy (&rest ignore) - (message "Not implemented yet")) - -(defun cusnu-describe-function (wid &rest ignore) - (let ((fun (widget-get wid :what)) - ) - (describe-function fun))) - -(defun cusnu-help-insert-xrefs (help-xref-button) - ;; The following should probably be abstracted out. - (unwind-protect - (progn - ;; Info references - (save-excursion - (while (re-search-forward help-xref-info-regexp nil t) - (let ((data (match-string 2))) - (save-match-data - (unless (string-match "^([^)]+)" data) - (setq data (concat "(emacs)" data)))) - (funcall help-xref-button 2 'help-info data)))) - ;; URLs - (save-excursion - (while (re-search-forward help-xref-url-regexp nil t) - (let ((data (match-string 1))) - (funcall help-xref-button 1 'help-url data)))) - ;; Mule related keywords. Do this before trying - ;; `help-xref-symbol-regexp' because some of Mule - ;; keywords have variable or function definitions. - (if help-xref-mule-regexp - (save-excursion - (while (re-search-forward help-xref-mule-regexp nil t) - (let* ((data (match-string 7)) - (sym (intern-soft data))) - (cond - ((match-string 3) ; coding system - (and sym (coding-system-p sym) - (funcall help-xref-button 6 'help-coding-system sym))) - ((match-string 4) ; input method - (and (assoc data input-method-alist) - (funcall help-xref-button 7 'help-input-method data))) - ((or (match-string 5) (match-string 6)) ; charset - (and sym (charsetp sym) - (funcall help-xref-button 7 'help-character-set sym))) - ((assoc data input-method-alist) - (funcall help-xref-button 7 'help-character-set data)) - ((and sym (coding-system-p sym)) - (funcall help-xref-button 7 'help-coding-system sym)) - ((and sym (charsetp sym)) - (funcall help-xref-button 7 'help-character-set sym))))))) - ;; Quoted symbols - (save-excursion - (while (re-search-forward help-xref-symbol-regexp nil t) - (let* ((data (match-string 8)) - (sym (intern-soft data))) - (if sym - (cond - ((match-string 3) ; `variable' &c - (and (or (boundp sym) ; `variable' doesn't ensure - ; it's actually bound - (get sym 'variable-documentation)) - (funcall help-xref-button 8 'help-variable sym))) - ((match-string 4) ; `function' &c - (and (fboundp sym) ; similarly - (funcall help-xref-button 8 'help-function sym))) - ((match-string 5) ; `face' - (and (facep sym) - (funcall help-xref-button 8 'help-face sym))) - ((match-string 6)) ; nothing for `symbol' - ((match-string 7) -;;; this used: -;;; #'(lambda (arg) -;;; (let ((location -;;; (find-function-noselect arg))) -;;; (pop-to-buffer (car location)) -;;; (goto-char (cdr location)))) - (funcall help-xref-button 8 'help-function-def sym)) - ((and - (facep sym) - (save-match-data (looking-at "[ \t\n]+face\\W"))) - (funcall help-xref-button 8 'help-face sym)) - ((and (or (boundp sym) - (get sym 'variable-documentation)) - (fboundp sym)) - ;; We can't intuit whether to use the - ;; variable or function doc -- supply both. - (funcall help-xref-button 8 'help-symbol sym)) - ((and - (or (boundp sym) - (get sym 'variable-documentation)) - (or - (documentation-property - sym 'variable-documentation) - (condition-case nil - (documentation-property - (indirect-variable sym) - 'variable-documentation) - (cyclic-variable-indirection nil)))) - (funcall help-xref-button 8 'help-variable sym)) - ((fboundp sym) - (funcall help-xref-button 8 'help-function sym))))))) - ;; An obvious case of a key substitution: - (save-excursion - (while (re-search-forward - ;; Assume command name is only word and symbol - ;; characters to get things like `use M-x foo->bar'. - ;; Command required to end with word constituent - ;; to avoid `.' at end of a sentence. - "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t) - (let ((sym (intern-soft (match-string 1)))) - (if (fboundp sym) - (funcall help-xref-button 1 'help-function sym))))) - ;; Look for commands in whole keymap substitutions: - (save-excursion - ;; Make sure to find the first keymap. - (goto-char (point-min)) - ;; Find a header and the column at which the command - ;; name will be found. - - ;; If the keymap substitution isn't the last thing in - ;; the doc string, and if there is anything on the - ;; same line after it, this code won't recognize the end of it. - (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" - nil t) - (let ((col (- (match-end 1) (match-beginning 1)))) - (while - (and (not (eobp)) - ;; Stop at a pair of blank lines. - (not (looking-at "\n\\s-*\n"))) - ;; Skip a single blank line. - (and (eolp) (forward-line)) - (end-of-line) - (skip-chars-backward "^ \t\n") - (if (and (>= (current-column) col) - (looking-at "\\(\\sw\\|\\s_\\)+$")) - (let ((sym (intern-soft (match-string 0)))) - (if (fboundp sym) - (funcall help-xref-button 0 'help-function sym)))) - (forward-line)))))) - ;;(set-syntax-table stab) - )) - -(defun cusnu-insert-options (options) - (widget-insert "\n") - (setq custom-options - (append - (if (= (length options) 1) - (mapcar (lambda (entry) - (widget-create (nth 1 entry) - ;;:documentation-shown t - :custom-state 'unknown - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :value (nth 0 entry))) - options) - (let ((count 0) - (length (length options))) - (mapcar (lambda (entry) - (prog2 - (message "Creating customization items ...%2d%%" - (/ (* 100.0 count) length)) - (widget-create (nth 1 entry) - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :value (nth 0 entry)) - (setq count (1+ count)) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")) - (widget-insert "\n"))) - options))) - custom-options)) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")) - custom-options - ) - -(defun cusnu-is-custom-obj (sym) - "Return non-nil if symbol SYM is customizable." - (or (get sym 'custom-type) - (get sym 'face) - (get sym 'custom-group) - )) - -(define-widget 'custom-symbol 'symbol - "A customizable symbol." - :prompt-match 'cusnu-is-custom-obj - :prompt-history 'widget-variable-prompt-value-history - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'cusnu-is-custom-obj)) - :tag "Custom option") - -(defun cusnu-set-my-skin-options (sym val) - (set-default sym val) - (let ((group (nth 0 val)) - (doc (nth 1 val)) - (members (nth 2 val))) - (custom-declare-group group nil doc) - (put group 'custom-group nil) - (dolist (opt members) - (let ((type (cusnu-get-opt-main-type opt))) - (when type - (custom-add-to-group group opt type)))))) - -(defun cusnu-get-opt-main-type (opt) - (when opt - (cond ((get opt 'face) 'custom-face) - ((get opt 'custom-type) 'custom-variable) - ((get opt 'custom-group) 'custom-group)))) - -(defgroup all-my-loaded-skin-groups nil - "All your loaded skin groups." - :group 'environment - :group 'convenience) - -(defun cusnu-custom-group-p (symbol) - (and (intern-soft symbol) - (or (and (get symbol 'custom-loads) - (not (get symbol 'custom-autoload))) - (get symbol 'custom-group)))) - -(defcustom cusnu-my-skin-options '(my-skin-group "My skin group.\n\n\n\n\n" nil) - "Your custom skin-like options. -The purpose of this variable is to provide for easy export a -selection of variables you choose to set to other users. - -To send these values to other users you export them to a file -with `cusnu-export-my-skin-options'." - :type '(list (symbol :tag "My custom group symbol name (should be specific to you)") - (string :tag "My custom group description") - (repeat :tag "Add your custom options below" - (custom-symbol :tag "My custom option"))) - :set 'cusnu-set-my-skin-options - :group 'all-my-loaded-skin-groups) - -;;(cusnu-ring-bell "bell") -(defun cusnu-ring-bell (format-string &rest args) - (message "%s" (propertize (apply - 'format format-string args) 'face 'secondary-selection)) - (ding) - (throw 'bell nil)) - -;;;###autoload -(defun cusnu-export-my-skin-options (file) - "Export to file FILE custom options in `cusnu-my-skin-options'. -The options is exported to elisp code that other users can run to -set the options that you have added to `cusnu-my-skin-options'. - -For more information about this see `cusnu-export-cust-group'." - (interactive '(nil)) - (catch 'bell - (let ((grp (nth 0 cusnu-my-skin-options)) - buf) - (let ((state (plist-get (cdr cusnu-my-skin-widget) :custom-state))) - (case state - ((set saved) nil) ;;(error "test, state=%s" state)) - (standard (cusnu-ring-bell "Please enter your options first")) - (t (cusnu-ring-bell "My Skin Options must be saved or set, use the State button, %s" state)))) - (unless (nth 2 cusnu-my-skin-options) - (cusnu-ring-bell "You have not added any of your options")) - (unless file - (setq file (read-file-name "Save to file: "))) - (when (file-exists-p file) - (cusnu-ring-bell "File %s already exists, choose another file name" file)) - (setq buf (find-file-other-window file)) - (with-current-buffer buf - (unless (eq major-mode 'emacs-lisp-mode) (emacs-lisp-mode)) - (unless (file-exists-p (buffer-file-name)) - (erase-buffer))) - (cusnu-export-cust-group grp buf)))) - -(defun cusnu-customize-my-skin-options () - (interactive) - (customize-group-other-window (nth 0 cusnu-my-skin-options))) - -(defun cusnu-reset-my-skin-options () - "Reset to my defaults for those options. -" - (interactive) - (cusnu-reset-group-options-to-my-defaults (nth 0 cusnu-my-skin-options))) - -(defun cusnu-reset-group-options-to-my-defaults (group) - (dolist (sym-typ (get group 'custom-group)) - (let ((symbol (nth 0 sym-typ)) - ;;(type (cusnu-get-opt-main-type symbol)) - (type (nth 1 sym-typ)) - defval) - (cond - ((eq type 'custom-variable) - ;; First try reset to saved. - (let* ((set (or (get symbol 'custom-set) 'set-default)) - (value (get symbol 'saved-value)) - (comment (get symbol 'saved-variable-comment))) - (cond ((or comment value) - (put symbol 'variable-comment comment) - (custom-push-theme 'theme-value symbol 'user 'set (car-safe value)) - (condition-case err - (funcall set symbol (eval (car value))) - (error (message "%s" err)))) - ;; If symbol was not saved then reset to standard. - (t - (unless (get symbol 'standard-value) - (error "No standard setting known for %S" symbol)) - (put symbol 'variable-comment nil) - (put symbol 'customized-value nil) - (put symbol 'customized-variable-comment nil) - (custom-push-theme 'theme-value symbol 'user 'reset) - (custom-theme-recalc-variable symbol) - (put symbol 'saved-value nil) - (put symbol 'saved-variable-comment nil) - )))) - ((eq type 'custom-face) - ;; First try reset to saved - (let* ((value (get symbol 'saved-face)) - (comment (get symbol 'saved-face-comment))) - (cond ((or value comment) - (put symbol 'customized-face nil) - (put symbol 'customized-face-comment nil) - (custom-push-theme 'theme-face symbol 'user 'set value) - (face-spec-set symbol value t) - (put symbol 'face-comment comment)) - ;; If symbol was not saved then reset to standard. - (t - (setq value (get symbol 'face-defface-spec)) - (unless value - (error "No standard setting for this face")) - (put symbol 'customized-face nil) - (put symbol 'customized-face-comment nil) - (custom-push-theme 'theme-face symbol 'user 'reset) - (face-spec-set symbol value t) - (custom-theme-recalc-face symbol) - ;; Do this later. - (put symbol 'saved-face nil) - (put symbol 'saved-face-comment nil) - )))) - (t (error "not iy")))))) - -(defun cusnu-export-cust-group (group buf) - "Export custom group GROUP to end of buffer BUF. -Only the options that has been customized will be exported. - -The group is exported as elisp code. Running the code will -create a group with just those members. After this it opens a -customization buffer with the new group. - -The code will also set the options to the customized values, but -it will not save them in the users init file. - -See also the comment in the exported file." - (let (start - (doc (get group 'group-documentation)) - groups options faces - (members (mapcar (lambda (rec) - (car rec)) - (get group 'custom-group)))) - (with-current-buffer buf - (insert (format-time-string ";; Here is my skin custom group %Y-%m-%d.\n")) - (font-lock-mode 1) - (insert (format ";;;;;; Customization group name: %s\n" group)) - (insert ";;\n") - (let ((here (point))) - (insert doc "\n") - (comment-region here (point)) - (fill-region here (point))) - (cusnu-get-options-and-faces members 'groups 'options 'faces) - (unless (or options faces) - (cusnu-ring-bell "There are no options or faces in %s customized by you" group)) - (insert " -;; This file defines the group and sets the options in it, but does -;; not save the values to your init file. -;; -;; To set the values evaluate this file. To do that open this file in Emacs and to -;; -;; M-x eval-buffer -;; -;; To go back to your default evaluate next line (place point at the end and to C-x C-e): -") - (insert (format ";; (cusnu-reset-group-options-to-my-defaults '%s)\n\n" group)) - (insert (format "(let ((grp '%s))\n" group)) - (insert (format " (custom-declare-group grp nil %S)\n" doc)) - (insert " (put grp 'custom-group nil)\n") - (insert (format " (custom-add-to-group 'all-my-loaded-skin-groups '%s 'custom-group)\n" group)) - (dolist (opt members) - (let ((type (cusnu-get-opt-main-type opt))) - (when type - (insert (format " (custom-add-to-group grp '%s '%s)\n" - opt type))))) - (insert " (custom-set-variables\n") - (dolist (opt options) - (let ((my-val (or (get opt 'saved-value) - (get opt 'customized-value)))) - (when my-val - (insert (format " '(%s %S)\n" opt (custom-quote (symbol-value opt))))))) - (insert " )\n") - (insert " (custom-set-faces\n") - (dolist (opt faces) - (let ((my-val (get opt 'customized-face))) - (when my-val - (insert (format " '(%s %S)\n" opt my-val))))) - (insert " ))\n") - (insert (format "\n(customize-group '%s)\n" group)) - ))) - -(defun cusnu-get-options-and-faces (members groups-par options-par faces-par) - (dolist (sym members) - (insert (format ";; sym=%s\n" sym)) - (cond ((and (get sym 'custom-type) - (or (get sym 'saved-value) - (get sym 'customize-value))) - (add-to-list options-par sym)) - ((and (get sym 'face) - (get sym 'customized-face)) - (add-to-list faces-par sym)) - ((get sym 'custom-group) - (unless (memq sym groups-par) ;; Don't loop - (cusnu-get-options-and-faces groups-par options-par faces-par))) - (t (insert ";; Not a custom variable or face: %s\n" sym))))) - -(provide 'cus-new-user) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; cus-new-user.el ends here |