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