* bug#597: 23.0.60; Corrupted display.
@ 2008-07-22 23:34 ` ofv
2008-07-23 0:01 ` Juanma Barranquero
` (2 more replies)
0 siblings, 3 replies; 21+ messages in thread
From: ofv @ 2008-07-22 23:34 UTC (permalink / raw)
To: emacs-pretest-bug
After some use, Emacs display shows garbage characters instead of
normal text. Only those characters that are shown with the normal face
are replaced by garbage. Text shown as italics, bold, etc, remains
correct. I have no recipe to reproduce this. It usually happens while
reading news with Gnus, but I was unable to reproduce the problem by
duplicating the Gnus session (in particular, displaying again the
article that I was reading when the display got corrupted).
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.0.2195)
of 2008-07-18 on K7
Windowing system distributor `Microsoft Corp.', version 5.0.2195
configured using `configure --with-gcc (4.2) --cflags -It:/emacscvs/include --ldflags -Lt:/emacscvs/lib'
Important settings:
value of $LC_ALL: nil
value of $LC_COLLATE: nil
value of $LC_CTYPE: nil
value of $LC_MESSAGES: en
value of $LC_MONETARY: nil
value of $LC_NUMERIC: nil
value of $LC_TIME: nil
value of $LANG: ESN
value of $XMODIFIERS: nil
locale-coding-system: cp1252
default-enable-multibyte-characters: t
Major mode: Fundamental
Minor modes in effect:
show-paren-mode: t
iswitchb-mode: t
tooltip-mode: t
mouse-wheel-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
blink-cursor-mode: t
global-auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
column-number-mode: t
line-number-mode: t
transient-mark-mode: t
Recent input:
M-h <up> <down> C-g <f10> <menu-bar> <help-menu> <
send-emacs-bug-report>
Recent messages:
ergo-keys
Loading comint...done
Loading d:/lp0/utils/lp0-mode.el (source)...done
Loading `~/.emacs': old-style backquotes detected!
For information about GNU Emacs and the GNU system, type C-h C-a.
Quit
;; --
;; =d3scar
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#597: 23.0.60; Corrupted display.
2008-07-22 23:34 ` bug#597: 23.0.60; Corrupted display ofv
@ 2008-07-23 0:01 ` Juanma Barranquero
2008-07-23 0:44 ` Óscar Fuentes
2008-07-23 8:01 ` Jason Rumney
2008-11-23 15:30 ` bug#597: marked as done (23.0.60; Corrupted display.) Emacs bug Tracking System
2 siblings, 1 reply; 21+ messages in thread
From: Juanma Barranquero @ 2008-07-23 0:01 UTC (permalink / raw)
To: ofv, 597
On Wed, Jul 23, 2008 at 01:34, <ofv@wanadoo.es> wrote:
> After some use, Emacs display shows garbage characters instead of
> normal text. Only those characters that are shown with the normal face
> are replaced by garbage. Text shown as italics, bold, etc, remains
> correct. I have no recipe to reproduce this.
If you display the etc/HELLO file (with C-h H) and move the cursor
around the buffer, do you see garbage?
[I ask because I've seen glyph corruption in one particular computer
when doing that]
Juanma
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#597: 23.0.60; Corrupted display.
2008-07-23 0:01 ` Juanma Barranquero
@ 2008-07-23 0:44 ` Óscar Fuentes
2008-07-23 7:53 ` Juanma Barranquero
0 siblings, 1 reply; 21+ messages in thread
From: Óscar Fuentes @ 2008-07-23 0:44 UTC (permalink / raw)
To: Juanma Barranquero; +Cc: ofv, 597
"Juanma Barranquero" <lekktu@gmail.com> writes:
> On Wed, Jul 23, 2008 at 01:34, <ofv@wanadoo.es> wrote:
>> After some use, Emacs display shows garbage characters instead of
>> normal text. Only those characters that are shown with the normal face
>> are replaced by garbage. Text shown as italics, bold, etc, remains
>> correct. I have no recipe to reproduce this.
>
> If you display the etc/HELLO file (with C-h H) and move the cursor
> around the buffer, do you see garbage?
>
> [I ask because I've seen glyph corruption in one particular computer
> when doing that]
No. Just some blank boxes due to missing character sets. It takes 2
minutes to load and display the file on my Athlon 550 MHz, though.
--
Oscar
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#597: 23.0.60; Corrupted display.
2008-07-23 0:44 ` Óscar Fuentes
@ 2008-07-23 7:53 ` Juanma Barranquero
0 siblings, 0 replies; 21+ messages in thread
From: Juanma Barranquero @ 2008-07-23 7:53 UTC (permalink / raw)
To: Óscar Fuentes; +Cc: ofv, 597
On Wed, Jul 23, 2008 at 02:44, Óscar Fuentes <oscarfv@telefonica.net> wrote:
> No. Just some blank boxes due to missing character sets.
Oh.
> It takes 2
> minutes to load and display the file on my Athlon 550 MHz, though.
Yes. Jason said that the time is spent looking up the fonts, which is
now much more thourough, but also much slower.
Juanma
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#597: 23.0.60; Corrupted display.
2008-07-22 23:34 ` bug#597: 23.0.60; Corrupted display ofv
2008-07-23 0:01 ` Juanma Barranquero
@ 2008-07-23 8:01 ` Jason Rumney
2008-07-23 13:06 ` ofv
2008-11-23 15:30 ` bug#597: marked as done (23.0.60; Corrupted display.) Emacs bug Tracking System
2 siblings, 1 reply; 21+ messages in thread
From: Jason Rumney @ 2008-07-23 8:01 UTC (permalink / raw)
To: ofv; +Cc: 597
ofv@wanadoo.es wrote:
> After some use, Emacs display shows garbage characters instead of
> normal text. Only those characters that are shown with the normal face
> are replaced by garbage.
What default font you are using? (as reported by C-u C-x = before the
problem starts)
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#597: 23.0.60; Corrupted display.
2008-07-23 8:01 ` Jason Rumney
@ 2008-07-23 13:06 ` ofv
0 siblings, 0 replies; 21+ messages in thread
From: ofv @ 2008-07-23 13:06 UTC (permalink / raw)
To: Jason Rumney; +Cc: 597
Jason Rumney <jasonr@gnu.org> writes:
> ofv@wanadoo.es wrote:
>> After some use, Emacs display shows garbage characters instead of
>> normal text. Only those characters that are shown with the normal face
>> are replaced by garbage.
>
> What default font you are using? (as reported by C-u C-x = before the
> problem starts)
nil:-outline-Courier New-normal-normal-normal-mono-16-*-*-*-c-*-iso8859-1 (#x3A)
--
Oscar
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#639: 23.0.60; tab bars use bizarre characters now
@ 2008-08-01 14:42 ` Drew Adams
2008-11-23 15:30 ` bug#639: marked as done (23.0.60; tab bars use bizarre characters now) Emacs bug Tracking System
0 siblings, 1 reply; 21+ messages in thread
From: Drew Adams @ 2008-08-01 14:42 UTC (permalink / raw)
To: emacs-pretest-bug
[-- Attachment #1: Type: text/plain, Size: 608 bytes --]
emacs -Q
Load David Ponce's tabbar.el. I'm using this revision, which
AFAIK is the latest:
;; Revision: $Id: tabbar.el,v 1.20 2003/06/05 08:15:49 ponced Exp $
(defconst tabbar-version "1.3")
M-x tabbar-mode
The characters in the tabs are bad now. See attached images - the good
one is from a build of 2008-07-26; the bad one is from a build of
2008-08-01.
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.1.2600)
of 2008-08-01 on LENNART-69DE564
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --no-opt --cflags -Ic:/g/include
-fno-crossjumping'
[-- Attachment #2: throw-good-tab-chars.png --]
[-- Type: image/png, Size: 992 bytes --]
[-- Attachment #3: throw-bad-tab-chars.PNG --]
[-- Type: image/png, Size: 1063 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
@ 2008-08-02 20:23 ` Drew Adams
2008-08-02 21:05 ` Jason Rumney
2008-11-23 15:30 ` bug#642: marked as done (23.0.60; garbled text (wrong font?) in About GNU Emacs screen) Emacs bug Tracking System
0 siblings, 2 replies; 21+ messages in thread
From: Drew Adams @ 2008-08-02 20:23 UTC (permalink / raw)
To: emacs-pretest-bug
[-- Attachment #1: Type: text/plain, Size: 819 bytes --]
emacs -Q --debug-init -l ".../path/to/hexrgb.el" -l ".../path/to/oneonone.el" -f
"1on1-emacs"
See attached files hexrgb.el and oneonone.el, and screenshot.
This is a regression wrt a build of 2008-07-26, where there was no such problem.
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.1.2600)
of 2008-08-01 on LENNART-69DE564
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --no-opt --cflags -Ic:/g/include
-fno-crossjumping'
Important settings:
value of $LC_ALL: nil
value of $LC_COLLATE: nil
value of $LC_CTYPE: nil
value of $LC_MESSAGES: nil
value of $LC_MONETARY: nil
value of $LC_NUMERIC: nil
value of $LC_TIME: nil
value of $LANG: ENU
value of $XMODIFIERS: nil
locale-coding-system: cp1252
default-enable-multibyte-characters: t
[-- Attachment #2: hexrgb.el --]
[-- Type: application/octet-stream, Size: 26932 bytes --]
;;; hexrgb.el --- Functions to manipulate colors, including RGB hex strings.
;;
;; Filename: hexrgb.el
;; Description: Functions to manipulate colors, including RGB hex strings.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 2004-2008, Drew Adams, all rights reserved.
;; Created: Mon Sep 20 22:58:45 2004
;; Version: 21.0
;; Last-Updated: Tue Jan 01 13:37:31 2008 (-28800 Pacific Standard Time)
;; By: dradams
;; Update #: 540
;; URL: http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el
;; Keywords: number, hex, rgb, color, background, frames, display
;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x
;;
;; Features that might be required by this library:
;;
;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Functions to manipulate colors, including RGB hex strings.
;;
;; This library provides functions for converting between RGB (red,
;; green, blue) color components and HSV (hue, saturation, value)
;; color components. It helps you convert among Emacs color values
;; (whole numbers from 0 through 65535), RGB and HSV floating-point
;; components (0.0 through 1.0), Emacs color-name strings (such as
;; "blue"), and hex RGB color strings (such as "#FC43A7912").
;;
;; An RGB hex string, such as used as a frame `background-color'
;; property, is a string of 1 + (3 * n) characters, the first of
;; which is "#". The other characters are hexadecimal digits, in
;; three groups representing (from the left): red, green, and blue
;; hex codes.
;;
;; Constants defined here:
;;
;; `hexrgb-defined-colors', `hexrgb-defined-colors-alist'.
;;
;; Commands defined here:
;;
;; `hexrgb-blue', `hexrgb-complement', `hexrgb-green',
;; `hexrgb-hue', `hexrgb-read-color', `hexrgb-red',
;; `hexrgb-saturation', `hexrgb-value'.
;;
;; Non-interactive functions defined here:
;;
;; `hexrgb-approx-equal', `hexrgb-color-name-to-hex',
;; `hexrgb-color-values-to-hex', `hexrgb-color-value-to-float',
;; `hexrgb-float-to-color-value', `hexrgb-hex-char-to-integer',
;; `hexrgb-hex-to-color-values', `hexrgb-hex-to-hsv',
;; `hexrgb-hex-to-rgb', `hexrgb-hsv-to-hex', `hexrgb-hex-to-int',
;; `hexrgb-hsv-to-rgb', `hexrgb-increment-blue',
;; `hexrgb-increment-equal-rgb', `hexrgb-increment-green',
;; `hexrgb-increment-hex', `hexrgb-increment-red',
;; `hexrgb-int-to-hex', `hexrgb-rgb-hex-string-p',
;; `hexrgb-rgb-to-hex', `hexrgb-rgb-to-hsv'.
;;
;;
;; Add this to your initialization file (~/.emacs or ~/_emacs):
;;
;; (require 'hexrgb)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2007/12/30 dadams
;; Added: hexrgb-hex-to-color-values.
;; 2007/10/20 dadams
;; hexrgb-read-color: Treat pseudo colors too (e.g. *point foreground*).
;; 2007/01/21 dadams
;; hexrgb-read-color: Error if empty string (and not allow-empty-name-p).
;; 2006/06/06 dadams
;; Added: hexrgb-defined-colors(-alist). Use instead of (x-defined-colors).
;; hexrgb-(red|green|blue): Added interactive specs.
;; 2006/06/04 dadams
;; hexrgb-read-color: Added optional arg allow-empty-name-p.
;; 2006/06/02 dadams
;; Added: hexrgb-rgb-hex-string-p. Used it.
;; 2006/05/30 dadams
;; Added: hexrgb-hex-to-(hsv|rgb), hexrgb-hsv-to-hex, hexrgb-color-name-to-hex,
;; hexrgb-complement, hexrgb-read-color, hexrgb-hue, hexrgb-saturation,
;; hexrgb-value, hexrgb-red, hexrgb-blue, hexrgb-green.
;; approx-equal: Add optional fuzz factor arguments. Changed the algorithm.
;; Renamed: approx-equal to hexrgb-approx-equal.
;; hexrgb-rgb-to-hsv: Changed test from < to <=: (when (<= hue 0.0)...).
;; hexrgb-hsv-to-rgb: Treat hue = 0.0 (int 0) the same as hue = 1.0 (int 6).
;; hexrgb-rgb-to-hex, hexrgb-increment-hex: Corrected doc strings.
;; 2006/05/22 dadams
;; Added: hexrgb-hsv-to-hex, hexrgb-rgb-to-hex. Require cl.el when byte-compile.
;; 2005/08/09 dadams
;; hexrgb-rgb-to-hsv: Side-stepped Emacs-20 bug in comparing NaN.
;; hexrgb-increment-*: Added optional arg wrap-p.
;; hexrgb-increment-hex: Prevent wrap if not wrap-p.
;; 2005/08/02 dadams
;; hexrgb-rgb-to-hes: Bug fix: If delta is zero, then so are hue and saturation.
;; 2005/06/24 dadams
;; hexrgb-rgb-to-hsv: Bug fix: test for NaN (e.g. on divide by zero).
;; 2005/02/08 dadams
;; hexrgb-hsv-to-rgb: Bug fix (typo: p, q -> pp, qq; added ww).
;; 2005/01/09 dadams
;; hexrgb-int-to-hex: Fixed bug in hexrgb-int-to-hex: nb-digits not respected.
;; Added: hexrgb-hsv-to-rgb, hexrgb-rgb-to-hsv, approx-equal.
;; Renamed old hexrgb-increment-value to hexrgb-increment-equal-rgb.
;; 2005/01/05 dadams
;; hexrgb-int-to-hex: Used a suggestion from Juri Linkov.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (require 'cl)) ;; case; plus, for Emacs < 20: when, unless
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Not used here, but put here to be available to libraries that use `hexrgb.el'.
;;;###autoload
(defconst hexrgb-defined-colors (eval-when-compile (x-defined-colors))
"List of all supported colors.")
;;;###autoload
(defconst hexrgb-defined-colors-alist (eval-when-compile (mapcar #'list (x-defined-colors)))
"Alist of all supported colors, for use in completion.")
;;;###autoload
(defun hexrgb-read-color (&optional convert-to-RGB-p allow-empty-name-p prompt)
"Read a color name or RGB hex value: #RRRRGGGGBBBB.
Completion is available for color names, but not for RGB hex strings.
If you input an RGB hex string, it must have the form #XXXXXXXXXXXX or
XXXXXXXXXXXX, where each X is a hex digit. The number of Xs must be a
multiple of 3, with the same number of Xs for each of red, green, and
blue. The order is red, green, blue.
In addition to standard color names and RGB hex values, the following
are available as color candidates. In each case, the corresponding
color is used.
* `*copied foreground*' - last copied foreground, if available
* `*copied background*' - last copied background, if available
* `*mouse-2 foreground*' - foreground where you click `mouse-2'
* `*mouse-2 background*' - background where you click `mouse-2'
* `*point foreground*' - foreground under the cursor
* `*point background*' - background under the cursor
\(You can copy a color using eyedropper commands such as
`eyedrop-pick-foreground-at-mouse'.)
Checks input to be sure it represents a valid color. If not, raises
an error (but see exception for empty input with non-nil
ALLOW-EMPTY-NAME-P).
Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, converts
an input color name to an RGB hex string. Returns the RGB hex string.
Optional arg ALLOW-EMPTY-NAME-P controls what happens if you enter an
empty color name (that is, you just hit `RET'). If non-nil, then
`hexrgb-read-color' returns an empty color name, \"\". If nil, then
it raises an error. Programs must test for \"\" if ALLOW-EMPTY-NAME-P
is non-nil. They can then perform an appropriate action in case of
empty input.
Optional arg PROMPT is the prompt. Nil means use a default prompt."
(interactive "p") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
(colors (if (fboundp 'eyedrop-foreground-at-point)
(append (and eyedrop-picked-foreground '(("*copied foreground*")))
(and eyedrop-picked-background '(("*copied background*")))
'(("*mouse-2 foreground*") ("*mouse-2 background*")
("*point foreground*") ("*point background*"))
hexrgb-defined-colors-alist)
hexrgb-defined-colors-alist))
(color (completing-read (or prompt "Color (name or #R+G+B+): ") colors))
hex-string)
(when (fboundp 'eyedrop-foreground-at-point)
(cond ((string= "*copied foreground*" color) (setq color eyedrop-picked-foreground))
((string= "*copied background*" color) (setq color eyedrop-picked-background))
((string= "*point foreground*" color) (setq color (eyedrop-foreground-at-point)))
((string= "*point background*" color) (setq color (eyedrop-background-at-point)))
((string= "*mouse-2 foreground*" color)
(setq color (prog1 (eyedrop-foreground-at-mouse
(read-event "Click `mouse-2' to choose foreground color - "))
(read-event)))) ; Discard mouse up event.
((string= "*mouse-2 background*" color)
(setq color (prog1 (eyedrop-background-at-mouse
(read-event "Click `mouse-2' to choose background color - "))
(read-event)))))) ; Discard mouse up event.
(setq hex-string (or (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
(and (string-match "^\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
t)))
(if (and allow-empty-name-p (string= "" color))
""
(when (and hex-string (not (eq 0 hex-string)))
(setq color (concat "#" color))) ; No #; add it.
(unless hex-string
(when (or (string= "" color)
(not (if (fboundp 'test-completion) ; Not defined in Emacs 20.
(test-completion color colors)
(try-completion color colors))))
(error "No such color: %S" color))
(when convert-to-RGB-p (setq color (hexrgb-color-name-to-hex color))))
(when (interactive-p) (message "Color: `%s'" color))
color)))
;;;###autoload
(defun hexrgb-rgb-hex-string-p (color &optional laxp)
"Non-nil if COLOR is an RGB string #XXXXXXXXXXXX.
Each X is a hex digit. The number of Xs must be a multiple of 3, with
the same number of Xs for each of red, green, and blue.
Non-nil optional arg LAXP means that the initial `#' is optional. In
that case, for a valid string of hex digits: when # is present 0 is
returned; otherwise, t is returned."
(or (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
(and laxp (string-match "^\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) t)))
;;;###autoload
(defun hexrgb-complement (color)
"Return the color that is the complement of COLOR."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(let ((red (hexrgb-red color))
(green (hexrgb-green color))
(blue (hexrgb-blue color)))
(setq color (hexrgb-rgb-to-hex (- 1.0 red) (- 1.0 green) (- 1.0 blue))))
(when (interactive-p) (message "Complement: `%s'" color))
color)
;;;###autoload
(defun hexrgb-hue (color)
"Return the hue component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(car (hexrgb-rgb-to-hsv (hexrgb-red color) (hexrgb-green color) (hexrgb-blue color))))
;;;###autoload
(defun hexrgb-saturation (color)
"Return the saturation component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(cadr (hexrgb-rgb-to-hsv (hexrgb-red color) (hexrgb-green color) (hexrgb-blue color))))
;;;###autoload
(defun hexrgb-value (color)
"Return the value component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(caddr (hexrgb-rgb-to-hsv (hexrgb-red color) (hexrgb-green color) (hexrgb-blue color))))
;;;###autoload
(defun hexrgb-red (color)
"Return the red component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(/ (hexrgb-hex-to-int (substring color 1 (1+ (/ (1- (length color)) 3))))
(expt 16.0 (/ (1- (length color)) 3.0))))
;;;###autoload
(defun hexrgb-green (color)
"Return the green component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(let* ((len (/ (1- (length color)) 3))
(start (1+ len)))
(/ (hexrgb-hex-to-int (substring color start (+ start len)))
(expt 16.0 (/ (1- (length color)) 3.0)))))
;;;###autoload
(defun hexrgb-blue (color)
"Return the blue component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(let* ((len (/ (1- (length color)) 3))
(start (+ 1 len len)))
(/ (hexrgb-hex-to-int (substring color start (+ start len)))
(expt 16.0 (/ (1- (length color)) 3.0)))))
;;;###autoload
(defun hexrgb-rgb-to-hsv (red green blue)
"Convert RED, GREEN, BLUE components to HSV (hue, saturation, value).
Each input component is 0.0 to 1.0, inclusive.
Returns a list of HSV components of value 0.0 to 1.0, inclusive."
(let* ((min (min red green blue))
(max (max red green blue))
(value max)
(delta (- max min))
hue saturation)
(if (hexrgb-approx-equal 0.0 delta)
(setq hue 0.0 saturation 0.0) ; Gray scale - no color; only value.
(if (and (condition-case nil
(setq saturation (/ delta max))
(arith-error nil))
(or (< emacs-major-version 21) ; Emacs 20 bug makes next test fail falsely.
(not (equal 0.0e+NaN saturation)))) ; Must be a number, not NaN.
(if (hexrgb-approx-equal 0.0 saturation)
(setq hue 0.0 saturation 0.0) ; Again, no color; only value.
;; Color
(if (hexrgb-approx-equal red max)
(setq hue (/ (- green blue) delta)) ; Between yellow & magenta.
(if (hexrgb-approx-equal green max)
(setq hue (+ 2.0 (/ (- blue red) delta))) ; Between cyan & yellow.
(setq hue (+ 4.0 (/ (- red green) delta))))) ; Between magenta & cyan.
(setq hue (/ hue 6.0))
(when (<= hue 0.0)(setq hue (+ hue 1.0))))
(setq saturation 0.0 hue 0.0))) ; Div by zero (max=0): H:=0, S:=0. (Hue undefined.)
(list hue saturation value)))
;;;###autoload
(defun hexrgb-hsv-to-rgb (hue saturation value)
"Convert HUE, SATURATION, VALUE components to RGB (red, green, blue).
Each input component is 0.0 to 1.0, inclusive.
Returns a list of RGB components of value 0.0 to 1.0, inclusive."
(let (red green blue int-hue fract pp qq tt ww)
(if (hexrgb-approx-equal 0.0 saturation)
(setq red value green value blue value) ; Gray
(setq hue (* hue 6.0) ; Sectors: 0 to 5
int-hue (floor hue)
fract (- hue int-hue)
pp (* value (- 1 saturation))
qq (* value (- 1 (* saturation fract)))
ww (* value (- 1 (* saturation (- 1 (- hue int-hue))))))
(case int-hue
((0 6) (setq red value green ww blue pp))
(1 (setq red qq green value blue pp))
(2 (setq red pp green value blue ww))
(3 (setq red pp green qq blue value))
(4 (setq red ww green pp blue value))
(otherwise (setq red value green pp blue qq))))
(list red green blue)))
;;;###autoload
(defun hexrgb-hsv-to-hex (hue saturation value)
"Return the hex RBG color string for inputs HUE, SATURATION, VALUE.
The inputs are each in the range 0 to 1.
The output string is of the form \"#RRRRGGGGBBBB\"."
(hexrgb-color-values-to-hex
(mapcar (lambda (x) (floor (* x 65535.0))) (hexrgb-hsv-to-rgb hue saturation value))))
;;;###autoload
(defun hexrgb-rgb-to-hex (red green blue)
"Return the hex RBG color string for inputs RED, GREEN, BLUE.
The inputs are each in the range 0 to 1.
The output string is of the form \"#RRRRGGGGBBBB\"."
(hexrgb-color-values-to-hex
(mapcar (lambda (x) (floor (* x 65535.0))) (list red green blue))))
;;;###autoload
(defun hexrgb-hex-to-hsv (color)
"Return a list of HSV (hue, saturation, value) color components.
Each component is a value from 0.0 to 1.0, inclusive.
COLOR is a color name or a hex RGB string that starts with \"#\" and
is followed by an equal number of hex digits for red, green, and blue
components."
(let ((rgb-components (hexrgb-hex-to-rgb color)))
(apply #'hexrgb-rgb-to-hsv rgb-components)))
;;;###autoload
(defun hexrgb-hex-to-rgb (color)
"Return a list of RGB (red, green, blue) color components.
Each component is a value from 0.0 to 1.0, inclusive.
COLOR is a color name or a hex RGB string that starts with \"#\" and
is followed by an equal number of hex digits for red, green, and blue
components."
(unless (hexrgb-rgb-hex-string-p color) (setq color (hexrgb-color-name-to-hex color)))
(let ((len (/ (1- (length color)) 3)))
(list (/ (hexrgb-hex-to-int (substring color 1 (1+ len))) 65535.0)
(/ (hexrgb-hex-to-int (substring color (1+ len) (+ 1 len len))) 65535.0)
(/ (hexrgb-hex-to-int (substring color (+ 1 len len))) 65535.0))))
;;;###autoload
(defun hexrgb-color-name-to-hex (color)
"Return the RGB hex string for the COLOR name, starting with \"#\".
If COLOR is already a string starting with \"#\", then just return it."
(let ((components (x-color-values color)))
(unless components (error "No such color: %S" color))
(unless (hexrgb-rgb-hex-string-p color)
(setq color (hexrgb-color-values-to-hex components))))
color)
;; Just hard-code 4 as the number of hex digits, since `x-color-values'
;; seems to produce appropriate integer values for this value.
;;
;; Color "components" would be better in the name than color "value"
;; but this name follows the Emacs tradition (e.g. `x-color-values',
;; 'ps-color-values', `ps-e-x-color-values').
;;;###autoload
(defun hexrgb-color-values-to-hex (values)
"Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
Each X in the string is a hexadecimal digit.
Input VALUES is as for the output of `x-color-values'."
(concat "#"
(hexrgb-int-to-hex (nth 0 values) 4) ; red
(hexrgb-int-to-hex (nth 1 values) 4) ; green
(hexrgb-int-to-hex (nth 2 values) 4))) ; blue
;;;###autoload
(defun hexrgb-hex-to-color-values (color)
"Convert hex COLOR to a list of rgb color values.
COLOR is a hex rgb color string, #XXXXXXXXXXXX
Each X in the string is a hexadecimal digit. There are 3N X's, N > 0.
The output list is as for `x-color-values'."
(let* ((hex-strgp (string-match
"^\\(#\\)?\\(\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+\\)$"
color))
(ndigits (/ (if (eq (match-beginning 1) (match-end 1))
(length color)
(1- (length color)))
3))
red green blue)
(unless hex-strgp (error "Invalid RGB color string: %s" color))
(setq color (substring color (match-beginning 2) (match-end 2))
red (hexrgb-hex-to-int (substring color 0 ndigits))
green (hexrgb-hex-to-int (substring color ndigits (* 2 ndigits)))
blue (hexrgb-hex-to-int (substring color ndigits (* 3 ndigits))))
(list red green blue)))
;;;###autoload
(defun hexrgb-increment-red (hex nb-digits increment &optional wrap-p)
"Increment red value of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
If optional arg WRAP-P is non-nil, then the result wraps around zero.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat "#"
(hexrgb-increment-hex (substring hex 1 (1+ nb-digits)) increment nb-digits wrap-p)
(substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
(substring hex (1+ (* nb-digits 2)))))
;;;###autoload
(defun hexrgb-increment-green (hex nb-digits increment &optional wrap-p)
"Increment green value of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat
"#" (substring hex 1 (1+ nb-digits))
(hexrgb-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
increment
nb-digits
wrap-p)
(substring hex (1+ (* nb-digits 2)))))
;;;###autoload
(defun hexrgb-increment-blue (hex nb-digits increment &optional wrap-p)
"Increment blue value of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat "#" (substring hex 1 (1+ (* nb-digits 2)))
(hexrgb-increment-hex (substring hex (1+ (* nb-digits 2)))
increment
nb-digits
wrap-p)))
;;;###autoload
(defun hexrgb-increment-equal-rgb (hex nb-digits increment &optional wrap-p)
"Increment each color value (r,g,b) of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat
"#" (hexrgb-increment-hex (substring hex 1 (1+ nb-digits)) increment nb-digits wrap-p)
(hexrgb-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
increment
nb-digits
wrap-p)
(hexrgb-increment-hex (substring hex (1+ (* nb-digits 2))) increment nb-digits wrap-p)))
;;;###autoload
(defun hexrgb-increment-hex (hex increment nb-digits &optional wrap-p)
"Increment HEX number (a string NB-DIGITS long) by INCREMENT.
For example, incrementing \"FFFFFFFFF\" by 1 will cause it to wrap
around to \"000000000\"."
(let* ((int (hexrgb-hex-to-int hex))
(new-int (+ increment int)))
(if (or wrap-p
(and (>= int 0) ; Not too large for the machine.
(>= new-int 0) ; For the case where increment < 0.
(<= (length (format (concat "%X") new-int)) nb-digits))) ; Not too long.
(hexrgb-int-to-hex new-int nb-digits) ; Use incremented number.
hex))) ; Don't increment.
;;;###autoload
(defun hexrgb-hex-to-int (hex)
"Convert HEX string argument to an integer.
The characters of HEX must be hex characters."
(let* ((factor 1)
(len (length hex))
(indx (1- len))
(int 0))
(while (>= indx 0)
(setq int (+ int (* factor (hexrgb-hex-char-to-integer (aref hex indx)))))
(setq indx (1- indx))
(setq factor (* 16 factor)))
int))
;; From `hexl.el'. This is the same as `hexl-hex-char-to-integer' defined there.
;;;###autoload
(defun hexrgb-hex-char-to-integer (character)
"Take a CHARACTER and return its value as if it were a hex digit."
(if (and (>= character ?0) (<= character ?9))
(- character ?0)
(let ((ch (logior character 32)))
(if (and (>= ch ?a) (<= ch ?f))
(- ch (- ?a 10))
(error "Invalid hex digit `%c'" ch)))))
;; Originally, I used the code from `int-to-hex-string' in `float.el'.
;; This version is thanks to Juri Linkov <juri@jurta.org>.
;;
;;;###autoload
(defun hexrgb-int-to-hex (int &optional nb-digits)
"Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
Each X in the output string is a hexadecimal digit.
NB-DIGITS is the number of hex digits. If INT is too large to be
represented with NB-DIGITS, then the result is truncated from the
left. So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
the hex equivalent of 256 decimal is 100, which is more than 2 digits."
(setq nb-digits (or nb-digits 4))
(substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
;; Inspired by Elisp Info manual, node "Comparison of Numbers".
;;;###autoload
(defun hexrgb-approx-equal (x y &optional rfuzz afuzz)
"Return non-nil if numbers X and Y are approximately equal.
RFUZZ is a relative fuzz factor. AFUZZ is an absolute fuzz factor.
RFUZZ defaults to 1.0e-8. AFUZZ defaults to (/ RFUZZ 10).
The algorithm is:
(< (abs (- X Y)) (+ AFUZZ (* RFUZZ (+ (abs X) (abs Y)))))."
(setq rfuzz (or rfuzz 1.0e-8) afuzz (or afuzz (/ rfuzz 10)))
(< (abs (- x y)) (+ afuzz (* rfuzz (+ (abs x) (abs y))))))
;;;###autoload
(defun hexrgb-color-value-to-float (n)
"Return the floating-point equivalent of color value N.
N must be an integer between 0 and 65535, or else an error is raised."
(unless (and (wholenump n) (<= n 65535))
(error "Not a whole number less than 65536"))
(/ (float n) 65535.0))
;;;###autoload
(defun hexrgb-float-to-color-value (x)
"Return the color value equivalent of floating-point number X.
X must be between 0.0 and 1.0, or else an error is raised."
(unless (and (numberp x) (<= 0.0 x) (<= x 1.0))
(error "Not a floating-point number between 0.0 and 1.0"))
(floor (* x 65535.0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'hexrgb)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; hexrgb.el ends here
[-- Attachment #3: oneonone.el --]
[-- Type: application/octet-stream, Size: 71097 bytes --]
;;; oneonone.el --- Frame configuration that uses one frame per window.
;;
;; Filename: oneonone.el
;; Description: Frame configuration that uses one frame per window.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1999-2008, Drew Adams, all rights reserved.
;; Created: Fri Apr 2 12:34:20 1999
;; Version: 21.1
;; Last-Updated: Tue Feb 12 07:08:17 2008 (Pacific Standard Time)
;; By: dradams
;; Update #: 2344
;; URL: http://www.emacswiki.org/cgi-bin/wiki/oneonone.el
;; Keywords: local, frames
;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x
;;
;; Features that might be required by this library:
;;
;; `avoid', `cl', `files+', `frame-cmds', `frame-fns', `hexrgb',
;; `misc-fns', `oneonone', `strings', `thingatpt', `thingatpt+',
;; `zoom-frm'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Frame configuration that uses one frame per window.
;;
;; This library is part of One-on-One Emacs, a collection of
;; libraries that try to make Emacs more frame-oriented and less
;; window-oriented.
;;
;; This library sets up Emacs to use multiple frames: individual
;; frames are used, by default, instead of Emacs windows. That is,
;; the default is to use a frame for each Emacs window: one window on
;; one frame.
;;
;; You can configure each of the frames defined here.
;;
;; Default properties are defined here for normal frames and
;; "special" frames, which show "special-display buffers" (see Emacs
;; manual for info on such frames).
;;
;; In addition, these user options control the creation of three
;; separate, specialized frames:
;;
;; - `1on1-*Help*-frame-flag' - *Help* buffer frame
;; - `1on1-*Completions*-frame-flag' - *Completions* buffer frame
;; - `1on1-minibuffer-frame-flag' - minibuffer frame
;;
;; Buffers *Help* and *Completions* are always displayed in their own
;; frames. In addition, if `1on1-*Help*-frame-flag' or
;; `1on1-*Completions*-frame-flag' is non-nil, then the *Help* or
;; *Completions* frame has a special (customizable) appearance.
;;
;; If `1on1-minibuffer-frame-flag' is non-nil (the default value),
;; then the minibuffer is shown in its own frame,
;; `1on1-minibuffer-frame'; this is the only frame to have a
;; minibuffer. If you customize `1on1-minibuffer-frame-flag' to nil,
;; then each frame will have its own minibuffer, as usual, and there
;; will be no standalone minibuffer frame.
;;
;; By default, if you use a standalone minibuffer frame, it is
;; automatically sized to the full width of your display and placed
;; at the bottom of the display. During minibuffer input, you can
;; use `1on1-fit-minibuffer-frame' (bind to `C-o') to resize its
;; height to fit the input text - the height is reset when inputting
;; is done. To help you perceive changes to different minibuffer
;; recursion levels, the background color of the minibuffer frame is
;; changed slightly with each recursion-depth change.
;;
;; This library is especially useful if used in combination with
;; One-on-One Emacs libraries `autofit-frame.el', which automatically
;; fits frames to their sole window, and `fit-frame.el', which lets
;; you fit a frame to its selected window manually. Library
;; `autofit-frame.el' uses library `fit-frame.el'.
;;
;; Because Emacs is not really designed to be frame-oriented, there
;; are many built-in and standard functions that produce
;; less-than-optimal results when frames, instead of windows, are the
;; default. In other One-on-One Emacs libraries, I have fixed most
;; of these built-in functions to play well with frames.
;;
;; For more information on One-on-One Emacs see
;; http://www.emacswiki.org/cgi-bin/wiki/OneOnOneEmacs.
;;
;; To use this library, put the following at the *END* of your init
;; file, `.emacs' (or `_emacs'). In particular, if your init file
;; contains a `custom-set-variables' expression, then the following
;; must appear *AFTER* that expression, in order for this to take
;; into account your customizations of any `1on1-' user options.
;;
;; (require 'oneonone)
;; (1on1-emacs)
;;
;; Initial frame: By default, the initial Emacs frame is like all
;; other normal (non-special-display) frames; that is,
;; `initial-frame-alist' effectively uses the frame properties
;; defined in `default-frame-alist'. If you would like the initial
;; frame to be different, set `default-frame-alist' to nil after
;; requiring `oneonone.el' but before executing `1on1-emacs':
;;
;; (require 'oneonone)
;; (setq default-frame-alist nil)
;; (setq initial-frame-alist '((background-color . "White"))); e.g.
;; (1on1-emacs)
;;
;; If you want the text cursor to change to a box when Emacs is idle,
;; then add this line also to your init file:
;;
;; (toggle-box-cursor-when-idle 1) ; Turn on box cursor when idle.
;;
;; Info and Customize frames: I recommend that you put the following
;; code in your init file, so that Info and Customize buffers will
;; display in their own frames. Which code to use depends on your
;; version of GNU Emacs.
;;
;; (cond ((< emacs-major-version 21)
;; (remove-hook 'same-window-buffer-names "*info*"))
;; ((= emacs-version 21)
;; (remove-hook 'same-window-buffer-names "*info*")
;; (remove-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'"))
;; (t
;; (remove-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)")
;; (remove-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")))
;;
;; Recommended key bindings (requires library `fit-frame.el'):
;;
;; (define-key minibuffer-local-map "\C-o"
;; '1on1-fit-minibuffer-frame)
;; (define-key minibuffer-local-must-match-map "\C-o"
;; '1on1-fit-minibuffer-frame)
;; (define-key minibuffer-local-completion-map "\C-o"
;; '1on1-fit-minibuffer-frame)
;;
;;
;; Notes on user options defined here:
;; ---------------------------------
;;
;; Some user options are used here only as conveniences to define
;; frame-parameter alists. They are defined using `defvar', not
;; `defcustom', because you cannot use Customize to define them
;; independently of the alist user options they help to define. The
;; alists themselves are the variables to customize. If you want to
;; change the `defvar' variables individually and then use them to
;; set the alist variables, then use `setq', not Customize, to change
;; them, and restart Emacs for their changes to take effect.
;;
;; Changes to any user options defined here with `defcustom' will
;; take effect as soon as `1on1-emacs' is executed, so you can do
;; `M-x 1on1-emacs' to see their changes (no need to restart
;; Emacs).
;;
;; User options `1on1-color-minibuffer-frame-on-setup-increment' and
;; `1on1-color-minibuffer-frame-on-exit-increment' determine how much
;; to change the color of the minibuffer frame when the minibuffer is
;; entered and exitted. They are hue increments, and should be
;; opposite in sign. They should cancel each other out, so that the
;; color returns to what it was initially at any given
;; recursive-minibuffer depth. However, because of the way HSV and
;; RGB color-component conversion works, the best cancellation does
;; not occur when these have the same absolute value. And, how much
;; their absolute values should differ depends on that magnitude.
;; It's best to just set one of these to an increment you like, and
;; then fiddle with the other until they more or less cancel.
;;
;;
;; New functions and macros defined here (each has prefix `1on1-'):
;;
;; `box-cursor-when-idle', `change-cursor-on-input-method',
;; `change-cursor-on-overwrite/read-only',
;; `color-minibuffer-frame-on-exit',
;; `color-minibuffer-frame-on-setup',
;; `color-isearch-minibuffer-frame', `display-*Completions*-frame',
;; `display-*Help*-frame', `emacs', `fit-minibuffer-frame',
;; `flash-ding-minibuffer-frame', `increment-color-hue',
;; `minibuffer-prompt-end', `reset-minibuffer-frame',
;; `set-box-cursor-when-idle-interval', `set-cursor-type',
;; `set-minibuffer-frame-top/bottom', `set-minibuffer-frame-width',
;; `setup-minibuffer-frame-coloring',
;; `setup-mode-line'. `toggle-box-cursor-when-idle'.
;;
;; Customizable user options defined here (each has prefix `1on1-'):
;;
;; `*Completions*-frame-flag', `*Completions*-frame-at-right-flag',
;; `*Help*-frame-flag', `active-minibuffer-frame-background',
;; `active-mode-line-background',
;; `change-cursor-on-overwrite/read-only-flag',
;; `color-minibuffer-frame-on-exit-increment',
;; `color-minibuffer-frame-on-setup-increment',
;; `color-mode-line-flag', `completions-frame-background',
;; `completions-frame-mouse+cursor-color',
;; `completions-frame-width', `default-frame-alist',
;; `help-frame-background', `help-frame-mouse+cursor-color',
;; `inactive-minibuffer-frame-background',
;; `inactive-mode-line-background',
;; `isearch-minibuffer-frame-background', `minibuffer-frame-alist',
;; `minibuffer-frame-left', `minibuffer-frame-top/bottom',
;; `minibuffer-frame-width', `minibuffer-frame-width-percent',
;; `special-display-frame-alist'.
;;
;; Non-customizable user options defined here (prefix `1on1-'):
;;
;; `default-frame-background', `default-frame-cursor-color',
;; `default-frame-cursor-color-input-method',
;; `default-frame-cursor-type',
;; `default-frame-cursor-type-overwrite/read-only',
;; `default-frame-font', `default-frame-foreground',
;; `default-frame-menu-bar-lines', `default-frame-mouse-color',
;; `default-frame-size', `default-frame-upper-left-corner',
;; `default-special-frame-background',
;; `default-special-frame-cursor-color',
;; `default-special-frame-font',
;; `default-special-frame-foreground',
;; `default-special-frame-menu-bar-lines',
;; `default-special-frame-mouse-color',
;; `default-special-frame-size',
;; `default-special-frame-upper-left-corner',
;; `minibuffer-frame-background', `minibuffer-frame-cursor-color',
;; `minibuffer-frame-flag', `minibuffer-frame-font',
;; `minibuffer-frame-foreground', `minibuffer-frame-height',
;; `minibuffer-frame-mouse-color'.
;;
;; Other new variables defined here (each has prefix `1on1-'):
;;
;; `box-cursor-when-idle-p', `box-cursor-when-idle-interval',
;; `box-cursor-when-idle-timer', `last-cursor-type',
;; `minibuffer-frame'.
;;
;;
;; ***** NOTE: These EMACS PRIMITIVES have been REDEFINED HERE:
;;
;; `abort-recursive-edit', `top-level' -
;; Reset color of minibuffer frame to "inactive" color.
;;
;; `y-or-n-p' - Temporarily color minibuffer frame to "active" color.
;;
;;
;; Acknowledgements:
;;
;; The cursor-changing on input method and read-only was inspired by
;; Juri Linkov <juri@jurta.org>. Joe Casadonte <joc@netaxs.com>
;; wrote a similar hook (`joc-cursor-type-set-hook'), which he got
;; from Steve Kemp...
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2007/12/05 dadams
;; 1on1-minibuffer-frame-left: Added :type.
;; 1on1-color-mode-line-flag, 1on1-minibuffer-frame-flag: defvar -> defcustom.
;; 1on1-(minibuffer|(special-)default)-frame-*: Removed * doc-string prefix.
;; 2007/11/22 dadams
;; Added: 1on1-reset-minibuffer-frame, 1on1-fit-minibuffer-frame,
;; 1on1-minibuffer-prompt-end. Recommend C-o key binding.
;; Use 1on1-reset-minibuffer-frame on minibuffer-exit-hook.
;; 2007/08/14 dadams
;; 1on1-emacs:
;; Add *Completions* to special-display-buffer-names even if
;; 1on1-*Completions*-frame-flag is nil, so minibuffer gets focus.
;; Set w(in)32-grab-focus-on-raise to nil.
;; 1on1-display-*Completions*-frame:
;; Don't change mouse pointer unless 1on1-*Completions*-frame-flag.
;; 1on1-minibuffer-frame-background: Use std minibuffer-frame-alist bg, if defined.
;; 2007/05/28 dadams
;; 1on1-display-*Completions*-frame:
;; Wrap zoom-frm-out in condition-case (hack for Emacs 23 problem changing size).
;; 2007/03/10 dadams
;; Added: 1on1-completions-frame-width. Use it in 1on1-emacs.
;; 2007/02/08 dadams
;; Removed: ^L-appearance-vector.
;; 1on1-emacs: No longer change ^L appearance - use my library pp-c-l.el to do that.
;; 2007/02/04 dadams
;; 1on1-emacs:
;; Initialize standard-display-table if nil (default is nil!). Thx to FidelSalas.
;; 2006/12/27 dadams
;; 1on1-change-cursor-on-input-method: Respect 1on1-change-cursor-on-input-method-flag
;; 2006/12/12 dadams
;; Added: 1on1-^L-appearance-vector.
;; 1on1-emacs: Use 1on1-^L-appearance-vector to set ^L appearance.
;; 2006/12/11 dadams
;; 1on1-set-minibuffer-frame-top/bottom: 2 chars up, not 1, to fit Emacs 22 better.
;; 2006/10/28 dadams
;; 1on1-(in)active-minibuffer-frame-background,
;; 1on1-isearch-minibuffer-frame-background, 1on1-(in)active-mode-line-background,
;; 1on1-(help|completions)-frame-background,
;; 1on1-(help|completions)-frame-mouse+cursor-color,
;; 1on1-default-frame-cursor-color(-input-method):
;; Changed :type to 'color for Emacs 21+.
;; 2006/09/14 dadams
;; Removed mode-line position enhancements - use new library modeline-posn.el.
;; Removed: 1on1-color-mode-line-column-flag, 1on1-mode-line-column-limit.
;; 2006/09/04 dadams
;; 1on1-box-cursor-when-idle-timer: Cancel beforehand, and cancel after defining.
;; 1on1-toggle-box-cursor-when-idle:
;; Use 1on1-box-cursor-when-idle-off on pre-command-hook.
;; Don't read an event; just turn it on.
;; Added: 1on1-box-cursor-when-idle-off.
;; 2006/09/02 dadams
;; 1on1-toggle-box-cursor-when-idle: Corrected.
;; 2006/08/27 dadams
;; Added: 1on1-box-cursor-when-idle(-p|-interval|-timer), 1on1-last-cursor-type,
;; (1on1-)toggle-box-cursor-when-idle, 1on1-set-box-cursor-when-idle-interval.
;; 2006/08/13 dadams
;; defalias set-cursor-type to 1on1-set-cursor-type.
;; 2006/07/25 dadams
;; Added: 1on1-minibuffer-frame-left. Use in 1on1-minibuffer-frame-alist.
;; 2006/03/31 dadams
;; 1on1-default-frame-alist:
;; Changed (left|right)-fringe code, to reflect Emacs 22 change.
;; 2006/03/17 dadams
;; Renamed:
;; 1on1-color-active-minibuffer-frame to 1on1-color-minibuffer-frame-on-setup,
;; 1on1-color-inactive-minibuffer-frame to 1on1-color-minibuffer-frame-on-exit.
;; 1on1-color-minibuffer-frame-on-setup:
;; Redefined so hue depends on minibuffer-depth.
;; 2006/03/14 dadams
;; 1on1-color-(in)active-minibuffer-frame: Change hue for each minibuffer recursion.
;; Added: 1on1-increment-color-hue.
;; Require hexrgb.el
;; 2006/03/13 dadams
;; 1on1-color-inactive-minibuffer-frame:
;; Change color only when not in recursive minibuffer.
;; abort-recursive-edit: Change minibuffer color after, not before, abort.
;; 2006/01/07 dadams
;; Added :link
;; 2005/12/14 dadams
;; Added: 1on1-*Completions*-frame-at-right-flag.
;; Use in 1on1-display-*Completions*-frame.
;; 2005/11/28 dadams
;; Added: 1on1-change-cursor-on-overwrite-flag,
;; 1on1-change-cursor-on-input-method-flag, 1on1-default-frame-cursor-type,
;; 1on1-default-frame-cursor-type-overwrite, 1on1-default-frame-cursor-color,
;; 1on1-default-frame-cursor-color-input-mode, 1on1-change-cursor-on-overwrite,
;; 1on1-change-cursor-on-insert-mode, 1on1-set-cursor-type (thanks to
;; Juri Linkov for the last three).
;; 1on1-emacs: Use 1on1-change-cursor-* in post-command-hook.
;; 1on1-mode-line-column-limit: Corrected custom group.
;; 2005/11/22 dadams
;; Added: 1on1-setup-mode-line, 1on1-mode-line-column-limit,
;; 1on1-color-mode-line(-column)-flag, 1on1-(in)active-mode-line-background.
;; 2005/10/28 dadams
;; 1on1-display-*Completions*-frame: Zoom to smaller font.
;; 2005/07/31 dadams
;; 1on1-emacs: Do not set initial-frame-alist to default-frame-alist (D. Reitter).
;; 2005/07/25 dadams
;; Added :prefix to defgroup.
;; 2005/07/17 dadams
;; Switched default colors for 1on1-(in)active-minibuffer-frame-background,
;; so active is the brighter color. Change inactive to LightBlue.
;; 2005/06/01 dadams
;; Corrected typo that gave minibuffer frame a vertical scroll bar.
;; 2005/05/29 dadams
;; *-alist: Use values from standard alist variables, if available (that is,
;; don't override user settings.)
;; 2005/05/28 dadams
;; Renamed: 1on1-separate-minibuffer-frame-flag -> 1on1-minibuffer-frame-flag,
;; 1on1-separate-*Help*-frame-flag -> 1on1-*Help*-frame-flag,
;; 1on1-separate-*Completions*-frame-flag -> 1on1-*Completions*-frame-flag.
;; Added: setup-minibuffer-frame-coloring.
;; Added info in doc strings about use of each variable (restart/1on1-emacs).
;; Corrected 1on1-minibuffer-frame-alist and 1on1-special-display-frame-alist
;; for menu-bar-lines (nil).
;; 1on1-set-minibuffer-frame-top/bottom: Rewrote with modify-frame-parameters.
;; 1on1-emacs:
;; Make sensitive to any changes to 1on1-*[Help|Completions]*-frame-flag.
;; Move defcustom's, defvar's, and defun's outside 1on1-emacs.
;; If 1on1-minibuffer-frame already exists, just modify it.
;; Don't step on other parameters in standard alists; just append new values.
;; 2005/05/23 dadams
;; Changed some individual frame-parameter variables from defcustom to defvar.
;; Left them as user options, however, so you can change them with
;; set-variable before loading oneonone.el.
;; Renamed:
;; 1on1-upper-left-frame-corner-default ->
;; 1on1-default-frame-upper-left-corner
;; 1on1-default-special-display-frame-size ->
;; 1on1-default-special-frame-size
;; 1on1-upper-left-special-display-frame-corner-default ->
;; 1on1-default-special-frame-upper-left-corner
;; Split 1on1-menu-bar-lines into: 1on1-default-special-frame-menu-bar-lines,
;; 1on1-default-frame-menu-bar-lines
;; 2005/05/18 dadams
;; Fixed typo: "oneoneone" -> "oneonone".
;; 2005/05/17 dadams
;; Updated to work with Emacs 22.x.
;; 2005/05/09 dadams
;; Major reorganization/rewrite. Created, from previous version setup-frames.el.
;; Added prefix "1on1-".
;; Encapsulated stuff in new command 1on1-emacs.
;; 2005/01/29 dadams
;; 1on1-default-frame-font: Fixed bug - misplaced parens, so no good if not Windows.
;; 2005/01/19 dadams
;; Use defcustom now.
;; Removed (put ... 'variable-interactive...).
;; 1on1-minibuffer-frame-top/bottom: Must be an integer (for set-frame-position).
;; 2004/12/18 dadams
;; Bind after-make-frame-functions to nil when create 1on1-minibuffer-frame.
;; 2004/11/26 dadams
;; Removed ;;;###autoload's.
;; 2004/11/20 dadams
;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x)
;; 2004/10/01 dadams
;; Ensure loaded before compile.
;; No fringe.
;; Remove *info* and *Customiz.* buffers from `same-window-regexps'
;; 2004/09/21 dadams
;; Updated to work with Emacs 21 (and Emacs 20).
;; 2004/03/19 dadams
;; 1on1-minibuffer-frame-width -> 1on1-set-minibuffer-frame-width.
;; added 1on1-set-minibuffer-frame-top/bottom.
;; 2001/01/05 dadams
;; 1. 1on1-minibuffer-frame-width: Use 1on1-minibuffer-frame arg for frame-char-width.
;; 2. Don't define width when initially set 1on1-minibuffer-frame-alist. Instead,
;; use set-frame-width afterward, so 1on1-minibuffer-frame-width uses correct
;; character size.
;; 2001/01/05 dadams
;; 1. These vars no longer user options (interactively changeable):
;; 1on1-completions-frame-background, 1on1-completions-frame-mouse+cursor-color,
;; 1on1-help-frame-background, 1on1-help-frame-mouse+cursor-color,
;; 1on1-minibuffer-frame-cursor-color, 1on1-minibuffer-frame-font,
;; 1on1-minibuffer-frame-foreground, 1on1-minibuffer-frame-height,
;; 1on1-minibuffer-frame-mouse-color, 1on1-minibuffer-frame-top/bottom,
;; 1on1-minibuffer-frame-width.
;; 2. Added: 1on1-minibuffer-frame-width (function),
;; 1on1-minibuffer-frame-width-percent (var).
;; 3. Changed var 1on1-minibuffer-frame-width to nil default (now use *-percent).
;; 2000/09/27 dadams
;; 1. Added: 1on1-display-*Completions*-frame, 1on1-display-*Help*-frame.
;; 2. *Help* & *Completions* frames not created here. Instead, use
;; special-display-buffer-names & display-*-frame fns to define them.
;; 3. Added: top-level, abort-recursive-edit.
;; 1999/08/24 dadams
;; 1. Windows: win32-grab-focus-on-raise = nil.
;; 2. 1on1-default-frame-font different if Windows.
;; 3. Added: 1on1-separate-minibuffer-frame-flag, 1on1-menu-bar-lines,
;; 1on1-upper-left-frame-corner-default, 1on1-default-frame-size,
;; 1on1-upper-left-special-display-frame-corner-default,
;; 1on1-default-special-display-frame-size, 1on1-default-special-frame-foreground,
;; 1on1-default-special-frame-background, 1on1-default-special-frame-font,
;; 1on1-default-special-frame-mouse-color, 1on1-default-special-frame-cursor-color.
;; 4. Use new vars to define default-frame-alist, special-display-frame-alist.
;; 5. Only create built-in frames if 1on1-separate-minibuffer-frame-flag.
;; 6. Protected refs to x-* vars.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-and-compile (require 'cl)) ;; remove-if (plus, for Emacs < 20, when, unless)
(require 'frame-cmds nil t) ;; (no error if not found): rename-frame
(require 'files+ nil t) ;; (no error if not found): switch-to-buffer-other-frame
(require 'zoom-frm nil t) ;; (no error if not found): zoom-frm-out
(require 'hexrgb) ;; hexrgb-color-values-to-hex, hexrgb-hsv-to-rgb, hexrgb-rgb-to-hsv
;; Ensure that this is loaded before compiling it.
(provide 'oneonone)
(require 'oneonone)
;; To quiet the byte compiler
(unless (> emacs-major-version 21)
(defvar x-pointer-box-spiral)
(defvar x-pointer-xterm))
;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup One-On-One nil
"Options to define initial frame configuration."
:prefix "1on1-" :group 'frames
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
oneonone.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/oneonone.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/OneOnOneEmacs")
:link '(emacs-commentary-link :tag "Commentary" "oneonone")
)
\f
;;; Minibuffer frame: ********************************
;;;
(defvar 1on1-minibuffer-frame nil
"Minibuffer-only frame used by One-on-One Emacs.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.")
(defcustom 1on1-minibuffer-frame-flag t
"*Non-nil means use a separate, specialized frame for the minibuffer.
If you change this variable, you will need to restart Emacs for it to
take effect."
:type 'boolean :group 'One-On-One)
(defvar 1on1-minibuffer-frame-foreground "Red"
"Default foreground color for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-background
(or (cdr (assq 'background-color minibuffer-frame-alist)) "LightBlue")
"Initial color of the `1on1-minibuffer-frame' background.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defcustom 1on1-active-minibuffer-frame-background "PaleGoldenrod"
"*The color of the `1on1-minibuffer-frame' when it is active.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-inactive-minibuffer-frame-background 1on1-minibuffer-frame-background
"*The color of the `1on1-minibuffer-frame' when it is inactive.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-isearch-minibuffer-frame-background "bisque"
"*Color of the `1on1-minibuffer-frame' when `isearch' is active.
See `1on1-color-isearch-minibuffer-frame'.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-color-mode-line-flag t
"*Non-nil means use `1on1-(in)active-mode-line-background'.
If you change this variable, you will need to restart Emacs for it to
take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-color-minibuffer-frame-on-exit-increment 5
"Increment to change minibuffer-frame hue when minibuffer is exited.
This should be opposite in sign to
`1on1-color-minibuffer-frame-on-setup-increment.'"
:type 'integer :group 'One-On-One)
(defcustom 1on1-color-minibuffer-frame-on-setup-increment -10
"Increment to change minibuffer-frame hue when minibuffer is entered.
This should be opposite in sign to
`1on1-color-minibuffer-frame-on-exit-increment.'"
:type 'integer :group 'One-On-One)
(defcustom 1on1-active-mode-line-background 1on1-active-minibuffer-frame-background
"*The color of the mode-line when it is active.
Note: This is not used if `1on1-color-mode-line-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-inactive-mode-line-background "LightGray"
"*The color of the mode-line when it is inactive.
Note: This is not used if `1on1-color-mode-line-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defvar 1on1-minibuffer-frame-font
(if (eq system-type 'windows-nt)
"-*-Lucida Console-normal-r-*-*-14-112-96-96-c-*-iso8859-1"
;;;;;;;"-*-Lucida Console-normal-r-*-*-15-*-*-*-c-*-*-ansi-"
"-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1")
"Default font for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-mouse-color "Black"
"Default mouse color for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-cursor-color "Black"
"Default text cursor color for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-height 2
"Height of minibuffer frame, in characters.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defcustom 1on1-minibuffer-frame-left 0
"*Position of left edge of minibuffer frame, in pixels.
An integer. If negative, then the position is that of the frame
bottom relative to the screen right (not left) edge.
See `default-frame-alist' for an explanation of frame parameters.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'integer :group 'One-On-One)
(defcustom 1on1-minibuffer-frame-top/bottom nil
"*Position of top (or bottom) of minibuffer frame, in pixels.
If nil, function `1on1-set-minibuffer-frame-top/bottom' will position
minibuffer at bottom of display.
An integer. If negative, then the position is that of the frame
bottom relative to the screen bottom.
See `default-frame-alist' for an explanation of frame parameters.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type '(choice (const :tag "Use function `1on1-set-minibuffer-frame-top/bottom'" nil)
(integer :tag "Pixels from top (>= 0) or bottom (< 0)" :value 0))
:group 'One-On-One)
(defcustom 1on1-minibuffer-frame-width nil
"Width, in characters, for minibuffer frame.
If nil, then function `1on1-set-minibuffer-frame-width' is used instead.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type '(choice (const :tag "Use function `1on1-set-minibuffer-frame-width'" nil)
(integer :tag "Width, in characters, for minibuffer frame" :value 0))
:group 'One-On-One)
(defcustom 1on1-minibuffer-frame-width-percent 100
"Max percent of the total display width to give to minibuffer frame.
See function `1on1-set-minibuffer-frame-width'.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'integer :group 'One-On-One)
;; Use values from the standard list, when available. However, we have no way of
;; distinguishing values predefined in vanilla Emacs from user settings.
(defcustom 1on1-minibuffer-frame-alist
(list
(or (assq 'foreground-color minibuffer-frame-alist)
(cons 'foreground-color 1on1-minibuffer-frame-foreground))
(or (assq 'background-color minibuffer-frame-alist)
(cons 'background-color 1on1-minibuffer-frame-background))
(or (assq 'font minibuffer-frame-alist)
(cons 'font 1on1-minibuffer-frame-font))
(or (assq 'mouse-color minibuffer-frame-alist)
(cons 'mouse-color 1on1-minibuffer-frame-mouse-color))
(or (assq 'cursor-color minibuffer-frame-alist)
(cons 'cursor-color 1on1-minibuffer-frame-cursor-color))
(or (assq 'menu-bar-lines minibuffer-frame-alist)
(cons 'menu-bar-lines nil))
(or (assq 'left minibuffer-frame-alist)
(cons 'left 1on1-minibuffer-frame-left))
(or (assq 'height minibuffer-frame-alist)
(cons 'height 1on1-minibuffer-frame-height))
(or (assq 'icon-type minibuffer-frame-alist)
(cons 'icon-type (< emacs-major-version 21))) ; `t' for Emacs 21 too?
(or (assq 'minibuffer minibuffer-frame-alist)
(cons 'minibuffer 'only))
(or (assq 'user-position minibuffer-frame-alist)
(cons 'user-position t))
(or (assq 'vertical-scroll-bars minibuffer-frame-alist) ; No scroll bar.
(cons 'vertical-scroll-bars nil))
(or (assq 'name minibuffer-frame-alist)
(cons 'name "Emacs Minibuffer")))
"Frame-parameter alist for the standalone minibuffer frame
`1on1-minibuffer-frame'.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
;; If we didn't need Emacs 20 compatibility, this could be:
;; :type '(alist :key-type symbol :value-type sexp)
:type '(repeat (cons :format "%v" (symbol :tag "Frame Parameter") (sexp :tag "Value")))
:group 'One-On-One)
\f
;;; *Help* frame: ********************************
;;; Display of *Help* buffer in custom frame.
;;; Background, height, cursor and pointer colors.
;;;
(defcustom 1on1-*Help*-frame-flag t
"*Non-nil means use a special appearance for the *Help* frame.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-help-frame-background "Thistle"
"Default background color for the *Help* buffer's frame.
Note: This is not used if `1on1-*Help*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-help-frame-mouse+cursor-color "Blue Violet"
"Default color for cursor & pointer of *Help* frame.
Note: This is not used if `1on1-*Help*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
\f
;;; *Completions* frame: ********************************
;;; Display of *Completion* buffer in custom frame.
;;; Background, height, cursor and pointer colors.
;;;
(defcustom 1on1-*Completions*-frame-flag t
"*Non-nil means use a special appearance for the *Completions* frame.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-*Completions*-frame-at-right-flag nil
"*Non-nil means place *Completions* frame at right edge of display.
This can be useful to make *Completions* more visible.
This has no effect if `1on1-*Completions*-frame-flag' is nil."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-completions-frame-background "LavenderBlush2"
"Default background color for the *Completions* buffer's frame.
Note: This is not used if `1on1-*Completions*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-completions-frame-mouse+cursor-color "VioletRed"
"Default color for cursor & pointer of *Completions* frame.
Note: This is not used if `1on1-*Completions*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-completions-frame-width 100
"Width, in characters, for *Completions* frame.
If this is nil, then the pertinent default frame width is used.
Note: This is not used if `1on1-*Completions*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'integer :group 'One-On-One)
\f
;;; Default for normal frames: `1on1-default-frame-alist' **************************
;;;
(defvar 1on1-default-frame-foreground "Black"
"Default foreground color for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-background "LightBlue"
"Default background color for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-font
(if (eq system-type 'windows-nt)
"-*-Lucida Console-normal-r-*-*-14-112-96-96-c-*-iso8859-1"
;;;;;;"-*-Lucida Console-normal-r-*-*-15-*-*-*-c-*-*-ansi-"
"-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1")
"Default font for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-mouse-color "Red"
"Default mouse-pointer color for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defcustom 1on1-change-cursor-on-input-method-flag t
"*Non-nil means to use a different cursor when using an input method.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-default-frame-cursor-color "Red"
"*Default text cursor color for non-special frames.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect. Furthermore, if
`1on1-change-cursor-on-input-method-flag' is nil when you rerun
`1on1-emacs', you will need to toggle that variable to non-nil (and
back to nil, if that's the value you want). Otherwise, the new value
will take effect only after you restart Emacs."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-default-frame-cursor-color-input-method "Orange"
"*Default cursor color for non-special frames if using an input method.
This has no effect if `1on1-change-cursor-on-input-method-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-change-cursor-on-overwrite/read-only-flag t
"*Non-nil means use a different cursor when overwrite mode or read-only.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-default-frame-cursor-type 'bar
"*Default text cursor type for non-special frames.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect. Furthermore, if
`1on1-change-cursor-on-overwrite/read-only-flag' is nil when you rerun
`1on1-emacs', you will need to toggle that variable to non-nil (and
back to nil, if that's the value you want). Otherwise, the new value
will take effect only after you restart Emacs."
:type 'symbol :group 'One-On-One)
(defvar 1on1-last-cursor-type 1on1-default-frame-cursor-type "Saved last cursor type.")
(defcustom 1on1-default-frame-cursor-type-overwrite/read-only 'box
"*Default text cursor type for overwrite mode or read-only buffer.
This applies only to non-special frames. This has no effect if
`1on1-change-cursor-on-overwrite/read-only-flag' is nil. If you
customize this variable, you will need to rerun `1on1-emacs' for the
new value to take effect."
:type 'symbol :group 'One-On-One)
(defvar 1on1-box-cursor-when-idle-p t
"Non-nil means to use a box cursor whenever Emacs is idle.
Do NOT change this yourself; instead, use `\\[toggle-box-cursor-when-idle]'.")
(defvar 1on1-box-cursor-when-idle-interval 2
"Number of seconds to wait before changing cursor type to box.
Do NOT change this yourself to change the wait period; instead, use
`\\[1on1-set-box-cursor-when-idle-interval]'.")
(defvar 1on1-box-cursor-when-idle-timer
(progn ; Cancel to prevent duplication.
(when (boundp '1on1-box-cursor-when-idle-timer)
(cancel-timer 1on1-box-cursor-when-idle-timer))
(run-with-idle-timer 1on1-box-cursor-when-idle-interval t '1on1-box-cursor-when-idle))
"Timer used to change the cursor to a box cursor when Emacs is idle.")
;; Turn it off, by default. You must use `toggle-box-cursor-when-idle' to turn it on.
(cancel-timer 1on1-box-cursor-when-idle-timer)
(defvar 1on1-default-frame-menu-bar-lines 1
"Number of lines used for the menu bar in non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-upper-left-corner '(0 . 0)
"Position of upper left frame corner.
A cons whose car is the distance from the top in pixels
and whose cdr is the distance from the left in pixels.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-size '(80 . 35)
"Default frame size.
A cons whose car is the frame width in pixels
and whose cdr is the frame height in pixels.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
;; Use values from the standard list, when available. However, we have no way of
;; distinguishing values predefined in vanilla Emacs from user settings.
(defcustom 1on1-default-frame-alist
(list
(or (assq 'foreground-color default-frame-alist)
(cons 'foreground-color 1on1-default-frame-foreground))
(or (assq 'background-color default-frame-alist)
(cons 'background-color 1on1-default-frame-background))
(or (assq 'font default-frame-alist)
(cons 'font 1on1-default-frame-font))
(or (assq 'mouse-color default-frame-alist)
(cons 'mouse-color 1on1-default-frame-mouse-color))
(or (assq 'cursor-color default-frame-alist)
(cons 'cursor-color 1on1-default-frame-cursor-color))
(or (assq 'cursor-type default-frame-alist)
(cons 'cursor-type 1on1-default-frame-cursor-type))
(or (assq 'menu-bar-lines default-frame-alist)
(cons 'menu-bar-lines 1on1-default-frame-menu-bar-lines))
(or (assq 'top default-frame-alist)
(cons 'top (car 1on1-default-frame-upper-left-corner)))
(or (assq 'left default-frame-alist)
(cons 'left (cdr 1on1-default-frame-upper-left-corner)))
(or (assq 'width default-frame-alist)
(cons 'width (car 1on1-default-frame-size)))
(or (assq 'height default-frame-alist)
(cons 'height (cdr 1on1-default-frame-size)))
(or (assq 'minibuffer default-frame-alist)
(cons 'minibuffer (not 1on1-minibuffer-frame-flag)))
(or (assq 'user-position default-frame-alist)
(cons 'user-position t))
(or (assq 'vertical-scroll-bars default-frame-alist)
(cons 'vertical-scroll-bars 'right))
(or (assq 'icon-type default-frame-alist)
(cons 'icon-type (< emacs-major-version 21))) ; `t' for Emacs 21 too?
(or (assq 'tool-bar-lines default-frame-alist)
(cons 'tool-bar-lines 1)) ; Emacs 21+
(if (cdr (assq 'left-fringe default-frame-alist))
(assq 'left-fringe default-frame-alist)
(cons 'left-fringe 0)) ; Emacs 21+
(if (cdr (assq 'right-fringe default-frame-alist))
(assq 'right-fringe default-frame-alist)
(cons 'right-fringe 0)) ; Emacs 21+
(or (assq 'fringe default-frame-alist)
(cons 'fringe 0))) ; Emacs 21, but not 21.3.50 - REMOVE after 22.x
"Properties to be used for One-on-One Emacs `default-frame-alist'.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
;; If we didn't need Emacs 20 compatibility, this could be:
;; :type '(alist :key-type symbol :value-type sexp)
:type '(repeat (cons :format "%v" (symbol :tag "Frame Parameter") (sexp :tag "Value")))
:group 'One-On-One)
\f
;;; Special-display frames: `1on1-special-display-frame-alist' ************************
;;;
(defvar 1on1-default-special-frame-foreground "Black"
"Default foreground color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-background "LightSteelBlue"
"Default background color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-font
(if (eq system-type 'windows-nt)
"-*-Lucida Console-normal-r-*-*-14-112-96-96-c-*-iso8859-1"
;;;;;;;;"-*-Lucida Console-normal-r-*-*-15-*-*-*-c-*-*-ansi-"
"-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1")
"Default font for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-mouse-color "Yellow"
"Default mouse color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-cursor-color "Yellow"
"Default text cursor color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-menu-bar-lines 1
"Number of lines used for the menu bar of special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-upper-left-corner '(0 . 0)
"Position of upper left corner of special display frames.
A cons whose car is the distance from the top in pixels
and whose cdr is the distance from the left in pixels.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-size '(80 . 20)
"Default size of special display frames.
A cons whose car is the frame width in pixels
and whose cdr is the frame height in pixels.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
;; Use values from the standard list, when available. However, we have no way of
;; distinguishing values predefined in vanilla Emacs from user settings.
(defcustom 1on1-special-display-frame-alist
(list
(or (assq 'font special-display-frame-alist)
(cons 'font 1on1-default-special-frame-font))
(or (assq 'width special-display-frame-alist)
(cons 'width (car 1on1-default-special-frame-size)))
(or (assq 'height special-display-frame-alist)
(cons 'height (cdr 1on1-default-special-frame-size)))
(or (assq 'mouse-color special-display-frame-alist)
(cons 'mouse-color 1on1-default-special-frame-mouse-color))
(or (assq 'cursor-color special-display-frame-alist)
(cons 'cursor-color 1on1-default-special-frame-cursor-color))
(or (assq 'menu-bar-lines special-display-frame-alist)
(cons 'menu-bar-lines 1on1-default-special-frame-menu-bar-lines))
(or (assq 'foreground-color special-display-frame-alist)
(cons 'foreground-color 1on1-default-special-frame-foreground))
(or (assq 'background-color special-display-frame-alist)
(cons 'background-color 1on1-default-special-frame-background))
(or (assq 'top special-display-frame-alist)
(cons 'top (car 1on1-default-special-frame-upper-left-corner)))
(or (assq 'left special-display-frame-alist)
(cons 'left (cdr 1on1-default-special-frame-upper-left-corner)))
(or (assq 'unsplittable special-display-frame-alist)
(cons 'unsplittable t))
(or (assq 'user-position special-display-frame-alist)
(cons 'user-position t))
(or (assq 'vertical-scroll-bars special-display-frame-alist)
(cons 'vertical-scroll-bars 'right)))
"Properties to be used for One-on-One `special-display-frame-alist'.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
;; If we didn't need Emacs 20 compatibility, this could be:
;; :type '(alist :key-type symbol :value-type sexp)
:type '(repeat (cons :format "%v" (symbol :tag "Frame Parameter") (sexp :tag "Value")))
:group 'One-On-One)
\f
;;; Main command ***************************************
;;;
;;;###autoload
(defun 1on1-emacs ()
"One-on-One Emacs setup.
Use `1on1-default-frame-alist' and `1on1-special-display-frame-alist'.
If `1on1-minibuffer-frame-flag' is non-nil, then create
minibuffer-only frame, `1on1-minibuffer-frame', using
`1on1-minibuffer-frame-alist'.
If `1on1-separate-minibuffer-*Help*-flag' is non-nil, then use
special frame for *Help* buffer.
If `1on1-separate-minibuffer-*Completions*-flag' is non-nil, then
use special frame for *Completions* buffer."
(interactive)
(setq default-frame-alist (append 1on1-default-frame-alist default-frame-alist)
special-display-frame-alist (append 1on1-special-display-frame-alist
special-display-frame-alist))
;; *Help* frame
(if 1on1-*Help*-frame-flag
(add-to-list
'special-display-buffer-names
(list "*Help*" '1on1-display-*Help*-frame
(list (cons 'background-color 1on1-help-frame-background)
(cons 'mouse-color 1on1-help-frame-mouse+cursor-color)
(cons 'cursor-color 1on1-help-frame-mouse+cursor-color)
'(height . 40))))
(setq special-display-buffer-names
(remove-if (lambda (elt) (equal "*Help*" (car elt)))
special-display-buffer-names)))
;; *Completions* frame
;; If `1on1-minibuffer-frame-flag' is non-nil, then *Completions* frame must be treated
;; specially, so that it gets focus from the minibuffer frame. This is so, even if
;; `1on1-*Completions*-frame-flag' is nil.
(if 1on1-minibuffer-frame-flag
(if 1on1-*Completions*-frame-flag
(add-to-list
'special-display-buffer-names
`("*Completions*" 1on1-display-*Completions*-frame
((background-color ,@1on1-completions-frame-background)
(mouse-color ,@1on1-completions-frame-mouse+cursor-color)
(cursor-color ,@1on1-completions-frame-mouse+cursor-color)
,@(and 1on1-completions-frame-width
`((width ,@1on1-completions-frame-width))))))
(add-to-list 'special-display-buffer-names
`("*Completions*" 1on1-display-*Completions*-frame)))
(setq special-display-buffer-names
(remove-if (lambda (elt) (equal "*Completions*" (car elt)))
special-display-buffer-names)))
;; Minibuffer frame
(when 1on1-minibuffer-frame-flag
;; `display-buffer' (& `*-other-window' fns) will use separate frames.
(setq pop-up-frames t
pop-up-frame-alist (append default-frame-alist pop-up-frame-alist))
;; Set up `1on1-minibuffer-frame'.
(setq minibuffer-frame-alist (append 1on1-minibuffer-frame-alist
minibuffer-frame-alist))
(if 1on1-minibuffer-frame
(modify-frame-parameters 1on1-minibuffer-frame 1on1-minibuffer-frame-alist)
(setq 1on1-minibuffer-frame
(let ((after-make-frame-functions nil)) ; E.g. inhibit `fit-frame'.
(make-frame 1on1-minibuffer-frame-alist))))
;; Resize and reposition it. If variable `1on1-minibuffer-frame-width'
;; or `1on1-minibuffer-frame-top/bottom' is nil, calculate automatically.
(1on1-set-minibuffer-frame-width)
(1on1-set-minibuffer-frame-top/bottom)
;; Rename minibuffer frame. (`rename-frame' is defined in `frame-cmds.el'.)
(when (fboundp 'rename-frame)
(rename-frame 1on1-minibuffer-frame "Emacs minibuffer \
show/hide: hold CTRL + click in window"))
(setq minibuffer-auto-raise t)
;; Background colors of minibuffer frame: 3 states
(add-hook 'isearch-mode-hook '1on1-color-isearch-minibuffer-frame)
(add-hook 'isearch-mode-end-hook '1on1-color-minibuffer-frame-on-exit)
(add-hook 'minibuffer-setup-hook '1on1-color-minibuffer-frame-on-setup)
(add-hook 'minibuffer-exit-hook '1on1-color-minibuffer-frame-on-exit)
;; Redefine built-in fns so they color minibuffer frame.
(1on1-setup-minibuffer-frame-coloring))
;; Hooks.
(if 1on1-change-cursor-on-overwrite/read-only-flag
(add-hook 'post-command-hook '1on1-change-cursor-on-overwrite/read-only)
(1on1-set-cursor-type 1on1-default-frame-cursor-type)
(remove-hook 'post-command-hook '1on1-change-cursor-on-overwrite/read-only))
(if 1on1-change-cursor-on-input-method-flag
(add-hook 'post-command-hook '1on1-change-cursor-on-input-method)
(setq current-input-method nil)
(1on1-change-cursor-on-input-method)
(remove-hook 'post-command-hook '1on1-change-cursor-on-input-method))
(add-hook 'minibuffer-exit-hook '1on1-reset-minibuffer-frame)
(setq w32-grab-focus-on-raise nil
win32-grab-focus-on-raise nil) ; older name
(1on1-setup-mode-line))
;; This is inspired by code from Juri Linkov <juri@jurta.org>.
(defun 1on1-change-cursor-on-input-method ()
"Set cursor type depending on whether an input method is used or not."
(when 1on1-change-cursor-on-input-method-flag
(set-cursor-color
(if current-input-method
1on1-default-frame-cursor-color-input-method
(let ((bufname (buffer-name (current-buffer))))
(cond
((string= "*Help*" bufname) 1on1-help-frame-mouse+cursor-color)
((string= "*Completions*" bufname) 1on1-completions-frame-mouse+cursor-color)
((eq 1on1-minibuffer-frame (selected-frame))
1on1-minibuffer-frame-cursor-color)
((special-display-p bufname) 1on1-default-special-frame-cursor-color)
(t 1on1-default-frame-cursor-color)))))))
;; This is from Juri Linkov <juri@jurta.org>, with read-only added.
(defun 1on1-change-cursor-on-overwrite/read-only ()
"Set cursor type differently for overwrite mode and read-only buffer.
That is, use one cursor type for overwrite mode and read-only buffers,
and another cursor type otherwise."
(1on1-set-cursor-type (if (or buffer-read-only overwrite-mode)
1on1-default-frame-cursor-type-overwrite/read-only
1on1-default-frame-cursor-type)))
(unless (fboundp 'set-cursor-type) (defalias 'set-cursor-type '1on1-set-cursor-type))
;; This is essentially from Juri Linkov <juri@jurta.org>.
(defun 1on1-set-cursor-type (cursor-type)
"Set the cursor type of the selected frame to CURSOR-TYPE.
When called interactively, prompt for the type to use.
To get the frame's current cursor type, use `frame-parameters'."
(interactive
(list (intern (completing-read "Cursor type: "
(mapcar 'list '("box" "hollow" "bar" "hbar" nil))))))
(modify-frame-parameters (selected-frame) (list (cons 'cursor-type cursor-type))))
(defun 1on1-box-cursor-when-idle ()
"Change the cursor to a box cursor when Emacs is idle."
(let ((type (cdr (assoc 'cursor-type (frame-parameters)))))
(unless (eq type 'box)
(setq 1on1-last-cursor-type type)
(1on1-set-cursor-type 'box))))
(defun 1on1-box-cursor-when-idle-off ()
"Turn off changing the cursor to a box cursor when Emacs is idle."
(when 1on1-last-cursor-type (1on1-set-cursor-type 1on1-last-cursor-type)))
(defalias 'toggle-box-cursor-when-idle '1on1-toggle-box-cursor-when-idle)
(defun 1on1-toggle-box-cursor-when-idle (&optional arg)
"Turn on or off automatically changing to a box cursor when idle.
When on, the cursor is changed to a box whenever Emacs is idle.
With prefix argument, turn on if ARG > 0; else turn off."
(interactive "P")
(setq 1on1-box-cursor-when-idle-p
(if arg (> (prefix-numeric-value arg) 0) (not 1on1-box-cursor-when-idle-p)))
(cond (1on1-box-cursor-when-idle-p
(timer-activate-when-idle 1on1-box-cursor-when-idle-timer)
(add-hook 'pre-command-hook '1on1-box-cursor-when-idle-off)
(message "Turned ON making cursor a box when Emacs is idle."))
(t
(cancel-timer 1on1-box-cursor-when-idle-timer)
(remove-hook 'pre-command-hook '1on1-box-cursor-when-idle-off)
(message "Turned OFF making cursor a box when Emacs is idle."))))
(defun 1on1-set-box-cursor-when-idle-interval (secs)
"Set wait until automatically change to a box cursor when Emacs is idle.
Whenever Emacs is idle for this many seconds it will change the cursor
to a box.
To turn on or off automatically changing to a box cursor when idle,
use `\\[toggle-box-cursor-when-idle]."
(interactive
"nSeconds to idle, before changing to a box cursor: ")
(timer-set-idle-time 1on1-box-cursor-when-idle-timer
(setq 1on1-box-cursor-when-idle-interval secs)
t))
(defun 1on1-display-*Help*-frame (buf &optional args)
"Display *Help* buffer in its own frame.
`special-display-function' is used to do the actual displaying.
BUF and ARGS are the arguments to `special-display-function'."
(let ((old-ptr-shape x-pointer-shape)
return-window)
(when (boundp 'x-pointer-xterm)
(setq x-pointer-shape x-pointer-xterm))
(setq return-window (select-window (funcall special-display-function buf args)))
(raise-frame)
(setq x-pointer-shape old-ptr-shape)
return-window))
(defun 1on1-display-*Completions*-frame (buf &optional args)
"Display *Completions* buffer in its own frame.
`special-display-function' is used to do the actual displaying.
Completion input events are redirected to `1on1-minibuffer-frame'.
BUF and ARGS are the arguments to `special-display-function'."
(let ((old-ptr-shape x-pointer-shape)
return-window)
(when (and 1on1-*Completions*-frame-flag (boundp 'x-pointer-box-spiral))
(setq x-pointer-shape x-pointer-box-spiral))
(setq return-window (select-window (funcall special-display-function buf args)))
(when (fboundp 'zoom-frm-out)
(condition-case nil (progn (zoom-frm-out) (zoom-frm-out)) ; In `zoom-frm.el'.
(error nil)))
;; We reposition frame this way, instead of binding `special-display-frame-alist'
;; with this value, because `after-make-frame-functions' might resize frame.
(when 1on1-*Completions*-frame-at-right-flag
(modify-frame-parameters
(selected-frame) ; Hard-code 7 here - what does it depend on?
`((left . ,(- (x-display-pixel-width) (+ (frame-pixel-width) 7))))))
(raise-frame)
(when (boundp '1on1-minibuffer-frame)
(redirect-frame-focus (selected-frame) 1on1-minibuffer-frame))
(when (and 1on1-*Completions*-frame-flag (boundp 'x-pointer-box-spiral))
(setq x-pointer-shape old-ptr-shape))
return-window))
(defun 1on1-set-minibuffer-frame-top/bottom ()
"Set position of minibuffer frame.
Use `1on1-minibuffer-frame-top/bottom' if non-nil.
Else, place minibuffer at bottom of display."
(when (boundp '1on1-minibuffer-frame)
(modify-frame-parameters
1on1-minibuffer-frame
`((top ,@ (or 1on1-minibuffer-frame-top/bottom
(- (* 2 (frame-char-height 1on1-minibuffer-frame)))))))))
(defun 1on1-set-minibuffer-frame-width ()
"Set width of minibuffer frame, in characters.
Use `1on1-minibuffer-frame-width' if not nil.
Else, set width relative to character size of `1on1-minibuffer-frame'
and display size, and depending on
`1on1-minibuffer-frame-width-percent':
(/ (* 1on1-minibuffer-frame-width-percent (x-display-pixel-width))
(* 100 (frame-char-width 1on1-minibuffer-frame)))"
(when (boundp '1on1-minibuffer-frame)
(set-frame-width
1on1-minibuffer-frame
(or 1on1-minibuffer-frame-width
(/ (* 1on1-minibuffer-frame-width-percent (x-display-pixel-width))
(* 100 (frame-char-width 1on1-minibuffer-frame)))))))
(defun 1on1-color-minibuffer-frame-on-setup ()
"Change background of minibuffer frame to reflect the minibuffer depth.
Use this when increasing the minibuffer recursion depth."
(when (boundp '1on1-minibuffer-frame)
(save-window-excursion
(select-frame 1on1-minibuffer-frame)
(set-background-color 1on1-active-minibuffer-frame-background)
(let ((count (minibuffer-depth)))
(while (> count 1)
(set-background-color (1on1-increment-color-hue ; Change bg hue slightly.
(frame-parameter nil 'background-color)
1on1-color-minibuffer-frame-on-setup-increment))
(setq count (1- count)))))))
(defun 1on1-color-minibuffer-frame-on-exit ()
"Change background of minibuffer frame to reflect the minibuffer depth.
Use this when reducing the minibuffer recursion depth."
(when (boundp '1on1-minibuffer-frame)
(save-window-excursion
(select-frame 1on1-minibuffer-frame)
(if (< (minibuffer-depth) 2)
(set-background-color 1on1-inactive-minibuffer-frame-background)
(set-background-color (1on1-increment-color-hue ; Change bg hue slightly.
(frame-parameter nil 'background-color)
1on1-color-minibuffer-frame-on-exit-increment))))))
;; This is essentially a version of `doremi-increment-color-component' for hue only.
(defun 1on1-increment-color-hue (color increment)
"Increase hue component of COLOR by INCREMENT."
(unless (string-match "#" color) ; Convert color name to #hhh...
(setq color (hexrgb-color-values-to-hex (x-color-values color))))
;; Convert RGB to HSV
(let* ((rgb (x-color-values color))
(red (/ (float (nth 0 rgb)) 65535.0)) ; Convert from 0-65535 to 0.0-1.0
(green (/ (float (nth 1 rgb)) 65535.0))
(blue (/ (float (nth 2 rgb)) 65535.0))
(hsv (hexrgb-rgb-to-hsv red green blue))
(hue (nth 0 hsv))
(saturation (nth 1 hsv))
(value (nth 2 hsv)))
(setq hue (+ hue (/ increment 100.0)))
(when (> hue 1.0) (setq hue (1- hue)))
(hexrgb-color-values-to-hex (mapcar (lambda (x) (floor (* x 65535.0)))
(hexrgb-hsv-to-rgb hue saturation value)))))
(defun 1on1-color-isearch-minibuffer-frame ()
"Use `1on1-isearch-minibuffer-frame-background' for minibuffer."
(and (boundp '1on1-minibuffer-frame)
(save-window-excursion
(select-frame 1on1-minibuffer-frame)
(set-background-color
;; Can also try `x-defined-colors', defined in `x-win.el'.
;; It contains all colors currently supported by X windows.
(if (x-color-defined-p 1on1-isearch-minibuffer-frame-background)
1on1-isearch-minibuffer-frame-background
"white")))))
(defun 1on1-flash-ding-minibuffer-frame (&optional do-not-terminate)
"Ring bell (`ding'), after flashing minibuffer frame, if relevant.
Terminates any keyboard macro executing, unless arg DO-NOT-TERMINATE non-nil."
(flash-ding do-not-terminate (and (boundp '1on1-minibuffer-frame)
1on1-minibuffer-frame)))
(defun 1on1-setup-minibuffer-frame-coloring ()
"Redefine some built-in functions so they color the minibuffer frame.
Functions redefined: `y-or-n-p', `top-level', `abort-recursive-exit'."
(or (fboundp 'old-y-or-n-p)
(fset 'old-y-or-n-p (symbol-function 'y-or-n-p)))
;; REPLACES ORIGINAL (built-in function):
;; Temporarily colors minibuffer frame to "active" color.
;;
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
Takes one argument, which is the string to display to ask the question.
It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
No confirmation of answer is requested; a single character is enough.
Also accepts SPC to mean yes, or DEL to mean no."
(1on1-color-minibuffer-frame-on-setup)
(prog1 (old-y-or-n-p prompt) (1on1-color-minibuffer-frame-on-exit)))
(or (fboundp 'old-top-level)
(fset 'old-top-level (symbol-function 'top-level)))
;; REPLACES ORIGINAL (built-in function):
;; Resets color of minibuffer frame to "inactive" color.
;;
(defun top-level ()
"Exit all recursive editing levels."
(interactive)
(1on1-color-minibuffer-frame-on-exit)
(old-top-level))
(or (fboundp 'old-abort-recursive-edit)
(fset 'old-abort-recursive-edit (symbol-function 'abort-recursive-edit)))
;; REPLACES ORIGINAL (built-in function):
;; Resets color of minibuffer frame to "inactive" color.
;;
(defun abort-recursive-edit ()
"Abort command that requested this recursive edit or minibuffer input."
(interactive)
(1on1-color-minibuffer-frame-on-exit)
(old-abort-recursive-edit)))
(defun 1on1-setup-mode-line ()
"Set up mode-line faces."
(when 1on1-color-mode-line-flag
(set-face-background 'modeline 1on1-active-mode-line-background)
(when (facep 'mode-line-inactive) ; Emacs 22
(set-face-background 'mode-line-inactive 1on1-inactive-mode-line-background))))
(defun 1on1-reset-minibuffer-frame ()
(when 1on1-minibuffer-frame
(set-frame-size 1on1-minibuffer-frame
(frame-width 1on1-minibuffer-frame)
1on1-minibuffer-frame-height)
(1on1-set-minibuffer-frame-top/bottom)))
;; Bind this to some key in the minibuffer completion maps. I use `C-o'.
;;;###autoload
(defun 1on1-fit-minibuffer-frame ()
"Fit the standalone minibuffer frame height to its contents.
Repeat to increase the height by 1.
Bind this in minibuffer keymaps to a key such as `C-o' that you can
use during minibuffer input."
(interactive)
(unless (require 'fit-frame nil t)
(error "You need to load library `fit-frame.el' to use this command"))
;; We could assume the minibuffer frame is `1on1-minibuffer-frame', but we don't.
(when (and (active-minibuffer-window)
(save-selected-window
(select-window (minibuffer-window))
;; We should be able to use just (one-window-p),
;; but an Emacs bug means we need this:
(one-window-p nil 'selected-frame)))
(let* ((frame (save-selected-window
(select-window (minibuffer-window)) (selected-frame)))
(frame-height (frame-height frame)))
(cond ((eq last-command this-command)
(set-frame-height frame (1+ (frame-height frame)))
(1on1-set-minibuffer-frame-top/bottom)
(condition-case nil
(scroll-down (frame-height frame))
(error nil)))
(t
(let* ((beg (1on1-minibuffer-prompt-end))
(frame-width (frame-width frame))
(fit-frame-min-width frame-width)
(window-min-width frame-width)
(fit-frame-max-width frame-width)
(fit-frame-empty-width frame-width)
(fit-frame-empty-special-display-width frame-width)
(fit-frame-min-height frame-height)
(window-min-height frame-height)
(fit-frame-empty-height frame-height)
(fit-frame-empty-special-display-height frame-height))
(fit-frame frame)
(when (>= emacs-major-version 21)
(set-frame-height frame (1+ (frame-height frame)))) ; A little extra.
(1on1-set-minibuffer-frame-top/bottom)
(condition-case nil (scroll-down (frame-height frame)) (error nil))))))))
(defun 1on1-minibuffer-prompt-end ()
"Version of `minibuffer-prompt-end' that works for Emacs 20 and later."
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) (point-min)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; oneonone.el ends here
[-- Attachment #4: bug-garbled-about-emacs.png --]
[-- Type: image/png, Size: 53271 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
@ 2008-08-02 20:50 Chong Yidong
2008-08-02 21:27 ` Drew Adams
0 siblings, 1 reply; 21+ messages in thread
From: Chong Yidong @ 2008-08-02 20:50 UTC (permalink / raw)
To: Drew Adams; +Cc: 642
Please try to construct a smaller testcase.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-08-02 20:23 ` bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen Drew Adams
@ 2008-08-02 21:05 ` Jason Rumney
2008-08-02 21:27 ` Drew Adams
2008-10-29 21:14 ` Drew Adams
2008-11-23 15:30 ` bug#642: marked as done (23.0.60; garbled text (wrong font?) in About GNU Emacs screen) Emacs bug Tracking System
1 sibling, 2 replies; 21+ messages in thread
From: Jason Rumney @ 2008-08-02 21:05 UTC (permalink / raw)
To: Drew Adams, 642; +Cc: emacs-pretest-bug
Drew Adams wrote:
> emacs -Q --debug-init -l ".../path/to/hexrgb.el" -l ".../path/to/oneonone.el" -f
> "1on1-emacs"
I can't reproduce this bug. If you position the cursor on one of the
affected characters and press C-u C-x =, what does it say. If the
resulting Help buffer is also garbled, please try to change the buffer's
font using Shift-Left Mouse.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-08-02 21:05 ` Jason Rumney
@ 2008-08-02 21:27 ` Drew Adams
2008-08-05 13:58 ` Drew Adams
2008-10-29 21:14 ` Drew Adams
1 sibling, 1 reply; 21+ messages in thread
From: Drew Adams @ 2008-08-02 21:27 UTC (permalink / raw)
To: 'Jason Rumney', 642; +Cc: emacs-pretest-bug
[-- Attachment #1: Type: text/plain, Size: 3554 bytes --]
> From: Jason Rumney Sent: Saturday, August 02, 2008 2:06 PM
> > emacs -Q --debug-init -l ".../path/to/hexrgb.el" -l
".../path/to/oneonone.el" -f "1on1-emacs"
>
> I can't reproduce this bug. If you position the cursor on one of the
> affected characters and press C-u C-x =, what does it say. If the
> resulting Help buffer is also garbled, please try to change
> the buffer's font using Shift-Left Mouse.
The text in the help buffer appears fine. If I put the cursor on the first `?'
char in the first text line (red) and do `C-u C-x =', *Help* shows this:
character: SPC (32, #o40, #x20)
preferred charset: ascii (ASCII (ISO646 IRV))
code point: 0x20
syntax: which means: whitespace
category: a:ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])
l:Latin
buffer code: #x20
file code: #x20 (encoded by coding system undecided-unix)
display: by this font (glyph code)
uniscribe:-outline-Helvetica-normal-normal-normal-sans-14-*-*-*-p-*-iso8859-1
(#x20)
Character code properties: customize what to show
name: SPACE
general-category: Zs (Separator, Space)
There are text properties here:
face (variable-pitch (:foreground "red"))
help-echo [Show]
[back]
Oddly enough, when I paste that text, it shows `SPC' for the character, but in
the *Help* buffer, it has `rob' for the character. I switched to HTML mail and
used a Unicode font (Arial Unicode MS), thinking that might make a difference,
but it didn't.
I then tried a cents char in the second text line (blue):
character: a (97, #o141, #x61)
preferred charset: ascii (ASCII (ISO646 IRV))
code point: 0x61
syntax: w which means: word
category: a:ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])
l:Latin r:Japanese roman
buffer code: #x61
file code: #x61 (encoded by coding system undecided-unix)
display: by this font (glyph code)
uniscribe:-outline-Helvetica-normal-normal-normal-sans-14-*-*-*-p-*-iso8859-1
(#x61)
Character code properties: customize what to show
name: LATIN SMALL LETTER A
general-category: Ll (Letter, Lowercase)
There are text properties here:
face (variable-pitch (:foreground "darkblue"))
help-echo [Show]
[back]
The cents character appears correctly in *Help*, but appears as `a' when pasted
into the mail.
I then tried a section symbol in the first tiny black text line:
character: f (102, #o146, #x66)
preferred charset: ascii (ASCII (ISO646 IRV))
code point: 0x66
syntax: w which means: word
category: a:ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])
l:Latin r:Japanese roman
buffer code: #x66
file code: #x66 (encoded by coding system undecided-unix)
display: by this font (glyph code)
uniscribe:-outline-Helvetica-normal-normal-normal-sans-11-*-*-*-p-*-iso8859-1
(#x66)
Character code properties: customize what to show
name: LATIN SMALL LETTER F
general-category: Ll (Letter, Lowercase)
There are text properties here:
face (variable-pitch (:height 0.8))
help-echo [Show]
[back]
Again, the section symbol appears correctly in *Help*, but appears as `f' in the
pasted text above.
Notice that the help text is describing what you see pasted above, but not what
I see in *Help*. For example, I see a section symbol, but it describes it as a
LATIN SMALL LETTER F.
HTH - Drew
[-- Attachment #2: Type: text/html, Size: 7278 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-08-02 20:50 Chong Yidong
@ 2008-08-02 21:27 ` Drew Adams
0 siblings, 0 replies; 21+ messages in thread
From: Drew Adams @ 2008-08-02 21:27 UTC (permalink / raw)
To: 'Chong Yidong'; +Cc: 642
> From: Chong Yidong Sent: Saturday, August 02, 2008 1:50 PM
> Please try to construct a smaller testcase.
Sorry, I don't have the time.
It's reproducible, and the recipe is simple to execute.
The code that sets up the frame parameters is straightforward.
A guess (just a guess) is that it's a problem with fonts. Another guess is that
it is related to bug #639: tabbar.el tab text being garbled. Both regressed in
the same way since 2008-07-26.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-08-02 21:27 ` Drew Adams
@ 2008-08-05 13:58 ` Drew Adams
0 siblings, 0 replies; 21+ messages in thread
From: Drew Adams @ 2008-08-05 13:58 UTC (permalink / raw)
To: 642, 'Jason Rumney'; +Cc: emacs-pretest-bug
[-- Attachment #1: Type: text/plain, Size: 115 bytes --]
I suspect this is related (and is simpler to reproduce): see attached
screenshot.
Recipe: emacs -Q, then C-h i.
[-- Attachment #2: bug-fonts-Info.png --]
[-- Type: image/png, Size: 70292 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-08-02 21:05 ` Jason Rumney
2008-08-02 21:27 ` Drew Adams
@ 2008-10-29 21:14 ` Drew Adams
2008-11-17 8:15 ` Drew Adams
1 sibling, 1 reply; 21+ messages in thread
From: Drew Adams @ 2008-10-29 21:14 UTC (permalink / raw)
To: 'Jason Rumney', 642; +Cc: emacs-pretest-bug
[-- Attachment #1.1: Type: text/plain, Size: 4418 bytes --]
I sent this reply on 2008-08-02, but I do NOT see it in the bug tracker.
The problem remains. The garbled text is in Info, tab-bar tabs, and the startup
screen.
This bug and #239 should NOT be merged with #597, IMO, since that is about text
that looks OK and gets garbled only after some time. This problem is seen from
the outset. It started around the time I filed #597 - no such problem before
that.
Attached are screenshots from a build of 2008-10-09 with emacs -Q:
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.1.2600)
of 2008-10-09 on LENNART-69DE564
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --no-opt --cflags -Ic:/g/include
-fno-crossjumping'
From: Drew Adams Sent: Saturday, August 02, 2008 2:27 PM
To: 'Jason Rumney'; '642@emacsbugs.donarmstrong.com'
Cc: 'emacs-pretest-bug@gnu.org'
> From: Jason Rumney Sent: Saturday, August 02, 2008 2:06 PM
> > emacs -Q --debug-init -l ".../path/to/hexrgb.el" -l
".../path/to/oneonone.el" -f "1on1-emacs"
>
> I can't reproduce this bug. If you position the cursor on one of the
> affected characters and press C-u C-x =, what does it say. If the
> resulting Help buffer is also garbled, please try to change
> the buffer's font using Shift-Left Mouse.
The text in the help buffer appears fine. If I put the cursor on the first `?'
char in the first text line (red) and do `C-u C-x =', *Help* shows this:
character: SPC (32, #o40, #x20)
preferred charset: ascii (ASCII (ISO646 IRV))
code point: 0x20
syntax: which means: whitespace
category: a:ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])
l:Latin
buffer code: #x20
file code: #x20 (encoded by coding system undecided-unix)
display: by this font (glyph code)
uniscribe:-outline-Helvetica-normal-normal-normal-sans-14-*-*-*-p-*-iso8859-1
(#x20)
Character code properties: customize what to show
name: SPACE
general-category: Zs (Separator, Space)
There are text properties here:
face (variable-pitch (:foreground "red"))
help-echo [Show]
[back]
Oddly enough, when I paste that text, it shows `SPC' for the character, but in
the *Help* buffer, it has `rob' for the character. I switched to HTML mail and
used a Unicode font (Arial Unicode MS), thinking that might make a difference,
but it didn't.
I then tried a cents char in the second text line (blue):
character: a (97, #o141, #x61)
preferred charset: ascii (ASCII (ISO646 IRV))
code point: 0x61
syntax: w which means: word
category: a:ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])
l:Latin r:Japanese roman
buffer code: #x61
file code: #x61 (encoded by coding system undecided-unix)
display: by this font (glyph code)
uniscribe:-outline-Helvetica-normal-normal-normal-sans-14-*-*-*-p-*-iso8859-1
(#x61)
Character code properties: customize what to show
name: LATIN SMALL LETTER A
general-category: Ll (Letter, Lowercase)
There are text properties here:
face (variable-pitch (:foreground "darkblue"))
help-echo [Show]
[back]
The cents character appears correctly in *Help*, but appears as `a' when pasted
into the mail.
I then tried a section symbol in the first tiny black text line:
character: f (102, #o146, #x66)
preferred charset: ascii (ASCII (ISO646 IRV))
code point: 0x66
syntax: w which means: word
category: a:ASCII graphic characters 32-126 (ISO646 IRV:1983[4/0])
l:Latin r:Japanese roman
buffer code: #x66
file code: #x66 (encoded by coding system undecided-unix)
display: by this font (glyph code)
uniscribe:-outline-Helvetica-normal-normal-normal-sans-11-*-*-*-p-*-iso8859-1
(#x66)
Character code properties: customize what to show
name: LATIN SMALL LETTER F
general-category: Ll (Letter, Lowercase)
There are text properties here:
face (variable-pitch (:height 0.8))
help-echo [Show]
[back]
Again, the section symbol appears correctly in *Help*, but appears as `f' in the
pasted text above.
Notice that the help text is describing what you see pasted above, but not what
I see in *Help*. For example, I see a section symbol, but it describes it as a
LATIN SMALL LETTER F.
HTH - Drew
[-- Attachment #1.2: Type: text/html, Size: 9386 bytes --]
[-- Attachment #2: throw-bug-info-text-garbled.PNG --]
[-- Type: image/png, Size: 69215 bytes --]
[-- Attachment #3: throw-bug-startup-screen.png --]
[-- Type: image/png, Size: 59665 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-10-29 21:14 ` Drew Adams
@ 2008-11-17 8:15 ` Drew Adams
0 siblings, 0 replies; 21+ messages in thread
From: Drew Adams @ 2008-11-17 8:15 UTC (permalink / raw)
To: 642, 'Jason Rumney'; +Cc: emacs-pretest-bug
[-- Attachment #1: Type: text/plain, Size: 2424 bytes --]
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.1.2600)
of 2008-11-08 on LENNART-69DE564
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --no-opt --cflags -Ic:/g/include
-fno-crossjumping'
Here is some more info about this. Attached is a screenshot showing font
families in Emacs 23 (on the left) and Emacs 22.3 (on the right).
I used the following code from Miles Bader:
(defun list-fonts-display ()
"Display a list of font-families available via font-config, in a new
buffer.
The name of each font family is displayed using that family, as
well as in the default font (to handle the case where a font
cannot be used to display its own name)."
(interactive)
(let (families)
(with-temp-buffer
(shell-command "fc-list : family" t)
(goto-char (point-min))
(while (not (eobp))
(push (buffer-substring (line-beginning-position)
(line-end-position))
families)
(forward-line)))
(let ((buf (get-buffer-create "*Font Families*")))
(with-current-buffer buf
(erase-buffer)
(dolist (family families)
(setq family (car (split-string family ",")))
(insert (concat (propertize family 'face (list :family family))
" (" family ")"))
(newline)))
(display-buffer buf))))
Other than that, I used emacs -Q and, to be able to use a bash shell, loaded
cygwin-mount.el and setup-cygwin.el
(http://www.emacswiki.org/emacs/cygwin-mount.el,
http://www.emacswiki.org/emacs/setup-cygwin.el). I also tried with just emacs -Q
and cmdproxy.exe, without loading the cygwin libraries - same result.
The display shows problems with font families Times and Helvetica. I use the
standard Times and Helvetica Type1 fonts on Windows XP. E.g., the Times Roman
font file is named TIR_____.PFM; the Helvetica file is HV_____.PFM.
Note too that font names such as Terminal do not appear in their own font in
this display in Emacs 23 (but they do in Emacs 22). I don't know if that is an
Emacs 23 bug or due to the nature of `list-fonts-display'.
It seems that the only font name that is displayed using its own font in Emacs
23 is Courier. The rest, except for Times and Helvetica, appear in some font
that is different from the default font - it looks like a Lucinda font.
(assoc 'font (frame-parameters)) in Emacs 23 gives (font . "-outline-Courier
New-normal-normal-normal-mono-13-*-*-*-c-*-iso8859-1").
[-- Attachment #2: bug-642-emacs-fonts.png --]
[-- Type: image/png, Size: 80908 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: marked as done (23.0.60; garbled text (wrong font?) in About GNU Emacs screen)
2008-08-02 20:23 ` bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen Drew Adams
2008-08-02 21:05 ` Jason Rumney
@ 2008-11-23 15:30 ` Emacs bug Tracking System
1 sibling, 0 replies; 21+ messages in thread
From: Emacs bug Tracking System @ 2008-11-23 15:30 UTC (permalink / raw)
To: Jason Rumney
[-- Attachment #1: Type: text/plain, Size: 887 bytes --]
Your message dated Sun, 23 Nov 2008 23:22:27 +0800
with message-id <49297533.3040505@f2s.com>
and subject line Re: bug#642: 23.0.60;garbled text (wrong font?) in About GNU Emacs screen
has caused the Emacs bug report #642,
regarding 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
to be marked as done.
This means that you claim that the problem has been dealt with.
If this is not the case it is now your responsibility to reopen the
bug report if necessary, and/or fix the problem forthwith.
(NB: If you are a system administrator and have no idea what this
message is talking about, this may indicate a serious mail system
misconfiguration somewhere. Please contact don@donarmstrong.com
immediately.)
--
642: http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=642
Emacs Bug Tracking System
Contact don@donarmstrong.com with problems
[-- Attachment #2: Type: message/rfc822, Size: 181268 bytes --]
[-- Attachment #2.1.1: Type: text/plain, Size: 819 bytes --]
emacs -Q --debug-init -l ".../path/to/hexrgb.el" -l ".../path/to/oneonone.el" -f
"1on1-emacs"
See attached files hexrgb.el and oneonone.el, and screenshot.
This is a regression wrt a build of 2008-07-26, where there was no such problem.
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.1.2600)
of 2008-08-01 on LENNART-69DE564
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --no-opt --cflags -Ic:/g/include
-fno-crossjumping'
Important settings:
value of $LC_ALL: nil
value of $LC_COLLATE: nil
value of $LC_CTYPE: nil
value of $LC_MESSAGES: nil
value of $LC_MONETARY: nil
value of $LC_NUMERIC: nil
value of $LC_TIME: nil
value of $LANG: ENU
value of $XMODIFIERS: nil
locale-coding-system: cp1252
default-enable-multibyte-characters: t
[-- Attachment #2.1.2: hexrgb.el --]
[-- Type: application/octet-stream, Size: 26932 bytes --]
;;; hexrgb.el --- Functions to manipulate colors, including RGB hex strings.
;;
;; Filename: hexrgb.el
;; Description: Functions to manipulate colors, including RGB hex strings.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 2004-2008, Drew Adams, all rights reserved.
;; Created: Mon Sep 20 22:58:45 2004
;; Version: 21.0
;; Last-Updated: Tue Jan 01 13:37:31 2008 (-28800 Pacific Standard Time)
;; By: dradams
;; Update #: 540
;; URL: http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el
;; Keywords: number, hex, rgb, color, background, frames, display
;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x
;;
;; Features that might be required by this library:
;;
;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Functions to manipulate colors, including RGB hex strings.
;;
;; This library provides functions for converting between RGB (red,
;; green, blue) color components and HSV (hue, saturation, value)
;; color components. It helps you convert among Emacs color values
;; (whole numbers from 0 through 65535), RGB and HSV floating-point
;; components (0.0 through 1.0), Emacs color-name strings (such as
;; "blue"), and hex RGB color strings (such as "#FC43A7912").
;;
;; An RGB hex string, such as used as a frame `background-color'
;; property, is a string of 1 + (3 * n) characters, the first of
;; which is "#". The other characters are hexadecimal digits, in
;; three groups representing (from the left): red, green, and blue
;; hex codes.
;;
;; Constants defined here:
;;
;; `hexrgb-defined-colors', `hexrgb-defined-colors-alist'.
;;
;; Commands defined here:
;;
;; `hexrgb-blue', `hexrgb-complement', `hexrgb-green',
;; `hexrgb-hue', `hexrgb-read-color', `hexrgb-red',
;; `hexrgb-saturation', `hexrgb-value'.
;;
;; Non-interactive functions defined here:
;;
;; `hexrgb-approx-equal', `hexrgb-color-name-to-hex',
;; `hexrgb-color-values-to-hex', `hexrgb-color-value-to-float',
;; `hexrgb-float-to-color-value', `hexrgb-hex-char-to-integer',
;; `hexrgb-hex-to-color-values', `hexrgb-hex-to-hsv',
;; `hexrgb-hex-to-rgb', `hexrgb-hsv-to-hex', `hexrgb-hex-to-int',
;; `hexrgb-hsv-to-rgb', `hexrgb-increment-blue',
;; `hexrgb-increment-equal-rgb', `hexrgb-increment-green',
;; `hexrgb-increment-hex', `hexrgb-increment-red',
;; `hexrgb-int-to-hex', `hexrgb-rgb-hex-string-p',
;; `hexrgb-rgb-to-hex', `hexrgb-rgb-to-hsv'.
;;
;;
;; Add this to your initialization file (~/.emacs or ~/_emacs):
;;
;; (require 'hexrgb)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2007/12/30 dadams
;; Added: hexrgb-hex-to-color-values.
;; 2007/10/20 dadams
;; hexrgb-read-color: Treat pseudo colors too (e.g. *point foreground*).
;; 2007/01/21 dadams
;; hexrgb-read-color: Error if empty string (and not allow-empty-name-p).
;; 2006/06/06 dadams
;; Added: hexrgb-defined-colors(-alist). Use instead of (x-defined-colors).
;; hexrgb-(red|green|blue): Added interactive specs.
;; 2006/06/04 dadams
;; hexrgb-read-color: Added optional arg allow-empty-name-p.
;; 2006/06/02 dadams
;; Added: hexrgb-rgb-hex-string-p. Used it.
;; 2006/05/30 dadams
;; Added: hexrgb-hex-to-(hsv|rgb), hexrgb-hsv-to-hex, hexrgb-color-name-to-hex,
;; hexrgb-complement, hexrgb-read-color, hexrgb-hue, hexrgb-saturation,
;; hexrgb-value, hexrgb-red, hexrgb-blue, hexrgb-green.
;; approx-equal: Add optional fuzz factor arguments. Changed the algorithm.
;; Renamed: approx-equal to hexrgb-approx-equal.
;; hexrgb-rgb-to-hsv: Changed test from < to <=: (when (<= hue 0.0)...).
;; hexrgb-hsv-to-rgb: Treat hue = 0.0 (int 0) the same as hue = 1.0 (int 6).
;; hexrgb-rgb-to-hex, hexrgb-increment-hex: Corrected doc strings.
;; 2006/05/22 dadams
;; Added: hexrgb-hsv-to-hex, hexrgb-rgb-to-hex. Require cl.el when byte-compile.
;; 2005/08/09 dadams
;; hexrgb-rgb-to-hsv: Side-stepped Emacs-20 bug in comparing NaN.
;; hexrgb-increment-*: Added optional arg wrap-p.
;; hexrgb-increment-hex: Prevent wrap if not wrap-p.
;; 2005/08/02 dadams
;; hexrgb-rgb-to-hes: Bug fix: If delta is zero, then so are hue and saturation.
;; 2005/06/24 dadams
;; hexrgb-rgb-to-hsv: Bug fix: test for NaN (e.g. on divide by zero).
;; 2005/02/08 dadams
;; hexrgb-hsv-to-rgb: Bug fix (typo: p, q -> pp, qq; added ww).
;; 2005/01/09 dadams
;; hexrgb-int-to-hex: Fixed bug in hexrgb-int-to-hex: nb-digits not respected.
;; Added: hexrgb-hsv-to-rgb, hexrgb-rgb-to-hsv, approx-equal.
;; Renamed old hexrgb-increment-value to hexrgb-increment-equal-rgb.
;; 2005/01/05 dadams
;; hexrgb-int-to-hex: Used a suggestion from Juri Linkov.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (require 'cl)) ;; case; plus, for Emacs < 20: when, unless
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Not used here, but put here to be available to libraries that use `hexrgb.el'.
;;;###autoload
(defconst hexrgb-defined-colors (eval-when-compile (x-defined-colors))
"List of all supported colors.")
;;;###autoload
(defconst hexrgb-defined-colors-alist (eval-when-compile (mapcar #'list (x-defined-colors)))
"Alist of all supported colors, for use in completion.")
;;;###autoload
(defun hexrgb-read-color (&optional convert-to-RGB-p allow-empty-name-p prompt)
"Read a color name or RGB hex value: #RRRRGGGGBBBB.
Completion is available for color names, but not for RGB hex strings.
If you input an RGB hex string, it must have the form #XXXXXXXXXXXX or
XXXXXXXXXXXX, where each X is a hex digit. The number of Xs must be a
multiple of 3, with the same number of Xs for each of red, green, and
blue. The order is red, green, blue.
In addition to standard color names and RGB hex values, the following
are available as color candidates. In each case, the corresponding
color is used.
* `*copied foreground*' - last copied foreground, if available
* `*copied background*' - last copied background, if available
* `*mouse-2 foreground*' - foreground where you click `mouse-2'
* `*mouse-2 background*' - background where you click `mouse-2'
* `*point foreground*' - foreground under the cursor
* `*point background*' - background under the cursor
\(You can copy a color using eyedropper commands such as
`eyedrop-pick-foreground-at-mouse'.)
Checks input to be sure it represents a valid color. If not, raises
an error (but see exception for empty input with non-nil
ALLOW-EMPTY-NAME-P).
Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, converts
an input color name to an RGB hex string. Returns the RGB hex string.
Optional arg ALLOW-EMPTY-NAME-P controls what happens if you enter an
empty color name (that is, you just hit `RET'). If non-nil, then
`hexrgb-read-color' returns an empty color name, \"\". If nil, then
it raises an error. Programs must test for \"\" if ALLOW-EMPTY-NAME-P
is non-nil. They can then perform an appropriate action in case of
empty input.
Optional arg PROMPT is the prompt. Nil means use a default prompt."
(interactive "p") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
(colors (if (fboundp 'eyedrop-foreground-at-point)
(append (and eyedrop-picked-foreground '(("*copied foreground*")))
(and eyedrop-picked-background '(("*copied background*")))
'(("*mouse-2 foreground*") ("*mouse-2 background*")
("*point foreground*") ("*point background*"))
hexrgb-defined-colors-alist)
hexrgb-defined-colors-alist))
(color (completing-read (or prompt "Color (name or #R+G+B+): ") colors))
hex-string)
(when (fboundp 'eyedrop-foreground-at-point)
(cond ((string= "*copied foreground*" color) (setq color eyedrop-picked-foreground))
((string= "*copied background*" color) (setq color eyedrop-picked-background))
((string= "*point foreground*" color) (setq color (eyedrop-foreground-at-point)))
((string= "*point background*" color) (setq color (eyedrop-background-at-point)))
((string= "*mouse-2 foreground*" color)
(setq color (prog1 (eyedrop-foreground-at-mouse
(read-event "Click `mouse-2' to choose foreground color - "))
(read-event)))) ; Discard mouse up event.
((string= "*mouse-2 background*" color)
(setq color (prog1 (eyedrop-background-at-mouse
(read-event "Click `mouse-2' to choose background color - "))
(read-event)))))) ; Discard mouse up event.
(setq hex-string (or (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
(and (string-match "^\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
t)))
(if (and allow-empty-name-p (string= "" color))
""
(when (and hex-string (not (eq 0 hex-string)))
(setq color (concat "#" color))) ; No #; add it.
(unless hex-string
(when (or (string= "" color)
(not (if (fboundp 'test-completion) ; Not defined in Emacs 20.
(test-completion color colors)
(try-completion color colors))))
(error "No such color: %S" color))
(when convert-to-RGB-p (setq color (hexrgb-color-name-to-hex color))))
(when (interactive-p) (message "Color: `%s'" color))
color)))
;;;###autoload
(defun hexrgb-rgb-hex-string-p (color &optional laxp)
"Non-nil if COLOR is an RGB string #XXXXXXXXXXXX.
Each X is a hex digit. The number of Xs must be a multiple of 3, with
the same number of Xs for each of red, green, and blue.
Non-nil optional arg LAXP means that the initial `#' is optional. In
that case, for a valid string of hex digits: when # is present 0 is
returned; otherwise, t is returned."
(or (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
(and laxp (string-match "^\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) t)))
;;;###autoload
(defun hexrgb-complement (color)
"Return the color that is the complement of COLOR."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(let ((red (hexrgb-red color))
(green (hexrgb-green color))
(blue (hexrgb-blue color)))
(setq color (hexrgb-rgb-to-hex (- 1.0 red) (- 1.0 green) (- 1.0 blue))))
(when (interactive-p) (message "Complement: `%s'" color))
color)
;;;###autoload
(defun hexrgb-hue (color)
"Return the hue component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(car (hexrgb-rgb-to-hsv (hexrgb-red color) (hexrgb-green color) (hexrgb-blue color))))
;;;###autoload
(defun hexrgb-saturation (color)
"Return the saturation component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(cadr (hexrgb-rgb-to-hsv (hexrgb-red color) (hexrgb-green color) (hexrgb-blue color))))
;;;###autoload
(defun hexrgb-value (color)
"Return the value component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(caddr (hexrgb-rgb-to-hsv (hexrgb-red color) (hexrgb-green color) (hexrgb-blue color))))
;;;###autoload
(defun hexrgb-red (color)
"Return the red component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(/ (hexrgb-hex-to-int (substring color 1 (1+ (/ (1- (length color)) 3))))
(expt 16.0 (/ (1- (length color)) 3.0))))
;;;###autoload
(defun hexrgb-green (color)
"Return the green component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(let* ((len (/ (1- (length color)) 3))
(start (1+ len)))
(/ (hexrgb-hex-to-int (substring color start (+ start len)))
(expt 16.0 (/ (1- (length color)) 3.0)))))
;;;###autoload
(defun hexrgb-blue (color)
"Return the blue component of COLOR, in range 0 to 1 inclusive.
COLOR is a color name or hex RGB string that starts with \"#\"."
(interactive (list (hexrgb-read-color)))
(setq color (hexrgb-color-name-to-hex color))
(let* ((len (/ (1- (length color)) 3))
(start (+ 1 len len)))
(/ (hexrgb-hex-to-int (substring color start (+ start len)))
(expt 16.0 (/ (1- (length color)) 3.0)))))
;;;###autoload
(defun hexrgb-rgb-to-hsv (red green blue)
"Convert RED, GREEN, BLUE components to HSV (hue, saturation, value).
Each input component is 0.0 to 1.0, inclusive.
Returns a list of HSV components of value 0.0 to 1.0, inclusive."
(let* ((min (min red green blue))
(max (max red green blue))
(value max)
(delta (- max min))
hue saturation)
(if (hexrgb-approx-equal 0.0 delta)
(setq hue 0.0 saturation 0.0) ; Gray scale - no color; only value.
(if (and (condition-case nil
(setq saturation (/ delta max))
(arith-error nil))
(or (< emacs-major-version 21) ; Emacs 20 bug makes next test fail falsely.
(not (equal 0.0e+NaN saturation)))) ; Must be a number, not NaN.
(if (hexrgb-approx-equal 0.0 saturation)
(setq hue 0.0 saturation 0.0) ; Again, no color; only value.
;; Color
(if (hexrgb-approx-equal red max)
(setq hue (/ (- green blue) delta)) ; Between yellow & magenta.
(if (hexrgb-approx-equal green max)
(setq hue (+ 2.0 (/ (- blue red) delta))) ; Between cyan & yellow.
(setq hue (+ 4.0 (/ (- red green) delta))))) ; Between magenta & cyan.
(setq hue (/ hue 6.0))
(when (<= hue 0.0)(setq hue (+ hue 1.0))))
(setq saturation 0.0 hue 0.0))) ; Div by zero (max=0): H:=0, S:=0. (Hue undefined.)
(list hue saturation value)))
;;;###autoload
(defun hexrgb-hsv-to-rgb (hue saturation value)
"Convert HUE, SATURATION, VALUE components to RGB (red, green, blue).
Each input component is 0.0 to 1.0, inclusive.
Returns a list of RGB components of value 0.0 to 1.0, inclusive."
(let (red green blue int-hue fract pp qq tt ww)
(if (hexrgb-approx-equal 0.0 saturation)
(setq red value green value blue value) ; Gray
(setq hue (* hue 6.0) ; Sectors: 0 to 5
int-hue (floor hue)
fract (- hue int-hue)
pp (* value (- 1 saturation))
qq (* value (- 1 (* saturation fract)))
ww (* value (- 1 (* saturation (- 1 (- hue int-hue))))))
(case int-hue
((0 6) (setq red value green ww blue pp))
(1 (setq red qq green value blue pp))
(2 (setq red pp green value blue ww))
(3 (setq red pp green qq blue value))
(4 (setq red ww green pp blue value))
(otherwise (setq red value green pp blue qq))))
(list red green blue)))
;;;###autoload
(defun hexrgb-hsv-to-hex (hue saturation value)
"Return the hex RBG color string for inputs HUE, SATURATION, VALUE.
The inputs are each in the range 0 to 1.
The output string is of the form \"#RRRRGGGGBBBB\"."
(hexrgb-color-values-to-hex
(mapcar (lambda (x) (floor (* x 65535.0))) (hexrgb-hsv-to-rgb hue saturation value))))
;;;###autoload
(defun hexrgb-rgb-to-hex (red green blue)
"Return the hex RBG color string for inputs RED, GREEN, BLUE.
The inputs are each in the range 0 to 1.
The output string is of the form \"#RRRRGGGGBBBB\"."
(hexrgb-color-values-to-hex
(mapcar (lambda (x) (floor (* x 65535.0))) (list red green blue))))
;;;###autoload
(defun hexrgb-hex-to-hsv (color)
"Return a list of HSV (hue, saturation, value) color components.
Each component is a value from 0.0 to 1.0, inclusive.
COLOR is a color name or a hex RGB string that starts with \"#\" and
is followed by an equal number of hex digits for red, green, and blue
components."
(let ((rgb-components (hexrgb-hex-to-rgb color)))
(apply #'hexrgb-rgb-to-hsv rgb-components)))
;;;###autoload
(defun hexrgb-hex-to-rgb (color)
"Return a list of RGB (red, green, blue) color components.
Each component is a value from 0.0 to 1.0, inclusive.
COLOR is a color name or a hex RGB string that starts with \"#\" and
is followed by an equal number of hex digits for red, green, and blue
components."
(unless (hexrgb-rgb-hex-string-p color) (setq color (hexrgb-color-name-to-hex color)))
(let ((len (/ (1- (length color)) 3)))
(list (/ (hexrgb-hex-to-int (substring color 1 (1+ len))) 65535.0)
(/ (hexrgb-hex-to-int (substring color (1+ len) (+ 1 len len))) 65535.0)
(/ (hexrgb-hex-to-int (substring color (+ 1 len len))) 65535.0))))
;;;###autoload
(defun hexrgb-color-name-to-hex (color)
"Return the RGB hex string for the COLOR name, starting with \"#\".
If COLOR is already a string starting with \"#\", then just return it."
(let ((components (x-color-values color)))
(unless components (error "No such color: %S" color))
(unless (hexrgb-rgb-hex-string-p color)
(setq color (hexrgb-color-values-to-hex components))))
color)
;; Just hard-code 4 as the number of hex digits, since `x-color-values'
;; seems to produce appropriate integer values for this value.
;;
;; Color "components" would be better in the name than color "value"
;; but this name follows the Emacs tradition (e.g. `x-color-values',
;; 'ps-color-values', `ps-e-x-color-values').
;;;###autoload
(defun hexrgb-color-values-to-hex (values)
"Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
Each X in the string is a hexadecimal digit.
Input VALUES is as for the output of `x-color-values'."
(concat "#"
(hexrgb-int-to-hex (nth 0 values) 4) ; red
(hexrgb-int-to-hex (nth 1 values) 4) ; green
(hexrgb-int-to-hex (nth 2 values) 4))) ; blue
;;;###autoload
(defun hexrgb-hex-to-color-values (color)
"Convert hex COLOR to a list of rgb color values.
COLOR is a hex rgb color string, #XXXXXXXXXXXX
Each X in the string is a hexadecimal digit. There are 3N X's, N > 0.
The output list is as for `x-color-values'."
(let* ((hex-strgp (string-match
"^\\(#\\)?\\(\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+\\)$"
color))
(ndigits (/ (if (eq (match-beginning 1) (match-end 1))
(length color)
(1- (length color)))
3))
red green blue)
(unless hex-strgp (error "Invalid RGB color string: %s" color))
(setq color (substring color (match-beginning 2) (match-end 2))
red (hexrgb-hex-to-int (substring color 0 ndigits))
green (hexrgb-hex-to-int (substring color ndigits (* 2 ndigits)))
blue (hexrgb-hex-to-int (substring color ndigits (* 3 ndigits))))
(list red green blue)))
;;;###autoload
(defun hexrgb-increment-red (hex nb-digits increment &optional wrap-p)
"Increment red value of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
If optional arg WRAP-P is non-nil, then the result wraps around zero.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat "#"
(hexrgb-increment-hex (substring hex 1 (1+ nb-digits)) increment nb-digits wrap-p)
(substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
(substring hex (1+ (* nb-digits 2)))))
;;;###autoload
(defun hexrgb-increment-green (hex nb-digits increment &optional wrap-p)
"Increment green value of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat
"#" (substring hex 1 (1+ nb-digits))
(hexrgb-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
increment
nb-digits
wrap-p)
(substring hex (1+ (* nb-digits 2)))))
;;;###autoload
(defun hexrgb-increment-blue (hex nb-digits increment &optional wrap-p)
"Increment blue value of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat "#" (substring hex 1 (1+ (* nb-digits 2)))
(hexrgb-increment-hex (substring hex (1+ (* nb-digits 2)))
increment
nb-digits
wrap-p)))
;;;###autoload
(defun hexrgb-increment-equal-rgb (hex nb-digits increment &optional wrap-p)
"Increment each color value (r,g,b) of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
For example, incrementing \"#FFFFFFFFF\" by 1 will cause it to wrap
around to \"#000000000\"."
(concat
"#" (hexrgb-increment-hex (substring hex 1 (1+ nb-digits)) increment nb-digits wrap-p)
(hexrgb-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
increment
nb-digits
wrap-p)
(hexrgb-increment-hex (substring hex (1+ (* nb-digits 2))) increment nb-digits wrap-p)))
;;;###autoload
(defun hexrgb-increment-hex (hex increment nb-digits &optional wrap-p)
"Increment HEX number (a string NB-DIGITS long) by INCREMENT.
For example, incrementing \"FFFFFFFFF\" by 1 will cause it to wrap
around to \"000000000\"."
(let* ((int (hexrgb-hex-to-int hex))
(new-int (+ increment int)))
(if (or wrap-p
(and (>= int 0) ; Not too large for the machine.
(>= new-int 0) ; For the case where increment < 0.
(<= (length (format (concat "%X") new-int)) nb-digits))) ; Not too long.
(hexrgb-int-to-hex new-int nb-digits) ; Use incremented number.
hex))) ; Don't increment.
;;;###autoload
(defun hexrgb-hex-to-int (hex)
"Convert HEX string argument to an integer.
The characters of HEX must be hex characters."
(let* ((factor 1)
(len (length hex))
(indx (1- len))
(int 0))
(while (>= indx 0)
(setq int (+ int (* factor (hexrgb-hex-char-to-integer (aref hex indx)))))
(setq indx (1- indx))
(setq factor (* 16 factor)))
int))
;; From `hexl.el'. This is the same as `hexl-hex-char-to-integer' defined there.
;;;###autoload
(defun hexrgb-hex-char-to-integer (character)
"Take a CHARACTER and return its value as if it were a hex digit."
(if (and (>= character ?0) (<= character ?9))
(- character ?0)
(let ((ch (logior character 32)))
(if (and (>= ch ?a) (<= ch ?f))
(- ch (- ?a 10))
(error "Invalid hex digit `%c'" ch)))))
;; Originally, I used the code from `int-to-hex-string' in `float.el'.
;; This version is thanks to Juri Linkov <juri@jurta.org>.
;;
;;;###autoload
(defun hexrgb-int-to-hex (int &optional nb-digits)
"Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
Each X in the output string is a hexadecimal digit.
NB-DIGITS is the number of hex digits. If INT is too large to be
represented with NB-DIGITS, then the result is truncated from the
left. So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
the hex equivalent of 256 decimal is 100, which is more than 2 digits."
(setq nb-digits (or nb-digits 4))
(substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
;; Inspired by Elisp Info manual, node "Comparison of Numbers".
;;;###autoload
(defun hexrgb-approx-equal (x y &optional rfuzz afuzz)
"Return non-nil if numbers X and Y are approximately equal.
RFUZZ is a relative fuzz factor. AFUZZ is an absolute fuzz factor.
RFUZZ defaults to 1.0e-8. AFUZZ defaults to (/ RFUZZ 10).
The algorithm is:
(< (abs (- X Y)) (+ AFUZZ (* RFUZZ (+ (abs X) (abs Y)))))."
(setq rfuzz (or rfuzz 1.0e-8) afuzz (or afuzz (/ rfuzz 10)))
(< (abs (- x y)) (+ afuzz (* rfuzz (+ (abs x) (abs y))))))
;;;###autoload
(defun hexrgb-color-value-to-float (n)
"Return the floating-point equivalent of color value N.
N must be an integer between 0 and 65535, or else an error is raised."
(unless (and (wholenump n) (<= n 65535))
(error "Not a whole number less than 65536"))
(/ (float n) 65535.0))
;;;###autoload
(defun hexrgb-float-to-color-value (x)
"Return the color value equivalent of floating-point number X.
X must be between 0.0 and 1.0, or else an error is raised."
(unless (and (numberp x) (<= 0.0 x) (<= x 1.0))
(error "Not a floating-point number between 0.0 and 1.0"))
(floor (* x 65535.0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'hexrgb)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; hexrgb.el ends here
[-- Attachment #2.1.3: oneonone.el --]
[-- Type: application/octet-stream, Size: 71097 bytes --]
;;; oneonone.el --- Frame configuration that uses one frame per window.
;;
;; Filename: oneonone.el
;; Description: Frame configuration that uses one frame per window.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1999-2008, Drew Adams, all rights reserved.
;; Created: Fri Apr 2 12:34:20 1999
;; Version: 21.1
;; Last-Updated: Tue Feb 12 07:08:17 2008 (Pacific Standard Time)
;; By: dradams
;; Update #: 2344
;; URL: http://www.emacswiki.org/cgi-bin/wiki/oneonone.el
;; Keywords: local, frames
;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x
;;
;; Features that might be required by this library:
;;
;; `avoid', `cl', `files+', `frame-cmds', `frame-fns', `hexrgb',
;; `misc-fns', `oneonone', `strings', `thingatpt', `thingatpt+',
;; `zoom-frm'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Frame configuration that uses one frame per window.
;;
;; This library is part of One-on-One Emacs, a collection of
;; libraries that try to make Emacs more frame-oriented and less
;; window-oriented.
;;
;; This library sets up Emacs to use multiple frames: individual
;; frames are used, by default, instead of Emacs windows. That is,
;; the default is to use a frame for each Emacs window: one window on
;; one frame.
;;
;; You can configure each of the frames defined here.
;;
;; Default properties are defined here for normal frames and
;; "special" frames, which show "special-display buffers" (see Emacs
;; manual for info on such frames).
;;
;; In addition, these user options control the creation of three
;; separate, specialized frames:
;;
;; - `1on1-*Help*-frame-flag' - *Help* buffer frame
;; - `1on1-*Completions*-frame-flag' - *Completions* buffer frame
;; - `1on1-minibuffer-frame-flag' - minibuffer frame
;;
;; Buffers *Help* and *Completions* are always displayed in their own
;; frames. In addition, if `1on1-*Help*-frame-flag' or
;; `1on1-*Completions*-frame-flag' is non-nil, then the *Help* or
;; *Completions* frame has a special (customizable) appearance.
;;
;; If `1on1-minibuffer-frame-flag' is non-nil (the default value),
;; then the minibuffer is shown in its own frame,
;; `1on1-minibuffer-frame'; this is the only frame to have a
;; minibuffer. If you customize `1on1-minibuffer-frame-flag' to nil,
;; then each frame will have its own minibuffer, as usual, and there
;; will be no standalone minibuffer frame.
;;
;; By default, if you use a standalone minibuffer frame, it is
;; automatically sized to the full width of your display and placed
;; at the bottom of the display. During minibuffer input, you can
;; use `1on1-fit-minibuffer-frame' (bind to `C-o') to resize its
;; height to fit the input text - the height is reset when inputting
;; is done. To help you perceive changes to different minibuffer
;; recursion levels, the background color of the minibuffer frame is
;; changed slightly with each recursion-depth change.
;;
;; This library is especially useful if used in combination with
;; One-on-One Emacs libraries `autofit-frame.el', which automatically
;; fits frames to their sole window, and `fit-frame.el', which lets
;; you fit a frame to its selected window manually. Library
;; `autofit-frame.el' uses library `fit-frame.el'.
;;
;; Because Emacs is not really designed to be frame-oriented, there
;; are many built-in and standard functions that produce
;; less-than-optimal results when frames, instead of windows, are the
;; default. In other One-on-One Emacs libraries, I have fixed most
;; of these built-in functions to play well with frames.
;;
;; For more information on One-on-One Emacs see
;; http://www.emacswiki.org/cgi-bin/wiki/OneOnOneEmacs.
;;
;; To use this library, put the following at the *END* of your init
;; file, `.emacs' (or `_emacs'). In particular, if your init file
;; contains a `custom-set-variables' expression, then the following
;; must appear *AFTER* that expression, in order for this to take
;; into account your customizations of any `1on1-' user options.
;;
;; (require 'oneonone)
;; (1on1-emacs)
;;
;; Initial frame: By default, the initial Emacs frame is like all
;; other normal (non-special-display) frames; that is,
;; `initial-frame-alist' effectively uses the frame properties
;; defined in `default-frame-alist'. If you would like the initial
;; frame to be different, set `default-frame-alist' to nil after
;; requiring `oneonone.el' but before executing `1on1-emacs':
;;
;; (require 'oneonone)
;; (setq default-frame-alist nil)
;; (setq initial-frame-alist '((background-color . "White"))); e.g.
;; (1on1-emacs)
;;
;; If you want the text cursor to change to a box when Emacs is idle,
;; then add this line also to your init file:
;;
;; (toggle-box-cursor-when-idle 1) ; Turn on box cursor when idle.
;;
;; Info and Customize frames: I recommend that you put the following
;; code in your init file, so that Info and Customize buffers will
;; display in their own frames. Which code to use depends on your
;; version of GNU Emacs.
;;
;; (cond ((< emacs-major-version 21)
;; (remove-hook 'same-window-buffer-names "*info*"))
;; ((= emacs-version 21)
;; (remove-hook 'same-window-buffer-names "*info*")
;; (remove-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'"))
;; (t
;; (remove-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)")
;; (remove-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")))
;;
;; Recommended key bindings (requires library `fit-frame.el'):
;;
;; (define-key minibuffer-local-map "\C-o"
;; '1on1-fit-minibuffer-frame)
;; (define-key minibuffer-local-must-match-map "\C-o"
;; '1on1-fit-minibuffer-frame)
;; (define-key minibuffer-local-completion-map "\C-o"
;; '1on1-fit-minibuffer-frame)
;;
;;
;; Notes on user options defined here:
;; ---------------------------------
;;
;; Some user options are used here only as conveniences to define
;; frame-parameter alists. They are defined using `defvar', not
;; `defcustom', because you cannot use Customize to define them
;; independently of the alist user options they help to define. The
;; alists themselves are the variables to customize. If you want to
;; change the `defvar' variables individually and then use them to
;; set the alist variables, then use `setq', not Customize, to change
;; them, and restart Emacs for their changes to take effect.
;;
;; Changes to any user options defined here with `defcustom' will
;; take effect as soon as `1on1-emacs' is executed, so you can do
;; `M-x 1on1-emacs' to see their changes (no need to restart
;; Emacs).
;;
;; User options `1on1-color-minibuffer-frame-on-setup-increment' and
;; `1on1-color-minibuffer-frame-on-exit-increment' determine how much
;; to change the color of the minibuffer frame when the minibuffer is
;; entered and exitted. They are hue increments, and should be
;; opposite in sign. They should cancel each other out, so that the
;; color returns to what it was initially at any given
;; recursive-minibuffer depth. However, because of the way HSV and
;; RGB color-component conversion works, the best cancellation does
;; not occur when these have the same absolute value. And, how much
;; their absolute values should differ depends on that magnitude.
;; It's best to just set one of these to an increment you like, and
;; then fiddle with the other until they more or less cancel.
;;
;;
;; New functions and macros defined here (each has prefix `1on1-'):
;;
;; `box-cursor-when-idle', `change-cursor-on-input-method',
;; `change-cursor-on-overwrite/read-only',
;; `color-minibuffer-frame-on-exit',
;; `color-minibuffer-frame-on-setup',
;; `color-isearch-minibuffer-frame', `display-*Completions*-frame',
;; `display-*Help*-frame', `emacs', `fit-minibuffer-frame',
;; `flash-ding-minibuffer-frame', `increment-color-hue',
;; `minibuffer-prompt-end', `reset-minibuffer-frame',
;; `set-box-cursor-when-idle-interval', `set-cursor-type',
;; `set-minibuffer-frame-top/bottom', `set-minibuffer-frame-width',
;; `setup-minibuffer-frame-coloring',
;; `setup-mode-line'. `toggle-box-cursor-when-idle'.
;;
;; Customizable user options defined here (each has prefix `1on1-'):
;;
;; `*Completions*-frame-flag', `*Completions*-frame-at-right-flag',
;; `*Help*-frame-flag', `active-minibuffer-frame-background',
;; `active-mode-line-background',
;; `change-cursor-on-overwrite/read-only-flag',
;; `color-minibuffer-frame-on-exit-increment',
;; `color-minibuffer-frame-on-setup-increment',
;; `color-mode-line-flag', `completions-frame-background',
;; `completions-frame-mouse+cursor-color',
;; `completions-frame-width', `default-frame-alist',
;; `help-frame-background', `help-frame-mouse+cursor-color',
;; `inactive-minibuffer-frame-background',
;; `inactive-mode-line-background',
;; `isearch-minibuffer-frame-background', `minibuffer-frame-alist',
;; `minibuffer-frame-left', `minibuffer-frame-top/bottom',
;; `minibuffer-frame-width', `minibuffer-frame-width-percent',
;; `special-display-frame-alist'.
;;
;; Non-customizable user options defined here (prefix `1on1-'):
;;
;; `default-frame-background', `default-frame-cursor-color',
;; `default-frame-cursor-color-input-method',
;; `default-frame-cursor-type',
;; `default-frame-cursor-type-overwrite/read-only',
;; `default-frame-font', `default-frame-foreground',
;; `default-frame-menu-bar-lines', `default-frame-mouse-color',
;; `default-frame-size', `default-frame-upper-left-corner',
;; `default-special-frame-background',
;; `default-special-frame-cursor-color',
;; `default-special-frame-font',
;; `default-special-frame-foreground',
;; `default-special-frame-menu-bar-lines',
;; `default-special-frame-mouse-color',
;; `default-special-frame-size',
;; `default-special-frame-upper-left-corner',
;; `minibuffer-frame-background', `minibuffer-frame-cursor-color',
;; `minibuffer-frame-flag', `minibuffer-frame-font',
;; `minibuffer-frame-foreground', `minibuffer-frame-height',
;; `minibuffer-frame-mouse-color'.
;;
;; Other new variables defined here (each has prefix `1on1-'):
;;
;; `box-cursor-when-idle-p', `box-cursor-when-idle-interval',
;; `box-cursor-when-idle-timer', `last-cursor-type',
;; `minibuffer-frame'.
;;
;;
;; ***** NOTE: These EMACS PRIMITIVES have been REDEFINED HERE:
;;
;; `abort-recursive-edit', `top-level' -
;; Reset color of minibuffer frame to "inactive" color.
;;
;; `y-or-n-p' - Temporarily color minibuffer frame to "active" color.
;;
;;
;; Acknowledgements:
;;
;; The cursor-changing on input method and read-only was inspired by
;; Juri Linkov <juri@jurta.org>. Joe Casadonte <joc@netaxs.com>
;; wrote a similar hook (`joc-cursor-type-set-hook'), which he got
;; from Steve Kemp...
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2007/12/05 dadams
;; 1on1-minibuffer-frame-left: Added :type.
;; 1on1-color-mode-line-flag, 1on1-minibuffer-frame-flag: defvar -> defcustom.
;; 1on1-(minibuffer|(special-)default)-frame-*: Removed * doc-string prefix.
;; 2007/11/22 dadams
;; Added: 1on1-reset-minibuffer-frame, 1on1-fit-minibuffer-frame,
;; 1on1-minibuffer-prompt-end. Recommend C-o key binding.
;; Use 1on1-reset-minibuffer-frame on minibuffer-exit-hook.
;; 2007/08/14 dadams
;; 1on1-emacs:
;; Add *Completions* to special-display-buffer-names even if
;; 1on1-*Completions*-frame-flag is nil, so minibuffer gets focus.
;; Set w(in)32-grab-focus-on-raise to nil.
;; 1on1-display-*Completions*-frame:
;; Don't change mouse pointer unless 1on1-*Completions*-frame-flag.
;; 1on1-minibuffer-frame-background: Use std minibuffer-frame-alist bg, if defined.
;; 2007/05/28 dadams
;; 1on1-display-*Completions*-frame:
;; Wrap zoom-frm-out in condition-case (hack for Emacs 23 problem changing size).
;; 2007/03/10 dadams
;; Added: 1on1-completions-frame-width. Use it in 1on1-emacs.
;; 2007/02/08 dadams
;; Removed: ^L-appearance-vector.
;; 1on1-emacs: No longer change ^L appearance - use my library pp-c-l.el to do that.
;; 2007/02/04 dadams
;; 1on1-emacs:
;; Initialize standard-display-table if nil (default is nil!). Thx to FidelSalas.
;; 2006/12/27 dadams
;; 1on1-change-cursor-on-input-method: Respect 1on1-change-cursor-on-input-method-flag
;; 2006/12/12 dadams
;; Added: 1on1-^L-appearance-vector.
;; 1on1-emacs: Use 1on1-^L-appearance-vector to set ^L appearance.
;; 2006/12/11 dadams
;; 1on1-set-minibuffer-frame-top/bottom: 2 chars up, not 1, to fit Emacs 22 better.
;; 2006/10/28 dadams
;; 1on1-(in)active-minibuffer-frame-background,
;; 1on1-isearch-minibuffer-frame-background, 1on1-(in)active-mode-line-background,
;; 1on1-(help|completions)-frame-background,
;; 1on1-(help|completions)-frame-mouse+cursor-color,
;; 1on1-default-frame-cursor-color(-input-method):
;; Changed :type to 'color for Emacs 21+.
;; 2006/09/14 dadams
;; Removed mode-line position enhancements - use new library modeline-posn.el.
;; Removed: 1on1-color-mode-line-column-flag, 1on1-mode-line-column-limit.
;; 2006/09/04 dadams
;; 1on1-box-cursor-when-idle-timer: Cancel beforehand, and cancel after defining.
;; 1on1-toggle-box-cursor-when-idle:
;; Use 1on1-box-cursor-when-idle-off on pre-command-hook.
;; Don't read an event; just turn it on.
;; Added: 1on1-box-cursor-when-idle-off.
;; 2006/09/02 dadams
;; 1on1-toggle-box-cursor-when-idle: Corrected.
;; 2006/08/27 dadams
;; Added: 1on1-box-cursor-when-idle(-p|-interval|-timer), 1on1-last-cursor-type,
;; (1on1-)toggle-box-cursor-when-idle, 1on1-set-box-cursor-when-idle-interval.
;; 2006/08/13 dadams
;; defalias set-cursor-type to 1on1-set-cursor-type.
;; 2006/07/25 dadams
;; Added: 1on1-minibuffer-frame-left. Use in 1on1-minibuffer-frame-alist.
;; 2006/03/31 dadams
;; 1on1-default-frame-alist:
;; Changed (left|right)-fringe code, to reflect Emacs 22 change.
;; 2006/03/17 dadams
;; Renamed:
;; 1on1-color-active-minibuffer-frame to 1on1-color-minibuffer-frame-on-setup,
;; 1on1-color-inactive-minibuffer-frame to 1on1-color-minibuffer-frame-on-exit.
;; 1on1-color-minibuffer-frame-on-setup:
;; Redefined so hue depends on minibuffer-depth.
;; 2006/03/14 dadams
;; 1on1-color-(in)active-minibuffer-frame: Change hue for each minibuffer recursion.
;; Added: 1on1-increment-color-hue.
;; Require hexrgb.el
;; 2006/03/13 dadams
;; 1on1-color-inactive-minibuffer-frame:
;; Change color only when not in recursive minibuffer.
;; abort-recursive-edit: Change minibuffer color after, not before, abort.
;; 2006/01/07 dadams
;; Added :link
;; 2005/12/14 dadams
;; Added: 1on1-*Completions*-frame-at-right-flag.
;; Use in 1on1-display-*Completions*-frame.
;; 2005/11/28 dadams
;; Added: 1on1-change-cursor-on-overwrite-flag,
;; 1on1-change-cursor-on-input-method-flag, 1on1-default-frame-cursor-type,
;; 1on1-default-frame-cursor-type-overwrite, 1on1-default-frame-cursor-color,
;; 1on1-default-frame-cursor-color-input-mode, 1on1-change-cursor-on-overwrite,
;; 1on1-change-cursor-on-insert-mode, 1on1-set-cursor-type (thanks to
;; Juri Linkov for the last three).
;; 1on1-emacs: Use 1on1-change-cursor-* in post-command-hook.
;; 1on1-mode-line-column-limit: Corrected custom group.
;; 2005/11/22 dadams
;; Added: 1on1-setup-mode-line, 1on1-mode-line-column-limit,
;; 1on1-color-mode-line(-column)-flag, 1on1-(in)active-mode-line-background.
;; 2005/10/28 dadams
;; 1on1-display-*Completions*-frame: Zoom to smaller font.
;; 2005/07/31 dadams
;; 1on1-emacs: Do not set initial-frame-alist to default-frame-alist (D. Reitter).
;; 2005/07/25 dadams
;; Added :prefix to defgroup.
;; 2005/07/17 dadams
;; Switched default colors for 1on1-(in)active-minibuffer-frame-background,
;; so active is the brighter color. Change inactive to LightBlue.
;; 2005/06/01 dadams
;; Corrected typo that gave minibuffer frame a vertical scroll bar.
;; 2005/05/29 dadams
;; *-alist: Use values from standard alist variables, if available (that is,
;; don't override user settings.)
;; 2005/05/28 dadams
;; Renamed: 1on1-separate-minibuffer-frame-flag -> 1on1-minibuffer-frame-flag,
;; 1on1-separate-*Help*-frame-flag -> 1on1-*Help*-frame-flag,
;; 1on1-separate-*Completions*-frame-flag -> 1on1-*Completions*-frame-flag.
;; Added: setup-minibuffer-frame-coloring.
;; Added info in doc strings about use of each variable (restart/1on1-emacs).
;; Corrected 1on1-minibuffer-frame-alist and 1on1-special-display-frame-alist
;; for menu-bar-lines (nil).
;; 1on1-set-minibuffer-frame-top/bottom: Rewrote with modify-frame-parameters.
;; 1on1-emacs:
;; Make sensitive to any changes to 1on1-*[Help|Completions]*-frame-flag.
;; Move defcustom's, defvar's, and defun's outside 1on1-emacs.
;; If 1on1-minibuffer-frame already exists, just modify it.
;; Don't step on other parameters in standard alists; just append new values.
;; 2005/05/23 dadams
;; Changed some individual frame-parameter variables from defcustom to defvar.
;; Left them as user options, however, so you can change them with
;; set-variable before loading oneonone.el.
;; Renamed:
;; 1on1-upper-left-frame-corner-default ->
;; 1on1-default-frame-upper-left-corner
;; 1on1-default-special-display-frame-size ->
;; 1on1-default-special-frame-size
;; 1on1-upper-left-special-display-frame-corner-default ->
;; 1on1-default-special-frame-upper-left-corner
;; Split 1on1-menu-bar-lines into: 1on1-default-special-frame-menu-bar-lines,
;; 1on1-default-frame-menu-bar-lines
;; 2005/05/18 dadams
;; Fixed typo: "oneoneone" -> "oneonone".
;; 2005/05/17 dadams
;; Updated to work with Emacs 22.x.
;; 2005/05/09 dadams
;; Major reorganization/rewrite. Created, from previous version setup-frames.el.
;; Added prefix "1on1-".
;; Encapsulated stuff in new command 1on1-emacs.
;; 2005/01/29 dadams
;; 1on1-default-frame-font: Fixed bug - misplaced parens, so no good if not Windows.
;; 2005/01/19 dadams
;; Use defcustom now.
;; Removed (put ... 'variable-interactive...).
;; 1on1-minibuffer-frame-top/bottom: Must be an integer (for set-frame-position).
;; 2004/12/18 dadams
;; Bind after-make-frame-functions to nil when create 1on1-minibuffer-frame.
;; 2004/11/26 dadams
;; Removed ;;;###autoload's.
;; 2004/11/20 dadams
;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x)
;; 2004/10/01 dadams
;; Ensure loaded before compile.
;; No fringe.
;; Remove *info* and *Customiz.* buffers from `same-window-regexps'
;; 2004/09/21 dadams
;; Updated to work with Emacs 21 (and Emacs 20).
;; 2004/03/19 dadams
;; 1on1-minibuffer-frame-width -> 1on1-set-minibuffer-frame-width.
;; added 1on1-set-minibuffer-frame-top/bottom.
;; 2001/01/05 dadams
;; 1. 1on1-minibuffer-frame-width: Use 1on1-minibuffer-frame arg for frame-char-width.
;; 2. Don't define width when initially set 1on1-minibuffer-frame-alist. Instead,
;; use set-frame-width afterward, so 1on1-minibuffer-frame-width uses correct
;; character size.
;; 2001/01/05 dadams
;; 1. These vars no longer user options (interactively changeable):
;; 1on1-completions-frame-background, 1on1-completions-frame-mouse+cursor-color,
;; 1on1-help-frame-background, 1on1-help-frame-mouse+cursor-color,
;; 1on1-minibuffer-frame-cursor-color, 1on1-minibuffer-frame-font,
;; 1on1-minibuffer-frame-foreground, 1on1-minibuffer-frame-height,
;; 1on1-minibuffer-frame-mouse-color, 1on1-minibuffer-frame-top/bottom,
;; 1on1-minibuffer-frame-width.
;; 2. Added: 1on1-minibuffer-frame-width (function),
;; 1on1-minibuffer-frame-width-percent (var).
;; 3. Changed var 1on1-minibuffer-frame-width to nil default (now use *-percent).
;; 2000/09/27 dadams
;; 1. Added: 1on1-display-*Completions*-frame, 1on1-display-*Help*-frame.
;; 2. *Help* & *Completions* frames not created here. Instead, use
;; special-display-buffer-names & display-*-frame fns to define them.
;; 3. Added: top-level, abort-recursive-edit.
;; 1999/08/24 dadams
;; 1. Windows: win32-grab-focus-on-raise = nil.
;; 2. 1on1-default-frame-font different if Windows.
;; 3. Added: 1on1-separate-minibuffer-frame-flag, 1on1-menu-bar-lines,
;; 1on1-upper-left-frame-corner-default, 1on1-default-frame-size,
;; 1on1-upper-left-special-display-frame-corner-default,
;; 1on1-default-special-display-frame-size, 1on1-default-special-frame-foreground,
;; 1on1-default-special-frame-background, 1on1-default-special-frame-font,
;; 1on1-default-special-frame-mouse-color, 1on1-default-special-frame-cursor-color.
;; 4. Use new vars to define default-frame-alist, special-display-frame-alist.
;; 5. Only create built-in frames if 1on1-separate-minibuffer-frame-flag.
;; 6. Protected refs to x-* vars.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-and-compile (require 'cl)) ;; remove-if (plus, for Emacs < 20, when, unless)
(require 'frame-cmds nil t) ;; (no error if not found): rename-frame
(require 'files+ nil t) ;; (no error if not found): switch-to-buffer-other-frame
(require 'zoom-frm nil t) ;; (no error if not found): zoom-frm-out
(require 'hexrgb) ;; hexrgb-color-values-to-hex, hexrgb-hsv-to-rgb, hexrgb-rgb-to-hsv
;; Ensure that this is loaded before compiling it.
(provide 'oneonone)
(require 'oneonone)
;; To quiet the byte compiler
(unless (> emacs-major-version 21)
(defvar x-pointer-box-spiral)
(defvar x-pointer-xterm))
;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup One-On-One nil
"Options to define initial frame configuration."
:prefix "1on1-" :group 'frames
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
oneonone.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/oneonone.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/OneOnOneEmacs")
:link '(emacs-commentary-link :tag "Commentary" "oneonone")
)
\f
;;; Minibuffer frame: ********************************
;;;
(defvar 1on1-minibuffer-frame nil
"Minibuffer-only frame used by One-on-One Emacs.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.")
(defcustom 1on1-minibuffer-frame-flag t
"*Non-nil means use a separate, specialized frame for the minibuffer.
If you change this variable, you will need to restart Emacs for it to
take effect."
:type 'boolean :group 'One-On-One)
(defvar 1on1-minibuffer-frame-foreground "Red"
"Default foreground color for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-background
(or (cdr (assq 'background-color minibuffer-frame-alist)) "LightBlue")
"Initial color of the `1on1-minibuffer-frame' background.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defcustom 1on1-active-minibuffer-frame-background "PaleGoldenrod"
"*The color of the `1on1-minibuffer-frame' when it is active.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-inactive-minibuffer-frame-background 1on1-minibuffer-frame-background
"*The color of the `1on1-minibuffer-frame' when it is inactive.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-isearch-minibuffer-frame-background "bisque"
"*Color of the `1on1-minibuffer-frame' when `isearch' is active.
See `1on1-color-isearch-minibuffer-frame'.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-color-mode-line-flag t
"*Non-nil means use `1on1-(in)active-mode-line-background'.
If you change this variable, you will need to restart Emacs for it to
take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-color-minibuffer-frame-on-exit-increment 5
"Increment to change minibuffer-frame hue when minibuffer is exited.
This should be opposite in sign to
`1on1-color-minibuffer-frame-on-setup-increment.'"
:type 'integer :group 'One-On-One)
(defcustom 1on1-color-minibuffer-frame-on-setup-increment -10
"Increment to change minibuffer-frame hue when minibuffer is entered.
This should be opposite in sign to
`1on1-color-minibuffer-frame-on-exit-increment.'"
:type 'integer :group 'One-On-One)
(defcustom 1on1-active-mode-line-background 1on1-active-minibuffer-frame-background
"*The color of the mode-line when it is active.
Note: This is not used if `1on1-color-mode-line-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-inactive-mode-line-background "LightGray"
"*The color of the mode-line when it is inactive.
Note: This is not used if `1on1-color-mode-line-flag' is nil."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defvar 1on1-minibuffer-frame-font
(if (eq system-type 'windows-nt)
"-*-Lucida Console-normal-r-*-*-14-112-96-96-c-*-iso8859-1"
;;;;;;;"-*-Lucida Console-normal-r-*-*-15-*-*-*-c-*-*-ansi-"
"-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1")
"Default font for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-mouse-color "Black"
"Default mouse color for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-cursor-color "Black"
"Default text cursor color for the minibuffer frame.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-minibuffer-frame-height 2
"Height of minibuffer frame, in characters.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
This is used only to define the standard value of
`1on1-minibuffer-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defcustom 1on1-minibuffer-frame-left 0
"*Position of left edge of minibuffer frame, in pixels.
An integer. If negative, then the position is that of the frame
bottom relative to the screen right (not left) edge.
See `default-frame-alist' for an explanation of frame parameters.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'integer :group 'One-On-One)
(defcustom 1on1-minibuffer-frame-top/bottom nil
"*Position of top (or bottom) of minibuffer frame, in pixels.
If nil, function `1on1-set-minibuffer-frame-top/bottom' will position
minibuffer at bottom of display.
An integer. If negative, then the position is that of the frame
bottom relative to the screen bottom.
See `default-frame-alist' for an explanation of frame parameters.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type '(choice (const :tag "Use function `1on1-set-minibuffer-frame-top/bottom'" nil)
(integer :tag "Pixels from top (>= 0) or bottom (< 0)" :value 0))
:group 'One-On-One)
(defcustom 1on1-minibuffer-frame-width nil
"Width, in characters, for minibuffer frame.
If nil, then function `1on1-set-minibuffer-frame-width' is used instead.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type '(choice (const :tag "Use function `1on1-set-minibuffer-frame-width'" nil)
(integer :tag "Width, in characters, for minibuffer frame" :value 0))
:group 'One-On-One)
(defcustom 1on1-minibuffer-frame-width-percent 100
"Max percent of the total display width to give to minibuffer frame.
See function `1on1-set-minibuffer-frame-width'.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'integer :group 'One-On-One)
;; Use values from the standard list, when available. However, we have no way of
;; distinguishing values predefined in vanilla Emacs from user settings.
(defcustom 1on1-minibuffer-frame-alist
(list
(or (assq 'foreground-color minibuffer-frame-alist)
(cons 'foreground-color 1on1-minibuffer-frame-foreground))
(or (assq 'background-color minibuffer-frame-alist)
(cons 'background-color 1on1-minibuffer-frame-background))
(or (assq 'font minibuffer-frame-alist)
(cons 'font 1on1-minibuffer-frame-font))
(or (assq 'mouse-color minibuffer-frame-alist)
(cons 'mouse-color 1on1-minibuffer-frame-mouse-color))
(or (assq 'cursor-color minibuffer-frame-alist)
(cons 'cursor-color 1on1-minibuffer-frame-cursor-color))
(or (assq 'menu-bar-lines minibuffer-frame-alist)
(cons 'menu-bar-lines nil))
(or (assq 'left minibuffer-frame-alist)
(cons 'left 1on1-minibuffer-frame-left))
(or (assq 'height minibuffer-frame-alist)
(cons 'height 1on1-minibuffer-frame-height))
(or (assq 'icon-type minibuffer-frame-alist)
(cons 'icon-type (< emacs-major-version 21))) ; `t' for Emacs 21 too?
(or (assq 'minibuffer minibuffer-frame-alist)
(cons 'minibuffer 'only))
(or (assq 'user-position minibuffer-frame-alist)
(cons 'user-position t))
(or (assq 'vertical-scroll-bars minibuffer-frame-alist) ; No scroll bar.
(cons 'vertical-scroll-bars nil))
(or (assq 'name minibuffer-frame-alist)
(cons 'name "Emacs Minibuffer")))
"Frame-parameter alist for the standalone minibuffer frame
`1on1-minibuffer-frame'.
Note: This is not used if `1on1-minibuffer-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
;; If we didn't need Emacs 20 compatibility, this could be:
;; :type '(alist :key-type symbol :value-type sexp)
:type '(repeat (cons :format "%v" (symbol :tag "Frame Parameter") (sexp :tag "Value")))
:group 'One-On-One)
\f
;;; *Help* frame: ********************************
;;; Display of *Help* buffer in custom frame.
;;; Background, height, cursor and pointer colors.
;;;
(defcustom 1on1-*Help*-frame-flag t
"*Non-nil means use a special appearance for the *Help* frame.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-help-frame-background "Thistle"
"Default background color for the *Help* buffer's frame.
Note: This is not used if `1on1-*Help*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-help-frame-mouse+cursor-color "Blue Violet"
"Default color for cursor & pointer of *Help* frame.
Note: This is not used if `1on1-*Help*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
\f
;;; *Completions* frame: ********************************
;;; Display of *Completion* buffer in custom frame.
;;; Background, height, cursor and pointer colors.
;;;
(defcustom 1on1-*Completions*-frame-flag t
"*Non-nil means use a special appearance for the *Completions* frame.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-*Completions*-frame-at-right-flag nil
"*Non-nil means place *Completions* frame at right edge of display.
This can be useful to make *Completions* more visible.
This has no effect if `1on1-*Completions*-frame-flag' is nil."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-completions-frame-background "LavenderBlush2"
"Default background color for the *Completions* buffer's frame.
Note: This is not used if `1on1-*Completions*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-completions-frame-mouse+cursor-color "VioletRed"
"Default color for cursor & pointer of *Completions* frame.
Note: This is not used if `1on1-*Completions*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-completions-frame-width 100
"Width, in characters, for *Completions* frame.
If this is nil, then the pertinent default frame width is used.
Note: This is not used if `1on1-*Completions*-frame-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'integer :group 'One-On-One)
\f
;;; Default for normal frames: `1on1-default-frame-alist' **************************
;;;
(defvar 1on1-default-frame-foreground "Black"
"Default foreground color for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-background "LightBlue"
"Default background color for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-font
(if (eq system-type 'windows-nt)
"-*-Lucida Console-normal-r-*-*-14-112-96-96-c-*-iso8859-1"
;;;;;;"-*-Lucida Console-normal-r-*-*-15-*-*-*-c-*-*-ansi-"
"-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1")
"Default font for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-mouse-color "Red"
"Default mouse-pointer color for non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defcustom 1on1-change-cursor-on-input-method-flag t
"*Non-nil means to use a different cursor when using an input method.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-default-frame-cursor-color "Red"
"*Default text cursor color for non-special frames.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect. Furthermore, if
`1on1-change-cursor-on-input-method-flag' is nil when you rerun
`1on1-emacs', you will need to toggle that variable to non-nil (and
back to nil, if that's the value you want). Otherwise, the new value
will take effect only after you restart Emacs."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-default-frame-cursor-color-input-method "Orange"
"*Default cursor color for non-special frames if using an input method.
This has no effect if `1on1-change-cursor-on-input-method-flag' is nil.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type (if (>= emacs-major-version 21) 'color 'string) :group 'One-On-One)
(defcustom 1on1-change-cursor-on-overwrite/read-only-flag t
"*Non-nil means use a different cursor when overwrite mode or read-only.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
:type 'boolean :group 'One-On-One)
(defcustom 1on1-default-frame-cursor-type 'bar
"*Default text cursor type for non-special frames.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect. Furthermore, if
`1on1-change-cursor-on-overwrite/read-only-flag' is nil when you rerun
`1on1-emacs', you will need to toggle that variable to non-nil (and
back to nil, if that's the value you want). Otherwise, the new value
will take effect only after you restart Emacs."
:type 'symbol :group 'One-On-One)
(defvar 1on1-last-cursor-type 1on1-default-frame-cursor-type "Saved last cursor type.")
(defcustom 1on1-default-frame-cursor-type-overwrite/read-only 'box
"*Default text cursor type for overwrite mode or read-only buffer.
This applies only to non-special frames. This has no effect if
`1on1-change-cursor-on-overwrite/read-only-flag' is nil. If you
customize this variable, you will need to rerun `1on1-emacs' for the
new value to take effect."
:type 'symbol :group 'One-On-One)
(defvar 1on1-box-cursor-when-idle-p t
"Non-nil means to use a box cursor whenever Emacs is idle.
Do NOT change this yourself; instead, use `\\[toggle-box-cursor-when-idle]'.")
(defvar 1on1-box-cursor-when-idle-interval 2
"Number of seconds to wait before changing cursor type to box.
Do NOT change this yourself to change the wait period; instead, use
`\\[1on1-set-box-cursor-when-idle-interval]'.")
(defvar 1on1-box-cursor-when-idle-timer
(progn ; Cancel to prevent duplication.
(when (boundp '1on1-box-cursor-when-idle-timer)
(cancel-timer 1on1-box-cursor-when-idle-timer))
(run-with-idle-timer 1on1-box-cursor-when-idle-interval t '1on1-box-cursor-when-idle))
"Timer used to change the cursor to a box cursor when Emacs is idle.")
;; Turn it off, by default. You must use `toggle-box-cursor-when-idle' to turn it on.
(cancel-timer 1on1-box-cursor-when-idle-timer)
(defvar 1on1-default-frame-menu-bar-lines 1
"Number of lines used for the menu bar in non-special frames.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-upper-left-corner '(0 . 0)
"Position of upper left frame corner.
A cons whose car is the distance from the top in pixels
and whose cdr is the distance from the left in pixels.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
(defvar 1on1-default-frame-size '(80 . 35)
"Default frame size.
A cons whose car is the frame width in pixels
and whose cdr is the frame height in pixels.
This is used only to define the standard value of
`1on1-default-frame-alist'. Customize that variable, not this one.
If you change this variable, you will need to restart Emacs for it to
take effect.")
;; Use values from the standard list, when available. However, we have no way of
;; distinguishing values predefined in vanilla Emacs from user settings.
(defcustom 1on1-default-frame-alist
(list
(or (assq 'foreground-color default-frame-alist)
(cons 'foreground-color 1on1-default-frame-foreground))
(or (assq 'background-color default-frame-alist)
(cons 'background-color 1on1-default-frame-background))
(or (assq 'font default-frame-alist)
(cons 'font 1on1-default-frame-font))
(or (assq 'mouse-color default-frame-alist)
(cons 'mouse-color 1on1-default-frame-mouse-color))
(or (assq 'cursor-color default-frame-alist)
(cons 'cursor-color 1on1-default-frame-cursor-color))
(or (assq 'cursor-type default-frame-alist)
(cons 'cursor-type 1on1-default-frame-cursor-type))
(or (assq 'menu-bar-lines default-frame-alist)
(cons 'menu-bar-lines 1on1-default-frame-menu-bar-lines))
(or (assq 'top default-frame-alist)
(cons 'top (car 1on1-default-frame-upper-left-corner)))
(or (assq 'left default-frame-alist)
(cons 'left (cdr 1on1-default-frame-upper-left-corner)))
(or (assq 'width default-frame-alist)
(cons 'width (car 1on1-default-frame-size)))
(or (assq 'height default-frame-alist)
(cons 'height (cdr 1on1-default-frame-size)))
(or (assq 'minibuffer default-frame-alist)
(cons 'minibuffer (not 1on1-minibuffer-frame-flag)))
(or (assq 'user-position default-frame-alist)
(cons 'user-position t))
(or (assq 'vertical-scroll-bars default-frame-alist)
(cons 'vertical-scroll-bars 'right))
(or (assq 'icon-type default-frame-alist)
(cons 'icon-type (< emacs-major-version 21))) ; `t' for Emacs 21 too?
(or (assq 'tool-bar-lines default-frame-alist)
(cons 'tool-bar-lines 1)) ; Emacs 21+
(if (cdr (assq 'left-fringe default-frame-alist))
(assq 'left-fringe default-frame-alist)
(cons 'left-fringe 0)) ; Emacs 21+
(if (cdr (assq 'right-fringe default-frame-alist))
(assq 'right-fringe default-frame-alist)
(cons 'right-fringe 0)) ; Emacs 21+
(or (assq 'fringe default-frame-alist)
(cons 'fringe 0))) ; Emacs 21, but not 21.3.50 - REMOVE after 22.x
"Properties to be used for One-on-One Emacs `default-frame-alist'.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
;; If we didn't need Emacs 20 compatibility, this could be:
;; :type '(alist :key-type symbol :value-type sexp)
:type '(repeat (cons :format "%v" (symbol :tag "Frame Parameter") (sexp :tag "Value")))
:group 'One-On-One)
\f
;;; Special-display frames: `1on1-special-display-frame-alist' ************************
;;;
(defvar 1on1-default-special-frame-foreground "Black"
"Default foreground color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-background "LightSteelBlue"
"Default background color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-font
(if (eq system-type 'windows-nt)
"-*-Lucida Console-normal-r-*-*-14-112-96-96-c-*-iso8859-1"
;;;;;;;;"-*-Lucida Console-normal-r-*-*-15-*-*-*-c-*-*-ansi-"
"-Misc-Fixed-Medium-R-Normal--15-140-75-75-C-90-ISO8859-1")
"Default font for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-mouse-color "Yellow"
"Default mouse color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-cursor-color "Yellow"
"Default text cursor color for special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-menu-bar-lines 1
"Number of lines used for the menu bar of special display frames.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-upper-left-corner '(0 . 0)
"Position of upper left corner of special display frames.
A cons whose car is the distance from the top in pixels
and whose cdr is the distance from the left in pixels.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
(defvar 1on1-default-special-frame-size '(80 . 20)
"Default size of special display frames.
A cons whose car is the frame width in pixels
and whose cdr is the frame height in pixels.
This is used only to define the standard value of
`1on1-special-display-frame-alist'. Customize that variable, not this
one. If you change this variable, you will need to restart Emacs for
it to take effect.")
;; Use values from the standard list, when available. However, we have no way of
;; distinguishing values predefined in vanilla Emacs from user settings.
(defcustom 1on1-special-display-frame-alist
(list
(or (assq 'font special-display-frame-alist)
(cons 'font 1on1-default-special-frame-font))
(or (assq 'width special-display-frame-alist)
(cons 'width (car 1on1-default-special-frame-size)))
(or (assq 'height special-display-frame-alist)
(cons 'height (cdr 1on1-default-special-frame-size)))
(or (assq 'mouse-color special-display-frame-alist)
(cons 'mouse-color 1on1-default-special-frame-mouse-color))
(or (assq 'cursor-color special-display-frame-alist)
(cons 'cursor-color 1on1-default-special-frame-cursor-color))
(or (assq 'menu-bar-lines special-display-frame-alist)
(cons 'menu-bar-lines 1on1-default-special-frame-menu-bar-lines))
(or (assq 'foreground-color special-display-frame-alist)
(cons 'foreground-color 1on1-default-special-frame-foreground))
(or (assq 'background-color special-display-frame-alist)
(cons 'background-color 1on1-default-special-frame-background))
(or (assq 'top special-display-frame-alist)
(cons 'top (car 1on1-default-special-frame-upper-left-corner)))
(or (assq 'left special-display-frame-alist)
(cons 'left (cdr 1on1-default-special-frame-upper-left-corner)))
(or (assq 'unsplittable special-display-frame-alist)
(cons 'unsplittable t))
(or (assq 'user-position special-display-frame-alist)
(cons 'user-position t))
(or (assq 'vertical-scroll-bars special-display-frame-alist)
(cons 'vertical-scroll-bars 'right)))
"Properties to be used for One-on-One `special-display-frame-alist'.
If you customize this variable, you will need to rerun `1on1-emacs'
for the new value to take effect."
;; If we didn't need Emacs 20 compatibility, this could be:
;; :type '(alist :key-type symbol :value-type sexp)
:type '(repeat (cons :format "%v" (symbol :tag "Frame Parameter") (sexp :tag "Value")))
:group 'One-On-One)
\f
;;; Main command ***************************************
;;;
;;;###autoload
(defun 1on1-emacs ()
"One-on-One Emacs setup.
Use `1on1-default-frame-alist' and `1on1-special-display-frame-alist'.
If `1on1-minibuffer-frame-flag' is non-nil, then create
minibuffer-only frame, `1on1-minibuffer-frame', using
`1on1-minibuffer-frame-alist'.
If `1on1-separate-minibuffer-*Help*-flag' is non-nil, then use
special frame for *Help* buffer.
If `1on1-separate-minibuffer-*Completions*-flag' is non-nil, then
use special frame for *Completions* buffer."
(interactive)
(setq default-frame-alist (append 1on1-default-frame-alist default-frame-alist)
special-display-frame-alist (append 1on1-special-display-frame-alist
special-display-frame-alist))
;; *Help* frame
(if 1on1-*Help*-frame-flag
(add-to-list
'special-display-buffer-names
(list "*Help*" '1on1-display-*Help*-frame
(list (cons 'background-color 1on1-help-frame-background)
(cons 'mouse-color 1on1-help-frame-mouse+cursor-color)
(cons 'cursor-color 1on1-help-frame-mouse+cursor-color)
'(height . 40))))
(setq special-display-buffer-names
(remove-if (lambda (elt) (equal "*Help*" (car elt)))
special-display-buffer-names)))
;; *Completions* frame
;; If `1on1-minibuffer-frame-flag' is non-nil, then *Completions* frame must be treated
;; specially, so that it gets focus from the minibuffer frame. This is so, even if
;; `1on1-*Completions*-frame-flag' is nil.
(if 1on1-minibuffer-frame-flag
(if 1on1-*Completions*-frame-flag
(add-to-list
'special-display-buffer-names
`("*Completions*" 1on1-display-*Completions*-frame
((background-color ,@1on1-completions-frame-background)
(mouse-color ,@1on1-completions-frame-mouse+cursor-color)
(cursor-color ,@1on1-completions-frame-mouse+cursor-color)
,@(and 1on1-completions-frame-width
`((width ,@1on1-completions-frame-width))))))
(add-to-list 'special-display-buffer-names
`("*Completions*" 1on1-display-*Completions*-frame)))
(setq special-display-buffer-names
(remove-if (lambda (elt) (equal "*Completions*" (car elt)))
special-display-buffer-names)))
;; Minibuffer frame
(when 1on1-minibuffer-frame-flag
;; `display-buffer' (& `*-other-window' fns) will use separate frames.
(setq pop-up-frames t
pop-up-frame-alist (append default-frame-alist pop-up-frame-alist))
;; Set up `1on1-minibuffer-frame'.
(setq minibuffer-frame-alist (append 1on1-minibuffer-frame-alist
minibuffer-frame-alist))
(if 1on1-minibuffer-frame
(modify-frame-parameters 1on1-minibuffer-frame 1on1-minibuffer-frame-alist)
(setq 1on1-minibuffer-frame
(let ((after-make-frame-functions nil)) ; E.g. inhibit `fit-frame'.
(make-frame 1on1-minibuffer-frame-alist))))
;; Resize and reposition it. If variable `1on1-minibuffer-frame-width'
;; or `1on1-minibuffer-frame-top/bottom' is nil, calculate automatically.
(1on1-set-minibuffer-frame-width)
(1on1-set-minibuffer-frame-top/bottom)
;; Rename minibuffer frame. (`rename-frame' is defined in `frame-cmds.el'.)
(when (fboundp 'rename-frame)
(rename-frame 1on1-minibuffer-frame "Emacs minibuffer \
show/hide: hold CTRL + click in window"))
(setq minibuffer-auto-raise t)
;; Background colors of minibuffer frame: 3 states
(add-hook 'isearch-mode-hook '1on1-color-isearch-minibuffer-frame)
(add-hook 'isearch-mode-end-hook '1on1-color-minibuffer-frame-on-exit)
(add-hook 'minibuffer-setup-hook '1on1-color-minibuffer-frame-on-setup)
(add-hook 'minibuffer-exit-hook '1on1-color-minibuffer-frame-on-exit)
;; Redefine built-in fns so they color minibuffer frame.
(1on1-setup-minibuffer-frame-coloring))
;; Hooks.
(if 1on1-change-cursor-on-overwrite/read-only-flag
(add-hook 'post-command-hook '1on1-change-cursor-on-overwrite/read-only)
(1on1-set-cursor-type 1on1-default-frame-cursor-type)
(remove-hook 'post-command-hook '1on1-change-cursor-on-overwrite/read-only))
(if 1on1-change-cursor-on-input-method-flag
(add-hook 'post-command-hook '1on1-change-cursor-on-input-method)
(setq current-input-method nil)
(1on1-change-cursor-on-input-method)
(remove-hook 'post-command-hook '1on1-change-cursor-on-input-method))
(add-hook 'minibuffer-exit-hook '1on1-reset-minibuffer-frame)
(setq w32-grab-focus-on-raise nil
win32-grab-focus-on-raise nil) ; older name
(1on1-setup-mode-line))
;; This is inspired by code from Juri Linkov <juri@jurta.org>.
(defun 1on1-change-cursor-on-input-method ()
"Set cursor type depending on whether an input method is used or not."
(when 1on1-change-cursor-on-input-method-flag
(set-cursor-color
(if current-input-method
1on1-default-frame-cursor-color-input-method
(let ((bufname (buffer-name (current-buffer))))
(cond
((string= "*Help*" bufname) 1on1-help-frame-mouse+cursor-color)
((string= "*Completions*" bufname) 1on1-completions-frame-mouse+cursor-color)
((eq 1on1-minibuffer-frame (selected-frame))
1on1-minibuffer-frame-cursor-color)
((special-display-p bufname) 1on1-default-special-frame-cursor-color)
(t 1on1-default-frame-cursor-color)))))))
;; This is from Juri Linkov <juri@jurta.org>, with read-only added.
(defun 1on1-change-cursor-on-overwrite/read-only ()
"Set cursor type differently for overwrite mode and read-only buffer.
That is, use one cursor type for overwrite mode and read-only buffers,
and another cursor type otherwise."
(1on1-set-cursor-type (if (or buffer-read-only overwrite-mode)
1on1-default-frame-cursor-type-overwrite/read-only
1on1-default-frame-cursor-type)))
(unless (fboundp 'set-cursor-type) (defalias 'set-cursor-type '1on1-set-cursor-type))
;; This is essentially from Juri Linkov <juri@jurta.org>.
(defun 1on1-set-cursor-type (cursor-type)
"Set the cursor type of the selected frame to CURSOR-TYPE.
When called interactively, prompt for the type to use.
To get the frame's current cursor type, use `frame-parameters'."
(interactive
(list (intern (completing-read "Cursor type: "
(mapcar 'list '("box" "hollow" "bar" "hbar" nil))))))
(modify-frame-parameters (selected-frame) (list (cons 'cursor-type cursor-type))))
(defun 1on1-box-cursor-when-idle ()
"Change the cursor to a box cursor when Emacs is idle."
(let ((type (cdr (assoc 'cursor-type (frame-parameters)))))
(unless (eq type 'box)
(setq 1on1-last-cursor-type type)
(1on1-set-cursor-type 'box))))
(defun 1on1-box-cursor-when-idle-off ()
"Turn off changing the cursor to a box cursor when Emacs is idle."
(when 1on1-last-cursor-type (1on1-set-cursor-type 1on1-last-cursor-type)))
(defalias 'toggle-box-cursor-when-idle '1on1-toggle-box-cursor-when-idle)
(defun 1on1-toggle-box-cursor-when-idle (&optional arg)
"Turn on or off automatically changing to a box cursor when idle.
When on, the cursor is changed to a box whenever Emacs is idle.
With prefix argument, turn on if ARG > 0; else turn off."
(interactive "P")
(setq 1on1-box-cursor-when-idle-p
(if arg (> (prefix-numeric-value arg) 0) (not 1on1-box-cursor-when-idle-p)))
(cond (1on1-box-cursor-when-idle-p
(timer-activate-when-idle 1on1-box-cursor-when-idle-timer)
(add-hook 'pre-command-hook '1on1-box-cursor-when-idle-off)
(message "Turned ON making cursor a box when Emacs is idle."))
(t
(cancel-timer 1on1-box-cursor-when-idle-timer)
(remove-hook 'pre-command-hook '1on1-box-cursor-when-idle-off)
(message "Turned OFF making cursor a box when Emacs is idle."))))
(defun 1on1-set-box-cursor-when-idle-interval (secs)
"Set wait until automatically change to a box cursor when Emacs is idle.
Whenever Emacs is idle for this many seconds it will change the cursor
to a box.
To turn on or off automatically changing to a box cursor when idle,
use `\\[toggle-box-cursor-when-idle]."
(interactive
"nSeconds to idle, before changing to a box cursor: ")
(timer-set-idle-time 1on1-box-cursor-when-idle-timer
(setq 1on1-box-cursor-when-idle-interval secs)
t))
(defun 1on1-display-*Help*-frame (buf &optional args)
"Display *Help* buffer in its own frame.
`special-display-function' is used to do the actual displaying.
BUF and ARGS are the arguments to `special-display-function'."
(let ((old-ptr-shape x-pointer-shape)
return-window)
(when (boundp 'x-pointer-xterm)
(setq x-pointer-shape x-pointer-xterm))
(setq return-window (select-window (funcall special-display-function buf args)))
(raise-frame)
(setq x-pointer-shape old-ptr-shape)
return-window))
(defun 1on1-display-*Completions*-frame (buf &optional args)
"Display *Completions* buffer in its own frame.
`special-display-function' is used to do the actual displaying.
Completion input events are redirected to `1on1-minibuffer-frame'.
BUF and ARGS are the arguments to `special-display-function'."
(let ((old-ptr-shape x-pointer-shape)
return-window)
(when (and 1on1-*Completions*-frame-flag (boundp 'x-pointer-box-spiral))
(setq x-pointer-shape x-pointer-box-spiral))
(setq return-window (select-window (funcall special-display-function buf args)))
(when (fboundp 'zoom-frm-out)
(condition-case nil (progn (zoom-frm-out) (zoom-frm-out)) ; In `zoom-frm.el'.
(error nil)))
;; We reposition frame this way, instead of binding `special-display-frame-alist'
;; with this value, because `after-make-frame-functions' might resize frame.
(when 1on1-*Completions*-frame-at-right-flag
(modify-frame-parameters
(selected-frame) ; Hard-code 7 here - what does it depend on?
`((left . ,(- (x-display-pixel-width) (+ (frame-pixel-width) 7))))))
(raise-frame)
(when (boundp '1on1-minibuffer-frame)
(redirect-frame-focus (selected-frame) 1on1-minibuffer-frame))
(when (and 1on1-*Completions*-frame-flag (boundp 'x-pointer-box-spiral))
(setq x-pointer-shape old-ptr-shape))
return-window))
(defun 1on1-set-minibuffer-frame-top/bottom ()
"Set position of minibuffer frame.
Use `1on1-minibuffer-frame-top/bottom' if non-nil.
Else, place minibuffer at bottom of display."
(when (boundp '1on1-minibuffer-frame)
(modify-frame-parameters
1on1-minibuffer-frame
`((top ,@ (or 1on1-minibuffer-frame-top/bottom
(- (* 2 (frame-char-height 1on1-minibuffer-frame)))))))))
(defun 1on1-set-minibuffer-frame-width ()
"Set width of minibuffer frame, in characters.
Use `1on1-minibuffer-frame-width' if not nil.
Else, set width relative to character size of `1on1-minibuffer-frame'
and display size, and depending on
`1on1-minibuffer-frame-width-percent':
(/ (* 1on1-minibuffer-frame-width-percent (x-display-pixel-width))
(* 100 (frame-char-width 1on1-minibuffer-frame)))"
(when (boundp '1on1-minibuffer-frame)
(set-frame-width
1on1-minibuffer-frame
(or 1on1-minibuffer-frame-width
(/ (* 1on1-minibuffer-frame-width-percent (x-display-pixel-width))
(* 100 (frame-char-width 1on1-minibuffer-frame)))))))
(defun 1on1-color-minibuffer-frame-on-setup ()
"Change background of minibuffer frame to reflect the minibuffer depth.
Use this when increasing the minibuffer recursion depth."
(when (boundp '1on1-minibuffer-frame)
(save-window-excursion
(select-frame 1on1-minibuffer-frame)
(set-background-color 1on1-active-minibuffer-frame-background)
(let ((count (minibuffer-depth)))
(while (> count 1)
(set-background-color (1on1-increment-color-hue ; Change bg hue slightly.
(frame-parameter nil 'background-color)
1on1-color-minibuffer-frame-on-setup-increment))
(setq count (1- count)))))))
(defun 1on1-color-minibuffer-frame-on-exit ()
"Change background of minibuffer frame to reflect the minibuffer depth.
Use this when reducing the minibuffer recursion depth."
(when (boundp '1on1-minibuffer-frame)
(save-window-excursion
(select-frame 1on1-minibuffer-frame)
(if (< (minibuffer-depth) 2)
(set-background-color 1on1-inactive-minibuffer-frame-background)
(set-background-color (1on1-increment-color-hue ; Change bg hue slightly.
(frame-parameter nil 'background-color)
1on1-color-minibuffer-frame-on-exit-increment))))))
;; This is essentially a version of `doremi-increment-color-component' for hue only.
(defun 1on1-increment-color-hue (color increment)
"Increase hue component of COLOR by INCREMENT."
(unless (string-match "#" color) ; Convert color name to #hhh...
(setq color (hexrgb-color-values-to-hex (x-color-values color))))
;; Convert RGB to HSV
(let* ((rgb (x-color-values color))
(red (/ (float (nth 0 rgb)) 65535.0)) ; Convert from 0-65535 to 0.0-1.0
(green (/ (float (nth 1 rgb)) 65535.0))
(blue (/ (float (nth 2 rgb)) 65535.0))
(hsv (hexrgb-rgb-to-hsv red green blue))
(hue (nth 0 hsv))
(saturation (nth 1 hsv))
(value (nth 2 hsv)))
(setq hue (+ hue (/ increment 100.0)))
(when (> hue 1.0) (setq hue (1- hue)))
(hexrgb-color-values-to-hex (mapcar (lambda (x) (floor (* x 65535.0)))
(hexrgb-hsv-to-rgb hue saturation value)))))
(defun 1on1-color-isearch-minibuffer-frame ()
"Use `1on1-isearch-minibuffer-frame-background' for minibuffer."
(and (boundp '1on1-minibuffer-frame)
(save-window-excursion
(select-frame 1on1-minibuffer-frame)
(set-background-color
;; Can also try `x-defined-colors', defined in `x-win.el'.
;; It contains all colors currently supported by X windows.
(if (x-color-defined-p 1on1-isearch-minibuffer-frame-background)
1on1-isearch-minibuffer-frame-background
"white")))))
(defun 1on1-flash-ding-minibuffer-frame (&optional do-not-terminate)
"Ring bell (`ding'), after flashing minibuffer frame, if relevant.
Terminates any keyboard macro executing, unless arg DO-NOT-TERMINATE non-nil."
(flash-ding do-not-terminate (and (boundp '1on1-minibuffer-frame)
1on1-minibuffer-frame)))
(defun 1on1-setup-minibuffer-frame-coloring ()
"Redefine some built-in functions so they color the minibuffer frame.
Functions redefined: `y-or-n-p', `top-level', `abort-recursive-exit'."
(or (fboundp 'old-y-or-n-p)
(fset 'old-y-or-n-p (symbol-function 'y-or-n-p)))
;; REPLACES ORIGINAL (built-in function):
;; Temporarily colors minibuffer frame to "active" color.
;;
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
Takes one argument, which is the string to display to ask the question.
It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
No confirmation of answer is requested; a single character is enough.
Also accepts SPC to mean yes, or DEL to mean no."
(1on1-color-minibuffer-frame-on-setup)
(prog1 (old-y-or-n-p prompt) (1on1-color-minibuffer-frame-on-exit)))
(or (fboundp 'old-top-level)
(fset 'old-top-level (symbol-function 'top-level)))
;; REPLACES ORIGINAL (built-in function):
;; Resets color of minibuffer frame to "inactive" color.
;;
(defun top-level ()
"Exit all recursive editing levels."
(interactive)
(1on1-color-minibuffer-frame-on-exit)
(old-top-level))
(or (fboundp 'old-abort-recursive-edit)
(fset 'old-abort-recursive-edit (symbol-function 'abort-recursive-edit)))
;; REPLACES ORIGINAL (built-in function):
;; Resets color of minibuffer frame to "inactive" color.
;;
(defun abort-recursive-edit ()
"Abort command that requested this recursive edit or minibuffer input."
(interactive)
(1on1-color-minibuffer-frame-on-exit)
(old-abort-recursive-edit)))
(defun 1on1-setup-mode-line ()
"Set up mode-line faces."
(when 1on1-color-mode-line-flag
(set-face-background 'modeline 1on1-active-mode-line-background)
(when (facep 'mode-line-inactive) ; Emacs 22
(set-face-background 'mode-line-inactive 1on1-inactive-mode-line-background))))
(defun 1on1-reset-minibuffer-frame ()
(when 1on1-minibuffer-frame
(set-frame-size 1on1-minibuffer-frame
(frame-width 1on1-minibuffer-frame)
1on1-minibuffer-frame-height)
(1on1-set-minibuffer-frame-top/bottom)))
;; Bind this to some key in the minibuffer completion maps. I use `C-o'.
;;;###autoload
(defun 1on1-fit-minibuffer-frame ()
"Fit the standalone minibuffer frame height to its contents.
Repeat to increase the height by 1.
Bind this in minibuffer keymaps to a key such as `C-o' that you can
use during minibuffer input."
(interactive)
(unless (require 'fit-frame nil t)
(error "You need to load library `fit-frame.el' to use this command"))
;; We could assume the minibuffer frame is `1on1-minibuffer-frame', but we don't.
(when (and (active-minibuffer-window)
(save-selected-window
(select-window (minibuffer-window))
;; We should be able to use just (one-window-p),
;; but an Emacs bug means we need this:
(one-window-p nil 'selected-frame)))
(let* ((frame (save-selected-window
(select-window (minibuffer-window)) (selected-frame)))
(frame-height (frame-height frame)))
(cond ((eq last-command this-command)
(set-frame-height frame (1+ (frame-height frame)))
(1on1-set-minibuffer-frame-top/bottom)
(condition-case nil
(scroll-down (frame-height frame))
(error nil)))
(t
(let* ((beg (1on1-minibuffer-prompt-end))
(frame-width (frame-width frame))
(fit-frame-min-width frame-width)
(window-min-width frame-width)
(fit-frame-max-width frame-width)
(fit-frame-empty-width frame-width)
(fit-frame-empty-special-display-width frame-width)
(fit-frame-min-height frame-height)
(window-min-height frame-height)
(fit-frame-empty-height frame-height)
(fit-frame-empty-special-display-height frame-height))
(fit-frame frame)
(when (>= emacs-major-version 21)
(set-frame-height frame (1+ (frame-height frame)))) ; A little extra.
(1on1-set-minibuffer-frame-top/bottom)
(condition-case nil (scroll-down (frame-height frame)) (error nil))))))))
(defun 1on1-minibuffer-prompt-end ()
"Version of `minibuffer-prompt-end' that works for Emacs 20 and later."
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) (point-min)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; oneonone.el ends here
[-- Attachment #2.1.4: bug-garbled-about-emacs.png --]
[-- Type: image/png, Size: 53271 bytes --]
[-- Attachment #3: Type: message/rfc822, Size: 3841 bytes --]
From: Jason Rumney <jasonr@f2s.com>
To: Drew Adams <drew.adams@oracle.com>
Cc: 642-done@emacsbugs.donarmstrong.com
Subject: Re: bug#642: 23.0.60;garbled text (wrong font?) in About GNU Emacs screen
Date: Sun, 23 Nov 2008 23:22:27 +0800
Message-ID: <49297533.3040505@f2s.com>
Drew Adams wrote:
> Here is some more info about this.
>
> The display shows problems with font families Times and Helvetica. I use the
> standard Times and Helvetica Type1 fonts on Windows XP. E.g., the Times Roman
> font file is named TIR_____.PFM; the Helvetica file is HV_____.PFM.
>
Thanks for your extra information. I think this is related to the fact
that the Uniscribe font backend can only use opentype and truetype
fonts, but Windows by default defines font substitutions for Helvetica
and Times to map to the Truetype fonts "Arial" and "Times New Roman". So
the uniscribe backend picks these substitutes up, but somehow things get
confused so the Type-1 fonts end up being loaded. I've added some code
to specifically reject these substitutes, which are detected by
comparing the font's "full name" with the name used to load it.
Unfortunately this also catches many legitimate fonts, so I've had to
pick out these two specific problematic substitutions. If there are any
other specific fonts that cause this problem, then we will need to add
rules for them too.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#597: marked as done (23.0.60; Corrupted display.)
2008-07-22 23:34 ` bug#597: 23.0.60; Corrupted display ofv
2008-07-23 0:01 ` Juanma Barranquero
2008-07-23 8:01 ` Jason Rumney
@ 2008-11-23 15:30 ` Emacs bug Tracking System
2 siblings, 0 replies; 21+ messages in thread
From: Emacs bug Tracking System @ 2008-11-23 15:30 UTC (permalink / raw)
To: Jason Rumney
[-- Attachment #1: Type: text/plain, Size: 853 bytes --]
Your message dated Sun, 23 Nov 2008 23:22:27 +0800
with message-id <49297533.3040505@f2s.com>
and subject line Re: bug#642: 23.0.60;garbled text (wrong font?) in About GNU Emacs screen
has caused the Emacs bug report #642,
regarding 23.0.60; Corrupted display.
to be marked as done.
This means that you claim that the problem has been dealt with.
If this is not the case it is now your responsibility to reopen the
bug report if necessary, and/or fix the problem forthwith.
(NB: If you are a system administrator and have no idea what this
message is talking about, this may indicate a serious mail system
misconfiguration somewhere. Please contact don@donarmstrong.com
immediately.)
--
642: http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=642
Emacs Bug Tracking System
Contact don@donarmstrong.com with problems
[-- Attachment #2: Type: message/rfc822, Size: 3474 bytes --]
From: ofv@wanadoo.es
To: emacs-pretest-bug@gnu.org
Subject: 23.0.60; Corrupted display.
Date: Wed, 23 Jul 2008 01:34:36 +0200
Message-ID: <ej5l1oj7.fsf@telefonica.net>
After some use, Emacs display shows garbage characters instead of
normal text. Only those characters that are shown with the normal face
are replaced by garbage. Text shown as italics, bold, etc, remains
correct. I have no recipe to reproduce this. It usually happens while
reading news with Gnus, but I was unable to reproduce the problem by
duplicating the Gnus session (in particular, displaying again the
article that I was reading when the display got corrupted).
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.0.2195)
of 2008-07-18 on K7
Windowing system distributor `Microsoft Corp.', version 5.0.2195
configured using `configure --with-gcc (4.2) --cflags -It:/emacscvs/include --ldflags -Lt:/emacscvs/lib'
Important settings:
value of $LC_ALL: nil
value of $LC_COLLATE: nil
value of $LC_CTYPE: nil
value of $LC_MESSAGES: en
value of $LC_MONETARY: nil
value of $LC_NUMERIC: nil
value of $LC_TIME: nil
value of $LANG: ESN
value of $XMODIFIERS: nil
locale-coding-system: cp1252
default-enable-multibyte-characters: t
Major mode: Fundamental
Minor modes in effect:
show-paren-mode: t
iswitchb-mode: t
tooltip-mode: t
mouse-wheel-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
blink-cursor-mode: t
global-auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
column-number-mode: t
line-number-mode: t
transient-mark-mode: t
Recent input:
M-h <up> <down> C-g <f10> <menu-bar> <help-menu> <
send-emacs-bug-report>
Recent messages:
ergo-keys
Loading comint...done
Loading d:/lp0/utils/lp0-mode.el (source)...done
Loading `~/.emacs': old-style backquotes detected!
For information about GNU Emacs and the GNU system, type C-h C-a.
Quit
;; --
;; =d3scar
[-- Attachment #3: Type: message/rfc822, Size: 3841 bytes --]
From: Jason Rumney <jasonr@f2s.com>
To: Drew Adams <drew.adams@oracle.com>
Cc: 642-done@emacsbugs.donarmstrong.com
Subject: Re: bug#642: 23.0.60;garbled text (wrong font?) in About GNU Emacs screen
Date: Sun, 23 Nov 2008 23:22:27 +0800
Message-ID: <49297533.3040505@f2s.com>
Drew Adams wrote:
> Here is some more info about this.
>
> The display shows problems with font families Times and Helvetica. I use the
> standard Times and Helvetica Type1 fonts on Windows XP. E.g., the Times Roman
> font file is named TIR_____.PFM; the Helvetica file is HV_____.PFM.
>
Thanks for your extra information. I think this is related to the fact
that the Uniscribe font backend can only use opentype and truetype
fonts, but Windows by default defines font substitutions for Helvetica
and Times to map to the Truetype fonts "Arial" and "Times New Roman". So
the uniscribe backend picks these substitutes up, but somehow things get
confused so the Type-1 fonts end up being loaded. I've added some code
to specifically reject these substitutes, which are detected by
comparing the font's "full name" with the name used to load it.
Unfortunately this also catches many legitimate fonts, so I've had to
pick out these two specific problematic substitutions. If there are any
other specific fonts that cause this problem, then we will need to add
rules for them too.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#639: marked as done (23.0.60; tab bars use bizarre characters now)
2008-08-01 14:42 ` bug#639: 23.0.60; tab bars use bizarre characters now Drew Adams
@ 2008-11-23 15:30 ` Emacs bug Tracking System
0 siblings, 0 replies; 21+ messages in thread
From: Emacs bug Tracking System @ 2008-11-23 15:30 UTC (permalink / raw)
To: Jason Rumney
[-- Attachment #1: Type: text/plain, Size: 870 bytes --]
Your message dated Sun, 23 Nov 2008 23:22:27 +0800
with message-id <49297533.3040505@f2s.com>
and subject line Re: bug#642: 23.0.60;garbled text (wrong font?) in About GNU Emacs screen
has caused the Emacs bug report #642,
regarding 23.0.60; tab bars use bizarre characters now
to be marked as done.
This means that you claim that the problem has been dealt with.
If this is not the case it is now your responsibility to reopen the
bug report if necessary, and/or fix the problem forthwith.
(NB: If you are a system administrator and have no idea what this
message is talking about, this may indicate a serious mail system
misconfiguration somewhere. Please contact don@donarmstrong.com
immediately.)
--
642: http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?bug=642
Emacs Bug Tracking System
Contact don@donarmstrong.com with problems
[-- Attachment #2: Type: message/rfc822, Size: 6676 bytes --]
[-- Attachment #2.1.1: Type: text/plain, Size: 608 bytes --]
emacs -Q
Load David Ponce's tabbar.el. I'm using this revision, which
AFAIK is the latest:
;; Revision: $Id: tabbar.el,v 1.20 2003/06/05 08:15:49 ponced Exp $
(defconst tabbar-version "1.3")
M-x tabbar-mode
The characters in the tabs are bad now. See attached images - the good
one is from a build of 2008-07-26; the bad one is from a build of
2008-08-01.
In GNU Emacs 23.0.60.1 (i386-mingw-nt5.1.2600)
of 2008-08-01 on LENNART-69DE564
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --no-opt --cflags -Ic:/g/include
-fno-crossjumping'
[-- Attachment #2.1.2: throw-good-tab-chars.png --]
[-- Type: image/png, Size: 992 bytes --]
[-- Attachment #2.1.3: throw-bad-tab-chars.PNG --]
[-- Type: image/png, Size: 1063 bytes --]
[-- Attachment #3: Type: message/rfc822, Size: 3841 bytes --]
From: Jason Rumney <jasonr@f2s.com>
To: Drew Adams <drew.adams@oracle.com>
Cc: 642-done@emacsbugs.donarmstrong.com
Subject: Re: bug#642: 23.0.60;garbled text (wrong font?) in About GNU Emacs screen
Date: Sun, 23 Nov 2008 23:22:27 +0800
Message-ID: <49297533.3040505@f2s.com>
Drew Adams wrote:
> Here is some more info about this.
>
> The display shows problems with font families Times and Helvetica. I use the
> standard Times and Helvetica Type1 fonts on Windows XP. E.g., the Times Roman
> font file is named TIR_____.PFM; the Helvetica file is HV_____.PFM.
>
Thanks for your extra information. I think this is related to the fact
that the Uniscribe font backend can only use opentype and truetype
fonts, but Windows by default defines font substitutions for Helvetica
and Times to map to the Truetype fonts "Arial" and "Times New Roman". So
the uniscribe backend picks these substitutes up, but somehow things get
confused so the Type-1 fonts end up being loaded. I've added some code
to specifically reject these substitutes, which are detected by
comparing the font's "full name" with the name used to load it.
Unfortunately this also catches many legitimate fonts, so I've had to
pick out these two specific problematic substitutions. If there are any
other specific fonts that cause this problem, then we will need to add
rules for them too.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
[not found] <49297533.3040505@f2s.com>
` (2 preceding siblings ...)
2008-08-02 20:23 ` bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen Drew Adams
@ 2008-11-29 22:50 ` Drew Adams
2008-11-30 3:07 ` Jason Rumney
3 siblings, 1 reply; 21+ messages in thread
From: Drew Adams @ 2008-11-29 22:50 UTC (permalink / raw)
To: 'Jason Rumney'; +Cc: 642, 642-done, 'Miles Bader'
[-- Attachment #1: Type: text/plain, Size: 2206 bytes --]
I was able to test this, to see the difference.
The bug is indeed fixed - thanks.
However, FWIW, the fonts used are less readable than in Emacs 22, so this is a
slight regression. See the attached screenshots. Notice both the text in the tab
bar and the text in the Info menu heading `Utilities'. Notice too that the
tab-bar text seems to be cut off at the top: you cannot tell the `f' in
"icicles-fn.el" from a `t'. You probably could not tell an `n' from an `h', and
so on: ascenders are chopped.
Dunno if anything can be done about this, but I hope the additional feedback
might help. It's a shame to see Emacs look a little worse instead of better.
Thx - Drew
> From: Drew Adams Sent: Sunday, November 23, 2008 9:20 AM
> > Thanks for your extra information. I think this is related
> > to the fact that the Uniscribe font backend can only use
> > opentype and truetype fonts, but Windows by default defines
> > font substitutions for Helvetica and Times to map to the
> > Truetype fonts "Arial" and "Times New Roman". So
> > the uniscribe backend picks these substitutes up, but somehow
> > things get confused so the Type-1 fonts end up being loaded.
> > I've added some code to specifically reject these substitutes,
> > which are detected by comparing the font's "full name" with
> > the name used to load it. Unfortunately this also catches many
> > legitimate fonts, so I've had to pick out these two specific
> > problematic substitutions. If there are any other specific
> > fonts that cause this problem, then we will need to add
> > rules for them too.
>
> Thanks for fixing this, Jason.
>
> I don't understand all that you wrote, but I probably don't
> need to. ;-)
>
> I think you're saying, along with the explanation of why,
> that I should no longer see garbled text after your fix. I
> might not see some particular fonts, but I will be able to
> read the text in some font. If so, that's fine.
>
> BTW, I the extra info helped, then it's thanks to Miles's
> list-fonts-display code. That enabled me to see the problem
> wrt specific fonts. Perhaps something like his code should be
> added to Emacs? (Dunno if there is already something that does that.)
>
> Thx.
[-- Attachment #2: throw-emacs-23-fonts.png --]
[-- Type: image/png, Size: 27780 bytes --]
[-- Attachment #3: throw-emacs-22-fonts.png --]
[-- Type: image/png, Size: 28980 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-11-29 22:50 ` bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen Drew Adams
@ 2008-11-30 3:07 ` Jason Rumney
2008-12-22 21:30 ` Drew Adams
0 siblings, 1 reply; 21+ messages in thread
From: Jason Rumney @ 2008-11-30 3:07 UTC (permalink / raw)
To: Drew Adams; +Cc: 642, 642-done, 'Miles Bader'
Drew Adams wrote:
> However, FWIW, the fonts used are less readable than in Emacs 22
I think Emacs 22 probably got the system defined font substitutions,
rather than the fonts that were being asked for (ie Arial instead of the
real Helvetica). If you customize the `variable-pitch' face to use
Arial, do the screenshots look the same?
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen
2008-11-30 3:07 ` Jason Rumney
@ 2008-12-22 21:30 ` Drew Adams
0 siblings, 0 replies; 21+ messages in thread
From: Drew Adams @ 2008-12-22 21:30 UTC (permalink / raw)
To: 'Jason Rumney'; +Cc: 642, 642-done, 'Miles Bader'
> From: Jason Rumney Sent: Saturday, November 29, 2008 7:08 PM
> > However, FWIW, the fonts used are less readable than in Emacs 22
> I think Emacs 22 probably got the system defined font substitutions,
> rather than the fonts that were being asked for (ie Arial
> instead of the
> real Helvetica). If you customize the `variable-pitch' face to use
> Arial, do the screenshots look the same?
Yes, that solved the problem. The default family is Sans Serif. Changing it to
Arial gives the same appearance as Emacs 22, which is more readable, IMO.
Thx. Sorry I took so long; I misplaced your reply.
^ permalink raw reply [flat|nested] 21+ messages in thread
end of thread, other threads:[~2008-12-22 21:30 UTC | newest]
Thread overview: 21+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <49297533.3040505@f2s.com>
2008-07-22 23:34 ` bug#597: 23.0.60; Corrupted display ofv
2008-07-23 0:01 ` Juanma Barranquero
2008-07-23 0:44 ` Óscar Fuentes
2008-07-23 7:53 ` Juanma Barranquero
2008-07-23 8:01 ` Jason Rumney
2008-07-23 13:06 ` ofv
2008-11-23 15:30 ` bug#597: marked as done (23.0.60; Corrupted display.) Emacs bug Tracking System
2008-08-01 14:42 ` bug#639: 23.0.60; tab bars use bizarre characters now Drew Adams
2008-11-23 15:30 ` bug#639: marked as done (23.0.60; tab bars use bizarre characters now) Emacs bug Tracking System
2008-08-02 20:23 ` bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen Drew Adams
2008-08-02 21:05 ` Jason Rumney
2008-08-02 21:27 ` Drew Adams
2008-08-05 13:58 ` Drew Adams
2008-10-29 21:14 ` Drew Adams
2008-11-17 8:15 ` Drew Adams
2008-11-23 15:30 ` bug#642: marked as done (23.0.60; garbled text (wrong font?) in About GNU Emacs screen) Emacs bug Tracking System
2008-11-29 22:50 ` bug#642: 23.0.60; garbled text (wrong font?) in About GNU Emacs screen Drew Adams
2008-11-30 3:07 ` Jason Rumney
2008-12-22 21:30 ` Drew Adams
2008-08-02 20:50 Chong Yidong
2008-08-02 21:27 ` Drew Adams
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).