NetNews Usenet Archive 1992 #30/NN_1992_30.iso/spool/gnu/emacs/sources/896

Internet Message Format | 1992-12-21 | 21.4 KB

Path: sparky!uunet!spool.mu.edu!agate!agate.berkeley.edu!dodd
From: [e-mail] (Lawrence R. Dodd)
Newsgroups: gnu.emacs.sources
Subject: update for mode-line.el (v 2.50)
Date: 19 Dec 92 14:40:20
Organization: Dept of Chemical Engineering, Polytechnic Univ, NY, USA
Lines: 545
Distribution: gnu
Message-ID: <[e-mail]>
NNTP-Posting-Host: mycenae.cchem.berkeley.edu
Summary: v 2.50 of mode-line.el, more robust
Keywords: mode line, abbreviated file paths


Hello,

  Here is the latest release of mode-line.el (version 2.50). This version
  fixes a couple of bugs that make mode-line.el much more robust than any of
  the earlier versions.  Also added is a toggle feature to scroll through
  various mode line displays (bound to C-c C-t).

                     share and enjoy,
                            Larry
                            [e-mail]

P.S. Happy holidays.

<file: ~/lisp/mode-line.el>
........................... cut along dotted line ...........................
;; mode-line.el - code for including abbreviated file paths in mode line

(defconst mode-line-version (substring "$Revision: 2.50 $" 11 -2)
  "$Id: mode-line.el,v 2.50 1992/12/19 22:30:50 dodd Stable $")

;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;; LCD Archive Entry:
;; mode-line|Lawrence R. Dodd|[e-mail]|
;; code for including abbreviated file paths in mode line|
;; $Date: 1992/12/19 22:30:50 $|$Revision: 2.50 $|~/????/mode-line.el.Z|

;;; MAINTAINER OF mode-line.el:
;;;
;;; Lawrence R. Dodd
;;; [e-mail]
;;;
;;; Please send bug reports, comments, suggestions, and any smart remarks
;;; concerning this code to the above e-mail address. Please be sure to
;;; mention the value of the variable `mode-line-version' *or* simply type
;;; `M-x mode-line-submit-report' and let mode-line.el do it for you.

;;; CONTRIBUTORS TO mode-line.el:
;;;
;;; Lawrence R. Dodd
;;; [e-mail]
;;;
;;; Robert McLay
;;; [e-mail]
;;; (for much beta-testing)
;;;
;;; Crys Rides (a.k.a., James C. Ghering)
;;; [e-mail]
;;; (for suggesting and testing of view-mode support)

;;; VERSION:
;;;
;;; $LastEditDate: "Sat Dec 19 17:30:30 1992"$
;;; $Id: mode-line.el,v 2.50 1992/12/19 22:30:50 dodd Stable $
;;; $Revision: 2.50 $

;;; HISTORY:
;;;
;;; Derived from prettymodeln.el.  That file was checked in as version 2.1 of
;;; mode-line.el.  This is a cleaned, debugged, and more robust version of
;;; that original code containing with more features and more documentation. I
;;; would have named this prettymodeln++.el but that is too many letters and I
;;; besides I hack Fortran.
;;;
;;; AUTHOR OF prettymodeln.el:
;;;
;;; Andy Gaynor (a.k.a., Silver)
;;; [e-mail] ...!rutgers!paul.rutgers.edu!gaynor
;;;
;;;                               _   /|  Splthlt...
;;;                    Ahckthph!  \`o_@'
;;;                                 (_)
;;;                                  U   Ptooey!
;;;
;;; Created: 13 Sep 87 18:34:59 GMT

;;; INSTALLATION/USAGE:
;;;
;;;   o  save as mode-line.el in the GNU emacs load-path
;;;   o  stick this in your ~/.emacs:
;;;
;;;                (require 'mode-line)
;;;
;;;   o  use C-c C-t to scroll through different mode lines manually
;;;      (with argument it will scroll through automatically)

;;; ADVANCED USAGE:
;;;
;;;   o  same as above but also stick something _like_ the following inside
;;;      your ~/.emacs:
;;;
;;;   (setq file-name-abbreviation-alist
;;;         (list
;;;          (cons  (concat "^" (expand-file-name "~")
;;;                         "/" "special/")  "special:")
;;;          (cons  (concat "^" (expand-file-name "~") "/")  "~/")
;;;          '("^/[e-mail]:/home/dodd/" . "Roebling:")
;;;          '("^/joe@\\([a-zA-Z0-9.]*\\).\\(edu\\|gov\\):/home/joe/" . "\\1:")
;;;          '("^.*/\\([^/]*/\\)" . "\\1")))
;;;
;;; The explanation of above is as follows. If I am editing a file called
;;; `filename' this list of associations will be attempted in this order: if
;;; the full path to `filename' is
;;;
;;; (1) `/myhomedirectory/special/filename' display as `special:filename'
;;;      (this is useful for much used sub-sub-directories)
;;; (2) `/myhomedirectory/filename' display as `~/filename'
;;;      (this eliminates those long paths to your home directory)
;;; (3) `/[e-mail]:/anything/filename' display as `Machine:filename'
;;;     (this is _extremely_ useful with ange-ftp)
;;; (4) `/[e-mail]:/anything/filename' display as `regexp:filename'
;;;     (this is the same as above but attempts to use a regular expression)
;;; (5) `/snafu/barfoo/filename' display as `barfoo:filename'
;;;     (this shows just the current directory and is done for any path that
;;;     does not match one of the above)

;;; SEE ALSO:
;;;
;;; For more information on the filename associations list, after
;;; loading, do `M-x describe-variable file-name-abbreviation-alist'

;;; MOTIVATION:
;;;
;;; Buffer names in the mode line are not very informative. When files with
;;; the same name are being visited in different directories the mode line
;;; shows names like "Makefile," "Makefile<2>," "Makefile<3>," and so on.  The
;;; zeroth order correction is to use the file name and directory in the mode
;;; line.  However, long file names with full directory paths (for example
;;; /u2/luser/foobar/bletch/src/0.1/foobar/Makefile) in the mode line are a
;;; pain in the ass.  They suck up the whole mode line, and are a strain on
;;; the eyes to differentiate. We would like to display things like
;;; "foobar/Makefile," "barfoo/Makefile," "conserve/Makefile," and so on in
;;; the mode line.
;;;
;;; You will find here a mode line formatting scheme that is fairly nice.  It
;;; displays the buffer name if the buffer is not associated with a file.
;;; Otherwise, it displays the file name, but only after abbreviating it as
;;; per a list of abbreviations that you provide.

;;; LOGIC:
;;;
;;; Set up the mode line by making mode-line-buffer-identification local to
;;; every buffer.  Various hooks will abbreviate the buffer-file-name to
;;; something a little easier to read.
;;;
;;;   `buffer-file-name' == the original file name
;;;   `file-name-abbreviation-alist' == list of abbreviations
;;;   `abbreviate-mode-line-buffer-identification' == what hooks call
;;;   `string-replace-regexp-in-alist' == means of abbreviation

;;; KNOWN BUG WITH SUGGESTED PATCH:
;;;
;;;   Sebastian Kremer's Tree Dired (v 6.0, available via anonymous ftp from
;;;   ftp.uni-koeln.de[134.95.80.1]:/pub/gnu/emacs/diredall.tar.Z) is an
;;;   improvement over the distribution dired for reasons too numerous to
;;;   mention. One major improvement is that Kremer's Dired correctly renames
;;;   any buffers visiting a file that is renamed using dired-mode.
;;;
;;;   Unfortunately, it uses `set-visited-file-name' in the function
;;;   `dired-rename-file', which does not use `write-hooks'. The result being
;;;   that while the buffer is renamed, the mode line is not updated properly
;;;   after a dired-do-move (key r).  The patch is to force a call to
;;;   `abbreviate-mode-line-buffer-identification' after the call to
;;;   `set-visited-file-name' in the function `dired-rename-file':
;;;
;;;      (defun dired-rename-file (from to ok-flag)
;;;                                ...
;;;                        [material not shown]
;;;                                ...
;;;              (let ((modflag (buffer-modified-p)))
;;;                (set-visited-file-name to)   ; kills write-file-hooks
;;;     +          ;; for mode-line.el
;;;     +          (and (memq 'abbreviate-mode-line-buffer-identification
;;;     +                     write-file-hooks)
;;;     +                 (abbreviate-mode-line-buffer-identification))
;;;                (set-buffer-modified-p modflag))))
;;;                                ...
;;;                        [material not shown]
;;;                                ...

;;; We need to load the default `view' package (be it view.el or new-view.el)
;;; so that `view-hook' will be defined when we append to it below.

(require 'view)

;;; We need to use kill-fix.el, by Joe Wells ([e-mail]), in order to
;;; preserve some mode-line's variables when the major mode of a buffer is
;;; changed. The next section contains a copy of kill-fix.el.  The copyright
;;; notice at the top of this file should be considered as a replacement for
;;; the one found in kill-fix.el.

;;; Note that instead of this page, the statement "(require 'kill-fix)" could
;;; be used if the the user already has a copy of kill-fix.el. That code is
;;; available via anonymous ftp to archive.cis.ohio-state.edu [128.146.8.52]
;;; in /pub/gnu/emacs/elisp-archive/as-is/kill-fix.el.Z.

;; -----------
;; kill-fix.el - enhancement to kill-all-local-variables
;; Author: Joe Wells ([e-mail])
;; Date: 18 Jan 89 22:16:15 GMT

;; save the original subr function definition of kill-all-local-variables
(or (fboundp 'original-kill-all-local-variables)
    (fset 'original-kill-all-local-variables
          (symbol-function 'kill-all-local-variables)))

(defun kill-all-local-variables ()
  "Eliminate all the buffer-local variable values of the current
buffer.  This buffer will then see the default values of all
variables.  NOTE: This function has been modified to ignore
buffer-local variables whose preserved property is non-nil."
  (let ((oldvars (buffer-local-variables)))
    (original-kill-all-local-variables)
    (while oldvars
      (let ((var (car (car oldvars))))
        (cond ((get var 'preserved)
               (make-local-variable var)
               (set var (cdr (car oldvars))))))
      (setq oldvars (cdr oldvars)))))

(provide 'kill-fix)
;; -----------

;;; GENERAL DISPLAY STUFF:

;;; This makes the mode line display the day, date, time of day, and average
;;; number of processes. The increment for time update is 30 seconds, also
;;; `Mail' appears if there is any unread mail.  Users may wish to comment
;;; this stuff out.

(setq display-time-interval 30)
(setq display-time-day-and-date t)
(display-time)

;;; Customize mode-line-format and its constituents.

;;; Make sure you use mode-line-buffer-identification to identify the buffer
;;; in your mode-line-format.  This variable must be buffer-local (if it is
;;; not already).

;;; Note that mode-line-buffer-identification must be used to identify the
;;; buffer.  mode-line-modified is retained because it is in emacs' own
;;; default mode-line-format, and emacs might do some clever tricks with it.

(make-variable-buffer-local 'mode-line-modified)
(setq-default mode-line-modified '("%*%*-"))

(make-variable-buffer-local 'mode-line-buffer-identification)
(setq-default mode-line-buffer-identification '("%b"))

;; create a new buffer-local variable to keep track of the current state of
;; the mode line for use by mode-line-toggle-display.

(make-variable-buffer-local 'mode-line-state)

(defvar mode-line-state "buffer-name"
  "A buffer-local variable to keep track of the current state of the mode line
for use by mode-line-toggle-display.")

(setq-default mode-line-state "buffer-name")

;; KLUDGE

;; If the user changes the major mode of a buffer the variables
;; `mode-line-buffer-identification' and `mode-line-state' are set to their
;; default values. We use Joe Wells' kill-fix.el to preserve these variables
;; when the major mode of a buffer is changed.

(put 'mode-line-buffer-identification 'preserved t)
(put 'mode-line-state 'preserved t)

;;; now the define the organization of the mode-line-format

(setq-default mode-line-format
  '("--"
    mode-line-modified
    " "
    mode-line-buffer-identification
    " %[("
    (-10 . mode-name) ; truncate mode name to 10 chars, it got too long - LRD
    minor-mode-alist
    "%n"
    mode-line-process
    " "
    (-3 . "%p") ; make string at most 3 chars: `Top', `Bot', or `nn%' - LRD
    ")%] "
    global-mode-string
    " %-"))

;;; A big thankyou to Robert McLay ([e-mail]) for help with
;;; the following - LRD.

;;; Form home directory with a leading `^' and trailing `/' so if your home
;;; directory is /home/machine/user-name then home-dir is
;;; `^/home/machine/user-name/' (without the quotes) The leading `^' is need
;;; to match the leading end of the string.

;;; (originally was not a user option because it was missing the `*' - LRD)

(defvar file-name-abbreviation-alist
      (list
       (cons  (concat "^" (expand-file-name "~") "/")  "~/"))

  "*Alist of embedded filename patterns versus the corresponding desired
abbreviations. Each element is of the form (<regexp> . <to-string>).

The package mode-line.el goes down this alist looking for matches to regular
expression <regexp> in the full pathname of the file and replaces it with
<to-string>.  This is then repeated for all <regexp> in the list. This fact
can be exploited in forming the regular expressions. However, since the
searching and replacing is done top-down, special cases should be put at the
head of the list.

Examples:

  If the user often plays with the files in /u2/luser/foobar/bletch.
  What the user may want to do is replace leading instances of this
  path with just `bletch.'  To do this stick the association into
  the alist

     (\"^/u2/luser/foobar/bletch\" . \"bletch\")

  Another good association is to display only the last directory in
  the path if no other special case applies. This is done with the
  following association

     (\"^.*/\\([^/]*/\\)\" . \"\\1\")

  Finally, one can also abbreviate those long filenames that result
  when using ange-ftp

     (\"^/[e-mail]:/home/emily/\" . \"Roebling:\")

  The default entry for this variable removes the home directory
  path and replaces it with ~/

     (cons  (concat \"^\" (expand-file-name \"~\") \"/\")  \"~/\")")

;;;; DEFUNS

;;; the function that makes the substitutions - this is the work-horse

(defun string-replace-regexp-in-alist (string replacement-alist)

   "Given a string STRING, replace *each* instance of <regexp> (cars of elements
in REPLACEMENT-ALIST) with <to-string> (cdrs of elements in REPLACEMENT-ALIST)
and return the new string. The above is different from simply replacing the
first match in the alist and then leaving. This is why a temporary buffer is
used."

   (save-excursion

     (let

         ;; VARLIST - we need to generate a unique name for temporary buffer
         ;; (originally just used `!@#$%^&*' which, believe or not, might not be
         ;; unique - LRD)

         ((temp-buffer (get-buffer-create (make-temp-name "!@#$%^&*")))
          (temp-alist replacement-alist) ; don't mess with incoming alist
          (new-string)) ; this is the value to be returned

       ;; create temporary buffer
       (set-buffer temp-buffer)

       ;; insert incoming string (name of filename with full path name)
       (insert string)

       ;; we want to make sure the temporary buffer is killed
       (unwind-protect

           ;; BODY
           (progn

             ;; walk down `temp-alist', removing as we go, until it is empty
             (while temp-alist

               ;; go to beginning of temporary buffer
               (goto-char (point-min))

               ;; search the temporary buffer for every occurrence of the
               ;; regular expression stored in `(car (car temp-alist))' and
               ;; replace it with the one stored in `(cdr (car temp-alist))'
               ;; (code originally used replace-regexp - LRD)

               (while (re-search-forward (car (car temp-alist)) nil t)
                 (replace-match (cdr (car temp-alist))))

               ;; decrement temp-alist and restart while-loop
               (setq temp-alist (cdr temp-alist)))

             ;; set return string to what remains in the temporary buffer
             (setq new-string (buffer-string)))

         ;; CLEAN UP - no matter what happens, remove the temporary buffer
         (kill-buffer temp-buffer))

     ;; return value of converted string
     new-string)))

;;; function that creates the abbreviated identification and is called by the
;;; various hooks (originally returned non-nil values - LRD)

(defun abbreviate-mode-line-buffer-identification ()

  "Abbreviates mode-line-buffer-identification locally using the function
string-replace-regexp-in-alist and the alist file-name-abbreviation-alist.
This function will return nil always. This is needed for view-mode since it
will call this function even if it is not visiting a file and its return value
needs to be predictable (as opposed to garbage). A nil return is also needed
for the write-file-hooks."

  (if buffer-file-name
      (progn
        (setq mode-line-buffer-identification
              (list
               (string-replace-regexp-in-alist buffer-file-name
                                               file-name-abbreviation-alist)))
        (setq mode-line-state "abbrev-file-name"))
    (setq mode-line-state "buffer-name"))
  ;; always return nil
  nil)

;;;; HOOKS

;;; Add abbreviate-mode-line-buffer-identification to find-file-hooks,
;;; write-file-hooks, and view-hook but only if it has not been added already
;;; (originally overwrote find-file-hooks - LRD).

(or (memq 'abbreviate-mode-line-buffer-identification find-file-hooks)
    (setq find-file-hooks
          (append find-file-hooks
                  '(abbreviate-mode-line-buffer-identification))))

(or (memq 'abbreviate-mode-line-buffer-identification view-hook)
    (setq view-hook
          (append view-hook
                  '(abbreviate-mode-line-buffer-identification))))

(or (memq 'abbreviate-mode-line-buffer-identification write-file-hooks)
    (setq write-file-hooks
          (append write-file-hooks
                  '(abbreviate-mode-line-buffer-identification))))

;;;; TOGGLE

(define-key global-map "\C-c\C-t" 'mode-line-toggle-display)

(defun mode-line-toggle-display (arg)

  "Cycles the buffer descriptor currently being displayed in modeline. If
filename is currently displayed as abbreviated, then display with full path.
If full path is currently displayed, then display just the buffer name. If the
buffer name is currently displayed, then display the abbreviated filename.
With argument will scroll through displays automatically."

  (interactive "P")

  (if buffer-file-name

      (if arg

          ;; scroll display
          (progn
            (mode-line-toggle-display nil)
            (sit-for 1)
            (mode-line-toggle-display nil)
            (sit-for 1)
            (mode-line-toggle-display nil))

        ;; change display
        (progn
          (if (string= mode-line-state "abbrev-file-name")
              (progn (setq mode-line-buffer-identification (buffer-file-name))
                     (setq mode-line-state "full-file-name"))
            (if (string= mode-line-state "full-file-name")
                (progn (setq mode-line-buffer-identification '("Emacs: %b"))
                       (setq mode-line-state "buffer-name"))
              (progn (abbreviate-mode-line-buffer-identification)
                     (setq mode-line-state "abbrev-file-name"))))

        ;; force redisplay of mode line
        (set-buffer-modified-p (buffer-modified-p))))))

;;;; BUG REPORTS

;;; this section is provided for reports.
;;; adopted from Barry A. Warsaw's c++-mode.el

(defvar mode-line-mailer 'mail
  "*Mail package to use to generate report mail buffer.")

(defconst mode-line-help-address "[e-mail]"
  "Address accepting submission of reports on mode-line.el.")

(defconst mode-line-maintainer "Larry"
  "First name of person accepting submission of reports on mode-line.el.")

(defconst mode-line-file "mode-line.el"
  "Name of file containing emacs lisp code.")

(defun mode-line-submit-report ()
  "Submit via mail a report using the mailer in mode-line-mailer, filename in
mode-line-file, to address in mode-line-help-address."
  (interactive)
  (funcall mode-line-mailer)
  (insert mode-line-help-address)
  (if (re-search-forward "^subject:[ \t]+" (point-max) 'move)
      (insert "Report on " mode-line-file " " mode-line-version))
  (if (not (re-search-forward mail-header-separator (point-max) 'move))
      (progn (goto-char (point-max))
             (insert "\n" mail-header-separator "\n")
             (goto-char (point-max)))
    (forward-line 1))
  (set-mark (point)) ;user should see mark change
  (insert "\n\n---------\n")
  (insert (emacs-version) "\n")
  (insert "code: " mode-line-file ",v " mode-line-version)
  (insert "\n\n")
  (insert "current value of file-name-abbreviation-alist:\n\n")
  (insert (prin1-to-string file-name-abbreviation-alist))
  (exchange-point-and-mark)
  (insert "\n" mode-line-maintainer ",\n\n")
  (message "please write the message"))

;;;; provide the package

(provide 'mode-line)
........................... cut along dotted line ...........................
<end file: ~/lisp/mode-line.el>