From 7f2c92e95f9a1e316649c3d3a898c2a5484d0407 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 17 Feb 2016 09:50:27 +0100 Subject: [PATCH] Add tramp-theme * packages/tramp-theme/README: * packages/tramp-theme/tramp-theme.el: New files. --- packages/tramp-theme/README | 11 ++ packages/tramp-theme/tramp-theme.el | 160 ++++++++++++++++++++++++++++ 2 files changed, 171 insertions(+) create mode 100644 packages/tramp-theme/README create mode 100644 packages/tramp-theme/tramp-theme.el diff --git a/packages/tramp-theme/README b/packages/tramp-theme/README new file mode 100644 index 000000000..093c1f0a8 --- /dev/null +++ b/packages/tramp-theme/README @@ -0,0 +1,11 @@ +This is a custom theme for remote buffers. + +It is not an own custom theme by itself. Rather, it is a custom +theme to run on top of other custom themes. It shall be loaded +always as the last custom theme, because it inherits existing +settings. + +This custom theme extends `mode-line-buffer-identification' by the +name of the remote host. It also allows to change faces according +to the value of `default-directory' of a buffer. See +`tramp-theme-face-remapping-alist' for customization options. diff --git a/packages/tramp-theme/tramp-theme.el b/packages/tramp-theme/tramp-theme.el new file mode 100644 index 000000000..3e80257da --- /dev/null +++ b/packages/tramp-theme/tramp-theme.el @@ -0,0 +1,160 @@ +;;; tramp-theme.el --- Custom theme for remote buffers + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Michael Albinus +;; Package: tramp-theme +;; Version: 0.1 + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This is not an own custom theme by itself. Rather, it is a custom +;; theme to run on top of other custom themes. It shall be loaded +;; always as the last custom theme, because it inherits existing +;; settings. + +;; This custom theme extends `mode-line-buffer-identification' by the +;; name of the remote host. It also allows to change faces according +;; to the value of `default-directory' of a buffer. See +;; `tramp-theme-face-remapping-alist' for customization options. + +;;; Code: + +(deftheme tramp + "A custom theme to decorate buffers when they are remote. +It can be combined with other custom themes.") + +(defcustom tramp-theme-face-remapping-alist + `((nil "^root$" + (mode-line-buffer-id + (:inherit mode-line-buffer-id + :inverse-video + ;; If the face uses already :inverse-video, we deactivate it. + ;; Happens on displays of type 'tty, for example. + ,(null + (face-inverse-video-p + 'mode-line-buffer-id nil '(mode-line default))))))) + "Face remapping for decoration of a remote buffer. +This is an alist of items (HOST USER REMAPPING-LIST). HOST and +USER are regular expressions, or nil. REMAPPING-LIST must be an +alist of face remappings as used by `face-remapping-alist'. If +USER matches the remote user part of `default-directory', and +HOST matches the remote host part of `default-directory', +REMAPPING-LIST is applied to the current buffer. + +For instance, the following settings change the background color +to \"Red\" for frames connected to the remote host \"foo\", it +changes the background color to \"Green\" for frames connected to +the remote host \"bar\", and it inverses the fringe face for +frames using the remote user \"root\": + + '((nil \"^root$\" (fringe (:inherit fringe :inverse-video t))) + (\"^foo$\" nil (default (:background \"Red\"))) + (\"^bar$\" nil (default (:background \"Green\")))) + +Per default, `mode-line-buffer-identification' is displayed +inverse for buffers which are editable with \"root\" permissions." + :group 'tramp + :type `(repeat (list (choice :tag "Host regexp" regexp (const nil)) + (choice :tag "User regexp" regexp (const nil)) + (list :tag "Face Remapping" + face (plist :value-type sexp))))) + +(defun tramp-theme-original-value (variable) + "Return the original value of VARIABLE before loading `tramp-theme'." + (let ((theme-value (get variable 'theme-value))) + (or (cdr (car (delete (assoc 'tramp theme-value) theme-value))) + (get variable 'tramp-theme-original-value)))) + +(defun tramp-theme-mode-line-buffer-identification () + "Return a list suitable for `mode-line-buffer-identification'. +It indicates the remote host being used, if any." + (append + (when (custom-theme-enabled-p 'tramp) + (let ((host (file-remote-p default-directory 'host)) + (user (file-remote-p default-directory 'user)) + remapping-alist) + ;; Apply `tramp-theme-face-remapping-alist'. + (dolist (elt tramp-theme-face-remapping-alist) + (when (and (string-match (or (nth 0 elt) "") (or host "")) + (string-match (or (nth 1 elt) "") (or user ""))) + (setq remapping-alist (cons (nth 2 elt) remapping-alist)))) + (setq-local face-remapping-alist (nreverse remapping-alist)) + + ;; The extended string. + (when host + ;; Do not use FQDN. + (when (string-match "^[^0-9][^.]*\\(\\..*\\)" host) + (setq host (substring host 0 (match-beginning 1)))) + (list + (propertize + (concat (propertize host 'help-echo (purecopy "Host name")) ": ") + 'face 'mode-line-buffer-id 'mouse-face 'mode-line-highlight))))) + + ;; That's the original definition. + (tramp-theme-original-value 'mode-line-buffer-identification))) + +(defun tramp-theme-hook-function () + "Modify `mode-line-buffer-indication'. +Used in different hooks, in order to accelerate the redisplay." + (setq + mode-line-buffer-identification + (tramp-theme-mode-line-buffer-identification))) + +(unless (custom-theme-enabled-p 'tramp) + ;; Save the original value. + (unless (get 'mode-line-buffer-identification 'tramp-theme-original-value) + (put 'mode-line-buffer-identification + 'tramp-theme-original-value + mode-line-buffer-identification)) + + (custom-theme-set-variables + 'tramp + ;; Extend `mode-line-buffer-identification' by host name. + '(mode-line-buffer-identification + '(:eval (tramp-theme-mode-line-buffer-identification))) + ;; `dired-mode' overwrites `mode-line-buffer-identification'. We + ;; want to use our own extension. + '(dired-mode-hook + (cons + 'tramp-theme-hook-function + (delete 'tramp-theme-hook-function dired-mode-hook))) + ;; Redisplay doesn't happen immediately. So we trigger it via + ;; `find-file-hook' and `eshell-directory-change-hook'. + '(find-file-hook + (cons + 'tramp-theme-hook-function + (delete 'tramp-theme-hook-function find-file-hook))) + '(eshell-directory-change-hook + (cons + 'tramp-theme-hook-function + (delete 'tramp-theme-hook-function eshell-directory-change-hook))))) + +(provide-theme 'tramp) + +;;; TODO: + +;; * Use a :type for `tramp-theme-face-remapping-alist' which allows +;; to edit the faces. Maybe use (widget-get custom-face-edit :args) +;; for this. + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; tramp-theme.el ends here -- 2.39.2