Commits

Anonymous committed 8eb7714

fake header-line-format and tidy up faces

  • Participants
  • Parent commits 6582f78

Comments (0)

Files changed (2)

+2002-02-17  John Paul Wallington  <jpw@xemacs.org>
+
+	* ibuffer.el (ibuffer-shrink-to-fit): make it an alias to
+	shrink-window-if-larger-than-buffer.
+	(ibuffer-set-header-line-format): new function.
+	(ibuffer-marked-face): replace defcustom with defface plus defvar.
+	(ibuffer-deletion-face): ditto.
+	(ibuffer-title-face): ditto.
+	(ibuffer-read-only-buffer-face): ditto.
+	(ibuffer-special-buffer-face): ditto.
+	(ibuffer-hidden-buffer-face): ditto.
+	(ibuffer-help-buffer-face): ditto.
+	(ibuffer-dired-buffer-face): ditto.
+	(ibuffer-header-line-face): new defface plus defvar.
+	(ibuffer-use-header-line): change default value to t. Docfix.
+	(ibuffer-truncate-lines): docfix.
+	(ibuffer-fontify-region-function): add header-line fontification.
+	(ibuffer-update-title): bind inhibit-read-only to t.
+	(ibuffer-update-mode-name): use ibuffer-set-header-line-format.
+	
 2002-02-16  John Paul Wallington  <jpw@shootybangbang.com>
 
 	* ibuf-macs.el (define-ibuffer-column): use ibuffer-propertize.
     (defun ibuffer-shrink-to-fit (&optional owin)
       (fit-window-to-buffer nil (when owin (/ (frame-height)
 					      (length (window-list (selected-frame)))))))
-  (defun ibuffer-shrink-to-fit (&optional owin)
-    (shrink-window-if-larger-than-buffer owin)))
+  (defalias 'ibuffer-shrink-to-fit 'shrink-window-if-larger-than-buffer))
     
 (if (fboundp 'replace-regexp-in-string)
     (defalias 'ibuffer-replace-regexp-in-string 'replace-regexp-in-string)
 	(setq start me))
       (setq matches (cons (substring string start l) matches))
       (apply #'concat (nreverse matches))))))
+
+(if (and (boundp 'header-line-format)
+	 (not (string-match "Lucid\\|XEmacs" emacs-version)))
+    (defun ibuffer-set-header-line (format)
+      (setq header-line-format format))
+  (defun ibuffer-set-header-line-format (format)
+    (save-excursion
+      (let ((top (goto-char (point-min)))
+	    (inhibit-read-only t))
+	(when (get-text-property top 'ibuffer-header-line)
+	  (delete-region top (next-single-property-change top 'ibuffer-title)))
+	(goto-char top)
+	(when format
+	  (if (> (length format) (- (window-width) 2))
+	      (setq format (substring format 0 (- (window-width) 2))))
+	  (insert format)
+	  (insert-char ?\  (max 0 (- (window-width) (current-column) 1)))
+	  (put-text-property top (point) 'ibuffer-header-line t)
+	  (unless (eolp)
+	    (insert "\n")))))))
   )
 
 (defgroup ibuffer nil
   :group 'ibuffer
   :group 'faces)
 
-(defcustom ibuffer-marked-face 'font-lock-warning-face
+(defface ibuffer-marked-face
+  '((((class color) (background light)) (:foreground "Red" :bold t))
+    (((class color) (background dark)) (:foreground "Pink" :bold t))
+    (t (:inverse-video t :bold t)))
   "Face used for displaying marked buffers."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-marked-face 'ibuffer-marked-face)
 
-(defcustom ibuffer-deletion-face 'font-lock-type-face
+(defface ibuffer-deletion-face
+  '((((class color) (background dark)) (:foreground "wheat"))
+    (((class color) (background light)) (:foreground "steelblue"))
+    (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for displaying buffers marked for deletion."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-deletion-face 'ibuffer-deletion-face)
 
-(defcustom ibuffer-title-face 'font-lock-type-face
+(defface ibuffer-title-face
+  '((((class color) (background dark)) (:foreground "wheat"))
+    (((class color) (background light)) (:foreground "steelblue"))
+    (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for the title string."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-title-face 'ibuffer-title-face)
 
-(defcustom ibuffer-read-only-buffer-face 'font-lock-keyword-face
+(defface ibuffer-read-only-buffer-face 
+  '((((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light) (type mswindows)) (:foreground "red"))
+    (((class color) (background light)) (:foreground "red4"))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for displaying read-only buffers."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-read-only-buffer-face 'ibuffer-read-only-buffer-face)
 
-(defcustom ibuffer-special-buffer-face 'font-lock-keyword-face
+(defface ibuffer-special-buffer-face 
+  '((((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light) (type mswindows)) (:foreground "red"))
+    (((class color) (background light)) (:foreground "red4"))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for displaying \"special\" buffers."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-special-buffer-face 'ibuffer-special-buffer-face)
 
-(defcustom ibuffer-hidden-buffer-face 'font-lock-keyword-face
+(defface ibuffer-hidden-buffer-face
+  '((((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light) (type mswindows)) (:foreground "red"))
+    (((class color) (background light)) (:foreground "red4"))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for displaying normally hidden buffers."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-hidden-buffer-face 'ibuffer-hidden-buffer-face)
 
-(defcustom ibuffer-help-buffer-face 'font-lock-keyword-face
+(defface ibuffer-help-buffer-face 
+  '((((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light) (type mswindows)) (:foreground "red"))
+    (((class color) (background light)) (:foreground "red4"))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for displaying help buffers \(info, apropos, help\)."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-help-buffer-face 'ibuffer-help-buffer-face)
 
-(defcustom ibuffer-dired-buffer-face 'font-lock-keyword-face
+(defface ibuffer-dired-buffer-face
+  '((((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light) (type mswindows)) (:foreground "red"))
+    (((class color) (background light)) (:foreground "red4"))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
   "Face used for displaying dired buffers."
-  :type 'face
   :group 'ibuffer-faces)
+(defvar ibuffer-dired-buffer-face 'ibuffer-dired-buffer-face)
+
+(defface ibuffer-header-line-face
+  '((((class color) (background light))
+     (:foreground "DarkGoldenrod" :background "Gray90"))
+    (((class color) (background dark))
+     (:foreground "LightGoldenrod" :background "Gray20"))
+    (((class grayscale) (background light)) (:background "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (t (:bold t)))
+  "Face used for displaying header-line."
+  :group 'ibuffer-faces)
+(defvar ibuffer-header-line-face 'ibuffer-header-line-face)
 
 (defcustom ibuffer-use-fontification (if (boundp 'font-lock-auto-fontify)
 					 font-lock-auto-fontify
   :group 'ibuffer)
 
 
-(defcustom ibuffer-use-header-line nil
-  "If non-nil, display a header line containing current filters.
-This feature only works on GNU Emacs 21 or later."
+(defcustom ibuffer-use-header-line t
+  "If non-nil, display a header line containing current filters."
   :type 'boolean
   :group 'ibuffer)
 
   :group 'ibuffer)
 
 (defcustom ibuffer-truncate-lines t
-  "If non-nil, do not display continuation lines within an Ibuffer buffer;
-give each line of text one frame line."
+  "If non-nil, do not display continuation lines."
   :type 'boolean
   :group 'ibuffer)
 
 							      (caddr e)
 							    (symbol-value (caddr e)))))))))))))))
 	(forward-line 1))))
+      
+  ;; fontify header-line
+  (save-excursion
+    (goto-char (point-min))
+    (if (get-text-property (point) 'ibuffer-header-line)
+	(put-text-property (point) (next-single-property-change (point) 'ibuffer-header-line) 'face 'ibuffer-header-line-face)))
+
   (when verbose (message "Fontifying...done")))
 
 (defun ibuffer-unfontify-region-function (beg end &optional loudly)
 (defun ibuffer-update-title (format)
   (assert (eq major-mode 'ibuffer-mode))
   ;; Don't do funky font-lock stuff here
-  (let ((after-change-functions nil))
+  (let ((after-change-functions nil)
+	(inhibit-read-only t))
     (if (get-text-property (point-min) 'ibuffer-title)
 	(delete-region (point-min)
 		       (next-single-property-change
 	(setq result
 	      (concat result (ibuffer-format-qualifier qualifier))))
       (if ibuffer-use-header-line
-	  (setq header-line-format
-		(when ibuffer-filtering-qualifiers
-		  (ibuffer-replace-regexp-in-string "%" "%%"
-						    (concat mode-name result))))
+	  (ibuffer-set-header-line-format
+	   (when ibuffer-filtering-qualifiers
+	     (ibuffer-replace-regexp-in-string "%" "%%"
+					       (concat mode-name result))))
 	(progn
 	  (setq mode-name (concat mode-name result))
 	  (when (boundp 'header-line-format)
-	    (setq header-line-format nil)))))))
+	    (ibuffer-set-header-line-format nil)))))))
 
 (defun ibuffer-redisplay (&optional silent)
   "Redisplay the current list of buffers.