From e35cdfa1de53d10f247c60ff8933847b33fc654d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 1 May 2020 13:29:06 +0200 Subject: [PATCH] Delete libraries obsolete since 23.1 or 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. --- admin/authors.el | 6 +- etc/NEWS | 4 + lisp/emulation/viper.el | 1 - lisp/ffap.el | 2 +- lisp/obsolete/ledit.el | 157 ------- lisp/obsolete/lmenu.el | 445 ------------------ lisp/obsolete/lucid.el | 211 --------- lisp/obsolete/old-whitespace.el | 801 -------------------------------- 8 files changed, 8 insertions(+), 1619 deletions(-) delete mode 100644 lisp/obsolete/ledit.el delete mode 100644 lisp/obsolete/lmenu.el delete mode 100644 lisp/obsolete/lucid.el delete mode 100644 lisp/obsolete/old-whitespace.el diff --git a/admin/authors.el b/admin/authors.el index 13b203b9bc..dc57c0a6b9 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -365,7 +365,7 @@ authors-ignored-files "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 @@ authors-fixed-entries ;; 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 @@ authors-valid-file-names "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" diff --git a/etc/NEWS b/etc/NEWS index c4911726a8..4edda0945d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -331,6 +331,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 diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 492c31bde7..8e7a34fc69 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1221,7 +1221,6 @@ viper-vi-intercept-map (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 diff --git a/lisp/ffap.el b/lisp/ffap.el index ead79b45c0..d656b37372 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1607,7 +1607,7 @@ ffap-menu-ask 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: diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el deleted file mode 100644 index c99a06de57..0000000000 --- a/lisp/obsolete/ledit.el +++ /dev/null @@ -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 . - -;;; 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 () - "\\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 diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el deleted file mode 100644 index 678481924b..0000000000 --- a/lisp/obsolete/lmenu.el +++ /dev/null @@ -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 . - -;;; 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 := - command := - callback := command | form - active-p := - name := - 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 diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el deleted file mode 100644 index 817cc9cfaa..0000000000 --- a/lisp/obsolete/lucid.el +++ /dev/null @@ -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 . - -;;; 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 diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el deleted file mode 100644 index 2f46d7ddda..0000000000 --- a/lisp/obsolete/old-whitespace.el +++ /dev/null @@ -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 -;; 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 . - -;;; 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:! 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 -;; !. -;; -;; (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 -- 2.26.2