(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 "=")
(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."
-;;; 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.
- 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.
;;; 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
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil
)
(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))
)
(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))
(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))
(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))
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (cadr (cadr form)))
nil nil
)
(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))
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil
)
(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))
)
(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))
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil nil
)
(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))
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-variable
(symbol-name (nth 2 form))
nil
)
(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)
)
(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)
""))))
(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)))
((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.
;; 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
(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."
-;;; 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.
(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
;;
(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
(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."
: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.
: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
-;;; 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.
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))
(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))
;;; 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.
(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))
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)
-;;; 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.
;;;###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 :-(
"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)
-
\f
;;; Miscellaneous
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))
(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)
(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)
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"))
(goto-char ,original-position)
(set-marker ,original-position nil)
(select-window ,original-window))))))
-(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
\f
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))
(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)
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)
(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."
-;;; 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.
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))
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.
-;;; 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.
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.
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.
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)
\f
-;;; 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.
(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\";
# }
"
"Template sieve script."
- :type 'string
- :group 'sieve)
+ :type 'string)
;; Internal variables:
;; 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'.")
(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"))
(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"))
(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"))
(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)
-;;; 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.
(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)
(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.
: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)
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)
(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))
"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))))))))
\f
;; 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))
(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)
-;;; 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.
(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."
(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.
(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.
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.
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.
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.
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)
: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.
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)
\f
;; User Functions:
;; 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.
;; 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
;; 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))))
\f
;; Fontification functions.
(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.
\f
;; 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)))))
-;;; 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.
;;; @ 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
(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
(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))
(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)
(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)))
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)
(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))
(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
(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.
;;
(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
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)
-;;; 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.
;; 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)
;; 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)
;;;;##########################################################################
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")
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))
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)))
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)))
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"))
"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
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
"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
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
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
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
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)
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)
"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
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)
"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")))
((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)
(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
(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.
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
;;;===========================================================================
;; 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'."
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))))
;;;===========================================================================
(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)
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)
(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)
(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)
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"))
(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))
(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))))
(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))
(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 --------------------------------------------
(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)
(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)
(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)
(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 ""
(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)
(insert "\n"))))
(defun test-byte-comp-compile-and-load (compile &rest forms)
+ (declare (indent 1))
(let ((elfile nil)
(elcfile nil))
(unwind-protect
(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
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
(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*)
projects / emacs.git / commitdiff