comparison lisp/progmodes/ebrowse.el @ 63448:b9811baefe1a

Revision: [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces 2005-06-14 Miles Bader <[e-mail]> * lisp/progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class) (ebrowse-file-name, ebrowse-default, ebrowse-member-attribute) (ebrowse-member-class, ebrowse-progress): Remove "-face" suffix from face names. (ebrowse-tree-mark-face, ebrowse-root-class-face) (ebrowse-file-name-face, ebrowse-default-face) (ebrowse-member-attribute-face, ebrowse-member-class-face) (ebrowse-progress-face): New backward-compatibility aliases for renamed faces. (ebrowse-show-progress, ebrowse-show-file-name-at-point) (ebrowse-set-mark-props, ebrowse-draw-tree-fn) (ebrowse-draw-member-buffer-class-line, ebrowse-draw-member-long-fn) (ebrowse-draw-member-short-fn): Use renamed ebrowse faces.

63447:7976e5fa0225

(defgroup ebrowse-faces nil
  "Faces used by Ebrowse."
  :group 'ebrowse)


(defface ebrowse-tree-mark-face
  '((((min-colors 88)) (:foreground "red1"))
    (t (:foreground "red")))
  "*The face used for the mark character in the tree."
  :group 'ebrowse-faces)


(defface ebrowse-root-class-face
  '((((min-colors 88)) (:weight bold :foreground "blue1"))
    (t (:weight bold :foreground "blue")))
  "*The face used for root classes in the tree."
  :group 'ebrowse-faces)


(defface ebrowse-file-name-face
  '((t (:italic t)))
  "*The face for filenames displayed in the tree."
  :group 'ebrowse-faces)


(defface ebrowse-default-face
  '((t nil))
  "*Face for everything else in the tree not having other faces."
  :group 'ebrowse-faces)


(defface ebrowse-member-attribute-face
  '((((min-colors 88)) (:foreground "red1"))
    (t (:foreground "red")))
  "*Face used to display member attributes."
  :group 'ebrowse-faces)


(defface ebrowse-member-class-face
  '((t (:foreground "purple")))
  "*Face used to display the class title in member buffers."
  :group 'ebrowse-faces)


(defface ebrowse-progress-face
  '((((min-colors 88)) (:background "blue1"))
    (t (:background "blue")))
  "*Face for progress indicator."
  :group 'ebrowse-faces)



;;; Utilities.

    (when start (setq ebrowse-n-boxes 0))
    (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes))
    (message (concat title ": "
		     (propertize (make-string ebrowse-n-boxes
					      (if (display-color-p) ?\  ?+))
				 'face 'ebrowse-progress-face)))))


;;; Reading a tree from disk

(defun ebrowse-read ()

	    (indent-to ebrowse-source-file-column)
	    (insert "(" (or (ebrowse-cs-file
			     (ebrowse-ts-class tree))
			    "unknown")
		    ")"))
	  (ebrowse-set-face start (point) 'ebrowse-file-name-face)
	  (beginning-of-line)
	  (forward-line 1))))))


(defun ebrowse-toggle-file-name-display ()

TREE denotes the class shown."
  (add-text-properties
   start end
   `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree
		help-echo "double-mouse-1: mark/unmark"))
  (ebrowse-set-face start end 'ebrowse-tree-mark-face))


(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
  "Display a single class and recursively its subclasses.
This function may look weird, but this is faster than recursion."

	  ;; If template class, add <>
	  (when (ebrowse-template-p class)
	    (insert "<>"))
	  (ebrowse-set-face start (point) (if (zerop level)
					      'ebrowse-root-class-face
					    'ebrowse-default-face))
	  (setf start-of-class-name start
		end-of-class-name (point))
	  ;; If filenames are to be displayed...
	  (when ebrowse--show-file-names-flag
	    (indent-to ebrowse-source-file-column)
	    (setq start (point))
	    (insert "("
		    (or (ebrowse-cs-file class)
			"unknown")
		    ")")
	    (ebrowse-set-face start (point) 'ebrowse-file-name-face))
	  (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
	  (add-text-properties
	   start-of-class-name end-of-class-name
	   `(mouse-face highlight ebrowse-what class-name
			ebrowse-tree ,tree

    (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree)))
    (when (ebrowse-template-p (ebrowse-ts-class tree))
      (insert "<>"))
    (setq class-name-end (point))
    (insert ":\n\n")
    (ebrowse-set-face start (point) 'ebrowse-member-class-face)
    (add-text-properties
     class-name-start class-name-end
     '(ebrowse-what class-name
		    mouse-face highlight
		    help-echo "mouse-3: menu"))

	  (let ((start (point)))
	    (insert "<")
	    (ebrowse-draw-member-attributes member-struc)
	    (insert ">")
	    (ebrowse-set-face start (point)
			      'ebrowse-member-attribute-face)))
	(insert " ")
	(ebrowse-draw-member-regexp member-struc))))
  (insert "\n")
  (goto-char (point-min)))

	  (when ebrowse--attributes-flag
	    (insert "<")
	    (ebrowse-draw-member-attributes member)
	    (insert "> ")
	    (ebrowse-set-face start-of-entry (point)
			      'ebrowse-member-attribute-face))
	  ;; insert member name truncated to column width
	  (setq start-of-name (point))
	  (insert (substring name 0
			     (min (length name)
				  (1- ebrowse--column-width))))

63448:b9811baefe1a

(defgroup ebrowse-faces nil
  "Faces used by Ebrowse."
  :group 'ebrowse)


(defface ebrowse-tree-mark
  '((((min-colors 88)) (:foreground "red1"))
    (t (:foreground "red")))
  "*The face used for the mark character in the tree."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-tree-mark-face 'face-alias 'ebrowse-tree-mark)


(defface ebrowse-root-class
  '((((min-colors 88)) (:weight bold :foreground "blue1"))
    (t (:weight bold :foreground "blue")))
  "*The face used for root classes in the tree."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-root-class-face 'face-alias 'ebrowse-root-class)


(defface ebrowse-file-name
  '((t (:italic t)))
  "*The face for filenames displayed in the tree."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-file-name-face 'face-alias 'ebrowse-file-name)


(defface ebrowse-default
  '((t nil))
  "*Face for everything else in the tree not having other faces."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-default-face 'face-alias 'ebrowse-default)


(defface ebrowse-member-attribute
  '((((min-colors 88)) (:foreground "red1"))
    (t (:foreground "red")))
  "*Face used to display member attributes."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-member-attribute-face 'face-alias 'ebrowse-member-attribute)


(defface ebrowse-member-class
  '((t (:foreground "purple")))
  "*Face used to display the class title in member buffers."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-member-class-face 'face-alias 'ebrowse-member-class)


(defface ebrowse-progress
  '((((min-colors 88)) (:background "blue1"))
    (t (:background "blue")))
  "*Face for progress indicator."
  :group 'ebrowse-faces)
;; backward-compatibility alias
(put 'ebrowse-progress-face 'face-alias 'ebrowse-progress)



;;; Utilities.

    (when start (setq ebrowse-n-boxes 0))
    (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes))
    (message (concat title ": "
		     (propertize (make-string ebrowse-n-boxes
					      (if (display-color-p) ?\  ?+))
				 'face 'ebrowse-progress)))))


;;; Reading a tree from disk

(defun ebrowse-read ()

	    (indent-to ebrowse-source-file-column)
	    (insert "(" (or (ebrowse-cs-file
			     (ebrowse-ts-class tree))
			    "unknown")
		    ")"))
	  (ebrowse-set-face start (point) 'ebrowse-file-name)
	  (beginning-of-line)
	  (forward-line 1))))))


(defun ebrowse-toggle-file-name-display ()

TREE denotes the class shown."
  (add-text-properties
   start end
   `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree
		help-echo "double-mouse-1: mark/unmark"))
  (ebrowse-set-face start end 'ebrowse-tree-mark))


(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
  "Display a single class and recursively its subclasses.
This function may look weird, but this is faster than recursion."

	  ;; If template class, add <>
	  (when (ebrowse-template-p class)
	    (insert "<>"))
	  (ebrowse-set-face start (point) (if (zerop level)
					      'ebrowse-root-class
					    'ebrowse-default))
	  (setf start-of-class-name start
		end-of-class-name (point))
	  ;; If filenames are to be displayed...
	  (when ebrowse--show-file-names-flag
	    (indent-to ebrowse-source-file-column)
	    (setq start (point))
	    (insert "("
		    (or (ebrowse-cs-file class)
			"unknown")
		    ")")
	    (ebrowse-set-face start (point) 'ebrowse-file-name))
	  (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
	  (add-text-properties
	   start-of-class-name end-of-class-name
	   `(mouse-face highlight ebrowse-what class-name
			ebrowse-tree ,tree

    (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree)))
    (when (ebrowse-template-p (ebrowse-ts-class tree))
      (insert "<>"))
    (setq class-name-end (point))
    (insert ":\n\n")
    (ebrowse-set-face start (point) 'ebrowse-member-class)
    (add-text-properties
     class-name-start class-name-end
     '(ebrowse-what class-name
		    mouse-face highlight
		    help-echo "mouse-3: menu"))

	  (let ((start (point)))
	    (insert "<")
	    (ebrowse-draw-member-attributes member-struc)
	    (insert ">")
	    (ebrowse-set-face start (point)
			      'ebrowse-member-attribute)))
	(insert " ")
	(ebrowse-draw-member-regexp member-struc))))
  (insert "\n")
  (goto-char (point-min)))

	  (when ebrowse--attributes-flag
	    (insert "<")
	    (ebrowse-draw-member-attributes member)
	    (insert "> ")
	    (ebrowse-set-face start-of-entry (point)
			      'ebrowse-member-attribute))
	  ;; insert member name truncated to column width
	  (setq start-of-name (point))
	  (insert (substring name 0
			     (min (length name)
				  (1- ebrowse--column-width))))