;;; 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:

;;(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*")))
    (Custom-mode)
    (erase-buffer)
    (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.

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")

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;; 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))
      (widget-insert "\n")

      ;; CUA Mode
      (cusnu-insert-options '((cua-mode custom-variable)))

      ;; Viper Mode
      (widget-insert "\n")
      (widget-insert (propertize "Viper Mode" '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'.
")
      (fill-region fill-pos (point))

      (cusnu-make-xrefs)
      )))

(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))
    (goto-char (point-min))
    (cusnu-help-insert-xrefs 'cusnu-help-xref-button)))

(defun cusnu-help-xref-button (match-number type &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))
          (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
                       :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)
  (buffer-disable-undo)
  (setq custom-options
	(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))))
  (unless (eq (preceding-char) ?\n)
    (widget-insert "\n"))
  )

(provide 'cus-new-user)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; cus-new-user.el ends here