1 ;;; tramp-theme.el --- Custom theme for remote buffers
3 ;; Copyright (C) 2016 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: convenience, faces
7 ;; Package: tramp-theme
9 ;; Package-Requires: ((emacs "24.1"))
11 ;; This file is not part of GNU Emacs.
13 ;; This program is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; This is not an own custom theme by itself. Rather, it is a custom
29 ;; theme to run on top of other custom themes. It shall be loaded
30 ;; always as the last custom theme, because it inherits existing
33 ;; This custom theme extends `mode-line-buffer-identification' by the
34 ;; name of the remote host. It also allows to change faces according
35 ;; to the value of `default-directory' of a buffer. See
36 ;; `tramp-theme-face-remapping-alist' for customization options.
40 ;; This is needed for the customized variables.
45 "A custom theme to decorate buffers when they are remote.
46 It can be combined with other custom themes.")
48 (defcustom tramp-theme-face-remapping-alist
51 (:inherit mode-line-buffer-id
53 ;; If the face uses already :inverse-video, we deactivate it.
54 ;; Happens on displays of type 'tty, for example.
57 'mode-line-buffer-id nil '(mode-line default)))))))
58 "Face remapping for decoration of a remote buffer.
59 This is an alist of items (HOST USER REMAPPING-LIST). HOST and
60 USER are regular expressions, or nil. REMAPPING-LIST must be an
61 alist of face remappings as used by `face-remapping-alist'. If
62 USER matches the remote user part of `default-directory', and
63 HOST matches the remote host part of `default-directory',
64 REMAPPING-LIST is applied to the current buffer.
66 For instance, the following settings change the background color
67 to \"Red\" for frames connected to the remote host \"foo\", it
68 changes the background color to \"Green\" for frames connected to
69 the remote host \"bar\", and it inverses the fringe face for
70 frames using the remote user \"root\":
72 '((nil \"^root$\" (fringe (:inherit fringe :inverse-video t)))
73 (\"^foo$\" nil (default (:background \"Red\")))
74 (\"^bar$\" nil (default (:background \"Green\"))))
76 Per default, `mode-line-buffer-identification' is displayed
77 inverse for buffers which are editable with \"root\" permissions."
79 :type `(repeat (list (choice :tag "Host regexp" regexp (const nil))
80 (choice :tag "User regexp" regexp (const nil))
81 (list :tag "Face Remapping"
82 face (plist :value-type sexp)))))
84 (defun tramp-theme-original-value (variable)
85 "Return the original value of VARIABLE before loading `tramp-theme'."
86 (let ((theme-value (get variable 'theme-value)))
87 (or (cdr (car (delete (assoc 'tramp theme-value) theme-value)))
88 (get variable 'tramp-theme-original-value))))
90 (defun tramp-theme-mode-line-buffer-identification ()
91 "Return a list suitable for `mode-line-buffer-identification'.
92 It indicates the remote host being used, if any."
94 (when (custom-theme-enabled-p 'tramp)
95 (let ((host (file-remote-p default-directory 'host))
96 (user (file-remote-p default-directory 'user))
98 ;; Apply `tramp-theme-face-remapping-alist'.
99 (dolist (elt tramp-theme-face-remapping-alist)
100 (when (and (string-match (or (nth 0 elt) "") (or host ""))
101 (string-match (or (nth 1 elt) "") (or user "")))
102 (setq remapping-alist (cons (nth 2 elt) remapping-alist))))
103 (setq-local face-remapping-alist (nreverse remapping-alist))
105 ;; The extended string.
108 (when (string-match "^[^0-9][^.]*\\(\\..*\\)" host)
109 (setq host (substring host 0 (match-beginning 1))))
112 (concat (propertize host 'help-echo (purecopy "Host name")) ": ")
113 'face 'mode-line-buffer-id 'mouse-face 'mode-line-highlight)))))
115 ;; That's the original definition.
116 (tramp-theme-original-value 'mode-line-buffer-identification)))
118 (defun tramp-theme-hook-function ()
119 "Modify `mode-line-buffer-indication'.
120 Used in different hooks, in order to accelerate the redisplay."
122 mode-line-buffer-identification
123 (tramp-theme-mode-line-buffer-identification)))
125 (unless (custom-theme-enabled-p 'tramp)
126 ;; Save the original value.
127 (unless (get 'mode-line-buffer-identification 'tramp-theme-original-value)
128 (put 'mode-line-buffer-identification
129 'tramp-theme-original-value
130 mode-line-buffer-identification))
132 (custom-theme-set-variables
134 ;; Extend `mode-line-buffer-identification' by host name.
135 '(mode-line-buffer-identification
136 '(:eval (tramp-theme-mode-line-buffer-identification)))
137 ;; `dired-mode' overwrites `mode-line-buffer-identification'. We
138 ;; want to use our own extension.
141 'tramp-theme-hook-function
142 (delete 'tramp-theme-hook-function dired-mode-hook)))
143 ;; Redisplay doesn't happen immediately. So we trigger it via
144 ;; `find-file-hook' and `eshell-directory-change-hook'.
147 'tramp-theme-hook-function
148 (delete 'tramp-theme-hook-function find-file-hook)))
149 '(eshell-directory-change-hook
151 'tramp-theme-hook-function
152 (delete 'tramp-theme-hook-function eshell-directory-change-hook)))))
157 'custom-theme-load-path
158 (file-name-as-directory (file-name-directory load-file-name))))
160 (provide-theme 'tramp)
164 ;; * Use a :type for `tramp-theme-face-remapping-alist' which allows
165 ;; to edit the faces. Maybe use (widget-get custom-face-edit :args)
168 ;;; tramp-theme.el ends here