(defun my-diff-detect-coding-system (file)
  "FILEのcoding systemを返す。分からなかったらnilを返す。"
  (let ((cs
         (when (file-regular-p file) ;;ディレクトリは除外する
           (with-temp-buffer
             (insert-file-contents file nil nil 1000000) ;;1MBくらい読んでおく?
             ;; これが一番簡単で確実っぽい
             last-coding-system-used))))
    (message "Detected coding system: %s" cs)
    (unless (memq cs '(nil undecided no-conversion)) ;;変なのは返さない
      cs)))

(defun my-diff-around (orig-fun old new &rest args)
  "diffにひっかけるaroundアドバイス。"
  ;; NEWのcoding systemに合わせてdiffを取る
  (let ((coding-system-for-read (or coding-system-for-read ;;すでに指定されている場合はそれを使う
                                    (my-diff-detect-coding-system new))))
    (apply orig-fun old new args)))

(advice-add 'diff :around 'my-diff-around)

;; 使用例:
;; (my-hogehoge-function
;;   1
;;   2
;;   3)

(defun my-hogehoge-function (a b c)
  (+ a b c))

;; my-elisp.el

(defun my-elisp-beginning-of-continuous-comments ()
  "現在の連続コメントの先頭を返す。

連続コメントとは、連続改行(空行)を除く空白文字のみで区切られた複
数のコメントのまとまりを指す。そのまとまりの最初の;の位置を返す。

例:
123 ;; line-1
    ;; line-2

    ;; line-3

「line-3」の末尾の場合「;; line-3」の先頭、「line-2」の末尾の場合
「;; line-1」の先頭の位置を返す。

各行;;の先頭はコメントに含まれない。

現在のポイントがコメント内ではない場合nilを返す。

文字列の中の;;には反応しない。
例:
\"
;; line-1 ←ここで実行してもnilを返す。コメントでは無く文字列の中なので。
\"

(以下追記)
同じコメントスタートに限定するかは迷うところ。
 ;; (+
;;     2
;;;    3)
みたいなのも現状では受け入れる。

    ;; line-1
123 ;; line-2
    ;; line-3
みたいなのは無理(;; line-2が先頭になる)。
対応できないことは無いだろうけど
そもそもコメントの前に何かある場合も対応する必要があるかは疑問。

理想的にはコメント開始の水平位置と;の数が揃っている連続行を
抽出すべきなのだと思う。"
  (cond
   ((derived-mode-p 'emacs-lisp-mode)
    (save-excursion
      (let (beginning-of-comment)
        (while (and (comment-beginning)
                    (progn
                      (skip-chars-backward " \t")
                      (skip-chars-backward ";")
                      (setq beginning-of-comment (point))
                      (skip-chars-backward " \t")
                      (bolp))
                    (not (bobp)))
          (backward-char))
        beginning-of-comment)))
   (t
    (save-excursion
      ;; TODO: 現在のメジャーモードでのコメントが先頭にある場合はそれも無視すべき？
      ;; TODO: 「123 ;; (if」から複数行に続く形式に対応していない。123の部分にコメント以外のセミコロン(文字列等)があることを考慮しなければならない。
      (let (beginning-of-comment)
        (forward-line 0)
        (while (looking-at "[ \t]*;+[ \t]*")
          (setq beginning-of-comment (match-end 0))
          (forward-line -1))
        beginning-of-comment)))))

(defun my-elisp-sexp-in-comment (beg end)
  "BEGからENDの中にあるコメントの中にあるS式を返す。"
  (when (and beg end (< beg end))
    (let ((original-buf (current-buffer)))
      (with-temp-buffer
        (emacs-lisp-mode)
        (insert-buffer-substring original-buf beg end)
        (goto-char (point-min))
        ;; ↓これだと最終行のコメントが空でかつEOBの時になぜか「Beginning of buffer」のエラーが出る。
        ;; (uncomment-region (point-min) (point-max))
        (while (re-search-forward "^\\s-*;+" nil t)
          (replace-match "")
          ;; 次の行へ(現在の行にある残りのコメント中コメントは残す)。
          (forward-line 1))
        (goto-char (point-max))
        ;; 1段階コメントを外した後の状態からS式を取り出す。
        ;; コメントの中にコメントがある場合は、
        ;; 再帰的にこの関数が呼び出されることもある。
        ;; ;; ;; (+
        ;; ;; ;;  ;; コメント
        ;; ;; ;;  1 2)
        ;; みたいなのも正しく処理する。
        (elisp--preceding-sexp)))))

(defun my-elisp-preceding-sexp-in-comment ()
  "ポイントがコメント内にあるとき、複数行にわたるコメントを考慮して
ポイントの直前にあるS式を読み取る。"
  (my-elisp-sexp-in-comment (my-elisp-beginning-of-continuous-comments) (point)))

(defun my-elisp-preceding-sexp-around (orig-fun &rest args)
  "elisp--preceding-sexpの:around advice。"
  (let ((end (point))
        (beg (my-elisp-beginning-of-continuous-comments)))
    (if (and beg (< beg end))
        (my-elisp-sexp-in-comment beg end)
      (apply orig-fun args))))

(provide 'my-elisp)

(when (version<= "25.1" emacs-version) ;; Require #'elisp--preceding-sexp
  (autoload 'my-elisp-preceding-sexp-around "my-elisp")
  (advice-add 'elisp--preceding-sexp :around 'my-elisp-preceding-sexp-around))

(define-widget 'custom-face-edit 'checklist
  "Widget for editing face attributes.
The following properties have special meanings for this widget:

:value is a plist of face attributes.

:default-face-attributes, if non-nil, is a plist of defaults for
face attributes (as specified by a `default' defface entry)."
  :format "%v"
  :extra-offset 3
  :button-args '(:help-echo "Control whether this attribute has any effect.")
  :value-to-internal 'custom-face-edit-fix-value
  :match (lambda (widget value)
           (widget-checklist-match widget
                                   (custom-face-edit-fix-value widget value)))
  :value-create 'custom-face-edit-value-create
  :convert-widget 'custom-face-edit-convert-widget
  :args (mapcar (lambda (att)
                  (list 'group :inline t
                        :format "%v"
                        :sibling-args (widget-get (nth 1 att) :sibling-args)
                        (list 'const :format "" :value (nth 0 att))
                        (nth 1 att)))
                custom-face-attributes))

(progn
  (pop-to-buffer (generate-new-buffer "*Widget Example*"))
  (widget-create 'checklist
                 :value '("Second" t) ;;初期値
                 :notify (lambda (widget &rest _)
                           (message "通知 value=%s" (widget-value widget)))
                 ;;以下args
                 '(const "First")
                 '(const "Second")
                 '(boolean :on "有効" :off "無効")
                 '(number :value 123))
  (use-local-map widget-keymap)
  (widget-setup))

(defun custom-face-edit-value-create (widget)
  (let* ((alist (widget-checklist-match-find
                 widget (widget-get widget :value)))
         (args  (widget-get widget :args))
         (show-all (widget-get widget :show-all-attributes))
         (buttons  (widget-get widget :buttons))
         (defaults (widget-checklist-match-find
                    widget
                    (widget-get widget :default-face-attributes)))
         entry)
    ;; 改行と空白の挿入
    (unless (looking-back "^ *" (line-beginning-position))
      (insert ?\n))
    (insert-char ?\s (widget-get widget :extra-offset)) ;;注意:nilのとき1文字挿入してしまう。バグ？　仕様？
    ;; 値部分の挿入
    (if (or alist defaults show-all)
        (dolist (prop args)
          (setq entry (or (assq prop alist)
                          (assq prop defaults)))
          (if (or entry show-all)
              (widget-checklist-add-item widget prop entry)))
      (insert (propertize "-- Empty face --" 'face 'shadow) ?\n))
    ;; 未使用属性を隠す/表示するボタン
    (let ((indent (widget-get widget :indent)))
      (if indent (insert-char ?\s (widget-get widget :indent))))
    (push (widget-create-child-and-convert
           widget 'visibility
           :help-echo "Show or hide all face attributes."
           :button-face 'custom-visibility
           :pressed-face 'custom-visibility
           :mouse-face 'highlight
           :on "Hide Unused Attributes"    :off "Show All Attributes"
           :on-glyph nil :off-glyph nil
           :always-active t
           :action 'custom-face-edit-value-visibility-action
           show-all)
          buttons)
    (insert ?\n)
    ;; ボタンと子供達を記録
    (widget-put widget :buttons buttons)
    (widget-put widget :children (nreverse (widget-get widget :children)))))

(defun custom-face-edit-convert-widget (widget)
  "Convert :args as widget types in WIDGET."
  (widget-put
   widget
   :args (mapcar (lambda (arg)
                   (widget-convert arg
                                   :deactivate 'custom-face-edit-deactivate
                                   :activate 'custom-face-edit-activate
                                   :delete 'custom-face-edit-delete))
                 (widget-get widget :args)))
  widget)

  :args (mapcar (lambda (att)
                  (list 'group :inline t
                        :format "%v"
                        :sibling-args (widget-get (nth 1 att) :sibling-args)
                        (list 'const :format "" :value (nth 0 att))
                        (nth 1 att)))
                custom-face-attributes)

(
 (group :inline t :format "%v" :sibling-args nil (const :format "" :value :family) (string :tag "Font Family" :help-echo "Font family or fontset alias name."))
 (group :inline t :format "%v" :sibling-args nil (const :format "" :value :foundry) (string :tag "Font Foundry" :help-echo "Font foundry name."))
 (group :inline t :format "%v" :sibling-args nil (const :format "" :value :width)
        (choice :tag "Width" :help-echo "Font width." :value normal (const :tag "compressed" condensed) (const :tag "condensed" condensed) ...))
 ...
)

(progn
  (require 'edraw-widget)
  (pop-to-buffer (generate-new-buffer "*Widget Example*"))
  (widget-create 'edraw-attribute-alist
                 :tag "Props"
                 :format "%v"
                 :notify
                 (lambda (w &rest _) (message "%s" (prin1-to-string (widget-value w))))
                 ;; :greedy nil ←未知の値の扱いに関わる(デフォルトはtにしてある)
                 :value '((stroke-width . 123.45) (stroke . "red") (unknown . "uval") (fill . "green"))
                 '(fill
                   (string :tag "Fill"))
                 '(stroke
                   (string :tag "Stroke"))
                 '(stroke-width
                   (number :tag "Stroke Width"))
                 '(stroke-join
                   (choice :tag "Stroke Join"
                           :value "miter"
                           (const "miter")
                           (const "round")
                           (const "bevel"))))
  (use-local-map widget-keymap)
  (widget-setup))

(require 'edraw-widget)
(defcustom my-hogehoge-properties
  '((stroke-width . 123.45) (stroke . "red") (fill . "green"))
  "Hoge Hoge no Properties."
  :type '(edraw-attribute-alist
          :tag "My Hogehoge Properties"
          (fill
           (string :tag "Fill"))
          (stroke
           (string :tag "Stroke"))
          (stroke-width
           (number :tag "Stroke Width"))
          (stroke-join
           (choice :tag "Stroke Join"
                   :value "miter"
                   (const "miter")
                   (const "round")
                   (const "bevel")))))

(define-widget 'color 'editable-field
  "Choose a color name (with sample)."
  :format "%{%t%}: %v (%{sample%})\n"
  :value-create 'widget-color-value-create
  :size (1+ (apply #'max 13 ; Longest RGB hex string.
                   (mapcar #'length (defined-colors))))
  :tag "Color"
  :value "black"
  :completions (defined-colors)
  :sample-face-get 'widget-color-sample-face-get
  :notify 'widget-color-notify
  :match #'widget-color-match
  :validate #'widget-color-validate
  :action 'widget-color-action)

;; 実装にはedraw-color.elやedraw-color-picker.elの助けを借ります。
;; https://github.com/misohena/el-easydraw/blob/master/edraw-color.el
;; https://github.com/misohena/el-easydraw/blob/master/edraw-color-picker.el
(require 'edraw-color)
(require 'edraw-color-picker)

(define-widget 'my-web-color 'editable-field
  "Choose a web color (with sample)."
  :value "black"
  ;; タグ: 値 サンプル
  :format "%{%t%}: %v %{      %}\n"
  ;; デフォルトのタグ(%t部分)
  :tag "Color"
  ;; 値部分の作成(%v部分)
  :value-create 'my-widget-web-color-value-create
  :size 26 ;; rgba(255,255,255,1.2345)くらいが収まる長さにしておく
  ;; 補完候補(C-M-i (M-TAB)で補完候補を出せる)
  :completions (mapcar #'car edraw-color-web-keywords)
  ;; 見本部分のface
  :sample-face-get 'my-widget-web-color-sample-face-get
  ;; 見本の更新
  :notify 'my-widget-web-color-notify
  ;; 値の検証
  :match #'my-widget-web-color-match
  :validate #'my-widget-web-color-validate
  ;; ミニバッファからの入力
  :action 'my-widget-web-color-action)

(defun my-widget-web-color-value-create (widget)
  ;; 値を表す部分(:formatの%v部分)をバッファ上に作成します。

  ;; editable-fieldとしての部分を作成。
  (widget-field-value-create widget)
  (widget-insert " ")
  ;; その後にChooseボタンを追加。
  (widget-create-child-and-convert
   widget 'push-button
   :tag " Choose " :action 'my-widget-web-color--choose-action)
  (widget-insert " "))

(defun my-widget-web-color--choose-action (widget &optional _event)
  ;; Chooseボタンが押されたら呼び出されます。
  ;; カラーピッカーで色を入力してもらい、それを親widgetの値として設定します。
  (let* ((wp (widget-get widget :parent))
         (old-color (widget-value wp))
         (new-color (edraw-color-picker-read-color nil old-color)))
    (widget-value-set wp new-color)))

(defun my-widget-web-color-sample-face-get (widget)
  ;; 見本部分(:formatの%{から%}までの間)に適用するfaceを返します。
  (let ((color (condition-case nil
                   (edraw-color-from-string (widget-value widget))
                 (error (widget-get widget :value)))))
    (if color
        (list (cons 'background-color (edraw-to-string-hex (edraw-change-a color 1.0)))) ;; 半透明が表現できないので無理矢理不透明にします。本当はSVGで市松模様背景付きのサンプルを作りたい所。
      'default)))

(defun my-widget-web-color-action (widget &optional event)
  "Prompt for a color."
  ;; フィールド上でRETを押したときに呼び出されます。
  ;; ミニバッファから色を入力してもらい、それをwidgetの値として設定します。
  (let* ((old-color (widget-value widget))
         (new-color (edraw-color-picker-read-color nil old-color)))
    (when new-color
      (widget-value-set widget new-color)
      (widget-setup)
      (widget-apply widget :notify widget event))))

(defun my-widget-web-color-notify (widget child &optional event)
  "Update the sample, and notify the parent."
  ;; 何かイベントが発生したときに呼び出されます。
  ;; たいていの場合テキストが変化したときなので、サンプルのfaceを更新します。
  (overlay-put (widget-get widget :sample-overlay)
               'face (widget-apply widget :sample-face-get))
  (widget-default-notify widget child event))

(defun my-widget-web-color-match (_widget value)
  ;; WIDGETにVALUEを設定可能なら非nilを返します。
  (and (stringp value)
       (or (assoc value edraw-color-web-keywords)
           (string-match edraw-color-string-patterns-re value))))

(defun my-widget-web-color-validate (widget)
  ;; WIDGETの現在の値が正当かチェックします。
  ;; エラーがなければnilを返します。
  (let ((value (widget-value widget)))
    (unless (my-widget-web-color-match widget value)
      (widget-put widget :error (format "Invalid color: %S" value))
      widget)))

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-insert "\n")
(widget-create 'my-web-color
               :tag "色"
               "black")
(use-local-map widget-keymap)
(widget-setup)

(defcustom my-hogehoge-color "#ff0000"
  "My Hogehoge HTML color."
  :type 'my-web-color)

(defun my-hogehoge-html ()
  (format "<span style=\"color: %s\">hogehoge</span>" my-hogehoge-color))

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-create 'url-link
               :tag "GNUのWebサイト"
               "https://www.gnu.org/")
(widget-setup)

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-create 'push-button
               :action (lambda (widget &optional _event)
                         (message "押された value=%s" (widget-value widget)))
               :tag "押して"
               "何かの値")
(use-local-map widget-keymap) ;; これが無いと押せない。linkは押せるのに
(widget-setup)

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-create 'list
               :tag "何かの固定長固定型のリスト"
               :notify (lambda (widget &rest args)
                         (message "通知 value=%s" (widget-value widget)))
               '(const "何かの固定値")
               '(boolean :tag "何かの真偽値" :on "有効" :off "無効")
               '(text :tag "好きな複数行文字列" :value "hogehoge"))
(use-local-map widget-keymap)
(widget-setup)

(let ((syms))
  (mapatoms (lambda (s) (when (get s 'widget-type) (push s syms))) obarray)
  syms)

(define-widget 'url-link 'link
  "A link to a web page."
  :action 'widget-url-link-action)

(define-widget 'link 'item
  "An embedded link."
  :button-prefix 'widget-link-prefix
  :button-suffix 'widget-link-suffix
  :follow-link 'mouse-face
  :keymap widget-link-keymap
  :help-echo "Follow the link."
  :format "%[%t%]")

(define-widget 'item 'default
  "Constant items for inclusion in other widgets."
  :convert-widget 'widget-value-convert-widget ;; 引数列をwidgetオブジェクトへ変換する
  :value-create 'widget-item-value-create ;; :formatの%v部分として、:valueの値をprincでバッファへ挿入する
  :value-delete 'ignore
  :value-get 'widget-value-value-get ;; :valueの値をそのまま返す
  :match 'widget-item-match
  :match-inline 'widget-item-match-inline
  :action 'widget-item-action ;; 自分自身に対して :notify を呼び出す
  :format "%t\n")

(define-widget 'default nil
  "Basic widget other widgets are derived from."
  :value-to-internal (lambda (_widget value) value)
  :value-to-external (lambda (_widget value) value)
  :button-prefix 'widget-button-prefix
  :button-suffix 'widget-button-suffix
  :completions-function #'widget-default-completions
  :create 'widget-default-create ;; :format等に従ってテキストやオーバーレイなどをバッファへ挿入する。
  :indent nil
  :offset 0
  :format-handler 'widget-default-format-handler ;; :formatに知らないエスケープ文字がある場合に呼ばれる
  :button-face-get 'widget-default-button-face-get
  :mouse-face-get 'widget-default-mouse-face-get
  :sample-face-get 'widget-default-sample-face-get
  :delete 'widget-default-delete ;; バッファからwidgetの全テキストを削除する
  :copy 'identity
  :value-set 'widget-default-value-set
  :value-inline 'widget-default-value-inline
  :value-delete 'ignore ;; :value-createで挿入したものを削除する
  ;; :value-create で :format の %v 部分をバッファへ挿入する
  :default-get 'widget-default-default-get
  :menu-tag-get 'widget-default-menu-tag-get
  :validate #'ignore ;; widgetの現在値が正当かチェックする
  :active 'widget-default-active
  :activate 'widget-specify-active
  :deactivate 'widget-default-deactivate
  :mouse-down-action #'ignore
  :action 'widget-default-action
  :notify 'widget-default-notify
  :prompt-value 'widget-default-prompt-value)