mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-03 11:33:37 +00:00
Code Issues Releases Activity

Prefer declare over a put of list-indent-function.

Browse Source 
While at it, I enabled lexical-binding in the affected files.

* lisp/cedet/semantic/sb.el: Enable lexical-binding.
(semantic-sb-with-tag-buffer): Use `declare`.

* lisp/cedet/semantic/bovine/el.el: Enable lexical-binding.
(semantic-elisp-setup-form-parser): Use `declare`.

* lisp/emacs-lisp/ert.el:
* lisp/emacs-lisp/ert-x.el: Remove redundant `put`.

* lisp/emulation/cua-rect.el: Enable lexical-binding.
(cua--rectangle-operation, cua--rectangle-aux-replace): Use `declare`.

* lisp/mh-e/mh-acros.el: Enable lexical-binding.
(mh-do-in-gnu-emacs, mh-do-in-xemacs, mh-funcall-if-exists, defun-mh)
(defmacro-mh, with-mh-folder-updating, mh-in-show-buffer)
(mh-do-at-event-location, mh-iterate-on-messages-in-region)
(mh-iterate-on-range): Use `declare`.

* lisp/mh-e/mh-compat.el: Enable lexical-binding.
(mh-flet): Use `declare`.

* lisp/mh-e/mh-e.el: Enable lexical-binding.
(defgroup-mh, defcustom-mh, defface-mh): Use `declare`.

* lisp/net/sieve.el: Enable lexical-binding.  Remove redundant :group args.
(sieve-activate, sieve-remove, sieve-edit-script): Remove unused arg
from the interactive spec.
(sieve-deactivate-all): Remove unused var `name`.
(sieve-change-region): Use `declare`.

* lisp/obsolete/fast-lock.el: Enable lexical-binding.
Remove redundant :group args.  Remove XEmacs compat code.
(save-buffer-state): Remove macro.
(fast-lock-add-properties): Use `with-silent-modifications` instead.

* lisp/obsolete/lazy-lock.el: Enable lexical-binding.
Remove redundant :group args.
(do-while): Use `declare`.
(save-buffer-state): Remove macro.
(lazy-lock-fontify-rest-after-change, lazy-lock-defer-line-after-change)
(lazy-lock-defer-rest-after-change, lazy-lock-after-fontify-buffer)
(lazy-lock-after-unfontify-buffer, lazy-lock-fontify-region):
Use `with-silent-modifications` instead.

* lisp/obsolete/pgg.el: Enable lexical-binding.  Remove XEmacs compat code.
(pgg-save-coding-system, pgg-as-lbt, pgg-process-when-success):
Use `declare`.
(pgg-add-passphrase-to-cache): Remove unused var `new-timer`.
(pgg-decrypt-region): Remove unused var `buf`.

* lisp/org/org-agenda.el (org-let, org-let2): Move from org-macs and
use `declare`.

* lisp/org/org-macs.el (org-let, org-let2): Move these functions that
are inherently harmful to your karma to the only package that uses them.
(org-scroll): Use `pcase` to avoid `eval` and use more readable syntax
for those integers standing for events.

* lisp/progmodes/antlr-mode.el: Enable lexical-binding.
(save-buffer-state-x): Use `declare` and `with-silent-modifications`.

* lisp/international/mule-util.el (with-coding-priority):
* lisp/cedet/ede/proj-comp.el (proj-comp-insert-variable-once):
* lisp/org/org-element.el (org-element-map):
* test/lisp/emacs-lisp/bytecomp-tests.el (test-byte-comp-compile-and-load):
* test/lisp/emacs-lisp/generator-tests.el (cps-testcase): Use `declare`.
This commit is contained in:
Stefan Monnier 2021-02-22 11:54:17 -05:00
parent f1fa35f091
commit 8d5dfafab7
20 changed files with 235 additions and 483 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/cedet/ede/proj-comp.el
View File

@ -248,6 +248,7 @@ This will prevent rules from creating duplicate variables or rules."
(defmacro proj-comp-insert-variable-once (varname &rest body)
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
(declare (indent 1) (debug (sexp body)))
`(let ((addcr t) (v ,varname))
(unless (re-search-backward (concat "^" v "\\s-*=") nil t)
(insert v "=")
@ -255,7 +256,6 @@ Execute BODY in a location where a value can be placed."
(if addcr (insert "\n"))
(goto-char (point-max)))
))
(put 'proj-comp-insert-variable-once 'lisp-indent-function 1)
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS."

44
lisp/cedet/semantic/bovine/el.el
View File

@ -1,4 +1,4 @@
;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@ -169,10 +169,10 @@ where:
- FORM is an Elisp form read from the current buffer.
- START and END are the beginning and end location of the
corresponding data in the current buffer."
(declare (indent 1))
(let ((sym (make-symbol "sym")))
`(dolist (,sym ',symbols)
(put ,sym 'semantic-elisp-form-parser #',parser))))
(put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
(defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
"Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
@ -210,7 +210,7 @@ Return a bovination list to use."
;;; Form parsers
;;
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 2 form))
nil
@ -234,7 +234,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil
@ -256,7 +256,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag-new-variable
(symbol-name (nth 1 form))
@ -274,7 +274,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag-new-variable
(symbol-name (nth 1 form))
@ -290,7 +290,7 @@ Return a bovination list to use."
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag-new-variable
(symbol-name (nth 1 form))
@ -307,7 +307,7 @@ Return a bovination list to use."
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag
(symbol-name (nth 1 form))
@ -321,7 +321,7 @@ Return a bovination list to use."
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (cadr (cadr form)))
nil nil
@ -333,7 +333,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let* ((a2 (nth 2 form))
(a3 (nth 3 form))
(args (if (listp a2) a2 a3))
@ -353,7 +353,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil
@ -363,7 +363,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((docpart (nthcdr 4 form)))
(semantic-tag-new-type
(symbol-name (nth 1 form))
@ -381,7 +381,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((slots (nthcdr 2 form)))
;; Skip doc string if present.
(and (stringp (car slots))
@ -399,7 +399,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil nil
@ -410,7 +410,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((args (nth 3 form)))
(semantic-tag-new-function
(symbol-name (nth 1 form))
@ -424,7 +424,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(semantic-tag-new-variable
(symbol-name (nth 2 form))
nil
@ -437,7 +437,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((name (nth 1 form)))
(semantic-tag-new-include
(symbol-name (if (eq (car-safe name) 'quote)
@ -449,7 +449,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
(lambda (form start end)
(lambda (form _start _end)
(let ((name (nth 1 form)))
(semantic-tag-new-package
(symbol-name (if (eq (car-safe name) 'quote)
@ -500,7 +500,7 @@ into Emacs Lisp's memory."
""))))
(define-mode-local-override semantic-documentation-for-tag
emacs-lisp-mode (tag &optional nosnarf)
emacs-lisp-mode (tag &optional _nosnarf)
"Return the documentation string for TAG.
Optional argument NOSNARF is ignored."
(let ((d (semantic-tag-docstring tag)))
@ -577,7 +577,7 @@ Override function for `semantic-tag-protection'."
((string= prot "protected") 'protected))))
(define-mode-local-override semantic-tag-static-p
emacs-lisp-mode (tag &optional parent)
emacs-lisp-mode (tag &optional _parent)
"Return non-nil if TAG is static in PARENT class.
Overrides `semantic-nonterminal-static'."
;; This can only be true (theoretically) in a class where it is assigned.
@ -588,7 +588,7 @@ Overrides `semantic-nonterminal-static'."
;; Emacs lisp is very different from C,C++ which most context parsing
;; functions are written. Support them here.
(define-mode-local-override semantic-up-context emacs-lisp-mode
(&optional point bounds-type)
(&optional _point _bounds-type)
"Move up one context in an Emacs Lisp function.
A Context in many languages is a block with its own local variables.
In Emacs, we will move up lists and stop when one starts with one of
@ -652,7 +652,7 @@ define-mode-overload\\)\
(define-mode-local-override semantic-get-local-variables emacs-lisp-mode
(&optional point)
(&optional _point)
"Return a list of local variables for POINT.
Scan backwards from point at each successive function. For all occurrences
of `let' or `let*', grab those variable names."

6
lisp/cedet/semantic/sb.el
View File

@ -1,4 +1,4 @@
;;; semantic/sb.el --- Semantic tag display for speedbar
;;; semantic/sb.el --- Semantic tag display for speedbar -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -73,10 +73,10 @@ use the `speedbar-line-file' to get this info if needed."
(defmacro semantic-sb-with-tag-buffer (tag &rest forms)
"Set the current buffer to the origin of TAG and execute FORMS.
Restore the old current buffer when completed."
(declare (indent 1) (debug t))
`(save-excursion
(semantic-sb-tag-set-buffer ,tag)
,@forms))
(put 'semantic-sb-with-tag-buffer 'lisp-indent-function 1)
;;; Button Generation
;;
@ -294,7 +294,7 @@ TEXT TOKEN and INDENT are the details."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
(defun semantic-sb-token-jump (text token indent)
(defun semantic-sb-token-jump (_text token indent)
"Jump to the location specified in token.
TEXT TOKEN and INDENT are the details."
(let ((file

9
lisp/emacs-lisp/ert-x.el
View File

@ -102,15 +102,6 @@ the name of the test and the result of NAME-FORM."
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
;; We use these `put' forms in addition to the (declare (indent)) in
;; the defmacro form since the `declare' alone does not lead to
;; correct indentation before the .el/.elc file is loaded.
;; Autoloading these `put' forms solves this.
;;;###autoload
(progn
;; TODO(ohler): Figure out what these mean and make sure they are correct.
(put 'ert-with-test-buffer 'lisp-indent-function 1))
;;;###autoload
(defun ert-kill-all-test-buffers ()
"Kill all test buffers that are still live."

16
lisp/emacs-lisp/ert.el
View File

@ -81,15 +81,13 @@ Use nil for no limit (caution: backtrace lines can be very long)."
:background "green1")
(((class color) (background dark))
:background "green3"))
"Face used for expected results in the ERT results buffer."
:group 'ert)
"Face used for expected results in the ERT results buffer.")
(defface ert-test-result-unexpected '((((class color) (background light))
:background "red1")
(((class color) (background dark))
:background "red3"))
"Face used for unexpected results in the ERT results buffer."
:group 'ert)
"Face used for unexpected results in the ERT results buffer.")
;;; Copies/reimplementations of cl functions.
@ -224,16 +222,6 @@ it has to be wrapped in `(eval (quote ...))'.
:body (lambda () ,@body)))
',name))))
;; We use these `put' forms in addition to the (declare (indent)) in
;; the defmacro form since the `declare' alone does not lead to
;; correct indentation before the .el/.elc file is loaded.
;; Autoloading these `put' forms solves this.
;;;###autoload
(progn
;; TODO(ohler): Figure out what these mean and make sure they are correct.
(put 'ert-deftest 'lisp-indent-function 2)
(put 'ert-info 'lisp-indent-function 1))
(defvar ert--find-test-regexp
(concat "^\\s-*(ert-deftest"
find-function-space-re

8
lisp/emulation/cua-rect.el
View File

@ -1,4 +1,4 @@
;;; cua-rect.el --- CUA unified rectangle support
;;; cua-rect.el --- CUA unified rectangle support -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@ -575,6 +575,7 @@ Set undo boundary if UNDO is non-nil.
Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
Perform auto-tabify after operation if TABIFY is non-nil.
Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear."
(declare (indent 4))
(let* ((inhibit-field-text-motion t)
(start (cua--rectangle-top))
(end (cua--rectangle-bot))
@ -645,8 +646,6 @@ Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear."
(cua--keep-active)))
(setq cua--buffer-and-point-before-command nil)))
(put 'cua--rectangle-operation 'lisp-indent-function 4)
(defun cua--delete-rectangle ()
(let ((lines 0))
(if (not (cua--rectangle-virtual-edges))
@ -1220,6 +1219,7 @@ The numbers are formatted according to the FORMAT string."
;;; Replace/rearrange text in current rectangle
(defun cua--rectangle-aux-replace (width adjust keep replace pad format-fct &optional setup-fct)
(declare (indent 4))
;; Process text inserted by calling SETUP-FCT or current rectangle if nil.
;; Then call FORMAT-FCT on text (if non-nil); takes two args: start and end.
;; Fill to WIDTH characters if > 0 or fill to current width if == 0.
@ -1279,8 +1279,6 @@ The numbers are formatted according to the FORMAT string."
(if keep
(cua--rectangle-resized)))))
(put 'cua--rectangle-aux-replace 'lisp-indent-function 4)
(defun cua--left-fill-rectangle (_start _end)
(beginning-of-line)
(while (< (point) (point-max))

3
lisp/international/mule-util.el
View File

@ -278,14 +278,13 @@ Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil
CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'.
This affects the implicit sorting of lists of coding systems returned by
operations such as `find-coding-systems-region'."
(declare (indent 1) (debug t))
(let ((current (make-symbol "current")))
`(let ((,current (coding-system-priority-list)))
(apply #'set-coding-system-priority ,coding-systems)
(unwind-protect
(progn ,@body)
(apply #'set-coding-system-priority ,current)))))
;;;###autoload(put 'with-coding-priority 'lisp-indent-function 1)
(put 'with-coding-priority 'edebug-form-spec t)
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)

33
lisp/mh-e/mh-acros.el
View File

@ -1,4 +1,4 @@
;;; mh-acros.el --- macros used in MH-E
;;; mh-acros.el --- macros used in MH-E -*- lexical-binding: t; -*-
;; Copyright (C) 2004, 2006-2021 Free Software Foundation, Inc.
@ -49,20 +49,19 @@
;;;###mh-autoload
(defmacro mh-do-in-gnu-emacs (&rest body)
"Execute BODY if in GNU Emacs."
(declare (debug t))
(declare (debug t) (indent defun))
(unless (featurep 'xemacs) `(progn ,@body)))
(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-do-in-xemacs (&rest body)
"Execute BODY if in XEmacs."
(declare (debug t))
(declare (debug t) (indent defun))
(when (featurep 'xemacs) `(progn ,@body)))
(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-funcall-if-exists (function &rest args)
"Call FUNCTION with ARGS as parameters if it exists."
(declare (debug (symbolp body)))
;; FIXME: Not clear when this should be used. If the function happens
;; not to exist at compile-time (e.g. because the corresponding package
;; wasn't loaded), then it won't ever be used :-(
@ -75,25 +74,24 @@
"Create function NAME.
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
Otherwise, create function NAME with ARG-LIST and BODY."
(declare (indent defun) (doc-string 4)
(debug (&define name symbolp sexp def-body)))
`(defalias ',name
(if (fboundp ',function)
',function
(lambda ,arg-list ,@body))))
(put 'defun-mh 'lisp-indent-function 'defun)
(put 'defun-mh 'doc-string-elt 4)
;;;###mh-autoload
(defmacro defmacro-mh (name macro arg-list &rest body)
"Create macro NAME.
If MACRO exists, then NAME becomes an alias for MACRO.
Otherwise, create macro NAME with ARG-LIST and BODY."
(declare (indent defun) (doc-string 4)
(debug (&define name symbolp sexp def-body)))
(let ((defined-p (fboundp macro)))
(if defined-p
`(defalias ',name ',macro)
`(defmacro ,name ,arg-list ,@body))))
(put 'defmacro-mh 'lisp-indent-function 'defun)
(put 'defmacro-mh 'doc-string-elt 4)
;;; Miscellaneous
@ -127,7 +125,7 @@ Execute BODY, which can modify the folder buffer without having to
worry about file locking or the read-only flag, and return its result.
If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification flag
is unchanged, otherwise it is cleared."
(declare (debug t))
(declare (debug t) (indent defun))
(setq save-modification-flag (car save-modification-flag)) ; CL style
`(prog1
(let ((mh-folder-updating-mod-flag (buffer-modified-p))
@ -139,14 +137,13 @@ is unchanged, otherwise it is cleared."
(mh-set-folder-modified-p mh-folder-updating-mod-flag)))
,@(if (not save-modification-flag)
'((mh-set-folder-modified-p nil)))))
(put 'with-mh-folder-updating 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-in-show-buffer (show-buffer &rest body)
"Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
Display buffer SHOW-BUFFER in other window and execute BODY in it.
Stronger than `save-excursion', weaker than `save-window-excursion'."
(declare (debug t))
(declare (debug t) (indent defun))
(setq show-buffer (car show-buffer)) ; CL style
`(let ((mh-in-show-buffer-saved-window (selected-window)))
(switch-to-buffer-other-window ,show-buffer)
@ -155,7 +152,6 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
(progn
,@body)
(select-window mh-in-show-buffer-saved-window))))
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-do-at-event-location (event &rest body)
@ -163,7 +159,7 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
After BODY has been executed return to original window.
The modification flag of the buffer in the event window is
preserved."
(declare (debug t))
(declare (debug t) (indent defun))
(let ((event-window (make-symbol "event-window"))
(event-position (make-symbol "event-position"))
(original-window (make-symbol "original-window"))
@ -190,7 +186,6 @@ preserved."
(goto-char ,original-position)
(set-marker ,original-position nil)
(select-window ,original-window))))))
(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
@ -209,7 +204,7 @@ VAR is bound to the message on the current line as we loop
starting from BEGIN till END. In each step BODY is executed.
If VAR is nil then the loop is executed without any binding."
(declare (debug (symbolp body)))
(declare (debug (symbolp body)) (indent defun))
(unless (symbolp var)
(error "Can not bind the non-symbol %s" var))
(let ((binding-needed-flag var))
@ -221,7 +216,6 @@ If VAR is nil then the loop is executed without any binding."
(let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
,@body))
(forward-line 1)))))
(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-iterate-on-range (var range &rest body)
@ -235,7 +229,7 @@ a string. In each iteration, BODY is executed.
The parameter RANGE is usually created with
`mh-interactive-range' in order to provide a uniform interface to
MH-E functions."
(declare (debug (symbolp body)))
(declare (debug (symbolp body)) (indent defun))
(unless (symbolp var)
(error "Can not bind the non-symbol %s" var))
(let ((binding-needed-flag var)
@ -263,7 +257,6 @@ MH-E functions."
(when (gethash v ,seq-hash-table)
(let ,(if binding-needed-flag `((,var v)) ())
,@body))))))))
(put 'mh-iterate-on-range 'lisp-indent-hook 'defun)
(defmacro mh-dlet* (binders &rest body)
"Like `let*' but always dynamically scoped."

6
lisp/mh-e/mh-compat.el
View File

@ -1,4 +1,4 @@
;;; mh-compat.el --- make MH-E compatible with various versions of Emacs
;;; mh-compat.el --- make MH-E compatible with various versions of Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@ -83,6 +83,7 @@ This is an analogue of a dynamically scoped `let' that operates on
the function cell of FUNCs rather than their value cell.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form)))
(if (fboundp 'cl-letf)
`(cl-letf ,(mapcar (lambda (binding)
`((symbol-function ',(car binding))
@ -90,9 +91,6 @@ the function cell of FUNCs rather than their value cell.
bindings)
,@body)
`(flet ,bindings ,@body)))
(put 'mh-flet 'lisp-indent-function 1)
(put 'mh-flet 'edebug-form-spec
'((&rest (sexp sexp &rest form)) &rest form))
(defun mh-display-color-cells (&optional display)
"Return the number of color cells supported by DISPLAY.

11
lisp/mh-e/mh-e.el
View File

@ -1,4 +1,4 @@
;;; mh-e.el --- GNU Emacs interface to the MH mail system
;;; mh-e.el --- GNU Emacs interface to the MH mail system -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2021 Free
;; Software Foundation, Inc.
@ -695,9 +695,8 @@ See documentation for `defgroup' for a description of the arguments
SYMBOL, MEMBERS, DOC and ARGS.
This macro is used by Emacs versions that lack the :package-version
keyword, introduced in Emacs 22."
(declare (doc-string 3))
(declare (doc-string 3) (indent defun))
`(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args)))
(put 'defgroup-mh 'lisp-indent-function 'defun)
(defmacro defcustom-mh (symbol value doc &rest args)
"Declare SYMBOL as a customizable variable that defaults to VALUE.
@ -705,9 +704,8 @@ See documentation for `defcustom' for a description of the arguments
SYMBOL, VALUE, DOC and ARGS.
This macro is used by Emacs versions that lack the :package-version
keyword, introduced in Emacs 22."
(declare (doc-string 3))
(declare (doc-string 3) (indent defun))
`(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args)))
(put 'defcustom-mh 'lisp-indent-function 'defun)
(defmacro defface-mh (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
@ -715,9 +713,8 @@ See documentation for `defface' for a description of the arguments
FACE, SPEC, DOC and ARGS.
This macro is used by Emacs versions that lack the :package-version
keyword, introduced in Emacs 22."
(declare (doc-string 3))
(declare (doc-string 3) (indent defun))
`(defface ,face ,spec ,doc ,@(mh-strip-package-version args)))
(put 'defface-mh 'lisp-indent-function 'defun)

82
lisp/net/sieve.el
View File

@ -1,4 +1,4 @@
;;; sieve.el --- Utilities to manage sieve scripts
;;; sieve.el --- Utilities to manage sieve scripts -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -69,13 +69,11 @@
(defcustom sieve-new-script "<new script>"
"Name of name script indicator."
:type 'string
:group 'sieve)
:type 'string)
(defcustom sieve-buffer "*sieve*"
"Name of sieve management buffer."
:type 'string
:group 'sieve)
:type 'string)
(defcustom sieve-template "\
require \"fileinto\";
@ -91,8 +89,7 @@ require \"fileinto\";
# }
"
"Template sieve script."
:type 'string
:group 'sieve)
:type 'string)
;; Internal variables:
@ -104,31 +101,36 @@ require \"fileinto\";
;; Sieve-manage mode:
;; This function is defined by `easy-menu-define' but it's only done
;; at run time and the compiler is not aware of it.
;; FIXME: This is arguably a bug/problem in `easy-menu-define'.
(declare-function sieve-manage-mode-menu "sieve")
(defvar sieve-manage-mode-map
(let ((map (make-sparse-keymap)))
;; various
(define-key map "?" 'sieve-help)
(define-key map "h" 'sieve-help)
(define-key map "?" #'sieve-help)
(define-key map "h" #'sieve-help)
;; activating
(define-key map "m" 'sieve-activate)
(define-key map "u" 'sieve-deactivate)
(define-key map "\M-\C-?" 'sieve-deactivate-all)
(define-key map "m" #'sieve-activate)
(define-key map "u" #'sieve-deactivate)
(define-key map "\M-\C-?" #'sieve-deactivate-all)
;; navigation keys
(define-key map "\C-p" 'sieve-prev-line)
(define-key map [up] 'sieve-prev-line)
(define-key map "\C-n" 'sieve-next-line)
(define-key map [down] 'sieve-next-line)
(define-key map " " 'sieve-next-line)
(define-key map "n" 'sieve-next-line)
(define-key map "p" 'sieve-prev-line)
(define-key map "\C-m" 'sieve-edit-script)
(define-key map "f" 'sieve-edit-script)
(define-key map "o" 'sieve-edit-script-other-window)
(define-key map "r" 'sieve-remove)
(define-key map "q" 'sieve-bury-buffer)
(define-key map "Q" 'sieve-manage-quit)
(define-key map [(down-mouse-2)] 'sieve-edit-script)
(define-key map [(down-mouse-3)] 'sieve-manage-mode-menu)
(define-key map "\C-p" #'sieve-prev-line)
(define-key map [up] #'sieve-prev-line)
(define-key map "\C-n" #'sieve-next-line)
(define-key map [down] #'sieve-next-line)
(define-key map " " #'sieve-next-line)
(define-key map "n" #'sieve-next-line)
(define-key map "p" #'sieve-prev-line)
(define-key map "\C-m" #'sieve-edit-script)
(define-key map "f" #'sieve-edit-script)
;; (define-key map "o" #'sieve-edit-script-other-window)
(define-key map "r" #'sieve-remove)
(define-key map "q" #'sieve-bury-buffer)
(define-key map "Q" #'sieve-manage-quit)
(define-key map [(down-mouse-2)] #'sieve-edit-script)
(define-key map [(down-mouse-3)] #'sieve-manage-mode-menu)
map)
"Keymap for `sieve-manage-mode'.")
@ -159,8 +161,8 @@ require \"fileinto\";
(interactive)
(bury-buffer))
(defun sieve-activate (&optional pos)
(interactive "d")
(defun sieve-activate (&optional _pos)
(interactive)
(let ((name (sieve-script-at-point)) err)
(when (or (null name) (string-equal name sieve-new-script))
(error "No sieve script at point"))
@ -171,20 +173,20 @@ require \"fileinto\";
(message "Activating script %s...done" name)
(message "Activating script %s...failed: %s" name (nth 2 err)))))
(defun sieve-deactivate-all (&optional pos)
(interactive "d")
(let ((name (sieve-script-at-point)) err)
(message "Deactivating scripts...")
(setq err (sieve-manage-setactive "" sieve-manage-buffer))
(defun sieve-deactivate-all (&optional _pos)
(interactive)
(message "Deactivating scripts...")
(let (;; (name (sieve-script-at-point))
(err (sieve-manage-setactive "" sieve-manage-buffer)))
(sieve-refresh-scriptlist)
(if (sieve-manage-ok-p err)
(message "Deactivating scripts...done")
(message "Deactivating scripts...failed: %s" (nth 2 err)))))
(defalias 'sieve-deactivate 'sieve-deactivate-all)
(defalias 'sieve-deactivate #'sieve-deactivate-all)
(defun sieve-remove (&optional pos)
(interactive "d")
(defun sieve-remove (&optional _pos)
(interactive)
(let ((name (sieve-script-at-point)) err)
(when (or (null name) (string-equal name sieve-new-script))
(error "No sieve script at point"))
@ -195,8 +197,8 @@ require \"fileinto\";
(sieve-refresh-scriptlist)
(message "Removing sieve script %s...done" name)))
(defun sieve-edit-script (&optional pos)
(interactive "d")
(defun sieve-edit-script (&optional _pos)
(interactive)
(let ((name (sieve-script-at-point)))
(unless name
(error "No sieve script at point"))
@ -224,11 +226,11 @@ require \"fileinto\";
(defmacro sieve-change-region (&rest body)
"Turns off sieve-region before executing BODY, then re-enables it after.
Used to bracket operations which move point in the sieve-buffer."
(declare (indent 0) (debug t))
`(progn
(sieve-highlight nil)
,@body
(sieve-highlight t)))
(put 'sieve-change-region 'lisp-indent-function 0)
(defun sieve-next-line (&optional arg)
(interactive)

127
lisp/obsolete/fast-lock.el
View File

@ -1,4 +1,4 @@
;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
@ -190,18 +190,6 @@
(defvar font-lock-face-list)
(eval-when-compile
;; We use this to preserve or protect things when modifying text properties.
(defmacro save-buffer-state (varlist &rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
`(let* (,@(append varlist
'((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)))
,@body
(when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil))))
(put 'save-buffer-state 'lisp-indent-function 1)
;;
;; We use this to verify that a face should be saved.
(defmacro fast-lock-save-facep (face)
@ -244,8 +232,7 @@ for buffers in Rmail mode, and size is irrelevant otherwise."
(symbol :tag "name"))
(radio :tag "Size"
(const :tag "none" nil)
(integer :tag "size")))))
:group 'fast-lock)
(integer :tag "size"))))))
(defcustom fast-lock-cache-directories '("~/.emacs-flc")
; - `internal', keep each file's Font Lock cache file in the same file.
@ -271,8 +258,7 @@ to avoid the possibility of using the cache of another user."
:type '(repeat (radio (directory :tag "directory")
(cons :tag "Matching"
(regexp :tag "regexp")
(directory :tag "directory"))))
:group 'fast-lock)
(directory :tag "directory")))))
(put 'fast-lock-cache-directories 'risky-local-variable t)
(defcustom fast-lock-save-events '(kill-buffer kill-emacs)
@ -282,23 +268,20 @@ If concurrent editing sessions use the same associated cache file for a file's
buffer, then you should add `save-buffer' to this list."
:type '(set (const :tag "buffer saving" save-buffer)
(const :tag "buffer killing" kill-buffer)
(const :tag "emacs killing" kill-emacs))
:group 'fast-lock)
(const :tag "emacs killing" kill-emacs)))
(defcustom fast-lock-save-others t
"If non-nil, save Font Lock cache files irrespective of file owner.
If nil, means only buffer files known to be owned by you can have associated
Font Lock cache files saved. Ownership may be unknown for networked files."
:type 'boolean
:group 'fast-lock)
:type 'boolean)
(defcustom fast-lock-verbose font-lock-verbose
"If non-nil, means show status messages for cache processing.
If a number, only buffers greater than this size have processing messages."
:type '(choice (const :tag "never" nil)
(other :tag "always" t)
(integer :tag "size"))
:group 'fast-lock)
(integer :tag "size")))
(defvar fast-lock-save-faces
(when (featurep 'xemacs)
@ -581,7 +564,7 @@ See `fast-lock-cache-directory'."
(defun fast-lock-cache-data (version timestamp
syntactic-keywords syntactic-properties
keywords face-properties
&rest ignored)
&rest _ignored)
;; Find value of syntactic keywords in case it is a symbol.
(setq font-lock-syntactic-keywords (font-lock-eval-keywords
font-lock-syntactic-keywords))
@ -708,86 +691,26 @@ See `fast-lock-get-face-properties'."
"Add `syntax-table' and `face' text properties to the current buffer.
Any existing `syntax-table' and `face' text properties are removed first.
See `fast-lock-get-face-properties'."
(save-buffer-state (plist regions)
(save-restriction
(widen)
(font-lock-unfontify-region (point-min) (point-max))
;;
;; Set the `syntax-table' property for each start/end region.
(while syntactic-properties
(setq plist (list 'syntax-table (car (car syntactic-properties)))
regions (cdr (car syntactic-properties))
syntactic-properties (cdr syntactic-properties))
(while regions
(add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions))))
;;
;; Set the `face' property for each start/end region.
(while face-properties
(setq plist (list 'face (car (car face-properties)))
regions (cdr (car face-properties))
face-properties (cdr face-properties))
(while regions
(add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions)))))))
(with-silent-modifications
(let ((inhibit-point-motion-hooks t))
(save-restriction
(widen)
(font-lock-unfontify-region (point-min) (point-max))
;;
;; Set the `syntax-table' property for each start/end region.
(pcase-dolist (`(,plist . ,regions) syntactic-properties)
(while regions
(add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions))))
;;
;; Set the `face' property for each start/end region.
(pcase-dolist (`(,plist . ,regions) face-properties)
(while regions
(add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions))))))))
;; Functions for XEmacs:
(when (featurep 'xemacs)
;;
;; It would be better to use XEmacs' `map-extents' over extents with a
;; `font-lock' property, but `face' properties are on different extents.
(defun fast-lock-get-face-properties ()
"Return a list of `face' text properties in the current buffer.
Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
where VALUE is a `face' property value and STARTx and ENDx are positions.
Only those `face' VALUEs in `fast-lock-save-faces' are returned."
(save-restriction
(widen)
(let ((properties ()) cell)
(map-extents
(function (lambda (extent ignore)
(let ((value (extent-face extent)))
;; We're only interested if it's one of `fast-lock-save-faces'.
(when (and value (fast-lock-save-facep value))
(let ((start (extent-start-position extent))
(end (extent-end-position extent)))
;; Make or add to existing list of regions with the same
;; `face' property value.
(if (setq cell (assoc value properties))
(setcdr cell (cons start (cons end (cdr cell))))
(push (list value start end) properties))))
;; Return nil to keep `map-extents' going.
nil))))
properties)))
;;
;; XEmacs does not support the `syntax-table' text property.
(defalias 'fast-lock-get-syntactic-properties
'ignore)
;;
;; Make extents just like XEmacs' font-lock.el does.
(defun fast-lock-add-properties (syntactic-properties face-properties)
"Set `face' text properties in the current buffer.
Any existing `face' text properties are removed first.
See `fast-lock-get-face-properties'."
(save-restriction
(widen)
(font-lock-unfontify-region (point-min) (point-max))
;; Set the `face' property, etc., for each start/end region.
(while face-properties
(let ((face (car (car face-properties)))
(regions (cdr (car face-properties))))
(while regions
(font-lock-set-face (nth 0 regions) (nth 1 regions) face)
(setq regions (nthcdr 2 regions)))
(setq face-properties (cdr face-properties))))
;; XEmacs does not support the `syntax-table' text property.
))
;;
;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook.
(add-hook 'font-lock-after-fontify-buffer-hook
'fast-lock-after-fontify-buffer))
(unless (boundp 'font-lock-syntactic-keywords)
(defvar font-lock-syntactic-keywords nil))
@ -802,7 +725,7 @@ See `fast-lock-get-face-properties'."
(if (symbolp keywords)
(font-lock-eval-keywords (if (fboundp keywords)
(funcall keywords)
(eval keywords)))
(eval keywords t)))
keywords)))
(unless (fboundp 'font-lock-value-in-major-mode)

114
lisp/obsolete/lazy-lock.el
View File

@ -1,4 +1,4 @@
;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
@ -270,30 +270,14 @@
(eval-when-compile (require 'cl-lib))
(eval-when-compile
;; We use this to preserve or protect things when modifying text properties.
(defmacro save-buffer-state (varlist &rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
`(let* (,@(append varlist
'((modified (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
deactivate-mark
buffer-file-name
buffer-file-truename)))
,@body
(when (and (not modified) (buffer-modified-p))
(restore-buffer-modified-p nil))))
(put 'save-buffer-state 'lisp-indent-function 1)
;;
;; We use this for clarity and speed. Naughty but nice.
(defmacro do-while (test &rest body)
"(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil.
The order of execution is thus BODY, TEST, BODY, TEST and so on
until TEST returns nil."
`(while (progn ,@body ,test)))
(put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function)))
(declare (indent 1) (debug t))
`(while (progn ,@body ,test))))
(defgroup lazy-lock nil
"Font Lock support mode to fontify lazily."
@ -326,8 +310,7 @@ The value of this variable is used when Lazy Lock mode is turned on."
(symbol :tag "name"))
(radio :tag "Size"
(const :tag "none" nil)
(integer :tag "size")))))
:group 'lazy-lock)
(integer :tag "size"))))))
(defcustom lazy-lock-defer-on-the-fly t
"If non-nil, means fontification after a change should be deferred.
@ -346,8 +329,7 @@ The value of this variable is used when Lazy Lock mode is turned on."
(set :menu-tag "mode specific" :tag "modes"
:value (not)
(const :tag "Except" not)
(repeat :inline t (symbol :tag "mode"))))
:group 'lazy-lock)
(repeat :inline t (symbol :tag "mode")))))
(defcustom lazy-lock-defer-on-scrolling nil
"If non-nil, means fontification after a scroll should be deferred.
@ -371,8 +353,7 @@ makes little sense if `lazy-lock-defer-contextually' is non-nil.)
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
(other :tag "eventually" eventually))
:group 'lazy-lock)
(other :tag "eventually" eventually)))
(defcustom lazy-lock-defer-contextually 'syntax-driven
"If non-nil, means deferred fontification should be syntactically true.
@ -389,8 +370,7 @@ buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
(other :tag "syntax-driven" syntax-driven))
:group 'lazy-lock)
(other :tag "syntax-driven" syntax-driven)))
(defcustom lazy-lock-defer-time 0.25
"Time in seconds to delay before beginning deferred fontification.
@ -401,8 +381,7 @@ variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(number :tag "seconds"))
:group 'lazy-lock)
(number :tag "seconds")))
(defcustom lazy-lock-stealth-time 30
"Time in seconds to delay before beginning stealth fontification.
@ -411,16 +390,14 @@ If nil, means stealth fontification is never performed.
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(number :tag "seconds"))
:group 'lazy-lock)
(number :tag "seconds")))
(defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250)
"Maximum size of a chunk of stealth fontification.
Each iteration of stealth fontification can fontify this number of lines.
To speed up input response during stealth fontification, at the cost of stealth
taking longer to fontify, you could reduce the value of this variable."
:type '(integer :tag "lines")
:group 'lazy-lock)
:type '(integer :tag "lines"))
(defcustom lazy-lock-stealth-load
(if (condition-case nil (load-average) (error)) 200)
@ -435,8 +412,7 @@ See also `lazy-lock-stealth-nice'."
:type (if (condition-case nil (load-average) (error))
'(choice (const :tag "never" nil)
(integer :tag "load"))
'(const :format "%t: unsupported\n" nil))
:group 'lazy-lock)
'(const :format "%t: unsupported\n" nil)))
(defcustom lazy-lock-stealth-nice 0.125
"Time in seconds to pause between chunks of stealth fontification.
@ -447,14 +423,12 @@ To reduce machine load during stealth fontification, at the cost of stealth
taking longer to fontify, you could increase the value of this variable.
See also `lazy-lock-stealth-load'."
:type '(choice (const :tag "never" nil)
(number :tag "seconds"))
:group 'lazy-lock)
(number :tag "seconds")))
(defcustom lazy-lock-stealth-verbose
(and (not lazy-lock-defer-contextually) (not (null font-lock-verbose)))
"If non-nil, means stealth fontification should show status messages."
:type 'boolean
:group 'lazy-lock)
:type 'boolean)
;; User Functions:
@ -682,7 +656,7 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; result in an unnecessary trigger after this if we did not cancel it now.
(set-window-redisplay-end-trigger window nil))
(defun lazy-lock-defer-after-scroll (window window-start)
(defun lazy-lock-defer-after-scroll (window _window-start)
;; Called from `window-scroll-functions'.
;; Defer fontification following the scroll. Save the current buffer so that
;; we subsequently fontify in all windows showing the buffer.
@ -758,29 +732,29 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; buffer. Save the current buffer so that we subsequently fontify in all
;; windows showing the buffer.
(lazy-lock-fontify-line-after-change beg end old-len)
(save-buffer-state nil
(with-silent-modifications
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
(save-restriction
(widen)
(remove-text-properties end (point-max) '(lazy-lock nil)))))
(defun lazy-lock-defer-line-after-change (beg end old-len)
(defun lazy-lock-defer-line-after-change (beg end _old-len)
;; Called from `after-change-functions'.
;; Defer fontification of the current change. Save the current buffer so
;; that we subsequently fontify in all windows showing the buffer.
(save-buffer-state nil
(with-silent-modifications
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
(remove-text-properties (max (1- beg) (point-min))
(min (1+ end) (point-max))
'(lazy-lock nil))))
(defun lazy-lock-defer-rest-after-change (beg end old-len)
(defun lazy-lock-defer-rest-after-change (beg _end _old-len)
;; Called from `after-change-functions'.
;; Defer fontification of the rest of the buffer. Save the current buffer so
;; that we subsequently fontify in all windows showing the buffer.
(save-buffer-state nil
(with-silent-modifications
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
(save-restriction
@ -868,14 +842,14 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; Called from `font-lock-after-fontify-buffer'.
;; Mark the current buffer as fontified.
;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
(save-buffer-state nil
(with-silent-modifications
(add-text-properties (point-min) (point-max) '(lazy-lock t))))
(defun lazy-lock-after-unfontify-buffer ()
;; Called from `font-lock-after-unfontify-buffer'.
;; Mark the current buffer as unfontified.
;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
(save-buffer-state nil
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(lazy-lock nil))))
;; Fontification functions.
@ -888,27 +862,27 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(widen)
(when (setq beg (text-property-any beg end 'lazy-lock nil))
(save-excursion
(save-match-data
(save-buffer-state
(next)
;; Find successive unfontified regions between BEG and END.
(condition-case data
(do-while beg
(setq next (or (text-property-any beg end 'lazy-lock t) end))
;; Make sure the region end points are at beginning of line.
(goto-char beg)
(unless (bolp)
(beginning-of-line)
(setq beg (point)))
(goto-char next)
(unless (bolp)
(forward-line)
(setq next (point)))
;; Fontify the region, then flag it as fontified.
(font-lock-fontify-region beg next)
(add-text-properties beg next '(lazy-lock t))
(setq beg (text-property-any next end 'lazy-lock nil)))
((error quit) (message "Fontifying region...%s" data)))))))))
(with-silent-modifications
(let ((inhibit-point-motion-hooks t))
;; Find successive unfontified regions between BEG and END.
(condition-case data
(do-while beg
(let ((next (or (text-property-any beg end 'lazy-lock t)
end)))
;; Make sure the region end points are at beginning of line.
(goto-char beg)
(unless (bolp)
(beginning-of-line)
(setq beg (point)))
(goto-char next)
(unless (bolp)
(forward-line)
(setq next (point)))
;; Fontify the region, then flag it as fontified.
(font-lock-fontify-region beg next)
(add-text-properties beg next '(lazy-lock t))
(setq beg (text-property-any next end 'lazy-lock nil))))
((error quit) (message "Fontifying region...%s" data)))))))))
(defun lazy-lock-fontify-chunk ()
;; Fontify the nearest chunk, for stealth, in the current buffer.
@ -1036,8 +1010,8 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; Install ourselves:
(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize)
(add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger)
(add-hook 'window-size-change-functions #'lazy-lock-fontify-after-resize)
(add-hook 'redisplay-end-trigger-functions #'lazy-lock-fontify-after-trigger)
(unless (assq 'lazy-lock-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil)))))

77
lisp/obsolete/pgg.el
View File

@ -1,4 +1,4 @@
;;; pgg.el --- glue for the various PGP implementations.
;;; pgg.el --- glue for the various PGP implementations. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
@ -34,68 +34,6 @@
;;; @ utility functions
;;;
(eval-when-compile
(when (featurep 'xemacs)
(defmacro pgg-run-at-time-1 (time repeat function args)
(if (condition-case nil
(let ((delete-itimer 'delete-itimer)
(itimer-driver-start 'itimer-driver-start)
(itimer-value 'itimer-value)
(start-itimer 'start-itimer))
(unless (or (symbol-value 'itimer-process)
(symbol-value 'itimer-timer))
(funcall itimer-driver-start))
;; Check whether there is a bug to which the difference of
;; the present time and the time when the itimer driver was
;; woken up is subtracted from the initial itimer value.
(let* ((inhibit-quit t)
(ctime (current-time))
(itimer-timer-last-wakeup
(prog1
ctime
(setcar ctime (1- (car ctime)))))
(itimer-list nil)
(itimer (funcall start-itimer "pgg-run-at-time"
'ignore 5)))
(sleep-for 0.1) ;; Accept the timeout interrupt.
(prog1
(> (funcall itimer-value itimer) 0)
(funcall delete-itimer itimer))))
(error nil))
`(let ((time ,time))
(apply #'start-itimer "pgg-run-at-time"
,function (if time (max time 1e-9) 1e-9)
,repeat nil t ,args))
`(let ((time ,time)
(itimers (list nil)))
(setcar
itimers
(apply #'start-itimer "pgg-run-at-time"
(lambda (itimers repeat function &rest args)
(let ((itimer (car itimers)))
(if repeat
(progn
(set-itimer-function
itimer
(lambda (itimer repeat function &rest args)
(set-itimer-restart itimer repeat)
(set-itimer-function itimer function)
(set-itimer-function-arguments itimer args)
(apply function args)))
(set-itimer-function-arguments
itimer
(append (list itimer repeat function) args)))
(set-itimer-function
itimer
(lambda (itimer function &rest args)
(delete-itimer itimer)
(apply function args)))
(set-itimer-function-arguments
itimer
(append (list itimer function) args)))))
1e-9 (if time (max time 1e-9) 1e-9)
nil t itimers ,repeat ,function ,args)))))))
(eval-and-compile
(if (featurep 'xemacs)
(progn
@ -117,9 +55,8 @@ or `cancel-timer'."
(require (intern (format "pgg-%s" scheme)))
(apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
(put 'pgg-save-coding-system 'lisp-indent-function 2)
(defmacro pgg-save-coding-system (start end &rest body)
(declare (indent 2) (debug t))
`(if (called-interactively-p 'interactive)
(let ((buffer (current-buffer)))
(with-temp-buffer
@ -209,7 +146,7 @@ regulate cache behavior."
(let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
(interned-timer-key (intern-soft key pgg-pending-timers))
(old-timer (symbol-value interned-timer-key))
new-timer)
) ;; new-timer
(when old-timer
(cancel-timer old-timer)
(unintern interned-timer-key pgg-pending-timers))
@ -265,9 +202,8 @@ regulate cache behavior."
(while (re-search-forward "\r$" pgg-conversion-end t)
(replace-match ""))))))
(put 'pgg-as-lbt 'lisp-indent-function 3)
(defmacro pgg-as-lbt (start end lbt &rest body)
(declare (indent 3) (debug t))
`(let ((inhibit-read-only t)
buffer-read-only
buffer-undo-list)
@ -277,9 +213,8 @@ regulate cache behavior."
(push nil buffer-undo-list)
(ignore-errors (undo))))
(put 'pgg-process-when-success 'lisp-indent-function 0)
(defmacro pgg-process-when-success (&rest body)
(declare (indent 0) (debug t))
`(with-current-buffer pgg-output-buffer
(if (zerop (buffer-size)) nil ,@body t)))
@ -377,7 +312,7 @@ passphrase cache or user."
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive "r")
(let* ((buf (current-buffer))
(let* (;; (buf (current-buffer))
(status
(pgg-save-coding-system start end
(pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)

9
lisp/org/org-agenda.el
View File

@ -3224,6 +3224,15 @@ s Search for keywords M Like m, but only TODO entries
(defvar org-agenda-overriding-cmd nil)
(defvar org-agenda-overriding-arguments nil)
(defvar org-agenda-overriding-cmd-arguments nil)
(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
(declare (indent 1))
(eval (cons 'let (cons list body))))
(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
(declare (indent 2))
(eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
(defun org-agenda-run-series (name series)
"Run agenda NAME as a SERIES of agenda commands."
(org-let (nth 1 series) '(org-agenda-prepare name))

2
lisp/org/org-element.el
View File

@ -4206,6 +4206,7 @@ looking into captions:
(lambda (b)
(and (org-element-map b \\='latex-snippet #\\='identity nil t) b))
nil nil nil t)"
(declare (indent 2))
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
(let* ((types (if (listp types) types (list types)))
(no-recursion (if (listp no-recursion) no-recursion
@ -4299,7 +4300,6 @@ looking into captions:
(funcall --walk-tree data)
;; Return value in a proper order.
(nreverse --acc)))))
(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
;;

58
lisp/org/org-macs.el
View File

@ -627,18 +627,10 @@ program is needed for, so that the error message can be more informative."
(let ((message-log-max nil))
(apply #'message args)))
(defun org-let (list &rest body)
(eval (cons 'let (cons list body))))
(put 'org-let 'lisp-indent-function 1)
(defun org-let2 (list1 list2 &rest body)
(eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
(put 'org-let2 'lisp-indent-function 2)
(defun org-eval (form)
"Eval FORM and return result."
(condition-case error
(eval form)
(eval form t)
(error (format "%%![Error: %s]" error))))
(defvar org-outline-regexp) ; defined in org.el
@ -1241,31 +1233,29 @@ Return 0. if S is not recognized as a valid value."
When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the
allowed keys for scrolling, as expected in the export dispatch
window."
(let ((scrlup (if additional-keys '(?\s 22) 22))
(scrldn (if additional-keys `(?\d 134217846) 134217846)))
(eval
`(cl-case ,key
;; C-n
(14 (if (not (pos-visible-in-window-p (point-max)))
(ignore-errors (scroll-up 1))
(message "End of buffer")
(sit-for 1)))
;; C-p
(16 (if (not (pos-visible-in-window-p (point-min)))
(ignore-errors (scroll-down 1))
(message "Beginning of buffer")
(sit-for 1)))
;; SPC or
(,scrlup
(if (not (pos-visible-in-window-p (point-max)))
(scroll-up nil)
(message "End of buffer")
(sit-for 1)))
;; DEL
(,scrldn (if (not (pos-visible-in-window-p (point-min)))
(scroll-down nil)
(message "Beginning of buffer")
(sit-for 1)))))))
(let ((scrlup (if additional-keys '(?\s ?\C-v) ?\C-v))
(scrldn (if additional-keys `(?\d ?\M-v) ?\M-v)))
(pcase key
(?\C-n (if (not (pos-visible-in-window-p (point-max)))
(ignore-errors (scroll-up 1))
(message "End of buffer")
(sit-for 1)))
(?\C-p (if (not (pos-visible-in-window-p (point-min)))
(ignore-errors (scroll-down 1))
(message "Beginning of buffer")
(sit-for 1)))
;; SPC or
((guard (memq key scrlup))
(if (not (pos-visible-in-window-p (point-max)))
(scroll-up nil)
(message "End of buffer")
(sit-for 1)))
;; DEL
((guard (memq key scrldn))
(if (not (pos-visible-in-window-p (point-min)))
(scroll-down nil)
(message "Beginning of buffer")
(sit-for 1))))))
(provide 'org-macs)

106
lisp/progmodes/antlr-mode.el
View File

@ -1,4 +1,4 @@
;;; antlr-mode.el --- major mode for ANTLR grammar files
;;; antlr-mode.el --- major mode for ANTLR grammar files -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -164,18 +164,10 @@
;; More compile-time-macros
(eval-when-compile
(defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el
(let ((modified (with-no-warnings (gensym "save-buffer-state-x-modified-"))))
`(let ((,modified (buffer-modified-p)))
(unwind-protect
(let ((buffer-undo-list t) (inhibit-read-only t)
,@(unless (featurep 'xemacs)
'((inhibit-point-motion-hooks t) deactivate-mark))
(inhibit-modification-hooks t)
buffer-file-name buffer-file-truename)
,@body)
(and (not ,modified) (buffer-modified-p)
(set-buffer-modified-p nil)))))))
(put 'save-buffer-state-x 'lisp-indent-function 0)
(declare (debug t) (indent 0))
`(let ((inhibit-point-motion-hooks t))
(with-silent-modifications
,@body))))
(defvar outline-level)
(defvar imenu-use-markers)
@ -188,7 +180,7 @@
;; Additional to the `defalias' below, we must set `antlr-c-forward-sws' to
;; `c-forward-syntactic-ws' when `c-forward-sws' is not defined after requiring
;; cc-mode.
(defalias 'antlr-c-forward-sws 'c-forward-sws)
(defalias 'antlr-c-forward-sws #'c-forward-sws)
;;;;##########################################################################
@ -231,7 +223,6 @@ value of `antlr-language' if the first group in the string matched by
REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.
An OPTION-VALUE of nil denotes the fallback element. MODELINE-STRING is
also displayed in the mode line next to \"Antlr\"."
:group 'antlr
:type '(repeat (group :value (java-mode "")
(function :tag "Major mode")
(string :tag "Mode line string")
@ -245,7 +236,6 @@ also displayed in the mode line next to \"Antlr\"."
Looks like \(LIMIT . REGEXP). Search for REGEXP from the beginning of
the buffer to LIMIT and use the first group in the matched string to set
the language according to `antlr-language-alist'."
:group 'antlr
:type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0))
regexp))
@ -259,7 +249,6 @@ the language according to `antlr-language-alist'."
If nil, the actions with their surrounding braces are hidden. If a
number, do not hide the braces, only hide the contents if its length is
greater than this number."
:group 'antlr
:type '(choice (const :tag "Completely hidden" nil)
(integer :tag "Hidden if longer than" :value 3)))
@ -268,7 +257,6 @@ greater than this number."
If nil, no continuation line of a block comment is changed. If t, they
are changed according to `c-indentation-line'. When not nil and not t,
they are only changed by \\[antlr-indent-command]."
:group 'antlr
:type '(radio (const :tag "No" nil)
(const :tag "Always" t)
(sexp :tag "With TAB" :format "%t" :value tab)))
@ -282,7 +270,6 @@ The first element whose MAJOR-MODE is nil or equal to `major-mode' and
whose REGEXP is nil or matches variable `buffer-file-name' is used to
set `tab-width' and `indent-tabs-mode'. This is useful to support both
ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'."
:group 'antlr
:type '(repeat (group :value (antlr-mode nil 8 nil)
(choice (const :tag "All" nil)
(function :tag "Major mode"))
@ -294,14 +281,12 @@ ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'."
"If non-nil, cc-mode indentation style used for `antlr-mode'.
See `c-set-style' and for details, where the most interesting part in
`c-style-alist' is the value of `c-basic-offset'."
:group 'antlr
:type '(choice (const nil) regexp))
(defcustom antlr-indent-item-regexp
"[]}):;|&]" ; & is local ANTLR extension (SGML's and-connector)
"Regexp matching lines which should be indented by one TAB less.
See `antlr-indent-line' and command \\[antlr-indent-command]."
:group 'antlr
:type 'regexp)
(defcustom antlr-indent-at-bol-alist
@ -316,7 +301,6 @@ If `antlr-language' equals to a MODE, the line starting at the first
non-whitespace is matched by the corresponding REGEXP, and the line is
part of a header action, indent the line at column 0 instead according
to the normal rules of `antlr-indent-line'."
:group 'antlr
:type '(repeat (cons (function :tag "Major mode") regexp)))
;; adopt indentation to cc-engine
@ -337,7 +321,6 @@ to the normal rules of `antlr-indent-line'."
"Non-nil, if the major mode menu should include option submenus.
If nil, the menu just includes a command to insert options. Otherwise,
it includes four submenus to insert file/grammar/rule/subrule options."
:group 'antlr
:type 'boolean)
(defcustom antlr-tool-version 20701
@ -349,7 +332,6 @@ version correct option values when using \\[antlr-insert-option].
Don't use a number smaller than 20600 since the stored history of
Antlr's options starts with v2.06.00, see `antlr-options-alists'. You
can make this variable buffer-local."
:group 'antlr
:type 'integer)
(defcustom antlr-options-auto-colon t
@ -358,7 +340,6 @@ A `:' is only inserted if this value is non-nil, if a rule or subrule
option is inserted with \\[antlr-insert-option], if there was no rule or
subrule options section before, and if a `:' is not already present
after the section, ignoring whitespace, comments and the init action."
:group 'antlr
:type 'boolean)
(defcustom antlr-options-style nil
@ -369,7 +350,6 @@ identifier.
The only style symbol used in the default value of `antlr-options-alist'
is `language-as-string'. See also `antlr-read-value'."
:group 'antlr
:type '(repeat (symbol :tag "Style symbol")))
(defcustom antlr-options-push-mark t
@ -380,7 +360,6 @@ number, only set mark if point was outside the options area before and
the number of lines between point and the insert position is greater
than this value. Otherwise, only set mark if point was outside the
options area before."
:group 'antlr
:type '(radio (const :tag "No" nil)
(const :tag "Always" t)
(integer :tag "Lines between" :value 10)
@ -391,7 +370,6 @@ options area before."
This string is only used if the option to insert did not exist before
or if there was no `=' after it. In other words, the spacing around an
existing `=' won't be changed when changing an option value."
:group 'antlr
:type 'string)
@ -576,13 +554,11 @@ AS-STRING is non-nil and is either t or a symbol which is a member of
"Command used in \\[antlr-run-tool] to run the Antlr tool.
This variable should include all options passed to Antlr except the
option \"-glib\" which is automatically suggested if necessary."
:group 'antlr
:type 'string)
(defcustom antlr-ask-about-save t
"If not nil, \\[antlr-run-tool] asks which buffers to save.
Otherwise, it saves all modified buffers before running without asking."
:group 'antlr
:type 'boolean)
(defcustom antlr-makefile-specification
@ -604,7 +580,6 @@ Then, GEN-VAR is a string with the name of the variable which contains
the file names of all makefile rules. GEN-VAR-FORMAT is a format string
producing the variable of each target with substitution COUNT/%d where
COUNT starts with 1. GEN-SEP is used to separate long variable values."
:group 'antlr
:type '(list (string :tag "Rule separator")
(choice
(const :tag "Direct targets" nil)
@ -683,7 +658,6 @@ DIRECTORY is the name of the current directory.")
"Non-nil, if a \"Index\" menu should be added to the menubar.
If it is a string, it is used instead \"Index\". Requires package
imenu."
:group 'antlr
:type '(choice (const :tag "No menu" nil)
(const :tag "Index menu" t)
(string :tag "Other menu name")))
@ -780,7 +754,6 @@ bound to `antlr-language'. For example, with value
((java-mode . 2) (c++-mode . 0))
Java actions are fontified with level 2 and C++ actions are not
fontified at all."
:group 'antlr
:type '(choice (const :tag "None" none)
(const :tag "Inherit" inherit)
(const :tag "Default" nil)
@ -824,52 +797,45 @@ in the grammar's actions and semantic predicates, see
(defface antlr-default '((t nil))
"Face to prevent strings from language dependent highlighting.
Do not change."
:group 'antlr)
Do not change.")
(defface antlr-keyword
(cond-emacs-xemacs
'((((class color) (background light))
(:foreground "black" :EMACS :weight bold :XEMACS :bold t))
(t :inherit font-lock-keyword-face)))
"ANTLR keywords."
:group 'antlr)
"ANTLR keywords.")
(defface antlr-syntax
(cond-emacs-xemacs
'((((class color) (background light))
(:foreground "black" :EMACS :weight bold :XEMACS :bold t))
(t :inherit font-lock-constant-face)))
"ANTLR syntax symbols like :, |, (, ), ...."
:group 'antlr)
"ANTLR syntax symbols like :, |, (, ), ....")
(defface antlr-ruledef
(cond-emacs-xemacs
'((((class color) (background light))
(:foreground "blue" :EMACS :weight bold :XEMACS :bold t))
(t :inherit font-lock-function-name-face)))
"ANTLR rule references (definition)."
:group 'antlr)
"ANTLR rule references (definition).")
(defface antlr-tokendef
(cond-emacs-xemacs
'((((class color) (background light))
(:foreground "blue" :EMACS :weight bold :XEMACS :bold t))
(t :inherit font-lock-function-name-face)))
"ANTLR token references (definition)."
:group 'antlr)
"ANTLR token references (definition).")
(defface antlr-ruleref
'((((class color) (background light)) (:foreground "blue4"))
(t :inherit font-lock-type-face))
"ANTLR rule references (usage)."
:group 'antlr)
"ANTLR rule references (usage).")
(defface antlr-tokenref
'((((class color) (background light)) (:foreground "orange4"))
(t :inherit font-lock-type-face))
"ANTLR token references (usage)."
:group 'antlr)
"ANTLR token references (usage).")
(defface antlr-literal
(cond-emacs-xemacs
@ -878,8 +844,7 @@ Do not change."
(t :inherit font-lock-string-face)))
"ANTLR special literal tokens.
It is used to highlight strings matched by the first regexp group of
`antlr-font-lock-literal-regexp'."
:group 'antlr)
`antlr-font-lock-literal-regexp'.")
(defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\""
"Regexp matching literals with special syntax highlighting, or nil.
@ -887,7 +852,6 @@ If nil, there is no special syntax highlighting for some literals.
Otherwise, it should be a regular expression which must contain a regexp
group. The string matched by the first group is highlighted with
`antlr-font-lock-literal-face'."
:group 'antlr
:type '(choice (const :tag "None" nil) regexp))
(defvar antlr-class-header-regexp
@ -1016,15 +980,6 @@ Used for `antlr-slow-syntactic-context'.")
;;;===========================================================================
;; From help.el (XEmacs-21.1), without `copy-syntax-table'
(defmacro antlr-with-syntax-table (syntab &rest body)
"Evaluate BODY with the syntax table SYNTAB."
`(let ((stab (syntax-table)))
(unwind-protect
(progn (set-syntax-table ,syntab) ,@body)
(set-syntax-table stab))))
(put 'antlr-with-syntax-table 'lisp-indent-function 1)
(put 'antlr-with-syntax-table 'edebug-form-spec '(form body))
(defunx antlr-default-directory ()
:xemacs-and-try default-directory
"Return `default-directory'."
@ -1229,7 +1184,8 @@ See `antlr-font-lock-additional-keywords', `antlr-language' and
antlr-font-lock-keywords-alist))
(if (eq antlr-font-lock-maximum-decoration 'inherit)
font-lock-maximum-decoration
antlr-font-lock-maximum-decoration)))))))
antlr-font-lock-maximum-decoration)))
t))))
;;;===========================================================================
@ -1248,7 +1204,7 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names."
(continue t))
;; The generic imenu function searches backward, which is slower
;; and more likely not to work during editing.
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(goto-char (point-min))
(antlr-skip-file-prelude t)
@ -1392,7 +1348,7 @@ Move to the beginning of the current rule if point is inside a rule."
A grammar class header and the file prelude are also considered as a
rule."
(save-excursion
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(not (antlr-outside-rule-p)))))
(defunx antlr-end-of-rule (&optional arg)
@ -1403,7 +1359,7 @@ rule. If ARG is zero, run `antlr-end-of-body'."
(interactive "_p")
(if (zerop arg)
(antlr-end-of-body)
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-next-rule arg nil))))
(defunx antlr-beginning-of-rule (&optional arg)
@ -1414,7 +1370,7 @@ of rule. If ARG is zero, run `antlr-beginning-of-body'."
(interactive "_p")
(if (zerop arg)
(antlr-beginning-of-body)
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-next-rule (- arg) t))))
(defunx antlr-end-of-body (&optional msg)
@ -1422,7 +1378,7 @@ of rule. If ARG is zero, run `antlr-beginning-of-body'."
A grammar class header is also considered as a rule. With optional
prefix arg MSG, move to `:'."
(interactive "_")
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(let ((orig (point)))
(if (antlr-outside-rule-p)
(error "Outside an ANTLR rule"))
@ -1458,7 +1414,7 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'."
(let ((literals 0))
(save-excursion
(goto-char (point-min))
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil)
(funcall transform (match-beginning 0) (match-end 0))
@ -1487,7 +1443,7 @@ Display a message unless optional argument SILENT is non-nil."
(antlr-hide-actions 0 t)
(save-excursion
(goto-char (point-min))
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(while (antlr-re-search-forward regexp nil)
(let ((beg (ignore-errors-x (scan-sexps (point) -1))))
@ -1708,7 +1664,7 @@ is undefined."
(widen)
(if (eq requested 1)
1
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(let* ((orig (point))
(outsidep (antlr-outside-rule-p))
@ -2086,7 +2042,7 @@ its export vocabulary is used as an import vocabulary."
(unless buffer-file-name
(error "Grammar buffer does not visit a file"))
(let (classes export-vocabs import-vocabs superclasses default-vocab)
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(goto-char (point-min))
(while (antlr-re-search-forward antlr-class-header-regexp nil)
;; parse class definition --------------------------------------------
@ -2385,7 +2341,7 @@ to a lesser extent, `antlr-tab-offset-alist'."
(skip-chars-forward " \t")
(setq boi (point))
;; check syntax at beginning of indentation ----------------------------
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(setq syntax (antlr-syntactic-context))
(cond ((symbolp syntax)
@ -2481,7 +2437,7 @@ ANTLR's syntax and influences the auto indentation, see
(interactive "*P")
(if (or arg
(save-excursion (skip-chars-backward " \t") (not (bolp)))
(antlr-with-syntax-table antlr-action-syntax-table
(with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(let ((context (antlr-syntactic-context)))
(not (and (numberp context)
@ -2524,7 +2480,7 @@ ANTLR's syntax and influences the auto indentation, see
(while settings
(when (boundp (car settings))
(ignore-errors
(set (car settings) (eval (cadr settings)))))
(set (car settings) (eval (cadr settings) t))))
(setq settings (cddr settings)))))
(defun antlr-language-option (search)
@ -2583,8 +2539,8 @@ the default language."
(antlr-c-init-language-vars))) ; do it myself
(c-basic-common-init antlr-language (or antlr-indent-style "gnu"))
(set (make-local-variable 'outline-regexp) "[^#\n\^M]")
(set (make-local-variable 'outline-level) 'c-outline-level) ;TODO: define own
(set (make-local-variable 'indent-line-function) 'antlr-indent-line)
(set (make-local-variable 'outline-level) #'c-outline-level) ;TODO: define own
(set (make-local-variable 'indent-line-function) #'antlr-indent-line)
(set (make-local-variable 'indent-region-function) nil) ; too lazy
(setq comment-start "// "
comment-end ""
@ -2594,7 +2550,7 @@ the default language."
(when (featurep 'xemacs)
(easy-menu-add antlr-mode-menu))
(set (make-local-variable 'imenu-create-index-function)
'antlr-imenu-create-index-function)
#'antlr-imenu-create-index-function)
(set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test
(and antlr-imenu-name ; there should be a global variable...
(fboundp 'imenu-add-to-menubar)

2
test/lisp/emacs-lisp/bytecomp-tests.el
View File

@ -495,6 +495,7 @@ Subtests signal errors if something goes wrong."
(insert "\n"))))
(defun test-byte-comp-compile-and-load (compile &rest forms)
(declare (indent 1))
(let ((elfile nil)
(elcfile nil))
(unwind-protect
@ -513,7 +514,6 @@ Subtests signal errors if something goes wrong."
(load elfile nil 'nomessage))
(when elfile (delete-file elfile))
(when elcfile (delete-file elcfile)))))
(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1)
(ert-deftest test-byte-comp-macro-expansion ()
(test-byte-comp-compile-and-load t

3
test/lisp/emacs-lisp/generator-tests.el
View File

@ -45,6 +45,7 @@
BODY twice: once using ordinary `eval' and once using
lambda-generators. The test ensures that the two forms produce
identical output."
(declare (indent 1))
`(progn
(ert-deftest ,name ()
(should
@ -62,8 +63,6 @@ identical output."
(let ((cps-inhibit-atomic-optimization t))
(iter-lambda () (iter-yield (progn ,@body)))))))))))
(put 'cps-testcase 'lisp-indent-function 1)
(defvar *cps-test-i* nil)
(defun cps-get-test-i ()
*cps-test-i*)