mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-21 18:23:59 +00:00
Delete libraries obsolete since 23.1 and 23.2
Emacs 23.2 was released 10 years ago. old-whitespace.el has a replacement in whitespace.el and is no longer relevant. The other libraries implement compatibility with Lucid Emacs, a modified version of Emacs last released in the 1990s. * lisp/obsolete/ledit.el: * lisp/obsolete/lmenu.el: * lisp/obsolete/lucid.el: * lisp/obsolete/old-whitespace.el: Delete files. These libraries have been obsolete since Emacs 23.1 or 23.2. * etc/NEWS: Announce their deletion. * admin/authors.el (authors-ignored-files) (authors-fixed-entries, authors-valid-file-names): * lisp/emulation/viper.el (viper-mode): * lisp/ffap.el (ffap-menu-ask): Remove references to deleted files.
This commit is contained in:
Stefan Kangas
parent
5d97d2683a
commit
b76cdd0c1a
@ -365,7 +365,7 @@ Changes to files matching one of the regexps in this list are not listed.")
|
||||
"lib/stdarg.in.h" "lib/stdbool.in.h"
|
||||
"unidata/bidimirror.awk" "unidata/biditype.awk"
|
||||
"split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
|
||||
"gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
|
||||
"gnu-hp300" "refcard.bit" "forms.README" "forms-d2.dat"
|
||||
"CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
|
||||
"CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit"
|
||||
"copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6"
|
||||
@ -609,7 +609,7 @@ Changes to files in this list are not listed.")
|
||||
;; No longer distributed: lselect.el.
|
||||
("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el"
|
||||
"bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el"
|
||||
"lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
|
||||
"mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
|
||||
;; MCC. No longer distributed: emacsserver.c.
|
||||
("Microelectronics and Computer Technology Corporation"
|
||||
:changed "etags.c" "emacsclient.c" "movemail.c"
|
||||
@ -773,7 +773,7 @@ Changes to files in this list are not listed.")
|
||||
"erc-hecomplete.el"
|
||||
"eshell/esh-maint.el"
|
||||
"language/persian.el"
|
||||
"ledit.el" "meese.el" "iswitchb.el" "longlines.el"
|
||||
"meese.el" "iswitchb.el" "longlines.el"
|
||||
"mh-exec.el" "mh-init.el" "mh-customize.el"
|
||||
"net/zone-mode.el" "xesam.el"
|
||||
"term/mac-win.el" "sup-mouse.el"
|
||||
|
||||
4
etc/NEWS
4
etc/NEWS
@ -397,6 +397,10 @@ This is no longer supported, and setting this variable has no effect.
|
||||
** The macro 'with-displayed-buffer-window' is now obsolete.
|
||||
Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
|
||||
|
||||
---
|
||||
** Some libraries obsolete since Emacs 23 have been removed:
|
||||
'ledit.el', 'lmenu.el', 'lucid.el and 'old-whitespace.el'.
|
||||
|
||||
|
||||
* Lisp Changes in Emacs 28.1
|
||||
|
||||
|
||||
@ -1221,7 +1221,6 @@ These two lines must come in the order given."))
|
||||
(viper-harness-minor-mode "outline")
|
||||
(viper-harness-minor-mode "allout")
|
||||
(viper-harness-minor-mode "xref")
|
||||
(viper-harness-minor-mode "lmenu")
|
||||
(viper-harness-minor-mode "vc")
|
||||
(viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which
|
||||
(viper-harness-minor-mode "latex") ; sits in one of these two files
|
||||
|
||||
@ -1607,7 +1607,7 @@ Each ALIST entry looks like (STRING . DATA) and defines one choice.
|
||||
Function CONT is applied to the entry chosen by the user."
|
||||
;; Note: this function is used with a different continuation
|
||||
;; by the ffap-url add-on package.
|
||||
;; Could try rewriting to use easymenu.el or lmenu.el.
|
||||
;; Could try rewriting to use easymenu.el.
|
||||
(let (choice)
|
||||
(cond
|
||||
;; Emacs mouse:
|
||||
|
||||
@ -1,157 +0,0 @@
|
||||
;;; ledit.el --- Emacs side of ledit interface
|
||||
|
||||
;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: languages
|
||||
;; Obsolete-since: 24.3
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is a major mode for editing Liszt.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; To do:
|
||||
;;; o lisp -> emacs side of things (grind-definition and find-definition)
|
||||
|
||||
(defvar ledit-mode-map nil)
|
||||
|
||||
(defconst ledit-zap-file
|
||||
(expand-file-name (concat (user-login-name) ".l1") temporary-file-directory)
|
||||
"File name for data sent to Lisp by Ledit.")
|
||||
(defconst ledit-read-file
|
||||
(expand-file-name (concat (user-login-name) ".l2") temporary-file-directory)
|
||||
"File name for data sent to Ledit by Lisp.")
|
||||
(defconst ledit-compile-file
|
||||
(expand-file-name (concat (user-login-name) ".l4") temporary-file-directory)
|
||||
"File name for data sent to Lisp compiler by Ledit.")
|
||||
(defconst ledit-buffer "*LEDIT*"
|
||||
"Name of buffer in which Ledit accumulates data to send to Lisp.")
|
||||
|
||||
;;;###autoload
|
||||
(defconst ledit-save-files t "\
|
||||
*Non-nil means Ledit should save files before transferring to Lisp.")
|
||||
;;;###autoload
|
||||
(defconst ledit-go-to-lisp-string "%?lisp" "\
|
||||
*Shell commands to execute to resume Lisp job.")
|
||||
;;;###autoload
|
||||
(defconst ledit-go-to-liszt-string "%?liszt" "\
|
||||
*Shell commands to execute to resume Lisp compiler job.")
|
||||
|
||||
(defun ledit-save-defun ()
|
||||
"Save the current defun in the ledit buffer."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(end-of-defun)
|
||||
(let ((end (point)))
|
||||
(beginning-of-defun)
|
||||
(append-to-buffer ledit-buffer (point) end))
|
||||
(message "Current defun saved for Lisp")))
|
||||
|
||||
(defun ledit-save-region (beg end)
|
||||
"Save the current region in the ledit buffer"
|
||||
(interactive "r")
|
||||
(append-to-buffer ledit-buffer beg end)
|
||||
(message "Region saved for Lisp"))
|
||||
|
||||
(defun ledit-zap-defun-to-lisp ()
|
||||
"Carry the current defun to Lisp."
|
||||
(interactive)
|
||||
(ledit-save-defun)
|
||||
(ledit-go-to-lisp))
|
||||
|
||||
(defun ledit-zap-defun-to-liszt ()
|
||||
"Carry the current defun to liszt."
|
||||
(interactive)
|
||||
(ledit-save-defun)
|
||||
(ledit-go-to-liszt))
|
||||
|
||||
(defun ledit-zap-region-to-lisp (beg end)
|
||||
"Carry the current region to Lisp."
|
||||
(interactive "r")
|
||||
(ledit-save-region beg end)
|
||||
(ledit-go-to-lisp))
|
||||
|
||||
(defun ledit-go-to-lisp ()
|
||||
"Suspend Emacs and restart a waiting Lisp job."
|
||||
(interactive)
|
||||
(if ledit-save-files
|
||||
(save-some-buffers))
|
||||
(if (get-buffer ledit-buffer)
|
||||
(with-current-buffer ledit-buffer
|
||||
(goto-char (point-min))
|
||||
(write-region (point-min) (point-max) ledit-zap-file)
|
||||
(erase-buffer)))
|
||||
(suspend-emacs ledit-go-to-lisp-string)
|
||||
(load ledit-read-file t t))
|
||||
|
||||
(defun ledit-go-to-liszt ()
|
||||
"Suspend Emacs and restart a waiting Liszt job."
|
||||
(interactive)
|
||||
(if ledit-save-files
|
||||
(save-some-buffers))
|
||||
(if (get-buffer ledit-buffer)
|
||||
(with-current-buffer ledit-buffer
|
||||
(goto-char (point-min))
|
||||
(insert "(declare (macros t))\n")
|
||||
(write-region (point-min) (point-max) ledit-compile-file)
|
||||
(erase-buffer)))
|
||||
(suspend-emacs ledit-go-to-liszt-string)
|
||||
(load ledit-read-file t t))
|
||||
|
||||
(defun ledit-setup ()
|
||||
"Set up key bindings for the Lisp/Emacs interface."
|
||||
(unless ledit-mode-map
|
||||
(setq ledit-mode-map (make-sparse-keymap))
|
||||
(set-keymap-parent ledit-mode-map lisp-mode-shared-map))
|
||||
(define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
|
||||
(define-key ledit-mode-map "\e\^r" 'ledit-save-region)
|
||||
(define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
|
||||
(define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
|
||||
|
||||
(ledit-setup)
|
||||
|
||||
;;;###autoload
|
||||
(defun ledit-mode ()
|
||||
"\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
|
||||
Like Lisp mode, plus these special commands:
|
||||
\\[ledit-save-defun] -- record defun at or after point
|
||||
for later transmission to Lisp job.
|
||||
\\[ledit-save-region] -- record region for later transmission to Lisp job.
|
||||
\\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
|
||||
\\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
|
||||
and transmit saved text.
|
||||
|
||||
\\{ledit-mode-map}
|
||||
To make Lisp mode automatically change to Ledit mode,
|
||||
do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
|
||||
(interactive)
|
||||
(delay-mode-hooks (lisp-mode))
|
||||
(ledit-from-lisp-mode))
|
||||
|
||||
;;;###autoload
|
||||
(defun ledit-from-lisp-mode ()
|
||||
(use-local-map ledit-mode-map)
|
||||
(setq mode-name "Ledit")
|
||||
(setq major-mode 'ledit-mode)
|
||||
(run-mode-hooks 'ledit-mode-hook))
|
||||
|
||||
(provide 'ledit)
|
||||
|
||||
;;; ledit.el ends here
|
||||
@ -1,445 +0,0 @@
|
||||
;;; lmenu.el --- emulate Lucid's menubar support
|
||||
|
||||
;; Copyright (C) 1992-1994, 1997, 2001-2020 Free Software Foundation,
|
||||
;; Inc.
|
||||
|
||||
;; Keywords: emulations obsolete
|
||||
;; Obsolete-since: 23.3
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file has been obsolete since Emacs 23.3.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
;; First, emulate the Lucid menubar support in GNU Emacs 19.
|
||||
|
||||
;; Arrange to use current-menubar to set up part of the menu bar.
|
||||
|
||||
(defvar current-menubar)
|
||||
(defvar lucid-menubar-map)
|
||||
(defvar lucid-failing-menubar)
|
||||
|
||||
(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
|
||||
(defun recompute-lucid-menubar ()
|
||||
(define-key lucid-menubar-map [menu-bar]
|
||||
(condition-case nil
|
||||
(make-lucid-menu-keymap "menu-bar" current-menubar)
|
||||
(error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
|
||||
(sit-for 1)
|
||||
(setq lucid-failing-menubar current-menubar
|
||||
current-menubar nil))))
|
||||
(setq lucid-menu-bar-dirty-flag nil))
|
||||
|
||||
(defvar lucid-menubar-map (make-sparse-keymap))
|
||||
(or (assq 'current-menubar minor-mode-map-alist)
|
||||
(setq minor-mode-map-alist
|
||||
(cons (cons 'current-menubar lucid-menubar-map)
|
||||
minor-mode-map-alist)))
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun set-menubar-dirty-flag ()
|
||||
(force-mode-line-update)
|
||||
(setq lucid-menu-bar-dirty-flag t))
|
||||
|
||||
(defvar add-menu-item-count 0)
|
||||
|
||||
;; This is a variable whose value is always nil.
|
||||
(defvar make-lucid-menu-keymap-disable nil)
|
||||
|
||||
;; Return a menu keymap corresponding to a Lucid-style menu list
|
||||
;; MENU-ITEMS, and with name MENU-NAME.
|
||||
(defun make-lucid-menu-keymap (menu-name menu-items)
|
||||
(let ((menu (make-sparse-keymap menu-name)))
|
||||
;; Process items in reverse order,
|
||||
;; since the define-key loop reverses them again.
|
||||
(setq menu-items (reverse menu-items))
|
||||
(while menu-items
|
||||
(let ((item (car menu-items))
|
||||
command name callback)
|
||||
(cond ((stringp item)
|
||||
(setq command nil)
|
||||
(setq name (if (string-match "^-+$" item) "" item)))
|
||||
((consp item)
|
||||
(setq command (make-lucid-menu-keymap (car item) (cdr item)))
|
||||
(setq name (car item)))
|
||||
((vectorp item)
|
||||
(setq command (make-symbol (format "menu-function-%d"
|
||||
add-menu-item-count))
|
||||
add-menu-item-count (1+ add-menu-item-count)
|
||||
name (aref item 0)
|
||||
callback (aref item 1))
|
||||
(if (symbolp callback)
|
||||
(fset command callback)
|
||||
(fset command (list 'lambda () '(interactive) callback)))
|
||||
(put command 'menu-alias t)
|
||||
(let ((i 2))
|
||||
(while (< i (length item))
|
||||
(cond
|
||||
((eq (aref item i) ':active)
|
||||
(put command 'menu-enable
|
||||
(or (aref item (1+ i))
|
||||
'make-lucid-menu-keymap-disable))
|
||||
(setq i (+ 2 i)))
|
||||
((eq (aref item i) ':suffix)
|
||||
;; unimplemented
|
||||
(setq i (+ 2 i)))
|
||||
((eq (aref item i) ':keys)
|
||||
;; unimplemented
|
||||
(setq i (+ 2 i)))
|
||||
((eq (aref item i) ':style)
|
||||
;; unimplemented
|
||||
(setq i (+ 2 i)))
|
||||
((eq (aref item i) ':selected)
|
||||
;; unimplemented
|
||||
(setq i (+ 2 i)))
|
||||
((and (symbolp (aref item i))
|
||||
(= ?: (string-to-char (symbol-name (aref item i)))))
|
||||
(error "Unrecognized menu item keyword: %S"
|
||||
(aref item i)))
|
||||
((= i 2)
|
||||
;; old-style format: active-p &optional suffix
|
||||
(put command 'menu-enable
|
||||
(or (aref item i) 'make-lucid-menu-keymap-disable))
|
||||
;; suffix is unimplemented
|
||||
(setq i (length item)))
|
||||
(t
|
||||
(error "Unexpected menu item value: %S"
|
||||
(aref item i))))))))
|
||||
(if (null command)
|
||||
;; Handle inactive strings specially--allow any number
|
||||
;; of identical ones.
|
||||
(setcdr menu (cons (list nil name) (cdr menu)))
|
||||
(if name
|
||||
(define-key menu (vector (intern name)) (cons name command)))))
|
||||
(setq menu-items (cdr menu-items)))
|
||||
menu))
|
||||
|
||||
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
|
||||
|
||||
;; XEmacs compatibility function
|
||||
(defun popup-dialog-box (data)
|
||||
"Pop up a dialog box.
|
||||
A dialog box description is a list.
|
||||
|
||||
- The first element of the list is a string to display in the dialog box.
|
||||
- The rest of the elements are descriptions of the dialog box's buttons.
|
||||
Each one is a vector of three elements:
|
||||
- The first element is the text of the button.
|
||||
- The second element is the `callback'.
|
||||
- The third element is t or nil, whether this button is selectable.
|
||||
|
||||
If the `callback' of a button is a symbol, then it must name a command.
|
||||
It will be invoked with `call-interactively'. If it is a list, then it is
|
||||
evaluated with `eval'.
|
||||
|
||||
One (and only one) of the buttons may be nil. This marker means that all
|
||||
following buttons should be flushright instead of flushleft.
|
||||
|
||||
The syntax, more precisely:
|
||||
|
||||
form := <something to pass to `eval'>
|
||||
command := <a symbol or string, to pass to `call-interactively'>
|
||||
callback := command | form
|
||||
active-p := <t, nil, or a form to evaluate to decide whether this
|
||||
button should be selectable>
|
||||
name := <string>
|
||||
partition := `nil'
|
||||
button := `[' name callback active-p `]'
|
||||
dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'"
|
||||
(let ((name (car data))
|
||||
(tail (cdr data))
|
||||
converted
|
||||
choice meaning)
|
||||
(while tail
|
||||
(if (null (car tail))
|
||||
(setq converted (cons nil converted))
|
||||
(let ((item (aref (car tail) 0))
|
||||
(callback (aref (car tail) 1))
|
||||
(enable (aref (car tail) 2)))
|
||||
(setq converted
|
||||
(cons (if enable (cons item callback) item)
|
||||
converted))))
|
||||
(setq tail (cdr tail)))
|
||||
(setq choice (x-popup-dialog t (cons name (nreverse converted))))
|
||||
(if choice
|
||||
(if (symbolp choice)
|
||||
(call-interactively choice)
|
||||
(eval choice)))))
|
||||
|
||||
;; This is empty because the usual elements of the menu bar
|
||||
;; are provided by menu-bar.el instead.
|
||||
;; It would not make sense to duplicate them here.
|
||||
(defconst default-menubar nil)
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun set-menubar (menubar)
|
||||
"Set the default menubar to be menubar."
|
||||
(setq-default current-menubar (copy-sequence menubar))
|
||||
(set-menubar-dirty-flag))
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun set-buffer-menubar (menubar)
|
||||
"Set the buffer-local menubar to be menubar."
|
||||
(make-local-variable 'current-menubar)
|
||||
(setq current-menubar (copy-sequence menubar))
|
||||
(set-menubar-dirty-flag))
|
||||
|
||||
|
||||
;;; menu manipulation functions
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun find-menu-item (menubar item-path-list &optional parent)
|
||||
"Searches MENUBAR for item given by ITEM-PATH-LIST.
|
||||
Returns (ITEM . PARENT), where PARENT is the immediate parent of
|
||||
the item found.
|
||||
Signals an error if the item is not found."
|
||||
(or parent (setq item-path-list (mapcar 'downcase item-path-list)))
|
||||
(if (not (consp menubar))
|
||||
nil
|
||||
(let ((rest menubar)
|
||||
result)
|
||||
(while rest
|
||||
(if (and (car rest)
|
||||
(equal (car item-path-list)
|
||||
(downcase (if (vectorp (car rest))
|
||||
(aref (car rest) 0)
|
||||
(if (stringp (car rest))
|
||||
(car rest)
|
||||
(car (car rest)))))))
|
||||
(setq result (car rest) rest nil)
|
||||
(setq rest (cdr rest))))
|
||||
(if (cdr item-path-list)
|
||||
(if (consp result)
|
||||
(find-menu-item (cdr result) (cdr item-path-list) result)
|
||||
(if result
|
||||
(signal 'error (list "not a submenu" result))
|
||||
(signal 'error (list "no such submenu" (car item-path-list)))))
|
||||
(cons result parent)))))
|
||||
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun disable-menu-item (path)
|
||||
"Make the named menu item be unselectable.
|
||||
PATH is a list of strings which identify the position of the menu item in
|
||||
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
|
||||
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
|
||||
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
|
||||
(let* ((menubar current-menubar)
|
||||
(pair (find-menu-item menubar path))
|
||||
(item (car pair))
|
||||
(menu (cdr pair)))
|
||||
(or item
|
||||
(signal 'error (list (if menu "No such menu item" "No such menu")
|
||||
path)))
|
||||
(if (consp item) (error "can't disable menus, only menu items"))
|
||||
(aset item 2 nil)
|
||||
(set-menubar-dirty-flag)
|
||||
item))
|
||||
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun enable-menu-item (path)
|
||||
"Make the named menu item be selectable.
|
||||
PATH is a list of strings which identify the position of the menu item in
|
||||
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
|
||||
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
|
||||
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
|
||||
(let* ((menubar current-menubar)
|
||||
(pair (find-menu-item menubar path))
|
||||
(item (car pair))
|
||||
(menu (cdr pair)))
|
||||
(or item
|
||||
(signal 'error (list (if menu "No such menu item" "No such menu")
|
||||
path)))
|
||||
(if (consp item) (error "%S is a menu, not a menu item" path))
|
||||
(aset item 2 t)
|
||||
(set-menubar-dirty-flag)
|
||||
item))
|
||||
|
||||
|
||||
(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
|
||||
(if before (setq before (downcase before)))
|
||||
(let* ((menubar current-menubar)
|
||||
(menu (condition-case ()
|
||||
(car (find-menu-item menubar menu-path))
|
||||
(error nil)))
|
||||
(item (if (listp menu)
|
||||
(car (find-menu-item (cdr menu) (list item-name)))
|
||||
(signal 'error (list "not a submenu" menu-path)))))
|
||||
(or menu
|
||||
(let ((rest menu-path)
|
||||
(so-far menubar))
|
||||
(while rest
|
||||
;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
|
||||
(setq menu
|
||||
(if (eq so-far menubar)
|
||||
(car (find-menu-item so-far (list (car rest))))
|
||||
(car (find-menu-item (cdr so-far) (list (car rest))))))
|
||||
(or menu
|
||||
(let ((rest2 so-far))
|
||||
(or rest2
|
||||
(error "Trying to modify a menu that doesn't exist"))
|
||||
(while (and (cdr rest2) (car (cdr rest2)))
|
||||
(setq rest2 (cdr rest2)))
|
||||
(setcdr rest2
|
||||
(nconc (list (setq menu (list (car rest))))
|
||||
(cdr rest2)))))
|
||||
(setq so-far menu)
|
||||
(setq rest (cdr rest)))))
|
||||
(or menu (setq menu menubar))
|
||||
(if item
|
||||
nil ; it's already there
|
||||
(if item-p
|
||||
(setq item (vector item-name item-data enabled-p))
|
||||
(setq item (cons item-name item-data)))
|
||||
;; if BEFORE is specified, try to add it there.
|
||||
(if before
|
||||
(setq before (car (find-menu-item menu (list before)))))
|
||||
(let ((rest menu)
|
||||
(added-before nil))
|
||||
(while rest
|
||||
(if (eq before (car (cdr rest)))
|
||||
(progn
|
||||
(setcdr rest (cons item (cdr rest)))
|
||||
(setq rest nil added-before t))
|
||||
(setq rest (cdr rest))))
|
||||
(if (not added-before)
|
||||
;; adding before the first item on the menubar itself is harder
|
||||
(if (and (eq menu menubar) (eq before (car menu)))
|
||||
(setq menu (cons item menu)
|
||||
current-menubar menu)
|
||||
;; otherwise, add the item to the end.
|
||||
(nconc menu (list item))))))
|
||||
(if item-p
|
||||
(progn
|
||||
(aset item 1 item-data)
|
||||
(aset item 2 (not (null enabled-p))))
|
||||
(setcar item item-name)
|
||||
(setcdr item item-data))
|
||||
(set-menubar-dirty-flag)
|
||||
item))
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun add-menu-item (menu-path item-name function enabled-p &optional before)
|
||||
"Add a menu item to some menu, creating the menu first if necessary.
|
||||
If the named item exists already, it is changed.
|
||||
MENU-PATH identifies the menu under which the new menu item should be inserted.
|
||||
It is a list of strings; for example, (\"File\") names the top-level \"File\"
|
||||
menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
|
||||
ITEM-NAME is the string naming the menu item to be added.
|
||||
FUNCTION is the command to invoke when this menu item is selected.
|
||||
If it is a symbol, then it is invoked with `call-interactively', in the same
|
||||
way that functions bound to keys are invoked. If it is a list, then the
|
||||
list is simply evaluated.
|
||||
ENABLED-P controls whether the item is selectable or not.
|
||||
BEFORE, if provided, is the name of a menu item before which this item should
|
||||
be added, if this item is not on the menu already. If the item is already
|
||||
present, it will not be moved."
|
||||
(or menu-path (error "must specify a menu path"))
|
||||
(or item-name (error "must specify an item name"))
|
||||
(add-menu-item-1 t menu-path item-name function enabled-p before))
|
||||
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun delete-menu-item (path)
|
||||
"Remove the named menu item from the menu hierarchy.
|
||||
PATH is a list of strings which identify the position of the menu item in
|
||||
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
|
||||
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
|
||||
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
|
||||
(let* ((menubar current-menubar)
|
||||
(pair (find-menu-item menubar path))
|
||||
(item (car pair))
|
||||
(menu (or (cdr pair) menubar)))
|
||||
(if (not item)
|
||||
nil
|
||||
;; the menubar is the only special case, because other menus begin
|
||||
;; with their name.
|
||||
(if (eq menu current-menubar)
|
||||
(setq current-menubar (delq item menu))
|
||||
(delq item menu))
|
||||
(set-menubar-dirty-flag)
|
||||
item)))
|
||||
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun relabel-menu-item (path new-name)
|
||||
"Change the string of the specified menu item.
|
||||
PATH is a list of strings which identify the position of the menu item in
|
||||
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
|
||||
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
|
||||
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
|
||||
NEW-NAME is the string that the menu item will be printed as from now on."
|
||||
(or (stringp new-name)
|
||||
(setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
|
||||
(let* ((menubar current-menubar)
|
||||
(pair (find-menu-item menubar path))
|
||||
(item (car pair))
|
||||
(menu (cdr pair)))
|
||||
(or item
|
||||
(signal 'error (list (if menu "No such menu item" "No such menu")
|
||||
path)))
|
||||
(if (and (consp item)
|
||||
(stringp (car item)))
|
||||
(setcar item new-name)
|
||||
(aset item 0 new-name))
|
||||
(set-menubar-dirty-flag)
|
||||
item))
|
||||
|
||||
;; XEmacs compatibility
|
||||
(defun add-menu (menu-path menu-name menu-items &optional before)
|
||||
"Add a menu to the menubar or one of its submenus.
|
||||
If the named menu exists already, it is changed.
|
||||
MENU-PATH identifies the menu under which the new menu should be inserted.
|
||||
It is a list of strings; for example, (\"File\") names the top-level \"File\"
|
||||
menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
|
||||
If MENU-PATH is nil, then the menu will be added to the menubar itself.
|
||||
MENU-NAME is the string naming the menu to be added.
|
||||
MENU-ITEMS is a list of menu item descriptions.
|
||||
Each menu item should be a vector of three elements:
|
||||
- a string, the name of the menu item;
|
||||
- a symbol naming a command, or a form to evaluate;
|
||||
- and a form whose value determines whether this item is selectable.
|
||||
BEFORE, if provided, is the name of a menu before which this menu should
|
||||
be added, if this menu is not on its parent already. If the menu is already
|
||||
present, it will not be moved."
|
||||
(or menu-name (error "must specify a menu name"))
|
||||
(or menu-items (error "must specify some menu items"))
|
||||
(add-menu-item-1 nil menu-path menu-name menu-items t before))
|
||||
|
||||
|
||||
|
||||
(defvar put-buffer-names-in-file-menu t)
|
||||
|
||||
|
||||
;; Don't unconditionally enable menu bars; leave that up to the user.
|
||||
;;(let ((frames (frame-list)))
|
||||
;; (while frames
|
||||
;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
|
||||
;; (setq frames (cdr frames))))
|
||||
;;(or (assq 'menu-bar-lines default-frame-alist)
|
||||
;; (setq default-frame-alist
|
||||
;; (cons '(menu-bar-lines . 1) default-frame-alist)))
|
||||
|
||||
(set-menubar default-menubar)
|
||||
|
||||
(provide 'lmenu)
|
||||
|
||||
;;; lmenu.el ends here
|
||||
@ -1,211 +0,0 @@
|
||||
;;; lucid.el --- emulate some Lucid Emacs functions
|
||||
|
||||
;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: emulations
|
||||
;; Obsolete-since: 23.2
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; XEmacs autoloads CL so we might as well make use of it.
|
||||
(require 'cl)
|
||||
|
||||
(defalias 'current-time-seconds 'current-time)
|
||||
|
||||
(defun real-path-name (name &optional default)
|
||||
(file-truename (expand-file-name name default)))
|
||||
|
||||
;; It's not clear what to return if the mouse is not in FRAME.
|
||||
(defun read-mouse-position (frame)
|
||||
(let ((pos (mouse-position)))
|
||||
(if (eq (car pos) frame)
|
||||
(cdr pos))))
|
||||
|
||||
(defun switch-to-other-buffer (arg)
|
||||
"Switch to the previous buffer.
|
||||
With a numeric arg N, switch to the Nth most recent buffer.
|
||||
With an arg of 0, buries the current buffer at the
|
||||
bottom of the buffer stack."
|
||||
(interactive "p")
|
||||
(if (eq arg 0)
|
||||
(bury-buffer (current-buffer)))
|
||||
(switch-to-buffer
|
||||
(if (<= arg 1) (other-buffer (current-buffer))
|
||||
(nth arg
|
||||
(apply 'nconc
|
||||
(mapcar
|
||||
(lambda (buf)
|
||||
(if (= ?\ (string-to-char (buffer-name buf)))
|
||||
nil
|
||||
(list buf)))
|
||||
(buffer-list)))))))
|
||||
|
||||
(defun device-class (&optional device)
|
||||
"Return the class (color behavior) of DEVICE.
|
||||
This will be one of `color', `grayscale', or `mono'.
|
||||
This function exists for compatibility with XEmacs."
|
||||
(cond
|
||||
((display-color-p device) 'color)
|
||||
((display-grayscale-p device) 'grayscale)
|
||||
(t 'mono)))
|
||||
|
||||
(defalias 'find-face 'facep)
|
||||
(defalias 'get-face 'facep)
|
||||
;; internal-try-face-font was removed from faces.el in rev 1.139, 1999/07/21.
|
||||
;;;(defalias 'try-face-font 'internal-try-face-font)
|
||||
|
||||
(defalias 'exec-to-string 'shell-command-to-string)
|
||||
|
||||
|
||||
;; Buffer context
|
||||
|
||||
(defun buffer-syntactic-context (&optional buffer)
|
||||
"Syntactic context at point in BUFFER.
|
||||
Either of `string', `comment' or nil.
|
||||
This is an XEmacs compatibility function."
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(let ((state (syntax-ppss (point))))
|
||||
(cond
|
||||
((nth 3 state) 'string)
|
||||
((nth 4 state) 'comment)))))
|
||||
|
||||
|
||||
(defun buffer-syntactic-context-depth (&optional buffer)
|
||||
"Syntactic parenthesis depth at point in BUFFER.
|
||||
This is an XEmacs compatibility function."
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(nth 0 (syntax-ppss (point)))))
|
||||
|
||||
|
||||
;; Extents
|
||||
(defun make-extent (beg end &optional buffer)
|
||||
(make-overlay beg end buffer))
|
||||
|
||||
(defun extent-properties (extent) (overlay-properties extent))
|
||||
(unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get))
|
||||
|
||||
(defun extent-at (pos &optional object property before)
|
||||
(with-current-buffer (or object (current-buffer))
|
||||
(let ((overlays (overlays-at pos 'sorted)))
|
||||
(when property
|
||||
(let (filtered)
|
||||
(while overlays
|
||||
(if (overlay-get (car overlays) property)
|
||||
(setq filtered (cons (car overlays) filtered)))
|
||||
(setq overlays (cdr overlays)))
|
||||
(setq overlays filtered)))
|
||||
(if before
|
||||
(nth 1 (memq before overlays))
|
||||
(car overlays)))))
|
||||
|
||||
(defun set-extent-property (extent prop value)
|
||||
;; Make sure that separate adjacent extents
|
||||
;; with the same mouse-face value
|
||||
;; do not run together as one extent.
|
||||
(and (eq prop 'mouse-face)
|
||||
(symbolp value)
|
||||
(setq value (list value)))
|
||||
(if (eq prop 'duplicable)
|
||||
(cond ((and value (not (overlay-get extent prop)))
|
||||
;; If becoming duplicable, copy all overlayprops to text props.
|
||||
(add-text-properties (overlay-start extent)
|
||||
(overlay-end extent)
|
||||
(overlay-properties extent)
|
||||
(overlay-buffer extent)))
|
||||
;; If becoming no longer duplicable, remove these text props.
|
||||
((and (not value) (overlay-get extent prop))
|
||||
(remove-text-properties (overlay-start extent)
|
||||
(overlay-end extent)
|
||||
(overlay-properties extent)
|
||||
(overlay-buffer extent))))
|
||||
;; If extent is already duplicable, put this property
|
||||
;; on the text as well as on the overlay.
|
||||
(if (overlay-get extent 'duplicable)
|
||||
(put-text-property (overlay-start extent)
|
||||
(overlay-end extent)
|
||||
prop value (overlay-buffer extent))))
|
||||
(overlay-put extent prop value))
|
||||
|
||||
(defun set-extent-face (extent face)
|
||||
(set-extent-property extent 'face face))
|
||||
|
||||
(defun set-extent-end-glyph (extent glyph)
|
||||
(set-extent-property extent 'after-string glyph))
|
||||
|
||||
(defun delete-extent (extent)
|
||||
(set-extent-property extent 'duplicable nil)
|
||||
(delete-overlay extent))
|
||||
|
||||
;; Support the Lucid names with `screen' instead of `frame'.
|
||||
|
||||
(defalias 'current-screen-configuration 'current-frame-configuration)
|
||||
(defalias 'delete-screen 'delete-frame)
|
||||
(defalias 'find-file-new-screen 'find-file-other-frame)
|
||||
(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
|
||||
(defalias 'find-tag-new-screen 'find-tag-other-frame)
|
||||
;;(defalias 'focus-screen 'focus-frame)
|
||||
(defalias 'iconify-screen 'iconify-frame)
|
||||
(defalias 'mail-new-screen 'mail-other-frame)
|
||||
(defalias 'make-screen-invisible 'make-frame-invisible)
|
||||
(defalias 'make-screen-visible 'make-frame-visible)
|
||||
;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
|
||||
(defalias 'modify-screen-parameters 'modify-frame-parameters)
|
||||
(defalias 'next-screen 'next-frame)
|
||||
;; (defalias 'next-multiscreen-window 'next-multiframe-window)
|
||||
;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
|
||||
;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
|
||||
(defalias 'redraw-screen 'redraw-frame)
|
||||
;; (defalias 'screen-char-height 'frame-char-height)
|
||||
;; (defalias 'screen-char-width 'frame-char-width)
|
||||
;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register)
|
||||
;; (defalias 'screen-focus 'frame-focus)
|
||||
(defalias 'screen-list 'frame-list)
|
||||
;; (defalias 'screen-live-p 'frame-live-p)
|
||||
(defalias 'screen-parameters 'frame-parameters)
|
||||
(defalias 'screen-pixel-height 'frame-pixel-height)
|
||||
(defalias 'screen-pixel-width 'frame-pixel-width)
|
||||
(defalias 'screen-root-window 'frame-root-window)
|
||||
(defalias 'screen-selected-window 'frame-selected-window)
|
||||
(defalias 'lower-screen 'lower-frame)
|
||||
(defalias 'raise-screen 'raise-frame)
|
||||
(defalias 'screen-visible-p 'frame-visible-p)
|
||||
(defalias 'screenp 'framep)
|
||||
(defalias 'select-screen 'select-frame)
|
||||
(defalias 'selected-screen 'selected-frame)
|
||||
;; (defalias 'set-screen-configuration 'set-frame-configuration)
|
||||
;; (defalias 'set-screen-height 'set-frame-height)
|
||||
(defalias 'set-screen-position 'set-frame-position)
|
||||
(defalias 'set-screen-size 'set-frame-size)
|
||||
;; (defalias 'set-screen-width 'set-frame-width)
|
||||
(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
|
||||
;; (defalias 'unfocus-screen 'unfocus-frame)
|
||||
(defalias 'visible-screen-list 'visible-frame-list)
|
||||
(defalias 'window-screen 'window-frame)
|
||||
(defalias 'x-create-screen 'x-create-frame)
|
||||
(defalias 'x-new-screen 'make-frame)
|
||||
|
||||
(provide 'lucid)
|
||||
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
|
||||
;;; lucid.el ends here
|
||||
@ -1,801 +0,0 @@
|
||||
;;; whitespace.el --- warn about and clean bogus whitespaces in the file
|
||||
|
||||
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
|
||||
;; Keywords: convenience
|
||||
;; Obsolete-since: 23.1
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; URL: http://www.dsmit.com/lisp/
|
||||
;;
|
||||
;; The whitespace library is intended to find and help fix five different types
|
||||
;; of whitespace problems that commonly exist in source code.
|
||||
;;
|
||||
;; 1. Leading space (empty lines at the top of a file).
|
||||
;; 2. Trailing space (empty lines at the end of a file).
|
||||
;; 3. Indentation space (8 or more spaces at beginning of line, that should be
|
||||
;; replaced with TABS).
|
||||
;; 4. Spaces followed by a TAB. (Almost always, we never want that).
|
||||
;; 5. Spaces or TABS at the end of a line.
|
||||
;;
|
||||
;; Whitespace errors are reported in a buffer, and on the mode line.
|
||||
;;
|
||||
;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
|
||||
;; where `x' and `y' can be one (or more) of:
|
||||
;;
|
||||
;; e - End-of-Line whitespace.
|
||||
;; i - Indentation whitespace.
|
||||
;; l - Leading whitespace.
|
||||
;; s - Space followed by Tab.
|
||||
;; t - Trailing whitespace.
|
||||
;;
|
||||
;; If any of the whitespace checks is turned off, the mode line will display a
|
||||
;; !<y>.
|
||||
;;
|
||||
;; (since (3) is the most controversial one, here is the rationale: Most
|
||||
;; terminal drivers and printer drivers have TAB configured or even
|
||||
;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost
|
||||
;; always they default to 8.)
|
||||
;;
|
||||
;; Changing `tab-width' to other than 8 and editing will cause your code to
|
||||
;; look different from within Emacs, and say, if you cat it or more it, or
|
||||
;; even print it.
|
||||
;;
|
||||
;; Almost all the popular programming modes let you define an offset (like
|
||||
;; c-basic-offset or perl-indent-level) to configure the offset, so you
|
||||
;; should never have to set your `tab-width' to be other than 8 in all
|
||||
;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause
|
||||
;; Emacs to replace your 8 spaces with one \t (try it). If vi users in
|
||||
;; your office complain, tell them to use vim, which distinguishes between
|
||||
;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
|
||||
;; to set smarttab.)
|
||||
;;
|
||||
;; All the above have caused (and will cause) unwanted codeline integration and
|
||||
;; merge problems.
|
||||
;;
|
||||
;; whitespace.el will complain if it detects whitespaces on opening a file, and
|
||||
;; warn you on closing a file also (in case you had inserted any
|
||||
;; whitespaces during the process of your editing).
|
||||
;;
|
||||
;; Exported functions:
|
||||
;;
|
||||
;; `whitespace-buffer' - To check the current buffer for whitespace problems.
|
||||
;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
|
||||
;; `whitespace-region' - To check between point and mark for whitespace
|
||||
;; problems.
|
||||
;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
|
||||
;; and mark in the current buffer.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar whitespace-version "3.5" "Version of the whitespace library.")
|
||||
|
||||
(defvar whitespace-all-buffer-files nil
|
||||
"An associated list of buffers and files checked for whitespace cleanliness.
|
||||
|
||||
This is to enable periodic checking of whitespace cleanliness in the files
|
||||
visited by the buffers.")
|
||||
|
||||
(defvar whitespace-rescan-timer nil
|
||||
"Timer object used to rescan the files in buffers that have been modified.")
|
||||
|
||||
;; Tell Emacs about this new kind of minor mode
|
||||
(defvar whitespace-mode nil
|
||||
"Non-nil when Whitespace mode (a minor mode) is enabled.")
|
||||
(make-variable-buffer-local 'whitespace-mode)
|
||||
|
||||
(defvar whitespace-mode-line nil
|
||||
"String to display in the mode line for Whitespace mode.")
|
||||
(make-variable-buffer-local 'whitespace-mode-line)
|
||||
|
||||
(defvar whitespace-check-buffer-leading nil
|
||||
"Test leading whitespace for file in current buffer if t.")
|
||||
(make-variable-buffer-local 'whitespace-check-buffer-leading)
|
||||
;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp)
|
||||
|
||||
(defvar whitespace-check-buffer-trailing nil
|
||||
"Test trailing whitespace for file in current buffer if t.")
|
||||
(make-variable-buffer-local 'whitespace-check-buffer-trailing)
|
||||
;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp)
|
||||
|
||||
(defvar whitespace-check-buffer-indent nil
|
||||
"Test indentation whitespace for file in current buffer if t.")
|
||||
(make-variable-buffer-local 'whitespace-check-buffer-indent)
|
||||
;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp)
|
||||
|
||||
(defvar whitespace-check-buffer-spacetab nil
|
||||
"Test Space-followed-by-TABS whitespace for file in current buffer if t.")
|
||||
(make-variable-buffer-local 'whitespace-check-buffer-spacetab)
|
||||
;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp)
|
||||
|
||||
(defvar whitespace-check-buffer-ateol nil
|
||||
"Test end-of-line whitespace for file in current buffer if t.")
|
||||
(make-variable-buffer-local 'whitespace-check-buffer-ateol)
|
||||
;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp)
|
||||
|
||||
(defvar whitespace-highlighted-space nil
|
||||
"The variable to store the extent to highlight.")
|
||||
(make-variable-buffer-local 'whitespace-highlighted-space)
|
||||
|
||||
(defalias 'whitespace-make-overlay
|
||||
(if (featurep 'xemacs) 'make-extent 'make-overlay))
|
||||
(defalias 'whitespace-overlay-put
|
||||
(if (featurep 'xemacs) 'set-extent-property 'overlay-put))
|
||||
(defalias 'whitespace-delete-overlay
|
||||
(if (featurep 'xemacs) 'delete-extent 'delete-overlay))
|
||||
(defalias 'whitespace-overlay-start
|
||||
(if (featurep 'xemacs) 'extent-start 'overlay-start))
|
||||
(defalias 'whitespace-overlay-end
|
||||
(if (featurep 'xemacs) 'extent-end 'overlay-end))
|
||||
(defalias 'whitespace-mode-line-update
|
||||
(if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
|
||||
|
||||
(defgroup whitespace nil
|
||||
"Check for and fix five different types of whitespaces in source code."
|
||||
:version "21.1"
|
||||
:link '(emacs-commentary-link "whitespace.el")
|
||||
;; Since XEmacs doesn't have a 'convenience group, use the next best group
|
||||
;; which is 'editing?
|
||||
:group (if (featurep 'xemacs) 'editing 'convenience))
|
||||
|
||||
(defcustom whitespace-check-leading-whitespace t
|
||||
"Flag to check leading whitespace. This is the global for the system.
|
||||
It can be overridden by setting a buffer local variable
|
||||
`whitespace-check-buffer-leading'."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-check-trailing-whitespace t
|
||||
"Flag to check trailing whitespace. This is the global for the system.
|
||||
It can be overridden by setting a buffer local variable
|
||||
`whitespace-check-buffer-trailing'."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-check-spacetab-whitespace t
|
||||
"Flag to check space followed by a TAB. This is the global for the system.
|
||||
It can be overridden by setting a buffer local variable
|
||||
`whitespace-check-buffer-spacetab'."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-spacetab-regexp "[ ]+\t"
|
||||
"Regexp to match one or more spaces followed by a TAB."
|
||||
:type 'regexp
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-check-indent-whitespace indent-tabs-mode
|
||||
"Flag to check indentation whitespace. This is the global for the system.
|
||||
It can be overridden by setting a buffer local variable
|
||||
`whitespace-check-buffer-indent'."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-indent-regexp "^\t*\\( \\)+"
|
||||
"Regexp to match multiples of eight spaces near line beginnings.
|
||||
The default value ignores leading TABs."
|
||||
:type 'regexp
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-check-ateol-whitespace t
|
||||
"Flag to check end-of-line whitespace. This is the global for the system.
|
||||
It can be overridden by setting a buffer local variable
|
||||
`whitespace-check-buffer-ateol'."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-ateol-regexp "[ \t]+$"
|
||||
"Regexp to match one or more TABs or spaces at line ends."
|
||||
:type 'regexp
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-errbuf "*Whitespace Errors*"
|
||||
"The name of the buffer where whitespace related messages will be logged."
|
||||
:type 'string
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-clean-msg "clean."
|
||||
"If non-nil, this message will be displayed after a whitespace check
|
||||
determines a file to be clean."
|
||||
:type 'string
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-abort-on-error nil
|
||||
"While writing a file, abort if the file is unclean.
|
||||
If `whitespace-auto-cleanup' is set, that takes precedence over
|
||||
this variable."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-auto-cleanup nil
|
||||
"Cleanup a buffer automatically on finding it whitespace unclean."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-silent nil
|
||||
"All whitespace errors will be shown only in the mode line when t.
|
||||
|
||||
Note that setting this may cause all whitespaces introduced in a file to go
|
||||
unnoticed when the buffer is killed, unless the user visits the `*Whitespace
|
||||
Errors*' buffer before opening (or closing) another file."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
|
||||
c-mode c++-mode cc-mode
|
||||
change-log-mode cperl-mode
|
||||
electric-nroff-mode emacs-lisp-mode
|
||||
f90-mode fortran-mode html-mode
|
||||
html3-mode java-mode jde-mode
|
||||
ksh-mode latex-mode LaTeX-mode
|
||||
lisp-mode m4-mode makefile-mode
|
||||
modula-2-mode nroff-mode objc-mode
|
||||
pascal-mode perl-mode prolog-mode
|
||||
python-mode scheme-mode sgml-mode
|
||||
sh-mode shell-script-mode simula-mode
|
||||
tcl-mode tex-mode texinfo-mode
|
||||
vrml-mode xml-mode)
|
||||
|
||||
"Major modes in which we turn on whitespace checking.
|
||||
|
||||
These are mostly programming and documentation modes. But you may add other
|
||||
modes that you want whitespaces checked in by adding something like the
|
||||
following to your `.emacs':
|
||||
|
||||
\(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode
|
||||
whitespace-modes))\)
|
||||
|
||||
Or, alternately, you can use the Emacs `customize' command to set this."
|
||||
:type '(repeat symbol)
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-rescan-timer-time 600
|
||||
"Period in seconds to rescan modified buffers for whitespace creep.
|
||||
|
||||
This is the period after which the timer will fire causing
|
||||
`whitespace-rescan-files-in-buffers' to check for whitespace creep in
|
||||
modified buffers.
|
||||
|
||||
To disable timer scans, set this to zero."
|
||||
:type 'integer
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-display-in-modeline t
|
||||
"Display whitespace errors on the modeline."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defcustom whitespace-display-spaces-in-color t
|
||||
"Display the bogus whitespaces by coloring them with the face
|
||||
`whitespace-highlight'."
|
||||
:type 'boolean
|
||||
:group 'whitespace)
|
||||
|
||||
(defface whitespace-highlight '((((class color) (background light))
|
||||
(:background "green1"))
|
||||
(((class color) (background dark))
|
||||
(:background "sea green"))
|
||||
(((class grayscale mono)
|
||||
(background light))
|
||||
(:background "black"))
|
||||
(((class grayscale mono)
|
||||
(background dark))
|
||||
(:background "white")))
|
||||
"Face used for highlighting the bogus whitespaces that exist in the buffer."
|
||||
:group 'whitespace)
|
||||
|
||||
(if (not (assoc 'whitespace-mode minor-mode-alist))
|
||||
(setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
|
||||
minor-mode-alist)))
|
||||
|
||||
(set-default 'whitespace-check-buffer-leading
|
||||
whitespace-check-leading-whitespace)
|
||||
(set-default 'whitespace-check-buffer-trailing
|
||||
whitespace-check-trailing-whitespace)
|
||||
(set-default 'whitespace-check-buffer-indent
|
||||
whitespace-check-indent-whitespace)
|
||||
(set-default 'whitespace-check-buffer-spacetab
|
||||
whitespace-check-spacetab-whitespace)
|
||||
(set-default 'whitespace-check-buffer-ateol
|
||||
whitespace-check-ateol-whitespace)
|
||||
|
||||
(defun whitespace-check-whitespace-mode (&optional arg)
|
||||
"Test and set the whitespace-mode in qualifying buffers."
|
||||
(if (null whitespace-mode)
|
||||
(setq whitespace-mode
|
||||
(if (or arg (member major-mode whitespace-modes))
|
||||
t
|
||||
nil))))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-toggle-leading-check ()
|
||||
"Toggle the check for leading space in the local buffer."
|
||||
(interactive)
|
||||
(let ((current-val whitespace-check-buffer-leading))
|
||||
(setq whitespace-check-buffer-leading (not current-val))
|
||||
(message "Will%s check for leading space in buffer."
|
||||
(if whitespace-check-buffer-leading "" " not"))
|
||||
(if whitespace-check-buffer-leading (whitespace-buffer-leading))))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-toggle-trailing-check ()
|
||||
"Toggle the check for trailing space in the local buffer."
|
||||
(interactive)
|
||||
(let ((current-val whitespace-check-buffer-trailing))
|
||||
(setq whitespace-check-buffer-trailing (not current-val))
|
||||
(message "Will%s check for trailing space in buffer."
|
||||
(if whitespace-check-buffer-trailing "" " not"))
|
||||
(if whitespace-check-buffer-trailing (whitespace-buffer-trailing))))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-toggle-indent-check ()
|
||||
"Toggle the check for indentation space in the local buffer."
|
||||
(interactive)
|
||||
(let ((current-val whitespace-check-buffer-indent))
|
||||
(setq whitespace-check-buffer-indent (not current-val))
|
||||
(message "Will%s check for indentation space in buffer."
|
||||
(if whitespace-check-buffer-indent "" " not"))
|
||||
(if whitespace-check-buffer-indent
|
||||
(whitespace-buffer-search whitespace-indent-regexp))))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-toggle-spacetab-check ()
|
||||
"Toggle the check for space-followed-by-TABs in the local buffer."
|
||||
(interactive)
|
||||
(let ((current-val whitespace-check-buffer-spacetab))
|
||||
(setq whitespace-check-buffer-spacetab (not current-val))
|
||||
(message "Will%s check for space-followed-by-TABs in buffer."
|
||||
(if whitespace-check-buffer-spacetab "" " not"))
|
||||
(if whitespace-check-buffer-spacetab
|
||||
(whitespace-buffer-search whitespace-spacetab-regexp))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-toggle-ateol-check ()
|
||||
"Toggle the check for end-of-line space in the local buffer."
|
||||
(interactive)
|
||||
(let ((current-val whitespace-check-buffer-ateol))
|
||||
(setq whitespace-check-buffer-ateol (not current-val))
|
||||
(message "Will%s check for end-of-line space in buffer."
|
||||
(if whitespace-check-buffer-ateol "" " not"))
|
||||
(if whitespace-check-buffer-ateol
|
||||
(whitespace-buffer-search whitespace-ateol-regexp))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-buffer (&optional quiet)
|
||||
"Find five different types of white spaces in buffer.
|
||||
These are:
|
||||
1. Leading space \(empty lines at the top of a file).
|
||||
2. Trailing space \(empty lines at the end of a file).
|
||||
3. Indentation space \(8 or more spaces, that should be replaced with TABS).
|
||||
4. Spaces followed by a TAB. \(Almost always, we never want that).
|
||||
5. Spaces or TABS at the end of a line.
|
||||
|
||||
Check for whitespace only if this buffer really contains a non-empty file
|
||||
and:
|
||||
1. the major mode is one of the whitespace-modes, or
|
||||
2. `whitespace-buffer' was explicitly called with a prefix argument."
|
||||
(interactive)
|
||||
(let ((whitespace-error nil))
|
||||
(whitespace-check-whitespace-mode current-prefix-arg)
|
||||
(if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
|
||||
(progn
|
||||
(whitespace-check-buffer-list (buffer-name) buffer-file-name)
|
||||
(whitespace-tickle-timer)
|
||||
(overlay-recenter (point-max))
|
||||
(remove-overlays nil nil 'face 'whitespace-highlight)
|
||||
(if whitespace-auto-cleanup
|
||||
(if buffer-read-only
|
||||
(if (not quiet)
|
||||
(message "Can't cleanup: %s is read-only" (buffer-name)))
|
||||
(whitespace-cleanup-internal))
|
||||
(let ((whitespace-leading (if whitespace-check-buffer-leading
|
||||
(whitespace-buffer-leading)
|
||||
nil))
|
||||
(whitespace-trailing (if whitespace-check-buffer-trailing
|
||||
(whitespace-buffer-trailing)
|
||||
nil))
|
||||
(whitespace-indent (if whitespace-check-buffer-indent
|
||||
(whitespace-buffer-search
|
||||
whitespace-indent-regexp)
|
||||
nil))
|
||||
(whitespace-spacetab (if whitespace-check-buffer-spacetab
|
||||
(whitespace-buffer-search
|
||||
whitespace-spacetab-regexp)
|
||||
nil))
|
||||
(whitespace-ateol (if whitespace-check-buffer-ateol
|
||||
(whitespace-buffer-search
|
||||
whitespace-ateol-regexp)
|
||||
nil))
|
||||
(whitespace-errmsg nil)
|
||||
(whitespace-filename buffer-file-name)
|
||||
(whitespace-this-modeline ""))
|
||||
|
||||
;; Now let's complain if we found any of the above.
|
||||
(setq whitespace-error (or whitespace-leading whitespace-indent
|
||||
whitespace-spacetab whitespace-ateol
|
||||
whitespace-trailing))
|
||||
|
||||
(if whitespace-error
|
||||
(progn
|
||||
(setq whitespace-errmsg
|
||||
(concat whitespace-filename " contains:\n"
|
||||
(if whitespace-leading
|
||||
"Leading whitespace\n")
|
||||
(if whitespace-indent
|
||||
(concat "Indentation whitespace"
|
||||
whitespace-indent "\n"))
|
||||
(if whitespace-spacetab
|
||||
(concat "Space followed by Tab"
|
||||
whitespace-spacetab "\n"))
|
||||
(if whitespace-ateol
|
||||
(concat "End-of-line whitespace"
|
||||
whitespace-ateol "\n"))
|
||||
(if whitespace-trailing
|
||||
"Trailing whitespace\n")
|
||||
"\ntype `M-x whitespace-cleanup' to "
|
||||
"cleanup the file."))
|
||||
(setq whitespace-this-modeline
|
||||
(concat (if whitespace-ateol "e")
|
||||
(if whitespace-indent "i")
|
||||
(if whitespace-leading "l")
|
||||
(if whitespace-spacetab "s")
|
||||
(if whitespace-trailing "t")))))
|
||||
(whitespace-update-modeline whitespace-this-modeline)
|
||||
(if (get-buffer whitespace-errbuf)
|
||||
(kill-buffer whitespace-errbuf))
|
||||
(with-current-buffer (get-buffer-create whitespace-errbuf)
|
||||
(if whitespace-errmsg
|
||||
(progn
|
||||
(insert whitespace-errmsg)
|
||||
(if (not (or quiet whitespace-silent))
|
||||
(display-buffer (current-buffer) t))
|
||||
(if (not quiet)
|
||||
(message "Whitespaces: [%s%s] in %s"
|
||||
whitespace-this-modeline
|
||||
(let ((whitespace-unchecked
|
||||
(whitespace-unchecked-whitespaces)))
|
||||
(if whitespace-unchecked
|
||||
(concat "!" whitespace-unchecked)
|
||||
""))
|
||||
whitespace-filename)))
|
||||
(if (and (not quiet) (not (equal whitespace-clean-msg "")))
|
||||
(message "%s %s" whitespace-filename
|
||||
whitespace-clean-msg))))))))
|
||||
whitespace-error))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-region (s e)
|
||||
"Check the region for whitespace errors."
|
||||
(interactive "r")
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region s e)
|
||||
(whitespace-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-cleanup ()
|
||||
"Cleanup the five different kinds of whitespace problems.
|
||||
It normally applies to the whole buffer, but in Transient Mark mode
|
||||
when the mark is active it applies to the region.
|
||||
See `whitespace-buffer' docstring for a summary of the problems."
|
||||
(interactive)
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(whitespace-cleanup-region (region-beginning) (region-end))
|
||||
(whitespace-cleanup-internal)))
|
||||
|
||||
(defun whitespace-cleanup-internal (&optional region-only)
|
||||
;; If this buffer really contains a file, then run, else quit.
|
||||
(whitespace-check-whitespace-mode current-prefix-arg)
|
||||
(if (and buffer-file-name whitespace-mode)
|
||||
(let ((whitespace-any nil)
|
||||
(whitespace-tabwidth 8)
|
||||
(whitespace-tabwidth-saved tab-width))
|
||||
|
||||
;; since all printable TABS should be 8, irrespective of how
|
||||
;; they are displayed.
|
||||
(setq tab-width whitespace-tabwidth)
|
||||
|
||||
(if (and whitespace-check-buffer-leading
|
||||
(whitespace-buffer-leading))
|
||||
(progn
|
||||
(whitespace-buffer-leading-cleanup)
|
||||
(setq whitespace-any t)))
|
||||
|
||||
(if (and whitespace-check-buffer-trailing
|
||||
(whitespace-buffer-trailing))
|
||||
(progn
|
||||
(whitespace-buffer-trailing-cleanup)
|
||||
(setq whitespace-any t)))
|
||||
|
||||
(if (and whitespace-check-buffer-indent
|
||||
(whitespace-buffer-search whitespace-indent-regexp))
|
||||
(progn
|
||||
(whitespace-indent-cleanup)
|
||||
(setq whitespace-any t)))
|
||||
|
||||
(if (and whitespace-check-buffer-spacetab
|
||||
(whitespace-buffer-search whitespace-spacetab-regexp))
|
||||
(progn
|
||||
(whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
|
||||
(setq whitespace-any t)))
|
||||
|
||||
(if (and whitespace-check-buffer-ateol
|
||||
(whitespace-buffer-search whitespace-ateol-regexp))
|
||||
(progn
|
||||
(whitespace-buffer-cleanup whitespace-ateol-regexp "")
|
||||
(setq whitespace-any t)))
|
||||
|
||||
;; Call this recursively till everything is taken care of
|
||||
(if whitespace-any
|
||||
(whitespace-cleanup-internal region-only)
|
||||
;; if we are done, talk to the user
|
||||
(progn
|
||||
(unless whitespace-silent
|
||||
(if region-only
|
||||
(message "The region is now clean")
|
||||
(message "%s is now clean" buffer-file-name)))
|
||||
(whitespace-update-modeline)))
|
||||
(setq tab-width whitespace-tabwidth-saved))))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-cleanup-region (s e)
|
||||
"Whitespace cleanup on the region."
|
||||
(interactive "r")
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region s e)
|
||||
(whitespace-cleanup-internal t))
|
||||
(whitespace-buffer t)))
|
||||
|
||||
(defun whitespace-buffer-leading ()
|
||||
"Return t if the current buffer has leading newline characters.
|
||||
If highlighting is enabled, highlight these characters."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(skip-chars-forward "\n")
|
||||
(unless (bobp)
|
||||
(whitespace-highlight-the-space (point-min) (point))
|
||||
t)))
|
||||
|
||||
(defun whitespace-buffer-leading-cleanup ()
|
||||
"Remove any leading newline characters from current buffer."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(skip-chars-forward "\n")
|
||||
(delete-region (point-min) (point))))
|
||||
|
||||
(defun whitespace-buffer-trailing ()
|
||||
"Return t if the current buffer has extra trailing newline characters.
|
||||
If highlighting is enabled, highlight these characters."
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward "\n")
|
||||
(forward-line)
|
||||
(unless (eobp)
|
||||
(whitespace-highlight-the-space (point) (point-max))
|
||||
t)))
|
||||
|
||||
(defun whitespace-buffer-trailing-cleanup ()
|
||||
"Remove extra trailing newline characters from current buffer."
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward "\n")
|
||||
(unless (eobp)
|
||||
(forward-line)
|
||||
(delete-region (point) (point-max)))))
|
||||
|
||||
(defun whitespace-buffer-search (regexp)
|
||||
"Search for any given whitespace REGEXP."
|
||||
(with-local-quit
|
||||
(let (whitespace-retval)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(whitespace-highlight-the-space (match-beginning 0) (match-end 0))
|
||||
(push (match-beginning 0) whitespace-retval)))
|
||||
(when whitespace-retval
|
||||
(format " %s" (nreverse whitespace-retval))))))
|
||||
|
||||
(defun whitespace-buffer-cleanup (regexp newregexp)
|
||||
"Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(replace-match newregexp))))
|
||||
|
||||
(defun whitespace-indent-cleanup ()
|
||||
"Search for 8/more spaces at the start of a line and replace it with tabs."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward whitespace-indent-regexp nil t)
|
||||
(let ((column (current-column))
|
||||
(indent-tabs-mode t))
|
||||
(delete-region (match-beginning 0) (point))
|
||||
(indent-to column)))))
|
||||
|
||||
(defun whitespace-unchecked-whitespaces ()
|
||||
"Return the list of whitespaces whose testing has been suppressed."
|
||||
(let ((unchecked-spaces
|
||||
(concat (if (not whitespace-check-buffer-ateol) "e")
|
||||
(if (not whitespace-check-buffer-indent) "i")
|
||||
(if (not whitespace-check-buffer-leading) "l")
|
||||
(if (not whitespace-check-buffer-spacetab) "s")
|
||||
(if (not whitespace-check-buffer-trailing) "t"))))
|
||||
(if (not (equal unchecked-spaces ""))
|
||||
unchecked-spaces
|
||||
nil)))
|
||||
|
||||
(defun whitespace-update-modeline (&optional whitespace-err)
|
||||
"Update mode line with whitespace errors.
|
||||
Also with whitespaces whose testing has been turned off."
|
||||
(if whitespace-display-in-modeline
|
||||
(progn
|
||||
(setq whitespace-mode-line nil)
|
||||
;; Whitespace errors
|
||||
(if (and whitespace-err (not (equal whitespace-err "")))
|
||||
(setq whitespace-mode-line whitespace-err))
|
||||
;; Whitespace suppressed errors
|
||||
(let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
|
||||
(if whitespace-unchecked
|
||||
(setq whitespace-mode-line
|
||||
(concat whitespace-mode-line "!" whitespace-unchecked))))
|
||||
;; Add the whitespace modeline prefix
|
||||
(setq whitespace-mode-line (if whitespace-mode-line
|
||||
(concat " W:" whitespace-mode-line)
|
||||
nil))
|
||||
(whitespace-mode-line-update))))
|
||||
|
||||
(defun whitespace-highlight-the-space (b e)
|
||||
"Highlight the current line, unhighlighting a previously jumped to line."
|
||||
(if whitespace-display-spaces-in-color
|
||||
(let ((ol (whitespace-make-overlay b e)))
|
||||
(whitespace-overlay-put ol 'face 'whitespace-highlight))))
|
||||
|
||||
(defun whitespace-unhighlight-the-space()
|
||||
"Unhighlight the currently highlight line."
|
||||
(if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
|
||||
(progn
|
||||
(mapc 'whitespace-delete-overlay whitespace-highlighted-space)
|
||||
(setq whitespace-highlighted-space nil))))
|
||||
|
||||
(defun whitespace-check-buffer-list (buf-name buf-file)
|
||||
"Add a buffer and its file to the whitespace monitor list.
|
||||
|
||||
The buffer named BUF-NAME and its associated file BUF-FILE are now monitored
|
||||
periodically for whitespace."
|
||||
(if (and whitespace-mode (not (member (list buf-file buf-name)
|
||||
whitespace-all-buffer-files)))
|
||||
(add-to-list 'whitespace-all-buffer-files (list buf-file buf-name))))
|
||||
|
||||
(defun whitespace-tickle-timer ()
|
||||
"Tickle timer to periodically to scan qualifying files for whitespace creep.
|
||||
|
||||
If timer is not set, then set it to scan the files in
|
||||
`whitespace-all-buffer-files' periodically (defined by
|
||||
`whitespace-rescan-timer-time') for whitespace creep."
|
||||
(if (and whitespace-rescan-timer-time
|
||||
(/= whitespace-rescan-timer-time 0)
|
||||
(not whitespace-rescan-timer))
|
||||
(setq whitespace-rescan-timer
|
||||
(add-timeout whitespace-rescan-timer-time
|
||||
'whitespace-rescan-files-in-buffers nil
|
||||
whitespace-rescan-timer-time))))
|
||||
|
||||
(defun whitespace-rescan-files-in-buffers (&optional arg)
|
||||
"Check monitored files for whitespace creep since last scan."
|
||||
(let ((whitespace-all-my-files whitespace-all-buffer-files)
|
||||
buffile bufname thiselt buf)
|
||||
(if (not whitespace-all-my-files)
|
||||
(progn
|
||||
(disable-timeout whitespace-rescan-timer)
|
||||
(setq whitespace-rescan-timer nil))
|
||||
(while whitespace-all-my-files
|
||||
(setq thiselt (car whitespace-all-my-files))
|
||||
(setq whitespace-all-my-files (cdr whitespace-all-my-files))
|
||||
(setq buffile (car thiselt))
|
||||
(setq bufname (cadr thiselt))
|
||||
(setq buf (get-buffer bufname))
|
||||
(if (buffer-live-p buf)
|
||||
(with-current-buffer bufname
|
||||
;;(message "buffer %s live" bufname)
|
||||
(if whitespace-mode
|
||||
(progn
|
||||
;;(message "checking for whitespace in %s" bufname)
|
||||
(if whitespace-auto-cleanup
|
||||
(progn
|
||||
;;(message "cleaning up whitespace in %s" bufname)
|
||||
(whitespace-cleanup-internal))
|
||||
(progn
|
||||
;;(message "whitespace-buffer %s." (buffer-name))
|
||||
(whitespace-buffer t))))
|
||||
;;(message "Removing %s from refresh list" bufname)
|
||||
(whitespace-refresh-rescan-list buffile bufname)))
|
||||
;;(message "Removing %s from refresh list" bufname)
|
||||
(whitespace-refresh-rescan-list buffile bufname))))))
|
||||
|
||||
(defun whitespace-refresh-rescan-list (buffile bufname)
|
||||
"Refresh the list of files to be rescanned for whitespace creep."
|
||||
(if whitespace-all-buffer-files
|
||||
(setq whitespace-all-buffer-files
|
||||
(delete (list buffile bufname) whitespace-all-buffer-files))
|
||||
(when whitespace-rescan-timer
|
||||
(disable-timeout whitespace-rescan-timer)
|
||||
(setq whitespace-rescan-timer nil))))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'global-whitespace-mode 'whitespace-global-mode)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode whitespace-global-mode
|
||||
"Toggle using Whitespace mode in new buffers.
|
||||
|
||||
When this mode is active, `whitespace-buffer' is added to
|
||||
`find-file-hook' and `kill-buffer-hook'."
|
||||
:global t
|
||||
:group 'whitespace
|
||||
(if whitespace-global-mode
|
||||
(progn
|
||||
(add-hook 'find-file-hook 'whitespace-buffer)
|
||||
(add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
|
||||
(add-hook 'kill-buffer-hook 'whitespace-buffer))
|
||||
(remove-hook 'find-file-hook 'whitespace-buffer)
|
||||
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)
|
||||
(remove-hook 'kill-buffer-hook 'whitespace-buffer)))
|
||||
|
||||
;;;###autoload
|
||||
(defun whitespace-write-file-hook ()
|
||||
"Hook function to be called on the buffer when whitespace check is enabled.
|
||||
This is meant to be added buffer-locally to `write-file-functions'."
|
||||
(let ((werr nil))
|
||||
(if whitespace-auto-cleanup
|
||||
(whitespace-cleanup-internal)
|
||||
(setq werr (whitespace-buffer)))
|
||||
(if (and whitespace-abort-on-error werr)
|
||||
(error "Abort write due to whitespaces in %s"
|
||||
buffer-file-name)))
|
||||
nil)
|
||||
|
||||
(defun whitespace-unload-function ()
|
||||
"Unload the whitespace library."
|
||||
(if (unintern "whitespace-unload-hook" obarray)
|
||||
;; if whitespace-unload-hook is defined, let's get rid of it
|
||||
;; and recursively call `unload-feature'
|
||||
(progn (unload-feature 'whitespace) t)
|
||||
;; this only happens in the recursive call
|
||||
(whitespace-global-mode -1)
|
||||
(save-current-buffer
|
||||
(dolist (buf (buffer-list))
|
||||
(set-buffer buf)
|
||||
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)))
|
||||
;; continue standard unloading
|
||||
nil))
|
||||
|
||||
(defun whitespace-unload-hook ()
|
||||
(remove-hook 'find-file-hook 'whitespace-buffer)
|
||||
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)
|
||||
(remove-hook 'kill-buffer-hook 'whitespace-buffer))
|
||||
|
||||
(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
|
||||
|
||||
(provide 'whitespace)
|
||||
|
||||
;;; whitespace.el ends here
|
||||
Loading…
Reference in New Issue
Block a user