diff options
| author | Stefan Kangas | 2020-05-15 19:55:26 +0200 |
|---|---|---|
| committer | Stefan Kangas | 2020-05-15 19:55:26 +0200 |
| commit | b76cdd0c1a7978decc0c1044ad23ecc9432c526a (patch) | |
| tree | 13532d1defc46230a4c9758843e8c2a304e06c7c | |
| parent | 5d97d2683a5e9051e4e048397c5a3681e378c9b5 (diff) | |
| download | emacs-b76cdd0c1a7978decc0c1044ad23ecc9432c526a.tar.gz emacs-b76cdd0c1a7978decc0c1044ad23ecc9432c526a.zip | |
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.
| -rw-r--r-- | admin/authors.el | 6 | ||||
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | lisp/emulation/viper.el | 1 | ||||
| -rw-r--r-- | lisp/ffap.el | 2 | ||||
| -rw-r--r-- | lisp/obsolete/ledit.el | 157 | ||||
| -rw-r--r-- | lisp/obsolete/lmenu.el | 445 | ||||
| -rw-r--r-- | lisp/obsolete/lucid.el | 211 | ||||
| -rw-r--r-- | lisp/obsolete/old-whitespace.el | 801 |
8 files changed, 8 insertions, 1619 deletions
diff --git a/admin/authors.el b/admin/authors.el index 13b203b9bc1..dc57c0a6b91 100644 --- a/admin/authors.el +++ b/admin/authors.el | |||
| @@ -365,7 +365,7 @@ Changes to files matching one of the regexps in this list are not listed.") | |||
| 365 | "lib/stdarg.in.h" "lib/stdbool.in.h" | 365 | "lib/stdarg.in.h" "lib/stdbool.in.h" |
| 366 | "unidata/bidimirror.awk" "unidata/biditype.awk" | 366 | "unidata/bidimirror.awk" "unidata/biditype.awk" |
| 367 | "split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack" | 367 | "split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack" |
| 368 | "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat" | 368 | "gnu-hp300" "refcard.bit" "forms.README" "forms-d2.dat" |
| 369 | "CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit" | 369 | "CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit" |
| 370 | "CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit" | 370 | "CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit" |
| 371 | "copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6" | 371 | "copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6" |
| @@ -609,7 +609,7 @@ Changes to files in this list are not listed.") | |||
| 609 | ;; No longer distributed: lselect.el. | 609 | ;; No longer distributed: lselect.el. |
| 610 | ("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el" | 610 | ("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el" |
| 611 | "bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el" | 611 | "bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el" |
| 612 | "lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c") | 612 | "mailabbrev.el" "select.el" "xfaces.c" "xselect.c") |
| 613 | ;; MCC. No longer distributed: emacsserver.c. | 613 | ;; MCC. No longer distributed: emacsserver.c. |
| 614 | ("Microelectronics and Computer Technology Corporation" | 614 | ("Microelectronics and Computer Technology Corporation" |
| 615 | :changed "etags.c" "emacsclient.c" "movemail.c" | 615 | :changed "etags.c" "emacsclient.c" "movemail.c" |
| @@ -773,7 +773,7 @@ Changes to files in this list are not listed.") | |||
| 773 | "erc-hecomplete.el" | 773 | "erc-hecomplete.el" |
| 774 | "eshell/esh-maint.el" | 774 | "eshell/esh-maint.el" |
| 775 | "language/persian.el" | 775 | "language/persian.el" |
| 776 | "ledit.el" "meese.el" "iswitchb.el" "longlines.el" | 776 | "meese.el" "iswitchb.el" "longlines.el" |
| 777 | "mh-exec.el" "mh-init.el" "mh-customize.el" | 777 | "mh-exec.el" "mh-init.el" "mh-customize.el" |
| 778 | "net/zone-mode.el" "xesam.el" | 778 | "net/zone-mode.el" "xesam.el" |
| 779 | "term/mac-win.el" "sup-mouse.el" | 779 | "term/mac-win.el" "sup-mouse.el" |
| @@ -397,6 +397,10 @@ This is no longer supported, and setting this variable has no effect. | |||
| 397 | ** The macro 'with-displayed-buffer-window' is now obsolete. | 397 | ** The macro 'with-displayed-buffer-window' is now obsolete. |
| 398 | Use macro 'with-current-buffer-window' with action alist entry 'body-function'. | 398 | Use macro 'with-current-buffer-window' with action alist entry 'body-function'. |
| 399 | 399 | ||
| 400 | --- | ||
| 401 | ** Some libraries obsolete since Emacs 23 have been removed: | ||
| 402 | 'ledit.el', 'lmenu.el', 'lucid.el and 'old-whitespace.el'. | ||
| 403 | |||
| 400 | 404 | ||
| 401 | * Lisp Changes in Emacs 28.1 | 405 | * Lisp Changes in Emacs 28.1 |
| 402 | 406 | ||
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 492c31bde74..8e7a34fc69c 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el | |||
| @@ -1221,7 +1221,6 @@ These two lines must come in the order given.")) | |||
| 1221 | (viper-harness-minor-mode "outline") | 1221 | (viper-harness-minor-mode "outline") |
| 1222 | (viper-harness-minor-mode "allout") | 1222 | (viper-harness-minor-mode "allout") |
| 1223 | (viper-harness-minor-mode "xref") | 1223 | (viper-harness-minor-mode "xref") |
| 1224 | (viper-harness-minor-mode "lmenu") | ||
| 1225 | (viper-harness-minor-mode "vc") | 1224 | (viper-harness-minor-mode "vc") |
| 1226 | (viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which | 1225 | (viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which |
| 1227 | (viper-harness-minor-mode "latex") ; sits in one of these two files | 1226 | (viper-harness-minor-mode "latex") ; sits in one of these two files |
diff --git a/lisp/ffap.el b/lisp/ffap.el index ead79b45c0e..d656b373729 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el | |||
| @@ -1607,7 +1607,7 @@ Each ALIST entry looks like (STRING . DATA) and defines one choice. | |||
| 1607 | Function CONT is applied to the entry chosen by the user." | 1607 | Function CONT is applied to the entry chosen by the user." |
| 1608 | ;; Note: this function is used with a different continuation | 1608 | ;; Note: this function is used with a different continuation |
| 1609 | ;; by the ffap-url add-on package. | 1609 | ;; by the ffap-url add-on package. |
| 1610 | ;; Could try rewriting to use easymenu.el or lmenu.el. | 1610 | ;; Could try rewriting to use easymenu.el. |
| 1611 | (let (choice) | 1611 | (let (choice) |
| 1612 | (cond | 1612 | (cond |
| 1613 | ;; Emacs mouse: | 1613 | ;; Emacs mouse: |
diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el deleted file mode 100644 index c99a06de570..00000000000 --- a/lisp/obsolete/ledit.el +++ /dev/null | |||
| @@ -1,157 +0,0 @@ | |||
| 1 | ;;; ledit.el --- Emacs side of ledit interface | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: emacs-devel@gnu.org | ||
| 6 | ;; Keywords: languages | ||
| 7 | ;; Obsolete-since: 24.3 | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; This is a major mode for editing Liszt. | ||
| 27 | |||
| 28 | ;;; Code: | ||
| 29 | |||
| 30 | ;;; To do: | ||
| 31 | ;;; o lisp -> emacs side of things (grind-definition and find-definition) | ||
| 32 | |||
| 33 | (defvar ledit-mode-map nil) | ||
| 34 | |||
| 35 | (defconst ledit-zap-file | ||
| 36 | (expand-file-name (concat (user-login-name) ".l1") temporary-file-directory) | ||
| 37 | "File name for data sent to Lisp by Ledit.") | ||
| 38 | (defconst ledit-read-file | ||
| 39 | (expand-file-name (concat (user-login-name) ".l2") temporary-file-directory) | ||
| 40 | "File name for data sent to Ledit by Lisp.") | ||
| 41 | (defconst ledit-compile-file | ||
| 42 | (expand-file-name (concat (user-login-name) ".l4") temporary-file-directory) | ||
| 43 | "File name for data sent to Lisp compiler by Ledit.") | ||
| 44 | (defconst ledit-buffer "*LEDIT*" | ||
| 45 | "Name of buffer in which Ledit accumulates data to send to Lisp.") | ||
| 46 | |||
| 47 | ;;;###autoload | ||
| 48 | (defconst ledit-save-files t "\ | ||
| 49 | *Non-nil means Ledit should save files before transferring to Lisp.") | ||
| 50 | ;;;###autoload | ||
| 51 | (defconst ledit-go-to-lisp-string "%?lisp" "\ | ||
| 52 | *Shell commands to execute to resume Lisp job.") | ||
| 53 | ;;;###autoload | ||
| 54 | (defconst ledit-go-to-liszt-string "%?liszt" "\ | ||
| 55 | *Shell commands to execute to resume Lisp compiler job.") | ||
| 56 | |||
| 57 | (defun ledit-save-defun () | ||
| 58 | "Save the current defun in the ledit buffer." | ||
| 59 | (interactive) | ||
| 60 | (save-excursion | ||
| 61 | (end-of-defun) | ||
| 62 | (let ((end (point))) | ||
| 63 | (beginning-of-defun) | ||
| 64 | (append-to-buffer ledit-buffer (point) end)) | ||
| 65 | (message "Current defun saved for Lisp"))) | ||
| 66 | |||
| 67 | (defun ledit-save-region (beg end) | ||
| 68 | "Save the current region in the ledit buffer" | ||
| 69 | (interactive "r") | ||
| 70 | (append-to-buffer ledit-buffer beg end) | ||
| 71 | (message "Region saved for Lisp")) | ||
| 72 | |||
| 73 | (defun ledit-zap-defun-to-lisp () | ||
| 74 | "Carry the current defun to Lisp." | ||
| 75 | (interactive) | ||
| 76 | (ledit-save-defun) | ||
| 77 | (ledit-go-to-lisp)) | ||
| 78 | |||
| 79 | (defun ledit-zap-defun-to-liszt () | ||
| 80 | "Carry the current defun to liszt." | ||
| 81 | (interactive) | ||
| 82 | (ledit-save-defun) | ||
| 83 | (ledit-go-to-liszt)) | ||
| 84 | |||
| 85 | (defun ledit-zap-region-to-lisp (beg end) | ||
| 86 | "Carry the current region to Lisp." | ||
| 87 | (interactive "r") | ||
| 88 | (ledit-save-region beg end) | ||
| 89 | (ledit-go-to-lisp)) | ||
| 90 | |||
| 91 | (defun ledit-go-to-lisp () | ||
| 92 | "Suspend Emacs and restart a waiting Lisp job." | ||
| 93 | (interactive) | ||
| 94 | (if ledit-save-files | ||
| 95 | (save-some-buffers)) | ||
| 96 | (if (get-buffer ledit-buffer) | ||
| 97 | (with-current-buffer ledit-buffer | ||
| 98 | (goto-char (point-min)) | ||
| 99 | (write-region (point-min) (point-max) ledit-zap-file) | ||
| 100 | (erase-buffer))) | ||
| 101 | (suspend-emacs ledit-go-to-lisp-string) | ||
| 102 | (load ledit-read-file t t)) | ||
| 103 | |||
| 104 | (defun ledit-go-to-liszt () | ||
| 105 | "Suspend Emacs and restart a waiting Liszt job." | ||
| 106 | (interactive) | ||
| 107 | (if ledit-save-files | ||
| 108 | (save-some-buffers)) | ||
| 109 | (if (get-buffer ledit-buffer) | ||
| 110 | (with-current-buffer ledit-buffer | ||
| 111 | (goto-char (point-min)) | ||
| 112 | (insert "(declare (macros t))\n") | ||
| 113 | (write-region (point-min) (point-max) ledit-compile-file) | ||
| 114 | (erase-buffer))) | ||
| 115 | (suspend-emacs ledit-go-to-liszt-string) | ||
| 116 | (load ledit-read-file t t)) | ||
| 117 | |||
| 118 | (defun ledit-setup () | ||
| 119 | "Set up key bindings for the Lisp/Emacs interface." | ||
| 120 | (unless ledit-mode-map | ||
| 121 | (setq ledit-mode-map (make-sparse-keymap)) | ||
| 122 | (set-keymap-parent ledit-mode-map lisp-mode-shared-map)) | ||
| 123 | (define-key ledit-mode-map "\e\^d" 'ledit-save-defun) | ||
| 124 | (define-key ledit-mode-map "\e\^r" 'ledit-save-region) | ||
| 125 | (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp) | ||
| 126 | (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt)) | ||
| 127 | |||
| 128 | (ledit-setup) | ||
| 129 | |||
| 130 | ;;;###autoload | ||
| 131 | (defun ledit-mode () | ||
| 132 | "\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job. | ||
| 133 | Like Lisp mode, plus these special commands: | ||
| 134 | \\[ledit-save-defun] -- record defun at or after point | ||
| 135 | for later transmission to Lisp job. | ||
| 136 | \\[ledit-save-region] -- record region for later transmission to Lisp job. | ||
| 137 | \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text. | ||
| 138 | \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job | ||
| 139 | and transmit saved text. | ||
| 140 | |||
| 141 | \\{ledit-mode-map} | ||
| 142 | To make Lisp mode automatically change to Ledit mode, | ||
| 143 | do (setq lisp-mode-hook 'ledit-from-lisp-mode)" | ||
| 144 | (interactive) | ||
| 145 | (delay-mode-hooks (lisp-mode)) | ||
| 146 | (ledit-from-lisp-mode)) | ||
| 147 | |||
| 148 | ;;;###autoload | ||
| 149 | (defun ledit-from-lisp-mode () | ||
| 150 | (use-local-map ledit-mode-map) | ||
| 151 | (setq mode-name "Ledit") | ||
| 152 | (setq major-mode 'ledit-mode) | ||
| 153 | (run-mode-hooks 'ledit-mode-hook)) | ||
| 154 | |||
| 155 | (provide 'ledit) | ||
| 156 | |||
| 157 | ;;; ledit.el ends here | ||
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el deleted file mode 100644 index 678481924b2..00000000000 --- a/lisp/obsolete/lmenu.el +++ /dev/null | |||
| @@ -1,445 +0,0 @@ | |||
| 1 | ;;; lmenu.el --- emulate Lucid's menubar support | ||
| 2 | |||
| 3 | ;; Copyright (C) 1992-1994, 1997, 2001-2020 Free Software Foundation, | ||
| 4 | ;; Inc. | ||
| 5 | |||
| 6 | ;; Keywords: emulations obsolete | ||
| 7 | ;; Obsolete-since: 23.3 | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; This file has been obsolete since Emacs 23.3. | ||
| 27 | |||
| 28 | ;;; Code: | ||
| 29 | |||
| 30 | |||
| 31 | ;; First, emulate the Lucid menubar support in GNU Emacs 19. | ||
| 32 | |||
| 33 | ;; Arrange to use current-menubar to set up part of the menu bar. | ||
| 34 | |||
| 35 | (defvar current-menubar) | ||
| 36 | (defvar lucid-menubar-map) | ||
| 37 | (defvar lucid-failing-menubar) | ||
| 38 | |||
| 39 | (defvar recompute-lucid-menubar 'recompute-lucid-menubar) | ||
| 40 | (defun recompute-lucid-menubar () | ||
| 41 | (define-key lucid-menubar-map [menu-bar] | ||
| 42 | (condition-case nil | ||
| 43 | (make-lucid-menu-keymap "menu-bar" current-menubar) | ||
| 44 | (error (message "Invalid data in current-menubar moved to lucid-failing-menubar") | ||
| 45 | (sit-for 1) | ||
| 46 | (setq lucid-failing-menubar current-menubar | ||
| 47 | current-menubar nil)))) | ||
| 48 | (setq lucid-menu-bar-dirty-flag nil)) | ||
| 49 | |||
| 50 | (defvar lucid-menubar-map (make-sparse-keymap)) | ||
| 51 | (or (assq 'current-menubar minor-mode-map-alist) | ||
| 52 | (setq minor-mode-map-alist | ||
| 53 | (cons (cons 'current-menubar lucid-menubar-map) | ||
| 54 | minor-mode-map-alist))) | ||
| 55 | |||
| 56 | ;; XEmacs compatibility | ||
| 57 | (defun set-menubar-dirty-flag () | ||
| 58 | (force-mode-line-update) | ||
| 59 | (setq lucid-menu-bar-dirty-flag t)) | ||
| 60 | |||
| 61 | (defvar add-menu-item-count 0) | ||
| 62 | |||
| 63 | ;; This is a variable whose value is always nil. | ||
| 64 | (defvar make-lucid-menu-keymap-disable nil) | ||
| 65 | |||
| 66 | ;; Return a menu keymap corresponding to a Lucid-style menu list | ||
| 67 | ;; MENU-ITEMS, and with name MENU-NAME. | ||
| 68 | (defun make-lucid-menu-keymap (menu-name menu-items) | ||
| 69 | (let ((menu (make-sparse-keymap menu-name))) | ||
| 70 | ;; Process items in reverse order, | ||
| 71 | ;; since the define-key loop reverses them again. | ||
| 72 | (setq menu-items (reverse menu-items)) | ||
| 73 | (while menu-items | ||
| 74 | (let ((item (car menu-items)) | ||
| 75 | command name callback) | ||
| 76 | (cond ((stringp item) | ||
| 77 | (setq command nil) | ||
| 78 | (setq name (if (string-match "^-+$" item) "" item))) | ||
| 79 | ((consp item) | ||
| 80 | (setq command (make-lucid-menu-keymap (car item) (cdr item))) | ||
| 81 | (setq name (car item))) | ||
| 82 | ((vectorp item) | ||
| 83 | (setq command (make-symbol (format "menu-function-%d" | ||
| 84 | add-menu-item-count)) | ||
| 85 | add-menu-item-count (1+ add-menu-item-count) | ||
| 86 | name (aref item 0) | ||
| 87 | callback (aref item 1)) | ||
| 88 | (if (symbolp callback) | ||
| 89 | (fset command callback) | ||
| 90 | (fset command (list 'lambda () '(interactive) callback))) | ||
| 91 | (put command 'menu-alias t) | ||
| 92 | (let ((i 2)) | ||
| 93 | (while (< i (length item)) | ||
| 94 | (cond | ||
| 95 | ((eq (aref item i) ':active) | ||
| 96 | (put command 'menu-enable | ||
| 97 | (or (aref item (1+ i)) | ||
| 98 | 'make-lucid-menu-keymap-disable)) | ||
| 99 | (setq i (+ 2 i))) | ||
| 100 | ((eq (aref item i) ':suffix) | ||
| 101 | ;; unimplemented | ||
| 102 | (setq i (+ 2 i))) | ||
| 103 | ((eq (aref item i) ':keys) | ||
| 104 | ;; unimplemented | ||
| 105 | (setq i (+ 2 i))) | ||
| 106 | ((eq (aref item i) ':style) | ||
| 107 | ;; unimplemented | ||
| 108 | (setq i (+ 2 i))) | ||
| 109 | ((eq (aref item i) ':selected) | ||
| 110 | ;; unimplemented | ||
| 111 | (setq i (+ 2 i))) | ||
| 112 | ((and (symbolp (aref item i)) | ||
| 113 | (= ?: (string-to-char (symbol-name (aref item i))))) | ||
| 114 | (error "Unrecognized menu item keyword: %S" | ||
| 115 | (aref item i))) | ||
| 116 | ((= i 2) | ||
| 117 | ;; old-style format: active-p &optional suffix | ||
| 118 | (put command 'menu-enable | ||
| 119 | (or (aref item i) 'make-lucid-menu-keymap-disable)) | ||
| 120 | ;; suffix is unimplemented | ||
| 121 | (setq i (length item))) | ||
| 122 | (t | ||
| 123 | (error "Unexpected menu item value: %S" | ||
| 124 | (aref item i)))))))) | ||
| 125 | (if (null command) | ||
| 126 | ;; Handle inactive strings specially--allow any number | ||
| 127 | ;; of identical ones. | ||
| 128 | (setcdr menu (cons (list nil name) (cdr menu))) | ||
| 129 | (if name | ||
| 130 | (define-key menu (vector (intern name)) (cons name command))))) | ||
| 131 | (setq menu-items (cdr menu-items))) | ||
| 132 | menu)) | ||
| 133 | |||
| 134 | (declare-function x-popup-dialog "menu.c" (position contents &optional header)) | ||
| 135 | |||
| 136 | ;; XEmacs compatibility function | ||
| 137 | (defun popup-dialog-box (data) | ||
| 138 | "Pop up a dialog box. | ||
| 139 | A dialog box description is a list. | ||
| 140 | |||
| 141 | - The first element of the list is a string to display in the dialog box. | ||
| 142 | - The rest of the elements are descriptions of the dialog box's buttons. | ||
| 143 | Each one is a vector of three elements: | ||
| 144 | - The first element is the text of the button. | ||
| 145 | - The second element is the `callback'. | ||
| 146 | - The third element is t or nil, whether this button is selectable. | ||
| 147 | |||
| 148 | If the `callback' of a button is a symbol, then it must name a command. | ||
| 149 | It will be invoked with `call-interactively'. If it is a list, then it is | ||
| 150 | evaluated with `eval'. | ||
| 151 | |||
| 152 | One (and only one) of the buttons may be nil. This marker means that all | ||
| 153 | following buttons should be flushright instead of flushleft. | ||
| 154 | |||
| 155 | The syntax, more precisely: | ||
| 156 | |||
| 157 | form := <something to pass to `eval'> | ||
| 158 | command := <a symbol or string, to pass to `call-interactively'> | ||
| 159 | callback := command | form | ||
| 160 | active-p := <t, nil, or a form to evaluate to decide whether this | ||
| 161 | button should be selectable> | ||
| 162 | name := <string> | ||
| 163 | partition := `nil' | ||
| 164 | button := `[' name callback active-p `]' | ||
| 165 | dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'" | ||
| 166 | (let ((name (car data)) | ||
| 167 | (tail (cdr data)) | ||
| 168 | converted | ||
| 169 | choice meaning) | ||
| 170 | (while tail | ||
| 171 | (if (null (car tail)) | ||
| 172 | (setq converted (cons nil converted)) | ||
| 173 | (let ((item (aref (car tail) 0)) | ||
| 174 | (callback (aref (car tail) 1)) | ||
| 175 | (enable (aref (car tail) 2))) | ||
| 176 | (setq converted | ||
| 177 | (cons (if enable (cons item callback) item) | ||
| 178 | converted)))) | ||
| 179 | (setq tail (cdr tail))) | ||
| 180 | (setq choice (x-popup-dialog t (cons name (nreverse converted)))) | ||
| 181 | (if choice | ||
| 182 | (if (symbolp choice) | ||
| 183 | (call-interactively choice) | ||
| 184 | (eval choice))))) | ||
| 185 | |||
| 186 | ;; This is empty because the usual elements of the menu bar | ||
| 187 | ;; are provided by menu-bar.el instead. | ||
| 188 | ;; It would not make sense to duplicate them here. | ||
| 189 | (defconst default-menubar nil) | ||
| 190 | |||
| 191 | ;; XEmacs compatibility | ||
| 192 | (defun set-menubar (menubar) | ||
| 193 | "Set the default menubar to be menubar." | ||
| 194 | (setq-default current-menubar (copy-sequence menubar)) | ||
| 195 | (set-menubar-dirty-flag)) | ||
| 196 | |||
| 197 | ;; XEmacs compatibility | ||
| 198 | (defun set-buffer-menubar (menubar) | ||
| 199 | "Set the buffer-local menubar to be menubar." | ||
| 200 | (make-local-variable 'current-menubar) | ||
| 201 | (setq current-menubar (copy-sequence menubar)) | ||
| 202 | (set-menubar-dirty-flag)) | ||
| 203 | |||
| 204 | |||
| 205 | ;;; menu manipulation functions | ||
| 206 | |||
| 207 | ;; XEmacs compatibility | ||
| 208 | (defun find-menu-item (menubar item-path-list &optional parent) | ||
| 209 | "Searches MENUBAR for item given by ITEM-PATH-LIST. | ||
| 210 | Returns (ITEM . PARENT), where PARENT is the immediate parent of | ||
| 211 | the item found. | ||
| 212 | Signals an error if the item is not found." | ||
| 213 | (or parent (setq item-path-list (mapcar 'downcase item-path-list))) | ||
| 214 | (if (not (consp menubar)) | ||
| 215 | nil | ||
| 216 | (let ((rest menubar) | ||
| 217 | result) | ||
| 218 | (while rest | ||
| 219 | (if (and (car rest) | ||
| 220 | (equal (car item-path-list) | ||
| 221 | (downcase (if (vectorp (car rest)) | ||
| 222 | (aref (car rest) 0) | ||
| 223 | (if (stringp (car rest)) | ||
| 224 | (car rest) | ||
| 225 | (car (car rest))))))) | ||
| 226 | (setq result (car rest) rest nil) | ||
| 227 | (setq rest (cdr rest)))) | ||
| 228 | (if (cdr item-path-list) | ||
| 229 | (if (consp result) | ||
| 230 | (find-menu-item (cdr result) (cdr item-path-list) result) | ||
| 231 | (if result | ||
| 232 | (signal 'error (list "not a submenu" result)) | ||
| 233 | (signal 'error (list "no such submenu" (car item-path-list))))) | ||
| 234 | (cons result parent))))) | ||
| 235 | |||
| 236 | |||
| 237 | ;; XEmacs compatibility | ||
| 238 | (defun disable-menu-item (path) | ||
| 239 | "Make the named menu item be unselectable. | ||
| 240 | PATH is a list of strings which identify the position of the menu item in | ||
| 241 | the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | ||
| 242 | under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | ||
| 243 | menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." | ||
| 244 | (let* ((menubar current-menubar) | ||
| 245 | (pair (find-menu-item menubar path)) | ||
| 246 | (item (car pair)) | ||
| 247 | (menu (cdr pair))) | ||
| 248 | (or item | ||
| 249 | (signal 'error (list (if menu "No such menu item" "No such menu") | ||
| 250 | path))) | ||
| 251 | (if (consp item) (error "can't disable menus, only menu items")) | ||
| 252 | (aset item 2 nil) | ||
| 253 | (set-menubar-dirty-flag) | ||
| 254 | item)) | ||
| 255 | |||
| 256 | |||
| 257 | ;; XEmacs compatibility | ||
| 258 | (defun enable-menu-item (path) | ||
| 259 | "Make the named menu item be selectable. | ||
| 260 | PATH is a list of strings which identify the position of the menu item in | ||
| 261 | the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | ||
| 262 | under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | ||
| 263 | menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." | ||
| 264 | (let* ((menubar current-menubar) | ||
| 265 | (pair (find-menu-item menubar path)) | ||
| 266 | (item (car pair)) | ||
| 267 | (menu (cdr pair))) | ||
| 268 | (or item | ||
| 269 | (signal 'error (list (if menu "No such menu item" "No such menu") | ||
| 270 | path))) | ||
| 271 | (if (consp item) (error "%S is a menu, not a menu item" path)) | ||
| 272 | (aset item 2 t) | ||
| 273 | (set-menubar-dirty-flag) | ||
| 274 | item)) | ||
| 275 | |||
| 276 | |||
| 277 | (defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before) | ||
| 278 | (if before (setq before (downcase before))) | ||
| 279 | (let* ((menubar current-menubar) | ||
| 280 | (menu (condition-case () | ||
| 281 | (car (find-menu-item menubar menu-path)) | ||
| 282 | (error nil))) | ||
| 283 | (item (if (listp menu) | ||
| 284 | (car (find-menu-item (cdr menu) (list item-name))) | ||
| 285 | (signal 'error (list "not a submenu" menu-path))))) | ||
| 286 | (or menu | ||
| 287 | (let ((rest menu-path) | ||
| 288 | (so-far menubar)) | ||
| 289 | (while rest | ||
| 290 | ;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest))))) | ||
| 291 | (setq menu | ||
| 292 | (if (eq so-far menubar) | ||
| 293 | (car (find-menu-item so-far (list (car rest)))) | ||
| 294 | (car (find-menu-item (cdr so-far) (list (car rest)))))) | ||
| 295 | (or menu | ||
| 296 | (let ((rest2 so-far)) | ||
| 297 | (or rest2 | ||
| 298 | (error "Trying to modify a menu that doesn't exist")) | ||
| 299 | (while (and (cdr rest2) (car (cdr rest2))) | ||
| 300 | (setq rest2 (cdr rest2))) | ||
| 301 | (setcdr rest2 | ||
| 302 | (nconc (list (setq menu (list (car rest)))) | ||
| 303 | (cdr rest2))))) | ||
| 304 | (setq so-far menu) | ||
| 305 | (setq rest (cdr rest))))) | ||
| 306 | (or menu (setq menu menubar)) | ||
| 307 | (if item | ||
| 308 | nil ; it's already there | ||
| 309 | (if item-p | ||
| 310 | (setq item (vector item-name item-data enabled-p)) | ||
| 311 | (setq item (cons item-name item-data))) | ||
| 312 | ;; if BEFORE is specified, try to add it there. | ||
| 313 | (if before | ||
| 314 | (setq before (car (find-menu-item menu (list before))))) | ||
| 315 | (let ((rest menu) | ||
| 316 | (added-before nil)) | ||
| 317 | (while rest | ||
| 318 | (if (eq before (car (cdr rest))) | ||
| 319 | (progn | ||
| 320 | (setcdr rest (cons item (cdr rest))) | ||
| 321 | (setq rest nil added-before t)) | ||
| 322 | (setq rest (cdr rest)))) | ||
| 323 | (if (not added-before) | ||
| 324 | ;; adding before the first item on the menubar itself is harder | ||
| 325 | (if (and (eq menu menubar) (eq before (car menu))) | ||
| 326 | (setq menu (cons item menu) | ||
| 327 | current-menubar menu) | ||
| 328 | ;; otherwise, add the item to the end. | ||
| 329 | (nconc menu (list item)))))) | ||
| 330 | (if item-p | ||
| 331 | (progn | ||
| 332 | (aset item 1 item-data) | ||
| 333 | (aset item 2 (not (null enabled-p)))) | ||
| 334 | (setcar item item-name) | ||
| 335 | (setcdr item item-data)) | ||
| 336 | (set-menubar-dirty-flag) | ||
| 337 | item)) | ||
| 338 | |||
| 339 | ;; XEmacs compatibility | ||
| 340 | (defun add-menu-item (menu-path item-name function enabled-p &optional before) | ||
| 341 | "Add a menu item to some menu, creating the menu first if necessary. | ||
| 342 | If the named item exists already, it is changed. | ||
| 343 | MENU-PATH identifies the menu under which the new menu item should be inserted. | ||
| 344 | It is a list of strings; for example, (\"File\") names the top-level \"File\" | ||
| 345 | menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". | ||
| 346 | ITEM-NAME is the string naming the menu item to be added. | ||
| 347 | FUNCTION is the command to invoke when this menu item is selected. | ||
| 348 | If it is a symbol, then it is invoked with `call-interactively', in the same | ||
| 349 | way that functions bound to keys are invoked. If it is a list, then the | ||
| 350 | list is simply evaluated. | ||
| 351 | ENABLED-P controls whether the item is selectable or not. | ||
| 352 | BEFORE, if provided, is the name of a menu item before which this item should | ||
| 353 | be added, if this item is not on the menu already. If the item is already | ||
| 354 | present, it will not be moved." | ||
| 355 | (or menu-path (error "must specify a menu path")) | ||
| 356 | (or item-name (error "must specify an item name")) | ||
| 357 | (add-menu-item-1 t menu-path item-name function enabled-p before)) | ||
| 358 | |||
| 359 | |||
| 360 | ;; XEmacs compatibility | ||
| 361 | (defun delete-menu-item (path) | ||
| 362 | "Remove the named menu item from the menu hierarchy. | ||
| 363 | PATH is a list of strings which identify the position of the menu item in | ||
| 364 | the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | ||
| 365 | under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | ||
| 366 | menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." | ||
| 367 | (let* ((menubar current-menubar) | ||
| 368 | (pair (find-menu-item menubar path)) | ||
| 369 | (item (car pair)) | ||
| 370 | (menu (or (cdr pair) menubar))) | ||
| 371 | (if (not item) | ||
| 372 | nil | ||
| 373 | ;; the menubar is the only special case, because other menus begin | ||
| 374 | ;; with their name. | ||
| 375 | (if (eq menu current-menubar) | ||
| 376 | (setq current-menubar (delq item menu)) | ||
| 377 | (delq item menu)) | ||
| 378 | (set-menubar-dirty-flag) | ||
| 379 | item))) | ||
| 380 | |||
| 381 | |||
| 382 | ;; XEmacs compatibility | ||
| 383 | (defun relabel-menu-item (path new-name) | ||
| 384 | "Change the string of the specified menu item. | ||
| 385 | PATH is a list of strings which identify the position of the menu item in | ||
| 386 | the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | ||
| 387 | under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | ||
| 388 | menu item called \"Item\" under the \"Foo\" submenu of \"Menu\". | ||
| 389 | NEW-NAME is the string that the menu item will be printed as from now on." | ||
| 390 | (or (stringp new-name) | ||
| 391 | (setq new-name (signal 'wrong-type-argument (list 'stringp new-name)))) | ||
| 392 | (let* ((menubar current-menubar) | ||
| 393 | (pair (find-menu-item menubar path)) | ||
| 394 | (item (car pair)) | ||
| 395 | (menu (cdr pair))) | ||
| 396 | (or item | ||
| 397 | (signal 'error (list (if menu "No such menu item" "No such menu") | ||
| 398 | path))) | ||
| 399 | (if (and (consp item) | ||
| 400 | (stringp (car item))) | ||
| 401 | (setcar item new-name) | ||
| 402 | (aset item 0 new-name)) | ||
| 403 | (set-menubar-dirty-flag) | ||
| 404 | item)) | ||
| 405 | |||
| 406 | ;; XEmacs compatibility | ||
| 407 | (defun add-menu (menu-path menu-name menu-items &optional before) | ||
| 408 | "Add a menu to the menubar or one of its submenus. | ||
| 409 | If the named menu exists already, it is changed. | ||
| 410 | MENU-PATH identifies the menu under which the new menu should be inserted. | ||
| 411 | It is a list of strings; for example, (\"File\") names the top-level \"File\" | ||
| 412 | menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". | ||
| 413 | If MENU-PATH is nil, then the menu will be added to the menubar itself. | ||
| 414 | MENU-NAME is the string naming the menu to be added. | ||
| 415 | MENU-ITEMS is a list of menu item descriptions. | ||
| 416 | Each menu item should be a vector of three elements: | ||
| 417 | - a string, the name of the menu item; | ||
| 418 | - a symbol naming a command, or a form to evaluate; | ||
| 419 | - and a form whose value determines whether this item is selectable. | ||
| 420 | BEFORE, if provided, is the name of a menu before which this menu should | ||
| 421 | be added, if this menu is not on its parent already. If the menu is already | ||
| 422 | present, it will not be moved." | ||
| 423 | (or menu-name (error "must specify a menu name")) | ||
| 424 | (or menu-items (error "must specify some menu items")) | ||
| 425 | (add-menu-item-1 nil menu-path menu-name menu-items t before)) | ||
| 426 | |||
| 427 | |||
| 428 | |||
| 429 | (defvar put-buffer-names-in-file-menu t) | ||
| 430 | |||
| 431 | |||
| 432 | ;; Don't unconditionally enable menu bars; leave that up to the user. | ||
| 433 | ;;(let ((frames (frame-list))) | ||
| 434 | ;; (while frames | ||
| 435 | ;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1))) | ||
| 436 | ;; (setq frames (cdr frames)))) | ||
| 437 | ;;(or (assq 'menu-bar-lines default-frame-alist) | ||
| 438 | ;; (setq default-frame-alist | ||
| 439 | ;; (cons '(menu-bar-lines . 1) default-frame-alist))) | ||
| 440 | |||
| 441 | (set-menubar default-menubar) | ||
| 442 | |||
| 443 | (provide 'lmenu) | ||
| 444 | |||
| 445 | ;;; lmenu.el ends here | ||
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el deleted file mode 100644 index 817cc9cfaaa..00000000000 --- a/lisp/obsolete/lucid.el +++ /dev/null | |||
| @@ -1,211 +0,0 @@ | |||
| 1 | ;;; lucid.el --- emulate some Lucid Emacs functions | ||
| 2 | |||
| 3 | ;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: emacs-devel@gnu.org | ||
| 6 | ;; Keywords: emulations | ||
| 7 | ;; Obsolete-since: 23.2 | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | ;; XEmacs autoloads CL so we might as well make use of it. | ||
| 29 | (require 'cl) | ||
| 30 | |||
| 31 | (defalias 'current-time-seconds 'current-time) | ||
| 32 | |||
| 33 | (defun real-path-name (name &optional default) | ||
| 34 | (file-truename (expand-file-name name default))) | ||
| 35 | |||
| 36 | ;; It's not clear what to return if the mouse is not in FRAME. | ||
| 37 | (defun read-mouse-position (frame) | ||
| 38 | (let ((pos (mouse-position))) | ||
| 39 | (if (eq (car pos) frame) | ||
| 40 | (cdr pos)))) | ||
| 41 | |||
| 42 | (defun switch-to-other-buffer (arg) | ||
| 43 | "Switch to the previous buffer. | ||
| 44 | With a numeric arg N, switch to the Nth most recent buffer. | ||
| 45 | With an arg of 0, buries the current buffer at the | ||
| 46 | bottom of the buffer stack." | ||
| 47 | (interactive "p") | ||
| 48 | (if (eq arg 0) | ||
| 49 | (bury-buffer (current-buffer))) | ||
| 50 | (switch-to-buffer | ||
| 51 | (if (<= arg 1) (other-buffer (current-buffer)) | ||
| 52 | (nth arg | ||
| 53 | (apply 'nconc | ||
| 54 | (mapcar | ||
| 55 | (lambda (buf) | ||
| 56 | (if (= ?\ (string-to-char (buffer-name buf))) | ||
| 57 | nil | ||
| 58 | (list buf))) | ||
| 59 | (buffer-list))))))) | ||
| 60 | |||
| 61 | (defun device-class (&optional device) | ||
| 62 | "Return the class (color behavior) of DEVICE. | ||
| 63 | This will be one of `color', `grayscale', or `mono'. | ||
| 64 | This function exists for compatibility with XEmacs." | ||
| 65 | (cond | ||
| 66 | ((display-color-p device) 'color) | ||
| 67 | ((display-grayscale-p device) 'grayscale) | ||
| 68 | (t 'mono))) | ||
| 69 | |||
| 70 | (defalias 'find-face 'facep) | ||
| 71 | (defalias 'get-face 'facep) | ||
| 72 | ;; internal-try-face-font was removed from faces.el in rev 1.139, 1999/07/21. | ||
| 73 | ;;;(defalias 'try-face-font 'internal-try-face-font) | ||
| 74 | |||
| 75 | (defalias 'exec-to-string 'shell-command-to-string) | ||
| 76 | |||
| 77 | |||
| 78 | ;; Buffer context | ||
| 79 | |||
| 80 | (defun buffer-syntactic-context (&optional buffer) | ||
| 81 | "Syntactic context at point in BUFFER. | ||
| 82 | Either of `string', `comment' or nil. | ||
| 83 | This is an XEmacs compatibility function." | ||
| 84 | (with-current-buffer (or buffer (current-buffer)) | ||
| 85 | (let ((state (syntax-ppss (point)))) | ||
| 86 | (cond | ||
| 87 | ((nth 3 state) 'string) | ||
| 88 | ((nth 4 state) 'comment))))) | ||
| 89 | |||
| 90 | |||
| 91 | (defun buffer-syntactic-context-depth (&optional buffer) | ||
| 92 | "Syntactic parenthesis depth at point in BUFFER. | ||
| 93 | This is an XEmacs compatibility function." | ||
| 94 | (with-current-buffer (or buffer (current-buffer)) | ||
| 95 | (nth 0 (syntax-ppss (point))))) | ||
| 96 | |||
| 97 | |||
| 98 | ;; Extents | ||
| 99 | (defun make-extent (beg end &optional buffer) | ||
| 100 | (make-overlay beg end buffer)) | ||
| 101 | |||
| 102 | (defun extent-properties (extent) (overlay-properties extent)) | ||
| 103 | (unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get)) | ||
| 104 | |||
| 105 | (defun extent-at (pos &optional object property before) | ||
| 106 | (with-current-buffer (or object (current-buffer)) | ||
| 107 | (let ((overlays (overlays-at pos 'sorted))) | ||
| 108 | (when property | ||
| 109 | (let (filtered) | ||
| 110 | (while overlays | ||
| 111 | (if (overlay-get (car overlays) property) | ||
| 112 | (setq filtered (cons (car overlays) filtered))) | ||
| 113 | (setq overlays (cdr overlays))) | ||
| 114 | (setq overlays filtered))) | ||
| 115 | (if before | ||
| 116 | (nth 1 (memq before overlays)) | ||
| 117 | (car overlays))))) | ||
| 118 | |||
| 119 | (defun set-extent-property (extent prop value) | ||
| 120 | ;; Make sure that separate adjacent extents | ||
| 121 | ;; with the same mouse-face value | ||
| 122 | ;; do not run together as one extent. | ||
| 123 | (and (eq prop 'mouse-face) | ||
| 124 | (symbolp value) | ||
| 125 | (setq value (list value))) | ||
| 126 | (if (eq prop 'duplicable) | ||
| 127 | (cond ((and value (not (overlay-get extent prop))) | ||
| 128 | ;; If becoming duplicable, copy all overlayprops to text props. | ||
| 129 | (add-text-properties (overlay-start extent) | ||
| 130 | (overlay-end extent) | ||
| 131 | (overlay-properties extent) | ||
| 132 | (overlay-buffer extent))) | ||
| 133 | ;; If becoming no longer duplicable, remove these text props. | ||
| 134 | ((and (not value) (overlay-get extent prop)) | ||
| 135 | (remove-text-properties (overlay-start extent) | ||
| 136 | (overlay-end extent) | ||
| 137 | (overlay-properties extent) | ||
| 138 | (overlay-buffer extent)))) | ||
| 139 | ;; If extent is already duplicable, put this property | ||
| 140 | ;; on the text as well as on the overlay. | ||
| 141 | (if (overlay-get extent 'duplicable) | ||
| 142 | (put-text-property (overlay-start extent) | ||
| 143 | (overlay-end extent) | ||
| 144 | prop value (overlay-buffer extent)))) | ||
| 145 | (overlay-put extent prop value)) | ||
| 146 | |||
| 147 | (defun set-extent-face (extent face) | ||
| 148 | (set-extent-property extent 'face face)) | ||
| 149 | |||
| 150 | (defun set-extent-end-glyph (extent glyph) | ||
| 151 | (set-extent-property extent 'after-string glyph)) | ||
| 152 | |||
| 153 | (defun delete-extent (extent) | ||
| 154 | (set-extent-property extent 'duplicable nil) | ||
| 155 | (delete-overlay extent)) | ||
| 156 | |||
| 157 | ;; Support the Lucid names with `screen' instead of `frame'. | ||
| 158 | |||
| 159 | (defalias 'current-screen-configuration 'current-frame-configuration) | ||
| 160 | (defalias 'delete-screen 'delete-frame) | ||
| 161 | (defalias 'find-file-new-screen 'find-file-other-frame) | ||
| 162 | (defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame) | ||
| 163 | (defalias 'find-tag-new-screen 'find-tag-other-frame) | ||
| 164 | ;;(defalias 'focus-screen 'focus-frame) | ||
| 165 | (defalias 'iconify-screen 'iconify-frame) | ||
| 166 | (defalias 'mail-new-screen 'mail-other-frame) | ||
| 167 | (defalias 'make-screen-invisible 'make-frame-invisible) | ||
| 168 | (defalias 'make-screen-visible 'make-frame-visible) | ||
| 169 | ;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list) | ||
| 170 | (defalias 'modify-screen-parameters 'modify-frame-parameters) | ||
| 171 | (defalias 'next-screen 'next-frame) | ||
| 172 | ;; (defalias 'next-multiscreen-window 'next-multiframe-window) | ||
| 173 | ;; (defalias 'previous-multiscreen-window 'previous-multiframe-window) | ||
| 174 | ;; (defalias 'redirect-screen-focus 'redirect-frame-focus) | ||
| 175 | (defalias 'redraw-screen 'redraw-frame) | ||
| 176 | ;; (defalias 'screen-char-height 'frame-char-height) | ||
| 177 | ;; (defalias 'screen-char-width 'frame-char-width) | ||
| 178 | ;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register) | ||
| 179 | ;; (defalias 'screen-focus 'frame-focus) | ||
| 180 | (defalias 'screen-list 'frame-list) | ||
| 181 | ;; (defalias 'screen-live-p 'frame-live-p) | ||
| 182 | (defalias 'screen-parameters 'frame-parameters) | ||
| 183 | (defalias 'screen-pixel-height 'frame-pixel-height) | ||
| 184 | (defalias 'screen-pixel-width 'frame-pixel-width) | ||
| 185 | (defalias 'screen-root-window 'frame-root-window) | ||
| 186 | (defalias 'screen-selected-window 'frame-selected-window) | ||
| 187 | (defalias 'lower-screen 'lower-frame) | ||
| 188 | (defalias 'raise-screen 'raise-frame) | ||
| 189 | (defalias 'screen-visible-p 'frame-visible-p) | ||
| 190 | (defalias 'screenp 'framep) | ||
| 191 | (defalias 'select-screen 'select-frame) | ||
| 192 | (defalias 'selected-screen 'selected-frame) | ||
| 193 | ;; (defalias 'set-screen-configuration 'set-frame-configuration) | ||
| 194 | ;; (defalias 'set-screen-height 'set-frame-height) | ||
| 195 | (defalias 'set-screen-position 'set-frame-position) | ||
| 196 | (defalias 'set-screen-size 'set-frame-size) | ||
| 197 | ;; (defalias 'set-screen-width 'set-frame-width) | ||
| 198 | (defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame) | ||
| 199 | ;; (defalias 'unfocus-screen 'unfocus-frame) | ||
| 200 | (defalias 'visible-screen-list 'visible-frame-list) | ||
| 201 | (defalias 'window-screen 'window-frame) | ||
| 202 | (defalias 'x-create-screen 'x-create-frame) | ||
| 203 | (defalias 'x-new-screen 'make-frame) | ||
| 204 | |||
| 205 | (provide 'lucid) | ||
| 206 | |||
| 207 | ;; Local Variables: | ||
| 208 | ;; byte-compile-warnings: (not cl-functions) | ||
| 209 | ;; End: | ||
| 210 | |||
| 211 | ;;; lucid.el ends here | ||
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el deleted file mode 100644 index 2f46d7ddda5..00000000000 --- a/lisp/obsolete/old-whitespace.el +++ /dev/null | |||
| @@ -1,801 +0,0 @@ | |||
| 1 | ;;; whitespace.el --- warn about and clean bogus whitespaces in the file | ||
| 2 | |||
| 3 | ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Rajesh Vaidheeswarran <rv@gnu.org> | ||
| 6 | ;; Keywords: convenience | ||
| 7 | ;; Obsolete-since: 23.1 | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; URL: http://www.dsmit.com/lisp/ | ||
| 27 | ;; | ||
| 28 | ;; The whitespace library is intended to find and help fix five different types | ||
| 29 | ;; of whitespace problems that commonly exist in source code. | ||
| 30 | ;; | ||
| 31 | ;; 1. Leading space (empty lines at the top of a file). | ||
| 32 | ;; 2. Trailing space (empty lines at the end of a file). | ||
| 33 | ;; 3. Indentation space (8 or more spaces at beginning of line, that should be | ||
| 34 | ;; replaced with TABS). | ||
| 35 | ;; 4. Spaces followed by a TAB. (Almost always, we never want that). | ||
| 36 | ;; 5. Spaces or TABS at the end of a line. | ||
| 37 | ;; | ||
| 38 | ;; Whitespace errors are reported in a buffer, and on the mode line. | ||
| 39 | ;; | ||
| 40 | ;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace, | ||
| 41 | ;; where `x' and `y' can be one (or more) of: | ||
| 42 | ;; | ||
| 43 | ;; e - End-of-Line whitespace. | ||
| 44 | ;; i - Indentation whitespace. | ||
| 45 | ;; l - Leading whitespace. | ||
| 46 | ;; s - Space followed by Tab. | ||
| 47 | ;; t - Trailing whitespace. | ||
| 48 | ;; | ||
| 49 | ;; If any of the whitespace checks is turned off, the mode line will display a | ||
| 50 | ;; !<y>. | ||
| 51 | ;; | ||
| 52 | ;; (since (3) is the most controversial one, here is the rationale: Most | ||
| 53 | ;; terminal drivers and printer drivers have TAB configured or even | ||
| 54 | ;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost | ||
| 55 | ;; always they default to 8.) | ||
| 56 | ;; | ||
| 57 | ;; Changing `tab-width' to other than 8 and editing will cause your code to | ||
| 58 | ;; look different from within Emacs, and say, if you cat it or more it, or | ||
| 59 | ;; even print it. | ||
| 60 | ;; | ||
| 61 | ;; Almost all the popular programming modes let you define an offset (like | ||
| 62 | ;; c-basic-offset or perl-indent-level) to configure the offset, so you | ||
| 63 | ;; should never have to set your `tab-width' to be other than 8 in all | ||
| 64 | ;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause | ||
| 65 | ;; Emacs to replace your 8 spaces with one \t (try it). If vi users in | ||
| 66 | ;; your office complain, tell them to use vim, which distinguishes between | ||
| 67 | ;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them | ||
| 68 | ;; to set smarttab.) | ||
| 69 | ;; | ||
| 70 | ;; All the above have caused (and will cause) unwanted codeline integration and | ||
| 71 | ;; merge problems. | ||
| 72 | ;; | ||
| 73 | ;; whitespace.el will complain if it detects whitespaces on opening a file, and | ||
| 74 | ;; warn you on closing a file also (in case you had inserted any | ||
| 75 | ;; whitespaces during the process of your editing). | ||
| 76 | ;; | ||
| 77 | ;; Exported functions: | ||
| 78 | ;; | ||
| 79 | ;; `whitespace-buffer' - To check the current buffer for whitespace problems. | ||
| 80 | ;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer. | ||
| 81 | ;; `whitespace-region' - To check between point and mark for whitespace | ||
| 82 | ;; problems. | ||
| 83 | ;; `whitespace-cleanup-region' - To cleanup all whitespaces between point | ||
| 84 | ;; and mark in the current buffer. | ||
| 85 | |||
| 86 | ;;; Code: | ||
| 87 | |||
| 88 | (defvar whitespace-version "3.5" "Version of the whitespace library.") | ||
| 89 | |||
| 90 | (defvar whitespace-all-buffer-files nil | ||
| 91 | "An associated list of buffers and files checked for whitespace cleanliness. | ||
| 92 | |||
| 93 | This is to enable periodic checking of whitespace cleanliness in the files | ||
| 94 | visited by the buffers.") | ||
| 95 | |||
| 96 | (defvar whitespace-rescan-timer nil | ||
| 97 | "Timer object used to rescan the files in buffers that have been modified.") | ||
| 98 | |||
| 99 | ;; Tell Emacs about this new kind of minor mode | ||
| 100 | (defvar whitespace-mode nil | ||
| 101 | "Non-nil when Whitespace mode (a minor mode) is enabled.") | ||
| 102 | (make-variable-buffer-local 'whitespace-mode) | ||
| 103 | |||
| 104 | (defvar whitespace-mode-line nil | ||
| 105 | "String to display in the mode line for Whitespace mode.") | ||
| 106 | (make-variable-buffer-local 'whitespace-mode-line) | ||
| 107 | |||
| 108 | (defvar whitespace-check-buffer-leading nil | ||
| 109 | "Test leading whitespace for file in current buffer if t.") | ||
| 110 | (make-variable-buffer-local 'whitespace-check-buffer-leading) | ||
| 111 | ;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp) | ||
| 112 | |||
| 113 | (defvar whitespace-check-buffer-trailing nil | ||
| 114 | "Test trailing whitespace for file in current buffer if t.") | ||
| 115 | (make-variable-buffer-local 'whitespace-check-buffer-trailing) | ||
| 116 | ;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp) | ||
| 117 | |||
| 118 | (defvar whitespace-check-buffer-indent nil | ||
| 119 | "Test indentation whitespace for file in current buffer if t.") | ||
| 120 | (make-variable-buffer-local 'whitespace-check-buffer-indent) | ||
| 121 | ;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp) | ||
| 122 | |||
| 123 | (defvar whitespace-check-buffer-spacetab nil | ||
| 124 | "Test Space-followed-by-TABS whitespace for file in current buffer if t.") | ||
| 125 | (make-variable-buffer-local 'whitespace-check-buffer-spacetab) | ||
| 126 | ;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp) | ||
| 127 | |||
| 128 | (defvar whitespace-check-buffer-ateol nil | ||
| 129 | "Test end-of-line whitespace for file in current buffer if t.") | ||
| 130 | (make-variable-buffer-local 'whitespace-check-buffer-ateol) | ||
| 131 | ;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp) | ||
| 132 | |||
| 133 | (defvar whitespace-highlighted-space nil | ||
| 134 | "The variable to store the extent to highlight.") | ||
| 135 | (make-variable-buffer-local 'whitespace-highlighted-space) | ||
| 136 | |||
| 137 | (defalias 'whitespace-make-overlay | ||
| 138 | (if (featurep 'xemacs) 'make-extent 'make-overlay)) | ||
| 139 | (defalias 'whitespace-overlay-put | ||
| 140 | (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) | ||
| 141 | (defalias 'whitespace-delete-overlay | ||
| 142 | (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) | ||
| 143 | (defalias 'whitespace-overlay-start | ||
| 144 | (if (featurep 'xemacs) 'extent-start 'overlay-start)) | ||
| 145 | (defalias 'whitespace-overlay-end | ||
| 146 | (if (featurep 'xemacs) 'extent-end 'overlay-end)) | ||
| 147 | (defalias 'whitespace-mode-line-update | ||
| 148 | (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) | ||
| 149 | |||
| 150 | (defgroup whitespace nil | ||
| 151 | "Check for and fix five different types of whitespaces in source code." | ||
| 152 | :version "21.1" | ||
| 153 | :link '(emacs-commentary-link "whitespace.el") | ||
| 154 | ;; Since XEmacs doesn't have a 'convenience group, use the next best group | ||
| 155 | ;; which is 'editing? | ||
| 156 | :group (if (featurep 'xemacs) 'editing 'convenience)) | ||
| 157 | |||
| 158 | (defcustom whitespace-check-leading-whitespace t | ||
| 159 | "Flag to check leading whitespace. This is the global for the system. | ||
| 160 | It can be overridden by setting a buffer local variable | ||
| 161 | `whitespace-check-buffer-leading'." | ||
| 162 | :type 'boolean | ||
| 163 | :group 'whitespace) | ||
| 164 | |||
| 165 | (defcustom whitespace-check-trailing-whitespace t | ||
| 166 | "Flag to check trailing whitespace. This is the global for the system. | ||
| 167 | It can be overridden by setting a buffer local variable | ||
| 168 | `whitespace-check-buffer-trailing'." | ||
| 169 | :type 'boolean | ||
| 170 | :group 'whitespace) | ||
| 171 | |||
| 172 | (defcustom whitespace-check-spacetab-whitespace t | ||
| 173 | "Flag to check space followed by a TAB. This is the global for the system. | ||
| 174 | It can be overridden by setting a buffer local variable | ||
| 175 | `whitespace-check-buffer-spacetab'." | ||
| 176 | :type 'boolean | ||
| 177 | :group 'whitespace) | ||
| 178 | |||
| 179 | (defcustom whitespace-spacetab-regexp "[ ]+\t" | ||
| 180 | "Regexp to match one or more spaces followed by a TAB." | ||
| 181 | :type 'regexp | ||
| 182 | :group 'whitespace) | ||
| 183 | |||
| 184 | (defcustom whitespace-check-indent-whitespace indent-tabs-mode | ||
| 185 | "Flag to check indentation whitespace. This is the global for the system. | ||
| 186 | It can be overridden by setting a buffer local variable | ||
| 187 | `whitespace-check-buffer-indent'." | ||
| 188 | :type 'boolean | ||
| 189 | :group 'whitespace) | ||
| 190 | |||
| 191 | (defcustom whitespace-indent-regexp "^\t*\\( \\)+" | ||
| 192 | "Regexp to match multiples of eight spaces near line beginnings. | ||
| 193 | The default value ignores leading TABs." | ||
| 194 | :type 'regexp | ||
| 195 | :group 'whitespace) | ||
| 196 | |||
| 197 | (defcustom whitespace-check-ateol-whitespace t | ||
| 198 | "Flag to check end-of-line whitespace. This is the global for the system. | ||
| 199 | It can be overridden by setting a buffer local variable | ||
| 200 | `whitespace-check-buffer-ateol'." | ||
| 201 | :type 'boolean | ||
| 202 | :group 'whitespace) | ||
| 203 | |||
| 204 | (defcustom whitespace-ateol-regexp "[ \t]+$" | ||
| 205 | "Regexp to match one or more TABs or spaces at line ends." | ||
| 206 | :type 'regexp | ||
| 207 | :group 'whitespace) | ||
| 208 | |||
| 209 | (defcustom whitespace-errbuf "*Whitespace Errors*" | ||
| 210 | "The name of the buffer where whitespace related messages will be logged." | ||
| 211 | :type 'string | ||
| 212 | :group 'whitespace) | ||
| 213 | |||
| 214 | (defcustom whitespace-clean-msg "clean." | ||
| 215 | "If non-nil, this message will be displayed after a whitespace check | ||
| 216 | determines a file to be clean." | ||
| 217 | :type 'string | ||
| 218 | :group 'whitespace) | ||
| 219 | |||
| 220 | (defcustom whitespace-abort-on-error nil | ||
| 221 | "While writing a file, abort if the file is unclean. | ||
| 222 | If `whitespace-auto-cleanup' is set, that takes precedence over | ||
| 223 | this variable." | ||
| 224 | :type 'boolean | ||
| 225 | :group 'whitespace) | ||
| 226 | |||
| 227 | (defcustom whitespace-auto-cleanup nil | ||
| 228 | "Cleanup a buffer automatically on finding it whitespace unclean." | ||
| 229 | :type 'boolean | ||
| 230 | :group 'whitespace) | ||
| 231 | |||
| 232 | (defcustom whitespace-silent nil | ||
| 233 | "All whitespace errors will be shown only in the mode line when t. | ||
| 234 | |||
| 235 | Note that setting this may cause all whitespaces introduced in a file to go | ||
| 236 | unnoticed when the buffer is killed, unless the user visits the `*Whitespace | ||
| 237 | Errors*' buffer before opening (or closing) another file." | ||
| 238 | :type 'boolean | ||
| 239 | :group 'whitespace) | ||
| 240 | |||
| 241 | (defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode | ||
| 242 | c-mode c++-mode cc-mode | ||
| 243 | change-log-mode cperl-mode | ||
| 244 | electric-nroff-mode emacs-lisp-mode | ||
| 245 | f90-mode fortran-mode html-mode | ||
| 246 | html3-mode java-mode jde-mode | ||
| 247 | ksh-mode latex-mode LaTeX-mode | ||
| 248 | lisp-mode m4-mode makefile-mode | ||
| 249 | modula-2-mode nroff-mode objc-mode | ||
| 250 | pascal-mode perl-mode prolog-mode | ||
| 251 | python-mode scheme-mode sgml-mode | ||
| 252 | sh-mode shell-script-mode simula-mode | ||
| 253 | tcl-mode tex-mode texinfo-mode | ||
| 254 | vrml-mode xml-mode) | ||
| 255 | |||
| 256 | "Major modes in which we turn on whitespace checking. | ||
| 257 | |||
| 258 | These are mostly programming and documentation modes. But you may add other | ||
| 259 | modes that you want whitespaces checked in by adding something like the | ||
| 260 | following to your `.emacs': | ||
| 261 | |||
| 262 | \(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode | ||
| 263 | whitespace-modes))\) | ||
| 264 | |||
| 265 | Or, alternately, you can use the Emacs `customize' command to set this." | ||
| 266 | :type '(repeat symbol) | ||
| 267 | :group 'whitespace) | ||
| 268 | |||
| 269 | (defcustom whitespace-rescan-timer-time 600 | ||
| 270 | "Period in seconds to rescan modified buffers for whitespace creep. | ||
| 271 | |||
| 272 | This is the period after which the timer will fire causing | ||
| 273 | `whitespace-rescan-files-in-buffers' to check for whitespace creep in | ||
| 274 | modified buffers. | ||
| 275 | |||
| 276 | To disable timer scans, set this to zero." | ||
| 277 | :type 'integer | ||
| 278 | :group 'whitespace) | ||
| 279 | |||
| 280 | (defcustom whitespace-display-in-modeline t | ||
| 281 | "Display whitespace errors on the modeline." | ||
| 282 | :type 'boolean | ||
| 283 | :group 'whitespace) | ||
| 284 | |||
| 285 | (defcustom whitespace-display-spaces-in-color t | ||
| 286 | "Display the bogus whitespaces by coloring them with the face | ||
| 287 | `whitespace-highlight'." | ||
| 288 | :type 'boolean | ||
| 289 | :group 'whitespace) | ||
| 290 | |||
| 291 | (defface whitespace-highlight '((((class color) (background light)) | ||
| 292 | (:background "green1")) | ||
| 293 | (((class color) (background dark)) | ||
| 294 | (:background "sea green")) | ||
| 295 | (((class grayscale mono) | ||
| 296 | (background light)) | ||
| 297 | (:background "black")) | ||
| 298 | (((class grayscale mono) | ||
| 299 | (background dark)) | ||
| 300 | (:background "white"))) | ||
| 301 | "Face used for highlighting the bogus whitespaces that exist in the buffer." | ||
| 302 | :group 'whitespace) | ||
| 303 | |||
| 304 | (if (not (assoc 'whitespace-mode minor-mode-alist)) | ||
| 305 | (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) | ||
| 306 | minor-mode-alist))) | ||
| 307 | |||
| 308 | (set-default 'whitespace-check-buffer-leading | ||
| 309 | whitespace-check-leading-whitespace) | ||
| 310 | (set-default 'whitespace-check-buffer-trailing | ||
| 311 | whitespace-check-trailing-whitespace) | ||
| 312 | (set-default 'whitespace-check-buffer-indent | ||
| 313 | whitespace-check-indent-whitespace) | ||
| 314 | (set-default 'whitespace-check-buffer-spacetab | ||
| 315 | whitespace-check-spacetab-whitespace) | ||
| 316 | (set-default 'whitespace-check-buffer-ateol | ||
| 317 | whitespace-check-ateol-whitespace) | ||
| 318 | |||
| 319 | (defun whitespace-check-whitespace-mode (&optional arg) | ||
| 320 | "Test and set the whitespace-mode in qualifying buffers." | ||
| 321 | (if (null whitespace-mode) | ||
| 322 | (setq whitespace-mode | ||
| 323 | (if (or arg (member major-mode whitespace-modes)) | ||
| 324 | t | ||
| 325 | nil)))) | ||
| 326 | |||
| 327 | ;;;###autoload | ||
| 328 | (defun whitespace-toggle-leading-check () | ||
| 329 | "Toggle the check for leading space in the local buffer." | ||
| 330 | (interactive) | ||
| 331 | (let ((current-val whitespace-check-buffer-leading)) | ||
| 332 | (setq whitespace-check-buffer-leading (not current-val)) | ||
| 333 | (message "Will%s check for leading space in buffer." | ||
| 334 | (if whitespace-check-buffer-leading "" " not")) | ||
| 335 | (if whitespace-check-buffer-leading (whitespace-buffer-leading)))) | ||
| 336 | |||
| 337 | ;;;###autoload | ||
| 338 | (defun whitespace-toggle-trailing-check () | ||
| 339 | "Toggle the check for trailing space in the local buffer." | ||
| 340 | (interactive) | ||
| 341 | (let ((current-val whitespace-check-buffer-trailing)) | ||
| 342 | (setq whitespace-check-buffer-trailing (not current-val)) | ||
| 343 | (message "Will%s check for trailing space in buffer." | ||
| 344 | (if whitespace-check-buffer-trailing "" " not")) | ||
| 345 | (if whitespace-check-buffer-trailing (whitespace-buffer-trailing)))) | ||
| 346 | |||
| 347 | ;;;###autoload | ||
| 348 | (defun whitespace-toggle-indent-check () | ||
| 349 | "Toggle the check for indentation space in the local buffer." | ||
| 350 | (interactive) | ||
| 351 | (let ((current-val whitespace-check-buffer-indent)) | ||
| 352 | (setq whitespace-check-buffer-indent (not current-val)) | ||
| 353 | (message "Will%s check for indentation space in buffer." | ||
| 354 | (if whitespace-check-buffer-indent "" " not")) | ||
| 355 | (if whitespace-check-buffer-indent | ||
| 356 | (whitespace-buffer-search whitespace-indent-regexp)))) | ||
| 357 | |||
| 358 | ;;;###autoload | ||
| 359 | (defun whitespace-toggle-spacetab-check () | ||
| 360 | "Toggle the check for space-followed-by-TABs in the local buffer." | ||
| 361 | (interactive) | ||
| 362 | (let ((current-val whitespace-check-buffer-spacetab)) | ||
| 363 | (setq whitespace-check-buffer-spacetab (not current-val)) | ||
| 364 | (message "Will%s check for space-followed-by-TABs in buffer." | ||
| 365 | (if whitespace-check-buffer-spacetab "" " not")) | ||
| 366 | (if whitespace-check-buffer-spacetab | ||
| 367 | (whitespace-buffer-search whitespace-spacetab-regexp)))) | ||
| 368 | |||
| 369 | |||
| 370 | ;;;###autoload | ||
| 371 | (defun whitespace-toggle-ateol-check () | ||
| 372 | "Toggle the check for end-of-line space in the local buffer." | ||
| 373 | (interactive) | ||
| 374 | (let ((current-val whitespace-check-buffer-ateol)) | ||
| 375 | (setq whitespace-check-buffer-ateol (not current-val)) | ||
| 376 | (message "Will%s check for end-of-line space in buffer." | ||
| 377 | (if whitespace-check-buffer-ateol "" " not")) | ||
| 378 | (if whitespace-check-buffer-ateol | ||
| 379 | (whitespace-buffer-search whitespace-ateol-regexp)))) | ||
| 380 | |||
| 381 | |||
| 382 | ;;;###autoload | ||
| 383 | (defun whitespace-buffer (&optional quiet) | ||
| 384 | "Find five different types of white spaces in buffer. | ||
| 385 | These are: | ||
| 386 | 1. Leading space \(empty lines at the top of a file). | ||
| 387 | 2. Trailing space \(empty lines at the end of a file). | ||
| 388 | 3. Indentation space \(8 or more spaces, that should be replaced with TABS). | ||
| 389 | 4. Spaces followed by a TAB. \(Almost always, we never want that). | ||
| 390 | 5. Spaces or TABS at the end of a line. | ||
| 391 | |||
| 392 | Check for whitespace only if this buffer really contains a non-empty file | ||
| 393 | and: | ||
| 394 | 1. the major mode is one of the whitespace-modes, or | ||
| 395 | 2. `whitespace-buffer' was explicitly called with a prefix argument." | ||
| 396 | (interactive) | ||
| 397 | (let ((whitespace-error nil)) | ||
| 398 | (whitespace-check-whitespace-mode current-prefix-arg) | ||
| 399 | (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode) | ||
| 400 | (progn | ||
| 401 | (whitespace-check-buffer-list (buffer-name) buffer-file-name) | ||
| 402 | (whitespace-tickle-timer) | ||
| 403 | (overlay-recenter (point-max)) | ||
| 404 | (remove-overlays nil nil 'face 'whitespace-highlight) | ||
| 405 | (if whitespace-auto-cleanup | ||
| 406 | (if buffer-read-only | ||
| 407 | (if (not quiet) | ||
| 408 | (message "Can't cleanup: %s is read-only" (buffer-name))) | ||
| 409 | (whitespace-cleanup-internal)) | ||
| 410 | (let ((whitespace-leading (if whitespace-check-buffer-leading | ||
| 411 | (whitespace-buffer-leading) | ||
| 412 | nil)) | ||
| 413 | (whitespace-trailing (if whitespace-check-buffer-trailing | ||
| 414 | (whitespace-buffer-trailing) | ||
| 415 | nil)) | ||
| 416 | (whitespace-indent (if whitespace-check-buffer-indent | ||
| 417 | (whitespace-buffer-search | ||
| 418 | whitespace-indent-regexp) | ||
| 419 | nil)) | ||
| 420 | (whitespace-spacetab (if whitespace-check-buffer-spacetab | ||
| 421 | (whitespace-buffer-search | ||
| 422 | whitespace-spacetab-regexp) | ||
| 423 | nil)) | ||
| 424 | (whitespace-ateol (if whitespace-check-buffer-ateol | ||
| 425 | (whitespace-buffer-search | ||
| 426 | whitespace-ateol-regexp) | ||
| 427 | nil)) | ||
| 428 | (whitespace-errmsg nil) | ||
| 429 | (whitespace-filename buffer-file-name) | ||
| 430 | (whitespace-this-modeline "")) | ||
| 431 | |||
| 432 | ;; Now let's complain if we found any of the above. | ||
| 433 | (setq whitespace-error (or whitespace-leading whitespace-indent | ||
| 434 | whitespace-spacetab whitespace-ateol | ||
| 435 | whitespace-trailing)) | ||
| 436 | |||
| 437 | (if whitespace-error | ||
| 438 | (progn | ||
| 439 | (setq whitespace-errmsg | ||
| 440 | (concat whitespace-filename " contains:\n" | ||
| 441 | (if whitespace-leading | ||
| 442 | "Leading whitespace\n") | ||
| 443 | (if whitespace-indent | ||
| 444 | (concat "Indentation whitespace" | ||
| 445 | whitespace-indent "\n")) | ||
| 446 | (if whitespace-spacetab | ||
| 447 | (concat "Space followed by Tab" | ||
| 448 | whitespace-spacetab "\n")) | ||
| 449 | (if whitespace-ateol | ||
| 450 | (concat "End-of-line whitespace" | ||
| 451 | whitespace-ateol "\n")) | ||
| 452 | (if whitespace-trailing | ||
| 453 | "Trailing whitespace\n") | ||
| 454 | "\ntype `M-x whitespace-cleanup' to " | ||
| 455 | "cleanup the file.")) | ||
| 456 | (setq whitespace-this-modeline | ||
| 457 | (concat (if whitespace-ateol "e") | ||
| 458 | (if whitespace-indent "i") | ||
| 459 | (if whitespace-leading "l") | ||
| 460 | (if whitespace-spacetab "s") | ||
| 461 | (if whitespace-trailing "t"))))) | ||
| 462 | (whitespace-update-modeline whitespace-this-modeline) | ||
| 463 | (if (get-buffer whitespace-errbuf) | ||
| 464 | (kill-buffer whitespace-errbuf)) | ||
| 465 | (with-current-buffer (get-buffer-create whitespace-errbuf) | ||
| 466 | (if whitespace-errmsg | ||
| 467 | (progn | ||
| 468 | (insert whitespace-errmsg) | ||
| 469 | (if (not (or quiet whitespace-silent)) | ||
| 470 | (display-buffer (current-buffer) t)) | ||
| 471 | (if (not quiet) | ||
| 472 | (message "Whitespaces: [%s%s] in %s" | ||
| 473 | whitespace-this-modeline | ||
| 474 | (let ((whitespace-unchecked | ||
| 475 | (whitespace-unchecked-whitespaces))) | ||
| 476 | (if whitespace-unchecked | ||
| 477 | (concat "!" whitespace-unchecked) | ||
| 478 | "")) | ||
| 479 | whitespace-filename))) | ||
| 480 | (if (and (not quiet) (not (equal whitespace-clean-msg ""))) | ||
| 481 | (message "%s %s" whitespace-filename | ||
| 482 | whitespace-clean-msg)))))))) | ||
| 483 | whitespace-error)) | ||
| 484 | |||
| 485 | ;;;###autoload | ||
| 486 | (defun whitespace-region (s e) | ||
| 487 | "Check the region for whitespace errors." | ||
| 488 | (interactive "r") | ||
| 489 | (save-excursion | ||
| 490 | (save-restriction | ||
| 491 | (narrow-to-region s e) | ||
| 492 | (whitespace-buffer)))) | ||
| 493 | |||
| 494 | ;;;###autoload | ||
| 495 | (defun whitespace-cleanup () | ||
| 496 | "Cleanup the five different kinds of whitespace problems. | ||
| 497 | It normally applies to the whole buffer, but in Transient Mark mode | ||
| 498 | when the mark is active it applies to the region. | ||
| 499 | See `whitespace-buffer' docstring for a summary of the problems." | ||
| 500 | (interactive) | ||
| 501 | (if (and transient-mark-mode mark-active) | ||
| 502 | (whitespace-cleanup-region (region-beginning) (region-end)) | ||
| 503 | (whitespace-cleanup-internal))) | ||
| 504 | |||
| 505 | (defun whitespace-cleanup-internal (&optional region-only) | ||
| 506 | ;; If this buffer really contains a file, then run, else quit. | ||
| 507 | (whitespace-check-whitespace-mode current-prefix-arg) | ||
| 508 | (if (and buffer-file-name whitespace-mode) | ||
| 509 | (let ((whitespace-any nil) | ||
| 510 | (whitespace-tabwidth 8) | ||
| 511 | (whitespace-tabwidth-saved tab-width)) | ||
| 512 | |||
| 513 | ;; since all printable TABS should be 8, irrespective of how | ||
| 514 | ;; they are displayed. | ||
| 515 | (setq tab-width whitespace-tabwidth) | ||
| 516 | |||
| 517 | (if (and whitespace-check-buffer-leading | ||
| 518 | (whitespace-buffer-leading)) | ||
| 519 | (progn | ||
| 520 | (whitespace-buffer-leading-cleanup) | ||
| 521 | (setq whitespace-any t))) | ||
| 522 | |||
| 523 | (if (and whitespace-check-buffer-trailing | ||
| 524 | (whitespace-buffer-trailing)) | ||
| 525 | (progn | ||
| 526 | (whitespace-buffer-trailing-cleanup) | ||
| 527 | (setq whitespace-any t))) | ||
| 528 | |||
| 529 | (if (and whitespace-check-buffer-indent | ||
| 530 | (whitespace-buffer-search whitespace-indent-regexp)) | ||
| 531 | (progn | ||
| 532 | (whitespace-indent-cleanup) | ||
| 533 | (setq whitespace-any t))) | ||
| 534 | |||
| 535 | (if (and whitespace-check-buffer-spacetab | ||
| 536 | (whitespace-buffer-search whitespace-spacetab-regexp)) | ||
| 537 | (progn | ||
| 538 | (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t") | ||
| 539 | (setq whitespace-any t))) | ||
| 540 | |||
| 541 | (if (and whitespace-check-buffer-ateol | ||
| 542 | (whitespace-buffer-search whitespace-ateol-regexp)) | ||
| 543 | (progn | ||
| 544 | (whitespace-buffer-cleanup whitespace-ateol-regexp "") | ||
| 545 | (setq whitespace-any t))) | ||
| 546 | |||
| 547 | ;; Call this recursively till everything is taken care of | ||
| 548 | (if whitespace-any | ||
| 549 | (whitespace-cleanup-internal region-only) | ||
| 550 | ;; if we are done, talk to the user | ||
| 551 | (progn | ||
| 552 | (unless whitespace-silent | ||
| 553 | (if region-only | ||
| 554 | (message "The region is now clean") | ||
| 555 | (message "%s is now clean" buffer-file-name))) | ||
| 556 | (whitespace-update-modeline))) | ||
| 557 | (setq tab-width whitespace-tabwidth-saved)))) | ||
| 558 | |||
| 559 | ;;;###autoload | ||
| 560 | (defun whitespace-cleanup-region (s e) | ||
| 561 | "Whitespace cleanup on the region." | ||
| 562 | (interactive "r") | ||
| 563 | (save-excursion | ||
| 564 | (save-restriction | ||
| 565 | (narrow-to-region s e) | ||
| 566 | (whitespace-cleanup-internal t)) | ||
| 567 | (whitespace-buffer t))) | ||
| 568 | |||
| 569 | (defun whitespace-buffer-leading () | ||
| 570 | "Return t if the current buffer has leading newline characters. | ||
| 571 | If highlighting is enabled, highlight these characters." | ||
| 572 | (save-excursion | ||
| 573 | (goto-char (point-min)) | ||
| 574 | (skip-chars-forward "\n") | ||
| 575 | (unless (bobp) | ||
| 576 | (whitespace-highlight-the-space (point-min) (point)) | ||
| 577 | t))) | ||
| 578 | |||
| 579 | (defun whitespace-buffer-leading-cleanup () | ||
| 580 | "Remove any leading newline characters from current buffer." | ||
| 581 | (save-excursion | ||
| 582 | (goto-char (point-min)) | ||
| 583 | (skip-chars-forward "\n") | ||
| 584 | (delete-region (point-min) (point)))) | ||
| 585 | |||
| 586 | (defun whitespace-buffer-trailing () | ||
| 587 | "Return t if the current buffer has extra trailing newline characters. | ||
| 588 | If highlighting is enabled, highlight these characters." | ||
| 589 | (save-excursion | ||
| 590 | (goto-char (point-max)) | ||
| 591 | (skip-chars-backward "\n") | ||
| 592 | (forward-line) | ||
| 593 | (unless (eobp) | ||
| 594 | (whitespace-highlight-the-space (point) (point-max)) | ||
| 595 | t))) | ||
| 596 | |||
| 597 | (defun whitespace-buffer-trailing-cleanup () | ||
| 598 | "Remove extra trailing newline characters from current buffer." | ||
| 599 | (save-excursion | ||
| 600 | (goto-char (point-max)) | ||
| 601 | (skip-chars-backward "\n") | ||
| 602 | (unless (eobp) | ||
| 603 | (forward-line) | ||
| 604 | (delete-region (point) (point-max))))) | ||
| 605 | |||
| 606 | (defun whitespace-buffer-search (regexp) | ||
| 607 | "Search for any given whitespace REGEXP." | ||
| 608 | (with-local-quit | ||
| 609 | (let (whitespace-retval) | ||
| 610 | (save-excursion | ||
| 611 | (goto-char (point-min)) | ||
| 612 | (while (re-search-forward regexp nil t) | ||
| 613 | (whitespace-highlight-the-space (match-beginning 0) (match-end 0)) | ||
| 614 | (push (match-beginning 0) whitespace-retval))) | ||
| 615 | (when whitespace-retval | ||
| 616 | (format " %s" (nreverse whitespace-retval)))))) | ||
| 617 | |||
| 618 | (defun whitespace-buffer-cleanup (regexp newregexp) | ||
| 619 | "Search for any given whitespace REGEXP and replace it with the NEWREGEXP." | ||
| 620 | (save-excursion | ||
| 621 | (goto-char (point-min)) | ||
| 622 | (while (re-search-forward regexp nil t) | ||
| 623 | (replace-match newregexp)))) | ||
| 624 | |||
| 625 | (defun whitespace-indent-cleanup () | ||
| 626 | "Search for 8/more spaces at the start of a line and replace it with tabs." | ||
| 627 | (save-excursion | ||
| 628 | (goto-char (point-min)) | ||
| 629 | (while (re-search-forward whitespace-indent-regexp nil t) | ||
| 630 | (let ((column (current-column)) | ||
| 631 | (indent-tabs-mode t)) | ||
| 632 | (delete-region (match-beginning 0) (point)) | ||
| 633 | (indent-to column))))) | ||
| 634 | |||
| 635 | (defun whitespace-unchecked-whitespaces () | ||
| 636 | "Return the list of whitespaces whose testing has been suppressed." | ||
| 637 | (let ((unchecked-spaces | ||
| 638 | (concat (if (not whitespace-check-buffer-ateol) "e") | ||
| 639 | (if (not whitespace-check-buffer-indent) "i") | ||
| 640 | (if (not whitespace-check-buffer-leading) "l") | ||
| 641 | (if (not whitespace-check-buffer-spacetab) "s") | ||
| 642 | (if (not whitespace-check-buffer-trailing) "t")))) | ||
| 643 | (if (not (equal unchecked-spaces "")) | ||
| 644 | unchecked-spaces | ||
| 645 | nil))) | ||
| 646 | |||
| 647 | (defun whitespace-update-modeline (&optional whitespace-err) | ||
| 648 | "Update mode line with whitespace errors. | ||
| 649 | Also with whitespaces whose testing has been turned off." | ||
| 650 | (if whitespace-display-in-modeline | ||
| 651 | (progn | ||
| 652 | (setq whitespace-mode-line nil) | ||
| 653 | ;; Whitespace errors | ||
| 654 | (if (and whitespace-err (not (equal whitespace-err ""))) | ||
| 655 | (setq whitespace-mode-line whitespace-err)) | ||
| 656 | ;; Whitespace suppressed errors | ||
| 657 | (let ((whitespace-unchecked (whitespace-unchecked-whitespaces))) | ||
| 658 | (if whitespace-unchecked | ||
| 659 | (setq whitespace-mode-line | ||
| 660 | (concat whitespace-mode-line "!" whitespace-unchecked)))) | ||
| 661 | ;; Add the whitespace modeline prefix | ||
| 662 | (setq whitespace-mode-line (if whitespace-mode-line | ||
| 663 | (concat " W:" whitespace-mode-line) | ||
| 664 | nil)) | ||
| 665 | (whitespace-mode-line-update)))) | ||
| 666 | |||
| 667 | (defun whitespace-highlight-the-space (b e) | ||
| 668 | "Highlight the current line, unhighlighting a previously jumped to line." | ||
| 669 | (if whitespace-display-spaces-in-color | ||
| 670 | (let ((ol (whitespace-make-overlay b e))) | ||
| 671 | (whitespace-overlay-put ol 'face 'whitespace-highlight)))) | ||
| 672 | |||
| 673 | (defun whitespace-unhighlight-the-space() | ||
| 674 | "Unhighlight the currently highlight line." | ||
| 675 | (if (and whitespace-display-spaces-in-color whitespace-highlighted-space) | ||
| 676 | (progn | ||
| 677 | (mapc 'whitespace-delete-overlay whitespace-highlighted-space) | ||
| 678 | (setq whitespace-highlighted-space nil)))) | ||
| 679 | |||
| 680 | (defun whitespace-check-buffer-list (buf-name buf-file) | ||
| 681 | "Add a buffer and its file to the whitespace monitor list. | ||
| 682 | |||
| 683 | The buffer named BUF-NAME and its associated file BUF-FILE are now monitored | ||
| 684 | periodically for whitespace." | ||
| 685 | (if (and whitespace-mode (not (member (list buf-file buf-name) | ||
| 686 | whitespace-all-buffer-files))) | ||
| 687 | (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name)))) | ||
| 688 | |||
| 689 | (defun whitespace-tickle-timer () | ||
| 690 | "Tickle timer to periodically to scan qualifying files for whitespace creep. | ||
| 691 | |||
| 692 | If timer is not set, then set it to scan the files in | ||
| 693 | `whitespace-all-buffer-files' periodically (defined by | ||
| 694 | `whitespace-rescan-timer-time') for whitespace creep." | ||
| 695 | (if (and whitespace-rescan-timer-time | ||
| 696 | (/= whitespace-rescan-timer-time 0) | ||
| 697 | (not whitespace-rescan-timer)) | ||
| 698 | (setq whitespace-rescan-timer | ||
| 699 | (add-timeout whitespace-rescan-timer-time | ||
| 700 | 'whitespace-rescan-files-in-buffers nil | ||
| 701 | whitespace-rescan-timer-time)))) | ||
| 702 | |||
| 703 | (defun whitespace-rescan-files-in-buffers (&optional arg) | ||
| 704 | "Check monitored files for whitespace creep since last scan." | ||
| 705 | (let ((whitespace-all-my-files whitespace-all-buffer-files) | ||
| 706 | buffile bufname thiselt buf) | ||
| 707 | (if (not whitespace-all-my-files) | ||
| 708 | (progn | ||
| 709 | (disable-timeout whitespace-rescan-timer) | ||
| 710 | (setq whitespace-rescan-timer nil)) | ||
| 711 | (while whitespace-all-my-files | ||
| 712 | (setq thiselt (car whitespace-all-my-files)) | ||
| 713 | (setq whitespace-all-my-files (cdr whitespace-all-my-files)) | ||
| 714 | (setq buffile (car thiselt)) | ||
| 715 | (setq bufname (cadr thiselt)) | ||
| 716 | (setq buf (get-buffer bufname)) | ||
| 717 | (if (buffer-live-p buf) | ||
| 718 | (with-current-buffer bufname | ||
| 719 | ;;(message "buffer %s live" bufname) | ||
| 720 | (if whitespace-mode | ||
| 721 | (progn | ||
| 722 | ;;(message "checking for whitespace in %s" bufname) | ||
| 723 | (if whitespace-auto-cleanup | ||
| 724 | (progn | ||
| 725 | ;;(message "cleaning up whitespace in %s" bufname) | ||
| 726 | (whitespace-cleanup-internal)) | ||
| 727 | (progn | ||
| 728 | ;;(message "whitespace-buffer %s." (buffer-name)) | ||
| 729 | (whitespace-buffer t)))) | ||
| 730 | ;;(message "Removing %s from refresh list" bufname) | ||
| 731 | (whitespace-refresh-rescan-list buffile bufname))) | ||
| 732 | ;;(message "Removing %s from refresh list" bufname) | ||
| 733 | (whitespace-refresh-rescan-list buffile bufname)))))) | ||
| 734 | |||
| 735 | (defun whitespace-refresh-rescan-list (buffile bufname) | ||
| 736 | "Refresh the list of files to be rescanned for whitespace creep." | ||
| 737 | (if whitespace-all-buffer-files | ||
| 738 | (setq whitespace-all-buffer-files | ||
| 739 | (delete (list buffile bufname) whitespace-all-buffer-files)) | ||
| 740 | (when whitespace-rescan-timer | ||
| 741 | (disable-timeout whitespace-rescan-timer) | ||
| 742 | (setq whitespace-rescan-timer nil)))) | ||
| 743 | |||
| 744 | ;;;###autoload | ||
| 745 | (defalias 'global-whitespace-mode 'whitespace-global-mode) | ||
| 746 | |||
| 747 | ;;;###autoload | ||
| 748 | (define-minor-mode whitespace-global-mode | ||
| 749 | "Toggle using Whitespace mode in new buffers. | ||
| 750 | |||
| 751 | When this mode is active, `whitespace-buffer' is added to | ||
| 752 | `find-file-hook' and `kill-buffer-hook'." | ||
| 753 | :global t | ||
| 754 | :group 'whitespace | ||
| 755 | (if whitespace-global-mode | ||
| 756 | (progn | ||
| 757 | (add-hook 'find-file-hook 'whitespace-buffer) | ||
| 758 | (add-hook 'write-file-functions 'whitespace-write-file-hook nil t) | ||
| 759 | (add-hook 'kill-buffer-hook 'whitespace-buffer)) | ||
| 760 | (remove-hook 'find-file-hook 'whitespace-buffer) | ||
| 761 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t) | ||
| 762 | (remove-hook 'kill-buffer-hook 'whitespace-buffer))) | ||
| 763 | |||
| 764 | ;;;###autoload | ||
| 765 | (defun whitespace-write-file-hook () | ||
| 766 | "Hook function to be called on the buffer when whitespace check is enabled. | ||
| 767 | This is meant to be added buffer-locally to `write-file-functions'." | ||
| 768 | (let ((werr nil)) | ||
| 769 | (if whitespace-auto-cleanup | ||
| 770 | (whitespace-cleanup-internal) | ||
| 771 | (setq werr (whitespace-buffer))) | ||
| 772 | (if (and whitespace-abort-on-error werr) | ||
| 773 | (error "Abort write due to whitespaces in %s" | ||
| 774 | buffer-file-name))) | ||
| 775 | nil) | ||
| 776 | |||
| 777 | (defun whitespace-unload-function () | ||
| 778 | "Unload the whitespace library." | ||
| 779 | (if (unintern "whitespace-unload-hook" obarray) | ||
| 780 | ;; if whitespace-unload-hook is defined, let's get rid of it | ||
| 781 | ;; and recursively call `unload-feature' | ||
| 782 | (progn (unload-feature 'whitespace) t) | ||
| 783 | ;; this only happens in the recursive call | ||
| 784 | (whitespace-global-mode -1) | ||
| 785 | (save-current-buffer | ||
| 786 | (dolist (buf (buffer-list)) | ||
| 787 | (set-buffer buf) | ||
| 788 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t))) | ||
| 789 | ;; continue standard unloading | ||
| 790 | nil)) | ||
| 791 | |||
| 792 | (defun whitespace-unload-hook () | ||
| 793 | (remove-hook 'find-file-hook 'whitespace-buffer) | ||
| 794 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t) | ||
| 795 | (remove-hook 'kill-buffer-hook 'whitespace-buffer)) | ||
| 796 | |||
| 797 | (add-hook 'whitespace-unload-hook 'whitespace-unload-hook) | ||
| 798 | |||
| 799 | (provide 'whitespace) | ||
| 800 | |||
| 801 | ;;; whitespace.el ends here | ||