Source

hyperbole / hui-em19-b.el

Diff from to

File hui-em19-b.el

-;;!emacs
-;;
-;; FILE:         hui-em19-b.el
-;; SUMMARY:      GNU Emacs V19 button highlighting and flashing support.
-;; USAGE:        GNU Emacs V19 Lisp Library
-;; KEYWORDS:     faces, hypermedia
-;;
-;; AUTHOR:       Bob Weiner
-;; ORG:          BeOpen.com
-;;
-;; ORIG-DATE:    21-Aug-92
-;; LAST-MOD:     13-Jun-99 at 01:44:55 by Bob Weiner
-;;
-;; Copyright (C) 1992-1995, BeOpen.com and the Free Software Foundation, Inc.
-;; See the "HY-COPY" file for license information.
-;;
-;; This file is part of Hyperbole.
-;; It is for use with GNU Emacs V19.
-;;
-;; DESCRIPTION:  
+;;; hui-em19-b.el --- GNU Emacs V19 button highlighting and flashing support.
+
+;; Copyright (C) 1992-1995, 2005, 2006 Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+
+;; Author: Bob Weiner, Brown U.
+;; Maintainer: Mats Lidell <matsl@contactor.se>
+;; Keywords: faces, hypermedia
+
+;; This file is part of GNU Hyperbole.
+
+;; GNU Hyperbole 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.
+
+;; GNU Hyperbole is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
 ;;
 ;;   This is truly prototype code.
 ;;
 ;;   Can't use read-only buttons here because then outline-mode
 ;;   becomes unusable.
 ;;
-;; DESCRIP-END.
+
+;;; Code:
 
 (if (and hyperb:emacs19-p (or noninteractive hyperb:window-system))
     nil
   (error "(hui-em19-b.el): Load only when running GNU Emacs V19 under a window system."))
 
-;;; ************************************************************************
+;;;
 ;;; Other required Elisp libraries
-;;; ************************************************************************
+;;;
 
-(require 'custom) ;; For defface.
 (require 'hvar)
 (require 'hbut)
 
 (defun hproperty:background ()
   "Returns default background color for current frame."
-  (or (face-background (defface default nil
-			 "Standard text face."))
+  (or (face-background (make-face 'default))
       (cdr (assq 'background-color (frame-parameters)))
       "White"))
 
 (defun hproperty:foreground ()
   "Returns default foreground color for current frame."
-  (or (face-foreground (defface default nil
-			 "Standard text face."))
+  (or (face-foreground (make-face 'default))
       (cdr (assq 'foreground-color (frame-parameters)))
       "Black"))
 
-;;; ************************************************************************
+;;;
 ;;; Public variables
-;;; ************************************************************************
+;;;
 
 (defvar hproperty:but-emphasize-p nil
   "*Non-nil means visually emphasize that button under mouse cursor is selectable.")
   "Color with which to highlight list/menu selections.
 Call (hproperty:set-item-highlight <color>) to change value.")
 
-;;; ************************************************************************
+;;;
 ;;; Public functions
-;;; ************************************************************************
+;;;
 
 ;; Support NEXTSTEP and X window systems.
 (and (not (fboundp 'display-color-p))
      (fboundp 'x-display-color-p)
-     (defalias 'display-color-p 'x-display-color-p))
+     (fset 'display-color-p 'x-display-color-p))
 
 (defun hproperty:but-add (start end face)
   "Add between START and END a button using FACE in current buffer.
-If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that
+If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that
 button is selectable whenever the mouse cursor moves over it."
   (let ((but (make-overlay start end)))
     (overlay-put but 'face face)
 If REGEXP-MATCH is non-nil, only buttons matching this argument are
 highlighted.
 
-If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that
+If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that
 button is selectable whenever the mouse cursor moves over it."
   (interactive)
   (hproperty:but-clear)
   (let ((but (hproperty:but-get pos)))
     (if but (delete-overlay but))))
 
-;;; ************************************************************************
+;;;
 ;;; Private functions
-;;; ************************************************************************
+;;;
 
 (defun hproperty:but-get (&optional pos)
   (car (delq nil
 	      (setq (, list-ptr) (cdr (, list-ptr))))
 	 (setq (, list-ptr) (, list)))))
 
-;;; ************************************************************************
+;;;
 ;;; Private variables
-;;; ************************************************************************
+;;;
 
 (defconst hproperty:color-list
-  (if (memq window-system '(x gtk)) 
+  (if (memq window-system '(x gtk))
       '( "red" "blue" "paleturquoise4" "mediumpurple2"
 "lightskyblue3" "springgreen2" "salmon" "yellowgreen" "darkorchid2"
 "aquamarine4" "slateblue4" "slateblue1" "olivedrab1" "goldenrod4"
   "Good colors for contrast against wheat background and black foreground.")
 
 
-;;; ************************************************************************
+;;;
 ;;; Public functions
-;;; ************************************************************************
+;;;
 
 (defun hproperty:cycle-but-color (&optional color)
   "Switches button color to optional COLOR name or next item referenced by hproperty:color-ptr."
       (setq start (point)))
     (setq b (and (hproperty:but-p start) hproperty:but-face))
     (if (setq a b)
-	(unwind-protect
-	    (progn
-	      (hproperty:set-but-face start hproperty:flash-face)
-	      (sit-for 0) ;; Force display update
-	      ;; Delay before redraw button
-	      (let ((i 0)) (while (< i hproperty:but-flash-time) (setq i (1+ i)))))
+	(progn
+	  (hproperty:set-but-face start hproperty:flash-face)
+	  (sit-for 0) ;; Force display update
+	  ;; Delay before redraw button
+	  (let ((i 0)) (while (< i hproperty:but-flash-time) (setq i (1+ i))))
 	  (hproperty:set-but-face start a)
-	  (sit-for 0))) ;; Force display update
-    (if (and ibut (not prev)) (hproperty:but-delete start))))
+	  (sit-for 0);; Force display update
+	  ))
+    (if (and ibut (not prev)) (hproperty:but-delete start))
+    ))
 
 (defun hproperty:set-item-highlight (&optional background foreground)
   "Setup or reset item highlight face using optional BACKGROUND and FOREGROUND."
   (if (stringp background) (setq hproperty:item-highlight-color background))
   (if (not hproperty:highlight-face)
       (progn 
-	(setq hproperty:highlight-face
-	      (defface hproperty:highlight-face nil
-  "Item highlighting face.  Use (hproperty:set-item-highlight) to set."))
+	(setq hproperty:highlight-face (make-face 'hproperty:highlight-face))
 	(set-face-foreground hproperty:highlight-face (or foreground
 							  (hproperty:background)))
 	(set-face-underline-p hproperty:highlight-face nil)))
 
   (let ((update-rolo-highlight-flag
 	 (and (boundp 'rolo-highlight-face)
-	      (internal-facep rolo-highlight-face)
+	      (facep rolo-highlight-face)
 	      (or (null (face-foreground rolo-highlight-face))
 		  (face-equal hproperty:highlight-face rolo-highlight-face)))))
     (if (not (equal (face-background hproperty:highlight-face)
   "Select item in current buffer at optional position PNT using hproperty:item-face."
   (if pnt (goto-char pnt))
   (skip-chars-forward " \t")
-  (skip-chars-backward "^ \t\n\r")
+  (skip-chars-backward "^ \t\n")
   (let ((start (point)))
     (save-excursion
-      (skip-chars-forward "^ \t\n\r")
+      (skip-chars-forward "^ \t\n")
       (hproperty:but-add start (point) hproperty:item-face)
       ))
   (sit-for 0)  ;; Force display update
   (sit-for 0)  ;; Force display update
   )
 
-;;; ************************************************************************
+;;;
 ;;; Private variables
-;;; ************************************************************************
+;;;
 
-(defvar hproperty:but-face
-  (progn (defface hbut nil "Hyperbole hyper-button face.")
-	 'hbut)
-  "Hyperbole hyper-button face.")
+(defvar hproperty:but-face (progn (make-face 'hbut) 'hbut) "Face for hyper-buttons.")
 (setq hproperty:but hproperty:but-face)
 (set-face-foreground hproperty:but-face (hproperty:but-color))
 (set-face-background hproperty:but-face (hproperty:background))
 
-(defvar hproperty:flash-face
-  (progn (defface hbut-flash nil "Hyperbole face for flashing hyper-buttons.")
-	 'hbut-flash)
-  "Hyperbole face for flashing hyper-buttons.")
+(defvar hproperty:flash-face (progn (make-face 'hbut-flash) 'hbut-flash)
+  "Face for flashing hyper-buttons.")
 (hproperty:set-flash-color)
 
 (defvar hproperty:item-button nil
   (hproperty:set-item-highlight (hproperty:foreground) (hproperty:background)))
 
 (provide 'hui-em19-b)
+
+;;; hui-em19-b.el ends here