1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
;; Decorate a shell buffer with fonts.
;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Synched up with: Not in FSF.
;; Do this: (add-hook 'shell-mode-hook 'install-shell-fonts)
;; and the prompt in your shell-buffers will appear bold-italic, process
;; output will appear in normal face, and typein will appear in bold.
;;
;; The faces shell-prompt, shell-input and shell-output can be modified
;; as desired, for example, (copy-face 'italic 'shell-prompt).
;; Written by Jamie Zawinski, overhauled by Eric Benson.
;; TODO:
;; =====
;; Parse ANSI/VT100 escape sequences to turn on underlining/boldface/etc.
;; Automatically run nuke-nroff-bs?
(require 'text-props) ; for put-nonduplicable-text-property
(make-face 'shell-prompt)
(if (not (face-differs-from-default-p 'shell-prompt))
(copy-face 'bold-italic 'shell-prompt))
(make-face 'shell-input)
(if (not (face-differs-from-default-p 'shell-input))
(copy-face 'bold 'shell-input))
(make-face 'shell-output)
(if (not (face-differs-from-default-p 'shell-output))
(progn (make-face-unbold 'shell-output)
(make-face-unitalic 'shell-output)
(set-face-underline-p 'shell-output nil)))
(defvar shell-font-read-only-prompt nil
"*Set all shell prompts to be read-only")
(defvar shell-font-current-face 'shell-input)
(defun shell-font-fontify-region (start end delete-count)
;; for use as an element of after-change-functions; fontifies the inserted text.
(if (= start end)
nil
; ;; This creates lots of extents (one per user-typed character)
; ;; which is wasteful of memory.
; (let ((e (make-extent start end)))
; (set-extent-face e shell-font-current-face)
; (set-extent-property e 'shell-font t))
;; This efficiently merges extents
(put-nonduplicable-text-property start end 'face shell-font-current-face)
(and shell-font-read-only-prompt
(eq shell-font-current-face 'shell-prompt)
(put-nonduplicable-text-property start end 'read-only t))
))
(defun shell-font-hack-prompt (limit)
"Search backward from point-max for text matching the comint-prompt-regexp,
and put it in the `shell-prompt' face. LIMIT is the left bound of the search."
(save-excursion
(goto-char (point-max))
(save-match-data
(cond ((re-search-backward comint-prompt-regexp limit t)
(goto-char (match-end 0))
(cond ((= (point) (point-max))
(skip-chars-backward " \t")
(let ((shell-font-current-face 'shell-prompt))
(shell-font-fontify-region
(match-beginning 0) (point) 0)))))))))
(defvar shell-font-process-filter nil
"In an interaction buffer with shell-font, this is the original proc filter.
shell-font encapsulates this.")
(defun shell-font-process-filter (proc string)
"Invoke the original process filter, then set fonts on the output.
The original filter is in the buffer-local variable shell-font-process-filter."
(let ((cb (current-buffer))
(pb (process-buffer proc)))
(if (null pb)
;; If the proc has no buffer, leave it alone.
(funcall shell-font-process-filter proc string)
;; Don't do save excursion because some proc filters want to change
;; the buffer's point.
(set-buffer pb)
(let ((p (marker-position (process-mark proc))))
(prog1
;; this let must not be around the `set-buffer' call.
(let ((shell-font-current-face 'shell-output))
(funcall shell-font-process-filter proc string))
(shell-font-hack-prompt p)
(set-buffer cb))))))
;;;###autoload
(defun install-shell-fonts ()
"Decorate the current interaction buffer with fonts.
This uses the faces called `shell-prompt', `shell-input' and `shell-output';
you can alter the graphical attributes of those with the normal
face-manipulation functions."
(let* ((proc (or (get-buffer-process (current-buffer))
(error "no process in %S" (current-buffer))))
(old (or (process-filter proc)
(error "no process filter on %S" proc))))
(make-local-variable 'after-change-functions)
(add-hook 'after-change-functions 'shell-font-fontify-region)
(make-local-variable 'shell-font-current-face)
(setq shell-font-current-face 'shell-input)
(make-local-variable 'shell-font-process-filter)
(or (eq old 'shell-font-process-filter) ; already set
(setq shell-font-process-filter old))
(set-process-filter proc 'shell-font-process-filter))
nil)
(add-hook 'shell-mode-hook 'install-shell-fonts)
(add-hook 'telnet-mode-hook 'install-shell-fonts)
(add-hook 'gdb-mode-hook 'install-shell-fonts)
;; for compatibility with the 19.8 version
;(fset 'install-shell-font-prompt 'install-shell-fonts)
(make-obsolete 'install-shell-font-prompt 'install-shell-fonts)
(provide 'shell-font)
|
