home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / help-lucid-emacs / text0484.txt < prev    next >
Encoding:
Text File  |  1993-07-14  |  6.2 KB  |  200 lines
  1.  
  2. Dave Barker (dbarker@mulga.awadi.com.AU ) on June 9:
  3. > A minor patch to your dired-lucid-highlight package:
  4. > 
  5. > If you include a subdirectory in a dired display, then the
  6. > highlighting code goes into an infinite loop.
  7. > 
  8. > 
  9. > Cheers,
  10. > Dave.
  11.  
  12. Thanks to Dave Barker for the patch. I am including the new version below.
  13.  
  14. Cengiz
  15.  
  16. ======================================================================
  17.                                |  Systems Design and Analysis Group
  18.       Cengiz Alaettinoglu      |  Department of Computer Science    
  19.          ca@cs.umd.edu         |  University of Maryland         
  20.                                |  College Park, MD 20742      
  21. ======================================================================
  22. ;;; Copyright (C) 1993 Cengiz Alaettinoglu
  23. ;;; Cengiz Alaettinoglu <ca@cs.umd.edu>
  24.  
  25. ;;; Copyright (C) 1991 Tim Wilson and Sebastian Kremer
  26. ;;; Tim.Wilson@cl.cam.ac.uk
  27. ;;; Sebastian Kremer <sk@thp.uni-koeln.de>
  28. ;;; Modified to work with Lucid Emacs
  29.  
  30. ;;; This program is free software; you can redistribute it and/or modify
  31. ;;; it under the terms of the GNU General Public License as published by
  32. ;;; the Free Software Foundation; either version 1, or (at your option)
  33. ;;; any later version.
  34. ;;;
  35. ;;; This program is distributed in the hope that it will be useful,
  36. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  37. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  38. ;;; GNU General Public License for more details.
  39. ;;;
  40. ;;; A copy of the GNU General Public License can be obtained from this
  41. ;;; program's author (send electronic mail to the above address) or from
  42. ;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  43.  
  44. ; How to install
  45. ; (add-hook 'dired-load-hook '(lambda () (require 'dired-lucid-highlight)) t)
  46.  
  47. (require 'dired)
  48. (provide 'dired-lucid-highlight)
  49.  
  50. (or (find-face 'dired-face-marked)
  51.     (and
  52.      (make-face 'dired-face-marked)
  53.      (if (x-color-display-p)
  54.      (progn
  55.        (set-face-foreground 'dired-face-marked "Black")
  56.        (set-face-background 'dired-face-marked "PaleVioletRed"))
  57.        (progn
  58.      (set-face-underline-p 'dired-face-marked t)))
  59. ))
  60.  
  61. (or (find-face 'dired-face-deleted)
  62.     (and
  63.      (make-face 'dired-face-deleted)
  64.      (if (x-color-display-p)
  65.      (progn
  66.        (set-face-foreground 'dired-face-deleted "Black")
  67.        (set-face-background 'dired-face-deleted "LightSlateGray"))
  68.        (progn
  69.      (set-face-underline-p 'dired-face-deleted t)))
  70. ))
  71.  
  72. (or (find-face 'dired-face-directory)
  73.     (and
  74.      (make-face 'dired-face-directory)
  75.      (if (x-color-display-p)
  76.      (set-face-foreground 'dired-face-directory "Firebrick")
  77.        (make-face-bold-italic 'dired-face-directory))
  78. ))
  79.  
  80. (or (find-face 'dired-face-executable)
  81.     (and
  82.      (make-face 'dired-face-executable)
  83.      (if (x-color-display-p)
  84.      (set-face-foreground 'dired-face-executable "Purple")
  85.        (make-face-bold 'dired-face-executable))
  86. ))
  87.  
  88. (or (find-face 'dired-face-setuid)
  89.     (and
  90.      (make-face 'dired-face-setuid)
  91.      (if (x-color-display-p)
  92.      (set-face-foreground 'dired-face-setuid "Red")
  93.        (make-face-bold 'dired-face-setuid))
  94. ))
  95.  
  96. (or (find-face 'dired-face-socket)
  97.     (and
  98.      (make-face 'dired-face-socket)
  99.      (if (x-color-display-p)
  100.      (set-face-foreground 'dired-face-socket "Gold")
  101.        (make-face-italic 'dired-face-socket))
  102. ))
  103.  
  104. (or (find-face 'dired-face-symlink)
  105.     (and
  106.      (make-face 'dired-face-symlink)
  107.      (if (x-color-display-p)
  108.      (set-face-foreground 'dired-face-symlink "MediumBlue")
  109.        (make-face-italic 'dired-face-symlink))
  110. ))
  111.  
  112. (or (find-face 'dired-face-boring)
  113.     (and
  114.      (make-face 'dired-face-boring)
  115.      (if (x-color-display-p)
  116.      (set-face-foreground 'dired-face-boring "Grey")
  117.        (set-face-background-pixmap 'dired-face-boring 
  118.                    '(32 2 "\125\125\125\125\252\252\252\252")))
  119. ))
  120.  
  121. (defvar dired-x11-re-boring (if (fboundp 'dired-omit-regexp)
  122.                 (dired-omit-regexp)
  123.                   "^#\\|~$")
  124.   "Regexp to match backup, autosave and otherwise boring files.
  125. Those files are displayed in a boring color such as grey (see
  126. variable `dired-x11-boring-color').")
  127.  
  128. (defvar dired-re-socket
  129.   (concat dired-re-maybe-mark dired-re-inode-size "s"))
  130.  
  131. (defvar dired-re-setuid;; setuid plain file (even if not executable)
  132.   (concat dired-re-maybe-mark dired-re-inode-size
  133.       "-[-r][-w][Ss][-r][-w][sx][-r][-w][xst]"))
  134.  
  135. (defvar dired-re-setgid;; setgid plain file (even if not executable)
  136.   (concat dired-re-maybe-mark dired-re-inode-size
  137.       "-[-r][-w][-x][-r][-w][Ss][-r][-w][xst]"))
  138.  
  139. (defun dired-lucid-highlight-one (face)
  140.   (set-extent-face (make-extent (dired-move-to-filename) 
  141.                 (dired-move-to-end-of-filename)) 
  142.            face))
  143.  
  144. (defun dired-lucid-highlight ()
  145. ;  (message "Highlighting...")
  146.   (save-excursion
  147.     (goto-char (point-min))
  148.     (while (not (eobp))
  149.       (and (not (eolp))
  150.        (progn
  151.          (beginning-of-line)
  152.          (cond
  153.           ((re-search-forward
  154.         dired-x11-re-boring
  155.         (save-excursion
  156.           (end-of-line)
  157.           (point))
  158.         t)
  159.            (dired-lucid-highlight-one 'dired-face-boring))
  160.           ((looking-at dired-re-dir)
  161.            (dired-lucid-highlight-one 'dired-face-directory))
  162.           ((looking-at dired-re-sym)
  163.            (dired-lucid-highlight-one 'dired-face-symlink))
  164.           ((or (looking-at dired-re-setuid)
  165.            (looking-at dired-re-setgid))
  166.            (dired-lucid-highlight-one 'dired-face-setuid))
  167.           ((looking-at dired-re-exe)
  168.            (dired-lucid-highlight-one 'dired-face-executable))
  169.           ((looking-at dired-re-socket)
  170.            (dired-lucid-highlight-one 'dired-face-socket))
  171.           )))
  172.       (forward-line 1))
  173. ;    (message "Highlighting...done")
  174. ))
  175.  
  176. (setq font-lock-keywords-dired-mode
  177.       (list (cons "^\\*.*$" 'dired-face-marked)
  178.         (cons "^\\D.*$" 'dired-face-deleted)))
  179.  
  180. (add-hook 'dired-after-readin-hook 'dired-lucid-highlight)
  181. (add-hook 'dired-mode-hook 
  182.       '(lambda () 
  183.          (font-lock-mode nil)
  184.          (setq font-lock-keywords font-lock-keywords-dired-mode) 
  185. ))
  186.  
  187.  
  188.  
  189.  
  190.  
  191. Cengiz
  192.  
  193. ======================================================================
  194.                                |  Systems Design and Analysis Group
  195.       Cengiz Alaettinoglu      |  Department of Computer Science    
  196.          ca@cs.umd.edu         |  University of Maryland         
  197.                                |  College Park, MD 20742      
  198. ======================================================================
  199.  
  200.