カラ〜リング

Last modified: "2003/08/17 07:27:49"

Table of contents


いろいろ

拡張子に合わせ背景色を変更

xyzzy Part5 282 より。

(add-hook '*find-file-hooks*
          #'(lambda () 
              (let ((ext (pathname-type (get-buffer-file-name (selected-buffer))))) 
                (cond 
                 ((or (equal ext "pl")
                      (equal ext "rb"))  (set-buffer-colors #(0 #xe0ffe0)))
                 ((or (equal ext "html")
                      (equal ext "htm")
                      (equal ext "ihtml")
                      (equal ext "xml")) (set-buffer-colors #(0 #xffe0e0)))
                 ((or (equal ext "php")
                      (equal ext "php3")
                      (equal ext "phtml")
                      (equal ext "inc")) (set-buffer-colors #(0 #xe0ffff)))
                 ((or (equal ext "sql")
                      (equal ext "css")) (set-buffer-colors #(0 #xe0e0ff)))
                 ))))

バッファ毎に色指定

xyzzy Part7 420 より。「色指定については横に長くなりすぎるので途中までしか書いていません。」とのこと。

(add-hook '*find-file-hooks* 'change-color)
(setq *color-mode* 2)
(defun change-color()
  (interactive)
  (cond
   ;                                        文字色   背景色   制御文字 選択文字 選択背景
   ((= *color-mode* 1) (set-buffer-colors #(#x000000 #xd7d7d7 #x008080 #xffffff #x808000 )))
   ((= *color-mode* 2) (set-buffer-colors #(#xd7d7d7 #x000000 #x008080 #xffffff #xd7d7d7 )))
   (t                  (set-buffer-colors #(#x000000 #xd7d7d7 #x008080 #xffffff #x808000 ))))
  (refresh-screen))

以下、そのまま引用。

ところで xyzzy.ini に書かれている色指定は 7 桁の 16 進数で指定されている物があり
7 桁の場合は先頭の桁が Windows 配色を参照しているようですね。
従って、配色を変えている場合は環境に依存することがあるかと。

上記を使い「みんなの楽しい色設定」を試す


テキストに色付け

[xyzzy:05281](山本 真二さん), [xyzzy:05291](亀井さん) より。Shift + 右クリックでメニューが表示される。 私の場合、text-mode でしか色付けしないので、text-mode の場合のみバッファを閉じるとき色保存している。

長いので、別ファイルにして使っている。

(defvar *color-popup-menu* nil)
(unless *color-popup-menu*
  (setq *color-popup-menu*
        (define-popup-menu
          (:item nil "既定色(&0)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 0 :background 0))
           :selection)
          (:item nil "赤(&1)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 1))
           :selection)
          (:item nil "青(&2)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 4))
           :selection)
          (:item nil "緑(&2)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 10))
           :selection)
          (:item nil "灰色(&2)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 15))
           :selection)
          :sep
          (:item nil "太赤(&1)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 1 :bold t))
           :selection)
          (:item nil "太青(&2)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 4 :bold t))
           :selection)
          (:item nil "太緑(&2)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 10 :bold t))
           :selection)
          :sep
          (:item nil "下線(&3)"
           #'(lambda () (interactive)
               (color-string-selection :underline t))
           :selection)
          (:item nil "取消し線(&4)"
           #'(lambda () (interactive)
               (color-string-selection :strike-out t))
           :selection)
          (:item nil "赤+下線(&5)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 1 :underline t))
           :selection)
          (:item nil "青+取消し線(&6)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 4 :strike-out t))
           :selection)
          :sep
          ; 背景色9は、水色にしとく。
   (:item nil "たぶん背景水色(&7)"
           #'(lambda () (interactive)
               (color-string-selection :background 9))
           :selection)
          (:item nil "前景:黒, 背景:黄緑(&8)"
           #'(lambda () (interactive)
               (color-string-selection :foreground 2 :background 8))
           :selection)
          :sep
          (:item nil "色削除(&C)" 'clear-color-string-and-save-color-list
           #'(lambda () (unless (get-buffer-file-name) :disable)))
          ;text-mode 以外で、色付けを保存したい場合に
   (:item nil "色保存(&S)" 'save-color-list
           #'(lambda () (unless (get-buffer-file-name) :disable)))
          )))

(global-set-key #\S-RBtnDown 'color-string-popup)

(add-hook '*find-file-hooks* 'resume-color)

(defun color-string-region (beg end fgnum)
  (interactive "r\nnForeground ColorNumber: ")
  (set-text-attribute beg end nil :foreground fgnum))

(defun color-string-selection (&rest attr)
  (apply #'set-text-attribute
         (selection-point) (selection-mark) nil attr))

(defun clear-color-string ()
  (interactive)
  (clear-all-text-attributes))

(defun color-string-popup ()
  (interactive)
  (set-window *last-mouse-window*)
  (continue-pre-selection)
  (track-popup-menu *color-popup-menu*))

(defun save-color-list ()
  (interactive)
  (let ((fname (get-buffer-file-name))
        (attr (list-text-attributes))
        col)
    (when fname
      (setq col (concat fname ".col"))
      (if attr
          (with-open-file (s col :direction :output)
            (format s "~S" attr))
        (if (file-exist-p col)
            (delete-file col))))))

(defun resume-color ()
  (let ((fname (get-buffer-file-name))
        col attr is)
    (when (and fname
               (file-exist-p (setq col (concat fname ".col"))))
      (handler-case
          (with-open-file (is col :direction :input)
            (setq attr (read is))
            (mapc #'(lambda (x)
                      (apply #'set-text-attribute x))
                  attr))
        (error ()
          (clear-all-text-attributes)))))
  t)


;; 色付けを全削除して、*.col も削除
;; (2002/03/11)追加
(defun clear-color-string-and-save-color-list ()
  (interactive)
  (clear-color-string)
  (save-color-list))


;; text-mode であれば、バッファを閉じるとき色保存
(add-hook '*delete-buffer-hook*
          #'(lambda (buffer)
              (let ((f (minibuffer-window-p (selected-window))))
                (unwind-protect
                    (progn
                      (and f (other-window))
                      (save-excursion
                        (set-buffer buffer)
                        (when (eq buffer-mode 'text-mode)
                          (save-color-list))))
                  (and f (set-window (minibuffer-window)))))
              t))


(^_^)