home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / m / modeline.zip / MODELINE.EL next >
Text File  |  1993-03-25  |  25KB  |  637 lines
  1. ; Path: hal.com!olivea!spool.mu.edu!agate!agate.berkeley.edu!dodd
  2. ; From: dodd@mycenae.cchem.berkeley.edu (Lawrence R. Dodd)
  3. ; Newsgroups: gnu.emacs.sources
  4. ; Subject: update for mode-line.el
  5. ; Date: 20 Feb 93 20:35:55 GMT
  6. ; Organization: Polytechnic Univ, Chem Eng Dept, Brooklyn, NY, USA
  7. ; NNTP-Posting-Host: mycenae.cchem.berkeley.edu
  8. ; 
  9. ; 
  10. ; 
  11. ;   Here is an update for mode-line.el.  Please read the note concerning
  12. ;   kill-fix.el.  mode-line.el now supports abbreviated directories in Tree
  13. ;   Dired buffers if the variable `mode-line-abbrev-dired' is t.  Thanks to Ed
  14. ;   Rapoport (rapoport@camax.com) for suggesting this.
  15. ; 
  16. ; Share and Enjoy,
  17. ; Larry
  18. ; dodd@roebling.poly.edu
  19. ; 
  20. ; 
  21. ; <file: ~/lisp/mode-line.el>
  22. ; ........................... cut along dotted line ...........................
  23. ;; mode-line.el -- code for including abbreviated file paths in mode line
  24.  
  25. (defconst mode-line-version (substring "$Revision: 2.69 $" 11 -2)
  26.   "The revision number of mode-line.el -- code for including abbreviated file
  27. paths in mode line. To send a bug report type M-x mode-line-submit-report.
  28. Complete RCS identity is
  29.  
  30.    $Id: mode-line.el,v 2.69 1993/02/20 17:49:01 dodd Exp $
  31.  
  32. This file is available via anonymous ftp in:
  33.  
  34.  /roebling.poly.edu:/pub/mode-line.el
  35.  /archive.cis.ohio-state.edu:/pub/gnu/emacs/elisp-archive/misc/mode-line.el.Z
  36.  
  37. also available \(if needed - see `POSSIBLE REQUIREMENT' in mode-line.el\)
  38.  
  39.  /roebling.poly.edu:/pub/kill-fix.el
  40.  /archive.cis.ohio-state.edu:/pub/gnu/emacs/elisp-archive/as-is/kill-fix.el.Z")
  41.  
  42. ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  43. ;;
  44. ;; This program is free software; you can redistribute it and/or modify
  45. ;; it under the terms of the GNU General Public License as published by
  46. ;; the Free Software Foundation; either version 1, or (at your option)
  47. ;; any later version.
  48. ;;
  49. ;; This program is distributed in the hope that it will be useful,
  50. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  51. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  52. ;; GNU General Public License for more details.
  53. ;;
  54. ;; You should have received a copy of the GNU General Public License
  55. ;; along with this program; if not, write to the Free Software
  56. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  57.  
  58. ;; LCD Archive Entry:
  59. ;; mode-line|Lawrence R. Dodd|dodd@roebling.poly.edu|
  60. ;; Code for including abbreviated file paths in mode line.|
  61. ;; 1993-02-20|2.69|~/misc/mode-line.el.Z|
  62.  
  63. ;;; VERSION:
  64. ;;;
  65. ;;; $Modified: Sat Feb 20 20:27:08 GMT 1993 by dodd $
  66. ;;; $Id: mode-line.el,v 2.69 1993/02/20 17:49:01 dodd Exp $
  67. ;;; $Revision: 2.69 $ 
  68.  
  69. ;;; AVAILABLE: 
  70. ;;; 
  71. ;;; via anonymous ftp to roebling.poly.edu [128.238.5.31] in /pub/mode-line.el
  72. ;;; (ange-ftp TAG: /roebling.poly.edu:/pub/mode-line.el) and via anonymous ftp 
  73. ;;; to archive.cis.ohio-state.edu in 
  74. ;;; /pub/gnu/emacs/elisp-archive/misc/mode-line.el.Z
  75.  
  76. ;;; BUG REPORTS: 
  77. ;;; 
  78. ;;; just type M-x mode-line-submit-report to generate a bug report template
  79.  
  80. ;;; MAINTAINER OF mode-line.el:
  81. ;;;  
  82. ;;; Lawrence R. Dodd       <dodd@roebling.poly.edu>
  83. ;;; Chemical Engineering
  84. ;;; Polytechnic University 
  85. ;;; Brooklyn, New York
  86.  
  87. ;;; CONTRIBUTORS TO mode-line.el:
  88. ;;;
  89. ;;; Lawrence R. Dodd
  90. ;;; dodd@roebling.poly.edu
  91. ;;;
  92. ;;; Robert McLay 
  93. ;;; mclay@cfdlab.ae.utexas.edu
  94. ;;; (for much beta-testing and many good suggestions)
  95. ;;;
  96. ;;; Crys Rides (a.k.a., James C. Ghering) 
  97. ;;; crys@cave.tcp.com
  98. ;;; (for suggesting and testing of view-mode support)
  99. ;;;
  100. ;;; Vladimir G. Ivanovic 
  101. ;;; vladimir@Eng.Sun.COM 
  102. ;;; (for beta-testing with Lucid (v19) emacs)
  103. ;;; 
  104. ;;; Ed Rapoport
  105. ;;; rapoport@camax.com 
  106. ;;; (for suggesting Tree Dired support)
  107.  
  108. ;;; HISTORY:
  109. ;;; 
  110. ;;; Derived from prettymodeln.el.  That file was checked in as version 2.1 of
  111. ;;; mode-line.el.  This is a cleaned, debugged, and more robust version of
  112. ;;; that original code containing more features and documentation. I would
  113. ;;; have named this prettymodeln++.el but that is too many letters...and
  114. ;;; besides I hack Fortran.
  115. ;;;
  116. ;;; AUTHOR OF prettymodeln.el: 
  117. ;;; 
  118. ;;; Andy Gaynor (a.k.a., Silver)
  119. ;;; gaynor@paul.rutgers.edu ...!rutgers!paul.rutgers.edu!gaynor
  120. ;;; 
  121. ;;;                               _   /|  Splthlt...
  122. ;;;                    Ahckthph!  \`o_@'
  123. ;;;                                 (_)
  124. ;;;                                  U   Ptooey!
  125. ;;;
  126. ;;; Created: 13 Sep 87 18:34:59 GMT
  127.  
  128. ;;; POSSIBLE REQUIREMENT:
  129. ;;;
  130. ;;; kill-fix.el - (for v18 of Emacs only)
  131. ;;;
  132. ;;;   available via anonymous ftp to archive.cis.ohio-state.edu [128.146.8.52]
  133. ;;;   in /pub/gnu/emacs/elisp-archive/as-is/kill-fix.el.Z.
  134. ;;;
  135. ;;;   There is one small bug in mode-line.el that occurs when the major mode
  136. ;;;   of a buffer is changed.  Changing the major mode incorrectly resets the
  137. ;;;   buffer identification used in the mode line to the plain buffer display.
  138. ;;;   This bug is corrected easily and transparently in v19 of GNU Emacs (or
  139. ;;;   in Lucid Emacs). However, if v18 of Emacs is being used, then
  140. ;;;   mode-line.el will attempt to load Joe Wells' kill-fix.el. However, if
  141. ;;;   the file does not exist in the load path nothing tragic will happen. The
  142. ;;;   bug will simply not be fixed.
  143.  
  144. ;;; INSTALLATION/USAGE:
  145. ;;;
  146. ;;;   o  save as mode-line.el in the load-path of GNU emacs 
  147. ;;;   o  optional: get kill-fix.el if you are using v18 of Emacs (see above)
  148. ;;;   o  stick this in your ~/.emacs:
  149. ;;;
  150. ;;;                (require 'mode-line) 
  151. ;;;   
  152. ;;;   o  use C-c C-t to scroll through different mode lines manually
  153. ;;;      (with an argument it will scroll through them automatically)
  154. ;;;   o  user may wish to change value of `mode-line-abbrev-dired'
  155.  
  156. ;;; ADVANCED USAGE:
  157. ;;;
  158. ;;;   o  same as above but also stick something _like_ the following inside 
  159. ;;;      your ~/.emacs:
  160. ;;; 
  161. ;;;   (setq file-name-abbreviation-alist
  162. ;;;         (list 
  163. ;;;          (cons  (concat "^" (expand-file-name "~") 
  164. ;;;                         "/" "special/")  "special:")
  165. ;;;          (cons  (concat "^" (expand-file-name "~") "/")  "~/")
  166. ;;;          '("^/dodd@roebling.poly.edu:/home/dodd/" . "Roebling:")
  167. ;;;          '("^/joe@\\([a-zA-Z0-9.]*\\).\\(edu\\|gov\\):/home/joe/" . "\\1:")
  168. ;;;          '("^.*/\\([^/]*/\\)" . "\\1")))  
  169. ;;; 
  170. ;;; The explanation of above is as follows. If I am editing a file called
  171. ;;; `filename' this list of associations will be attempted in this order: if
  172. ;;; the full path to `filename' is
  173. ;;; 
  174. ;;; (1) `/myhomedirectory/special/filename' display as `special:filename' 
  175. ;;;      (this is useful for much used sub-sub-directories)
  176. ;;; (2) `/myhomedirectory/filename' display as `~/filename' 
  177. ;;;      (this eliminates those long paths to your home directory)
  178. ;;; (3) `/user@machine.edu:/anything/filename' display as `Machine:filename' 
  179. ;;;     (this is _extremely_ useful with ange-ftp)
  180. ;;; (4) `/user@regexp.edu:/anything/filename' display as `regexp:filename' 
  181. ;;;     (this is the same as above but attempts to use a regular expression)
  182. ;;; (5) `/snafu/barfoo/filename' display as `barfoo:filename' 
  183. ;;;     (this shows just the current directory and is done for any path that
  184. ;;;     does not match one of the above)
  185.  
  186. ;;; SEE ALSO: 
  187. ;;; 
  188. ;;; For more information on the filename associations list, after
  189. ;;; loading, do `M-x describe-variable file-name-abbreviation-alist'
  190.  
  191. ;;; MOTIVATION:
  192. ;;; 
  193. ;;; Buffer names in the mode line are not very informative. When files with
  194. ;;; the same name are being visited in different directories the mode line
  195. ;;; shows names like "Makefile," "Makefile<2>," "Makefile<3>," and so on.  The
  196. ;;; zeroth order correction is to use the file name and directory in the mode
  197. ;;; line.  However, long file names with full directory paths (for example
  198. ;;; /u2/luser/foobar/bletch/src/0.1/foobar/Makefile) in the mode line are a
  199. ;;; pain in the ass.  They suck up the whole mode line, and are a strain on
  200. ;;; the eyes to differentiate. We would like to display things like
  201. ;;; "foobar/Makefile," "barfoo/Makefile," "conserve/Makefile," and so on in
  202. ;;; the mode line.
  203. ;;;
  204. ;;; You will find here a mode line formatting scheme that is fairly nice.  It
  205. ;;; displays the buffer name if the buffer is not associated with a file.
  206. ;;; Otherwise, it displays the file name, but only after abbreviating it as
  207. ;;; per a list of abbreviations that you provide.
  208.  
  209. ;;; LOGIC: 
  210. ;;; 
  211. ;;; Set up the mode line by making mode-line-buffer-identification local to
  212. ;;; every buffer.  Various hooks will abbreviate the buffer-file-name to
  213. ;;; something a little easier to read.
  214. ;;; 
  215. ;;;   `buffer-file-name' == the original file name   
  216. ;;;   `file-name-abbreviation-alist' == list of abbreviations
  217. ;;;   `abbreviate-mode-line-buffer-identification' == what hooks call      
  218. ;;;   `string-replace-regexp-in-alist' == means of abbreviation
  219.  
  220. ;;; KNOWN BUGS WITH SUGGESTED PATCHES:
  221. ;;; 
  222. ;;;   1. Sebastian Kremer's Tree Dired (v 6.0, available via anonymous ftp
  223. ;;;   from ftp.uni-koeln.de[134.95.80.1]:/pub/gnu/emacs/diredall.tar.Z) is an
  224. ;;;   improvement over the distribution dired for reasons too numerous to
  225. ;;;   mention. One major improvement is that Kremer's Dired correctly renames
  226. ;;;   any buffers visiting a file that is renamed using dired-mode.
  227. ;;; 
  228. ;;;   Unfortunately, it uses `set-visited-file-name' in the function
  229. ;;;   `dired-rename-file', which does not use `write-hooks'. The result being
  230. ;;;   that while the buffer is renamed, the mode line is not updated properly
  231. ;;;   after a dired-do-move (key r).  The patch is to force a call to
  232. ;;;   `abbreviate-mode-line-buffer-identification' after the call to
  233. ;;;   `set-visited-file-name' in the function `dired-rename-file':
  234. ;;;
  235. ;;;      (defun dired-rename-file (from to ok-flag)
  236. ;;;                                ...
  237. ;;;                        [material not shown]
  238. ;;;                                ...
  239. ;;;              (let ((modflag (buffer-modified-p)))
  240. ;;;                (set-visited-file-name to)   ; kills write-file-hooks
  241. ;;;     +          ;; for mode-line.el
  242. ;;;     +          (and (memq 'abbreviate-mode-line-buffer-identification
  243. ;;;     +                     write-file-hooks)
  244. ;;;     +                 (abbreviate-mode-line-buffer-identification)) 
  245. ;;;                (set-buffer-modified-p modflag))))
  246. ;;;                                ...
  247. ;;;                        [material not shown]
  248. ;;;                                ... 
  249. ;;; 
  250. ;;;   this patch is also available at /roebling.poly.edu in 
  251. ;;;   /pub/mode-line-dired-6.0.patch
  252. ;;;  
  253. ;;;   2. Dave Gillespie's live-find-file.el does not invoke a major mode so
  254. ;;;   the mode line is not set properly. This patch will fix it. 
  255. ;;;   A call to `abbreviate-mode-line-buffer-identification' is needed 
  256. ;;;  
  257. ;;;      (defun live-find-file (filename)
  258. ;;;                                ...
  259. ;;;                        [material not shown]
  260. ;;;                                ... 
  261. ;;;          (set-buffer-modified-p nil)
  262. ;;;          (setq buffer-read-only t)
  263. ;;;      +   ;; for mode-line.el
  264. ;;;      +   (and (memq 'abbreviate-mode-line-buffer-identification
  265. ;;;      +             write-file-hooks)
  266. ;;;      +       (abbreviate-mode-line-buffer-identification)) 
  267. ;;;          (goto-char (point-max))
  268. ;;;          (setq default-directory (file-name-directory filename))
  269. ;;;                                ...
  270. ;;;                        [material not shown]
  271. ;;;                                ... 
  272. ;;;  
  273. ;;;   this patch is also available at /roebling.poly.edu in 
  274. ;;;   /pub/mode-line-live.patch
  275.  
  276. ;;; First, we need to load the default `view' package (be it view.el or
  277. ;;; new-view.el) so that `view-hook' will be defined when we append to it
  278. ;;; below.
  279.  
  280. (require 'view)
  281.  
  282. ;;; GENERAL DISPLAY STUFF:
  283.  
  284. ;;; This makes the mode line display the day, date, time of day, and average
  285. ;;; number of processes. The increment for time update is 30 seconds, also
  286. ;;; `Mail' appears if there is any unread mail.  Users may wish to comment
  287. ;;; this stuff out.
  288.  
  289. (setq display-time-interval 30)
  290. (setq display-time-day-and-date t)
  291. (display-time)
  292.  
  293. ;;; Customize mode-line-format and its constituents. 
  294.  
  295. ;;; Make sure you use mode-line-buffer-identification to identify the buffer
  296. ;;; in your mode-line-format.  This variable must be buffer-local (if it is
  297. ;;; not already).
  298.  
  299. ;;; Note that mode-line-buffer-identification must be used to identify the
  300. ;;; buffer.  mode-line-modified is retained because it is in emacs' own
  301. ;;; default mode-line-format, and emacs might do some clever tricks with it.
  302.  
  303. (make-variable-buffer-local 'mode-line-modified)
  304. (setq-default mode-line-modified '("%*%*-"))
  305.  
  306. (make-variable-buffer-local 'mode-line-buffer-identification)
  307. (setq-default mode-line-buffer-identification '("%b"))
  308.  
  309. ;; create a new buffer-local variable to keep track of the current state of 
  310. ;; the mode line for use by mode-line-toggle-display.
  311.  
  312. (make-variable-buffer-local 'mode-line-state)
  313.  
  314. (defvar mode-line-state "buffer-name"
  315.   "A buffer-local variable to keep track of the current state of the mode line
  316. for use by mode-line-toggle-display.")
  317.  
  318. (setq-default mode-line-state "buffer-name")
  319.  
  320. ;; KLUDGE
  321.  
  322. ;; If the user changes the major mode of a buffer the variables
  323. ;; `mode-line-buffer-identification' and `mode-line-state' are set to their
  324. ;; default values by kill-all-local-variables. This screws up the mode line
  325. ;; but can be fixed by preserving these two variables.
  326.  
  327. (if (equal (substring emacs-version 0 2) "19") 
  328.     ;; version 19 of GNU emacs - preserve feature built-in
  329.     (progn
  330.       (put 'mode-line-buffer-identification 'permanent-local t)
  331.       (put 'mode-line-state 'permanent-local t))
  332.   ;; version 18 of GNU emacs - have kill-fix?
  333.   (if (load "kill-fix" t t)
  334.       ;; user has Joe Wells' kill-fix.el, use it to preserve these variables
  335.       (progn
  336.         (put 'mode-line-buffer-identification 'preserved t)
  337.         (put 'mode-line-state 'preserved t))))
  338.  
  339. ;;; now the define the organization of the mode-line-format
  340.  
  341. (setq-default mode-line-format
  342.   '("--"
  343.     mode-line-modified
  344.     " "
  345.     mode-line-buffer-identification
  346.     " %[("
  347.     (-10 . mode-name) ; truncate mode name to 10 chars, it got too long - LRD
  348.     minor-mode-alist
  349.     "%n"
  350.     mode-line-process
  351.     " "
  352.     (-3 . "%p") ; make string at most 3 chars: `Top', `Bot', or `nn%' - LRD
  353.     ")%] "
  354.     global-mode-string
  355.     " %-"))
  356.  
  357. ;;; A big thankyou to Robert McLay (mclay@cfdlab.ae.utexas.edu) for help with
  358. ;;; the following - LRD.
  359.  
  360. ;;; Form home directory with a leading `^' and trailing `/' so if your home
  361. ;;; directory is /home/machine/user-name then home-dir is
  362. ;;; `^/home/machine/user-name/' (without the quotes) The leading `^' is need
  363. ;;; to match the leading end of the string.
  364.  
  365. ;;; (originally was not a user option because it was missing the `*' - LRD)
  366.  
  367. (defvar file-name-abbreviation-alist
  368.       (list 
  369.        (cons  (concat "^" (expand-file-name "~") "/")  "~/"))
  370.  
  371.   "*Alist of embedded filename patterns versus the corresponding desired
  372. abbreviations. Each element is of the form (<regexp> . <to-string>).
  373.  
  374. The package mode-line.el goes down this alist looking for matches to regular
  375. expression <regexp> in the full pathname of the file and replaces it with
  376. <to-string>.  This is then repeated for all <regexp> in the list. This fact
  377. can be exploited in forming the regular expressions. However, since the
  378. searching and replacing is done top-down, special cases should be put at the
  379. head of the list.
  380.  
  381. Examples:
  382.  
  383.   If the user often plays with the files in /u2/luser/foobar/bletch.
  384.   What the user may want to do is replace leading instances of this
  385.   path with just `bletch.'  To do this stick the association into
  386.   the alist
  387.  
  388.      (\"^/u2/luser/foobar/bletch\" . \"bletch\")
  389.  
  390.   Another good association is to display only the last directory in
  391.   the path if no other special case applies. This is done with the
  392.   following association
  393.  
  394.      (\"^.*/\\([^/]*/\\)\" . \"\\1\")
  395.  
  396.   Finally, one can also abbreviate those long filenames that result
  397.   when using ange-ftp
  398.  
  399.      (\"^/emily@roebling.poly.edu:/columbia/heights/emily/\" . \"Roebling:\")
  400.  
  401.   The default entry for this variable removes the home directory
  402.   path and replaces it with ~/
  403.  
  404.      (cons  (concat \"^\" (expand-file-name \"~\") \"/\")  \"~/\")")
  405.  
  406. (defvar mode-line-abbrev-dired t
  407.   "*A value of `t' means that mode-line.el will abbreviate directory paths in
  408. Tree Dired buffers via its `dired-after-readin-hook.'  Otherwise, not done.")
  409.  
  410. ;;;; DEFUNS
  411.  
  412. ;;; the function that makes the substitutions - this is the work-horse
  413.  
  414. (defun string-replace-regexp-in-alist (string replacement-alist)
  415.  
  416.    "Given a string STRING, replace *each* instance of <regexp> (cars of elements
  417. in REPLACEMENT-ALIST) with <to-string> (cdrs of elements in REPLACEMENT-ALIST)
  418. and return the new string. The above is different from simply replacing the
  419. first match in the alist and then leaving. This is why a temporary buffer is
  420. used."
  421.  
  422.    (save-excursion
  423.        
  424.      (let 
  425.  
  426.          ;; VARLIST - we need to generate a unique name for temporary buffer
  427.          ;; (originally just used `!@#$%^&*' which, believe or not, might not be
  428.          ;; unique - LRD)
  429.  
  430.          ((temp-buffer (get-buffer-create (make-temp-name "!@#$%^&*")))
  431.           (temp-alist replacement-alist) ; don't mess with incoming alist
  432.           (new-string)) ; this is the value to be returned 
  433.  
  434.        ;; create temporary buffer
  435.        (set-buffer temp-buffer)
  436.        
  437.        ;; insert incoming string (name of filename with full path name)
  438.        (insert string)
  439.        
  440.        ;; we want to make sure the temporary buffer is killed
  441.        (unwind-protect
  442.            
  443.            ;; BODY
  444.            (progn
  445.              
  446.              ;; walk down `temp-alist', removing as we go, until it is empty
  447.              (while temp-alist
  448.                
  449.                ;; go to beginning of temporary buffer
  450.                (goto-char (point-min))
  451.                
  452.                ;; search the temporary buffer for every occurrence of the
  453.                ;; regular expression stored in `(car (car temp-alist))' and
  454.                ;; replace it with the one stored in `(cdr (car temp-alist))'
  455.                ;; (code originally used replace-regexp - LRD)
  456.                
  457.                (while (re-search-forward (car (car temp-alist)) nil t)
  458.                  (replace-match (cdr (car temp-alist))))
  459.                
  460.                ;; decrement temp-alist and restart while-loop
  461.                (setq temp-alist (cdr temp-alist)))
  462.              
  463.              ;; set return string to what remains in the temporary buffer
  464.              (setq new-string (buffer-string)))
  465.          
  466.          ;; CLEAN UP - no matter what happens, remove the temporary buffer
  467.          (kill-buffer temp-buffer))
  468.      
  469.      ;; return value of converted string
  470.      new-string)))
  471.  
  472. ;;; function that creates the abbreviated identification and is called by the
  473. ;;; various hooks (originally returned non-nil values - LRD)
  474.  
  475. (defun abbreviate-mode-line-buffer-identification ()
  476.  
  477.   "Abbreviates mode-line-buffer-identification locally using the function
  478. string-replace-regexp-in-alist and the alist file-name-abbreviation-alist.
  479. This function will return nil always. This is needed for view-mode since it
  480. will call this function even if it is not visiting a file and its return value
  481. needs to be predictable (as opposed to garbage). A nil return is also needed
  482. for the write-file-hooks."
  483.  
  484.   (if buffer-file-name
  485.       (progn
  486.         (setq mode-line-buffer-identification
  487.               (list
  488.                (string-replace-regexp-in-alist buffer-file-name
  489.                                                file-name-abbreviation-alist)))
  490.         (setq mode-line-state "abbrev-file-name"))
  491.     ;; an attempt at Tree Dired support - instead of the buffer-file-name we 
  492.     ;; pass the default-directory sans the last slash
  493.     (if (and mode-line-abbrev-dired (eq major-mode 'dired-mode))
  494.       (progn
  495.         (setq mode-line-buffer-identification
  496.               (list (string-replace-regexp-in-alist
  497.                      ;; special case of home directory
  498.                      (if (string= default-directory (expand-file-name "~/"))
  499.                          ;; pass the whole thing, otherwise looks funny
  500.                          default-directory
  501.                        ;; remove final slash
  502.                        (substring default-directory 0 -1))
  503.                      file-name-abbreviation-alist)))
  504.         (setq mode-line-state "abbrev-file-name"))
  505.     (setq mode-line-state "buffer-name")))
  506.   ;; always return nil
  507.   nil)
  508.  
  509. ;;;; HOOKS
  510.  
  511. ;;; Add abbreviate-mode-line-buffer-identification to find-file-hooks,
  512. ;;; write-file-hooks, and view-hook but only if it has not been added already
  513. ;;; (originally overwrote find-file-hooks - LRD).
  514.  
  515. (or (memq 'abbreviate-mode-line-buffer-identification find-file-hooks)
  516.     (setq find-file-hooks
  517.           (append '(abbreviate-mode-line-buffer-identification)
  518.                   find-file-hooks)))
  519.  
  520. (or (memq 'abbreviate-mode-line-buffer-identification view-hook)
  521.     (setq view-hook
  522.           (append '(abbreviate-mode-line-buffer-identification) 
  523.                   view-hook)))
  524.  
  525. (or (memq 'abbreviate-mode-line-buffer-identification write-file-hooks)
  526.     (setq write-file-hooks 
  527.           (append '(abbreviate-mode-line-buffer-identification)
  528.                   write-file-hooks)))
  529.  
  530. ;;; add to Tree Dired's `dired-after-readin-hook' this allows dired buffers to 
  531. ;;; contain abbreviated paths in the mode line too
  532.  
  533. (defvar dired-after-readin-hook nil) ; may not be defined yet...
  534. (if (fboundp 'diff-add-hook)
  535.     ;; use Tree Dired's own add-hook
  536.     (dired-add-hook 'dired-after-readin-hook
  537.                     'abbreviate-mode-line-buffer-identification)
  538.   ;; check by hand
  539.   (or (memq 'abbreviate-mode-line-buffer-identification dired-after-readin-hook)
  540.       (setq dired-after-readin-hook
  541.             (cons 'abbreviate-mode-line-buffer-identification
  542.                   dired-after-readin-hook))))
  543.  
  544. ;;;; TOGGLE 
  545.  
  546. (define-key global-map "\C-c\C-t" 'mode-line-toggle-display)
  547.  
  548. (defun mode-line-toggle-display (arg)
  549.  
  550.   "Cycles the buffer descriptor currently being displayed in modeline. If
  551. filename is currently displayed as abbreviated, then display with full path.
  552. If full path is currently displayed, then display just the buffer name. If the
  553. buffer name is currently displayed, then display the abbreviated filename.
  554. With argument will scroll through displays automatically."
  555.  
  556.   (interactive "P")
  557.  
  558.   (if buffer-file-name
  559.  
  560.       (if arg
  561.  
  562.           ;; scroll display
  563.           (progn
  564.             (mode-line-toggle-display nil)
  565.             ;(sit-for 1)
  566.             (mode-line-toggle-display nil)
  567.             ;(sit-for 1)
  568.             (mode-line-toggle-display nil))
  569.  
  570.         ;; change display 
  571.         (progn
  572.           (if (string= mode-line-state "abbrev-file-name")
  573.               (progn (setq mode-line-buffer-identification (buffer-file-name))
  574.                      (setq mode-line-state "full-file-name")
  575.                      (message "full path name"))
  576.             (if (string= mode-line-state "full-file-name")
  577.                 (progn (setq mode-line-buffer-identification '("Emacs: %b"))
  578.                        (setq mode-line-state "buffer-name")
  579.                        (message "buffer name"))
  580.               (progn (abbreviate-mode-line-buffer-identification)
  581.                      (setq mode-line-state "abbrev-file-name")
  582.                      (message "abbreviated"))))
  583.         
  584.         ;; force redisplay of mode line
  585.         (set-buffer-modified-p (buffer-modified-p))
  586.         (sit-for 1)
  587.         (message " ")))))
  588.  
  589. ;;;; BUG REPORTS
  590.  
  591. ;;; this section is provided for reports.
  592. ;;; adopted from Barry A. Warsaw's c++-mode.el
  593.  
  594. (defvar mode-line-mailer 'mail
  595.   "*Mail package to use to generate report mail buffer.")
  596.  
  597. (defconst mode-line-help-address "dodd@roebling.poly.edu"
  598.   "Address accepting submission of reports on mode-line.el.")
  599.  
  600. (defconst mode-line-maintainer "Larry"
  601.   "First name of person accepting submission of reports on mode-line.el.")
  602.  
  603. (defconst mode-line-file "mode-line.el"
  604.   "Name of file containing emacs lisp code.")
  605.  
  606. (defun mode-line-submit-report ()
  607.   "Submit via mail a report using the mailer in mode-line-mailer, filename in
  608. mode-line-file, to address in mode-line-help-address."
  609.   (interactive)
  610.   (funcall mode-line-mailer)
  611.   (insert mode-line-help-address)
  612.   (let ((case-fold-search t))
  613.     (if (re-search-forward "^subject:[ \t]+" (point-max) 'move)
  614.         (insert "Report on " mode-line-file " " mode-line-version))
  615.     (if (not (re-search-forward mail-header-separator (point-max) 'move))
  616.         (progn (goto-char (point-max))
  617.                (insert "\n" mail-header-separator "\n")
  618.                (goto-char (point-max)))
  619.       (forward-line 1)))
  620.   (set-mark (point)) ;user should see mark change
  621.   (insert "\n\n" (user-full-name))
  622.   (insert "\n\n---------\n")
  623.   (insert (emacs-version) "\n")
  624.   (insert "code: " mode-line-file ",v " mode-line-version)
  625.   (insert "\n\n")
  626.   (insert "current value of file-name-abbreviation-alist:\n\n")
  627.   (insert (prin1-to-string file-name-abbreviation-alist))
  628.   (exchange-point-and-mark)
  629.   (insert "\n" mode-line-maintainer ",\n\n  ")
  630.   (message "%s, please write the message, use C-c C-c to send" (user-login-name)))
  631.  
  632. ;;;; provide the package
  633.  
  634. (provide 'mode-line)
  635. ........................... cut along dotted line ...........................
  636. <end file: ~/lisp/mode-line.el>
  637.