nxhtml/util/cus-new-user.el

   1 ;;; cus-new-user.el --- Customize some important options
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2009-07-10 Fri
   5 ;; Version: 0.2
   6 ;; Last-Updated: 2009-07-10 Fri
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;;    Customize significant options for which different user
  20 ;;    environment expectations might dictate different defaults.
  21 ;;
  22 ;;    After an idea of Scot Becker on Emacs Devel.
  23 ;;
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;
  26 ;;; Change log:
  27 ;;
  28 ;;
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 ;;
  31 ;; This program is free software; you can redistribute it and/or
  32 ;; modify it under the terms of the GNU General Public License as
  33 ;; published by the Free Software Foundation; either version 3, or
  34 ;; (at your option) any later version.
  35 ;;
  36 ;; This program is distributed in the hope that it will be useful,
  37 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  38 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  39 ;; General Public License for more details.
  40 ;;
  41 ;; You should have received a copy of the GNU General Public License
  42 ;; along with this program; see the file COPYING.  If not, write to
  43 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  44 ;; Floor, Boston, MA 02110-1301, USA.
  45 ;;
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47 ;;
  48 ;;; Code:
  49
  50 (defvar cusnu-my-skin-widget nil)
  51
  52 (defvar cusnu-insert-os-spec-fun nil)
  53
  54 ;;(customize-for-new-user)
  55 ;;;###autoload
  56 (defun customize-for-new-user (&optional name)
  57   "Show special customization page for new user.
  58 "
  59   (interactive)
  60   ;;(setq debug-on-error t)
  61   ;;(setq buffer-read-only t)
  62   (require 'cus-edit)
  63   (let ((inhibit-read-only t)
  64         fill-pos)
  65     (pop-to-buffer (custom-get-fresh-buffer (or name "*Customizations for New Users*")))
  66     (buffer-disable-undo)
  67     (Custom-mode)
  68     (erase-buffer)
  69     (widget-insert (propertize "Easy Customization for New Users\n" 'face '(:weight bold :height 1.5)))
  70     (setq fill-pos (point))
  71     (widget-insert
  72      "Below are some custom options that new users often may want to
  73 tweak since they may make Emacs a bit more like what they expect from
  74 using other software in their environment.
  75
  76 After this, at the bottom of this page, is a tool for exporting your own specific options.
  77 You choose which to export, make a description and give the group of options a new and click a button.
  78 Then you just mail it or put it on the web for others to use.
  79
  80 Since Emacs runs in many environment and an Emacs user may use
  81 several of them it is hard to decide by default what a user
  82 wants/expects.  Therefor you are given the possibility to easily
  83 do those changes here.
  84
  85 Note that this is just a collection of normal custom options.
  86 There are no new options here.
  87
  88
  89 ")
  90     (fill-region fill-pos (point))
  91
  92     ;; Normal custom buffer header
  93     (let ((init-file (or custom-file user-init-file)))
  94       ;; Insert verbose help at the top of the custom buffer.
  95       (when custom-buffer-verbose-help
  96         (widget-insert "Editing a setting changes only the text in this buffer."
  97                        (if init-file
  98                            "
  99 To apply your changes, use the Save or Set buttons.
 100 Saving a change normally works by editing your init file."
 101                          "
 102 Currently, these settings cannot be saved for future Emacs sessions,
 103 possibly because you started Emacs with `-q'.")
 104                        "\nFor details, see ")
 105         (widget-create 'custom-manual
 106                        :tag "Saving Customizations"
 107                        "(emacs)Saving Customizations")
 108         (widget-insert " in the ")
 109         (widget-create 'custom-manual
 110                        :tag "Emacs manual"
 111                        :help-echo "Read the Emacs manual."
 112                        "(emacs)Top")
 113         (widget-insert "."))
 114       (widget-insert "\n")
 115       ;; The custom command buttons are also in the toolbar, so for a
 116       ;; time they were not inserted in the buffer if the toolbar was in use.
 117       ;; But it can be a little confusing for the buffer layout to
 118       ;; change according to whether or nor the toolbar is on, not to
 119       ;; mention that a custom buffer can in theory be created in a
 120       ;; frame with a toolbar, then later viewed in one without.
 121       ;; So now the buttons are always inserted in the buffer.  (Bug#1326)
 122 ;;;    (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
 123       (if custom-buffer-verbose-help
 124           (widget-insert "\n
 125  Operate on all settings in this buffer that are not marked HIDDEN:\n"))
 126       (let ((button (lambda (tag action active help icon)
 127                       (widget-insert " ")
 128                       (if (eval active)
 129                           (widget-create 'push-button :tag tag
 130                                          :help-echo help :action action))))
 131             (commands custom-commands))
 132         (apply button (pop commands)) ; Set for current session
 133         (apply button (pop commands)) ; Save for future sessions
 134         (if custom-reset-button-menu
 135             (progn
 136               (widget-insert " ")
 137               (widget-create 'push-button
 138                              :tag "Reset buffer"
 139                              :help-echo "Show a menu with reset operations."
 140                              :mouse-down-action 'ignore
 141                              :action 'custom-reset))
 142           (widget-insert "\n")
 143           (apply button (pop commands)) ; Undo edits
 144           (apply button (pop commands)) ; Reset to saved
 145           (apply button (pop commands)) ; Erase customization
 146           (widget-insert "  ")
 147           (pop commands) ; Help (omitted)
 148           (apply button (pop commands)))) ; Exit
 149       (widget-insert "\n\n")
 150
 151       (widget-insert (propertize "\nThis part is for your own use\n" 'face '(:weight bold :height 1.5)))
 152       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 153       ;; Editor emulator level
 154
 155       (widget-insert "\n")
 156       (setq fill-pos (point))
 157       (widget-insert
 158 "Emacs can emulate some common editing behaviours (and some uncommon too).
 159 For the most common ones you can decide if you want to use them here:
 160 ")
 161       (fill-region fill-pos (point))
 162       (cusnu-mark-part-desc fill-pos (point))
 163
 164       ;; CUA Mode
 165       (cusnu-insert-options '((cua-mode custom-variable)))
 166
 167       ;; Viper Mode
 168       (widget-insert "\n")
 169       (widget-insert (propertize "Viper" 'face 'custom-variable-tag))
 170       (widget-insert ":")
 171       (setq fill-pos (point))
 172       (widget-insert "
 173    Viper is currently set up in a special way, please see the
 174    command `viper-mode'.  You can use custom to set up most of
 175    it.  However if you want to load Viper at startup you must
 176    explicitly include \(require 'viper) in your .emacs.
 177 ")
 178       (fill-region fill-pos (point))
 179
 180       ;; Viper Mode
 181       (backward-delete-char 1)
 182       (cusnu-insert-options '((viper-mode custom-variable)))
 183
 184       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 185       ;; OS specific
 186
 187       (widget-insert "\n")
 188       (setq fill-pos (point))
 189       (widget-insert (format "OS specific options (%s): \n" system-type))
 190       (fill-region fill-pos (point))
 191       (cusnu-mark-part-desc fill-pos (point))
 192
 193       (if cusnu-insert-os-spec-fun
 194           (funcall cusnu-insert-os-spec-fun)
 195        (widget-insert "No OS specific customizations.\n"))
 196
 197       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 198       ;; Disputed settings
 199
 200       (widget-insert "\n")
 201       (setq fill-pos (point))
 202       (widget-insert
 203 "Some old time Emacs users want to change the options below:
 204 ")
 205       (fill-region fill-pos (point))
 206       (cusnu-mark-part-desc fill-pos (point))
 207
 208       (cusnu-insert-options '((global-visual-line-mode custom-variable)))
 209       (cusnu-insert-options '((word-wrap custom-variable)))
 210       (cusnu-insert-options '((blink-cursor-mode custom-variable)))
 211       (cusnu-insert-options '((tool-bar-mode custom-variable)))
 212       (cusnu-insert-options '((tooltip-mode custom-variable)))
 213       ;;(cusnu-insert-options '((initial-scratch-message custom-variable)))
 214
 215       (widget-insert "\n")
 216       (widget-insert (propertize "\n\nThis part is for exporting to others\n\n" 'face '(:weight bold :height 1.5)))
 217       (setq fill-pos (point))
 218       (widget-insert
 219 "My skin options - This is for exporting custom options to other users
 220 \(or maybe yourself on another computer).
 221 This works the following way:
 222
 223 - You add a description of your options and the options you want to export below.
 224 Then you click on `Export my skin options'.
 225 This creates a file that you can send to other Emacs users.
 226 They simply open that file in Emacs and follow the instructions there to test your options
 227 and maybe save them for later use if they like them.
 228 \(You can follow the instructions yourself to see how it works.)
 229
 230 Please change the group symbol name to something specific for you.
 231 ")
 232       (fill-region fill-pos (point))
 233       (cusnu-mark-part-desc fill-pos (point))
 234
 235       (widget-insert "\n")
 236       (set (make-local-variable 'cusnu-my-skin-widget)
 237            (car
 238             (cusnu-insert-options '((cusnu-my-skin-options custom-variable)))))
 239       (widget-insert "\n")
 240       (widget-create 'push-button
 241                      :tag "Export my skin options             "
 242                      :action (lambda (&rest ignore)
 243                                (let ((use-dialog-box nil))
 244                                  (call-interactively 'cusnu-export-my-skin-options))))
 245       (widget-insert "\n")
 246       (widget-create 'push-button
 247                      :tag "Customize my skin options          "
 248                      :action (lambda (&rest ignore)
 249                                (let ((use-dialog-box nil))
 250                                  (call-interactively 'cusnu-customize-my-skin-options))))
 251       (widget-insert "\n")
 252       (widget-create 'push-button
 253                      :tag "Reset those options to saved values"
 254                      :action (lambda (&rest ignore)
 255                                (let ((use-dialog-box nil))
 256                                  (call-interactively 'cusnu-reset-my-skin-options))))
 257
 258       ;; Finish setup buffer
 259       (mapc 'custom-magic-reset custom-options)
 260       (cusnu-make-xrefs)
 261       (widget-setup)
 262       (buffer-enable-undo)
 263       (goto-char (point-min)))))
 264
 265 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 266 ;; Example on Emacs+Emacw32
 267 (eval-when-compile (require 'emacsw32 nil t))
 268 (when (fboundp 'emacsw32-version)
 269   (defun cusnu-emacsw32-show-custstart (&rest args)
 270     (emacsw32-show-custstart))
 271   (setq cusnu-insert-os-spec-fun 'cusnu-insert-emacsw32-specific-part)
 272   (defun cusnu-insert-emacsw32-specific-part ()
 273     (cusnu-insert-options '((w32-meta-style custom-variable)))
 274     (widget-insert "\n")
 275     (widget-insert (propertize "EmacsW32" 'face 'custom-variable-tag))
 276     (widget-insert "
 277    Easy setup for Emacs+EmacsW32.")
 278     (widget-insert "\n   ")
 279     (widget-create 'push-button :tag "Customize EmacsW32"
 280                    ;;:help-echo help
 281                    :action 'cusnu-emacsw32-show-custstart)
 282     (widget-insert "\n")))
 283 ;; End example
 284 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 285
 286 (defun cusnu-mark-part-desc (beg end)
 287   (let ((ovl (make-overlay beg end)))
 288     (overlay-put ovl 'face 'highlight)))
 289
 290 (defun cusnu-make-xrefs (&optional beg end)
 291   (save-restriction
 292     (when (or beg end)
 293       (unless beg (setq beg (point-min)))
 294       (unless end (setq end (point-max)))
 295       (narrow-to-region beg end))
 296     (let ((here (point)))
 297       (goto-char (point-min))
 298       (cusnu-help-insert-xrefs 'cusnu-help-xref-button)
 299       (goto-char here))))
 300
 301 (defun widget-info-link-action (widget &optional event)
 302   "Open the info node specified by WIDGET."
 303   (info-other-window (widget-value widget)))
 304
 305 (defun widget-documentation-string-value-create (widget)
 306   ;; Insert documentation string.
 307   (let ((doc (widget-value widget))
 308         (indent (widget-get widget :indent))
 309         (shown (widget-get (widget-get widget :parent) :documentation-shown))
 310         (start (point)))
 311     (if (string-match "\n" doc)
 312         (let ((before (substring doc 0 (match-beginning 0)))
 313               (after (substring doc (match-beginning 0)))
 314               button)
 315           (when (and indent (not (zerop indent)))
 316             (insert-char ?\s indent))
 317           (insert before ?\s)
 318           (widget-documentation-link-add widget start (point))
 319           (setq button
 320                 (widget-create-child-and-convert
 321                  widget (widget-get widget :visibility-widget)
 322                  :help-echo "Show or hide rest of the documentation."
 323                  :on "Hide Rest"
 324                  :off "More"
 325                  :always-active t
 326                  :action 'widget-parent-action
 327                  shown))
 328           (when shown
 329             (setq start (point))
 330             (when (and indent (not (zerop indent)))
 331               (insert-char ?\s indent))
 332             (insert after)
 333             (widget-documentation-link-add widget start (point))
 334             (cusnu-make-xrefs start (point))
 335             )
 336           (widget-put widget :buttons (list button)))
 337       (when (and indent (not (zerop indent)))
 338         (insert-char ?\s indent))
 339       (insert doc)
 340       (widget-documentation-link-add widget start (point))))
 341   (insert ?\n))
 342 (defun cusnu-help-xref-button (match-number type what &rest args)
 343   (let ((beg (match-beginning match-number))
 344         (end (match-end match-number)))
 345   (if nil
 346       (let ((ovl (make-overlay beg end)))
 347         (overlay-put ovl 'face 'highlight))
 348     (let* ((tag (match-string match-number))
 349            (value what)
 350             (wid-type (cond
 351                        ((eq type 'help-variable)
 352                         'variable-link)
 353                        ((eq type 'help-function)
 354                         'function-link)
 355                        ((eq type 'help-info)
 356                         'custom-manual)
 357                        (t nil)))
 358           )
 359       (when wid-type
 360         (delete-region beg end)
 361         (backward-char)
 362         ;;(tag action active help icon)
 363         (widget-create wid-type
 364                        ;;tag
 365                        :value value
 366                        :tag tag
 367                        :keymap custom-mode-link-map
 368                        :follow-link 'mouse-face
 369                        :button-face 'custom-link
 370                        :mouse-face 'highlight
 371                        :pressed-face 'highlight
 372                        ;;:help-echo help
 373                        )))))
 374     )
 375
 376 ;; Override default ... ;-)
 377 (define-widget 'documentation-link 'link
 378   "Link type used in documentation strings."
 379   ;;:tab-order -1
 380   :help-echo "Describe this symbol"
 381   :button-face 'custom-link
 382   :action 'widget-documentation-link-action)
 383
 384 (defun cusnu-xref-niy (&rest ignore)
 385   (message "Not implemented yet"))
 386
 387 (defun cusnu-describe-function (wid &rest ignore)
 388   (let ((fun (widget-get wid :what))
 389         )
 390     (describe-function fun)))
 391
 392 (defun cusnu-help-insert-xrefs (help-xref-button)
 393   ;; The following should probably be abstracted out.
 394   (unwind-protect
 395       (progn
 396         ;; Info references
 397         (save-excursion
 398           (while (re-search-forward help-xref-info-regexp nil t)
 399             (let ((data (match-string 2)))
 400               (save-match-data
 401                 (unless (string-match "^([^)]+)" data)
 402                   (setq data (concat "(emacs)" data))))
 403               (funcall help-xref-button 2 'help-info data))))
 404         ;; URLs
 405         (save-excursion
 406           (while (re-search-forward help-xref-url-regexp nil t)
 407             (let ((data (match-string 1)))
 408               (funcall help-xref-button 1 'help-url data))))
 409         ;; Mule related keywords.  Do this before trying
 410         ;; `help-xref-symbol-regexp' because some of Mule
 411         ;; keywords have variable or function definitions.
 412         (if help-xref-mule-regexp
 413             (save-excursion
 414               (while (re-search-forward help-xref-mule-regexp nil t)
 415                 (let* ((data (match-string 7))
 416                        (sym (intern-soft data)))
 417                   (cond
 418                    ((match-string 3) ; coding system
 419                     (and sym (coding-system-p sym)
 420                          (funcall help-xref-button 6 'help-coding-system sym)))
 421                    ((match-string 4) ; input method
 422                     (and (assoc data input-method-alist)
 423                          (funcall help-xref-button 7 'help-input-method data)))
 424                    ((or (match-string 5) (match-string 6)) ; charset
 425                     (and sym (charsetp sym)
 426                          (funcall help-xref-button 7 'help-character-set sym)))
 427                    ((assoc data input-method-alist)
 428                     (funcall help-xref-button 7 'help-character-set data))
 429                    ((and sym (coding-system-p sym))
 430                     (funcall help-xref-button 7 'help-coding-system sym))
 431                    ((and sym (charsetp sym))
 432                     (funcall help-xref-button 7 'help-character-set sym)))))))
 433         ;; Quoted symbols
 434         (save-excursion
 435           (while (re-search-forward help-xref-symbol-regexp nil t)
 436             (let* ((data (match-string 8))
 437                    (sym (intern-soft data)))
 438               (if sym
 439                   (cond
 440                    ((match-string 3)  ; `variable' &c
 441                     (and (or (boundp sym) ; `variable' doesn't ensure
 442                                         ; it's actually bound
 443                              (get sym 'variable-documentation))
 444                          (funcall help-xref-button 8 'help-variable sym)))
 445                    ((match-string 4)   ; `function' &c
 446                     (and (fboundp sym) ; similarly
 447                          (funcall help-xref-button 8 'help-function sym)))
 448                    ((match-string 5) ; `face'
 449                     (and (facep sym)
 450                          (funcall help-xref-button 8 'help-face sym)))
 451                    ((match-string 6)) ; nothing for `symbol'
 452                    ((match-string 7)
 453 ;;;  this used:
 454 ;;;                       #'(lambda (arg)
 455 ;;;                           (let ((location
 456 ;;;                                  (find-function-noselect arg)))
 457 ;;;                             (pop-to-buffer (car location))
 458 ;;;                             (goto-char (cdr location))))
 459                     (funcall help-xref-button 8 'help-function-def sym))
 460                    ((and
 461                      (facep sym)
 462                      (save-match-data (looking-at "[ \t\n]+face\\W")))
 463                     (funcall help-xref-button 8 'help-face sym))
 464                    ((and (or (boundp sym)
 465                              (get sym 'variable-documentation))
 466                          (fboundp sym))
 467                     ;; We can't intuit whether to use the
 468                     ;; variable or function doc -- supply both.
 469                     (funcall help-xref-button 8 'help-symbol sym))
 470                    ((and
 471                      (or (boundp sym)
 472                          (get sym 'variable-documentation))
 473                      (or
 474                       (documentation-property
 475                        sym 'variable-documentation)
 476                       (condition-case nil
 477                           (documentation-property
 478                            (indirect-variable sym)
 479                            'variable-documentation)
 480                         (cyclic-variable-indirection nil))))
 481                     (funcall help-xref-button 8 'help-variable sym))
 482                    ((fboundp sym)
 483                     (funcall help-xref-button 8 'help-function sym)))))))
 484         ;; An obvious case of a key substitution:
 485         (save-excursion
 486           (while (re-search-forward
 487                   ;; Assume command name is only word and symbol
 488                   ;; characters to get things like `use M-x foo->bar'.
 489                   ;; Command required to end with word constituent
 490                   ;; to avoid `.' at end of a sentence.
 491                   "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
 492             (let ((sym (intern-soft (match-string 1))))
 493               (if (fboundp sym)
 494                   (funcall help-xref-button 1 'help-function sym)))))
 495         ;; Look for commands in whole keymap substitutions:
 496         (save-excursion
 497           ;; Make sure to find the first keymap.
 498           (goto-char (point-min))
 499           ;; Find a header and the column at which the command
 500           ;; name will be found.
 501
 502           ;; If the keymap substitution isn't the last thing in
 503           ;; the doc string, and if there is anything on the
 504           ;; same line after it, this code won't recognize the end of it.
 505           (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
 506                                     nil t)
 507             (let ((col (- (match-end 1) (match-beginning 1))))
 508               (while
 509                   (and (not (eobp))
 510                        ;; Stop at a pair of blank lines.
 511                        (not (looking-at "\n\\s-*\n")))
 512                 ;; Skip a single blank line.
 513                 (and (eolp) (forward-line))
 514                 (end-of-line)
 515                 (skip-chars-backward "^ \t\n")
 516                 (if (and (>= (current-column) col)
 517                          (looking-at "\\(\\sw\\|\\s_\\)+$"))
 518                     (let ((sym (intern-soft (match-string 0))))
 519                       (if (fboundp sym)
 520                           (funcall help-xref-button 0 'help-function sym))))
 521                 (forward-line))))))
 522     ;;(set-syntax-table stab)
 523     ))
 524
 525 (defun cusnu-insert-options (options)
 526   (widget-insert "\n")
 527   (setq custom-options
 528         (append
 529          (if (= (length options) 1)
 530              (mapcar (lambda (entry)
 531                        (widget-create (nth 1 entry)
 532                                       ;;:documentation-shown t
 533                                       :custom-state 'unknown
 534                                       :tag (custom-unlispify-tag-name
 535                                             (nth 0 entry))
 536                                       :value (nth 0 entry)))
 537                      options)
 538            (let ((count 0)
 539                  (length (length options)))
 540              (mapcar (lambda (entry)
 541                        (prog2
 542                            (message "Creating customization items ...%2d%%"
 543                                     (/ (* 100.0 count) length))
 544                            (widget-create (nth 1 entry)
 545                                           :tag (custom-unlispify-tag-name
 546                                                 (nth 0 entry))
 547                                           :value (nth 0 entry))
 548                          (setq count (1+ count))
 549                          (unless (eq (preceding-char) ?\n)
 550                            (widget-insert "\n"))
 551                          (widget-insert "\n")))
 552                      options)))
 553          custom-options))
 554   (unless (eq (preceding-char) ?\n)
 555     (widget-insert "\n"))
 556   custom-options
 557   )
 558
 559 (defun cusnu-is-custom-obj (sym)
 560   "Return non-nil if symbol SYM is customizable."
 561   (or (get sym 'custom-type)
 562       (get sym 'face)
 563       (get sym 'custom-group)
 564       ))
 565
 566 (define-widget 'custom-symbol 'symbol
 567   "A customizable symbol."
 568   :prompt-match 'cusnu-is-custom-obj
 569   :prompt-history 'widget-variable-prompt-value-history
 570   :complete-function (lambda ()
 571                        (interactive)
 572                        (lisp-complete-symbol 'cusnu-is-custom-obj))
 573   :tag "Custom option")
 574
 575 (defun cusnu-set-my-skin-options (sym val)
 576   (set-default sym val)
 577   (let ((group (nth 0 val))
 578         (doc   (nth 1 val))
 579         (members (nth 2 val)))
 580     (custom-declare-group group nil doc)
 581     (put group 'custom-group nil)
 582     (dolist (opt members)
 583       (let ((type (cusnu-get-opt-main-type opt)))
 584         (when type
 585           (custom-add-to-group group opt type))))))
 586
 587 (defun cusnu-get-opt-main-type (opt)
 588   (when opt
 589     (cond ((get opt 'face) 'custom-face)
 590           ((get opt 'custom-type) 'custom-variable)
 591           ((get opt 'custom-group) 'custom-group))))
 592
 593 (defgroup all-my-loaded-skin-groups nil
 594   "All your loaded skin groups."
 595   :group 'environment
 596   :group 'convenience)
 597
 598 (defun cusnu-custom-group-p (symbol)
 599   (and (intern-soft symbol)
 600        (or (and (get symbol 'custom-loads)
 601                 (not (get symbol 'custom-autoload)))
 602            (get symbol 'custom-group))))
 603
 604 (defcustom cusnu-my-skin-options '(my-skin-group "My skin group.\n\n\n\n\n" nil)
 605   "Your custom skin-like options.
 606 The purpose of this variable is to provide for easy export a
 607 selection of variables you choose to set to other users.
 608
 609 To send these values to other users you export them to a file
 610 with `cusnu-export-my-skin-options'."
 611   :type '(list (symbol :tag "My custom group symbol name (should be specific to you)")
 612                (string :tag "My custom group description")
 613                (repeat :tag "Add your custom options below"
 614                        (custom-symbol :tag "My custom option")))
 615   :set 'cusnu-set-my-skin-options
 616   :group 'all-my-loaded-skin-groups)
 617
 618 ;;(cusnu-ring-bell "bell")
 619 (defun cusnu-ring-bell (format-string &rest args)
 620   (message "%s" (propertize (apply
 621                              'format format-string args) 'face 'secondary-selection))
 622   (ding)
 623   (throw 'bell nil))
 624
 625 ;;;###autoload
 626 (defun cusnu-export-my-skin-options (file)
 627   "Export to file FILE custom options in `cusnu-my-skin-options'.
 628 The options is exported to elisp code that other users can run to
 629 set the options that you have added to `cusnu-my-skin-options'.
 630
 631 For more information about this see `cusnu-export-cust-group'."
 632   (interactive '(nil))
 633   (catch 'bell
 634     (let ((grp (nth 0 cusnu-my-skin-options))
 635           buf)
 636       (let ((state (plist-get (cdr cusnu-my-skin-widget) :custom-state)))
 637         (case state
 638           ((set saved) nil) ;;(error "test, state=%s" state))
 639           (standard (cusnu-ring-bell "Please enter your options first"))
 640           (t (cusnu-ring-bell "My Skin Options must be saved or set, use the State button, %s" state))))
 641       (unless (nth 2 cusnu-my-skin-options)
 642         (cusnu-ring-bell "You have not added any of your options"))
 643       (unless file
 644         (setq file (read-file-name "Save to file: ")))
 645       (when (file-exists-p file)
 646         (cusnu-ring-bell "File %s already exists, choose another file name" file))
 647       (setq buf (find-file-other-window file))
 648       (with-current-buffer buf
 649         (unless (eq major-mode 'emacs-lisp-mode) (emacs-lisp-mode))
 650         (unless (file-exists-p (buffer-file-name))
 651           (erase-buffer)))
 652       (cusnu-export-cust-group grp buf))))
 653
 654 (defun cusnu-customize-my-skin-options ()
 655   (interactive)
 656   (customize-group-other-window (nth 0 cusnu-my-skin-options)))
 657
 658 (defun cusnu-reset-my-skin-options ()
 659   "Reset to my defaults for those options.
 660 "
 661   (interactive)
 662   (cusnu-reset-group-options-to-my-defaults (nth 0 cusnu-my-skin-options)))
 663
 664 (defun cusnu-reset-group-options-to-my-defaults (group)
 665   (dolist (sym-typ (get group 'custom-group))
 666     (let ((symbol (nth 0 sym-typ))
 667           ;;(type (cusnu-get-opt-main-type symbol))
 668           (type   (nth 1 sym-typ))
 669           defval)
 670       (cond
 671        ((eq type 'custom-variable)
 672         ;; First try reset to saved.
 673         (let* ((set (or (get symbol 'custom-set) 'set-default))
 674                (value (get symbol 'saved-value))
 675                (comment (get symbol 'saved-variable-comment)))
 676           (cond ((or comment value)
 677                  (put symbol 'variable-comment comment)
 678                  (custom-push-theme 'theme-value symbol 'user 'set (car-safe value))
 679                  (condition-case err
 680                      (funcall set symbol (eval (car value)))
 681                    (error (message "%s" err))))
 682                 ;; If symbol was not saved then reset to standard.
 683                 (t
 684                  (unless (get symbol 'standard-value)
 685                    (error "No standard setting known for %S" symbol))
 686                  (put symbol 'variable-comment nil)
 687                  (put symbol 'customized-value nil)
 688                  (put symbol 'customized-variable-comment nil)
 689                  (custom-push-theme 'theme-value symbol 'user 'reset)
 690                  (custom-theme-recalc-variable symbol)
 691                  (put symbol 'saved-value nil)
 692                  (put symbol 'saved-variable-comment nil)
 693                  ))))
 694        ((eq type 'custom-face)
 695         ;; First try reset to saved
 696         (let* ((value (get symbol 'saved-face))
 697                (comment (get symbol 'saved-face-comment)))
 698           (cond ((or value comment)
 699                  (put symbol 'customized-face nil)
 700                  (put symbol 'customized-face-comment nil)
 701                  (custom-push-theme 'theme-face symbol 'user 'set value)
 702                  (face-spec-set symbol value t)
 703                  (put symbol 'face-comment comment))
 704                 ;; If symbol was not saved then reset to standard.
 705                 (t
 706                  (setq value (get symbol 'face-defface-spec))
 707                  (unless value
 708                    (error "No standard setting for this face"))
 709                  (put symbol 'customized-face nil)
 710                  (put symbol 'customized-face-comment nil)
 711                  (custom-push-theme 'theme-face symbol 'user 'reset)
 712                  (face-spec-set symbol value t)
 713                  (custom-theme-recalc-face symbol)
 714                  ;; Do this later.
 715                  (put symbol 'saved-face nil)
 716                  (put symbol 'saved-face-comment nil)
 717                  ))))
 718        (t (error "not iy"))))))
 719
 720 (defun cusnu-export-cust-group (group buf)
 721   "Export custom group GROUP to end of buffer BUF.
 722 Only the options that has been customized will be exported.
 723
 724 The group is exported as elisp code.  Running the code will
 725 create a group with just those members.  After this it opens a
 726 customization buffer with the new group.
 727
 728 The code will also set the options to the customized values, but
 729 it will not save them in the users init file.
 730
 731 See also the comment in the exported file."
 732   (let (start
 733         (doc (get group 'group-documentation))
 734         groups options faces
 735         (members (mapcar (lambda (rec)
 736                            (car rec))
 737                          (get group 'custom-group))))
 738     (with-current-buffer buf
 739       (insert (format-time-string ";; Here is my skin custom group %Y-%m-%d.\n"))
 740       (font-lock-mode 1)
 741       (insert (format ";;;;;; Customization group name:  %s\n" group))
 742       (insert ";;\n")
 743       (let ((here (point)))
 744         (insert doc "\n")
 745         (comment-region here (point))
 746         (fill-region here (point)))
 747       (cusnu-get-options-and-faces members 'groups 'options 'faces)
 748       (unless (or options faces)
 749         (cusnu-ring-bell "There are no options or faces in %s customized by you" group))
 750       (insert "
 751 ;; This file defines the group and sets the options in it, but does
 752 ;; not save the values to your init file.
 753 ;;
 754 ;; To set the values evaluate this file.  To do that open this file in Emacs and to
 755 ;;
 756 ;;   M-x eval-buffer
 757 ;;
 758 ;; To go back to your default evaluate next line (place point at the end and to C-x C-e):
 759 ")
 760       (insert (format ";; (cusnu-reset-group-options-to-my-defaults '%s)\n\n"  group))
 761       (insert (format "(let ((grp '%s))\n" group))
 762       (insert (format "  (custom-declare-group grp nil %S)\n" doc))
 763       (insert "  (put grp 'custom-group nil)\n")
 764       (insert (format "  (custom-add-to-group 'all-my-loaded-skin-groups '%s 'custom-group)\n" group))
 765       (dolist (opt members)
 766         (let ((type (cusnu-get-opt-main-type opt)))
 767           (when type
 768             (insert (format "  (custom-add-to-group grp '%s '%s)\n"
 769                             opt type)))))
 770       (insert "  (custom-set-variables\n")
 771       (dolist (opt options)
 772         (let ((my-val (or (get opt 'saved-value)
 773                           (get opt 'customized-value))))
 774           (when my-val
 775             (insert (format "   '(%s %S)\n" opt (custom-quote (symbol-value opt)))))))
 776       (insert "   )\n")
 777       (insert "  (custom-set-faces\n")
 778       (dolist (opt faces)
 779         (let ((my-val (get opt 'customized-face)))
 780           (when my-val
 781             (insert (format "   '(%s %S)\n" opt my-val)))))
 782       (insert "   ))\n")
 783       (insert (format "\n(customize-group '%s)\n" group))
 784       )))
 785
 786 (defun cusnu-get-options-and-faces (members groups-par options-par faces-par)
 787   (dolist (sym members)
 788     (insert (format ";; sym=%s\n" sym))
 789     (cond ((and (get sym 'custom-type)
 790            (or (get sym 'saved-value)
 791                (get sym 'customize-value)))
 792            (add-to-list options-par sym))
 793           ((and (get sym 'face)
 794                 (get sym 'customized-face))
 795            (add-to-list faces-par sym))
 796           ((get sym 'custom-group)
 797            (unless (memq sym groups-par) ;; Don't loop
 798              (cusnu-get-options-and-faces groups-par options-par faces-par)))
 799           (t (insert ";; Not a custom variable or face: %s\n" sym)))))
 800
 801 (provide 'cus-new-user)
 802 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 803 ;;; cus-new-user.el ends here