2 Commits

Author SHA1 Message Date
  Jens Pitkänen 021b28b38b Improvements for -nw, new modes 5 months ago
  Jens Pitkänen c78c396b1b Add misc 10 months ago
6 changed files with 846 additions and 47 deletions
Split View
  1. +1
    -0
      .gitignore
  2. +3
    -0
      .gitmodules
  3. +98
    -47
      init.el
  4. +1
    -0
      shader-mode
  5. +588
    -0
      xterm-title/xterm-frobs.el
  6. +155
    -0
      xterm-title/xterm-title.el

+ 1
- 0
.gitignore View File

@ -13,3 +13,4 @@ ac-comphist.dat
session.*
custom.el
notes
eln-cache/

+ 3
- 0
.gitmodules View File

@ -0,0 +1,3 @@
[submodule "shader-mode"]
path = shader-mode
url = https://github.com/midnightSuyama/shader-mode

+ 98
- 47
init.el View File

@ -30,35 +30,50 @@
;; Mode line
(use-package smart-mode-line
:config
(setq sml/theme 'dark)
(setq sml/theme 'respectful)
(sml/setup))
;; Font
(set-face-attribute 'default nil :height 100)
(set-face-attribute 'default nil :font "Consolas")
;; Theme
(add-to-list 'custom-theme-load-path "~/.emacs.d/themes")
(use-package base16-theme
;(add-to-list 'custom-theme-load-path "~/.emacs.d/themes")
;(use-package base16-theme
; :config
; (load-theme 'snazzy))
(use-package gruvbox-theme
:config
(load-theme 'snazzy))
(load-theme 'gruvbox))
;; Whitespace
(setq-default show-trailing-whitespace t)
;; Misc nice visual stuff
(show-paren-mode 1)
(set-face-attribute 'show-paren-match nil :weight 'normal)
(global-hl-line-mode 0)
;(global-display-line-numbers-mode)
(setq column-number-mode t)
(setq ring-bell-function 'ignore)
;; Window size
(if (display-graphic-p)
(setq initial-frame-alist
'((width . 80) (height . 26))))
;; Disable unneeded GUI stuff
(menu-bar-mode -1)
(when (fboundp 'tool-bar-mode)
(tool-bar-mode -1))
(when (fboundp 'scroll-bar-mode)
(scroll-bar-mode -1))
;; Fonts
(set-face-attribute 'show-paren-match nil :weight 'normal)
(set-face-attribute 'default nil :height 135)
;(set-face-attribute 'font-lock-comment-face nil :height 140)
;(set-face-attribute 'font-lock-comment-face nil :italic t)
(set-face-attribute 'default nil :weight 'semibold)
;; Misc nice visual stuff
(show-paren-mode 1)
(global-hl-line-mode 1)
(global-linum-mode 1)
(setq line-spacing 0.0)
(setq linum-format "%4d ")
(setq column-number-mode t)
(setq ring-bell-function 'ignore)
(setq-default cursor-type 'bar)
;; End of very visual stuff
;; Customfile
@ -70,10 +85,12 @@
;; Dear emacs,
;; please don't leave garbage all around my filesystem.
(setq backup-directory-alist
`((".*" . ,(concat user-emacs-directory
"backups"))))
(setq auto-save-default nil)
(setq backup-by-copying t
backup-directory-alist '(("." . "~/.saves/"))
delete-old-versions t
kept-new-versions 6
kept-old-versions 2
version-control t)
(setq create-lockfiles nil)
;; Window switching
@ -112,32 +129,38 @@
(global-set-key (kbd "M-x") 'smex)
;; Langs that don't need much config
(use-package yaml-mode
:mode "\\.yaml\\'")
(use-package toml-mode
:mode "\\.toml\\'")
(use-package csharp-mode
:mode "\\.cs\\'")
(use-package gdscript-mode
:mode "\\.gd\\'")
(use-package json-mode
:mode "\\.json\\'")
(use-package nix-mode
:mode "\\.nix\\'")
(use-package papyrus-mode
:load-path "papyrus-mode"
:mode "\\.psc\\'")
(use-package scopes-mode
:load-path "scopes-mode"
:mode "\\.sc\\'")
(use-package nix-mode
:mode "\\.nix\\'")
(use-package json-mode
:mode "\\.json\\'")
(use-package shader-mode
:mode "\\.shader\\'")
(use-package toml-mode
:mode "\\.toml\\'")
(use-package yaml-mode
:mode "\\.yaml\\'")
(use-package zetz-mode
:mode "\\.zz\\'")
;; Langs that do need config below
;; Rust
(use-package rust-mode
:config (setq rust-format-on-save t))
(use-package flycheck-rust
:config
(with-eval-after-load 'rust-mode
(add-hook 'flycheck-mode-hook #'flycheck-rust-setup)))
;(use-package flycheck-rust
; :config
; (with-eval-after-load 'rust-mode
; (add-hook 'flycheck-mode-hook #'flycheck-rust-setup)))
;; Haskell
(use-package haskell-mode
@ -205,24 +228,31 @@
(if (> space-count tab-count) (setq indent-tabs-mode nil))
(if (> tab-count space-count) (setq indent-tabs-mode t))))
(setq-default indent-tabs-mode nil)
(infer-indentation-style)
(add-hook 'after-change-major-mode-hook 'infer-indentation-style)
(define-key global-map (kbd "RET") 'newline-and-indent)
;; Rainbow parens
(use-package rainbow-delimiters
:config
(add-hook 'prog-mode-hook 'rainbow-delimiters-mode))
;; Flycheck
(use-package flycheck
:config
(setq flycheck-check-syntax-automatically '(mode-enabled save))
(add-hook 'after-init-hook #'global-flycheck-mode))
(use-package flycheck-inline
:after (flycheck)
:config
(with-eval-after-load 'flycheck
(add-hook 'flycheck-mode-hook #'flycheck-inline-mode)))
;; Rainbow parens (I've grown to dislike.)
;(use-package rainbow-delimiters
; :config
; (add-hook 'prog-mode-hook 'rainbow-delimiters-mode))
;; Flycheck (breaks emacs-pgtk-native-comp-git)
;(use-package flycheck
; :config
; (setq flycheck-check-syntax-automatically '(mode-enabled save))
; (add-hook 'after-init-hook #'global-flycheck-mode))
;(add-hook 'c-mode-hook
; (lambda () (setq flycheck-clang-include-path
; (list "/usr/include/SDL2/"
; "/usr/include/"))))
; Flycheck-inline is great, but also hangs my emacs now and then
;(use-package flycheck-inline
; :after (flycheck)
; :config
; (with-eval-after-load 'flycheck
; (add-hook 'flycheck-mode-hook #'flycheck-inline-mode)))
;; Company
(use-package company
@ -238,6 +268,27 @@
(define-key input-decode-map "\e[1;5B" [C-down])
(define-key input-decode-map "\e[1;5D" [C-left])
(define-key input-decode-map "\e[1;5C" [C-right])
(define-key input-decode-map "\e[1;6A" [C-S-up])
(define-key input-decode-map "\e[1;6B" [C-S-down])
(define-key input-decode-map "\e[1;6D" [C-S-left])
(define-key input-decode-map "\e[1;6C" [C-S-right])
;; Window resize
(global-set-key (kbd "C-S-<left>") 'shrink-window-horizontally)
(global-set-key (kbd "C-S-<right>") 'enlarge-window-horizontally)
(global-set-key (kbd "C-S-<down>") 'shrink-window)
(global-set-key (kbd "C-S-<up>") 'enlarge-window)
;; Delete words backwards on Ctrl+Backspace in terminal mode
(global-set-key (kbd "C-h") 'backward-kill-word)
;; Delete char properly
(global-set-key [delete] 'delete-forward-char)
;; Use mouse in terminal mode
(xterm-mouse-mode)
;; Mouse scrolling
(global-set-key [mouse-5] 'scroll-up-line)
(global-set-key [mouse-4] 'scroll-down-line)
;; Misc packages
(use-package eldoc)


+ 1
- 0
shader-mode

@ -0,0 +1 @@
Subproject commit d7dc8d0d6fe8914e8b6d5cf2081ad61e6952359c

+ 588
- 0
xterm-title/xterm-frobs.el View File

@ -0,0 +1,588 @@
;;; xterm-frobs.el --- manipulate xterm when running emacs in tty mode
;; Copyright (C) 1998, 99, 00, 2004 Noah S. Friedman
;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com
;; Created: 1998-03-21
;; $Id: xterm-frobs.el,v 1.9 2016/11/24 20:24:53 friedman Exp $
;; 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 2, 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. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Commands for tty-mode emacs when running under xterm, to manipulate the
;; parent xterm state. Some of these commands may only work with post-1996
;; XFree86 xterm versions.
;; Color defaults and algorithms derived from the xterm-189 (2004-5-16)
;; distribution from http://dickey.his.com/xterm/
;; In particular see XTerm-col.ad and 256colres.pl
;; These values may differ from those of earlier releases of xterm.
;; Updates of xterm-frobs.el may be retrieved via
;; http://www.splode.com/~friedman/software/emacs-lisp/
;;; Code:
;; If emacs is running under the `screen' tty session management program
;; (which does its own terminal emulation), the sequence sent to the
;; terminal must be wrapped in a Device Control String so that the original
;; control sequence will be passed uninterpreted to the parent xterm.
(defvar xterm-screen-dcs-encapsulation
(not (null (or (getenv "STY")
(save-match-data
(string-match "^screen\\(\\|-.*\\)$" (getenv "TERM")))))))
(defvar xterm-standard-16color-alist
'(("black" 0 0 0 0)
("red3" 1 52685 0 0)
("green3" 2 0 52685 0)
("yellow3" 3 52685 52685 0)
("dodgerblue1" 4 7710 37008 65535)
("magenta3" 5 52685 0 52685)
("cyan3" 6 0 52685 52685)
("gray90" 7 58853 58853 58853)
("gray50" 8 32639 32639 32639)
("red" 9 65535 0 0)
("green" 10 0 65535 0)
("yellow" 11 65535 65535 0)
("steelblue1" 12 25443 47288 65535)
("magenta" 13 65535 0 65535)
("cyan" 14 0 65535 65535)
("white" 15 65535 65535 65535))
"The first 16 standard xterm colors and their corresponding RGB values.")
;;;###autoload
(defun xterm-iconify ()
"Minimize \(iconify\) xterm window."
(interactive)
(xterm-send-escape-sequence "\e[2t"))
;;;###autoload
(defun xterm-deiconify ()
"Restore \(deiconify\) xterm window."
(interactive)
(xterm-send-escape-sequence "\e[1t"))
;;;###autoload
(defun xterm-set-font (font-name)
"Set the font of the xterm window to FONT.
When called interactively, prompt for the name of the font to use.
This function is used to change the font of the xterm window in which a
tty-mode emacs is running. It should also work if emacs is running under
`screen' in an xterm window.
Use \\[set-default-font] if this emacs is using the window system directly."
(interactive "sFont name: ")
(xterm-send-escape-sequence (format "\e]50;%s\a" font-name)))
;;;###autoload
(defun xterm-set-icon-title (title)
"Set the title in the icon for this xterm window to TITLE.
This does not change the title of the corresponding window."
(interactive "sIcon title: ")
(xterm-send-escape-sequence (format "\e]1;%s\a" title)))
;;;###autoload
(defun xterm-set-window-title (title)
"Set the title for xterm window to TITLE.
This does not change the title in the corresponding icon."
(interactive "sWindow title: ")
(xterm-send-escape-sequence (format "\e]2;%s\a" title)))
;;;###autoload
(defun xterm-set-all-titles (title)
"Set the title for xterm window and corresponding icon to TITLE."
(interactive "sIcon and window title: ")
(xterm-send-escape-sequence (format "\e]0;%s\a" title)))
;;;###autoload
(defun xterm-set-background-color (color)
(interactive "sBackground color: ")
(xterm-send-escape-sequence (format "\e]10;%s\a" color)))
;;;###autoload
(defun xterm-set-foreground-color (color)
(interactive "sForeground color: ")
(xterm-send-escape-sequence (format "\e]11;%s\a" color)))
;;;###autoload
(defun xterm-set-cursor-color (color)
(interactive "sCursor color: ")
(xterm-send-escape-sequence (format "\e]12;%s\a" color)))
;;;###autoload
(defun xterm-set-mouse-foreground-color (color)
(interactive "sMouse foreground color: ")
(xterm-send-escape-sequence (format "\e]13;%s\a" color)))
;;;###autoload
(defun xterm-set-mouse-background-color (color)
(interactive "sMouse background color: ")
(xterm-send-escape-sequence (format "\e]14;%s\a" color)))
(defun xterm-set-Tek-foreground-color (color)
(interactive "sTek foreground color: ")
(xterm-send-escape-sequence (format "\e]15;%s\a" color)))
(defun xterm-set-Tek-background-color (color)
(interactive "sTek background color: ")
(xterm-send-escape-sequence (format "\e]16;%s\a" color)))
;;;###autoload
(defun xterm-set-highlight-color (color)
(interactive "sHighlight color: ")
(xterm-send-escape-sequence (format "\e]17;%s\a" color)))
;;;###autoload
(defun xterm-reverse-video ()
"Set xterm to reverse video mode.
For monochrome xterms, this is white foreground on black background.
For xterms which support color, this has the effect of swapping the
foreground and background colors, whatever they may be.
The effect of this command and \\[xterm-normal-video] may be exchanged
if the XTerm*reverseVideo resource property is set to True."
(interactive)
(xterm-send-escape-sequence "\e[?5h"))
;;;###autoload
(defun xterm-normal-video ()
"Set xterm to normal \(i.e. non-reverse\) video mode.
For monochrome xterms, this is black foreground on white background.
For xterms which support color, this has the effect of restoring the
original foreground and background colors, whatever they may be.
The effect of this command and \\[xterm-reverse-video] may be exchanged
if the XTerm*reverseVideo resource property is set to True."
(interactive)
(xterm-send-escape-sequence "\e[?5l"))
(defun xterm-aaa-mode (&optional prefix)
"Color-emulate an Ann Arbor Ambassador.
With negative prefix argument, reset foreground to white."
(interactive "p")
(cond ((> prefix 0)
(xterm-set-background-color "black")
(xterm-set-foreground-color "green")
(xterm-set-cursor-color "green")
(xterm-set-mouse-foreground-color "black")
(xterm-set-mouse-background-color "green"))
(t
(xterm-set-background-color "black")
(xterm-set-foreground-color "white")
(xterm-set-cursor-color "white")
(xterm-set-mouse-foreground-color "black")
(xterm-set-mouse-background-color "white"))))
(defun xterm-report-cursor-position ()
"Return the position of the xterm cursor.
The result is a cons of the form \(COL . ROW\) indicating the offset in
characters from the upper left-hand corner of the window."
(interactive)
(and (interactive-p)
(sit-for 0))
(let* ((re "\e\\[\\([0-9]+\\);\\([0-9]+\\)R")
(result (xterm-send-and-read-response "\e[6n" re t))
(pos (cons (string-to-number (xterm-substring 2 result))
(string-to-number (xterm-substring 1 result)))))
(and (interactive-p)
(message "COL=%d, ROW=%d" (car pos) (cdr pos)))
pos))
(defun xterm-report-window-state ()
"Return 'iconified or 'non-iconified."
(let ((result (xterm-send-and-read-response "\e[11t" "\e\\[[0-9]+t")))
(cond ((string= result "\e[1t")
'non-iconified)
((string= result "\e[2t")
'iconified))))
(defun xterm-report-window-position-pixels ()
"Return the position of the xterm window on the display.
The result is a cons of the form \(X . Y\) indicating the offset in
pixels from the upper left-hand corner of the display.
Origin is (1 . 1)."
(interactive)
(let* ((re "\e\\[3;\\([0-9]+\\);\\([0-9]+\\)t")
(result (xterm-send-and-read-response "\e[13t" re t))
(pos (cons (string-to-number (xterm-substring 1 result))
(string-to-number (xterm-substring 2 result)))))
(and (interactive-p)
(message "X=%d, Y=%d" (car pos) (cdr pos)))
pos))
(defun xterm-report-window-size-pixels ()
"Return the size of the xterm window, in pixels.
The result is a cons \(WIDTH . HEIGHT\) indicating the dimensions."
(interactive)
(let* ((re "\e\\[4;\\([0-9]+\\);\\([0-9]+\\)t")
(result (xterm-send-and-read-response "\e[14t" re t))
(dim (cons (string-to-number (xterm-substring 2 result))
(string-to-number (xterm-substring 1 result)))))
(and (interactive-p)
(message "%dx%d" (car dim) (cdr dim)))
dim))
(defun xterm-report-window-size ()
"Return the size of the xterm window, in character cells.
The result is a cons \(WIDTH . HEIGHT\) indicating the dimensions."
(interactive)
(let* ((re "\e\\[8;\\([0-9]+\\);\\([0-9]+\\)t")
(result (xterm-send-and-read-response "\e[18t" re t))
(dim (cons (string-to-number (xterm-substring 2 result))
(string-to-number (xterm-substring 1 result)))))
(and (interactive-p)
(message "%dx%d" (car dim) (cdr dim)))
dim))
(defun xterm-report-icon-title ()
"Return the icon label string associated with the xterm window."
(interactive)
(let* ((re "\e\\]L\\(.*\\)\e\\\\")
(result (xterm-send-and-read-response "\e[20t" re t))
(title (xterm-substring 1 result)))
(and (interactive-p)
(message "%s" title))
title))
(defun xterm-report-window-title ()
"Return the window title string associated with the xterm window."
(interactive)
(let* ((re "\e\\]l\\(.*\\)\e\\\\")
(result (xterm-send-and-read-response "\e[21t" re t))
(title (xterm-substring 1 result)))
(and (interactive-p)
(message "%s" title))
title))
(defun xterm-report-color-cells ()
"Return the number of colors which can be displayed by xterm window."
(interactive)
;; Termcap query (`+q') capability is a compile-time option; if not
;; enabled, xterm will not respond at all. Therefore, also query for
;; DECSTBM (terminal scrolling region) so as to guarantee a response.
;; If it turns out that the terminal does not implement this capability,
;; just return emacs' current notion of the number of colors.
(let* ((reply (xterm-send-and-read-response
"\eP+q436f\e\\\eP$qr\e\\" ; "436f" is hex ascii for "Co"
"\eP.\$r[0-9;]*r\e\\\\"))
(result (and (string-match "\eP1\\+r436f=\\([0-9a-f]+\\)\e\\\\" reply)
(xterm-substring 1 reply)))
num-str (i 0) j)
(cond (result
(setq num-str (make-string (/ (length result) 2) ?0))
(while (< i (length num-str))
(setq j (* i 2))
(aset num-str i
(string-to-number (substring result j (+ 2 j)) 16))
(setq i (1+ i)))
(setq result (string-to-number num-str)))
(t
(setq result (display-color-cells))))
(and (interactive-p)
(message "%d" result))
result))
;; queries terminal for rgb data and returns unparsed blocks
(defun xterm-color-rgb-data (&optional query-blocksize max-colors verbose)
(let* ((max (or max-colors (xterm-report-color-cells)))
(start 0)
(stop nil)
(step (1- (min max (or query-blocksize 32))))
(data nil))
(while (< start max)
(setq stop (+ start step))
(and verbose
(message "Looking up terminal color indices %d-%d ..." start stop))
(setq data (cons
(xterm-send-and-read-response
(mapconcat 'identity
(list "\e]4"
(mapconcat (lambda (n) (format "%d;?" n))
(number-sequence start stop)
";")
"\e\\")
";")
(format "\e\\]4;%d;rgb:[0-9a-f/]+\e\\\\" stop))
data))
(setq start (1+ stop)))
(nreverse data)))
;; This is derived from tty-color-approximate, but it works from
;; color-name-rgb-alist, not what emacs currently thinks are the defined
;; colors. (we can't just let-bind variables because the format of the rgb
;; alist is incompatible)
(defun xterm-color-approximate (rgb)
(let* ((color-list (when (boundp 'color-name-rgb-alist)
color-name-rgb-alist))
(candidate (car color-list))
(best-distance 195076);; 3 * 255^2 + 15
(r (ash (car rgb) -8))
(g (ash (cadr rgb) -8))
(b (ash (nth 2 rgb) -8))
best-color)
(while candidate
(let ((try-rgb (cdr candidate))
;; If the approximated color is not close enough to the
;; gray diagonal of the RGB cube, favor non-gray colors.
;; (The number 0.065 is an empirical ad-hoc'ery.)
(favor-non-gray (>= (tty-color-off-gray-diag r g b) 0.065))
try-r try-g try-b
dif-r dif-g dif-b dist)
;; If the RGB values of the candidate color are unknown, we
;; never consider it for approximating another color.
(if try-rgb
(progn
(setq try-r (lsh (car try-rgb) -8)
try-g (lsh (cadr try-rgb) -8)
try-b (lsh (nth 2 try-rgb) -8))
(setq dif-r (- r try-r)
dif-g (- g try-g)
dif-b (- b try-b))
(setq dist (+ (* dif-r dif-r) (* dif-g dif-g) (* dif-b dif-b)))
(if (and (< dist best-distance)
;; The candidate color is on the gray diagonal
;; if its RGB components are all equal.
(or (/= try-r try-g) (/= try-g try-b)
(not favor-non-gray)))
(setq best-distance dist
best-color candidate)))))
(setq color-list (cdr color-list))
(setq candidate (car color-list)))
best-color))
;; Fill matching substrings into a statically allocated buffer to avoid
;; excessive consing, since we're just converting immediately to numbers.
(defsubst xterm-color-substring-to-number (string matchnum base buffer)
(let* ((beg (match-beginning matchnum))
(mpos (1- (match-end matchnum)))
(bpos (1- (length buffer))))
(while (>= mpos beg)
(aset buffer bpos (aref string mpos))
(setq bpos (1- bpos)
mpos (1- mpos)))
(while (>= bpos 0)
(aset buffer bpos ?0)
(setq bpos (1- bpos))))
(string-to-number buffer base))
(defun xterm-color-map (&optional max-colors)
"Query xterm for current color palette and return corresponding alist.
This function depends on xterm supporting certain escape sequences which
not all versions implement."
(let* ((rgb-data (xterm-color-rgb-data nil max-colors))
(map nil)
(color-name nil)
(cvt-buffer (make-string 4 ?0))
data start-pos idx rgb
(case-fold-search t)
;; Reduce frequency of garbage collection until we're finished.
(gc-cons-threshold (max gc-cons-threshold (* 5 1024 1024))))
(while rgb-data
(setq data (car rgb-data)
rgb-data (cdr rgb-data)
start-pos 0)
(while (string-match "\e\\]4;\\([0-9]+\\);rgb:\\([0-9a-f]+\\)/\\([0-9a-f]+\\)/\\([0-9a-f]+\\)\e\\\\"
data start-pos)
(setq idx (xterm-color-substring-to-number data 1 nil cvt-buffer)
rgb (list (xterm-color-substring-to-number data 2 16 cvt-buffer)
(xterm-color-substring-to-number data 3 16 cvt-buffer)
(xterm-color-substring-to-number data 4 16 cvt-buffer))
start-pos (match-end 0))
(setq color-name
(or (when (boundp 'color-name-rgb-alist)
(car (rassoc rgb color-name-rgb-alist)))
(car (xterm-color-approximate rgb))
(format "color-%d" idx)))
(setq map (cons (cons color-name (cons idx rgb)) map))))
(nreverse map)))
;;;###autoload
(defun xterm-sync-emacs-colors ()
"Query xterm for color palette and define color list for Emacs."
(interactive)
(setq tty-defined-color-alist (xterm-color-map))
(clear-face-cache))
;;;###autoload
(defun xterm-print-formatted-color-alist (&optional color-alist)
"Create a pretty-printed table of the current xterm color map.
This table is inserted into a new buffer which can be saved to a file and
reloaded later."
(interactive)
(let* ((map (mapcar (lambda (elt) (mapcar 'prin1-to-string elt))
(or color-alist tty-defined-color-alist)))
(lengths (make-vector (length (car map)) 0))
fmt
(buf (get-buffer-create "*Defined Colors*")))
(mapc (lambda (list)
(let ((i 0))
(mapc (lambda (elt)
(aset lengths i (max (aref lengths i) (length elt)))
(setq i (1+ i)))
list)))
map)
(aset lengths 0 (- (aref lengths 0)))
(setq fmt (format "(%s)\n"
(mapconcat (lambda (d) (format "%%%ds" d)) lengths " ")))
(save-excursion
(set-buffer buf)
(setq buffer-read-only nil)
(erase-buffer)
(fundamental-mode)
(insert (format-time-string ";; Generated %Y-%m-%d %H:%M:%S %Z"))
(when (interactive-p)
(insert (format " by `%s'" this-command))
(let ((file (symbol-file this-command)))
(when file
(insert "\n;; in " (file-name-sans-extension
(file-name-nondirectory file)) ".el"))))
(insert "\n\n(setq tty-defined-color-alist\n'")
(princ (mapcar (lambda (elt) (apply 'format fmt elt)) map) buf)
(search-backward "\n")
(delete-char 1)
(goto-char (point-max))
(insert ")\n\n(clear-face-cache)\n\n;; eof\n")
(emacs-lisp-mode)
(xterm-lisp-indent-region (point-min) (point-max)))
(when (interactive-p)
(pop-to-buffer buf)
(message "Save this buffer to a file, then load it"))))
;; Emacs post 23.1 removes lisp-indent-region
(defun xterm-lisp-indent-region (start end)
"Indent every line whose first char is between START and END inclusive."
(save-excursion
(let ((endmark (copy-marker end)))
(goto-char start)
(and (bolp) (not (eolp))
(lisp-indent-line))
(indent-sexp endmark)
(set-marker endmark nil))))
(defun xterm-standard-256color-alist ()
"Generate the default 256-color map used by xterm.
Return an alist suitable to use as the value for `tty-defined-color-alist',
which see.
This map is the list of RGB values compiled into xterm itself; it may not
correspond to the actual color map used by xterm if it has been overridden
in X resources or other mechanisms."
(let ((alist nil)
(ir 0))
;; Colors 16-231 are a 6x6x6 color cube
(while (< ir 6)
(let ((ig 0))
(while (< ig 6)
(let ((ib 0))
(while (< ib 6)
(let ((i (+ 16 (* ir 36) (* ig 6) ib))
(r (if (zerop ir) 0 (+ 55 (* ir 40))))
(g (if (zerop ig) 0 (+ 55 (* ig 40))))
(b (if (zerop ib) 0 (+ 55 (* ib 40)))))
(setq alist (cons (list (format "color-%d" i) i
(logior (lsh r 8) r) ; cvt to 16bit
(logior (lsh g 8) g)
(logior (lsh b 8) b))
alist)))
(setq ib (1+ ib))))
(setq ig (1+ ig))))
(setq ir (1+ ir)))
;; Colors 232-255 are a grayscale ramp, leaving out black and white
(let ((i 232)
(grey 0)
(level 0))
(while (< i 256)
(setq grey (- i 232))
(setq level (+ (* grey 10) 8))
(setq level (logior (lsh level 8) level)) ; cvt to 16bit
(setq alist (cons (list (format "color-%d" i) i
level level level)
alist))
(setq i (1+ i))))
(nconc (mapcar 'copy-sequence xterm-standard-16color-alist)
(nreverse alist))))
;; This implementation currently reads answerback data into a preallocated
;; string to avoid excessive consing. Using an actual buffer would
;; probably be overkill given the typical length of answerbacks.
;; The major exception is when reading xterm's supported color list.
(defun xterm-send-and-read-response (string response-re &optional alter-md)
(xterm-send-escape-sequence string)
(let ((response (make-string 32 0))
(strlen 32) ; initial buffer size
(c 0) ; index into buffer
(match-data (match-data)))
(while (not (string-match response-re response))
(cond ((= c strlen)
(setq response (concat response (make-string strlen 0)))
(setq strlen (* 2 strlen))))
(aset response c (read-char))
(setq c (1+ c)))
(or alter-md
(store-match-data match-data))
(substring response 0 c)))
(defun xterm-send-escape-sequence (string)
(cond ((and xterm-screen-dcs-encapsulation
(save-match-data (string-match "\e[P\\\\]" string)))
;; ^[P and ^[\ are screen's DCS text string encapsulators, so if
;; they appear as a literal in the string argument, they would
;; truncate/corrupt the encapsulation. Therefore, any literal
;; occurences will be broken up into multiple encapsulations so as
;; not to confuse screen.
(save-match-data
(let ((pos 0)
(substrings nil))
(while (string-match "\e\\(P\\|\\\\\\)" string pos)
(setq substrings
(cons "\e\\"
(cons (substring string pos (match-beginning 1))
(cons "\eP" substrings))))
(setq pos (match-beginning 1)))
(setq substrings (cons (substring string pos) substrings))
(setq string (mapconcat 'identity (nreverse substrings) "")))))
(xterm-screen-dcs-encapsulation
(setq string (format "\eP%s\e\\" string))))
(send-string-to-terminal string))
(defun xterm-substring (n &optional string)
"Return substring matched by last search.
N specifies which match data pair to use
Value is nil if there is no Nth match.
If STRING is not specified, the current buffer is used."
(if (match-beginning n)
(if string
(substring string (match-beginning n) (match-end n))
(buffer-substring (match-beginning n) (match-end n)))))
(provide 'xterm-frobs)
;;; xterm-frobs.el ends here

+ 155
- 0
xterm-title/xterm-title.el View File

@ -0,0 +1,155 @@
;;; xterm-title.el --- Update xterm titles
;; Copyright (C) 2004 Noah S. Friedman
;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com
;; Created: 2004-06-21
;; $Id: xterm-title.el,v 1.1 2004/06/22 00:19:06 friedman Exp $
;; 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 2, 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; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
;;; Commentary:
;; To use this, put something like the following in your .emacs:
;; (when (and (not window-system)
;; (string-match "^xterm" (getenv "TERM")))
;; (require 'xterm-title)
;; (xterm-title-mode 1))
;; This package requires the function `format-mode-line', which does not
;; appear in Emacs 21.3 or earlier versions. In fact, as of 2004-06-21
;; only the Emacs development sources in CVS have this function.
;; Updates of xterm-title.el may be retrieved via
;; http://www.splode.com/~friedman/software/emacs-lisp/
;;; Code:
(require 'xterm-frobs)
(defgroup xterm nil
"Emacs interaction with xterm windows"
:group 'xterm
:group 'extensions)
(defcustom xterm-title-frame-title-format nil
"Window title string to use for xterm windows.
This variable takes precedence over the usual manner of setting frame
titles in Emacs \(see variables `frame-title-format' and
`mode-line-format'\). If nil, it is ignored."
:group 'xterm
:type '(choice
(string :tag "Literal text")
(sexp :tag "Dynamic title (see variable `mode-line-format')")))
(defcustom xterm-title-icon-title-format nil
"Window icon label to use for xterm windows.
This variable takes precedence over the usual manner of setting frame icon
titles in Emacs \(see variables `icon-title-format' and
`mode-line-format'\). If nil, it is ignored."
:group 'xterm
:type '(choice
(string :tag "Literal text")
(sexp :tag "Dynamic icon title (see variable `mode-line-format')")))
;; Not user variables; just used to maintain state
(defvar xterm-title-update-last-window nil)
(defvar xterm-title-orig-frame-title nil)
(defvar xterm-title-orig-icon-title nil)
(define-minor-mode xterm-title-mode
"Update xterm window and icon titles with the selected Emacs tty frame.
When this mode is enabled, the original state of the titles are saved.
If the mode is later disabled, or emacs is exited normally, these original
titles will be restored."
:global t
:group 'xterm
:lighter " XTitle"
:init-value nil
(cond (xterm-title-mode
(xterm-title-save-orig-titles)
(add-hook 'post-command-hook 'xterm-title-update)
(add-hook 'kill-emacs-hook 'xterm-title-restore-orig-titles))
(t
(remove-hook 'kill-emacs-hook 'xterm-title-restore-orig-titles)
(remove-hook 'post-command-hook 'xterm-title-update)
(xterm-title-restore-orig-titles))))
(defun xterm-title-update ()
"Update xterm window and icon titles with the selected Emacs tty frame."
(unless (and xterm-title-mode
(eq (selected-window) xterm-title-update-last-window))
(xterm-set-window-title
(format-mode-line (or xterm-title-frame-title-format
(frame-parameter nil 'title)
;; This would mimic the semantics in X but since
;; frame ttys always have a name (even if just
;; the default "F<n>"), don't bother.
;;
;;(frame-parameter nil 'name)
frame-title-format)))
(xterm-set-icon-title
(format-mode-line (or xterm-title-icon-title-format
(frame-parameter nil 'icon-name)
(frame-parameter nil 'title)
;; See above.
;;
;;(frame-parameter nil 'name)
;; Iconified frames won't be running commands,
;; so they are never updated. Instead, just use
;; the icon-title-format unconditionally if we
;; get this far.
;;
;; Also, calling xterm-report-window-state
;; can interfere with xterm-mouse-mode.
;;
;;(if (eq (xterm-report-window-state) 'iconified)
;; icon-title-format
;; (or xterm-title-frame-title-format
;; frame-title-format)))))
icon-title-format)))
(setq xterm-update-last-window (selected-window))))
(defun xterm-title-save-orig-titles ()
(condition-case nil
(progn
(setq xterm-title-orig-frame-title (xterm-report-window-title)
xterm-title-orig-icon-title (xterm-report-icon-title)))
(error
(setq xterm-title-orig-frame-title nil
xterm-title-orig-icon-title nil))))
(defun xterm-title-restore-orig-titles ()
(unwind-protect
(progn
(when xterm-title-orig-frame-title
(xterm-set-window-title xterm-title-orig-frame-title))
(when xterm-title-orig-icon-title
(xterm-set-icon-title xterm-title-orig-icon-title)))
(setq xterm-title-orig-frame-title nil
xterm-title-orig-icon-title nil)))
(provide 'xterm-title)
;;; xterm-title.el ends here

Loading…
Cancel
Save