2015-09-28 22:39:14 +00:00
|
|
|
|
;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*-
|
1992-07-15 21:31:44 +00:00
|
|
|
|
|
2024-02-04 09:28:18 +00:00
|
|
|
|
;; Copyright (C) 1985-2024 Free Software Foundation, Inc.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
2019-05-25 20:43:06 +00:00
|
|
|
|
;; Maintainer: emacs-devel@gnu.org
|
2002-05-02 05:41:46 +00:00
|
|
|
|
;; Keywords: internal
|
2010-08-29 16:17:13 +00:00
|
|
|
|
;; Package: emacs
|
2002-05-02 05:41:46 +00:00
|
|
|
|
|
1990-11-05 10:06:02 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1990-11-05 10:06:02 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 22:52:52 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
2021-09-22 18:26:40 +00:00
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
2019-06-23 17:07:38 +00:00
|
|
|
|
;;; Code:
|
2016-05-27 19:45:21 +00:00
|
|
|
|
|
|
|
|
|
;; declare-function's args use &rest, not &optional, for compatibility
|
|
|
|
|
;; with byte-compile-macroexpand-declare-function.
|
|
|
|
|
|
2016-05-27 02:10:26 +00:00
|
|
|
|
(defmacro declare-function (_fn _file &rest _args)
|
2007-12-03 00:33:35 +00:00
|
|
|
|
"Tell the byte-compiler that function FN is defined, in FILE.
|
2013-06-11 16:51:12 +00:00
|
|
|
|
The FILE argument is not used by the byte-compiler, but by the
|
2007-12-03 00:33:35 +00:00
|
|
|
|
`check-declare' package, which checks that FILE contains a
|
2021-07-23 13:12:03 +00:00
|
|
|
|
definition for FN. (FILE can be nil, and that disables this
|
|
|
|
|
check.)
|
2007-12-03 00:33:35 +00:00
|
|
|
|
|
|
|
|
|
FILE can be either a Lisp file (in which case the \".el\"
|
|
|
|
|
extension is optional), or a C file. C files are expanded
|
|
|
|
|
relative to the Emacs \"src/\" directory. Lisp files are
|
|
|
|
|
searched for using `locate-library', and if that fails they are
|
|
|
|
|
expanded relative to the location of the file containing the
|
|
|
|
|
declaration. A FILE with an \"ext:\" prefix is an external file.
|
|
|
|
|
`check-declare' will check such files if they are found, and skip
|
|
|
|
|
them without error if they are not.
|
|
|
|
|
|
2023-04-05 09:31:01 +00:00
|
|
|
|
Optional ARGLIST specifies FN's arguments, in the same form as
|
|
|
|
|
in `defun' (including the parentheses); or it is t to not specify
|
2016-05-28 01:16:24 +00:00
|
|
|
|
FN's arguments. An omitted ARGLIST defaults to t, not nil: a nil
|
2016-05-27 16:46:44 +00:00
|
|
|
|
ARGLIST specifies an empty argument list, and an explicit t
|
|
|
|
|
ARGLIST is a placeholder that allows supplying a later arg.
|
2016-05-28 01:16:24 +00:00
|
|
|
|
|
|
|
|
|
Optional FILEONLY non-nil means that `check-declare' will check
|
|
|
|
|
only that FILE exists, not that it defines FN. This is intended
|
|
|
|
|
for function definitions that `check-declare' does not recognize,
|
|
|
|
|
e.g., `defstruct'.
|
2007-12-03 00:33:35 +00:00
|
|
|
|
|
|
|
|
|
Note that for the purposes of `check-declare', this statement
|
2009-10-01 02:03:38 +00:00
|
|
|
|
must be the first non-whitespace on a line.
|
2007-12-03 00:33:35 +00:00
|
|
|
|
|
2008-12-13 04:12:45 +00:00
|
|
|
|
For more information, see Info node `(elisp)Declaring Functions'."
|
2016-05-28 01:16:24 +00:00
|
|
|
|
(declare (advertised-calling-convention
|
|
|
|
|
(fn file &optional arglist fileonly) nil))
|
2021-12-05 21:12:26 +00:00
|
|
|
|
;; Does nothing - `byte-compile-macroexpand-declare-function' does
|
|
|
|
|
;; the work.
|
2007-12-03 00:33:35 +00:00
|
|
|
|
nil)
|
2008-10-20 16:14:06 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Basic Lisp macros.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(defalias 'not #'null)
|
|
|
|
|
(defalias 'sxhash #'sxhash-equal)
|
2001-11-08 00:57:57 +00:00
|
|
|
|
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(defmacro noreturn (form)
|
2005-12-30 02:59:47 +00:00
|
|
|
|
"Evaluate FORM, expecting it not to return.
|
|
|
|
|
If FORM does return, signal an error."
|
* lisp/emacs-lisp/edebug.el: Miscellaneous cleanup.
Remove obsolete byte-compiler hack that tried to silence some warnings.
(edebug-submit-bug-report): Remove.
(edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
Remove aliases, use the un-prefixed name instead.
(edebug-pop-to-buffer): Consider other frames.
(edebug-original-read):: Make it more obvious that it's always defined.
(edebug--make-form-data-entry, edebug--form-data-name)
(edebug--form-data-begin, edebug--form-data-end): Rename from the
single-dashed name, and implement with cl-defstruct.
(edebug-set-form-data-entry): Use the standard accessors.
(edebug-make-top-form-data-entry): Use push.
(edebug-no-match): Drop useless `funcall'.
(mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
to functions.
(defsubst, dont-compile, eval-when-compile, eval-and-compile)
(delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
(with-syntax-table, push, pop, 1value, noreturn, defadvice)
(easy-menu-define, with-custom-print): Remove redundant specs.
(edebug-outside-overriding-local-map)
(edebug-outside-overriding-terminal-local-map): Remove, unused.
(edebug--display): Bind unread-command-events directly to nil rather
than binding it to unread-command-events and later setting it to nil.
(edebug--display): Kill edebug-eval-buffer here...
(edebug--recursive-edit): ...rather than here.
Bind standard-output and standard-input.
(edebug-eval): Check cl-macroexpand-all is fboundp.
(edebug-temp-display-freq-count): Fix last change.
* lisp/emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
* lisp/subr.el (noreturn, 1value): Add `debug' spec.
* lisp/emacs-lisp/advice.el: Require cl-lib.
(ad-copy-tree): Remove, use copy-tree instead.
(ad-dolist): Remove use dolist or cl-dolist instead.
(ad-do-return): Remove, use cl-return instead.
(defadvice): Add `debug' spec.
2012-09-14 03:55:16 +00:00
|
|
|
|
(declare (debug t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
`(prog1 ,form
|
Go back to grave quoting in source-code docstrings etc.
This reverts almost all my recent changes to use curved quotes
in docstrings and/or strings used for error diagnostics.
There are a few exceptions, e.g., Bahá’í proper names.
* admin/unidata/unidata-gen.el (unidata-gen-table):
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/align.el (align-region):
* lisp/allout.el (allout-mode, allout-solicit-alternate-bullet)
(outlineify-sticky):
* lisp/apropos.el (apropos-library):
* lisp/bookmark.el (bookmark-default-annotation-text):
* lisp/button.el (button-category-symbol, button-put)
(make-text-button):
* lisp/calc/calc-aent.el (math-read-if, math-read-factor):
* lisp/calc/calc-embed.el (calc-do-embedded):
* lisp/calc/calc-ext.el (calc-user-function-list):
* lisp/calc/calc-graph.el (calc-graph-show-dumb):
* lisp/calc/calc-help.el (calc-describe-key)
(calc-describe-thing, calc-full-help):
* lisp/calc/calc-lang.el (calc-c-language)
(math-parse-fortran-vector-end, math-parse-tex-sum)
(math-parse-eqn-matrix, math-parse-eqn-prime)
(calc-yacas-language, calc-maxima-language, calc-giac-language)
(math-read-giac-subscr, math-read-math-subscr)
(math-read-big-rec, math-read-big-balance):
* lisp/calc/calc-misc.el (calc-help, report-calc-bug):
* lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes)
(calc-auto-recompute):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-read-parse-table-part, calc-user-define-invocation)
(math-do-arg-check):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-vec.el (math-read-brackets):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calc/calc.el (calc, calc-do, calc-user-invocation):
* lisp/calendar/appt.el (appt-display-message):
* lisp/calendar/diary-lib.el (diary-check-diary-file)
(diary-mail-entries, diary-from-outlook):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--convert-float-to-ical)
(icalendar--convert-date-to-ical)
(icalendar--convert-ical-to-diary)
(icalendar--convert-recurring-to-diary)
(icalendar--add-diary-entry):
* lisp/calendar/time-date.el (format-seconds):
* lisp/calendar/timeclock.el (timeclock-mode-line-display)
(timeclock-make-hours-explicit, timeclock-log-data):
* lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category)
(todo-item-mark, todo-check-format)
(todo-insert-item--next-param, todo-edit-item--next-key)
(todo-mode):
* lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules):
* lisp/cedet/mode-local.el (describe-mode-local-overload)
(mode-local-print-binding, mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-displayor-show-request):
* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-start.el (standard):
* lisp/cus-theme.el (describe-theme-1):
* lisp/custom.el (custom-add-dependencies, custom-check-theme)
(custom--sort-vars-1, load-theme):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log):
* lisp/emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-read-advice-name, ad-enable-advice)
(ad-disable-advice, ad-remove-advice, ad-set-argument)
(ad-set-arguments, ad--defalias-fset, ad-activate)
(ad-deactivate):
* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand)
(byte-compile-unfold-lambda, byte-optimize-form-code-walker)
(byte-optimize-while, byte-optimize-apply):
* lisp/emacs-lisp/byte-run.el (defun, defsubst):
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode)
(byte-compile-log-file, byte-compile-format-warn)
(byte-compile-nogroup-warn, byte-compile-arglist-warn)
(byte-compile-cl-warn)
(byte-compile-warn-about-unresolved-functions)
(byte-compile-file, byte-compile--declare-var)
(byte-compile-file-form-defmumble, byte-compile-form)
(byte-compile-normal-call, byte-compile-check-variable)
(byte-compile-variable-ref, byte-compile-variable-set)
(byte-compile-subr-wrong-args, byte-compile-setq-default)
(byte-compile-negation-optimizer)
(byte-compile-condition-case--old)
(byte-compile-condition-case--new, byte-compile-save-excursion)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form)
(byte-compile-make-variable-buffer-local, display-call-tree)
(batch-byte-compile):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use):
* lisp/emacs-lisp/chart.el (chart-space-usage):
* lisp/emacs-lisp/check-declare.el (check-declare-scan)
(check-declare-warn, check-declare-file)
(check-declare-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine)
(checkdoc-message-text-engine):
* lisp/emacs-lisp/cl-extra.el (cl-parse-integer)
(cl--describe-class):
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric)
(cl--generic-describe, cl-generic-generalizers):
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody)
(cl-symbol-macrolet):
* lisp/emacs-lisp/cl.el (cl-unload-function, flet):
* lisp/emacs-lisp/copyright.el (copyright)
(copyright-update-directory):
* lisp/emacs-lisp/edebug.el (edebug-read-list):
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-read):
* lisp/emacs-lisp/eieio-core.el (eieio--slot-override)
(eieio-oref):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor):
* lisp/emacs-lisp/eieio-speedbar.el:
(eieio-speedbar-child-make-tag-lines)
(eieio-speedbar-child-description):
* lisp/emacs-lisp/eieio.el (defclass, change-class):
* lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms)
(elint-init-form, elint-check-defalias-form)
(elint-check-let-form):
* lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu)
(ert-results-pop-to-backtrace-for-test-at-point)
(ert-results-pop-to-messages-for-test-at-point)
(ert-results-pop-to-should-forms-for-test-at-point)
(ert-describe-test):
* lisp/emacs-lisp/find-func.el (find-function-search-for-symbol)
(find-function-library):
* lisp/emacs-lisp/generator.el (iter-yield):
* lisp/emacs-lisp/gv.el (gv-define-simple-setter):
* lisp/emacs-lisp/lisp-mnt.el (lm-verify):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring)
(advice--make, define-advice):
* lisp/emacs-lisp/package-x.el (package-upload-file):
* lisp/emacs-lisp/package.el (package-version-join)
(package-disabled-p, package-activate-1, package-activate)
(package--download-one-archive)
(package--download-and-read-archives)
(package-compute-transaction, package-install-from-archive)
(package-install, package-install-selected-packages)
(package-delete, package-autoremove, describe-package-1)
(package-install-button-action, package-delete-button-action)
(package-menu-hide-package, package-menu--list-to-prompt)
(package-menu--perform-transaction)
(package-menu--find-and-notify-upgrades):
* lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1):
* lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode):
* lisp/emacs-lisp/ring.el (ring-previous, ring-next):
* lisp/emacs-lisp/rx.el (rx-check, rx-anything)
(rx-check-any-string, rx-check-any, rx-check-not, rx-=)
(rx-repeat, rx-check-backref, rx-syntax, rx-check-category)
(rx-form):
* lisp/emacs-lisp/smie.el (smie-config-save):
* lisp/emacs-lisp/subr-x.el (internal--check-binding):
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag):
* lisp/emacs-lisp/testcover.el (testcover-1value):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments)
(viper-toggle-search-style, viper-kill-buffer)
(viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/env.el (setenv):
* lisp/erc/erc-button.el (erc-nick-popup):
* lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english):
* lisp/eshell/em-dirs.el (eshell/cd):
* lisp/eshell/em-glob.el (eshell-glob-regexp)
(eshell-glob-entries):
* lisp/eshell/em-pred.el (eshell-parse-modifiers):
* lisp/eshell/esh-opt.el (eshell-show-usage):
* lisp/facemenu.el (facemenu-add-new-face)
(facemenu-add-new-color):
* lisp/faces.el (read-face-name, read-face-font, describe-face)
(x-resolve-font-name):
* lisp/files-x.el (modify-file-local-variable):
* lisp/files.el (locate-user-emacs-file, find-alternate-file)
(set-auto-mode, hack-one-local-variable--obsolete)
(dir-locals-set-directory-class, write-file, basic-save-buffer)
(delete-directory, copy-directory, recover-session)
(recover-session-finish, insert-directory)
(file-modes-char-to-who, file-modes-symbolic-to-number)
(move-file-to-trash):
* lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer):
* lisp/find-cmd.el (find-generic, find-to-string):
* lisp/finder.el (finder-commentary):
* lisp/font-lock.el (font-lock-fontify-buffer):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/frame.el (get-device-terminal, select-frame-by-name):
* lisp/fringe.el (fringe--check-style):
* lisp/gnus/nnmairix.el (nnmairix-widget-create-query):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--parent-mode)
(help-fns--obsolete, help-fns--interactive-only)
(describe-function-1, describe-variable):
* lisp/help.el (describe-mode)
(describe-minor-mode-from-indicator):
* lisp/image.el (image-type):
* lisp/international/ccl.el (ccl-dump):
* lisp/international/fontset.el (x-must-resolve-font-name):
* lisp/international/mule-cmds.el (prefer-coding-system)
(select-safe-coding-system-interactively)
(select-safe-coding-system, activate-input-method)
(toggle-input-method, describe-current-input-method)
(describe-language-environment):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/mail/feedmail.el (feedmail-run-the-queue):
* lisp/mouse.el (minor-mode-menu-from-indicator):
* lisp/mpc.el (mpc-playlist-rename):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-shell-command):
* lisp/net/imap.el (imap-interactive-login):
* lisp/net/mairix.el (mairix-widget-create-query):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/rlogin.el (rlogin):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/obsolete/otodo-mode.el (todo-more-important-p):
* lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region):
* lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region):
* lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region):
* lisp/org/ob-core.el (org-babel-goto-named-src-block)
(org-babel-goto-named-result):
* lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap):
* lisp/org/ob-ref.el (org-babel-ref-resolve):
* lisp/org/org-agenda.el (org-agenda-prepare):
* lisp/org/org-clock.el (org-clock-notify-once-if-expired)
(org-clock-resolve):
* lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/org/org-feed.el (org-feed-parse-atom-entry):
* lisp/org/org-habit.el (org-habit-parse-todo):
* lisp/org/org-mouse.el (org-mouse-popup-global-menu)
(org-mouse-context-menu):
* lisp/org/org-table.el (org-table-edit-formulas):
* lisp/org/ox.el (org-export-async-start):
* lisp/proced.el (proced-log):
* lisp/progmodes/ada-mode.el (ada-get-indent-case)
(ada-check-matching-start, ada-goto-matching-start):
* lisp/progmodes/ada-prj.el (ada-prj-display-page):
* lisp/progmodes/ada-xref.el (ada-find-executable):
* lisp/progmodes/ebrowse.el (ebrowse-tags-apropos):
* lisp/progmodes/etags.el (etags-tags-apropos-additional):
* lisp/progmodes/flymake.el (flymake-parse-err-lines)
(flymake-start-syntax-check-process):
* lisp/progmodes/python.el (python-shell-get-process-or-error)
(python-define-auxiliary-skeleton):
* lisp/progmodes/sql.el (sql-comint):
* lisp/progmodes/verilog-mode.el (verilog-load-file-at-point):
* lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate):
* lisp/recentf.el (recentf-open-files):
* lisp/replace.el (query-replace-read-from)
(occur-after-change-function, occur-1):
* lisp/scroll-bar.el (scroll-bar-columns):
* lisp/server.el (server-get-auth-key):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, list-processes--refresh)
(compose-mail, set-variable, choose-completion-string)
(define-alternatives):
* lisp/startup.el (site-run-file, tty-handle-args, command-line)
(command-line-1):
* lisp/subr.el (noreturn, define-error, add-to-list)
(read-char-choice, version-to-list):
* lisp/term/common-win.el (x-handle-xrm-switch)
(x-handle-name-switch, x-handle-args):
* lisp/term/x-win.el (x-handle-parent-id, x-handle-smid):
* lisp/textmodes/reftex-ref.el (reftex-label):
* lisp/textmodes/reftex-toc.el (reftex-toc-rename-label):
* lisp/textmodes/two-column.el (2C-split):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* lisp/type-break.el (type-break-noninteractive-query):
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
* lisp/whitespace.el (whitespace-report-region):
Prefer grave quoting in source-code strings used to generate help
and diagnostics.
* lisp/faces.el (face-documentation):
No need to convert quotes, since the result is a docstring.
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
Simplify by generating only curved quotes, since info files are
typically that ways nowadays anyway.
* lisp/international/mule-diag.el (list-input-methods):
Don’t assume text quoting style is curved.
* lisp/org/org-bibtex.el (org-bibtex-fields):
Revert my recent changes, going back to the old quoting style.
2015-09-07 15:41:44 +00:00
|
|
|
|
(error "Form marked with `noreturn' did return")))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
|
|
|
|
(defmacro 1value (form)
|
2005-12-30 02:59:47 +00:00
|
|
|
|
"Evaluate FORM, expecting a constant return value.
|
2017-09-25 20:45:07 +00:00
|
|
|
|
If FORM returns differing values when running under Testcover,
|
|
|
|
|
Testcover will raise an error."
|
* lisp/emacs-lisp/edebug.el: Miscellaneous cleanup.
Remove obsolete byte-compiler hack that tried to silence some warnings.
(edebug-submit-bug-report): Remove.
(edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
Remove aliases, use the un-prefixed name instead.
(edebug-pop-to-buffer): Consider other frames.
(edebug-original-read):: Make it more obvious that it's always defined.
(edebug--make-form-data-entry, edebug--form-data-name)
(edebug--form-data-begin, edebug--form-data-end): Rename from the
single-dashed name, and implement with cl-defstruct.
(edebug-set-form-data-entry): Use the standard accessors.
(edebug-make-top-form-data-entry): Use push.
(edebug-no-match): Drop useless `funcall'.
(mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
to functions.
(defsubst, dont-compile, eval-when-compile, eval-and-compile)
(delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
(with-syntax-table, push, pop, 1value, noreturn, defadvice)
(easy-menu-define, with-custom-print): Remove redundant specs.
(edebug-outside-overriding-local-map)
(edebug-outside-overriding-terminal-local-map): Remove, unused.
(edebug--display): Bind unread-command-events directly to nil rather
than binding it to unread-command-events and later setting it to nil.
(edebug--display): Kill edebug-eval-buffer here...
(edebug--recursive-edit): ...rather than here.
Bind standard-output and standard-input.
(edebug-eval): Check cl-macroexpand-all is fboundp.
(edebug-temp-display-freq-count): Fix last change.
* lisp/emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
* lisp/subr.el (noreturn, 1value): Add `debug' spec.
* lisp/emacs-lisp/advice.el: Require cl-lib.
(ad-copy-tree): Remove, use copy-tree instead.
(ad-dolist): Remove use dolist or cl-dolist instead.
(ad-do-return): Remove, use cl-return instead.
(defadvice): Add `debug' spec.
2012-09-14 03:55:16 +00:00
|
|
|
|
(declare (debug t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
form)
|
|
|
|
|
|
2006-07-09 02:00:10 +00:00
|
|
|
|
(defmacro def-edebug-spec (symbol spec)
|
2021-02-13 00:28:25 +00:00
|
|
|
|
"Set the Edebug SPEC to use for sexps which have SYMBOL as head.
|
2009-07-14 07:45:56 +00:00
|
|
|
|
Both SYMBOL and SPEC are unevaluated. The SPEC can be:
|
|
|
|
|
0 (instrument no arguments); t (instrument all arguments);
|
|
|
|
|
a symbol (naming a function with an Edebug specification); or a list.
|
|
|
|
|
The elements of the list describe the argument types; see
|
2011-05-28 19:36:02 +00:00
|
|
|
|
Info node `(elisp)Specification List' for details."
|
2021-02-12 21:08:01 +00:00
|
|
|
|
(declare (indent 1))
|
2006-07-09 02:00:10 +00:00
|
|
|
|
`(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
|
|
|
|
|
|
2021-02-13 00:28:25 +00:00
|
|
|
|
(defun def-edebug-elem-spec (name spec)
|
|
|
|
|
"Define a new Edebug spec element NAME as shorthand for SPEC.
|
2021-02-15 02:13:35 +00:00
|
|
|
|
The SPEC has to be a list."
|
2021-02-13 00:28:25 +00:00
|
|
|
|
(declare (indent 1))
|
|
|
|
|
(when (string-match "\\`[&:]" (symbol-name name))
|
|
|
|
|
;; & and : have special meaning in spec element names.
|
|
|
|
|
(error "Edebug spec name cannot start with '&' or ':'"))
|
|
|
|
|
(unless (consp spec)
|
|
|
|
|
(error "Edebug spec has to be a list: %S" spec))
|
|
|
|
|
(put name 'edebug-elem-spec spec))
|
|
|
|
|
|
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
(defmacro lambda (&rest cdr)
|
2018-10-29 23:01:07 +00:00
|
|
|
|
"Return an anonymous function.
|
|
|
|
|
Under dynamic binding, a call of the form (lambda ARGS DOCSTRING
|
|
|
|
|
INTERACTIVE BODY) is self-quoting; the result of evaluating the
|
|
|
|
|
lambda expression is the expression itself. Under lexical
|
|
|
|
|
binding, the result is a closure. Regardless, the result is a
|
|
|
|
|
function, i.e., it may be stored as the function value of a
|
|
|
|
|
symbol, passed to `funcall' or `mapcar', etc.
|
1994-12-15 18:25:24 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
ARGS should take the same form as an argument list for a `defun'.
|
1995-06-27 06:52:56 +00:00
|
|
|
|
DOCSTRING is an optional documentation string.
|
|
|
|
|
If present, it should describe how to call the function.
|
|
|
|
|
But documentation strings are usually not useful in nameless functions.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
INTERACTIVE should be a call to the function `interactive', which see.
|
|
|
|
|
It may also be omitted.
|
2004-05-07 01:06:20 +00:00
|
|
|
|
BODY should be a list of Lisp expressions.
|
|
|
|
|
|
|
|
|
|
\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
|
2012-05-26 15:52:27 +00:00
|
|
|
|
(declare (doc-string 2) (indent defun)
|
2017-10-06 18:30:22 +00:00
|
|
|
|
(debug (&define lambda-list lambda-doc
|
2012-05-26 15:52:27 +00:00
|
|
|
|
[&optional ("interactive" interactive)]
|
|
|
|
|
def-body)))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
;; Note that this definition should not use backquotes; subr.el should not
|
|
|
|
|
;; depend on backquote.el.
|
|
|
|
|
(list 'function (cons 'lambda cdr)))
|
|
|
|
|
|
2019-04-02 13:51:20 +00:00
|
|
|
|
(defmacro prog2 (form1 form2 &rest body)
|
|
|
|
|
"Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
|
|
|
|
|
The value of FORM2 is saved during the evaluation of the
|
|
|
|
|
remaining args, whose values are discarded."
|
|
|
|
|
(declare (indent 2) (debug t))
|
|
|
|
|
`(progn ,form1 (prog1 ,form2 ,@body)))
|
|
|
|
|
|
2019-04-01 16:35:10 +00:00
|
|
|
|
(defmacro setq-default (&rest args)
|
|
|
|
|
"Set the default value of variable VAR to VALUE.
|
|
|
|
|
VAR, the variable name, is literal (not evaluated);
|
|
|
|
|
VALUE is an expression: it is evaluated and its value returned.
|
|
|
|
|
The default value of a variable is seen in buffers
|
|
|
|
|
that do not have their own values for the variable.
|
|
|
|
|
|
|
|
|
|
More generally, you can use multiple variables and values, as in
|
|
|
|
|
(setq-default VAR VALUE VAR VALUE...)
|
|
|
|
|
This sets each VAR's default value to the corresponding VALUE.
|
|
|
|
|
The VALUE for the Nth VAR can refer to the new default values
|
|
|
|
|
of previous VARs.
|
|
|
|
|
|
2019-04-06 22:44:24 +00:00
|
|
|
|
\(fn [VAR VALUE]...)"
|
2019-04-01 16:35:10 +00:00
|
|
|
|
(declare (debug setq))
|
|
|
|
|
(let ((exps nil))
|
|
|
|
|
(while args
|
|
|
|
|
(push `(set-default ',(pop args) ,(pop args)) exps))
|
|
|
|
|
`(progn . ,(nreverse exps))))
|
|
|
|
|
|
2019-10-11 06:27:50 +00:00
|
|
|
|
(defmacro setq-local (&rest pairs)
|
2022-11-04 07:49:48 +00:00
|
|
|
|
"Make each VARIABLE buffer-local and assign to it the corresponding VALUE.
|
2019-10-11 05:58:42 +00:00
|
|
|
|
|
2023-03-17 13:25:37 +00:00
|
|
|
|
The arguments are variable/value pairs. For each VARIABLE in a pair,
|
2022-11-04 07:49:48 +00:00
|
|
|
|
make VARIABLE buffer-local and assign to it the corresponding VALUE
|
|
|
|
|
of the pair. The VARIABLEs are literal symbols and should not be quoted.
|
2019-10-11 06:27:50 +00:00
|
|
|
|
|
2022-11-04 07:49:48 +00:00
|
|
|
|
The VALUE of the Nth pair is not computed until after the VARIABLE
|
|
|
|
|
of the (N-1)th pair is set; thus, each VALUE can use the new VALUEs
|
|
|
|
|
of VARIABLEs set by earlier pairs.
|
|
|
|
|
|
|
|
|
|
The return value of the `setq-local' form is the VALUE of the last
|
|
|
|
|
pair.
|
2019-10-11 06:27:50 +00:00
|
|
|
|
|
|
|
|
|
\(fn [VARIABLE VALUE]...)"
|
|
|
|
|
(declare (debug setq))
|
|
|
|
|
(unless (zerop (mod (length pairs) 2))
|
|
|
|
|
(error "PAIRS must have an even number of variable/value members"))
|
|
|
|
|
(let ((expr nil))
|
|
|
|
|
(while pairs
|
|
|
|
|
(unless (symbolp (car pairs))
|
|
|
|
|
(error "Attempting to set a non-symbol: %s" (car pairs)))
|
|
|
|
|
;; Can't use backquote here, it's too early in the bootstrap.
|
2019-10-11 05:58:42 +00:00
|
|
|
|
(setq expr
|
|
|
|
|
(cons
|
|
|
|
|
(list 'set
|
2019-10-11 06:27:50 +00:00
|
|
|
|
(list 'make-local-variable (list 'quote (car pairs)))
|
|
|
|
|
(car (cdr pairs)))
|
2019-10-11 05:58:42 +00:00
|
|
|
|
expr))
|
2019-10-11 06:27:50 +00:00
|
|
|
|
(setq pairs (cdr (cdr pairs))))
|
|
|
|
|
(macroexp-progn (nreverse expr))))
|
2012-05-05 01:47:04 +00:00
|
|
|
|
|
|
|
|
|
(defmacro defvar-local (var val &optional docstring)
|
|
|
|
|
"Define VAR as a buffer-local variable with default value VAL.
|
|
|
|
|
Like `defvar' but additionally marks the variable as being automatically
|
|
|
|
|
buffer-local wherever it is set."
|
2021-10-13 19:52:50 +00:00
|
|
|
|
(declare (debug defvar) (doc-string 3) (indent 2))
|
2012-05-05 01:47:04 +00:00
|
|
|
|
;; Can't use backquote here, it's too early in the bootstrap.
|
|
|
|
|
(list 'progn (list 'defvar var val docstring)
|
|
|
|
|
(list 'make-variable-buffer-local (list 'quote var))))
|
|
|
|
|
|
2021-05-31 05:21:09 +00:00
|
|
|
|
(defun buffer-local-boundp (symbol buffer)
|
|
|
|
|
"Return non-nil if SYMBOL is bound in BUFFER.
|
|
|
|
|
Also see `local-variable-p'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2021-05-31 05:21:09 +00:00
|
|
|
|
(condition-case nil
|
|
|
|
|
(buffer-local-value symbol buffer)
|
|
|
|
|
(:success t)
|
|
|
|
|
(void-variable nil)))
|
|
|
|
|
|
2022-05-06 14:09:38 +00:00
|
|
|
|
(defmacro buffer-local-set-state (&rest pairs)
|
|
|
|
|
"Like `setq-local', but allow restoring the previous state of locals later.
|
|
|
|
|
This macro returns an object that can be passed to `buffer-local-restore-state'
|
|
|
|
|
in order to restore the state of the local variables set via this macro.
|
|
|
|
|
|
|
|
|
|
\(fn [VARIABLE VALUE]...)"
|
|
|
|
|
(declare (debug setq))
|
|
|
|
|
(unless (zerop (mod (length pairs) 2))
|
|
|
|
|
(error "PAIRS must have an even number of variable/value members"))
|
|
|
|
|
`(prog1
|
|
|
|
|
(buffer-local-set-state--get ',pairs)
|
|
|
|
|
(setq-local ,@pairs)))
|
|
|
|
|
|
|
|
|
|
(defun buffer-local-set-state--get (pairs)
|
|
|
|
|
(let ((states nil))
|
|
|
|
|
(while pairs
|
|
|
|
|
(push (list (car pairs)
|
|
|
|
|
(and (boundp (car pairs))
|
|
|
|
|
(local-variable-p (car pairs)))
|
|
|
|
|
(and (boundp (car pairs))
|
|
|
|
|
(symbol-value (car pairs))))
|
|
|
|
|
states)
|
|
|
|
|
(setq pairs (cddr pairs)))
|
|
|
|
|
(nreverse states)))
|
|
|
|
|
|
|
|
|
|
(defun buffer-local-restore-state (states)
|
|
|
|
|
"Restore values of buffer-local variables recorded in STATES.
|
|
|
|
|
STATES should be an object returned by `buffer-local-set-state'."
|
|
|
|
|
(pcase-dolist (`(,variable ,local ,value) states)
|
|
|
|
|
(if local
|
|
|
|
|
(set variable value)
|
|
|
|
|
(kill-local-variable variable))))
|
|
|
|
|
|
Provide generalized variables in core Elisp.
* lisp/emacs-lisp/gv.el: New file.
* lisp/subr.el (push, pop): Extend to generalized variables.
* lisp/loadup.el (macroexp): Unload if preloaded and uncompiled.
* lisp/emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
* lisp/emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
gv-define-simple-setter, and gv-define-expander.
Remove setf-methods defined in gv. Rename cl-setf -> setf.
(cl-setf, cl-do-pop, cl-get-setf-method): Remove.
(cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
(cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
(cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
gv-letplace.
(cl-defstruct): Don't define setf-method any more.
* lisp/emacs-lisp/cl.el (flet): Don't autoload.
(cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
(define-setf-expander, defsetf, define-modify-macro)
(cl-struct-setf-expander): Move from cl-lib.el.
* lisp/emacs-lisp/syntax.el:
* lisp/emacs-lisp/ewoc.el:
* lisp/emacs-lisp/smie.el:
* lisp/emacs-lisp/cconv.el:
* lisp/emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
(timer--time): Use gv-define-simple-setter.
* lisp/emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
to avoid coding-system problems in subr.el. Adjust all users.
(macroexp--maxsize, macroexp-small-p): New functions.
* lisp/emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
* lisp/scroll-bar.el (scroll-bar-mode):
* lisp/simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
(normal-erase-is-backspace-mode): Don't use the `eq' place.
* lisp/winner.el (winner-configuration, winner-make-point-alist)
(winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
* lisp/files.el (locate-file-completion-table): Avoid list*.
Fixes: debbugs:11657
2012-06-22 13:42:38 +00:00
|
|
|
|
(defmacro push (newelt place)
|
|
|
|
|
"Add NEWELT to the list stored in the generalized variable PLACE.
|
|
|
|
|
This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
|
2019-11-04 02:36:05 +00:00
|
|
|
|
except that PLACE is evaluated only once (after NEWELT)."
|
Provide generalized variables in core Elisp.
* lisp/emacs-lisp/gv.el: New file.
* lisp/subr.el (push, pop): Extend to generalized variables.
* lisp/loadup.el (macroexp): Unload if preloaded and uncompiled.
* lisp/emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
* lisp/emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
gv-define-simple-setter, and gv-define-expander.
Remove setf-methods defined in gv. Rename cl-setf -> setf.
(cl-setf, cl-do-pop, cl-get-setf-method): Remove.
(cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
(cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
(cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
gv-letplace.
(cl-defstruct): Don't define setf-method any more.
* lisp/emacs-lisp/cl.el (flet): Don't autoload.
(cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
(define-setf-expander, defsetf, define-modify-macro)
(cl-struct-setf-expander): Move from cl-lib.el.
* lisp/emacs-lisp/syntax.el:
* lisp/emacs-lisp/ewoc.el:
* lisp/emacs-lisp/smie.el:
* lisp/emacs-lisp/cconv.el:
* lisp/emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
(timer--time): Use gv-define-simple-setter.
* lisp/emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
to avoid coding-system problems in subr.el. Adjust all users.
(macroexp--maxsize, macroexp-small-p): New functions.
* lisp/emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
* lisp/scroll-bar.el (scroll-bar-mode):
* lisp/simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
(normal-erase-is-backspace-mode): Don't use the `eq' place.
* lisp/winner.el (winner-configuration, winner-make-point-alist)
(winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
* lisp/files.el (locate-file-completion-table): Avoid list*.
Fixes: debbugs:11657
2012-06-22 13:42:38 +00:00
|
|
|
|
(declare (debug (form gv-place)))
|
|
|
|
|
(if (symbolp place)
|
|
|
|
|
;; Important special case, to avoid triggering GV too early in
|
|
|
|
|
;; the bootstrap.
|
|
|
|
|
(list 'setq place
|
|
|
|
|
(list 'cons newelt place))
|
|
|
|
|
(require 'macroexp)
|
2020-09-26 15:05:17 +00:00
|
|
|
|
(macroexp-let2 macroexp-copyable-p x newelt
|
Provide generalized variables in core Elisp.
* lisp/emacs-lisp/gv.el: New file.
* lisp/subr.el (push, pop): Extend to generalized variables.
* lisp/loadup.el (macroexp): Unload if preloaded and uncompiled.
* lisp/emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
* lisp/emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
gv-define-simple-setter, and gv-define-expander.
Remove setf-methods defined in gv. Rename cl-setf -> setf.
(cl-setf, cl-do-pop, cl-get-setf-method): Remove.
(cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
(cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
(cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
gv-letplace.
(cl-defstruct): Don't define setf-method any more.
* lisp/emacs-lisp/cl.el (flet): Don't autoload.
(cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
(define-setf-expander, defsetf, define-modify-macro)
(cl-struct-setf-expander): Move from cl-lib.el.
* lisp/emacs-lisp/syntax.el:
* lisp/emacs-lisp/ewoc.el:
* lisp/emacs-lisp/smie.el:
* lisp/emacs-lisp/cconv.el:
* lisp/emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
(timer--time): Use gv-define-simple-setter.
* lisp/emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
to avoid coding-system problems in subr.el. Adjust all users.
(macroexp--maxsize, macroexp-small-p): New functions.
* lisp/emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
* lisp/scroll-bar.el (scroll-bar-mode):
* lisp/simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
(normal-erase-is-backspace-mode): Don't use the `eq' place.
* lisp/winner.el (winner-configuration, winner-make-point-alist)
(winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
* lisp/files.el (locate-file-completion-table): Avoid list*.
Fixes: debbugs:11657
2012-06-22 13:42:38 +00:00
|
|
|
|
(gv-letplace (getter setter) place
|
2020-09-26 15:05:17 +00:00
|
|
|
|
(funcall setter `(cons ,x ,getter))))))
|
Provide generalized variables in core Elisp.
* lisp/emacs-lisp/gv.el: New file.
* lisp/subr.el (push, pop): Extend to generalized variables.
* lisp/loadup.el (macroexp): Unload if preloaded and uncompiled.
* lisp/emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
* lisp/emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
gv-define-simple-setter, and gv-define-expander.
Remove setf-methods defined in gv. Rename cl-setf -> setf.
(cl-setf, cl-do-pop, cl-get-setf-method): Remove.
(cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
(cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
(cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
gv-letplace.
(cl-defstruct): Don't define setf-method any more.
* lisp/emacs-lisp/cl.el (flet): Don't autoload.
(cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
(define-setf-expander, defsetf, define-modify-macro)
(cl-struct-setf-expander): Move from cl-lib.el.
* lisp/emacs-lisp/syntax.el:
* lisp/emacs-lisp/ewoc.el:
* lisp/emacs-lisp/smie.el:
* lisp/emacs-lisp/cconv.el:
* lisp/emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
(timer--time): Use gv-define-simple-setter.
* lisp/emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
to avoid coding-system problems in subr.el. Adjust all users.
(macroexp--maxsize, macroexp-small-p): New functions.
* lisp/emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
* lisp/scroll-bar.el (scroll-bar-mode):
* lisp/simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
(normal-erase-is-backspace-mode): Don't use the `eq' place.
* lisp/winner.el (winner-configuration, winner-make-point-alist)
(winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
* lisp/files.el (locate-file-completion-table): Avoid list*.
Fixes: debbugs:11657
2012-06-22 13:42:38 +00:00
|
|
|
|
|
|
|
|
|
(defmacro pop (place)
|
|
|
|
|
"Return the first element of PLACE's value, and remove it from the list.
|
|
|
|
|
PLACE must be a generalized variable whose value is a list.
|
1999-08-29 20:23:54 +00:00
|
|
|
|
If the value is nil, `pop' returns nil but does not actually
|
|
|
|
|
change the list."
|
Provide generalized variables in core Elisp.
* lisp/emacs-lisp/gv.el: New file.
* lisp/subr.el (push, pop): Extend to generalized variables.
* lisp/loadup.el (macroexp): Unload if preloaded and uncompiled.
* lisp/emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
* lisp/emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
gv-define-simple-setter, and gv-define-expander.
Remove setf-methods defined in gv. Rename cl-setf -> setf.
(cl-setf, cl-do-pop, cl-get-setf-method): Remove.
(cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
(cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
(cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
gv-letplace.
(cl-defstruct): Don't define setf-method any more.
* lisp/emacs-lisp/cl.el (flet): Don't autoload.
(cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
(define-setf-expander, defsetf, define-modify-macro)
(cl-struct-setf-expander): Move from cl-lib.el.
* lisp/emacs-lisp/syntax.el:
* lisp/emacs-lisp/ewoc.el:
* lisp/emacs-lisp/smie.el:
* lisp/emacs-lisp/cconv.el:
* lisp/emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
(timer--time): Use gv-define-simple-setter.
* lisp/emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
to avoid coding-system problems in subr.el. Adjust all users.
(macroexp--maxsize, macroexp-small-p): New functions.
* lisp/emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
* lisp/scroll-bar.el (scroll-bar-mode):
* lisp/simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
(normal-erase-is-backspace-mode): Don't use the `eq' place.
* lisp/winner.el (winner-configuration, winner-make-point-alist)
(winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
* lisp/files.el (locate-file-completion-table): Avoid list*.
Fixes: debbugs:11657
2012-06-22 13:42:38 +00:00
|
|
|
|
(declare (debug (gv-place)))
|
2013-09-05 03:46:34 +00:00
|
|
|
|
;; We use `car-safe' here instead of `car' because the behavior is the same
|
|
|
|
|
;; (if it's not a cons cell, the `cdr' would have signaled an error already),
|
|
|
|
|
;; but `car-safe' is total, so the byte-compiler can safely remove it if the
|
|
|
|
|
;; result is not used.
|
|
|
|
|
`(car-safe
|
|
|
|
|
,(if (symbolp place)
|
|
|
|
|
;; So we can use `pop' in the bootstrap before `gv' can be used.
|
|
|
|
|
(list 'prog1 place (list 'setq place (list 'cdr place)))
|
|
|
|
|
(gv-letplace (getter setter) place
|
2014-11-06 03:27:23 +00:00
|
|
|
|
(macroexp-let2 macroexp-copyable-p x getter
|
|
|
|
|
`(prog1 ,x ,(funcall setter `(cdr ,x))))))))
|
1999-08-29 20:23:54 +00:00
|
|
|
|
|
2023-09-03 12:54:47 +00:00
|
|
|
|
;; Note: `static-if' can be copied into a package to enable it to be
|
|
|
|
|
;; used in Emacsen older than Emacs 30.1. If the package is used in
|
|
|
|
|
;; very old Emacsen or XEmacs (in which `eval' takes exactly one
|
|
|
|
|
;; argument) the copy will need amending.
|
|
|
|
|
(defmacro static-if (condition then-form &rest else-forms)
|
|
|
|
|
"A conditional compilation macro.
|
|
|
|
|
Evaluate CONDITION at macro-expansion time. If it is non-nil,
|
|
|
|
|
expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS
|
|
|
|
|
enclosed in a `progn' form. ELSE-FORMS may be empty."
|
|
|
|
|
(declare (indent 2)
|
|
|
|
|
(debug (sexp sexp &rest sexp)))
|
|
|
|
|
(if (eval condition lexical-binding)
|
|
|
|
|
then-form
|
|
|
|
|
(cons 'progn else-forms)))
|
|
|
|
|
|
1997-01-08 06:09:02 +00:00
|
|
|
|
(defmacro when (cond &rest body)
|
2007-03-18 00:44:24 +00:00
|
|
|
|
"If COND yields non-nil, do BODY, else return nil.
|
|
|
|
|
When COND yields non-nil, eval BODY forms sequentially and return
|
2022-05-02 10:30:19 +00:00
|
|
|
|
value of last one, or nil if there are none."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 1) (debug t))
|
2022-12-29 12:01:47 +00:00
|
|
|
|
(if body
|
|
|
|
|
(list 'if cond (cons 'progn body))
|
2023-01-03 14:58:14 +00:00
|
|
|
|
(macroexp-warn-and-return (format-message "`when' with empty body")
|
2022-12-29 12:01:47 +00:00
|
|
|
|
cond '(empty-body when) t)))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
1997-01-08 06:09:02 +00:00
|
|
|
|
(defmacro unless (cond &rest body)
|
2007-03-18 00:44:24 +00:00
|
|
|
|
"If COND yields nil, do BODY, else return nil.
|
|
|
|
|
When COND yields nil, eval BODY forms sequentially and return
|
2022-05-02 10:30:19 +00:00
|
|
|
|
value of last one, or nil if there are none."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 1) (debug t))
|
2022-12-29 12:01:47 +00:00
|
|
|
|
(if body
|
|
|
|
|
(cons 'if (cons cond (cons nil body)))
|
2023-01-03 14:58:14 +00:00
|
|
|
|
(macroexp-warn-and-return (format-message "`unless' with empty body")
|
2022-12-29 12:01:47 +00:00
|
|
|
|
cond '(empty-body unless) t)))
|
1997-08-23 18:55:52 +00:00
|
|
|
|
|
2020-04-24 18:23:34 +00:00
|
|
|
|
(defsubst subr-primitive-p (object)
|
2024-03-17 21:29:02 +00:00
|
|
|
|
"Return t if OBJECT is a built-in primitive written in C.
|
|
|
|
|
Such objects can be functions or special forms."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2020-04-24 18:23:34 +00:00
|
|
|
|
(and (subrp object)
|
|
|
|
|
(not (subr-native-elisp-p object))))
|
|
|
|
|
|
2024-03-17 21:29:02 +00:00
|
|
|
|
(defsubst primitive-function-p (object)
|
|
|
|
|
"Return t if OBJECT is a built-in primitive function.
|
|
|
|
|
This excludes special forms, since they are not functions."
|
|
|
|
|
(declare (side-effect-free error-free))
|
|
|
|
|
(and (subrp object)
|
|
|
|
|
(not (or (subr-native-elisp-p object)
|
|
|
|
|
(eq (cdr (subr-arity object)) 'unevalled)))))
|
|
|
|
|
|
2019-07-31 17:45:06 +00:00
|
|
|
|
(defsubst xor (cond1 cond2)
|
|
|
|
|
"Return the boolean exclusive-or of COND1 and COND2.
|
|
|
|
|
If only one of the arguments is non-nil, return it; otherwise
|
|
|
|
|
return nil."
|
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
|
|
|
|
(cond ((not cond1) cond2)
|
|
|
|
|
((not cond2) cond1)))
|
|
|
|
|
|
2000-01-21 02:08:58 +00:00
|
|
|
|
(defmacro dolist (spec &rest body)
|
2003-05-17 22:00:40 +00:00
|
|
|
|
"Loop over a list.
|
2000-01-21 02:08:58 +00:00
|
|
|
|
Evaluate BODY with VAR bound to each car from LIST, in turn.
|
2003-05-17 22:00:40 +00:00
|
|
|
|
Then evaluate RESULT to get return value, default nil.
|
|
|
|
|
|
2003-07-08 16:57:15 +00:00
|
|
|
|
\(fn (VAR LIST [RESULT]) BODY...)"
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 1) (debug ((symbolp form &optional form) body)))
|
2017-03-26 18:53:43 +00:00
|
|
|
|
(unless (consp spec)
|
|
|
|
|
(signal 'wrong-type-argument (list 'consp spec)))
|
|
|
|
|
(unless (<= 2 (length spec) 3)
|
|
|
|
|
(signal 'wrong-number-of-arguments (list '(2 . 3) (length spec))))
|
2022-09-07 11:48:20 +00:00
|
|
|
|
(let ((tail (make-symbol "tail")))
|
|
|
|
|
`(let ((,tail ,(nth 1 spec)))
|
|
|
|
|
(while ,tail
|
|
|
|
|
(let ((,(car spec) (car ,tail)))
|
2011-03-30 18:40:00 +00:00
|
|
|
|
,@body
|
2022-09-07 11:48:20 +00:00
|
|
|
|
(setq ,tail (cdr ,tail))))
|
|
|
|
|
,@(cdr (cdr spec)))))
|
2006-07-24 17:01:08 +00:00
|
|
|
|
|
2000-01-21 02:08:58 +00:00
|
|
|
|
(defmacro dotimes (spec &rest body)
|
2003-05-17 22:00:40 +00:00
|
|
|
|
"Loop a certain number of times.
|
2000-01-21 02:08:58 +00:00
|
|
|
|
Evaluate BODY with VAR bound to successive integers running from 0,
|
2020-09-30 18:29:16 +00:00
|
|
|
|
inclusive, to COUNT, exclusive.
|
|
|
|
|
|
|
|
|
|
Finally RESULT is evaluated to get the return value (nil if
|
|
|
|
|
RESULT is omitted). Using RESULT is deprecated, and may result
|
|
|
|
|
in compilation warnings about unused variables.
|
2003-05-17 22:00:40 +00:00
|
|
|
|
|
2003-07-08 16:57:15 +00:00
|
|
|
|
\(fn (VAR COUNT [RESULT]) BODY...)"
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 1) (debug dolist))
|
2022-09-07 11:48:20 +00:00
|
|
|
|
(let ((var (nth 0 spec))
|
|
|
|
|
(end (nth 1 spec))
|
|
|
|
|
(upper-bound (make-symbol "upper-bound"))
|
|
|
|
|
(counter (make-symbol "counter")))
|
|
|
|
|
`(let ((,upper-bound ,end)
|
|
|
|
|
(,counter 0))
|
|
|
|
|
(while (< ,counter ,upper-bound)
|
|
|
|
|
(let ((,var ,counter))
|
|
|
|
|
,@body)
|
|
|
|
|
(setq ,counter (1+ ,counter)))
|
|
|
|
|
,@(if (cddr spec)
|
|
|
|
|
;; FIXME: This let often leads to "unused var" warnings.
|
|
|
|
|
`((let ((,var ,counter)) ,@(cddr spec)))))))
|
2000-01-21 02:08:58 +00:00
|
|
|
|
|
2022-10-16 16:01:47 +00:00
|
|
|
|
(defmacro declare (&rest specs)
|
2012-09-25 05:33:43 +00:00
|
|
|
|
"Do not evaluate any arguments, and return nil.
|
|
|
|
|
If a `declare' form appears as the first form in the body of a
|
|
|
|
|
`defun' or `defmacro' form, SPECS specifies various additional
|
|
|
|
|
information about the function or macro; these go into effect
|
|
|
|
|
during the evaluation of the `defun' or `defmacro' form.
|
|
|
|
|
|
|
|
|
|
The possible values of SPECS are specified by
|
2014-03-22 22:12:52 +00:00
|
|
|
|
`defun-declarations-alist' and `macro-declarations-alist'.
|
|
|
|
|
|
|
|
|
|
For more information, see info node `(elisp)Declare Form'."
|
2022-10-16 16:01:47 +00:00
|
|
|
|
;; `declare' is handled directly by `defun/defmacro' rather than here.
|
|
|
|
|
;; If we get here, it's because there's a `declare' somewhere not attached
|
|
|
|
|
;; to a `defun/defmacro', i.e. a `declare' which doesn't do what it's
|
|
|
|
|
;; intended to do.
|
|
|
|
|
(let ((form `(declare . ,specs))) ;; FIXME: WIBNI we had &whole?
|
|
|
|
|
(macroexp-warn-and-return
|
|
|
|
|
(format-message "Stray `declare' form: %S" form)
|
|
|
|
|
;; Make a "unique" harmless form to circumvent
|
|
|
|
|
;; the cache in `macroexp-warn-and-return'.
|
|
|
|
|
`(progn ',form nil) nil 'compile-only)))
|
2008-05-07 02:57:53 +00:00
|
|
|
|
|
|
|
|
|
(defmacro ignore-errors (&rest body)
|
|
|
|
|
"Execute BODY; if an error occurs, return nil.
|
2012-09-11 17:47:25 +00:00
|
|
|
|
Otherwise, return result of last form in BODY.
|
|
|
|
|
See also `with-demoted-errors' that does something similar
|
|
|
|
|
without silencing all errors."
|
2010-08-11 13:43:49 +00:00
|
|
|
|
(declare (debug t) (indent 0))
|
2008-05-07 02:57:53 +00:00
|
|
|
|
`(condition-case nil (progn ,@body) (error nil)))
|
2019-07-26 07:58:23 +00:00
|
|
|
|
|
|
|
|
|
(defmacro ignore-error (condition &rest body)
|
|
|
|
|
"Execute BODY; if the error CONDITION occurs, return nil.
|
|
|
|
|
Otherwise, return result of last form in BODY.
|
|
|
|
|
|
2022-12-28 13:40:19 +00:00
|
|
|
|
CONDITION can also be a list of error conditions.
|
|
|
|
|
The CONDITION argument is not evaluated. Do not quote it."
|
2019-07-26 07:58:23 +00:00
|
|
|
|
(declare (debug t) (indent 1))
|
2022-12-29 12:01:47 +00:00
|
|
|
|
(cond
|
|
|
|
|
((and (eq (car-safe condition) 'quote)
|
|
|
|
|
(cdr condition) (null (cddr condition)))
|
|
|
|
|
(macroexp-warn-and-return
|
2023-01-03 14:58:14 +00:00
|
|
|
|
(format-message
|
|
|
|
|
"`ignore-error' condition argument should not be quoted: %S"
|
|
|
|
|
condition)
|
2022-12-29 12:01:47 +00:00
|
|
|
|
`(condition-case nil (progn ,@body) (,(cadr condition) nil))
|
|
|
|
|
nil t condition))
|
|
|
|
|
(body
|
|
|
|
|
`(condition-case nil (progn ,@body) (,condition nil)))
|
|
|
|
|
(t
|
2023-01-03 14:58:14 +00:00
|
|
|
|
(macroexp-warn-and-return (format-message "`ignore-error' with empty body")
|
2022-12-29 12:01:47 +00:00
|
|
|
|
nil '(empty-body ignore-error) t condition))))
|
2022-12-28 13:40:19 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Basic Lisp functions.
|
|
|
|
|
|
2017-09-12 15:08:00 +00:00
|
|
|
|
(defvar gensym-counter 0
|
|
|
|
|
"Number used to construct the name of the next symbol created by `gensym'.")
|
|
|
|
|
|
|
|
|
|
(defun gensym (&optional prefix)
|
|
|
|
|
"Return a new uninterned symbol.
|
|
|
|
|
The name is made by appending `gensym-counter' to PREFIX.
|
2017-09-13 14:38:05 +00:00
|
|
|
|
PREFIX is a string, and defaults to \"g\"."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2017-09-13 14:38:05 +00:00
|
|
|
|
(let ((num (prog1 gensym-counter
|
|
|
|
|
(setq gensym-counter (1+ gensym-counter)))))
|
2017-09-18 13:00:45 +00:00
|
|
|
|
(make-symbol (format "%s%d" (or prefix "g") num))))
|
2017-09-12 15:08:00 +00:00
|
|
|
|
|
2019-10-10 04:00:20 +00:00
|
|
|
|
(defun ignore (&rest _arguments)
|
2023-07-22 05:36:08 +00:00
|
|
|
|
"Ignore ARGUMENTS, do nothing, and return nil.
|
|
|
|
|
This function accepts any number of arguments in ARGUMENTS.
|
2021-02-20 12:44:19 +00:00
|
|
|
|
Also see `always'."
|
Move side-effect-free and pure declarations to function definitions
Some Lisp functions still had their `side-effect-free` and `pure`
properties declared in byte-opt.el; do it at their definition instead.
The lists in byte-opt.el now only contain functions implemented in C
and function aliases.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns)
(side-effect-and-error-free-fns, pure-fns):
Remove functions whose properties are now declared elsewhere
and some obsolete entries.
* lisp/custom.el (custom-variable-p):
* lisp/emacs-lisp/lisp.el (buffer-end):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt):
* lisp/env.el (getenv):
* lisp/simple.el (count-lines, mark, string-empty-p, lax-plist-get):
* lisp/subr.el (ignore, always, zerop, fixnump, bignump, lsh, last)
(eventp, mouse-movement-p, log10, memory-limit, string-greaterp)
(interactive-p):
* lisp/window.el (get-lru-window, get-largest-window, (window-edges)
(window-body-edges, window-pixel-edges, window-body-pixel-edges)
(window-absolute-pixel-edges, window-absolute-body-pixel-edges)
(one-window-p):
Declare functions `side-effect-free` and/or `pure` as appropriate.
2023-02-17 13:38:50 +00:00
|
|
|
|
;; Not declared `side-effect-free' because we don't want calls to it
|
|
|
|
|
;; elided; see `byte-compile-ignore'.
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (&rest t) null))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(pure t) (completion ignore))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
nil)
|
|
|
|
|
|
2021-02-20 12:44:19 +00:00
|
|
|
|
(defun always (&rest _arguments)
|
2023-07-22 05:36:08 +00:00
|
|
|
|
"Ignore ARGUMENTS, do nothing, and return t.
|
|
|
|
|
This function accepts any number of arguments in ARGUMENTS.
|
2021-02-20 12:44:19 +00:00
|
|
|
|
Also see `ignore'."
|
Move side-effect-free and pure declarations to function definitions
Some Lisp functions still had their `side-effect-free` and `pure`
properties declared in byte-opt.el; do it at their definition instead.
The lists in byte-opt.el now only contain functions implemented in C
and function aliases.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns)
(side-effect-and-error-free-fns, pure-fns):
Remove functions whose properties are now declared elsewhere
and some obsolete entries.
* lisp/custom.el (custom-variable-p):
* lisp/emacs-lisp/lisp.el (buffer-end):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt):
* lisp/env.el (getenv):
* lisp/simple.el (count-lines, mark, string-empty-p, lax-plist-get):
* lisp/subr.el (ignore, always, zerop, fixnump, bignump, lsh, last)
(eventp, mouse-movement-p, log10, memory-limit, string-greaterp)
(interactive-p):
* lisp/window.el (get-lru-window, get-largest-window, (window-edges)
(window-body-edges, window-pixel-edges, window-body-pixel-edges)
(window-absolute-pixel-edges, window-absolute-body-pixel-edges)
(one-window-p):
Declare functions `side-effect-free` and/or `pure` as appropriate.
2023-02-17 13:38:50 +00:00
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
2021-02-20 12:44:19 +00:00
|
|
|
|
t)
|
|
|
|
|
|
2009-10-16 03:21:18 +00:00
|
|
|
|
;; Signal a compile-error if the first arg is missing.
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun error (&rest args)
|
2019-06-27 09:33:10 +00:00
|
|
|
|
"Signal an error, making a message by passing ARGS to `format-message'.
|
2019-06-27 09:33:36 +00:00
|
|
|
|
Errors cause entry to the debugger when `debug-on-error' is non-nil.
|
|
|
|
|
This can be overridden by `debug-ignored-errors'.
|
|
|
|
|
|
2023-11-09 08:33:28 +00:00
|
|
|
|
When `noninteractive' is non-nil (in particular, in batch mode), an
|
|
|
|
|
unhandled error calls `kill-emacs', which terminates the Emacs
|
|
|
|
|
session with a non-zero exit code.
|
|
|
|
|
|
2019-06-27 09:33:36 +00:00
|
|
|
|
To signal with MESSAGE without interpreting format characters
|
|
|
|
|
like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE).
|
2005-10-22 15:01:08 +00:00
|
|
|
|
In Emacs, the convention is that error messages start with a capital
|
|
|
|
|
letter but *do not* end with a period. Please follow this convention
|
2022-05-23 11:56:03 +00:00
|
|
|
|
for the sake of consistency.
|
|
|
|
|
|
|
|
|
|
To alter the look of the displayed error messages, you can use
|
|
|
|
|
the `command-error-function' variable."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (string &rest t) nil))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(advertised-calling-convention (string &rest args) "23.1"))
|
More-conservative ‘format’ quote restyling
Instead of restyling curved quotes for every call to ‘format’,
create a new function ‘format-message’ that does the restyling,
and using the new function instead of ‘format’ only in contexts
where this seems appropriate.
Problem reported by Dmitry Gutov and Andreas Schwab in:
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00826.html
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00827.html
* doc/lispref/commands.texi (Using Interactive):
* doc/lispref/control.texi (Signaling Errors, Signaling Errors):
* doc/lispref/display.texi (Displaying Messages, Progress):
* doc/lispref/elisp.texi:
* doc/lispref/help.texi (Keys in Documentation):
* doc/lispref/minibuf.texi (Minibuffer Misc):
* doc/lispref/strings.texi (Formatting Strings):
* etc/NEWS:
Document the changes.
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/apropos.el (apropos-library):
* lisp/calc/calc-ext.el (calc-record-message)
(calc-user-function-list):
* lisp/calc/calc-help.el (calc-describe-key, calc-full-help):
* lisp/calc/calc-lang.el (math-read-big-balance):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--add-diary-entry):
* lisp/cedet/mode-local.el (mode-local-print-binding)
(mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-completion-message):
* lisp/cedet/semantic/edit.el (semantic-parse-changes-failed):
* lisp/cedet/semantic/wisent/comp.el (wisent-log):
* lisp/cedet/srecode/insert.el (srecode-insert-show-error-report):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dframe.el (dframe-message):
* lisp/dired-aux.el (dired-query):
* lisp/emacs-lisp/byte-opt.el (byte-compile-log-lap-1):
* lisp/emacs-lisp/bytecomp.el (byte-compile-log)
(byte-compile-log-file, byte-compile-warn, byte-compile-form):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use)
(cconv-analyze-form):
* lisp/emacs-lisp/check-declare.el (check-declare-warn):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet):
* lisp/emacs-lisp/edebug.el (edebug-format):
* lisp/emacs-lisp/eieio-core.el (eieio-oref):
* lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message)
(eldoc-message):
* lisp/emacs-lisp/elint.el (elint-file, elint-log):
* lisp/emacs-lisp/find-func.el (find-function-library):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring):
* lisp/emacs-lisp/package.el (package-compute-transaction)
(package-install-button-action, package-delete-button-action)
(package-menu--list-to-prompt):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emacs-lisp/warnings.el (lwarn, warn):
* lisp/emulation/viper-cmd.el:
(viper-toggle-parse-sexp-ignore-comments)
(viper-kill-buffer, viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/facemenu.el (facemenu-add-new-face):
* lisp/faces.el (face-documentation, read-face-name)
(face-read-string, read-face-font, describe-face):
* lisp/files.el (find-alternate-file, hack-local-variables)
(hack-one-local-variable--obsolete, write-file)
(basic-save-buffer, delete-directory):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--obsolete)
(help-fns--interactive-only, describe-function-1)
(describe-variable):
* lisp/help.el (describe-mode):
* lisp/info-xref.el (info-xref-output):
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
* lisp/international/kkc.el (kkc-error):
* lisp/international/mule-cmds.el:
(select-safe-coding-system-interactively)
(select-safe-coding-system, describe-input-method):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/international/quail.el (quail-error):
* lisp/minibuffer.el (minibuffer-message):
* lisp/mpc.el (mpc--debug):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-message):
* lisp/net/gnutls.el (gnutls-message-maybe):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/nsm.el (nsm-query-user):
* lisp/net/rlogin.el (rlogin):
* lisp/net/soap-client.el (soap-warning):
* lisp/net/tramp.el (tramp-debug-message):
* lisp/nxml/nxml-outln.el (nxml-report-outline-error):
* lisp/nxml/nxml-parse.el (nxml-parse-error):
* lisp/nxml/rng-cmpct.el (rng-c-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/org/org-ctags.el:
(org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/proced.el (proced-log):
* lisp/progmodes/ebnf2ps.el (ebnf-log):
* lisp/progmodes/flymake.el (flymake-log):
* lisp/progmodes/vhdl-mode.el (vhdl-warning-when-idle):
* lisp/replace.el (occur-1):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, define-alternatives):
* lisp/startup.el (command-line):
* lisp/subr.el (error, user-error, add-to-list):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* src/callint.c (Fcall_interactively):
* src/editfns.c (Fmessage, Fmessage_box):
Restyle the quotes of format strings intended for use as a
diagnostic, when restyling seems appropriate.
* lisp/subr.el (format-message): New function.
* src/doc.c (Finternal__text_restyle): New function.
(syms_of_doc): Define it.
2015-08-24 05:38:02 +00:00
|
|
|
|
(signal 'error (list (apply #'format-message args))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
Add new error and function `user-error'.
* lisp/subr.el (user-error): New function.
* lisp/window.el (switch-to-buffer):
* lisp/vc/smerge-mode.el (smerge-resolve-function, smerge-resolve)
(smerge-match-conflict):
* lisp/simple.el (previous-matching-history-element)
(next-matching-history-element, goto-history-element, undo-more)
(undo-start):
* lisp/progmodes/etags.el (visit-tags-table-buffer, find-tag-tag)
(find-tag-noselect, find-tag-in-order, etags-goto-tag-location)
(next-file, tags-loop-scan, list-tags, complete-tag):
* lisp/progmodes/compile.el (compilation-loop):
* lisp/mouse.el (mouse-minibuffer-check):
* lisp/man.el (Man-bgproc-sentinel, Man-goto-page):
* lisp/info.el (Info-find-node-2, Info-extract-pointer, Info-history-back)
(Info-history-forward, Info-follow-reference, Info-menu)
(Info-extract-menu-item, Info-extract-menu-counting)
(Info-forward-node, Info-backward-node, Info-next-menu-item)
(Info-last-menu-item, Info-next-preorder, Info-last-preorder)
(Info-next-reference, Info-prev-reference, Info-index)
(Info-index-next, Info-follow-nearest-node)
(Info-copy-current-node-name):
* lisp/imenu.el (imenu--make-index-alist)
(imenu-default-create-index-function, imenu-add-to-menubar):
* lisp/files.el (basic-save-buffer, recover-file):
* lisp/emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
* lisp/emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments)
(checkdoc-message-text, checkdoc-defun):
* lisp/dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point):
* lisp/cus-edit.el (customize-changed-options, customize-rogue)
(customize-saved, custom-variable-set, custom-variable-mark-to-save)
(custom-variable-mark-to-reset-standard)
(custom-variable-reset-backup, custom-face-mark-to-reset-standard)
(custom-file):
* lisp/completion.el (check-completion-length):
* lisp/comint.el (comint-search-arg)
(comint-previous-matching-input-string-position)
(comint-previous-matching-input)
(comint-replace-by-expanded-history-before-point, comint-send-input)
(comint-copy-old-input, comint-backward-matching-input)
(comint-goto-process-mark, comint-set-process-mark):
* lisp/calendar/calendar.el (calendar-cursor-to-date): Use it.
* lisp/bindings.el (debug-ignored-errors): Remove regexps, add `user-error'.
* src/data.c (PUT_ERROR): New macro.
(syms_of_data): Use it. Add new error type `user-error'.
* src/undo.c (user_error): New function.
(Fprimitive_undo): Use it.
* src/print.c (print_error_message): Adjust print style for `user-error'.
* src/keyboard.c (user_error): New function.
(Fexit_recursive_edit, Fabort_recursive_edit): Use it.
2012-05-04 23:16:47 +00:00
|
|
|
|
(defun user-error (format &rest args)
|
2019-06-27 09:33:10 +00:00
|
|
|
|
"Signal a user error, making a message by passing ARGS to `format-message'.
|
2019-06-27 09:33:36 +00:00
|
|
|
|
This is like `error' except that a user error (or \"pilot error\") comes
|
|
|
|
|
from an incorrect manipulation by the user, not from an actual problem.
|
2019-06-27 09:33:10 +00:00
|
|
|
|
In contrast with other errors, user errors normally do not cause
|
|
|
|
|
entry to the debugger, even when `debug-on-error' is non-nil.
|
|
|
|
|
This can be overridden by `debug-ignored-errors'.
|
2016-05-03 15:02:16 +00:00
|
|
|
|
|
2019-06-27 09:33:36 +00:00
|
|
|
|
To signal with MESSAGE without interpreting format characters
|
2020-03-01 17:50:14 +00:00
|
|
|
|
like `%', `\\=`' and `\\='', use (user-error \"%s\" MESSAGE).
|
2019-06-27 09:33:36 +00:00
|
|
|
|
In Emacs, the convention is that error messages start with a capital
|
|
|
|
|
letter but *do not* end with a period. Please follow this convention
|
2022-05-23 11:56:03 +00:00
|
|
|
|
for the sake of consistency.
|
|
|
|
|
|
|
|
|
|
To alter the look of the displayed error messages, you can use
|
|
|
|
|
the `command-error-function' variable."
|
More-conservative ‘format’ quote restyling
Instead of restyling curved quotes for every call to ‘format’,
create a new function ‘format-message’ that does the restyling,
and using the new function instead of ‘format’ only in contexts
where this seems appropriate.
Problem reported by Dmitry Gutov and Andreas Schwab in:
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00826.html
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00827.html
* doc/lispref/commands.texi (Using Interactive):
* doc/lispref/control.texi (Signaling Errors, Signaling Errors):
* doc/lispref/display.texi (Displaying Messages, Progress):
* doc/lispref/elisp.texi:
* doc/lispref/help.texi (Keys in Documentation):
* doc/lispref/minibuf.texi (Minibuffer Misc):
* doc/lispref/strings.texi (Formatting Strings):
* etc/NEWS:
Document the changes.
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/apropos.el (apropos-library):
* lisp/calc/calc-ext.el (calc-record-message)
(calc-user-function-list):
* lisp/calc/calc-help.el (calc-describe-key, calc-full-help):
* lisp/calc/calc-lang.el (math-read-big-balance):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--add-diary-entry):
* lisp/cedet/mode-local.el (mode-local-print-binding)
(mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-completion-message):
* lisp/cedet/semantic/edit.el (semantic-parse-changes-failed):
* lisp/cedet/semantic/wisent/comp.el (wisent-log):
* lisp/cedet/srecode/insert.el (srecode-insert-show-error-report):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dframe.el (dframe-message):
* lisp/dired-aux.el (dired-query):
* lisp/emacs-lisp/byte-opt.el (byte-compile-log-lap-1):
* lisp/emacs-lisp/bytecomp.el (byte-compile-log)
(byte-compile-log-file, byte-compile-warn, byte-compile-form):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use)
(cconv-analyze-form):
* lisp/emacs-lisp/check-declare.el (check-declare-warn):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet):
* lisp/emacs-lisp/edebug.el (edebug-format):
* lisp/emacs-lisp/eieio-core.el (eieio-oref):
* lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message)
(eldoc-message):
* lisp/emacs-lisp/elint.el (elint-file, elint-log):
* lisp/emacs-lisp/find-func.el (find-function-library):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring):
* lisp/emacs-lisp/package.el (package-compute-transaction)
(package-install-button-action, package-delete-button-action)
(package-menu--list-to-prompt):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emacs-lisp/warnings.el (lwarn, warn):
* lisp/emulation/viper-cmd.el:
(viper-toggle-parse-sexp-ignore-comments)
(viper-kill-buffer, viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/facemenu.el (facemenu-add-new-face):
* lisp/faces.el (face-documentation, read-face-name)
(face-read-string, read-face-font, describe-face):
* lisp/files.el (find-alternate-file, hack-local-variables)
(hack-one-local-variable--obsolete, write-file)
(basic-save-buffer, delete-directory):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--obsolete)
(help-fns--interactive-only, describe-function-1)
(describe-variable):
* lisp/help.el (describe-mode):
* lisp/info-xref.el (info-xref-output):
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
* lisp/international/kkc.el (kkc-error):
* lisp/international/mule-cmds.el:
(select-safe-coding-system-interactively)
(select-safe-coding-system, describe-input-method):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/international/quail.el (quail-error):
* lisp/minibuffer.el (minibuffer-message):
* lisp/mpc.el (mpc--debug):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-message):
* lisp/net/gnutls.el (gnutls-message-maybe):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/nsm.el (nsm-query-user):
* lisp/net/rlogin.el (rlogin):
* lisp/net/soap-client.el (soap-warning):
* lisp/net/tramp.el (tramp-debug-message):
* lisp/nxml/nxml-outln.el (nxml-report-outline-error):
* lisp/nxml/nxml-parse.el (nxml-parse-error):
* lisp/nxml/rng-cmpct.el (rng-c-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/org/org-ctags.el:
(org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/proced.el (proced-log):
* lisp/progmodes/ebnf2ps.el (ebnf-log):
* lisp/progmodes/flymake.el (flymake-log):
* lisp/progmodes/vhdl-mode.el (vhdl-warning-when-idle):
* lisp/replace.el (occur-1):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, define-alternatives):
* lisp/startup.el (command-line):
* lisp/subr.el (error, user-error, add-to-list):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* src/callint.c (Fcall_interactively):
* src/editfns.c (Fmessage, Fmessage_box):
Restyle the quotes of format strings intended for use as a
diagnostic, when restyling seems appropriate.
* lisp/subr.el (format-message): New function.
* src/doc.c (Finternal__text_restyle): New function.
(syms_of_doc): Define it.
2015-08-24 05:38:02 +00:00
|
|
|
|
(signal 'user-error (list (apply #'format-message format args))))
|
Add new error and function `user-error'.
* lisp/subr.el (user-error): New function.
* lisp/window.el (switch-to-buffer):
* lisp/vc/smerge-mode.el (smerge-resolve-function, smerge-resolve)
(smerge-match-conflict):
* lisp/simple.el (previous-matching-history-element)
(next-matching-history-element, goto-history-element, undo-more)
(undo-start):
* lisp/progmodes/etags.el (visit-tags-table-buffer, find-tag-tag)
(find-tag-noselect, find-tag-in-order, etags-goto-tag-location)
(next-file, tags-loop-scan, list-tags, complete-tag):
* lisp/progmodes/compile.el (compilation-loop):
* lisp/mouse.el (mouse-minibuffer-check):
* lisp/man.el (Man-bgproc-sentinel, Man-goto-page):
* lisp/info.el (Info-find-node-2, Info-extract-pointer, Info-history-back)
(Info-history-forward, Info-follow-reference, Info-menu)
(Info-extract-menu-item, Info-extract-menu-counting)
(Info-forward-node, Info-backward-node, Info-next-menu-item)
(Info-last-menu-item, Info-next-preorder, Info-last-preorder)
(Info-next-reference, Info-prev-reference, Info-index)
(Info-index-next, Info-follow-nearest-node)
(Info-copy-current-node-name):
* lisp/imenu.el (imenu--make-index-alist)
(imenu-default-create-index-function, imenu-add-to-menubar):
* lisp/files.el (basic-save-buffer, recover-file):
* lisp/emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
* lisp/emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments)
(checkdoc-message-text, checkdoc-defun):
* lisp/dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point):
* lisp/cus-edit.el (customize-changed-options, customize-rogue)
(customize-saved, custom-variable-set, custom-variable-mark-to-save)
(custom-variable-mark-to-reset-standard)
(custom-variable-reset-backup, custom-face-mark-to-reset-standard)
(custom-file):
* lisp/completion.el (check-completion-length):
* lisp/comint.el (comint-search-arg)
(comint-previous-matching-input-string-position)
(comint-previous-matching-input)
(comint-replace-by-expanded-history-before-point, comint-send-input)
(comint-copy-old-input, comint-backward-matching-input)
(comint-goto-process-mark, comint-set-process-mark):
* lisp/calendar/calendar.el (calendar-cursor-to-date): Use it.
* lisp/bindings.el (debug-ignored-errors): Remove regexps, add `user-error'.
* src/data.c (PUT_ERROR): New macro.
(syms_of_data): Use it. Add new error type `user-error'.
* src/undo.c (user_error): New function.
(Fprimitive_undo): Use it.
* src/print.c (print_error_message): Adjust print style for `user-error'.
* src/keyboard.c (user_error): New function.
(Fexit_recursive_edit, Fabort_recursive_edit): Use it.
2012-05-04 23:16:47 +00:00
|
|
|
|
|
* lisp/subr.el (define-error): New function.
* doc/lispref/control.texi (Signaling Errors): Refer to define-error.
(Error Symbols): Add `define-error'.
* doc/lispref/errors.texi (Standard Errors): Don't refer to `error-conditions'.
* lisp/progmodes/ada-xref.el (ada-error-file-not-found): Rename from
error-file-not-found and define with define-error.
* lisp/emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el
and define with define-error.
* lisp/userlock.el (file-locked, file-supersession):
* lisp/simple.el (mark-inactive):
* lisp/progmodes/js.el (js-moz-bad-rpc, js-js-error):
* lisp/progmodes/ada-mode.el (ada-mode-errors):
* lisp/play/life.el (life-extinct):
* lisp/nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error):
* lisp/nxml/xmltok.el (xmltok-markup-declaration-parse-error):
* lisp/nxml/rng-util.el (rng-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-cmpct.el (rng-c-incorrect-schema):
* lisp/nxml/nxml-util.el (nxml-error, nxml-file-parse-error):
* lisp/nxml/nxml-rap.el (nxml-scan-error):
* lisp/nxml/nxml-outln.el (nxml-outline-error):
* lisp/net/soap-client.el (soap-error):
* lisp/net/gnutls.el (gnutls-error):
* lisp/net/ange-ftp.el (ftp-error):
* lisp/mpc.el (mpc-proc-error):
* lisp/json.el (json-error, json-readtable-error, json-unknown-keyword)
(json-number-format, json-string-escape, json-string-format)
(json-key-format, json-object-format):
* lisp/jka-compr.el (compression-error):
* lisp/international/quail.el (quail-error):
* lisp/international/kkc.el (kkc-error):
* lisp/emacs-lisp/ert.el (ert-test-failed):
* lisp/calc/calc.el (calc-error, inexact-result, math-overflow)
(math-underflow):
* lisp/bookmark.el (bookmark-error-no-filename):
* lisp/epg.el (epg-error): Define with define-error.
2013-08-09 21:22:44 +00:00
|
|
|
|
(defun define-error (name message &optional parent)
|
|
|
|
|
"Define NAME as a new error signal.
|
|
|
|
|
MESSAGE is a string that will be output to the echo area if such an error
|
|
|
|
|
is signaled without being caught by a `condition-case'.
|
|
|
|
|
PARENT is either a signal or a list of signals from which it inherits.
|
|
|
|
|
Defaults to `error'."
|
|
|
|
|
(unless parent (setq parent 'error))
|
|
|
|
|
(let ((conditions
|
|
|
|
|
(if (consp parent)
|
2015-02-06 03:04:13 +00:00
|
|
|
|
(apply #'append
|
* lisp/subr.el (define-error): New function.
* doc/lispref/control.texi (Signaling Errors): Refer to define-error.
(Error Symbols): Add `define-error'.
* doc/lispref/errors.texi (Standard Errors): Don't refer to `error-conditions'.
* lisp/progmodes/ada-xref.el (ada-error-file-not-found): Rename from
error-file-not-found and define with define-error.
* lisp/emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el
and define with define-error.
* lisp/userlock.el (file-locked, file-supersession):
* lisp/simple.el (mark-inactive):
* lisp/progmodes/js.el (js-moz-bad-rpc, js-js-error):
* lisp/progmodes/ada-mode.el (ada-mode-errors):
* lisp/play/life.el (life-extinct):
* lisp/nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error):
* lisp/nxml/xmltok.el (xmltok-markup-declaration-parse-error):
* lisp/nxml/rng-util.el (rng-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-cmpct.el (rng-c-incorrect-schema):
* lisp/nxml/nxml-util.el (nxml-error, nxml-file-parse-error):
* lisp/nxml/nxml-rap.el (nxml-scan-error):
* lisp/nxml/nxml-outln.el (nxml-outline-error):
* lisp/net/soap-client.el (soap-error):
* lisp/net/gnutls.el (gnutls-error):
* lisp/net/ange-ftp.el (ftp-error):
* lisp/mpc.el (mpc-proc-error):
* lisp/json.el (json-error, json-readtable-error, json-unknown-keyword)
(json-number-format, json-string-escape, json-string-format)
(json-key-format, json-object-format):
* lisp/jka-compr.el (compression-error):
* lisp/international/quail.el (quail-error):
* lisp/international/kkc.el (kkc-error):
* lisp/emacs-lisp/ert.el (ert-test-failed):
* lisp/calc/calc.el (calc-error, inexact-result, math-overflow)
(math-underflow):
* lisp/bookmark.el (bookmark-error-no-filename):
* lisp/epg.el (epg-error): Define with define-error.
2013-08-09 21:22:44 +00:00
|
|
|
|
(mapcar (lambda (parent)
|
|
|
|
|
(cons parent
|
|
|
|
|
(or (get parent 'error-conditions)
|
Go back to grave quoting in source-code docstrings etc.
This reverts almost all my recent changes to use curved quotes
in docstrings and/or strings used for error diagnostics.
There are a few exceptions, e.g., Bahá’í proper names.
* admin/unidata/unidata-gen.el (unidata-gen-table):
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/align.el (align-region):
* lisp/allout.el (allout-mode, allout-solicit-alternate-bullet)
(outlineify-sticky):
* lisp/apropos.el (apropos-library):
* lisp/bookmark.el (bookmark-default-annotation-text):
* lisp/button.el (button-category-symbol, button-put)
(make-text-button):
* lisp/calc/calc-aent.el (math-read-if, math-read-factor):
* lisp/calc/calc-embed.el (calc-do-embedded):
* lisp/calc/calc-ext.el (calc-user-function-list):
* lisp/calc/calc-graph.el (calc-graph-show-dumb):
* lisp/calc/calc-help.el (calc-describe-key)
(calc-describe-thing, calc-full-help):
* lisp/calc/calc-lang.el (calc-c-language)
(math-parse-fortran-vector-end, math-parse-tex-sum)
(math-parse-eqn-matrix, math-parse-eqn-prime)
(calc-yacas-language, calc-maxima-language, calc-giac-language)
(math-read-giac-subscr, math-read-math-subscr)
(math-read-big-rec, math-read-big-balance):
* lisp/calc/calc-misc.el (calc-help, report-calc-bug):
* lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes)
(calc-auto-recompute):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-read-parse-table-part, calc-user-define-invocation)
(math-do-arg-check):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-vec.el (math-read-brackets):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calc/calc.el (calc, calc-do, calc-user-invocation):
* lisp/calendar/appt.el (appt-display-message):
* lisp/calendar/diary-lib.el (diary-check-diary-file)
(diary-mail-entries, diary-from-outlook):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--convert-float-to-ical)
(icalendar--convert-date-to-ical)
(icalendar--convert-ical-to-diary)
(icalendar--convert-recurring-to-diary)
(icalendar--add-diary-entry):
* lisp/calendar/time-date.el (format-seconds):
* lisp/calendar/timeclock.el (timeclock-mode-line-display)
(timeclock-make-hours-explicit, timeclock-log-data):
* lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category)
(todo-item-mark, todo-check-format)
(todo-insert-item--next-param, todo-edit-item--next-key)
(todo-mode):
* lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules):
* lisp/cedet/mode-local.el (describe-mode-local-overload)
(mode-local-print-binding, mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-displayor-show-request):
* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-start.el (standard):
* lisp/cus-theme.el (describe-theme-1):
* lisp/custom.el (custom-add-dependencies, custom-check-theme)
(custom--sort-vars-1, load-theme):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log):
* lisp/emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-read-advice-name, ad-enable-advice)
(ad-disable-advice, ad-remove-advice, ad-set-argument)
(ad-set-arguments, ad--defalias-fset, ad-activate)
(ad-deactivate):
* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand)
(byte-compile-unfold-lambda, byte-optimize-form-code-walker)
(byte-optimize-while, byte-optimize-apply):
* lisp/emacs-lisp/byte-run.el (defun, defsubst):
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode)
(byte-compile-log-file, byte-compile-format-warn)
(byte-compile-nogroup-warn, byte-compile-arglist-warn)
(byte-compile-cl-warn)
(byte-compile-warn-about-unresolved-functions)
(byte-compile-file, byte-compile--declare-var)
(byte-compile-file-form-defmumble, byte-compile-form)
(byte-compile-normal-call, byte-compile-check-variable)
(byte-compile-variable-ref, byte-compile-variable-set)
(byte-compile-subr-wrong-args, byte-compile-setq-default)
(byte-compile-negation-optimizer)
(byte-compile-condition-case--old)
(byte-compile-condition-case--new, byte-compile-save-excursion)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form)
(byte-compile-make-variable-buffer-local, display-call-tree)
(batch-byte-compile):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use):
* lisp/emacs-lisp/chart.el (chart-space-usage):
* lisp/emacs-lisp/check-declare.el (check-declare-scan)
(check-declare-warn, check-declare-file)
(check-declare-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine)
(checkdoc-message-text-engine):
* lisp/emacs-lisp/cl-extra.el (cl-parse-integer)
(cl--describe-class):
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric)
(cl--generic-describe, cl-generic-generalizers):
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody)
(cl-symbol-macrolet):
* lisp/emacs-lisp/cl.el (cl-unload-function, flet):
* lisp/emacs-lisp/copyright.el (copyright)
(copyright-update-directory):
* lisp/emacs-lisp/edebug.el (edebug-read-list):
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-read):
* lisp/emacs-lisp/eieio-core.el (eieio--slot-override)
(eieio-oref):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor):
* lisp/emacs-lisp/eieio-speedbar.el:
(eieio-speedbar-child-make-tag-lines)
(eieio-speedbar-child-description):
* lisp/emacs-lisp/eieio.el (defclass, change-class):
* lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms)
(elint-init-form, elint-check-defalias-form)
(elint-check-let-form):
* lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu)
(ert-results-pop-to-backtrace-for-test-at-point)
(ert-results-pop-to-messages-for-test-at-point)
(ert-results-pop-to-should-forms-for-test-at-point)
(ert-describe-test):
* lisp/emacs-lisp/find-func.el (find-function-search-for-symbol)
(find-function-library):
* lisp/emacs-lisp/generator.el (iter-yield):
* lisp/emacs-lisp/gv.el (gv-define-simple-setter):
* lisp/emacs-lisp/lisp-mnt.el (lm-verify):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring)
(advice--make, define-advice):
* lisp/emacs-lisp/package-x.el (package-upload-file):
* lisp/emacs-lisp/package.el (package-version-join)
(package-disabled-p, package-activate-1, package-activate)
(package--download-one-archive)
(package--download-and-read-archives)
(package-compute-transaction, package-install-from-archive)
(package-install, package-install-selected-packages)
(package-delete, package-autoremove, describe-package-1)
(package-install-button-action, package-delete-button-action)
(package-menu-hide-package, package-menu--list-to-prompt)
(package-menu--perform-transaction)
(package-menu--find-and-notify-upgrades):
* lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1):
* lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode):
* lisp/emacs-lisp/ring.el (ring-previous, ring-next):
* lisp/emacs-lisp/rx.el (rx-check, rx-anything)
(rx-check-any-string, rx-check-any, rx-check-not, rx-=)
(rx-repeat, rx-check-backref, rx-syntax, rx-check-category)
(rx-form):
* lisp/emacs-lisp/smie.el (smie-config-save):
* lisp/emacs-lisp/subr-x.el (internal--check-binding):
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag):
* lisp/emacs-lisp/testcover.el (testcover-1value):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments)
(viper-toggle-search-style, viper-kill-buffer)
(viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/env.el (setenv):
* lisp/erc/erc-button.el (erc-nick-popup):
* lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english):
* lisp/eshell/em-dirs.el (eshell/cd):
* lisp/eshell/em-glob.el (eshell-glob-regexp)
(eshell-glob-entries):
* lisp/eshell/em-pred.el (eshell-parse-modifiers):
* lisp/eshell/esh-opt.el (eshell-show-usage):
* lisp/facemenu.el (facemenu-add-new-face)
(facemenu-add-new-color):
* lisp/faces.el (read-face-name, read-face-font, describe-face)
(x-resolve-font-name):
* lisp/files-x.el (modify-file-local-variable):
* lisp/files.el (locate-user-emacs-file, find-alternate-file)
(set-auto-mode, hack-one-local-variable--obsolete)
(dir-locals-set-directory-class, write-file, basic-save-buffer)
(delete-directory, copy-directory, recover-session)
(recover-session-finish, insert-directory)
(file-modes-char-to-who, file-modes-symbolic-to-number)
(move-file-to-trash):
* lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer):
* lisp/find-cmd.el (find-generic, find-to-string):
* lisp/finder.el (finder-commentary):
* lisp/font-lock.el (font-lock-fontify-buffer):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/frame.el (get-device-terminal, select-frame-by-name):
* lisp/fringe.el (fringe--check-style):
* lisp/gnus/nnmairix.el (nnmairix-widget-create-query):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--parent-mode)
(help-fns--obsolete, help-fns--interactive-only)
(describe-function-1, describe-variable):
* lisp/help.el (describe-mode)
(describe-minor-mode-from-indicator):
* lisp/image.el (image-type):
* lisp/international/ccl.el (ccl-dump):
* lisp/international/fontset.el (x-must-resolve-font-name):
* lisp/international/mule-cmds.el (prefer-coding-system)
(select-safe-coding-system-interactively)
(select-safe-coding-system, activate-input-method)
(toggle-input-method, describe-current-input-method)
(describe-language-environment):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/mail/feedmail.el (feedmail-run-the-queue):
* lisp/mouse.el (minor-mode-menu-from-indicator):
* lisp/mpc.el (mpc-playlist-rename):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-shell-command):
* lisp/net/imap.el (imap-interactive-login):
* lisp/net/mairix.el (mairix-widget-create-query):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/rlogin.el (rlogin):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/obsolete/otodo-mode.el (todo-more-important-p):
* lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region):
* lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region):
* lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region):
* lisp/org/ob-core.el (org-babel-goto-named-src-block)
(org-babel-goto-named-result):
* lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap):
* lisp/org/ob-ref.el (org-babel-ref-resolve):
* lisp/org/org-agenda.el (org-agenda-prepare):
* lisp/org/org-clock.el (org-clock-notify-once-if-expired)
(org-clock-resolve):
* lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/org/org-feed.el (org-feed-parse-atom-entry):
* lisp/org/org-habit.el (org-habit-parse-todo):
* lisp/org/org-mouse.el (org-mouse-popup-global-menu)
(org-mouse-context-menu):
* lisp/org/org-table.el (org-table-edit-formulas):
* lisp/org/ox.el (org-export-async-start):
* lisp/proced.el (proced-log):
* lisp/progmodes/ada-mode.el (ada-get-indent-case)
(ada-check-matching-start, ada-goto-matching-start):
* lisp/progmodes/ada-prj.el (ada-prj-display-page):
* lisp/progmodes/ada-xref.el (ada-find-executable):
* lisp/progmodes/ebrowse.el (ebrowse-tags-apropos):
* lisp/progmodes/etags.el (etags-tags-apropos-additional):
* lisp/progmodes/flymake.el (flymake-parse-err-lines)
(flymake-start-syntax-check-process):
* lisp/progmodes/python.el (python-shell-get-process-or-error)
(python-define-auxiliary-skeleton):
* lisp/progmodes/sql.el (sql-comint):
* lisp/progmodes/verilog-mode.el (verilog-load-file-at-point):
* lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate):
* lisp/recentf.el (recentf-open-files):
* lisp/replace.el (query-replace-read-from)
(occur-after-change-function, occur-1):
* lisp/scroll-bar.el (scroll-bar-columns):
* lisp/server.el (server-get-auth-key):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, list-processes--refresh)
(compose-mail, set-variable, choose-completion-string)
(define-alternatives):
* lisp/startup.el (site-run-file, tty-handle-args, command-line)
(command-line-1):
* lisp/subr.el (noreturn, define-error, add-to-list)
(read-char-choice, version-to-list):
* lisp/term/common-win.el (x-handle-xrm-switch)
(x-handle-name-switch, x-handle-args):
* lisp/term/x-win.el (x-handle-parent-id, x-handle-smid):
* lisp/textmodes/reftex-ref.el (reftex-label):
* lisp/textmodes/reftex-toc.el (reftex-toc-rename-label):
* lisp/textmodes/two-column.el (2C-split):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* lisp/type-break.el (type-break-noninteractive-query):
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
* lisp/whitespace.el (whitespace-report-region):
Prefer grave quoting in source-code strings used to generate help
and diagnostics.
* lisp/faces.el (face-documentation):
No need to convert quotes, since the result is a docstring.
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
Simplify by generating only curved quotes, since info files are
typically that ways nowadays anyway.
* lisp/international/mule-diag.el (list-input-methods):
Don’t assume text quoting style is curved.
* lisp/org/org-bibtex.el (org-bibtex-fields):
Revert my recent changes, going back to the old quoting style.
2015-09-07 15:41:44 +00:00
|
|
|
|
(error "Unknown signal `%s'" parent))))
|
* lisp/subr.el (define-error): New function.
* doc/lispref/control.texi (Signaling Errors): Refer to define-error.
(Error Symbols): Add `define-error'.
* doc/lispref/errors.texi (Standard Errors): Don't refer to `error-conditions'.
* lisp/progmodes/ada-xref.el (ada-error-file-not-found): Rename from
error-file-not-found and define with define-error.
* lisp/emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el
and define with define-error.
* lisp/userlock.el (file-locked, file-supersession):
* lisp/simple.el (mark-inactive):
* lisp/progmodes/js.el (js-moz-bad-rpc, js-js-error):
* lisp/progmodes/ada-mode.el (ada-mode-errors):
* lisp/play/life.el (life-extinct):
* lisp/nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error):
* lisp/nxml/xmltok.el (xmltok-markup-declaration-parse-error):
* lisp/nxml/rng-util.el (rng-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-cmpct.el (rng-c-incorrect-schema):
* lisp/nxml/nxml-util.el (nxml-error, nxml-file-parse-error):
* lisp/nxml/nxml-rap.el (nxml-scan-error):
* lisp/nxml/nxml-outln.el (nxml-outline-error):
* lisp/net/soap-client.el (soap-error):
* lisp/net/gnutls.el (gnutls-error):
* lisp/net/ange-ftp.el (ftp-error):
* lisp/mpc.el (mpc-proc-error):
* lisp/json.el (json-error, json-readtable-error, json-unknown-keyword)
(json-number-format, json-string-escape, json-string-format)
(json-key-format, json-object-format):
* lisp/jka-compr.el (compression-error):
* lisp/international/quail.el (quail-error):
* lisp/international/kkc.el (kkc-error):
* lisp/emacs-lisp/ert.el (ert-test-failed):
* lisp/calc/calc.el (calc-error, inexact-result, math-overflow)
(math-underflow):
* lisp/bookmark.el (bookmark-error-no-filename):
* lisp/epg.el (epg-error): Define with define-error.
2013-08-09 21:22:44 +00:00
|
|
|
|
parent))
|
|
|
|
|
(cons parent (get parent 'error-conditions)))))
|
|
|
|
|
(put name 'error-conditions
|
|
|
|
|
(delete-dups (copy-sequence (cons name conditions))))
|
|
|
|
|
(when message (put name 'error-message message))))
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; We put this here instead of in frame.el so that it's defined even on
|
|
|
|
|
;; systems where frame.el isn't loaded.
|
|
|
|
|
(defun frame-configuration-p (object)
|
|
|
|
|
"Return non-nil if OBJECT seems to be a frame configuration.
|
|
|
|
|
Any list whose car is `frame-configuration' is assumed to be a frame
|
|
|
|
|
configuration."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(and (consp object)
|
|
|
|
|
(eq (car object) 'frame-configuration)))
|
2014-05-28 00:50:44 +00:00
|
|
|
|
|
2017-03-02 23:37:23 +00:00
|
|
|
|
(defun apply-partially (fun &rest args)
|
|
|
|
|
"Return a function that is a partial application of FUN to ARGS.
|
|
|
|
|
ARGS is a list of the first N arguments to pass to FUN.
|
|
|
|
|
The result is a new function which does the same as FUN, except that
|
|
|
|
|
the first N arguments are fixed at the values with which this function
|
|
|
|
|
was called."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2017-03-02 23:37:23 +00:00
|
|
|
|
(lambda (&rest args2)
|
|
|
|
|
(apply fun (append args args2))))
|
|
|
|
|
|
2018-07-12 14:29:28 +00:00
|
|
|
|
(defun zerop (number)
|
|
|
|
|
"Return t if NUMBER is zero."
|
|
|
|
|
;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
|
|
|
|
|
;; = has a byte-code.
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (number) boolean))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(pure t) (side-effect-free t)
|
Move side-effect-free and pure declarations to function definitions
Some Lisp functions still had their `side-effect-free` and `pure`
properties declared in byte-opt.el; do it at their definition instead.
The lists in byte-opt.el now only contain functions implemented in C
and function aliases.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns)
(side-effect-and-error-free-fns, pure-fns):
Remove functions whose properties are now declared elsewhere
and some obsolete entries.
* lisp/custom.el (custom-variable-p):
* lisp/emacs-lisp/lisp.el (buffer-end):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt):
* lisp/env.el (getenv):
* lisp/simple.el (count-lines, mark, string-empty-p, lax-plist-get):
* lisp/subr.el (ignore, always, zerop, fixnump, bignump, lsh, last)
(eventp, mouse-movement-p, log10, memory-limit, string-greaterp)
(interactive-p):
* lisp/window.el (get-lru-window, get-largest-window, (window-edges)
(window-body-edges, window-pixel-edges, window-body-pixel-edges)
(window-absolute-pixel-edges, window-absolute-body-pixel-edges)
(one-window-p):
Declare functions `side-effect-free` and/or `pure` as appropriate.
2023-02-17 13:38:50 +00:00
|
|
|
|
(compiler-macro (lambda (_) `(= 0 ,number))))
|
2018-07-12 14:29:28 +00:00
|
|
|
|
(= 0 number))
|
|
|
|
|
|
2018-08-21 23:06:58 +00:00
|
|
|
|
(defun fixnump (object)
|
|
|
|
|
"Return t if OBJECT is a fixnum."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (t) boolean))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(side-effect-free error-free))
|
2018-08-21 23:06:58 +00:00
|
|
|
|
(and (integerp object)
|
|
|
|
|
(<= most-negative-fixnum object most-positive-fixnum)))
|
|
|
|
|
|
|
|
|
|
(defun bignump (object)
|
|
|
|
|
"Return t if OBJECT is a bignum."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (t) boolean))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(side-effect-free error-free))
|
2018-08-21 23:06:58 +00:00
|
|
|
|
(and (integerp object) (not (fixnump object))))
|
|
|
|
|
|
2018-08-18 22:20:46 +00:00
|
|
|
|
(defun lsh (value count)
|
|
|
|
|
"Return VALUE with its bits shifted left by COUNT.
|
|
|
|
|
If COUNT is negative, shifting is actually to the right.
|
|
|
|
|
In this case, if VALUE is a negative fixnum treat it as unsigned,
|
2022-07-20 09:24:49 +00:00
|
|
|
|
i.e., subtract 2 * `most-negative-fixnum' from VALUE before shifting it.
|
|
|
|
|
|
2023-09-15 07:17:30 +00:00
|
|
|
|
Most uses of this function turn out to be mistakes. We recommend
|
|
|
|
|
to use `ash' instead, unless COUNT could ever be negative, and
|
|
|
|
|
if, when COUNT is negative, your program really needs the special
|
|
|
|
|
treatment of negative COUNT provided by this function."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (integer integer) integer))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(compiler-macro
|
2022-07-23 10:15:08 +00:00
|
|
|
|
(lambda (form)
|
2023-01-03 14:58:14 +00:00
|
|
|
|
(macroexp-warn-and-return
|
|
|
|
|
(format-message "avoid `lsh'; use `ash' instead")
|
Move side-effect-free and pure declarations to function definitions
Some Lisp functions still had their `side-effect-free` and `pure`
properties declared in byte-opt.el; do it at their definition instead.
The lists in byte-opt.el now only contain functions implemented in C
and function aliases.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns)
(side-effect-and-error-free-fns, pure-fns):
Remove functions whose properties are now declared elsewhere
and some obsolete entries.
* lisp/custom.el (custom-variable-p):
* lisp/emacs-lisp/lisp.el (buffer-end):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt):
* lisp/env.el (getenv):
* lisp/simple.el (count-lines, mark, string-empty-p, lax-plist-get):
* lisp/subr.el (ignore, always, zerop, fixnump, bignump, lsh, last)
(eventp, mouse-movement-p, log10, memory-limit, string-greaterp)
(interactive-p):
* lisp/window.el (get-lru-window, get-largest-window, (window-edges)
(window-body-edges, window-pixel-edges, window-body-pixel-edges)
(window-absolute-pixel-edges, window-absolute-body-pixel-edges)
(one-window-p):
Declare functions `side-effect-free` and/or `pure` as appropriate.
2023-02-17 13:38:50 +00:00
|
|
|
|
form '(suspicious lsh) t form)))
|
|
|
|
|
(side-effect-free t))
|
2018-08-18 22:20:46 +00:00
|
|
|
|
(when (and (< value 0) (< count 0))
|
|
|
|
|
(when (< value most-negative-fixnum)
|
|
|
|
|
(signal 'args-out-of-range (list value count)))
|
|
|
|
|
(setq value (logand (ash value -1) most-positive-fixnum))
|
|
|
|
|
(setq count (1+ count)))
|
|
|
|
|
(ash value count))
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; List functions.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
;; Note: `internal--compiler-macro-cXXr' was copied from
|
|
|
|
|
;; `cl--compiler-macro-cXXr' in cl-macs.el. If you amend either one,
|
|
|
|
|
;; you may want to amend the other, too.
|
|
|
|
|
(defun internal--compiler-macro-cXXr (form x)
|
|
|
|
|
(let* ((head (car form))
|
2022-06-21 22:41:13 +00:00
|
|
|
|
(n (symbol-name head))
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(i (- (length n) 2)))
|
|
|
|
|
(if (not (string-match "c[ad]+r\\'" n))
|
|
|
|
|
(if (and (fboundp head) (symbolp (symbol-function head)))
|
2022-06-21 22:41:13 +00:00
|
|
|
|
(internal--compiler-macro-cXXr
|
|
|
|
|
(cons (symbol-function head) (cdr form)) x)
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(error "Compiler macro for cXXr applied to non-cXXr form"))
|
|
|
|
|
(while (> i (match-beginning 0))
|
|
|
|
|
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
|
|
|
|
|
(setq i (1- i)))
|
|
|
|
|
x)))
|
|
|
|
|
|
|
|
|
|
(defun caar (x)
|
1997-08-23 18:55:52 +00:00
|
|
|
|
"Return the car of the car of X."
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
1997-08-23 18:55:52 +00:00
|
|
|
|
(car (car x)))
|
|
|
|
|
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(defun cadr (x)
|
1997-08-23 18:55:52 +00:00
|
|
|
|
"Return the car of the cdr of X."
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
1997-08-23 18:55:52 +00:00
|
|
|
|
(car (cdr x)))
|
|
|
|
|
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(defun cdar (x)
|
1997-08-23 18:55:52 +00:00
|
|
|
|
"Return the cdr of the car of X."
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
1997-08-23 18:55:52 +00:00
|
|
|
|
(cdr (car x)))
|
|
|
|
|
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(defun cddr (x)
|
1997-08-23 18:55:52 +00:00
|
|
|
|
"Return the cdr of the cdr of X."
|
Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
Also expunge eudc-c[ad]+r.
* subr.el (internal--compiler-macro-cXXr): "New" function, copied
from cl--compiler-macro-cXXr.
(caar, cadr, cdar, cddr): Change from defsubsts to defuns with
the above compiler-macro.
* net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
* emacs-lisp/cl.el (Top level dolist doing defaliases): Remove
caaar, etc., from list of new alias functions.
* emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
(gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
which generate obsolete cl- aliases for caaar, etc. Invoke them.
* desktop.el:
* edmacro.el:
* emacs-lisp/cl-macs.el:
* frameset.el:
* ibuffer.el:
* mail/footnote.el:
* net/dbus.el:
* net/eudc-export.el:
* net/eudc.el:
* net/eudcb-ph.el:
* net/rcirc.el:
* net/secrets.el:
* play/5x5.el:
* play/decipher.el:
* play/hanoi.el:
* progmodes/hideif.el:
* ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
2015-04-05 12:41:45 +00:00
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
1997-08-23 18:55:52 +00:00
|
|
|
|
(cdr (cdr x)))
|
1997-08-23 19:10:42 +00:00
|
|
|
|
|
Move cXXXr and cXXXXr to subr.el
* etc/NEWS: Mention new core Elisp.
* doc/lispref/lists.texi (List Elements): Document and index the new
functions.
* doc/misc/cl.texi (List Functions): Change "defines" to "aliases".
* lisp/subr.el (caaar, caadr, cadar, caddr, cdaar, cdadr, cddar)
(cdddr, caaaar caaadr, caadar, caaddr, cadaar, cadadr, caddar):
(cadddr, cdaaar, cdaadr, cdadar, cdaddr, cddaar, cddadr, cdddar):
(cddddr): New functions.
* lisp/emacs-lisp/cl-lib.el (cl-caaar, cl-caadr, cl-cadar, cl-caddr):
(cl-cdaar, cl-cdadr, cl-cddar cl-cdddr, cl-caaaar cl-caaadr):
(cl-caadar, cl-caaddr, cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr):
(cl-cdaaar, cl-cdaadr, cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr):
(cl-cdddar, cl-cddddr): Alias to new subr functions.
* lisp/emacs-lisp/cl.el (cl-unload-function): Remove cXXXr and cXXXXr
elements.
2017-01-25 19:21:10 +00:00
|
|
|
|
(defun caaar (x)
|
|
|
|
|
"Return the `car' of the `car' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (car (car x))))
|
|
|
|
|
|
|
|
|
|
(defun caadr (x)
|
|
|
|
|
"Return the `car' of the `car' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (car (cdr x))))
|
|
|
|
|
|
|
|
|
|
(defun cadar (x)
|
|
|
|
|
"Return the `car' of the `cdr' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (cdr (car x))))
|
|
|
|
|
|
|
|
|
|
(defun caddr (x)
|
|
|
|
|
"Return the `car' of the `cdr' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (cdr (cdr x))))
|
|
|
|
|
|
|
|
|
|
(defun cdaar (x)
|
|
|
|
|
"Return the `cdr' of the `car' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (car (car x))))
|
|
|
|
|
|
|
|
|
|
(defun cdadr (x)
|
|
|
|
|
"Return the `cdr' of the `car' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (car (cdr x))))
|
|
|
|
|
|
|
|
|
|
(defun cddar (x)
|
|
|
|
|
"Return the `cdr' of the `cdr' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (cdr (car x))))
|
|
|
|
|
|
|
|
|
|
(defun cdddr (x)
|
|
|
|
|
"Return the `cdr' of the `cdr' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (cdr (cdr x))))
|
|
|
|
|
|
|
|
|
|
(defun caaaar (x)
|
|
|
|
|
"Return the `car' of the `car' of the `car' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (car (car (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun caaadr (x)
|
|
|
|
|
"Return the `car' of the `car' of the `car' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (car (car (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun caadar (x)
|
|
|
|
|
"Return the `car' of the `car' of the `cdr' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (car (cdr (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun caaddr (x)
|
|
|
|
|
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (car (cdr (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun cadaar (x)
|
|
|
|
|
"Return the `car' of the `cdr' of the `car' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (cdr (car (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun cadadr (x)
|
|
|
|
|
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (cdr (car (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun caddar (x)
|
|
|
|
|
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (cdr (cdr (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun cadddr (x)
|
|
|
|
|
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(car (cdr (cdr (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun cdaaar (x)
|
|
|
|
|
"Return the `cdr' of the `car' of the `car' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (car (car (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun cdaadr (x)
|
|
|
|
|
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (car (car (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun cdadar (x)
|
|
|
|
|
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (car (cdr (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun cdaddr (x)
|
|
|
|
|
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (car (cdr (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun cddaar (x)
|
|
|
|
|
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (cdr (car (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun cddadr (x)
|
|
|
|
|
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (cdr (car (cdr x)))))
|
|
|
|
|
|
|
|
|
|
(defun cdddar (x)
|
|
|
|
|
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (cdr (cdr (car x)))))
|
|
|
|
|
|
|
|
|
|
(defun cddddr (x)
|
|
|
|
|
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
|
|
|
|
|
(declare (compiler-macro internal--compiler-macro-cXXr))
|
|
|
|
|
(cdr (cdr (cdr (cdr x)))))
|
|
|
|
|
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(defun last (list &optional n)
|
|
|
|
|
"Return the last link of LIST. Its car is the last element.
|
|
|
|
|
If LIST is nil, return nil.
|
|
|
|
|
If N is non-nil, return the Nth-to-last link of LIST.
|
|
|
|
|
If N is bigger than the length of LIST, return LIST."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (list &optional integer) list))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(pure t) (side-effect-free t)) ; pure up to mutation
|
1997-08-27 22:34:30 +00:00
|
|
|
|
(if n
|
2010-10-13 23:43:39 +00:00
|
|
|
|
(and (>= n 0)
|
2010-10-13 23:15:03 +00:00
|
|
|
|
(let ((m (safe-length list)))
|
2010-10-13 03:30:36 +00:00
|
|
|
|
(if (< n m) (nthcdr (- m n) list) list)))
|
|
|
|
|
(and list
|
2010-10-13 23:15:03 +00:00
|
|
|
|
(nthcdr (1- (safe-length list)) list))))
|
1998-07-31 10:53:30 +00:00
|
|
|
|
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(defun butlast (list &optional n)
|
2014-02-01 07:54:29 +00:00
|
|
|
|
"Return a copy of LIST with the last N elements removed.
|
2022-07-19 09:59:37 +00:00
|
|
|
|
If N is omitted or nil, return a copy of LIST without its last element.
|
|
|
|
|
If N is zero or negative, return LIST."
|
2019-04-17 16:35:12 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2022-07-19 09:59:37 +00:00
|
|
|
|
(unless n
|
|
|
|
|
(setq n 1))
|
|
|
|
|
(if (<= n 0)
|
|
|
|
|
list
|
|
|
|
|
(take (- (length list) n) list)))
|
2000-12-28 12:15:44 +00:00
|
|
|
|
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(defun nbutlast (list &optional n)
|
lisp/*.el: Fix typos and improve some docstrings
* lisp/auth-source.el (auth-source-backend-parse-parameters)
(auth-source-search-collection)
(auth-source-secrets-listify-pattern)
(auth-source--decode-octal-string, auth-source-plstore-search):
* lisp/registry.el (registry-lookup)
(registry-lookup-breaks-before-lexbind)
(registry-lookup-secondary, registry-lookup-secondary-value)
(registry-search, registry-delete, registry-size, registry-full)
(registry-insert, registry-reindex, registry-prune)
(registry-collect-prune-candidates):
* lisp/subr.el (nbutlast, process-live-p):
* lisp/tab-bar.el (tab-bar-list):
* lisp/cedet/ede/linux.el (ede-linux--get-archs)
(ede-linux--include-path, ede-linux-load):
* lisp/erc/erc-log.el (erc-log-all-but-server-buffers):
* lisp/erc/erc-pcomplete.el (pcomplete-erc-commands)
(pcomplete-erc-ops, pcomplete-erc-not-ops, pcomplete-erc-nicks)
(pcomplete-erc-all-nicks, pcomplete-erc-channels)
(pcomplete-erc-command-name, pcomplete-erc-parse-arguments):
* lisp/eshell/em-term.el (eshell-visual-command-p):
* lisp/gnus/gnus-cache.el (gnus-cache-fully-p):
* lisp/gnus/nnmail.el (nnmail-get-active)
(nnmail-fancy-expiry-target):
* lisp/mail/mail-utils.el (mail-string-delete):
* lisp/mail/supercite.el (sc-hdr, sc-valid-index-p):
* lisp/net/ange-ftp.el (ange-ftp-use-smart-gateway-p):
* lisp/net/nsm.el (nsm-save-fingerprint-maybe)
(nsm-network-same-subnet, nsm-should-check):
* lisp/net/rcirc.el (rcirc-looking-at-input):
* lisp/net/tramp-cache.el (tramp-get-hash-table):
* lisp/net/tramp-compat.el (tramp-compat-process-running-p):
* lisp/net/tramp-smb.el (tramp-smb-get-share)
(tramp-smb-get-localname, tramp-smb-read-file-entry)
(tramp-smb-get-cifs-capabilities, tramp-smb-get-stat-capability):
* lisp/net/zeroconf.el (zeroconf-list-service-names)
(zeroconf-list-service-types, zeroconf-list-services)
(zeroconf-get-host, zeroconf-get-domain)
(zeroconf-get-host-domain):
* lisp/nxml/rng-xsd.el (rng-xsd-compile)
(rng-xsd-make-date-time-regexp, rng-xsd-convert-date-time):
* lisp/obsolete/erc-hecomplete.el (erc-hecomplete)
(erc-command-list, erc-complete-at-prompt):
* lisp/org/ob-scheme.el (org-babel-scheme-get-buffer-impl):
* lisp/org/ob-shell.el (org-babel--variable-assignments:sh-generic)
(org-babel--variable-assignments:bash_array)
(org-babel--variable-assignments:bash_assoc)
(org-babel--variable-assignments:bash):
* lisp/org/org-clock.el (org-day-of-week):
* lisp/progmodes/cperl-mode.el (cperl-char-ends-sub-keyword-p):
* lisp/progmodes/gud.el (gud-find-c-expr, gud-innermost-expr)
(gud-prev-expr, gud-next-expr):
* lisp/textmodes/table.el (table--at-cell-p, table--probe-cell)
(table--get-cell-justify-property)
(table--get-cell-valign-property)
(table--put-cell-justify-property)
(table--put-cell-valign-property): Fix typos.
* lisp/so-long.el (fboundp): Doc fix.
(so-long-mode-line-info, so-long-mode)
(so-long--check-header-modes): Fix typos.
* lisp/emulation/viper-mous.el (viper-surrounding-word)
(viper-mouse-click-get-word): Fix typos.
(viper-mouse-click-search-word): Doc fix.
* lisp/erc/erc-backend.el (erc-forward-word, erc-word-at-arg-p)
(erc-bounds-of-word-at-point): Fix typos.
(erc-decode-string-from-target, define-erc-response-handler):
Refill docstring.
* lisp/erc/erc-dcc.el (pcomplete/erc-mode/DCC): Fix typo.
(erc-dcc-get-host, erc-dcc-auto-mask-p, erc-dcc-get-file):
Doc fixes.
* lisp/erc/erc-networks.el (erc-network-name): Fix typo.
(erc-determine-network): Refill docstring.
* lisp/net/dbus.el (dbus-list-hash-table)
(dbus-string-to-byte-array, dbus-byte-array-to-string)
(dbus-check-event): Fix typos.
(dbus-introspect-get-property): Doc fix.
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler):
Rename ARGS to ARGUMENTS. Doc fix.
(tramp-adb-sh-fix-ls-output, tramp-adb-execute-adb-command)
(tramp-adb-find-test-command): Fix typos.
* lisp/net/tramp.el (tramp-set-completion-function)
(tramp-get-completion-function)
(tramp-completion-dissect-file-name)
(tramp-completion-dissect-file-name1)
(tramp-get-completion-methods, tramp-get-completion-user-host)
(tramp-get-inode, tramp-get-device, tramp-mode-string-to-int)
(tramp-call-process, tramp-call-process-region)
(tramp-process-lines): Fix typos.
(tramp-interrupt-process): Doc fix.
* lisp/org/ob-core.el (org-babel-named-src-block-regexp-for-name)
(org-babel-named-data-regexp-for-name): Doc fix.
(org-babel-src-block-names, org-babel-result-names): Fix typos.
* lisp/progmodes/inf-lisp.el (lisp-input-filter): Doc fix.
(lisp-fn-called-at-pt): Fix typo.
* lisp/progmodes/xref.el (xref-backend-identifier-at-point):
Doc fix.
(xref-backend-identifier-completion-table): Fix typo.
2019-10-20 10:12:27 +00:00
|
|
|
|
"Modify LIST to remove the last N elements.
|
2014-02-01 07:54:29 +00:00
|
|
|
|
If N is omitted or nil, remove the last element."
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(let ((m (length list)))
|
2000-12-28 12:15:44 +00:00
|
|
|
|
(or n (setq n 1))
|
|
|
|
|
(and (< n m)
|
|
|
|
|
(progn
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
|
|
|
|
|
list))))
|
2000-12-28 12:15:44 +00:00
|
|
|
|
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(defun delete-dups (list)
|
|
|
|
|
"Destructively remove `equal' duplicates from LIST.
|
|
|
|
|
Store the result in LIST and return it. LIST must be a proper list.
|
|
|
|
|
Of several `equal' occurrences of an element in LIST, the first
|
2021-10-05 07:11:33 +00:00
|
|
|
|
one is kept. See `seq-uniq' for non-destructive operation."
|
2015-05-07 01:13:56 +00:00
|
|
|
|
(let ((l (length list)))
|
|
|
|
|
(if (> l 100)
|
|
|
|
|
(let ((hash (make-hash-table :test #'equal :size l))
|
|
|
|
|
(tail list) retail)
|
|
|
|
|
(puthash (car list) t hash)
|
|
|
|
|
(while (setq retail (cdr tail))
|
|
|
|
|
(let ((elt (car retail)))
|
|
|
|
|
(if (gethash elt hash)
|
|
|
|
|
(setcdr tail (cdr retail))
|
2015-07-16 14:52:30 +00:00
|
|
|
|
(puthash elt t hash)
|
|
|
|
|
(setq tail retail)))))
|
2015-05-07 01:13:56 +00:00
|
|
|
|
(let ((tail list))
|
|
|
|
|
(while tail
|
|
|
|
|
(setcdr tail (delete (car tail) (cdr tail)))
|
|
|
|
|
(setq tail (cdr tail))))))
|
2015-05-06 18:27:43 +00:00
|
|
|
|
list)
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
2017-11-26 06:45:41 +00:00
|
|
|
|
;; See https://lists.gnu.org/r/emacs-devel/2013-05/msg00204.html
|
2013-05-17 02:43:41 +00:00
|
|
|
|
(defun delete-consecutive-dups (list &optional circular)
|
|
|
|
|
"Destructively remove `equal' consecutive duplicates from LIST.
|
|
|
|
|
First and last elements are considered consecutive if CIRCULAR is
|
2023-02-26 13:34:58 +00:00
|
|
|
|
non-nil.
|
|
|
|
|
Of several consecutive `equal' occurrences, the one earliest in
|
|
|
|
|
the list is kept."
|
2013-05-17 02:43:41 +00:00
|
|
|
|
(let ((tail list) last)
|
2015-07-26 17:43:10 +00:00
|
|
|
|
(while (cdr tail)
|
2013-05-17 02:43:41 +00:00
|
|
|
|
(if (equal (car tail) (cadr tail))
|
|
|
|
|
(setcdr tail (cddr tail))
|
2015-07-26 17:43:10 +00:00
|
|
|
|
(setq last tail
|
2013-05-17 02:43:41 +00:00
|
|
|
|
tail (cdr tail))))
|
|
|
|
|
(if (and circular
|
2015-07-26 17:43:10 +00:00
|
|
|
|
last
|
|
|
|
|
(equal (car tail) (car list)))
|
|
|
|
|
(setcdr last nil)))
|
|
|
|
|
list)
|
2013-05-17 02:43:41 +00:00
|
|
|
|
|
2003-04-05 02:13:44 +00:00
|
|
|
|
(defun number-sequence (from &optional to inc)
|
2003-04-03 02:43:11 +00:00
|
|
|
|
"Return a sequence of numbers from FROM to TO (both inclusive) as a list.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
INC is the increment used between numbers in the sequence and defaults to 1.
|
2013-06-11 16:51:12 +00:00
|
|
|
|
So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
|
2019-11-04 02:36:05 +00:00
|
|
|
|
zero. TO is included only if there is an N for which TO = FROM + N * INC.
|
2013-06-11 16:51:12 +00:00
|
|
|
|
If TO is nil or numerically equal to FROM, return (FROM).
|
2004-04-16 12:51:06 +00:00
|
|
|
|
If INC is positive and TO is less than FROM, or INC is negative
|
|
|
|
|
and TO is larger than FROM, return nil.
|
|
|
|
|
If INC is zero and TO is neither nil nor numerically equal to
|
|
|
|
|
FROM, signal an error.
|
|
|
|
|
|
|
|
|
|
This function is primarily designed for integer arguments.
|
|
|
|
|
Nevertheless, FROM, TO and INC can be integer or float. However,
|
|
|
|
|
floating point arithmetic is inexact. For instance, depending on
|
|
|
|
|
the machine, it may quite well happen that
|
2013-06-11 16:51:12 +00:00
|
|
|
|
\(number-sequence 0.4 0.6 0.2) returns the one element list (0.4),
|
|
|
|
|
whereas (number-sequence 0.4 0.8 0.2) returns a list with three
|
2004-04-16 12:51:06 +00:00
|
|
|
|
elements. Thus, if some of the arguments are floats and one wants
|
|
|
|
|
to make sure that TO is included, one may have to explicitly write
|
2013-06-11 16:51:12 +00:00
|
|
|
|
TO as (+ FROM (* N INC)) or use a variable whose value was
|
2004-04-16 12:51:06 +00:00
|
|
|
|
computed with this exact expression. Alternatively, you can,
|
|
|
|
|
of course, also replace TO with a slightly larger value
|
|
|
|
|
\(or a slightly more negative value if INC is negative)."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(if (or (not to) (= from to))
|
2003-04-05 02:13:44 +00:00
|
|
|
|
(list from)
|
|
|
|
|
(or inc (setq inc 1))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(when (zerop inc) (error "The increment can not be zero"))
|
2019-07-22 20:09:42 +00:00
|
|
|
|
(let (seq (n 0) (next from))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(if (> inc 0)
|
2019-07-22 11:45:40 +00:00
|
|
|
|
(while (<= next to)
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(setq seq (cons next seq)
|
|
|
|
|
n (1+ n)
|
|
|
|
|
next (+ from (* n inc))))
|
2019-07-22 11:45:40 +00:00
|
|
|
|
(while (>= next to)
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(setq seq (cons next seq)
|
|
|
|
|
n (1+ n)
|
|
|
|
|
next (+ from (* n inc)))))
|
2003-04-05 02:13:44 +00:00
|
|
|
|
(nreverse seq))))
|
2003-04-03 02:43:11 +00:00
|
|
|
|
|
2023-05-19 10:32:28 +00:00
|
|
|
|
(defun copy-tree (tree &optional vectors-and-records)
|
2002-06-08 20:48:15 +00:00
|
|
|
|
"Make a copy of TREE.
|
|
|
|
|
If TREE is a cons cell, this recursively copies both its car and its cdr.
|
2023-05-19 10:32:28 +00:00
|
|
|
|
Contrast to `copy-sequence', which copies only along the cdrs.
|
|
|
|
|
With the second argument VECTORS-AND-RECORDS non-nil, this
|
|
|
|
|
traverses and copies vectors and records as well as conses."
|
2023-04-12 10:20:12 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2002-06-08 20:48:15 +00:00
|
|
|
|
(if (consp tree)
|
2002-06-10 09:01:08 +00:00
|
|
|
|
(let (result)
|
|
|
|
|
(while (consp tree)
|
|
|
|
|
(let ((newcar (car tree)))
|
2023-05-19 10:32:28 +00:00
|
|
|
|
(if (or (consp (car tree))
|
|
|
|
|
(and vectors-and-records
|
|
|
|
|
(or (vectorp (car tree)) (recordp (car tree)))))
|
|
|
|
|
(setq newcar (copy-tree (car tree) vectors-and-records)))
|
2002-06-10 09:01:08 +00:00
|
|
|
|
(push newcar result))
|
|
|
|
|
(setq tree (cdr tree)))
|
2016-11-05 15:31:22 +00:00
|
|
|
|
(nconc (nreverse result)
|
2023-05-19 10:32:28 +00:00
|
|
|
|
(if (and vectors-and-records (or (vectorp tree) (recordp tree)))
|
|
|
|
|
(copy-tree tree vectors-and-records)
|
|
|
|
|
tree)))
|
|
|
|
|
(if (and vectors-and-records (or (vectorp tree) (recordp tree)))
|
2002-06-08 20:48:15 +00:00
|
|
|
|
(let ((i (length (setq tree (copy-sequence tree)))))
|
|
|
|
|
(while (>= (setq i (1- i)) 0)
|
2023-05-19 10:32:28 +00:00
|
|
|
|
(aset tree i (copy-tree (aref tree i) vectors-and-records)))
|
2002-06-10 09:01:08 +00:00
|
|
|
|
tree)
|
|
|
|
|
tree)))
|
2023-03-07 08:00:25 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Various list-search functions.
|
2002-06-08 20:48:15 +00:00
|
|
|
|
|
1998-08-08 23:07:06 +00:00
|
|
|
|
(defun assoc-default (key alist &optional test default)
|
|
|
|
|
"Find object KEY in a pseudo-alist ALIST.
|
2009-04-29 04:46:15 +00:00
|
|
|
|
ALIST is a list of conses or objects. Each element
|
|
|
|
|
(or the element's car, if it is a cons) is compared with KEY by
|
|
|
|
|
calling TEST, with two arguments: (i) the element or its car,
|
|
|
|
|
and (ii) KEY.
|
|
|
|
|
If that is non-nil, the element matches; then `assoc-default'
|
|
|
|
|
returns the element's cdr, if it is a cons, or DEFAULT if the
|
|
|
|
|
element is not a cons.
|
1998-08-08 23:07:06 +00:00
|
|
|
|
|
|
|
|
|
If no element matches, the value is nil.
|
|
|
|
|
If TEST is omitted or nil, `equal' is used."
|
2023-05-01 13:55:32 +00:00
|
|
|
|
(declare (important-return-value t))
|
1998-08-08 23:07:06 +00:00
|
|
|
|
(let (found (tail alist) value)
|
|
|
|
|
(while (and tail (not found))
|
|
|
|
|
(let ((elt (car tail)))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(when (funcall (or test #'equal) (if (consp elt) (car elt) elt) key)
|
1998-08-08 23:07:06 +00:00
|
|
|
|
(setq found t value (if (consp elt) (cdr elt) default))))
|
|
|
|
|
(setq tail (cdr tail)))
|
|
|
|
|
value))
|
1999-08-16 21:04:49 +00:00
|
|
|
|
|
2000-04-03 19:29:56 +00:00
|
|
|
|
(defun member-ignore-case (elt list)
|
2010-12-11 02:34:55 +00:00
|
|
|
|
"Like `member', but ignore differences in case and text representation.
|
2000-04-03 19:29:56 +00:00
|
|
|
|
ELT must be a string. Upper-case and lower-case letters are treated as equal.
|
2002-04-27 19:49:18 +00:00
|
|
|
|
Unibyte strings are converted to multibyte for comparison.
|
|
|
|
|
Non-strings in LIST are ignored."
|
2019-04-17 16:35:12 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2002-04-27 19:49:18 +00:00
|
|
|
|
(while (and list
|
|
|
|
|
(not (and (stringp (car list))
|
2022-07-26 17:47:03 +00:00
|
|
|
|
(string-equal-ignore-case elt (car list)))))
|
2000-11-29 04:36:30 +00:00
|
|
|
|
(setq list (cdr list)))
|
|
|
|
|
list)
|
2000-04-03 19:29:56 +00:00
|
|
|
|
|
2018-01-28 04:05:54 +00:00
|
|
|
|
(defun assoc-delete-all (key alist &optional test)
|
|
|
|
|
"Delete from ALIST all elements whose car is KEY.
|
|
|
|
|
Compare keys with TEST. Defaults to `equal'.
|
2018-01-21 21:45:43 +00:00
|
|
|
|
Return the modified alist.
|
|
|
|
|
Elements of ALIST that are not conses are ignored."
|
2023-05-20 16:24:53 +00:00
|
|
|
|
(declare (important-return-value t))
|
2018-01-28 04:05:54 +00:00
|
|
|
|
(unless test (setq test #'equal))
|
2018-01-21 21:45:43 +00:00
|
|
|
|
(while (and (consp (car alist))
|
2018-01-28 04:05:54 +00:00
|
|
|
|
(funcall test (caar alist) key))
|
2018-01-21 21:45:43 +00:00
|
|
|
|
(setq alist (cdr alist)))
|
|
|
|
|
(let ((tail alist) tail-cdr)
|
|
|
|
|
(while (setq tail-cdr (cdr tail))
|
|
|
|
|
(if (and (consp (car tail-cdr))
|
2018-01-28 04:05:54 +00:00
|
|
|
|
(funcall test (caar tail-cdr) key))
|
2018-01-21 21:45:43 +00:00
|
|
|
|
(setcdr tail (cdr tail-cdr))
|
|
|
|
|
(setq tail tail-cdr))))
|
|
|
|
|
alist)
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun assq-delete-all (key alist)
|
|
|
|
|
"Delete from ALIST all elements whose car is `eq' to KEY.
|
|
|
|
|
Return the modified alist.
|
|
|
|
|
Elements of ALIST that are not conses are ignored."
|
2023-05-20 16:24:53 +00:00
|
|
|
|
(declare (important-return-value t))
|
2018-01-28 04:05:54 +00:00
|
|
|
|
(assoc-delete-all key alist #'eq))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
(defun rassq-delete-all (value alist)
|
|
|
|
|
"Delete from ALIST all elements whose cdr is `eq' to VALUE.
|
|
|
|
|
Return the modified alist.
|
|
|
|
|
Elements of ALIST that are not conses are ignored."
|
2023-05-20 16:24:53 +00:00
|
|
|
|
(declare (important-return-value t))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(while (and (consp (car alist))
|
|
|
|
|
(eq (cdr (car alist)) value))
|
|
|
|
|
(setq alist (cdr alist)))
|
|
|
|
|
(let ((tail alist) tail-cdr)
|
|
|
|
|
(while (setq tail-cdr (cdr tail))
|
|
|
|
|
(if (and (consp (car tail-cdr))
|
|
|
|
|
(eq (cdr (car tail-cdr)) value))
|
|
|
|
|
(setcdr tail (cdr tail-cdr))
|
|
|
|
|
(setq tail tail-cdr))))
|
|
|
|
|
alist)
|
|
|
|
|
|
2017-07-17 12:30:50 +00:00
|
|
|
|
(defun alist-get (key alist &optional default remove testfn)
|
2019-04-09 14:56:37 +00:00
|
|
|
|
"Find the first element of ALIST whose `car' equals KEY and return its `cdr'.
|
2016-06-07 23:59:37 +00:00
|
|
|
|
If KEY is not found in ALIST, return DEFAULT.
|
2019-04-09 14:56:37 +00:00
|
|
|
|
Equality with KEY is tested by TESTFN, defaulting to `eq'.
|
2016-06-07 23:59:37 +00:00
|
|
|
|
|
2020-10-07 02:50:52 +00:00
|
|
|
|
You can use `alist-get' in \"place expressions\"; i.e., as a
|
|
|
|
|
generalized variable. Doing this will modify an existing
|
|
|
|
|
association (more precisely, the first one if multiple exist), or
|
|
|
|
|
add a new element to the beginning of ALIST, destructively
|
|
|
|
|
modifying the list stored in ALIST.
|
2019-03-12 14:13:55 +00:00
|
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
2019-11-09 01:07:13 +00:00
|
|
|
|
(setq foo \\='((a . 0)))
|
|
|
|
|
(setf (alist-get \\='a foo) 1
|
|
|
|
|
(alist-get \\='b foo) 2)
|
2019-03-12 14:13:55 +00:00
|
|
|
|
|
|
|
|
|
foo => ((b . 2) (a . 1))
|
|
|
|
|
|
|
|
|
|
|
2016-06-07 23:59:37 +00:00
|
|
|
|
When using it to set a value, optional argument REMOVE non-nil
|
2019-03-12 14:13:55 +00:00
|
|
|
|
means to remove KEY from ALIST if the new value is `eql' to
|
|
|
|
|
DEFAULT (more precisely the first found association will be
|
|
|
|
|
deleted from the alist).
|
|
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
2019-11-09 01:07:13 +00:00
|
|
|
|
(setq foo \\='((a . 1) (b . 2)))
|
|
|
|
|
(setf (alist-get \\='b foo nil \\='remove) nil)
|
2019-03-12 14:13:55 +00:00
|
|
|
|
|
|
|
|
|
foo => ((a . 1))"
|
2023-05-20 16:24:53 +00:00
|
|
|
|
(declare (important-return-value t))
|
2014-10-01 17:23:42 +00:00
|
|
|
|
(ignore remove) ;;Silence byte-compiler.
|
2017-07-17 12:30:50 +00:00
|
|
|
|
(let ((x (if (not testfn)
|
|
|
|
|
(assq key alist)
|
|
|
|
|
(assoc key alist testfn))))
|
2014-10-01 17:23:42 +00:00
|
|
|
|
(if x (cdr x) default)))
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun remove (elt seq)
|
|
|
|
|
"Return a copy of SEQ with all occurrences of ELT removed.
|
2021-03-11 19:08:09 +00:00
|
|
|
|
SEQ must be a list, vector, or string. The comparison is done with `equal'.
|
|
|
|
|
Contrary to `delete', this does not use side-effects, and the argument
|
|
|
|
|
SEQ is not modified."
|
2019-04-17 16:35:12 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2023-09-12 16:55:54 +00:00
|
|
|
|
(delete elt (if (nlistp seq)
|
|
|
|
|
;; If SEQ isn't a list, there's no need to copy SEQ because
|
|
|
|
|
;; `delete' will return a new object.
|
|
|
|
|
seq
|
|
|
|
|
(copy-sequence seq))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
(defun remq (elt list)
|
2014-08-28 01:55:45 +00:00
|
|
|
|
"Return LIST with all occurrences of ELT removed.
|
2005-10-22 15:01:08 +00:00
|
|
|
|
The comparison is done with `eq'. Contrary to `delq', this does not use
|
|
|
|
|
side-effects, and the argument LIST is not modified."
|
2019-04-17 16:35:12 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2011-07-09 00:50:01 +00:00
|
|
|
|
(while (and (eq elt (car list)) (setq list (cdr list))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(if (memq elt list)
|
|
|
|
|
(delq elt (copy-sequence list))
|
|
|
|
|
list))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
|
|
|
|
;;;; Keymap support.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
2021-10-17 20:14:30 +00:00
|
|
|
|
(defun kbd (keys)
|
2012-06-07 16:20:28 +00:00
|
|
|
|
"Convert KEYS to the internal Emacs key representation.
|
2016-04-29 18:27:22 +00:00
|
|
|
|
KEYS should be a string in the format returned by commands such
|
2022-07-03 19:00:16 +00:00
|
|
|
|
as \\[describe-key] (`describe-key').
|
2021-10-17 20:27:13 +00:00
|
|
|
|
|
2016-04-29 18:27:22 +00:00
|
|
|
|
This is the same format used for saving keyboard macros (see
|
2018-03-25 21:35:51 +00:00
|
|
|
|
`edmacro-mode').
|
|
|
|
|
|
2021-10-17 20:27:13 +00:00
|
|
|
|
Here's some example key sequences:
|
|
|
|
|
|
|
|
|
|
\"f\"
|
|
|
|
|
\"C-c C-c\"
|
|
|
|
|
\"H-<left>\"
|
|
|
|
|
\"M-RET\"
|
|
|
|
|
\"C-M-<return>\"
|
|
|
|
|
|
2021-10-17 20:14:30 +00:00
|
|
|
|
For an approximate inverse of this, see `key-description'."
|
2020-11-01 14:57:12 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2021-11-16 07:15:43 +00:00
|
|
|
|
(let ((res (key-parse keys)))
|
2022-05-03 14:19:50 +00:00
|
|
|
|
;; For historical reasons, parse "C-x ( C-d C-x )" as "C-d", since
|
|
|
|
|
;; `kbd' used to be a wrapper around `read-kbd-macro'.
|
|
|
|
|
(when (and (>= (length res) 4)
|
|
|
|
|
(eq (aref res 0) ?\C-x)
|
|
|
|
|
(eq (aref res 1) ?\()
|
|
|
|
|
(eq (aref res (- (length res) 2)) ?\C-x)
|
|
|
|
|
(eq (aref res (- (length res) 1)) ?\)))
|
|
|
|
|
(setq res (apply #'vector (let ((lres (append res nil)))
|
|
|
|
|
;; Remove the first and last two elements.
|
|
|
|
|
(setq lres (cddr lres))
|
|
|
|
|
(setq lres (nreverse lres))
|
|
|
|
|
(setq lres (cddr lres))
|
|
|
|
|
(nreverse lres)))))
|
|
|
|
|
|
2021-11-16 07:15:43 +00:00
|
|
|
|
(if (not (memq nil (mapcar (lambda (ch)
|
|
|
|
|
(and (numberp ch)
|
|
|
|
|
(<= 0 ch 127)))
|
|
|
|
|
res)))
|
|
|
|
|
;; Return a string.
|
|
|
|
|
(concat (mapcar #'identity res))
|
|
|
|
|
;; Return a vector.
|
|
|
|
|
res)))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(defun undefined ()
|
2011-01-11 03:23:04 +00:00
|
|
|
|
"Beep to tell the user this binding is undefined."
|
2021-02-20 18:55:12 +00:00
|
|
|
|
(declare (completion ignore))
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(interactive)
|
2013-10-29 21:05:35 +00:00
|
|
|
|
(ding)
|
2017-09-30 13:46:48 +00:00
|
|
|
|
(if defining-kbd-macro
|
|
|
|
|
(error "%s is undefined" (key-description (this-single-command-keys)))
|
|
|
|
|
(message "%s is undefined" (key-description (this-single-command-keys))))
|
2013-10-29 21:05:35 +00:00
|
|
|
|
(force-mode-line-update)
|
|
|
|
|
;; If this is a down-mouse event, don't reset prefix-arg;
|
|
|
|
|
;; pass it to the command run by the up event.
|
|
|
|
|
(setq prefix-arg
|
|
|
|
|
(when (memq 'down (event-modifiers last-command-event))
|
|
|
|
|
current-prefix-arg)))
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; Prevent the \{...} documentation construct
|
|
|
|
|
;; from mentioning keys that run this command.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(put 'undefined 'suppress-keymap t)
|
|
|
|
|
|
|
|
|
|
(defun suppress-keymap (map &optional nodigits)
|
|
|
|
|
"Make MAP override all normally self-inserting keys to be undefined.
|
|
|
|
|
Normally, as an exception, digits and minus-sign are set to make prefix args,
|
|
|
|
|
but optional second arg NODIGITS non-nil treats them like other chars."
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map [remap self-insert-command] #'undefined)
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(or nodigits
|
|
|
|
|
(let (loop)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map "-" #'negative-argument)
|
1990-11-05 10:06:02 +00:00
|
|
|
|
;; Make plain numbers do numeric args.
|
|
|
|
|
(setq loop ?0)
|
|
|
|
|
(while (<= loop ?9)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map (char-to-string loop) #'digit-argument)
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(setq loop (1+ loop))))))
|
|
|
|
|
|
2011-08-03 21:40:06 +00:00
|
|
|
|
(defun make-composed-keymap (maps &optional parent)
|
|
|
|
|
"Construct a new keymap composed of MAPS and inheriting from PARENT.
|
|
|
|
|
When looking up a key in the returned map, the key is looked in each
|
|
|
|
|
keymap of MAPS in turn until a binding is found.
|
|
|
|
|
If no binding is found in MAPS, the lookup continues in PARENT, if non-nil.
|
|
|
|
|
As always with keymap inheritance, a nil binding in MAPS overrides
|
|
|
|
|
any corresponding binding in PARENT, but it does not override corresponding
|
|
|
|
|
bindings in other keymaps of MAPS.
|
|
|
|
|
MAPS can be a list of keymaps or a single keymap.
|
|
|
|
|
PARENT if non-nil should be a keymap."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2011-08-03 21:40:06 +00:00
|
|
|
|
`(keymap
|
|
|
|
|
,@(if (keymapp maps) (list maps) maps)
|
|
|
|
|
,@parent))
|
|
|
|
|
|
2000-02-23 11:40:06 +00:00
|
|
|
|
(defun define-key-after (keymap key definition &optional after)
|
1993-06-26 04:18:37 +00:00
|
|
|
|
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
|
2021-11-16 07:15:43 +00:00
|
|
|
|
This is a legacy function; see `keymap-set-after' for the
|
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
1993-06-26 04:18:37 +00:00
|
|
|
|
This is like `define-key' except that the binding for KEY is placed
|
|
|
|
|
just after the binding for the event AFTER, instead of at the beginning
|
1996-11-10 05:02:38 +00:00
|
|
|
|
of the map. Note that AFTER must be an event type (like KEY), NOT a command
|
|
|
|
|
\(like DEFINITION).
|
|
|
|
|
|
2000-02-23 11:40:06 +00:00
|
|
|
|
If AFTER is t or omitted, the new binding goes at the end of the keymap.
|
2001-10-05 09:26:17 +00:00
|
|
|
|
AFTER should be a single event type--a symbol or a character, not a sequence.
|
1996-11-10 05:02:38 +00:00
|
|
|
|
|
2000-02-23 11:40:06 +00:00
|
|
|
|
Bindings are always added before any inherited map.
|
1996-11-10 05:02:38 +00:00
|
|
|
|
|
2019-11-04 02:36:05 +00:00
|
|
|
|
The order of bindings in a keymap matters only when it is used as
|
2011-10-06 19:15:19 +00:00
|
|
|
|
a menu, so this function is not useful for non-menu keymaps."
|
2021-10-13 19:21:23 +00:00
|
|
|
|
(declare (indent defun))
|
2000-02-23 11:40:06 +00:00
|
|
|
|
(unless after (setq after t))
|
1993-06-26 04:18:37 +00:00
|
|
|
|
(or (keymapp keymap)
|
|
|
|
|
(signal 'wrong-type-argument (list 'keymapp keymap)))
|
2001-10-05 09:26:17 +00:00
|
|
|
|
(setq key
|
|
|
|
|
(if (<= (length key) 1) (aref key 0)
|
|
|
|
|
(setq keymap (lookup-key keymap
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(apply #'vector
|
|
|
|
|
(butlast (mapcar #'identity key)))))
|
2001-10-05 09:26:17 +00:00
|
|
|
|
(aref key (1- (length key)))))
|
|
|
|
|
(let ((tail keymap) done inserted)
|
1993-06-26 04:18:37 +00:00
|
|
|
|
(while (and (not done) tail)
|
|
|
|
|
;; Delete any earlier bindings for the same key.
|
2001-10-05 09:26:17 +00:00
|
|
|
|
(if (eq (car-safe (car (cdr tail))) key)
|
1993-06-26 04:18:37 +00:00
|
|
|
|
(setcdr tail (cdr (cdr tail))))
|
2001-10-05 09:26:17 +00:00
|
|
|
|
;; If we hit an included map, go down that one.
|
|
|
|
|
(if (keymapp (car tail)) (setq tail (car tail)))
|
1993-06-26 04:18:37 +00:00
|
|
|
|
;; When we reach AFTER's binding, insert the new binding after.
|
|
|
|
|
;; If we reach an inherited keymap, insert just before that.
|
1993-06-30 04:36:37 +00:00
|
|
|
|
;; If we reach the end of this keymap, insert at the end.
|
1996-11-10 05:02:38 +00:00
|
|
|
|
(if (or (and (eq (car-safe (car tail)) after)
|
|
|
|
|
(not (eq after t)))
|
1993-06-30 04:36:37 +00:00
|
|
|
|
(eq (car (cdr tail)) 'keymap)
|
|
|
|
|
(null (cdr tail)))
|
1993-06-26 04:18:37 +00:00
|
|
|
|
(progn
|
1993-06-30 04:36:37 +00:00
|
|
|
|
;; Stop the scan only if we find a parent keymap.
|
|
|
|
|
;; Keep going past the inserted element
|
|
|
|
|
;; so we can delete any duplications that come later.
|
|
|
|
|
(if (eq (car (cdr tail)) 'keymap)
|
|
|
|
|
(setq done t))
|
|
|
|
|
;; Don't insert more than once.
|
|
|
|
|
(or inserted
|
2001-10-05 09:26:17 +00:00
|
|
|
|
(setcdr tail (cons (cons key definition) (cdr tail))))
|
1993-06-30 04:36:37 +00:00
|
|
|
|
(setq inserted t)))
|
1993-06-26 04:18:37 +00:00
|
|
|
|
(setq tail (cdr tail)))))
|
|
|
|
|
|
2021-01-08 14:16:02 +00:00
|
|
|
|
(defun define-prefix-command (command &optional mapvar name)
|
|
|
|
|
"Define COMMAND as a prefix command. COMMAND should be a symbol.
|
|
|
|
|
A new sparse keymap is stored as COMMAND's function definition and its
|
|
|
|
|
value.
|
|
|
|
|
This prepares COMMAND for use as a prefix key's binding.
|
|
|
|
|
If a second optional argument MAPVAR is given, it should be a symbol.
|
|
|
|
|
The map is then stored as MAPVAR's value instead of as COMMAND's
|
|
|
|
|
value; but COMMAND is still defined as a function.
|
|
|
|
|
The third optional argument NAME, if given, supplies a menu name
|
|
|
|
|
string for the map. This is required to use the keymap as a menu.
|
|
|
|
|
This function returns COMMAND."
|
|
|
|
|
(let ((map (make-sparse-keymap name)))
|
|
|
|
|
(fset command map)
|
|
|
|
|
(set (or mapvar command) map)
|
|
|
|
|
command))
|
|
|
|
|
|
2008-03-25 19:42:34 +00:00
|
|
|
|
(defun map-keymap-sorted (function keymap)
|
2004-11-16 17:05:18 +00:00
|
|
|
|
"Implement `map-keymap' with sorting.
|
|
|
|
|
Don't call this function; it is for internal use only."
|
2008-03-25 19:42:34 +00:00
|
|
|
|
(let (list)
|
|
|
|
|
(map-keymap (lambda (a b) (push (cons a b) list))
|
|
|
|
|
keymap)
|
|
|
|
|
(setq list (sort list
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(setq a (car a) b (car b))
|
|
|
|
|
(if (integerp a)
|
|
|
|
|
(if (integerp b) (< a b)
|
|
|
|
|
t)
|
|
|
|
|
(if (integerp b) t
|
|
|
|
|
;; string< also accepts symbols.
|
|
|
|
|
(string< a b))))))
|
|
|
|
|
(dolist (p list)
|
|
|
|
|
(funcall function (car p) (cdr p)))))
|
2002-03-29 23:13:26 +00:00
|
|
|
|
|
2011-07-02 04:27:41 +00:00
|
|
|
|
(defun keymap--menu-item-binding (val)
|
|
|
|
|
"Return the binding part of a menu-item."
|
|
|
|
|
(cond
|
|
|
|
|
((not (consp val)) val) ;Not a menu-item.
|
|
|
|
|
((eq 'menu-item (car val))
|
|
|
|
|
(let* ((binding (nth 2 val))
|
|
|
|
|
(plist (nthcdr 3 val))
|
|
|
|
|
(filter (plist-get plist :filter)))
|
|
|
|
|
(if filter (funcall filter binding)
|
|
|
|
|
binding)))
|
|
|
|
|
((and (consp (cdr val)) (stringp (cadr val)))
|
|
|
|
|
(cddr val))
|
|
|
|
|
((stringp (car val))
|
|
|
|
|
(cdr val))
|
|
|
|
|
(t val))) ;Not a menu-item either.
|
|
|
|
|
|
|
|
|
|
(defun keymap--menu-item-with-binding (item binding)
|
|
|
|
|
"Build a menu-item like ITEM but with its binding changed to BINDING."
|
|
|
|
|
(cond
|
2011-10-31 10:53:16 +00:00
|
|
|
|
((not (consp item)) binding) ;Not a menu-item.
|
2011-07-02 04:27:41 +00:00
|
|
|
|
((eq 'menu-item (car item))
|
|
|
|
|
(setq item (copy-sequence item))
|
|
|
|
|
(let ((tail (nthcdr 2 item)))
|
|
|
|
|
(setcar tail binding)
|
|
|
|
|
;; Remove any potential filter.
|
|
|
|
|
(if (plist-get (cdr tail) :filter)
|
|
|
|
|
(setcdr tail (plist-put (cdr tail) :filter nil))))
|
|
|
|
|
item)
|
|
|
|
|
((and (consp (cdr item)) (stringp (cadr item)))
|
|
|
|
|
(cons (car item) (cons (cadr item) binding)))
|
|
|
|
|
(t (cons (car item) binding))))
|
|
|
|
|
|
|
|
|
|
(defun keymap--merge-bindings (val1 val2)
|
|
|
|
|
"Merge bindings VAL1 and VAL2."
|
|
|
|
|
(let ((map1 (keymap--menu-item-binding val1))
|
|
|
|
|
(map2 (keymap--menu-item-binding val2)))
|
|
|
|
|
(if (not (and (keymapp map1) (keymapp map2)))
|
|
|
|
|
;; There's nothing to merge: val1 takes precedence.
|
|
|
|
|
val1
|
|
|
|
|
(let ((map (list 'keymap map1 map2))
|
|
|
|
|
(item (if (keymapp val1) (if (keymapp val2) nil val2) val1)))
|
|
|
|
|
(keymap--menu-item-with-binding item map)))))
|
|
|
|
|
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(defun keymap-canonicalize (map)
|
2011-07-02 04:27:41 +00:00
|
|
|
|
"Return a simpler equivalent keymap.
|
|
|
|
|
This resolves inheritance and redefinitions. The returned keymap
|
|
|
|
|
should behave identically to a copy of KEYMAP w.r.t `lookup-key'
|
|
|
|
|
and use in active keymaps and menus.
|
|
|
|
|
Subkeymaps may be modified but are not canonicalized."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2011-07-02 04:27:41 +00:00
|
|
|
|
;; FIXME: Problem with the difference between a nil binding
|
|
|
|
|
;; that hides a binding in an inherited map and a nil binding that's ignored
|
|
|
|
|
;; to let some further binding visible. Currently a nil binding hides all.
|
|
|
|
|
;; FIXME: we may want to carefully (re)order elements in case they're
|
|
|
|
|
;; menu-entries.
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(let ((bindings ())
|
2008-12-26 16:49:30 +00:00
|
|
|
|
(ranges ())
|
|
|
|
|
(prompt (keymap-prompt map)))
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(while (keymapp map)
|
2011-07-02 04:27:41 +00:00
|
|
|
|
(setq map (map-keymap ;; -internal
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(lambda (key item)
|
|
|
|
|
(if (consp key)
|
2022-01-31 16:31:09 +00:00
|
|
|
|
(if (= (car key) (1- (cdr key)))
|
|
|
|
|
;; If we have a two-character range, then
|
|
|
|
|
;; treat it as two separate characters
|
|
|
|
|
;; (because this makes `describe-bindings'
|
|
|
|
|
;; look better and shouldn't affect
|
|
|
|
|
;; anything else).
|
|
|
|
|
(progn
|
|
|
|
|
(push (cons (car key) item) bindings)
|
|
|
|
|
(push (cons (cdr key) item) bindings))
|
|
|
|
|
;; Treat char-ranges specially.
|
|
|
|
|
(push (cons key item) ranges))
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(push (cons key item) bindings)))
|
|
|
|
|
map)))
|
2011-07-02 04:27:41 +00:00
|
|
|
|
;; Create the new map.
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(setq map (funcall (if ranges #'make-keymap #'make-sparse-keymap) prompt))
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(dolist (binding ranges)
|
2011-07-02 04:27:41 +00:00
|
|
|
|
;; Treat char-ranges specially. FIXME: need to merge as well.
|
2008-04-05 20:00:23 +00:00
|
|
|
|
(define-key map (vector (car binding)) (cdr binding)))
|
2011-07-02 04:27:41 +00:00
|
|
|
|
;; Process the bindings starting from the end.
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(dolist (binding (prog1 bindings (setq bindings ())))
|
|
|
|
|
(let* ((key (car binding))
|
|
|
|
|
(oldbind (assq key bindings)))
|
2011-07-02 04:27:41 +00:00
|
|
|
|
(push (if (not oldbind)
|
|
|
|
|
;; The normal case: no duplicate bindings.
|
|
|
|
|
binding
|
|
|
|
|
;; This is the second binding for this key.
|
|
|
|
|
(setq bindings (delq oldbind bindings))
|
|
|
|
|
(cons key (keymap--merge-bindings (cdr binding)
|
|
|
|
|
(cdr oldbind))))
|
|
|
|
|
bindings)))
|
2008-04-04 17:31:20 +00:00
|
|
|
|
(nconc map bindings)))
|
|
|
|
|
|
1996-08-21 20:36:30 +00:00
|
|
|
|
(put 'keyboard-translate-table 'char-table-extra-slots 0)
|
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
(defun keyboard-translate (from to)
|
2012-07-18 13:31:16 +00:00
|
|
|
|
"Translate character FROM to TO on the current terminal.
|
2022-10-27 16:57:33 +00:00
|
|
|
|
This is a legacy function; see `key-translate' for the
|
2021-11-16 07:15:43 +00:00
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
This function creates a `keyboard-translate-table' if necessary
|
|
|
|
|
and then modifies one entry in it."
|
1996-08-21 20:36:30 +00:00
|
|
|
|
(or (char-table-p keyboard-translate-table)
|
|
|
|
|
(setq keyboard-translate-table
|
|
|
|
|
(make-char-table 'keyboard-translate-table nil)))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
(aset keyboard-translate-table from to))
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Key binding commands.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun global-set-key (key command)
|
|
|
|
|
"Give KEY a global binding as COMMAND.
|
2021-11-16 07:15:43 +00:00
|
|
|
|
This is a legacy function; see `keymap-global-set' for the
|
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
COMMAND is the command definition to use; usually it is
|
|
|
|
|
a symbol naming an interactively-callable function.
|
|
|
|
|
KEY is a key sequence; noninteractively, it is a string or vector
|
|
|
|
|
of characters or event types, and non-ASCII characters with codes
|
|
|
|
|
above 127 (such as ISO Latin-1) can be included if you use a vector.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
Note that if KEY has a local binding in the current buffer,
|
|
|
|
|
that local binding will continue to shadow any global binding
|
|
|
|
|
that you make with this function."
|
2016-05-01 19:15:06 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(let* ((menu-prompting nil)
|
2019-10-19 18:21:25 +00:00
|
|
|
|
(key (read-key-sequence "Set key globally: " nil t)))
|
2016-05-01 19:15:06 +00:00
|
|
|
|
(list key
|
|
|
|
|
(read-command (format "Set key %s to command: "
|
|
|
|
|
(key-description key))))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(or (vectorp key) (stringp key)
|
|
|
|
|
(signal 'wrong-type-argument (list 'arrayp key)))
|
|
|
|
|
(define-key (current-global-map) key command))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun local-set-key (key command)
|
|
|
|
|
"Give KEY a local binding as COMMAND.
|
2021-11-16 07:15:43 +00:00
|
|
|
|
This is a legacy function; see `keymap-local-set' for the
|
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
COMMAND is the command definition to use; usually it is
|
|
|
|
|
a symbol naming an interactively-callable function.
|
|
|
|
|
KEY is a key sequence; noninteractively, it is a string or vector
|
|
|
|
|
of characters or event types, and non-ASCII characters with codes
|
|
|
|
|
above 127 (such as ISO Latin-1) can be included if you use a vector.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2013-06-11 16:51:12 +00:00
|
|
|
|
The binding goes in the current buffer's local map, which in most
|
|
|
|
|
cases is shared with all other buffers in the same major mode."
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(interactive "KSet key locally: \nCSet key %s locally to command: ")
|
|
|
|
|
(let ((map (current-local-map)))
|
|
|
|
|
(or map
|
|
|
|
|
(use-local-map (setq map (make-sparse-keymap))))
|
|
|
|
|
(or (vectorp key) (stringp key)
|
|
|
|
|
(signal 'wrong-type-argument (list 'arrayp key)))
|
|
|
|
|
(define-key map key command)))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun global-unset-key (key)
|
|
|
|
|
"Remove global binding of KEY.
|
2021-11-16 07:15:43 +00:00
|
|
|
|
This is a legacy function; see `keymap-global-unset' for the
|
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
KEY is a string or vector representing a sequence of keystrokes."
|
|
|
|
|
(interactive "kUnset key globally: ")
|
|
|
|
|
(global-set-key key nil))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun local-unset-key (key)
|
|
|
|
|
"Remove local binding of KEY.
|
2021-11-16 07:15:43 +00:00
|
|
|
|
This is a legacy function; see `keymap-local-unset' for the
|
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
KEY is a string or vector representing a sequence of keystrokes."
|
|
|
|
|
(interactive "kUnset key locally: ")
|
|
|
|
|
(if (current-local-map)
|
|
|
|
|
(local-set-key key nil))
|
|
|
|
|
nil)
|
2021-01-13 17:54:09 +00:00
|
|
|
|
|
|
|
|
|
(defun local-key-binding (keys &optional accept-default)
|
|
|
|
|
"Return the binding for command KEYS in current local keymap only.
|
2022-10-26 20:41:09 +00:00
|
|
|
|
This is a legacy function; see `keymap-local-lookup' for the
|
2021-11-16 07:15:43 +00:00
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2021-01-13 17:54:09 +00:00
|
|
|
|
KEYS is a string or vector, a sequence of keystrokes.
|
|
|
|
|
The binding is probably a symbol with a function definition.
|
|
|
|
|
|
|
|
|
|
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
|
|
|
|
|
bindings; see the description of `lookup-key' for more details
|
|
|
|
|
about this."
|
|
|
|
|
(let ((map (current-local-map)))
|
|
|
|
|
(when map (lookup-key map keys accept-default))))
|
|
|
|
|
|
|
|
|
|
(defun global-key-binding (keys &optional accept-default)
|
|
|
|
|
"Return the binding for command KEYS in current global keymap only.
|
2022-10-26 20:41:09 +00:00
|
|
|
|
This is a legacy function; see `keymap-global-lookup' for the
|
2021-11-16 07:15:43 +00:00
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2021-01-13 17:54:09 +00:00
|
|
|
|
KEYS is a string or vector, a sequence of keystrokes.
|
|
|
|
|
The binding is probably a symbol with a function definition.
|
|
|
|
|
This function's return values are the same as those of `lookup-key'
|
|
|
|
|
\(which see).
|
|
|
|
|
|
|
|
|
|
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
|
|
|
|
|
bindings; see the description of `lookup-key' for more details
|
|
|
|
|
about this."
|
|
|
|
|
(lookup-key (current-global-map) keys accept-default))
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; substitute-key-definition and its subroutines.
|
|
|
|
|
|
|
|
|
|
(defvar key-substitution-in-progress nil
|
2007-04-09 23:10:00 +00:00
|
|
|
|
"Used internally by `substitute-key-definition'.")
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
|
|
|
|
|
"Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
|
2021-11-16 07:15:43 +00:00
|
|
|
|
This is a legacy function; see `keymap-substitute' for the
|
|
|
|
|
recommended function to use instead.
|
|
|
|
|
|
2016-11-04 21:50:09 +00:00
|
|
|
|
In other words, OLDDEF is replaced with NEWDEF wherever it appears.
|
2005-10-22 15:01:08 +00:00
|
|
|
|
Alternatively, if optional fourth argument OLDMAP is specified, we redefine
|
2019-11-04 02:36:05 +00:00
|
|
|
|
in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP.
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
2006-02-12 20:32:18 +00:00
|
|
|
|
If you don't specify OLDMAP, you can usually get the same results
|
|
|
|
|
in a cleaner way with command remapping, like this:
|
2013-06-11 16:51:12 +00:00
|
|
|
|
(define-key KEYMAP [remap OLDDEF] NEWDEF)
|
2006-02-13 11:05:37 +00:00
|
|
|
|
\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; Don't document PREFIX in the doc string because we don't want to
|
|
|
|
|
;; advertise it. It's meant for recursive calls only. Here's its
|
|
|
|
|
;; meaning
|
|
|
|
|
|
|
|
|
|
;; If optional argument PREFIX is specified, it should be a key
|
|
|
|
|
;; prefix, a string. Redefined bindings will then be bound to the
|
|
|
|
|
;; original key, with PREFIX added at the front.
|
|
|
|
|
(or prefix (setq prefix ""))
|
|
|
|
|
(let* ((scan (or oldmap keymap))
|
|
|
|
|
(prefix1 (vconcat prefix [nil]))
|
|
|
|
|
(key-substitution-in-progress
|
|
|
|
|
(cons scan key-substitution-in-progress)))
|
|
|
|
|
;; Scan OLDMAP, finding each char or event-symbol that
|
|
|
|
|
;; has any definition, and act on it with hack-key.
|
|
|
|
|
(map-keymap
|
|
|
|
|
(lambda (char defn)
|
|
|
|
|
(aset prefix1 (length prefix) char)
|
|
|
|
|
(substitute-key-definition-key defn olddef newdef prefix1 keymap))
|
|
|
|
|
scan)))
|
|
|
|
|
|
|
|
|
|
(defun substitute-key-definition-key (defn olddef newdef prefix keymap)
|
|
|
|
|
(let (inner-def skipped menu-item)
|
|
|
|
|
;; Find the actual command name within the binding.
|
|
|
|
|
(if (eq (car-safe defn) 'menu-item)
|
|
|
|
|
(setq menu-item defn defn (nth 2 defn))
|
|
|
|
|
;; Skip past menu-prompt.
|
|
|
|
|
(while (stringp (car-safe defn))
|
|
|
|
|
(push (pop defn) skipped))
|
|
|
|
|
;; Skip past cached key-equivalence data for menu items.
|
|
|
|
|
(if (consp (car-safe defn))
|
|
|
|
|
(setq defn (cdr defn))))
|
|
|
|
|
(if (or (eq defn olddef)
|
|
|
|
|
;; Compare with equal if definition is a key sequence.
|
|
|
|
|
;; That is useful for operating on function-key-map.
|
|
|
|
|
(and (or (stringp defn) (vectorp defn))
|
|
|
|
|
(equal defn olddef)))
|
|
|
|
|
(define-key keymap prefix
|
|
|
|
|
(if menu-item
|
|
|
|
|
(let ((copy (copy-sequence menu-item)))
|
|
|
|
|
(setcar (nthcdr 2 copy) newdef)
|
|
|
|
|
copy)
|
|
|
|
|
(nconc (nreverse skipped) newdef)))
|
|
|
|
|
;; Look past a symbol that names a keymap.
|
|
|
|
|
(setq inner-def
|
2015-04-16 02:25:16 +00:00
|
|
|
|
(or (indirect-function defn) defn))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; For nested keymaps, we use `inner-def' rather than `defn' so as to
|
|
|
|
|
;; avoid autoloading a keymap. This is mostly done to preserve the
|
|
|
|
|
;; original non-autoloading behavior of pre-map-keymap times.
|
|
|
|
|
(if (and (keymapp inner-def)
|
|
|
|
|
;; Avoid recursively scanning
|
|
|
|
|
;; where KEYMAP does not have a submap.
|
|
|
|
|
(let ((elt (lookup-key keymap prefix)))
|
|
|
|
|
(or (null elt) (natnump elt) (keymapp elt)))
|
|
|
|
|
;; Avoid recursively rescanning keymap being scanned.
|
|
|
|
|
(not (memq inner-def key-substitution-in-progress)))
|
|
|
|
|
;; If this one isn't being scanned already, scan it now.
|
|
|
|
|
(substitute-key-definition olddef newdef keymap inner-def prefix)))))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
|
|
|
|
|
2002-10-17 15:42:10 +00:00
|
|
|
|
;;;; The global keymap tree.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2021-01-05 04:20:44 +00:00
|
|
|
|
(defvar esc-map
|
|
|
|
|
(let ((map (make-keymap)))
|
|
|
|
|
(define-key map "u" #'upcase-word)
|
|
|
|
|
(define-key map "l" #'downcase-word)
|
|
|
|
|
(define-key map "c" #'capitalize-word)
|
|
|
|
|
(define-key map "x" #'execute-extended-command)
|
2021-02-20 14:12:45 +00:00
|
|
|
|
(define-key map "X" #'execute-extended-command-for-buffer)
|
2021-01-05 04:20:44 +00:00
|
|
|
|
map)
|
1993-04-10 06:21:55 +00:00
|
|
|
|
"Default keymap for ESC (meta) commands.
|
|
|
|
|
The normal global definition of the character ESC indirects to this keymap.")
|
2021-01-05 04:20:44 +00:00
|
|
|
|
(fset 'ESC-prefix esc-map)
|
|
|
|
|
(make-obsolete 'ESC-prefix 'esc-map "28.1")
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
|
|
|
|
(defvar ctl-x-4-map (make-sparse-keymap)
|
2001-12-11 07:34:39 +00:00
|
|
|
|
"Keymap for subcommands of C-x 4.")
|
1993-04-23 06:50:48 +00:00
|
|
|
|
(defalias 'ctl-x-4-prefix ctl-x-4-map)
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
|
|
|
|
(defvar ctl-x-5-map (make-sparse-keymap)
|
|
|
|
|
"Keymap for frame commands.")
|
1993-04-23 06:50:48 +00:00
|
|
|
|
(defalias 'ctl-x-5-prefix ctl-x-5-map)
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2019-10-19 22:06:38 +00:00
|
|
|
|
(defvar tab-prefix-map (make-sparse-keymap)
|
|
|
|
|
"Keymap for tab-bar related commands.")
|
2021-01-05 04:11:07 +00:00
|
|
|
|
|
|
|
|
|
(defvar ctl-x-map
|
|
|
|
|
(let ((map (make-keymap)))
|
|
|
|
|
(define-key map "4" 'ctl-x-4-prefix)
|
|
|
|
|
(define-key map "5" 'ctl-x-5-prefix)
|
|
|
|
|
(define-key map "t" tab-prefix-map)
|
|
|
|
|
|
|
|
|
|
(define-key map "b" #'switch-to-buffer)
|
2021-01-05 10:27:41 +00:00
|
|
|
|
(define-key map "k" #'kill-buffer)
|
2021-01-05 04:11:07 +00:00
|
|
|
|
(define-key map "\C-u" #'upcase-region) (put 'upcase-region 'disabled t)
|
|
|
|
|
(define-key map "\C-l" #'downcase-region) (put 'downcase-region 'disabled t)
|
|
|
|
|
(define-key map "<" #'scroll-left)
|
|
|
|
|
(define-key map ">" #'scroll-right)
|
|
|
|
|
map)
|
|
|
|
|
"Default keymap for C-x commands.
|
|
|
|
|
The normal global definition of the character C-x indirects to this keymap.")
|
|
|
|
|
(fset 'Control-X-prefix ctl-x-map)
|
2021-01-05 04:20:44 +00:00
|
|
|
|
(make-obsolete 'Control-X-prefix 'ctl-x-map "28.1")
|
2019-10-05 21:54:46 +00:00
|
|
|
|
|
2021-01-05 03:57:21 +00:00
|
|
|
|
(defvar global-map
|
|
|
|
|
(let ((map (make-keymap)))
|
|
|
|
|
(define-key map "\C-[" 'ESC-prefix)
|
|
|
|
|
(define-key map "\C-x" 'Control-X-prefix)
|
|
|
|
|
|
|
|
|
|
(define-key map "\C-i" #'self-insert-command)
|
|
|
|
|
(let* ((vec1 (make-vector 1 nil))
|
|
|
|
|
(f (lambda (from to)
|
|
|
|
|
(while (< from to)
|
|
|
|
|
(aset vec1 0 from)
|
|
|
|
|
(define-key map vec1 #'self-insert-command)
|
|
|
|
|
(setq from (1+ from))))))
|
|
|
|
|
(funcall f #o040 #o0177)
|
|
|
|
|
(when (eq system-type 'ms-dos) ;FIXME: Why?
|
|
|
|
|
(funcall f #o0200 #o0240))
|
|
|
|
|
(funcall f #o0240 #o0400))
|
|
|
|
|
|
|
|
|
|
(define-key map "\C-a" #'beginning-of-line)
|
|
|
|
|
(define-key map "\C-b" #'backward-char)
|
|
|
|
|
(define-key map "\C-e" #'end-of-line)
|
|
|
|
|
(define-key map "\C-f" #'forward-char)
|
2021-01-05 04:20:44 +00:00
|
|
|
|
|
2021-01-05 04:11:07 +00:00
|
|
|
|
(define-key map "\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
|
|
|
|
|
(define-key map "\C-x\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
|
2021-01-05 04:20:44 +00:00
|
|
|
|
|
|
|
|
|
(define-key map "\C-v" #'scroll-up-command)
|
|
|
|
|
(define-key map "\M-v" #'scroll-down-command)
|
|
|
|
|
(define-key map "\M-\C-v" #'scroll-other-window)
|
|
|
|
|
|
|
|
|
|
(define-key map "\M-\C-c" #'exit-recursive-edit)
|
|
|
|
|
(define-key map "\C-]" #'abort-recursive-edit)
|
2021-01-05 03:57:21 +00:00
|
|
|
|
map)
|
|
|
|
|
"Default global keymap mapping Emacs keyboard input into commands.
|
|
|
|
|
The value is a keymap that is usually (but not necessarily) Emacs's
|
2021-01-09 11:03:12 +00:00
|
|
|
|
global map.
|
|
|
|
|
|
|
|
|
|
See also `current-global-map'.")
|
2021-01-05 03:57:21 +00:00
|
|
|
|
(use-global-map global-map)
|
|
|
|
|
|
1993-03-08 08:10:13 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
;;;; Event manipulation functions.
|
|
|
|
|
|
2009-08-19 03:03:05 +00:00
|
|
|
|
(defconst listify-key-sequence-1 (logior 128 ?\M-\C-@))
|
1993-05-27 00:06:08 +00:00
|
|
|
|
|
1993-03-06 05:54:29 +00:00
|
|
|
|
(defun listify-key-sequence (key)
|
|
|
|
|
"Convert a key sequence to a list of events."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
1993-03-06 05:54:29 +00:00
|
|
|
|
(if (vectorp key)
|
|
|
|
|
(append key nil)
|
2020-11-12 21:06:47 +00:00
|
|
|
|
(mapcar (lambda (c)
|
|
|
|
|
(if (> c 127)
|
|
|
|
|
(logxor c listify-key-sequence-1)
|
|
|
|
|
c))
|
2003-05-17 22:00:40 +00:00
|
|
|
|
key)))
|
1993-03-06 05:54:29 +00:00
|
|
|
|
|
2019-04-21 22:02:01 +00:00
|
|
|
|
(defun eventp (object)
|
|
|
|
|
"Return non-nil if OBJECT is an input event or event object."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (t) boolean))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(pure t) (side-effect-free error-free))
|
2019-04-21 22:02:01 +00:00
|
|
|
|
(or (integerp object)
|
|
|
|
|
(and (if (consp object)
|
|
|
|
|
(setq object (car object))
|
|
|
|
|
object)
|
|
|
|
|
(symbolp object)
|
|
|
|
|
(not (keywordp object)))))
|
1993-03-07 07:35:57 +00:00
|
|
|
|
|
|
|
|
|
(defun event-modifiers (event)
|
2004-07-25 05:45:53 +00:00
|
|
|
|
"Return a list of symbols representing the modifier keys in event EVENT.
|
1993-03-07 07:35:57 +00:00
|
|
|
|
The elements of the list may include `meta', `control',
|
1993-08-02 07:23:07 +00:00
|
|
|
|
`shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
|
2004-07-31 15:45:30 +00:00
|
|
|
|
and `down'.
|
|
|
|
|
EVENT may be an event or an event type. If EVENT is a symbol
|
|
|
|
|
that has never been used in an event that has been read as input
|
2011-08-30 14:50:02 +00:00
|
|
|
|
in the current Emacs session, then this function may fail to include
|
|
|
|
|
the `click' modifier."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2023-04-08 12:36:44 +00:00
|
|
|
|
(unless (stringp event)
|
|
|
|
|
(let ((type event))
|
|
|
|
|
(if (listp type)
|
|
|
|
|
(setq type (car type)))
|
|
|
|
|
(if (symbolp type)
|
|
|
|
|
;; Don't read event-symbol-elements directly since we're not
|
|
|
|
|
;; sure the symbol has already been parsed.
|
|
|
|
|
(cdr (internal-event-symbol-parse-modifiers type))
|
|
|
|
|
(let ((list nil)
|
|
|
|
|
(char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0
|
|
|
|
|
?\H-\0 ?\s-\0 ?\A-\0)))))
|
|
|
|
|
(if (not (zerop (logand type ?\M-\0)))
|
|
|
|
|
(push 'meta list))
|
|
|
|
|
(if (or (not (zerop (logand type ?\C-\0)))
|
|
|
|
|
(< char 32))
|
|
|
|
|
(push 'control list))
|
|
|
|
|
(if (or (not (zerop (logand type ?\S-\0)))
|
|
|
|
|
(/= char (downcase char)))
|
|
|
|
|
(push 'shift list))
|
|
|
|
|
(or (zerop (logand type ?\H-\0))
|
|
|
|
|
(push 'hyper list))
|
|
|
|
|
(or (zerop (logand type ?\s-\0))
|
|
|
|
|
(push 'super list))
|
|
|
|
|
(or (zerop (logand type ?\A-\0))
|
|
|
|
|
(push 'alt list))
|
|
|
|
|
list)))))
|
1993-03-07 07:35:57 +00:00
|
|
|
|
|
1993-03-08 00:07:53 +00:00
|
|
|
|
(defun event-basic-type (event)
|
2004-07-25 05:45:53 +00:00
|
|
|
|
"Return the basic type of the given event (all modifiers removed).
|
2004-07-31 15:45:30 +00:00
|
|
|
|
The value is a printing character (not upper case) or a symbol.
|
|
|
|
|
EVENT may be an event or an event type. If EVENT is a symbol
|
|
|
|
|
that has never been used in an event that has been read as input
|
|
|
|
|
in the current Emacs session, then this function may return nil."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2023-04-08 12:36:44 +00:00
|
|
|
|
(unless (stringp event)
|
|
|
|
|
(if (consp event)
|
|
|
|
|
(setq event (car event)))
|
|
|
|
|
(if (symbolp event)
|
|
|
|
|
(car (get event 'event-symbol-elements))
|
|
|
|
|
(let* ((base (logand event (1- ?\A-\0)))
|
|
|
|
|
(uncontrolled (if (< base 32) (logior base 64) base)))
|
|
|
|
|
;; There are some numbers that are invalid characters and
|
|
|
|
|
;; cause `downcase' to get an error.
|
|
|
|
|
(condition-case ()
|
|
|
|
|
(downcase uncontrolled)
|
|
|
|
|
(error uncontrolled))))))
|
1993-03-08 00:07:53 +00:00
|
|
|
|
|
1993-03-08 08:10:13 +00:00
|
|
|
|
(defsubst mouse-movement-p (object)
|
|
|
|
|
"Return non-nil if OBJECT is a mouse movement event."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (t) boolean))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(side-effect-free error-free))
|
2004-10-13 17:05:55 +00:00
|
|
|
|
(eq (car-safe object) 'mouse-movement))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
|
2008-05-02 14:37:39 +00:00
|
|
|
|
(defun mouse-event-p (object)
|
|
|
|
|
"Return non-nil if OBJECT is a mouse click event."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2008-05-02 14:37:39 +00:00
|
|
|
|
;; is this really correct? maybe remove mouse-movement?
|
|
|
|
|
(memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
|
|
|
|
|
|
2022-09-24 14:38:09 +00:00
|
|
|
|
(defun event--posn-at-point ()
|
|
|
|
|
;; Use `window-point' for the case when the current buffer
|
|
|
|
|
;; is temporarily switched to some other buffer (bug#50256)
|
|
|
|
|
(let* ((pos (window-point))
|
2022-12-23 14:41:08 +00:00
|
|
|
|
(posn (posn-at-point pos (if (minibufferp (current-buffer))
|
|
|
|
|
(minibuffer-window)))))
|
|
|
|
|
(cond ((null posn) ;; `pos' is "out of sight".
|
|
|
|
|
(setq posn (list (selected-window) pos '(0 . 0) 0)))
|
|
|
|
|
;; If `pos' is inside a chunk of text hidden by an `invisible'
|
|
|
|
|
;; or `display' property, `posn-at-point' returns the position
|
|
|
|
|
;; that *is* visible, whereas `event--posn-at-point' is used
|
|
|
|
|
;; when we have a keyboard event, whose position is `point' even
|
|
|
|
|
;; if that position is invisible.
|
|
|
|
|
((> (length posn) 5)
|
|
|
|
|
(setf (nth 5 posn) pos)))
|
|
|
|
|
posn))
|
2022-09-24 14:38:09 +00:00
|
|
|
|
|
2012-08-10 14:47:12 +00:00
|
|
|
|
(defun event-start (event)
|
1993-03-08 08:10:13 +00:00
|
|
|
|
"Return the starting position of EVENT.
|
2023-08-17 00:45:57 +00:00
|
|
|
|
EVENT should be a mouse click, drag, touch screen, or key press
|
|
|
|
|
event. If EVENT is nil, the value of `posn-at-point' is used
|
|
|
|
|
instead.
|
2014-02-09 02:13:23 +00:00
|
|
|
|
|
|
|
|
|
The following accessor functions are used to access the elements
|
|
|
|
|
of the position:
|
|
|
|
|
|
2020-10-11 02:03:47 +00:00
|
|
|
|
`posn-window': The window of the event end, or its frame if the
|
|
|
|
|
event end point belongs to no window.
|
2014-02-09 02:13:23 +00:00
|
|
|
|
`posn-area': A symbol identifying the area the event occurred in,
|
|
|
|
|
or nil if the event occurred in the text area.
|
|
|
|
|
`posn-point': The buffer position of the event.
|
2014-02-12 19:40:35 +00:00
|
|
|
|
`posn-x-y': The pixel-based coordinates of the event.
|
2014-02-09 02:13:23 +00:00
|
|
|
|
`posn-col-row': The estimated column and row corresponding to the
|
|
|
|
|
position of the event.
|
|
|
|
|
`posn-actual-col-row': The actual column and row corresponding to the
|
|
|
|
|
position of the event.
|
|
|
|
|
`posn-string': The string object of the event, which is either
|
|
|
|
|
nil or (STRING . POSITION)'.
|
|
|
|
|
`posn-image': The image object of the event, if any.
|
|
|
|
|
`posn-object': The image or string object of the event, if any.
|
|
|
|
|
`posn-timestamp': The time the event occurred, in milliseconds.
|
|
|
|
|
|
|
|
|
|
For more information, see Info node `(elisp)Click Events'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2023-08-17 07:27:14 +00:00
|
|
|
|
(if (and (consp event)
|
|
|
|
|
(or (eq (car event) 'touchscreen-begin)
|
|
|
|
|
(eq (car event) 'touchscreen-end)))
|
2023-08-17 00:45:57 +00:00
|
|
|
|
;; Touch screen begin and end events save their information in a
|
|
|
|
|
;; different format, where the mouse position list is the cdr of
|
|
|
|
|
;; (nth 1 event).
|
|
|
|
|
(cdadr event)
|
|
|
|
|
(or (and (consp event)
|
|
|
|
|
;; Ignore touchscreen update events. They store the posn
|
|
|
|
|
;; in a different format, and can have multiple posns.
|
|
|
|
|
(not (eq (car event) 'touchscreen-update))
|
|
|
|
|
(nth 1 event))
|
|
|
|
|
(event--posn-at-point))))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
|
2012-08-10 14:47:12 +00:00
|
|
|
|
(defun event-end (event)
|
2014-02-09 02:13:23 +00:00
|
|
|
|
"Return the ending position of EVENT.
|
2023-08-17 00:45:57 +00:00
|
|
|
|
EVENT should be a click, drag, touch screen, or key press event.
|
2014-02-09 02:13:23 +00:00
|
|
|
|
|
|
|
|
|
See `event-start' for a description of the value returned."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2023-08-17 07:27:14 +00:00
|
|
|
|
(if (and (consp event)
|
|
|
|
|
(or (eq (car event) 'touchscreen-begin)
|
|
|
|
|
(eq (car event) 'touchscreen-end)))
|
2023-08-17 00:45:57 +00:00
|
|
|
|
(cdadr event)
|
|
|
|
|
(or (and (consp event)
|
|
|
|
|
(not (eq (car event) 'touchscreen-update))
|
|
|
|
|
(nth (if (consp (nth 2 event)) 2 1) event))
|
|
|
|
|
(event--posn-at-point))))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
|
1993-08-02 07:23:07 +00:00
|
|
|
|
(defsubst event-click-count (event)
|
|
|
|
|
"Return the multi-click count of EVENT, a click or drag event.
|
|
|
|
|
The return value is a positive integer."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2002-06-23 22:13:15 +00:00
|
|
|
|
(if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
|
2017-09-08 18:26:47 +00:00
|
|
|
|
|
|
|
|
|
(defsubst event-line-count (event)
|
|
|
|
|
"Return the line count of EVENT, a mousewheel event.
|
|
|
|
|
The return value is a positive integer."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2017-09-08 18:26:47 +00:00
|
|
|
|
(if (and (consp event) (integerp (nth 3 event))) (nth 3 event) 1))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Extracting fields of the positions in an event.
|
1993-08-02 07:23:07 +00:00
|
|
|
|
|
2012-08-10 14:47:12 +00:00
|
|
|
|
(defun posnp (obj)
|
2015-01-21 08:01:30 +00:00
|
|
|
|
"Return non-nil if OBJ appears to be a valid `posn' object specifying a window.
|
2016-05-02 22:08:31 +00:00
|
|
|
|
A `posn' object is returned from functions such as `event-start'.
|
2015-01-21 08:01:30 +00:00
|
|
|
|
If OBJ is a valid `posn' object, but specifies a frame rather
|
|
|
|
|
than a window, return nil."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2015-01-21 08:01:30 +00:00
|
|
|
|
;; FIXME: Correct the behavior of this function so that all valid
|
|
|
|
|
;; `posn' objects are recognized, after updating other code that
|
|
|
|
|
;; depends on its present behavior.
|
2012-08-10 14:47:12 +00:00
|
|
|
|
(and (windowp (car-safe obj))
|
|
|
|
|
(atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
|
|
|
|
|
(integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
|
|
|
|
|
(integerp (car-safe (cdr obj))))) ;TIMESTAMP.
|
|
|
|
|
|
1993-03-08 08:10:13 +00:00
|
|
|
|
(defsubst posn-window (position)
|
|
|
|
|
"Return the window in POSITION.
|
2020-10-11 02:03:47 +00:00
|
|
|
|
If POSITION is outside the frame where the event was initiated,
|
|
|
|
|
return that frame instead. POSITION should be a list of the form
|
|
|
|
|
returned by the `event-start' and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
(nth 0 position))
|
|
|
|
|
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(defsubst posn-area (position)
|
|
|
|
|
"Return the window area recorded in POSITION, or nil for the text area.
|
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
|
|
|
|
and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(let ((area (if (consp (nth 1 position))
|
|
|
|
|
(car (nth 1 position))
|
|
|
|
|
(nth 1 position))))
|
|
|
|
|
(and (symbolp area) area)))
|
|
|
|
|
|
2013-03-20 18:13:00 +00:00
|
|
|
|
(defun posn-point (position)
|
1993-03-08 08:10:13 +00:00
|
|
|
|
"Return the buffer location in POSITION.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
2013-03-20 18:13:00 +00:00
|
|
|
|
and `event-end' functions.
|
|
|
|
|
Returns nil if POSITION does not correspond to any buffer location (e.g.
|
|
|
|
|
a click on a scroll bar)."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(or (nth 5 position)
|
2013-03-20 18:13:00 +00:00
|
|
|
|
(let ((pt (nth 1 position)))
|
|
|
|
|
(or (car-safe pt)
|
|
|
|
|
;; Apparently this can also be `vertical-scroll-bar' (bug#13979).
|
|
|
|
|
(if (integerp pt) pt)))))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
|
|
|
|
(defun posn-set-point (position)
|
|
|
|
|
"Move point to POSITION.
|
|
|
|
|
Select the corresponding window as well."
|
2020-10-11 02:03:47 +00:00
|
|
|
|
(if (framep (posn-window position))
|
|
|
|
|
(progn
|
|
|
|
|
(unless (windowp (frame-selected-window (posn-window position)))
|
|
|
|
|
(error "Position not in text area of window"))
|
|
|
|
|
(select-window (frame-selected-window (posn-window position))))
|
|
|
|
|
(unless (windowp (posn-window position))
|
2007-04-09 23:10:00 +00:00
|
|
|
|
(error "Position not in text area of window"))
|
2020-10-11 02:03:47 +00:00
|
|
|
|
(select-window (posn-window position)))
|
2007-04-09 23:10:00 +00:00
|
|
|
|
(if (numberp (posn-point position))
|
|
|
|
|
(goto-char (posn-point position))))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
|
1994-02-23 05:08:28 +00:00
|
|
|
|
(defsubst posn-x-y (position)
|
|
|
|
|
"Return the x and y coordinates in POSITION.
|
2010-12-05 00:43:18 +00:00
|
|
|
|
The return value has the form (X . Y), where X and Y are given in
|
|
|
|
|
pixels. POSITION should be a list of the form returned by
|
|
|
|
|
`event-start' and `event-end'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
(nth 2 position))
|
|
|
|
|
|
2008-06-12 03:56:20 +00:00
|
|
|
|
(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
|
|
|
|
|
|
2022-06-07 16:34:20 +00:00
|
|
|
|
(defun posn-col-row (position &optional use-window)
|
2004-04-16 12:51:06 +00:00
|
|
|
|
"Return the nominal column and row in POSITION, measured in characters.
|
|
|
|
|
The column and row values are approximations calculated from the x
|
|
|
|
|
and y coordinates in POSITION and the frame's default character width
|
2014-06-14 16:37:15 +00:00
|
|
|
|
and default line height, including spacing.
|
2022-06-07 16:34:20 +00:00
|
|
|
|
|
|
|
|
|
If USE-WINDOW is non-nil, use the typical width of a character in
|
|
|
|
|
the window indicated by POSITION instead of the frame. (This
|
|
|
|
|
makes a difference is a window has a zoom level.)
|
|
|
|
|
|
1994-05-22 20:55:15 +00:00
|
|
|
|
For a scroll-bar event, the result column is 0, and the row
|
2004-04-16 12:51:06 +00:00
|
|
|
|
corresponds to the vertical position of the click in the scroll bar.
|
2022-06-07 16:34:20 +00:00
|
|
|
|
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
|
|
|
|
and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2015-01-21 08:01:30 +00:00
|
|
|
|
(let* ((pair (posn-x-y position))
|
|
|
|
|
(frame-or-window (posn-window position))
|
|
|
|
|
(frame (if (framep frame-or-window)
|
|
|
|
|
frame-or-window
|
|
|
|
|
(window-frame frame-or-window)))
|
|
|
|
|
(window (when (windowp frame-or-window) frame-or-window))
|
|
|
|
|
(area (posn-area position)))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(cond
|
2015-01-21 08:01:30 +00:00
|
|
|
|
((null frame-or-window)
|
2004-04-16 12:51:06 +00:00
|
|
|
|
'(0 . 0))
|
|
|
|
|
((eq area 'vertical-scroll-bar)
|
|
|
|
|
(cons 0 (scroll-bar-scale pair (1- (window-height window)))))
|
|
|
|
|
((eq area 'horizontal-scroll-bar)
|
|
|
|
|
(cons (scroll-bar-scale pair (window-width window)) 0))
|
|
|
|
|
(t
|
2022-12-03 20:09:16 +00:00
|
|
|
|
(if use-window
|
2022-06-07 16:34:20 +00:00
|
|
|
|
(cons (/ (car pair) (window-font-width window))
|
|
|
|
|
(/ (cdr pair) (window-font-height window)))
|
|
|
|
|
;; FIXME: This should take line-spacing properties on
|
|
|
|
|
;; newlines into account.
|
|
|
|
|
(let* ((spacing (when (display-graphic-p frame)
|
|
|
|
|
(or (with-current-buffer
|
|
|
|
|
(window-buffer (frame-selected-window frame))
|
|
|
|
|
line-spacing)
|
|
|
|
|
(frame-parameter frame 'line-spacing)))))
|
|
|
|
|
(cond ((floatp spacing)
|
|
|
|
|
(setq spacing (truncate (* spacing
|
|
|
|
|
(frame-char-height frame)))))
|
|
|
|
|
((null spacing)
|
|
|
|
|
(setq spacing 0)))
|
|
|
|
|
(cons (/ (car pair) (frame-char-width frame))
|
|
|
|
|
(/ (cdr pair) (+ (frame-char-height frame) spacing)))))))))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
|
|
|
|
(defun posn-actual-col-row (position)
|
2014-09-04 15:21:40 +00:00
|
|
|
|
"Return the window row number in POSITION and character number in that row.
|
|
|
|
|
|
2004-04-16 12:51:06 +00:00
|
|
|
|
Return nil if POSITION does not contain the actual position; in that case
|
2015-06-30 22:06:31 +00:00
|
|
|
|
`posn-col-row' can be used to get approximate values.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
2014-09-04 15:21:40 +00:00
|
|
|
|
and `event-end' functions.
|
|
|
|
|
|
|
|
|
|
This function does not account for the width on display, like the
|
|
|
|
|
number of visual columns taken by a TAB or image. If you need
|
|
|
|
|
the coordinates of POSITION in character units, you should use
|
2015-06-30 22:06:31 +00:00
|
|
|
|
`posn-col-row', not this function."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(nth 6 position))
|
1994-02-23 05:08:28 +00:00
|
|
|
|
|
1993-03-08 08:10:13 +00:00
|
|
|
|
(defsubst posn-timestamp (position)
|
|
|
|
|
"Return the timestamp of POSITION.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
|
|
|
|
and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
1993-03-08 08:10:13 +00:00
|
|
|
|
(nth 3 position))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2013-03-20 18:13:00 +00:00
|
|
|
|
(defun posn-string (position)
|
2006-04-26 08:56:32 +00:00
|
|
|
|
"Return the string object of POSITION.
|
|
|
|
|
Value is a cons (STRING . STRING-POS), or nil if not a string.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
|
|
|
|
and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2013-03-20 18:13:00 +00:00
|
|
|
|
(let ((x (nth 4 position)))
|
|
|
|
|
;; Apparently this can also be `handle' or `below-handle' (bug#13979).
|
|
|
|
|
(when (consp x) x)))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
|
|
|
|
(defsubst posn-image (position)
|
2006-04-26 08:56:32 +00:00
|
|
|
|
"Return the image object of POSITION.
|
2006-11-19 23:42:37 +00:00
|
|
|
|
Value is a list (image ...), or nil if not an image.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
|
|
|
|
and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(nth 7 position))
|
|
|
|
|
|
|
|
|
|
(defsubst posn-object (position)
|
|
|
|
|
"Return the object (image or string) of POSITION.
|
2006-04-26 08:56:32 +00:00
|
|
|
|
Value is a list (image ...) for an image object, a cons cell
|
|
|
|
|
\(STRING . STRING-POS) for a string object, and nil for a buffer position.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
POSITION should be a list of the form returned by the `event-start'
|
|
|
|
|
and `event-end' functions."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(or (posn-image position) (posn-string position)))
|
|
|
|
|
|
|
|
|
|
(defsubst posn-object-x-y (position)
|
2022-11-26 11:56:30 +00:00
|
|
|
|
"Return the x and y coordinates relative to the glyph of object of POSITION.
|
2010-12-05 00:43:18 +00:00
|
|
|
|
The return value has the form (DX . DY), where DX and DY are
|
2022-11-26 11:56:30 +00:00
|
|
|
|
given in pixels, and they are relative to the top-left corner of
|
|
|
|
|
the clicked glyph of object at POSITION. POSITION should be a
|
|
|
|
|
list of the form returned by `event-start' and `event-end'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(nth 8 position))
|
|
|
|
|
|
|
|
|
|
(defsubst posn-object-width-height (position)
|
|
|
|
|
"Return the pixel width and height of the object of POSITION.
|
2010-12-05 00:43:18 +00:00
|
|
|
|
The return value has the form (WIDTH . HEIGHT). POSITION should
|
|
|
|
|
be a list of the form returned by `event-start' and `event-end'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(nth 9 position))
|
|
|
|
|
|
2021-02-09 08:04:47 +00:00
|
|
|
|
(defun values--store-value (value)
|
|
|
|
|
"Store VALUE in the obsolete `values' variable."
|
|
|
|
|
(with-suppressed-warnings ((obsolete values))
|
|
|
|
|
(push value values))
|
|
|
|
|
value)
|
|
|
|
|
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
;;;; Obsolescent names for functions.
|
|
|
|
|
|
2017-12-12 08:00:33 +00:00
|
|
|
|
(make-obsolete 'invocation-directory "use the variable of the same name."
|
|
|
|
|
"27.1")
|
|
|
|
|
(make-obsolete 'invocation-name "use the variable of the same name." "27.1")
|
|
|
|
|
|
2018-06-02 10:04:15 +00:00
|
|
|
|
;; We used to declare string-to-unibyte obsolete, but it is a valid
|
|
|
|
|
;; way of getting a unibyte string that can be indexed by bytes, when
|
|
|
|
|
;; the original string has raw bytes in their internal multibyte
|
|
|
|
|
;; representation. This can be useful when one needs to examine
|
|
|
|
|
;; individual bytes at known offsets from the string beginning.
|
|
|
|
|
;; (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1")
|
2019-06-14 12:37:29 +00:00
|
|
|
|
;; string-to-multibyte is also sometimes useful (and there's no good
|
2019-12-11 04:04:36 +00:00
|
|
|
|
;; general replacement for it), so it's also been revived in Emacs 27.1.
|
2019-06-14 12:37:29 +00:00
|
|
|
|
;; (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1")
|
2016-06-26 01:55:39 +00:00
|
|
|
|
;; bug#23850
|
2016-11-18 06:50:40 +00:00
|
|
|
|
(make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1")
|
2017-01-30 18:02:18 +00:00
|
|
|
|
(make-obsolete 'string-make-unibyte "use `encode-coding-string'." "26.1")
|
2016-11-18 06:50:40 +00:00
|
|
|
|
(make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1")
|
2017-01-30 18:02:18 +00:00
|
|
|
|
(make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1")
|
2016-06-26 01:55:39 +00:00
|
|
|
|
|
2013-06-20 14:15:42 +00:00
|
|
|
|
(defun log10 (x)
|
|
|
|
|
"Return (log X 10), the log base 10 of X."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function (number) float))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(side-effect-free t) (obsolete log "24.4"))
|
2013-06-20 14:15:42 +00:00
|
|
|
|
(log x 10))
|
|
|
|
|
|
2009-10-26 03:39:15 +00:00
|
|
|
|
(set-advertised-calling-convention
|
2010-09-14 11:11:44 +00:00
|
|
|
|
'all-completions '(string collection &optional predicate) "23.1")
|
|
|
|
|
(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
|
2015-02-08 13:51:10 +00:00
|
|
|
|
(set-advertised-calling-convention 'indirect-function '(object) "25.1")
|
2012-08-15 16:29:11 +00:00
|
|
|
|
(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
|
2023-05-05 07:08:59 +00:00
|
|
|
|
(set-advertised-calling-convention 'libxml-parse-xml-region '(&optional start end base-url) "27.1")
|
|
|
|
|
(set-advertised-calling-convention 'libxml-parse-html-region '(&optional start end base-url) "27.1")
|
2023-10-20 22:59:51 +00:00
|
|
|
|
(set-advertised-calling-convention 'sleep-for '(seconds) "30.1")
|
2022-08-05 22:46:31 +00:00
|
|
|
|
(set-advertised-calling-convention 'time-convert '(time form) "29.1")
|
2009-10-01 17:47:38 +00:00
|
|
|
|
|
|
|
|
|
;;;; Obsolescence declarations for variables, and aliases.
|
2022-10-07 18:15:40 +00:00
|
|
|
|
(make-obsolete-variable
|
|
|
|
|
'inhibit-point-motion-hooks
|
|
|
|
|
"use `cursor-intangible-mode' or `cursor-sensor-mode' instead"
|
|
|
|
|
;; It's been announced as obsolete in NEWS and in the docstring since Emacs-25,
|
|
|
|
|
;; but it's only been marked for compilation warnings since Emacs-29.
|
|
|
|
|
"25.1")
|
2014-12-18 15:25:54 +00:00
|
|
|
|
(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
|
2021-01-31 07:22:12 +00:00
|
|
|
|
(make-obsolete-variable 'operating-system-release nil "28.1")
|
2021-10-07 19:10:34 +00:00
|
|
|
|
(make-obsolete-variable 'inhibit-changing-match-data 'save-match-data "29.1")
|
2008-03-25 17:32:20 +00:00
|
|
|
|
|
2019-10-26 12:17:09 +00:00
|
|
|
|
(make-obsolete 'run-window-configuration-change-hook nil "27.1")
|
2008-03-25 17:32:20 +00:00
|
|
|
|
|
2016-10-04 14:34:51 +00:00
|
|
|
|
(make-obsolete-variable 'command-debug-status
|
|
|
|
|
"expect it to be removed in a future version." "25.2")
|
|
|
|
|
|
2009-02-14 09:08:08 +00:00
|
|
|
|
;; This was introduced in 21.4 for pre-unicode unification. That
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; usage was rendered obsolete in 23.1, which uses Unicode internally.
|
2009-02-14 09:08:08 +00:00
|
|
|
|
;; Other uses are possible, so this variable is not _really_ obsolete,
|
|
|
|
|
;; but Stefan insists to mark it so.
|
|
|
|
|
(make-obsolete-variable 'translation-table-for-input nil "23.1")
|
|
|
|
|
|
2017-08-27 10:38:46 +00:00
|
|
|
|
(make-obsolete-variable 'x-gtk-use-window-move nil "26.1")
|
|
|
|
|
|
2004-12-27 16:23:34 +00:00
|
|
|
|
(defvaralias 'messages-buffer-max-lines 'message-log-max)
|
2020-10-05 17:59:00 +00:00
|
|
|
|
(define-obsolete-variable-alias 'inhibit-nul-byte-detection
|
|
|
|
|
'inhibit-null-byte-detection "28.1")
|
2020-03-01 00:19:23 +00:00
|
|
|
|
(make-obsolete-variable 'load-dangerous-libraries
|
|
|
|
|
"no longer used." "27.1")
|
|
|
|
|
|
2022-05-20 02:23:32 +00:00
|
|
|
|
(define-obsolete-function-alias 'compare-window-configurations
|
|
|
|
|
#'window-configuration-equal-p "29.1")
|
|
|
|
|
|
2021-02-09 08:04:47 +00:00
|
|
|
|
;; We can't actually make `values' obsolete, because that will result
|
|
|
|
|
;; in warnings when using `values' in let-bindings.
|
|
|
|
|
;;(make-obsolete-variable 'values "no longer used" "28.1")
|
|
|
|
|
|
2022-09-19 08:55:09 +00:00
|
|
|
|
(defvar max-specpdl-size 2500
|
|
|
|
|
"Former limit on specbindings, now without effect.
|
|
|
|
|
This variable used to limit the size of the specpdl stack which,
|
|
|
|
|
among other things, holds dynamic variable bindings and `unwind-protect'
|
|
|
|
|
activations. To prevent runaway recursion, use `max-lisp-eval-depth'
|
|
|
|
|
instead; it will indirectly limit the specpdl stack size as well.")
|
|
|
|
|
(make-obsolete-variable 'max-specpdl-size nil "29.1")
|
|
|
|
|
|
2023-02-13 15:33:40 +00:00
|
|
|
|
(make-obsolete-variable 'comp-enable-subr-trampolines
|
|
|
|
|
'native-comp-enable-subr-trampolines
|
|
|
|
|
"29.1")
|
|
|
|
|
|
2023-08-14 13:30:23 +00:00
|
|
|
|
(defvaralias 'comp-enable-subr-trampolines 'native-comp-enable-subr-trampolines)
|
|
|
|
|
|
2022-10-03 13:26:04 +00:00
|
|
|
|
(make-obsolete-variable 'native-comp-deferred-compilation
|
2023-02-13 15:37:43 +00:00
|
|
|
|
'native-comp-jit-compilation
|
|
|
|
|
"29.1")
|
2022-10-03 13:26:04 +00:00
|
|
|
|
|
2023-08-14 13:48:53 +00:00
|
|
|
|
(defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation)
|
|
|
|
|
|
2024-01-30 16:55:19 +00:00
|
|
|
|
(define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1")
|
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
|
|
|
|
;;;; Alternate names for functions - these are not being phased out.
|
|
|
|
|
|
2024-04-28 16:38:44 +00:00
|
|
|
|
(defalias 'drop #'nthcdr)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(defalias 'send-string #'process-send-string)
|
|
|
|
|
(defalias 'send-region #'process-send-region)
|
|
|
|
|
(defalias 'string= #'string-equal)
|
|
|
|
|
(defalias 'string< #'string-lessp)
|
|
|
|
|
(defalias 'string> #'string-greaterp)
|
|
|
|
|
(defalias 'move-marker #'set-marker)
|
|
|
|
|
(defalias 'rplaca #'setcar)
|
|
|
|
|
(defalias 'rplacd #'setcdr)
|
|
|
|
|
(defalias 'beep #'ding) ;preserve lingual purity
|
|
|
|
|
(defalias 'indent-to-column #'indent-to)
|
|
|
|
|
(defalias 'backward-delete-char #'delete-backward-char)
|
1993-04-23 06:50:48 +00:00
|
|
|
|
(defalias 'search-forward-regexp (symbol-function 're-search-forward))
|
|
|
|
|
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(defalias 'int-to-string #'number-to-string)
|
|
|
|
|
(defalias 'store-match-data #'set-match-data)
|
|
|
|
|
(defalias 'chmod #'set-file-modes)
|
|
|
|
|
(defalias 'mkdir #'make-directory)
|
2023-09-03 09:22:06 +00:00
|
|
|
|
(defalias 'wholenump #'natnump)
|
1993-02-22 14:16:25 +00:00
|
|
|
|
|
2022-08-23 02:54:57 +00:00
|
|
|
|
;; These were the XEmacs names, now obsolete:
|
2022-08-29 17:26:39 +00:00
|
|
|
|
(defalias 'point-at-eol #'line-end-position)
|
|
|
|
|
(make-obsolete 'point-at-eol "use `line-end-position' or `pos-eol' instead." "29.1")
|
|
|
|
|
(defalias 'point-at-bol #'line-beginning-position)
|
|
|
|
|
(make-obsolete 'point-at-bol "use `line-beginning-position' or `pos-bol' instead." "29.1")
|
2022-08-23 02:54:57 +00:00
|
|
|
|
(define-obsolete-function-alias 'user-original-login-name #'user-login-name "28.1")
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
2022-08-15 05:29:22 +00:00
|
|
|
|
;; These are in obsolete/autoload.el, but are commonly used by
|
|
|
|
|
;; third-party scripts that assume that they exist without requiring
|
|
|
|
|
;; autoload. These should be removed when obsolete/autoload.el is
|
|
|
|
|
;; removed.
|
|
|
|
|
(autoload 'make-directory-autoloads "autoload" nil t)
|
|
|
|
|
(autoload 'update-directory-autoloads "autoload" nil t)
|
|
|
|
|
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
;;;; Hook manipulation functions.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
2019-05-29 19:56:14 +00:00
|
|
|
|
(defun add-hook (hook function &optional depth local)
|
|
|
|
|
;; Note: the -100..100 depth range is arbitrary and was chosen to match the
|
|
|
|
|
;; range used in add-function.
|
1993-08-02 07:23:07 +00:00
|
|
|
|
"Add to the value of HOOK the function FUNCTION.
|
|
|
|
|
FUNCTION is not added if already present.
|
2019-05-29 19:56:14 +00:00
|
|
|
|
|
|
|
|
|
The place where the function is added depends on the DEPTH
|
|
|
|
|
parameter. DEPTH defaults to 0. By convention, it should be
|
|
|
|
|
a number between -100 and 100 where 100 means that the function
|
|
|
|
|
should be at the very end of the list, whereas -100 means that
|
|
|
|
|
the function should always come first.
|
|
|
|
|
Since nothing is \"always\" true, don't use 100 nor -100.
|
|
|
|
|
When two functions have the same depth, the new one gets added after the
|
|
|
|
|
old one if depth is strictly positive and before otherwise.
|
|
|
|
|
|
|
|
|
|
For backward compatibility reasons, a symbol other than nil is
|
|
|
|
|
interpreted as a DEPTH of 90.
|
1993-08-02 07:23:07 +00:00
|
|
|
|
|
1994-09-30 20:47:13 +00:00
|
|
|
|
The optional fourth argument, LOCAL, if non-nil, says to modify
|
2011-07-13 21:38:56 +00:00
|
|
|
|
the hook's buffer-local value rather than its global value.
|
2019-02-07 08:57:15 +00:00
|
|
|
|
This makes the hook buffer-local, and it makes t a member of the
|
2011-07-13 21:38:56 +00:00
|
|
|
|
buffer-local value. That acts as a flag to run the hook
|
|
|
|
|
functions of the global value as well as in the local value.
|
1994-09-30 20:47:13 +00:00
|
|
|
|
|
2021-05-03 08:45:30 +00:00
|
|
|
|
HOOK should be a symbol. If HOOK is void, it is first set to
|
|
|
|
|
nil. If HOOK's value is a single function, it is changed to a
|
|
|
|
|
list of functions.
|
|
|
|
|
|
|
|
|
|
FUNCTION may be any valid function, but it's recommended to use a
|
|
|
|
|
function symbol and not a lambda form. Using a symbol will
|
|
|
|
|
ensure that the function is not re-added if the function is
|
|
|
|
|
edited, and using lambda forms may also have a negative
|
|
|
|
|
performance impact when running `add-hook' and `remove-hook'."
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(or (boundp hook) (set hook nil))
|
1994-09-30 20:47:13 +00:00
|
|
|
|
(or (default-boundp hook) (set-default hook nil))
|
2019-05-29 19:56:14 +00:00
|
|
|
|
(unless (numberp depth) (setq depth (if depth 90 0)))
|
2001-10-05 09:26:17 +00:00
|
|
|
|
(if local (unless (local-variable-if-set-p hook)
|
|
|
|
|
(set (make-local-variable hook) (list t)))
|
2000-05-10 22:40:17 +00:00
|
|
|
|
;; Detect the case where make-local-variable was used on a hook
|
|
|
|
|
;; and do what we used to do.
|
2022-02-23 03:52:40 +00:00
|
|
|
|
(when (and (local-variable-if-set-p hook)
|
|
|
|
|
(not (and (consp (symbol-value hook))
|
|
|
|
|
(memq t (symbol-value hook)))))
|
2000-05-10 22:40:17 +00:00
|
|
|
|
(setq local t)))
|
|
|
|
|
(let ((hook-value (if local (symbol-value hook) (default-value hook))))
|
|
|
|
|
;; If the hook value is a single function, turn it into a list.
|
2013-09-18 01:27:00 +00:00
|
|
|
|
(when (or (not (listp hook-value)) (functionp hook-value))
|
2000-05-16 14:47:46 +00:00
|
|
|
|
(setq hook-value (list hook-value)))
|
2000-05-10 22:40:17 +00:00
|
|
|
|
;; Do the actual addition if necessary
|
|
|
|
|
(unless (member function hook-value)
|
2022-02-22 15:18:43 +00:00
|
|
|
|
(let ((depth-sym (get hook 'hook--depth-alist)))
|
|
|
|
|
;; While the `member' test above has to use `equal' for historical
|
|
|
|
|
;; reasons, `equal' is a performance problem on large/cyclic functions,
|
|
|
|
|
;; so we index `hook--depth-alist' with `eql'. (bug#46326)
|
|
|
|
|
(unless (zerop depth)
|
|
|
|
|
(unless depth-sym
|
|
|
|
|
(setq depth-sym (make-symbol "depth-alist"))
|
|
|
|
|
(set depth-sym nil)
|
|
|
|
|
(setf (get hook 'hook--depth-alist) depth-sym))
|
|
|
|
|
(if local (make-local-variable depth-sym))
|
|
|
|
|
(setf (alist-get function
|
|
|
|
|
(if local (symbol-value depth-sym)
|
|
|
|
|
(default-value depth-sym))
|
|
|
|
|
0)
|
|
|
|
|
depth))
|
|
|
|
|
(setq hook-value
|
|
|
|
|
(if (< 0 depth)
|
|
|
|
|
(append hook-value (list function))
|
|
|
|
|
(cons function hook-value)))
|
|
|
|
|
(when depth-sym
|
|
|
|
|
(let ((depth-alist (if local (symbol-value depth-sym)
|
|
|
|
|
(default-value depth-sym))))
|
|
|
|
|
(when depth-alist
|
|
|
|
|
(setq hook-value
|
|
|
|
|
(sort (if (< 0 depth) hook-value (copy-sequence hook-value))
|
|
|
|
|
(lambda (f1 f2)
|
|
|
|
|
(< (alist-get f1 depth-alist 0 nil #'eq)
|
|
|
|
|
(alist-get f2 depth-alist 0 nil #'eq))))))))))
|
2000-05-10 22:40:17 +00:00
|
|
|
|
;; Set the actual variable
|
2008-01-25 22:51:18 +00:00
|
|
|
|
(if local
|
|
|
|
|
(progn
|
|
|
|
|
;; If HOOK isn't a permanent local,
|
|
|
|
|
;; but FUNCTION wants to survive a change of modes,
|
|
|
|
|
;; mark HOOK as partially permanent.
|
|
|
|
|
(and (symbolp function)
|
|
|
|
|
(get function 'permanent-local-hook)
|
|
|
|
|
(not (get hook 'permanent-local))
|
|
|
|
|
(put hook 'permanent-local 'permanent-local-hook))
|
|
|
|
|
(set hook hook-value))
|
|
|
|
|
(set-default hook hook-value))))
|
1994-09-30 20:47:13 +00:00
|
|
|
|
|
|
|
|
|
(defun remove-hook (hook function &optional local)
|
1993-11-10 20:30:32 +00:00
|
|
|
|
"Remove from the value of HOOK the function FUNCTION.
|
|
|
|
|
HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
|
|
FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
|
1994-09-30 20:47:13 +00:00
|
|
|
|
list of hooks to run in HOOK, then nothing is done. See `add-hook'.
|
|
|
|
|
|
|
|
|
|
The optional third argument, LOCAL, if non-nil, says to modify
|
2020-12-25 05:44:40 +00:00
|
|
|
|
the hook's buffer-local value rather than its default value.
|
|
|
|
|
|
|
|
|
|
Interactively, prompt for the various arguments (skipping local
|
|
|
|
|
unless HOOK has both local and global functions). If multiple
|
|
|
|
|
functions have the same representation under `princ', the first
|
|
|
|
|
one will be removed."
|
|
|
|
|
(interactive
|
2021-01-05 18:59:51 +00:00
|
|
|
|
(let* ((default (and (symbolp (variable-at-point))
|
|
|
|
|
(symbol-name (variable-at-point))))
|
|
|
|
|
(hook (intern (completing-read
|
|
|
|
|
(format-prompt "Hook variable" default)
|
|
|
|
|
obarray #'boundp t nil nil default)))
|
2020-12-25 05:44:40 +00:00
|
|
|
|
(local
|
|
|
|
|
(and
|
|
|
|
|
(local-variable-p hook)
|
|
|
|
|
(symbol-value hook)
|
|
|
|
|
;; No need to prompt if there's nothing global
|
|
|
|
|
(or (not (default-value hook))
|
|
|
|
|
(y-or-n-p (format "%s has a buffer-local binding, use that? "
|
|
|
|
|
hook)))))
|
|
|
|
|
(fn-alist (mapcar
|
|
|
|
|
(lambda (x) (cons (with-output-to-string (prin1 x)) x))
|
|
|
|
|
(if local (symbol-value hook) (default-value hook))))
|
|
|
|
|
(function (alist-get (completing-read
|
|
|
|
|
(format "%s hook to remove: "
|
|
|
|
|
(if local "Buffer-local" "Global"))
|
|
|
|
|
fn-alist
|
2022-01-12 19:08:16 +00:00
|
|
|
|
nil t nil 'set-variable-value-history)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
fn-alist nil nil #'string=)))
|
2020-12-25 05:44:40 +00:00
|
|
|
|
(list hook function local)))
|
2000-05-10 22:40:17 +00:00
|
|
|
|
(or (boundp hook) (set hook nil))
|
|
|
|
|
(or (default-boundp hook) (set-default hook nil))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
;; Do nothing if LOCAL is t but this hook has no local binding.
|
|
|
|
|
(unless (and local (not (local-variable-p hook)))
|
2000-05-10 22:40:17 +00:00
|
|
|
|
;; Detect the case where make-local-variable was used on a hook
|
|
|
|
|
;; and do what we used to do.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(when (and (local-variable-p hook)
|
|
|
|
|
(not (and (consp (symbol-value hook))
|
|
|
|
|
(memq t (symbol-value hook)))))
|
|
|
|
|
(setq local t))
|
2021-04-23 20:50:12 +00:00
|
|
|
|
(let ((hook-value (if local (symbol-value hook) (default-value hook)))
|
|
|
|
|
(old-fun nil))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
;; Remove the function, for both the list and the non-list cases.
|
|
|
|
|
(if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
|
2021-04-23 20:50:12 +00:00
|
|
|
|
(when (equal hook-value function)
|
|
|
|
|
(setq old-fun hook-value)
|
|
|
|
|
(setq hook-value nil))
|
|
|
|
|
(when (setq old-fun (car (member function hook-value)))
|
|
|
|
|
(setq hook-value (remq old-fun hook-value))))
|
|
|
|
|
(when old-fun
|
2021-04-23 21:17:40 +00:00
|
|
|
|
;; Remove auxiliary depth info to avoid leaks (bug#46414)
|
|
|
|
|
;; and to avoid the list growing too long.
|
2022-02-22 15:18:43 +00:00
|
|
|
|
(let* ((depth-sym (get hook 'hook--depth-alist))
|
|
|
|
|
(depth-alist (if depth-sym (if local (symbol-value depth-sym)
|
|
|
|
|
(default-value depth-sym))))
|
|
|
|
|
(di (assq old-fun depth-alist)))
|
|
|
|
|
(when di
|
|
|
|
|
(setf (if local (symbol-value depth-sym)
|
|
|
|
|
(default-value depth-sym))
|
2022-02-23 03:52:40 +00:00
|
|
|
|
(remq di depth-alist)))))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
;; If the function is on the global hook, we need to shadow it locally
|
|
|
|
|
;;(when (and local (member function (default-value hook))
|
|
|
|
|
;; (not (member (cons 'not function) hook-value)))
|
|
|
|
|
;; (push (cons 'not function) hook-value))
|
|
|
|
|
;; Set the actual variable
|
|
|
|
|
(if (not local)
|
|
|
|
|
(set-default hook hook-value)
|
|
|
|
|
(if (equal hook-value '(t))
|
|
|
|
|
(kill-local-variable hook)
|
|
|
|
|
(set hook hook-value))))))
|
1994-10-13 06:34:09 +00:00
|
|
|
|
|
2011-03-11 20:04:22 +00:00
|
|
|
|
(defmacro letrec (binders &rest body)
|
|
|
|
|
"Bind variables according to BINDERS then eval BODY.
|
|
|
|
|
The value of the last form in BODY is returned.
|
2019-11-04 02:36:05 +00:00
|
|
|
|
Each element of BINDERS is a list (SYMBOL VALUEFORM) that binds
|
2011-03-11 20:04:22 +00:00
|
|
|
|
SYMBOL to the value of VALUEFORM.
|
2019-10-09 04:06:24 +00:00
|
|
|
|
|
|
|
|
|
The main difference between this macro and `let'/`let*' is that
|
|
|
|
|
all symbols are bound before any of the VALUEFORMs are evalled."
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; Useful only in lexical-binding mode.
|
2011-03-11 20:04:22 +00:00
|
|
|
|
;; As a special-form, we could implement it more efficiently (and cleanly,
|
|
|
|
|
;; making the vars actually unbound during evaluation of the binders).
|
|
|
|
|
(declare (debug let) (indent 1))
|
2021-01-08 23:44:13 +00:00
|
|
|
|
;; Use plain `let*' for the non-recursive definitions.
|
|
|
|
|
;; This only handles the case where the first few definitions are not
|
|
|
|
|
;; recursive. Nothing as fancy as an SCC analysis.
|
|
|
|
|
(let ((seqbinds nil))
|
|
|
|
|
;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
|
|
|
|
|
;; may fail to see references that will be introduced later by
|
|
|
|
|
;; macroexpansion. We could call `macroexpand-all' to avoid that,
|
|
|
|
|
;; but in order to avoid that, we instead check to see if the binders
|
|
|
|
|
;; appear in the macroexp environment, since that's how references can be
|
|
|
|
|
;; introduced later on.
|
|
|
|
|
(unless (macroexp--fgrep binders macroexpand-all-environment)
|
|
|
|
|
(while (and binders
|
|
|
|
|
(null (macroexp--fgrep binders (nth 1 (car binders)))))
|
|
|
|
|
(push (pop binders) seqbinds)))
|
|
|
|
|
(let ((nbody (if (null binders)
|
|
|
|
|
(macroexp-progn body)
|
|
|
|
|
`(let ,(mapcar #'car binders)
|
2024-05-04 12:09:23 +00:00
|
|
|
|
,@(mapcan (lambda (binder)
|
|
|
|
|
(and (cdr binder) (list `(setq ,@binder))))
|
|
|
|
|
binders)
|
2021-01-08 23:44:13 +00:00
|
|
|
|
,@body))))
|
2021-01-09 00:59:16 +00:00
|
|
|
|
(cond
|
|
|
|
|
;; All bindings are recursive.
|
|
|
|
|
((null seqbinds) nbody)
|
|
|
|
|
;; Special case for trivial uses.
|
|
|
|
|
((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
|
|
|
|
|
(nth 1 (car seqbinds)))
|
|
|
|
|
;; General case.
|
|
|
|
|
(t `(let* ,(nreverse seqbinds) ,nbody))))))
|
2011-03-11 20:04:22 +00:00
|
|
|
|
|
2020-03-10 16:00:51 +00:00
|
|
|
|
(defmacro dlet (binders &rest body)
|
2021-08-01 15:05:48 +00:00
|
|
|
|
"Like `let' but using dynamic scoping."
|
2020-03-10 16:00:51 +00:00
|
|
|
|
(declare (indent 1) (debug let))
|
|
|
|
|
;; (defvar FOO) only affects the current scope, but in order for
|
2021-08-01 15:05:48 +00:00
|
|
|
|
;; this not to affect code after the main `let' we need to create a new scope,
|
2020-03-10 16:00:51 +00:00
|
|
|
|
;; which is what the surrounding `let' is for.
|
|
|
|
|
;; FIXME: (let () ...) currently doesn't actually create a new scope,
|
|
|
|
|
;; which is why we use (let (_) ...).
|
|
|
|
|
`(let (_)
|
|
|
|
|
,@(mapcar (lambda (binder)
|
|
|
|
|
`(defvar ,(if (consp binder) (car binder) binder)))
|
|
|
|
|
binders)
|
2021-08-01 15:05:48 +00:00
|
|
|
|
(let ,binders ,@body)))
|
2020-03-10 16:00:51 +00:00
|
|
|
|
|
|
|
|
|
|
2011-10-26 00:44:06 +00:00
|
|
|
|
(defmacro with-wrapper-hook (hook args &rest body)
|
|
|
|
|
"Run BODY, using wrapper functions from HOOK with additional ARGS.
|
|
|
|
|
HOOK is an abnormal hook. Each hook function in HOOK \"wraps\"
|
|
|
|
|
around the preceding ones, like a set of nested `around' advices.
|
|
|
|
|
|
|
|
|
|
Each hook function should accept an argument list consisting of a
|
|
|
|
|
function FUN, followed by the additional arguments in ARGS.
|
|
|
|
|
|
2012-02-04 20:59:54 +00:00
|
|
|
|
The first hook function in HOOK is passed a FUN that, if it is called
|
|
|
|
|
with arguments ARGS, performs BODY (i.e., the default operation).
|
|
|
|
|
The FUN passed to each successive hook function is defined based
|
|
|
|
|
on the preceding hook functions; if called with arguments ARGS,
|
|
|
|
|
it does what the `with-wrapper-hook' call would do if the
|
|
|
|
|
preceding hook functions were the only ones present in HOOK.
|
|
|
|
|
|
|
|
|
|
Each hook function may call its FUN argument as many times as it wishes,
|
|
|
|
|
including never. In that case, such a hook function acts to replace
|
|
|
|
|
the default definition altogether, and any preceding hook functions.
|
|
|
|
|
Of course, a subsequent hook function may do the same thing.
|
|
|
|
|
|
|
|
|
|
Each hook function definition is used to construct the FUN passed
|
2011-10-26 00:44:06 +00:00
|
|
|
|
to the next hook function, if any. The last (or \"outermost\")
|
|
|
|
|
FUN is then called once."
|
2013-04-18 00:12:33 +00:00
|
|
|
|
(declare (indent 2) (debug (form sexp body))
|
2014-03-01 03:54:47 +00:00
|
|
|
|
(obsolete "use a <foo>-function variable modified by `add-function'."
|
2013-04-18 00:12:33 +00:00
|
|
|
|
"24.4"))
|
2016-05-18 07:12:01 +00:00
|
|
|
|
`(subr--with-wrapper-hook-no-warnings ,hook ,args ,@body))
|
|
|
|
|
|
|
|
|
|
(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body)
|
|
|
|
|
"Like (with-wrapper-hook HOOK ARGS BODY), but without warnings."
|
2021-05-17 08:00:36 +00:00
|
|
|
|
(declare (debug (form sexp def-body)))
|
2011-03-11 20:04:22 +00:00
|
|
|
|
;; We need those two gensyms because CL's lexical scoping is not available
|
|
|
|
|
;; for function arguments :-(
|
|
|
|
|
(let ((funs (make-symbol "funs"))
|
|
|
|
|
(global (make-symbol "global"))
|
|
|
|
|
(argssym (make-symbol "args"))
|
|
|
|
|
(runrestofhook (make-symbol "runrestofhook")))
|
|
|
|
|
;; Since the hook is a wrapper, the loop has to be done via
|
|
|
|
|
;; recursion: a given hook function will call its parameter in order to
|
|
|
|
|
;; continue looping.
|
|
|
|
|
`(letrec ((,runrestofhook
|
|
|
|
|
(lambda (,funs ,global ,argssym)
|
|
|
|
|
;; `funs' holds the functions left on the hook and `global'
|
|
|
|
|
;; holds the functions left on the global part of the hook
|
|
|
|
|
;; (in case the hook is local).
|
|
|
|
|
(if (consp ,funs)
|
|
|
|
|
(if (eq t (car ,funs))
|
|
|
|
|
(funcall ,runrestofhook
|
|
|
|
|
(append ,global (cdr ,funs)) nil ,argssym)
|
|
|
|
|
(apply (car ,funs)
|
|
|
|
|
(apply-partially
|
|
|
|
|
(lambda (,funs ,global &rest ,argssym)
|
|
|
|
|
(funcall ,runrestofhook ,funs ,global ,argssym))
|
|
|
|
|
(cdr ,funs) ,global)
|
|
|
|
|
,argssym))
|
|
|
|
|
;; Once there are no more functions on the hook, run
|
|
|
|
|
;; the original body.
|
|
|
|
|
(apply (lambda ,args ,@body) ,argssym)))))
|
2011-10-26 00:44:06 +00:00
|
|
|
|
(funcall ,runrestofhook ,hook
|
2011-03-11 20:04:22 +00:00
|
|
|
|
;; The global part of the hook, if any.
|
2011-10-26 00:44:06 +00:00
|
|
|
|
,(if (symbolp hook)
|
|
|
|
|
`(if (local-variable-p ',hook)
|
|
|
|
|
(default-value ',hook)))
|
2011-03-11 20:04:22 +00:00
|
|
|
|
(list ,@args)))))
|
|
|
|
|
|
2006-09-10 17:45:42 +00:00
|
|
|
|
(defun add-to-list (list-var element &optional append compare-fn)
|
2005-06-27 21:21:36 +00:00
|
|
|
|
"Add ELEMENT to the value of LIST-VAR if it isn't there yet.
|
2014-02-08 03:37:57 +00:00
|
|
|
|
The test for presence of ELEMENT is done with `equal', or with
|
|
|
|
|
COMPARE-FN if that's non-nil.
|
2000-10-10 02:47:30 +00:00
|
|
|
|
If ELEMENT is added, it is added at the beginning of the list,
|
|
|
|
|
unless the optional argument APPEND is non-nil, in which case
|
|
|
|
|
ELEMENT is added at the end.
|
2020-02-01 19:11:11 +00:00
|
|
|
|
LIST-VAR should not refer to a lexical variable.
|
1999-05-22 19:42:01 +00:00
|
|
|
|
|
2002-03-11 13:31:50 +00:00
|
|
|
|
The return value is the new value of LIST-VAR.
|
|
|
|
|
|
2013-06-05 01:58:43 +00:00
|
|
|
|
This is handy to add some elements to configuration variables,
|
2014-02-08 03:37:57 +00:00
|
|
|
|
but please do not abuse it in Elisp code, where you are usually
|
|
|
|
|
better off using `push' or `cl-pushnew'.
|
|
|
|
|
|
|
|
|
|
If you want to use `add-to-list' on a variable that is not
|
|
|
|
|
defined until a certain package is loaded, you should put the
|
|
|
|
|
call to `add-to-list' into a hook function that will be run only
|
|
|
|
|
after loading the package. `eval-after-load' provides one way to
|
|
|
|
|
do this. In some cases other hooks, such as major mode hooks,
|
|
|
|
|
can do the job."
|
2013-06-05 01:58:43 +00:00
|
|
|
|
(declare
|
|
|
|
|
(compiler-macro
|
|
|
|
|
(lambda (exp)
|
|
|
|
|
;; FIXME: Something like this could be used for `set' as well.
|
|
|
|
|
(if (or (not (eq 'quote (car-safe list-var)))
|
|
|
|
|
(special-variable-p (cadr list-var))
|
2013-07-22 17:24:31 +00:00
|
|
|
|
(not (macroexp-const-p append)))
|
2013-06-05 01:58:43 +00:00
|
|
|
|
exp
|
|
|
|
|
(let* ((sym (cadr list-var))
|
2022-02-22 15:18:43 +00:00
|
|
|
|
(append (eval append lexical-binding))
|
More-conservative ‘format’ quote restyling
Instead of restyling curved quotes for every call to ‘format’,
create a new function ‘format-message’ that does the restyling,
and using the new function instead of ‘format’ only in contexts
where this seems appropriate.
Problem reported by Dmitry Gutov and Andreas Schwab in:
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00826.html
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00827.html
* doc/lispref/commands.texi (Using Interactive):
* doc/lispref/control.texi (Signaling Errors, Signaling Errors):
* doc/lispref/display.texi (Displaying Messages, Progress):
* doc/lispref/elisp.texi:
* doc/lispref/help.texi (Keys in Documentation):
* doc/lispref/minibuf.texi (Minibuffer Misc):
* doc/lispref/strings.texi (Formatting Strings):
* etc/NEWS:
Document the changes.
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/apropos.el (apropos-library):
* lisp/calc/calc-ext.el (calc-record-message)
(calc-user-function-list):
* lisp/calc/calc-help.el (calc-describe-key, calc-full-help):
* lisp/calc/calc-lang.el (math-read-big-balance):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--add-diary-entry):
* lisp/cedet/mode-local.el (mode-local-print-binding)
(mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-completion-message):
* lisp/cedet/semantic/edit.el (semantic-parse-changes-failed):
* lisp/cedet/semantic/wisent/comp.el (wisent-log):
* lisp/cedet/srecode/insert.el (srecode-insert-show-error-report):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dframe.el (dframe-message):
* lisp/dired-aux.el (dired-query):
* lisp/emacs-lisp/byte-opt.el (byte-compile-log-lap-1):
* lisp/emacs-lisp/bytecomp.el (byte-compile-log)
(byte-compile-log-file, byte-compile-warn, byte-compile-form):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use)
(cconv-analyze-form):
* lisp/emacs-lisp/check-declare.el (check-declare-warn):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet):
* lisp/emacs-lisp/edebug.el (edebug-format):
* lisp/emacs-lisp/eieio-core.el (eieio-oref):
* lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message)
(eldoc-message):
* lisp/emacs-lisp/elint.el (elint-file, elint-log):
* lisp/emacs-lisp/find-func.el (find-function-library):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring):
* lisp/emacs-lisp/package.el (package-compute-transaction)
(package-install-button-action, package-delete-button-action)
(package-menu--list-to-prompt):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emacs-lisp/warnings.el (lwarn, warn):
* lisp/emulation/viper-cmd.el:
(viper-toggle-parse-sexp-ignore-comments)
(viper-kill-buffer, viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/facemenu.el (facemenu-add-new-face):
* lisp/faces.el (face-documentation, read-face-name)
(face-read-string, read-face-font, describe-face):
* lisp/files.el (find-alternate-file, hack-local-variables)
(hack-one-local-variable--obsolete, write-file)
(basic-save-buffer, delete-directory):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--obsolete)
(help-fns--interactive-only, describe-function-1)
(describe-variable):
* lisp/help.el (describe-mode):
* lisp/info-xref.el (info-xref-output):
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
* lisp/international/kkc.el (kkc-error):
* lisp/international/mule-cmds.el:
(select-safe-coding-system-interactively)
(select-safe-coding-system, describe-input-method):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/international/quail.el (quail-error):
* lisp/minibuffer.el (minibuffer-message):
* lisp/mpc.el (mpc--debug):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-message):
* lisp/net/gnutls.el (gnutls-message-maybe):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/nsm.el (nsm-query-user):
* lisp/net/rlogin.el (rlogin):
* lisp/net/soap-client.el (soap-warning):
* lisp/net/tramp.el (tramp-debug-message):
* lisp/nxml/nxml-outln.el (nxml-report-outline-error):
* lisp/nxml/nxml-parse.el (nxml-parse-error):
* lisp/nxml/rng-cmpct.el (rng-c-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/org/org-ctags.el:
(org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/proced.el (proced-log):
* lisp/progmodes/ebnf2ps.el (ebnf-log):
* lisp/progmodes/flymake.el (flymake-log):
* lisp/progmodes/vhdl-mode.el (vhdl-warning-when-idle):
* lisp/replace.el (occur-1):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, define-alternatives):
* lisp/startup.el (command-line):
* lisp/subr.el (error, user-error, add-to-list):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* src/callint.c (Fcall_interactively):
* src/editfns.c (Fmessage, Fmessage_box):
Restyle the quotes of format strings intended for use as a
diagnostic, when restyling seems appropriate.
* lisp/subr.el (format-message): New function.
* src/doc.c (Finternal__text_restyle): New function.
(syms_of_doc): Define it.
2015-08-24 05:38:02 +00:00
|
|
|
|
(msg (format-message
|
Go back to grave quoting in source-code docstrings etc.
This reverts almost all my recent changes to use curved quotes
in docstrings and/or strings used for error diagnostics.
There are a few exceptions, e.g., Bahá’í proper names.
* admin/unidata/unidata-gen.el (unidata-gen-table):
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/align.el (align-region):
* lisp/allout.el (allout-mode, allout-solicit-alternate-bullet)
(outlineify-sticky):
* lisp/apropos.el (apropos-library):
* lisp/bookmark.el (bookmark-default-annotation-text):
* lisp/button.el (button-category-symbol, button-put)
(make-text-button):
* lisp/calc/calc-aent.el (math-read-if, math-read-factor):
* lisp/calc/calc-embed.el (calc-do-embedded):
* lisp/calc/calc-ext.el (calc-user-function-list):
* lisp/calc/calc-graph.el (calc-graph-show-dumb):
* lisp/calc/calc-help.el (calc-describe-key)
(calc-describe-thing, calc-full-help):
* lisp/calc/calc-lang.el (calc-c-language)
(math-parse-fortran-vector-end, math-parse-tex-sum)
(math-parse-eqn-matrix, math-parse-eqn-prime)
(calc-yacas-language, calc-maxima-language, calc-giac-language)
(math-read-giac-subscr, math-read-math-subscr)
(math-read-big-rec, math-read-big-balance):
* lisp/calc/calc-misc.el (calc-help, report-calc-bug):
* lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes)
(calc-auto-recompute):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-read-parse-table-part, calc-user-define-invocation)
(math-do-arg-check):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-vec.el (math-read-brackets):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calc/calc.el (calc, calc-do, calc-user-invocation):
* lisp/calendar/appt.el (appt-display-message):
* lisp/calendar/diary-lib.el (diary-check-diary-file)
(diary-mail-entries, diary-from-outlook):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--convert-float-to-ical)
(icalendar--convert-date-to-ical)
(icalendar--convert-ical-to-diary)
(icalendar--convert-recurring-to-diary)
(icalendar--add-diary-entry):
* lisp/calendar/time-date.el (format-seconds):
* lisp/calendar/timeclock.el (timeclock-mode-line-display)
(timeclock-make-hours-explicit, timeclock-log-data):
* lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category)
(todo-item-mark, todo-check-format)
(todo-insert-item--next-param, todo-edit-item--next-key)
(todo-mode):
* lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules):
* lisp/cedet/mode-local.el (describe-mode-local-overload)
(mode-local-print-binding, mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-displayor-show-request):
* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-start.el (standard):
* lisp/cus-theme.el (describe-theme-1):
* lisp/custom.el (custom-add-dependencies, custom-check-theme)
(custom--sort-vars-1, load-theme):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log):
* lisp/emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-read-advice-name, ad-enable-advice)
(ad-disable-advice, ad-remove-advice, ad-set-argument)
(ad-set-arguments, ad--defalias-fset, ad-activate)
(ad-deactivate):
* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand)
(byte-compile-unfold-lambda, byte-optimize-form-code-walker)
(byte-optimize-while, byte-optimize-apply):
* lisp/emacs-lisp/byte-run.el (defun, defsubst):
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode)
(byte-compile-log-file, byte-compile-format-warn)
(byte-compile-nogroup-warn, byte-compile-arglist-warn)
(byte-compile-cl-warn)
(byte-compile-warn-about-unresolved-functions)
(byte-compile-file, byte-compile--declare-var)
(byte-compile-file-form-defmumble, byte-compile-form)
(byte-compile-normal-call, byte-compile-check-variable)
(byte-compile-variable-ref, byte-compile-variable-set)
(byte-compile-subr-wrong-args, byte-compile-setq-default)
(byte-compile-negation-optimizer)
(byte-compile-condition-case--old)
(byte-compile-condition-case--new, byte-compile-save-excursion)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form)
(byte-compile-make-variable-buffer-local, display-call-tree)
(batch-byte-compile):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use):
* lisp/emacs-lisp/chart.el (chart-space-usage):
* lisp/emacs-lisp/check-declare.el (check-declare-scan)
(check-declare-warn, check-declare-file)
(check-declare-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine)
(checkdoc-message-text-engine):
* lisp/emacs-lisp/cl-extra.el (cl-parse-integer)
(cl--describe-class):
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric)
(cl--generic-describe, cl-generic-generalizers):
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody)
(cl-symbol-macrolet):
* lisp/emacs-lisp/cl.el (cl-unload-function, flet):
* lisp/emacs-lisp/copyright.el (copyright)
(copyright-update-directory):
* lisp/emacs-lisp/edebug.el (edebug-read-list):
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-read):
* lisp/emacs-lisp/eieio-core.el (eieio--slot-override)
(eieio-oref):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor):
* lisp/emacs-lisp/eieio-speedbar.el:
(eieio-speedbar-child-make-tag-lines)
(eieio-speedbar-child-description):
* lisp/emacs-lisp/eieio.el (defclass, change-class):
* lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms)
(elint-init-form, elint-check-defalias-form)
(elint-check-let-form):
* lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu)
(ert-results-pop-to-backtrace-for-test-at-point)
(ert-results-pop-to-messages-for-test-at-point)
(ert-results-pop-to-should-forms-for-test-at-point)
(ert-describe-test):
* lisp/emacs-lisp/find-func.el (find-function-search-for-symbol)
(find-function-library):
* lisp/emacs-lisp/generator.el (iter-yield):
* lisp/emacs-lisp/gv.el (gv-define-simple-setter):
* lisp/emacs-lisp/lisp-mnt.el (lm-verify):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring)
(advice--make, define-advice):
* lisp/emacs-lisp/package-x.el (package-upload-file):
* lisp/emacs-lisp/package.el (package-version-join)
(package-disabled-p, package-activate-1, package-activate)
(package--download-one-archive)
(package--download-and-read-archives)
(package-compute-transaction, package-install-from-archive)
(package-install, package-install-selected-packages)
(package-delete, package-autoremove, describe-package-1)
(package-install-button-action, package-delete-button-action)
(package-menu-hide-package, package-menu--list-to-prompt)
(package-menu--perform-transaction)
(package-menu--find-and-notify-upgrades):
* lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1):
* lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode):
* lisp/emacs-lisp/ring.el (ring-previous, ring-next):
* lisp/emacs-lisp/rx.el (rx-check, rx-anything)
(rx-check-any-string, rx-check-any, rx-check-not, rx-=)
(rx-repeat, rx-check-backref, rx-syntax, rx-check-category)
(rx-form):
* lisp/emacs-lisp/smie.el (smie-config-save):
* lisp/emacs-lisp/subr-x.el (internal--check-binding):
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag):
* lisp/emacs-lisp/testcover.el (testcover-1value):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments)
(viper-toggle-search-style, viper-kill-buffer)
(viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/env.el (setenv):
* lisp/erc/erc-button.el (erc-nick-popup):
* lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english):
* lisp/eshell/em-dirs.el (eshell/cd):
* lisp/eshell/em-glob.el (eshell-glob-regexp)
(eshell-glob-entries):
* lisp/eshell/em-pred.el (eshell-parse-modifiers):
* lisp/eshell/esh-opt.el (eshell-show-usage):
* lisp/facemenu.el (facemenu-add-new-face)
(facemenu-add-new-color):
* lisp/faces.el (read-face-name, read-face-font, describe-face)
(x-resolve-font-name):
* lisp/files-x.el (modify-file-local-variable):
* lisp/files.el (locate-user-emacs-file, find-alternate-file)
(set-auto-mode, hack-one-local-variable--obsolete)
(dir-locals-set-directory-class, write-file, basic-save-buffer)
(delete-directory, copy-directory, recover-session)
(recover-session-finish, insert-directory)
(file-modes-char-to-who, file-modes-symbolic-to-number)
(move-file-to-trash):
* lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer):
* lisp/find-cmd.el (find-generic, find-to-string):
* lisp/finder.el (finder-commentary):
* lisp/font-lock.el (font-lock-fontify-buffer):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/frame.el (get-device-terminal, select-frame-by-name):
* lisp/fringe.el (fringe--check-style):
* lisp/gnus/nnmairix.el (nnmairix-widget-create-query):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--parent-mode)
(help-fns--obsolete, help-fns--interactive-only)
(describe-function-1, describe-variable):
* lisp/help.el (describe-mode)
(describe-minor-mode-from-indicator):
* lisp/image.el (image-type):
* lisp/international/ccl.el (ccl-dump):
* lisp/international/fontset.el (x-must-resolve-font-name):
* lisp/international/mule-cmds.el (prefer-coding-system)
(select-safe-coding-system-interactively)
(select-safe-coding-system, activate-input-method)
(toggle-input-method, describe-current-input-method)
(describe-language-environment):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/mail/feedmail.el (feedmail-run-the-queue):
* lisp/mouse.el (minor-mode-menu-from-indicator):
* lisp/mpc.el (mpc-playlist-rename):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-shell-command):
* lisp/net/imap.el (imap-interactive-login):
* lisp/net/mairix.el (mairix-widget-create-query):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/rlogin.el (rlogin):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/obsolete/otodo-mode.el (todo-more-important-p):
* lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region):
* lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region):
* lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region):
* lisp/org/ob-core.el (org-babel-goto-named-src-block)
(org-babel-goto-named-result):
* lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap):
* lisp/org/ob-ref.el (org-babel-ref-resolve):
* lisp/org/org-agenda.el (org-agenda-prepare):
* lisp/org/org-clock.el (org-clock-notify-once-if-expired)
(org-clock-resolve):
* lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/org/org-feed.el (org-feed-parse-atom-entry):
* lisp/org/org-habit.el (org-habit-parse-todo):
* lisp/org/org-mouse.el (org-mouse-popup-global-menu)
(org-mouse-context-menu):
* lisp/org/org-table.el (org-table-edit-formulas):
* lisp/org/ox.el (org-export-async-start):
* lisp/proced.el (proced-log):
* lisp/progmodes/ada-mode.el (ada-get-indent-case)
(ada-check-matching-start, ada-goto-matching-start):
* lisp/progmodes/ada-prj.el (ada-prj-display-page):
* lisp/progmodes/ada-xref.el (ada-find-executable):
* lisp/progmodes/ebrowse.el (ebrowse-tags-apropos):
* lisp/progmodes/etags.el (etags-tags-apropos-additional):
* lisp/progmodes/flymake.el (flymake-parse-err-lines)
(flymake-start-syntax-check-process):
* lisp/progmodes/python.el (python-shell-get-process-or-error)
(python-define-auxiliary-skeleton):
* lisp/progmodes/sql.el (sql-comint):
* lisp/progmodes/verilog-mode.el (verilog-load-file-at-point):
* lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate):
* lisp/recentf.el (recentf-open-files):
* lisp/replace.el (query-replace-read-from)
(occur-after-change-function, occur-1):
* lisp/scroll-bar.el (scroll-bar-columns):
* lisp/server.el (server-get-auth-key):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, list-processes--refresh)
(compose-mail, set-variable, choose-completion-string)
(define-alternatives):
* lisp/startup.el (site-run-file, tty-handle-args, command-line)
(command-line-1):
* lisp/subr.el (noreturn, define-error, add-to-list)
(read-char-choice, version-to-list):
* lisp/term/common-win.el (x-handle-xrm-switch)
(x-handle-name-switch, x-handle-args):
* lisp/term/x-win.el (x-handle-parent-id, x-handle-smid):
* lisp/textmodes/reftex-ref.el (reftex-label):
* lisp/textmodes/reftex-toc.el (reftex-toc-rename-label):
* lisp/textmodes/two-column.el (2C-split):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* lisp/type-break.el (type-break-noninteractive-query):
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
* lisp/whitespace.el (whitespace-report-region):
Prefer grave quoting in source-code strings used to generate help
and diagnostics.
* lisp/faces.el (face-documentation):
No need to convert quotes, since the result is a docstring.
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
Simplify by generating only curved quotes, since info files are
typically that ways nowadays anyway.
* lisp/international/mule-diag.el (list-input-methods):
Don’t assume text quoting style is curved.
* lisp/org/org-bibtex.el (org-bibtex-fields):
Revert my recent changes, going back to the old quoting style.
2015-09-07 15:41:44 +00:00
|
|
|
|
"`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
|
More-conservative ‘format’ quote restyling
Instead of restyling curved quotes for every call to ‘format’,
create a new function ‘format-message’ that does the restyling,
and using the new function instead of ‘format’ only in contexts
where this seems appropriate.
Problem reported by Dmitry Gutov and Andreas Schwab in:
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00826.html
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00827.html
* doc/lispref/commands.texi (Using Interactive):
* doc/lispref/control.texi (Signaling Errors, Signaling Errors):
* doc/lispref/display.texi (Displaying Messages, Progress):
* doc/lispref/elisp.texi:
* doc/lispref/help.texi (Keys in Documentation):
* doc/lispref/minibuf.texi (Minibuffer Misc):
* doc/lispref/strings.texi (Formatting Strings):
* etc/NEWS:
Document the changes.
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/apropos.el (apropos-library):
* lisp/calc/calc-ext.el (calc-record-message)
(calc-user-function-list):
* lisp/calc/calc-help.el (calc-describe-key, calc-full-help):
* lisp/calc/calc-lang.el (math-read-big-balance):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--add-diary-entry):
* lisp/cedet/mode-local.el (mode-local-print-binding)
(mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-completion-message):
* lisp/cedet/semantic/edit.el (semantic-parse-changes-failed):
* lisp/cedet/semantic/wisent/comp.el (wisent-log):
* lisp/cedet/srecode/insert.el (srecode-insert-show-error-report):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dframe.el (dframe-message):
* lisp/dired-aux.el (dired-query):
* lisp/emacs-lisp/byte-opt.el (byte-compile-log-lap-1):
* lisp/emacs-lisp/bytecomp.el (byte-compile-log)
(byte-compile-log-file, byte-compile-warn, byte-compile-form):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use)
(cconv-analyze-form):
* lisp/emacs-lisp/check-declare.el (check-declare-warn):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet):
* lisp/emacs-lisp/edebug.el (edebug-format):
* lisp/emacs-lisp/eieio-core.el (eieio-oref):
* lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message)
(eldoc-message):
* lisp/emacs-lisp/elint.el (elint-file, elint-log):
* lisp/emacs-lisp/find-func.el (find-function-library):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring):
* lisp/emacs-lisp/package.el (package-compute-transaction)
(package-install-button-action, package-delete-button-action)
(package-menu--list-to-prompt):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emacs-lisp/warnings.el (lwarn, warn):
* lisp/emulation/viper-cmd.el:
(viper-toggle-parse-sexp-ignore-comments)
(viper-kill-buffer, viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/facemenu.el (facemenu-add-new-face):
* lisp/faces.el (face-documentation, read-face-name)
(face-read-string, read-face-font, describe-face):
* lisp/files.el (find-alternate-file, hack-local-variables)
(hack-one-local-variable--obsolete, write-file)
(basic-save-buffer, delete-directory):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--obsolete)
(help-fns--interactive-only, describe-function-1)
(describe-variable):
* lisp/help.el (describe-mode):
* lisp/info-xref.el (info-xref-output):
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
* lisp/international/kkc.el (kkc-error):
* lisp/international/mule-cmds.el:
(select-safe-coding-system-interactively)
(select-safe-coding-system, describe-input-method):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/international/quail.el (quail-error):
* lisp/minibuffer.el (minibuffer-message):
* lisp/mpc.el (mpc--debug):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-message):
* lisp/net/gnutls.el (gnutls-message-maybe):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/nsm.el (nsm-query-user):
* lisp/net/rlogin.el (rlogin):
* lisp/net/soap-client.el (soap-warning):
* lisp/net/tramp.el (tramp-debug-message):
* lisp/nxml/nxml-outln.el (nxml-report-outline-error):
* lisp/nxml/nxml-parse.el (nxml-parse-error):
* lisp/nxml/rng-cmpct.el (rng-c-error):
* lisp/nxml/rng-match.el (rng-compile-error):
* lisp/nxml/rng-uri.el (rng-uri-error):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/org/org-ctags.el:
(org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/proced.el (proced-log):
* lisp/progmodes/ebnf2ps.el (ebnf-log):
* lisp/progmodes/flymake.el (flymake-log):
* lisp/progmodes/vhdl-mode.el (vhdl-warning-when-idle):
* lisp/replace.el (occur-1):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, define-alternatives):
* lisp/startup.el (command-line):
* lisp/subr.el (error, user-error, add-to-list):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* src/callint.c (Fcall_interactively):
* src/editfns.c (Fmessage, Fmessage_box):
Restyle the quotes of format strings intended for use as a
diagnostic, when restyling seems appropriate.
* lisp/subr.el (format-message): New function.
* src/doc.c (Finternal__text_restyle): New function.
(syms_of_doc): Define it.
2015-08-24 05:38:02 +00:00
|
|
|
|
sym))
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; Big ugly hack, so we output a warning only during
|
2013-06-05 01:58:43 +00:00
|
|
|
|
;; byte-compilation, and so we can use
|
|
|
|
|
;; byte-compile-not-lexical-var-p to silence the warning
|
|
|
|
|
;; when a defvar has been seen but not yet executed.
|
|
|
|
|
(warnfun (lambda ()
|
|
|
|
|
;; FIXME: We should also emit a warning for let-bound
|
|
|
|
|
;; variables with dynamic binding.
|
|
|
|
|
(when (assq sym byte-compile--lexical-environment)
|
2016-09-03 18:37:47 +00:00
|
|
|
|
(byte-compile-report-error msg :fill))))
|
2013-06-05 01:58:43 +00:00
|
|
|
|
(code
|
2013-07-22 17:24:31 +00:00
|
|
|
|
(macroexp-let2 macroexp-copyable-p x element
|
2013-10-25 01:10:27 +00:00
|
|
|
|
`(if ,(if compare-fn
|
|
|
|
|
(progn
|
|
|
|
|
(require 'cl-lib)
|
|
|
|
|
`(cl-member ,x ,sym :test ,compare-fn))
|
|
|
|
|
;; For bootstrapping reasons, don't rely on
|
|
|
|
|
;; cl--compiler-macro-member for the base case.
|
|
|
|
|
`(member ,x ,sym))
|
|
|
|
|
,sym
|
2013-07-22 17:24:31 +00:00
|
|
|
|
,(if append
|
|
|
|
|
`(setq ,sym (append ,sym (list ,x)))
|
|
|
|
|
`(push ,x ,sym))))))
|
2021-02-24 18:52:45 +00:00
|
|
|
|
(if (not (macroexp-compiling-p))
|
2013-06-05 01:58:43 +00:00
|
|
|
|
code
|
|
|
|
|
`(progn
|
|
|
|
|
(macroexp--funcall-if-compiled ',warnfun)
|
|
|
|
|
,code)))))))
|
2006-10-22 22:32:53 +00:00
|
|
|
|
(if (cond
|
2006-10-22 22:37:51 +00:00
|
|
|
|
((null compare-fn)
|
2006-09-10 17:45:42 +00:00
|
|
|
|
(member element (symbol-value list-var)))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
((eq compare-fn #'eq)
|
2006-10-22 22:32:53 +00:00
|
|
|
|
(memq element (symbol-value list-var)))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
((eq compare-fn #'eql)
|
2006-10-22 22:32:53 +00:00
|
|
|
|
(memql element (symbol-value list-var)))
|
2006-10-22 22:37:51 +00:00
|
|
|
|
(t
|
2006-10-30 22:49:04 +00:00
|
|
|
|
(let ((lst (symbol-value list-var)))
|
|
|
|
|
(while (and lst
|
|
|
|
|
(not (funcall compare-fn element (car lst))))
|
|
|
|
|
(setq lst (cdr lst)))
|
|
|
|
|
lst)))
|
1998-04-07 18:22:28 +00:00
|
|
|
|
(symbol-value list-var)
|
2000-10-10 02:47:30 +00:00
|
|
|
|
(set list-var
|
|
|
|
|
(if append
|
|
|
|
|
(append (symbol-value list-var) (list element))
|
|
|
|
|
(cons element (symbol-value list-var))))))
|
2001-10-09 11:14:31 +00:00
|
|
|
|
|
2005-06-13 21:29:52 +00:00
|
|
|
|
|
2021-01-01 04:48:02 +00:00
|
|
|
|
(defun add-to-ordered-list (list-var element &optional order)
|
2005-06-27 21:21:36 +00:00
|
|
|
|
"Add ELEMENT to the value of LIST-VAR if it isn't there yet.
|
2021-01-01 04:48:02 +00:00
|
|
|
|
The test for presence of ELEMENT is done with `eq'.
|
2005-06-13 21:29:52 +00:00
|
|
|
|
|
2020-12-31 04:28:47 +00:00
|
|
|
|
The value of LIST-VAR is kept ordered based on the ORDER
|
|
|
|
|
parameter.
|
2005-06-13 21:29:52 +00:00
|
|
|
|
|
2005-06-27 21:21:36 +00:00
|
|
|
|
If the third optional argument ORDER is a number (integer or
|
|
|
|
|
float), set the element's list order to the given value. If
|
|
|
|
|
ORDER is nil or omitted, do not change the numeric order of
|
|
|
|
|
ELEMENT. If ORDER has any other value, remove the numeric order
|
|
|
|
|
of ELEMENT if it has one.
|
2005-06-14 08:14:06 +00:00
|
|
|
|
|
2005-06-15 20:58:20 +00:00
|
|
|
|
The list order for each element is stored in LIST-VAR's
|
2005-06-14 08:14:06 +00:00
|
|
|
|
`list-order' property.
|
2020-02-02 11:48:51 +00:00
|
|
|
|
LIST-VAR cannot refer to a lexical variable.
|
2005-06-13 21:29:52 +00:00
|
|
|
|
|
|
|
|
|
The return value is the new value of LIST-VAR."
|
2021-01-01 04:48:02 +00:00
|
|
|
|
(let ((ordering (get list-var 'list-order)))
|
2005-06-15 20:58:20 +00:00
|
|
|
|
(unless ordering
|
|
|
|
|
(put list-var 'list-order
|
2021-01-01 04:48:02 +00:00
|
|
|
|
(setq ordering (make-hash-table :weakness 'key :test 'eq))))
|
|
|
|
|
(when order
|
|
|
|
|
(puthash element (and (numberp order) order) ordering))
|
|
|
|
|
(unless (memq element (symbol-value list-var))
|
2005-06-20 21:41:34 +00:00
|
|
|
|
(set list-var (cons element (symbol-value list-var))))
|
2021-01-01 04:48:02 +00:00
|
|
|
|
(set list-var (sort (symbol-value list-var)
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(let ((oa (gethash a ordering))
|
|
|
|
|
(ob (gethash b ordering)))
|
|
|
|
|
(if (and oa ob)
|
|
|
|
|
(< oa ob)
|
|
|
|
|
oa)))))))
|
2006-05-05 23:35:57 +00:00
|
|
|
|
|
2006-05-16 11:19:39 +00:00
|
|
|
|
(defun add-to-history (history-var newelt &optional maxelt keep-all)
|
2006-05-05 23:35:57 +00:00
|
|
|
|
"Add NEWELT to the history list stored in the variable HISTORY-VAR.
|
|
|
|
|
Return the new history list.
|
|
|
|
|
If MAXELT is non-nil, it specifies the maximum length of the history.
|
|
|
|
|
Otherwise, the maximum history length is the value of the `history-length'
|
|
|
|
|
property on symbol HISTORY-VAR, if set, or the value of the `history-length'
|
2017-07-22 08:34:55 +00:00
|
|
|
|
variable. The possible values of maximum length have the same meaning as
|
|
|
|
|
the values of `history-length'.
|
2006-05-16 11:19:39 +00:00
|
|
|
|
Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil.
|
|
|
|
|
If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even
|
2020-02-02 11:48:51 +00:00
|
|
|
|
if it is empty or duplicates the most recent entry in the history.
|
|
|
|
|
HISTORY-VAR cannot refer to a lexical variable."
|
2006-05-05 23:35:57 +00:00
|
|
|
|
(unless maxelt
|
|
|
|
|
(setq maxelt (or (get history-var 'history-length)
|
|
|
|
|
history-length)))
|
|
|
|
|
(let ((history (symbol-value history-var))
|
|
|
|
|
tail)
|
2006-05-16 11:19:39 +00:00
|
|
|
|
(when (and (listp history)
|
|
|
|
|
(or keep-all
|
|
|
|
|
(not (stringp newelt))
|
|
|
|
|
(> (length newelt) 0))
|
|
|
|
|
(or keep-all
|
|
|
|
|
(not (equal (car history) newelt))))
|
|
|
|
|
(if history-delete-duplicates
|
2012-09-08 14:30:09 +00:00
|
|
|
|
(setq history (delete newelt history)))
|
2006-05-16 11:19:39 +00:00
|
|
|
|
(setq history (cons newelt history))
|
|
|
|
|
(when (integerp maxelt)
|
2018-04-29 14:37:45 +00:00
|
|
|
|
(if (>= 0 maxelt)
|
2006-05-16 11:19:39 +00:00
|
|
|
|
(setq history nil)
|
|
|
|
|
(setq tail (nthcdr (1- maxelt) history))
|
|
|
|
|
(when (consp tail)
|
2018-04-29 14:37:45 +00:00
|
|
|
|
(setcdr tail nil))))
|
|
|
|
|
(set history-var history))))
|
2006-05-05 23:35:57 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Mode hooks.
|
|
|
|
|
|
|
|
|
|
(defvar delay-mode-hooks nil
|
|
|
|
|
"If non-nil, `run-mode-hooks' should delay running the hooks.")
|
2017-12-27 22:49:39 +00:00
|
|
|
|
(defvar-local delayed-mode-hooks nil
|
2005-10-22 15:01:08 +00:00
|
|
|
|
"List of delayed mode hooks waiting to be run.")
|
|
|
|
|
(put 'delay-mode-hooks 'permanent-local t)
|
2005-06-13 21:29:52 +00:00
|
|
|
|
|
2017-12-27 22:49:39 +00:00
|
|
|
|
(defvar-local delayed-after-hook-functions nil
|
2016-05-08 13:24:20 +00:00
|
|
|
|
"List of delayed :after-hook forms waiting to be run.
|
|
|
|
|
These forms come from `define-derived-mode'.")
|
|
|
|
|
|
2011-10-27 03:01:40 +00:00
|
|
|
|
(defvar change-major-mode-after-body-hook nil
|
|
|
|
|
"Normal hook run in major mode functions, before the mode hooks.")
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defvar after-change-major-mode-hook nil
|
|
|
|
|
"Normal hook run at the very end of major mode functions.")
|
|
|
|
|
|
|
|
|
|
(defun run-mode-hooks (&rest hooks)
|
|
|
|
|
"Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
|
2016-05-05 11:05:49 +00:00
|
|
|
|
Call `hack-local-variables' to set up file local and directory local
|
|
|
|
|
variables.
|
|
|
|
|
|
|
|
|
|
If the variable `delay-mode-hooks' is non-nil, does not do anything,
|
2012-02-02 02:57:26 +00:00
|
|
|
|
just adds the HOOKS to the list `delayed-mode-hooks'.
|
|
|
|
|
Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',
|
2016-05-05 11:05:49 +00:00
|
|
|
|
`delayed-mode-hooks' (in reverse order), HOOKS, then runs
|
2023-03-04 10:16:51 +00:00
|
|
|
|
`hack-local-variables' (if the buffer is visiting a file),
|
|
|
|
|
runs the hook `after-change-major-mode-hook', and finally
|
|
|
|
|
evaluates the functions in `delayed-after-hook-functions' (see
|
2016-05-08 13:24:20 +00:00
|
|
|
|
`define-derived-mode').
|
|
|
|
|
|
|
|
|
|
Major mode functions should use this instead of `run-hooks' when
|
|
|
|
|
running their FOO-mode-hook."
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(if delay-mode-hooks
|
|
|
|
|
;; Delaying case.
|
|
|
|
|
(dolist (hook hooks)
|
|
|
|
|
(push hook delayed-mode-hooks))
|
|
|
|
|
;; Normal case, just run the hook as before plus any delayed hooks.
|
|
|
|
|
(setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
|
2018-06-22 03:30:11 +00:00
|
|
|
|
(and (bound-and-true-p syntax-propertize-function)
|
2017-12-12 19:43:27 +00:00
|
|
|
|
(not (local-variable-p 'parse-sexp-lookup-properties))
|
2017-12-12 14:11:17 +00:00
|
|
|
|
;; `syntax-propertize' sets `parse-sexp-lookup-properties' for us, but
|
|
|
|
|
;; in order for the sexp primitives to automatically call
|
|
|
|
|
;; `syntax-propertize' we need `parse-sexp-lookup-properties' to be
|
|
|
|
|
;; set first.
|
|
|
|
|
(setq-local parse-sexp-lookup-properties t))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(setq delayed-mode-hooks nil)
|
2017-12-12 14:11:17 +00:00
|
|
|
|
(apply #'run-hooks (cons 'change-major-mode-after-body-hook hooks))
|
2016-05-05 11:05:49 +00:00
|
|
|
|
(if (buffer-file-name)
|
|
|
|
|
(with-demoted-errors "File local-variables error: %s"
|
|
|
|
|
(hack-local-variables 'no-mode)))
|
2016-05-08 13:24:20 +00:00
|
|
|
|
(run-hooks 'after-change-major-mode-hook)
|
2017-12-27 22:49:39 +00:00
|
|
|
|
(dolist (fun (prog1 (nreverse delayed-after-hook-functions)
|
|
|
|
|
(setq delayed-after-hook-functions nil)))
|
|
|
|
|
(funcall fun))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
(defmacro delay-mode-hooks (&rest body)
|
|
|
|
|
"Execute BODY, but delay any `run-mode-hooks'.
|
|
|
|
|
These hooks will be executed by the first following call to
|
2015-04-28 05:59:10 +00:00
|
|
|
|
`run-mode-hooks' that occurs outside any `delay-mode-hooks' form.
|
2019-11-04 02:36:05 +00:00
|
|
|
|
Affects only hooks run in the current buffer."
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(declare (debug t) (indent 0))
|
|
|
|
|
`(progn
|
|
|
|
|
(make-local-variable 'delay-mode-hooks)
|
|
|
|
|
(let ((delay-mode-hooks t))
|
|
|
|
|
,@body)))
|
|
|
|
|
|
2022-04-30 14:42:44 +00:00
|
|
|
|
;;; `when-let' and friends.
|
|
|
|
|
|
|
|
|
|
(defun internal--build-binding (binding prev-var)
|
|
|
|
|
"Check and build a single BINDING with PREV-VAR."
|
|
|
|
|
(setq binding
|
|
|
|
|
(cond
|
|
|
|
|
((symbolp binding)
|
|
|
|
|
(list binding binding))
|
|
|
|
|
((null (cdr binding))
|
|
|
|
|
(list (make-symbol "s") (car binding)))
|
2024-02-16 21:07:18 +00:00
|
|
|
|
((eq '_ (car binding))
|
|
|
|
|
(list (make-symbol "s") (cadr binding)))
|
2022-04-30 14:42:44 +00:00
|
|
|
|
(t binding)))
|
|
|
|
|
(when (> (length binding) 2)
|
|
|
|
|
(signal 'error
|
|
|
|
|
(cons "`let' bindings can have only one value-form" binding)))
|
|
|
|
|
(let ((var (car binding)))
|
|
|
|
|
`(,var (and ,prev-var ,(cadr binding)))))
|
|
|
|
|
|
|
|
|
|
(defun internal--build-bindings (bindings)
|
|
|
|
|
"Check and build conditional value forms for BINDINGS."
|
|
|
|
|
(let ((prev-var t))
|
|
|
|
|
(mapcar (lambda (binding)
|
|
|
|
|
(let ((binding (internal--build-binding binding prev-var)))
|
|
|
|
|
(setq prev-var (car binding))
|
|
|
|
|
binding))
|
|
|
|
|
bindings)))
|
|
|
|
|
|
|
|
|
|
(defmacro if-let* (varlist then &rest else)
|
|
|
|
|
"Bind variables according to VARLIST and evaluate THEN or ELSE.
|
|
|
|
|
This is like `if-let' but doesn't handle a VARLIST of the form
|
|
|
|
|
\(SYMBOL SOMETHING) specially."
|
|
|
|
|
(declare (indent 2)
|
|
|
|
|
(debug ((&rest [&or symbolp (symbolp form) (form)])
|
|
|
|
|
body)))
|
|
|
|
|
(if varlist
|
|
|
|
|
`(let* ,(setq varlist (internal--build-bindings varlist))
|
|
|
|
|
(if ,(caar (last varlist))
|
|
|
|
|
,then
|
|
|
|
|
,@else))
|
|
|
|
|
`(let* () ,then)))
|
|
|
|
|
|
|
|
|
|
(defmacro when-let* (varlist &rest body)
|
|
|
|
|
"Bind variables according to VARLIST and conditionally evaluate BODY.
|
|
|
|
|
This is like `when-let' but doesn't handle a VARLIST of the form
|
|
|
|
|
\(SYMBOL SOMETHING) specially."
|
|
|
|
|
(declare (indent 1) (debug if-let*))
|
|
|
|
|
(list 'if-let* varlist (macroexp-progn body)))
|
|
|
|
|
|
|
|
|
|
(defmacro and-let* (varlist &rest body)
|
|
|
|
|
"Bind variables according to VARLIST and conditionally evaluate BODY.
|
|
|
|
|
Like `when-let*', except if BODY is empty and all the bindings
|
2024-02-18 01:27:56 +00:00
|
|
|
|
are non-nil, then the result is the value of the last binding."
|
2022-04-30 14:42:44 +00:00
|
|
|
|
(declare (indent 1) (debug if-let*))
|
|
|
|
|
(let (res)
|
|
|
|
|
(if varlist
|
|
|
|
|
`(let* ,(setq varlist (internal--build-bindings varlist))
|
|
|
|
|
(when ,(setq res (caar (last varlist)))
|
|
|
|
|
,@(or body `(,res))))
|
|
|
|
|
`(let* () ,@(or body '(t))))))
|
|
|
|
|
|
|
|
|
|
(defmacro if-let (spec then &rest else)
|
|
|
|
|
"Bind variables according to SPEC and evaluate THEN or ELSE.
|
|
|
|
|
Evaluate each binding in turn, as in `let*', stopping if a
|
|
|
|
|
binding value is nil. If all are non-nil return the value of
|
2024-02-18 01:27:56 +00:00
|
|
|
|
THEN, otherwise the value of the last form in ELSE, or nil if
|
|
|
|
|
there are none.
|
2022-04-30 14:42:44 +00:00
|
|
|
|
|
|
|
|
|
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
|
|
|
|
|
SYMBOL to the value of VALUEFORM. An element can additionally be
|
|
|
|
|
of the form (VALUEFORM), which is evaluated and checked for nil;
|
|
|
|
|
i.e. SYMBOL can be omitted if only the test result is of
|
|
|
|
|
interest. It can also be of the form SYMBOL, then the binding of
|
|
|
|
|
SYMBOL is checked for nil.
|
|
|
|
|
|
|
|
|
|
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
|
|
|
|
|
like \((SYMBOL SOMETHING)). This exists for backward compatibility
|
|
|
|
|
with an old syntax that accepted only one binding."
|
|
|
|
|
(declare (indent 2)
|
|
|
|
|
(debug ([&or (symbolp form) ; must be first, Bug#48489
|
|
|
|
|
(&rest [&or symbolp (symbolp form) (form)])]
|
|
|
|
|
body)))
|
|
|
|
|
(when (and (<= (length spec) 2)
|
|
|
|
|
(not (listp (car spec))))
|
|
|
|
|
;; Adjust the single binding case
|
|
|
|
|
(setq spec (list spec)))
|
|
|
|
|
(list 'if-let* spec then (macroexp-progn else)))
|
|
|
|
|
|
|
|
|
|
(defmacro when-let (spec &rest body)
|
|
|
|
|
"Bind variables according to SPEC and conditionally evaluate BODY.
|
|
|
|
|
Evaluate each binding in turn, stopping if a binding value is nil.
|
|
|
|
|
If all are non-nil, return the value of the last form in BODY.
|
|
|
|
|
|
|
|
|
|
The variable list SPEC is the same as in `if-let'."
|
|
|
|
|
(declare (indent 1) (debug if-let))
|
|
|
|
|
(list 'if-let spec (macroexp-progn body)))
|
|
|
|
|
|
2022-09-28 11:19:08 +00:00
|
|
|
|
(defmacro while-let (spec &rest body)
|
|
|
|
|
"Bind variables according to SPEC and conditionally evaluate BODY.
|
|
|
|
|
Evaluate each binding in turn, stopping if a binding value is nil.
|
|
|
|
|
If all bindings are non-nil, eval BODY and repeat.
|
2022-04-30 14:42:44 +00:00
|
|
|
|
|
2023-01-15 17:01:41 +00:00
|
|
|
|
The variable list SPEC is the same as in `if-let*'."
|
2022-09-28 11:19:08 +00:00
|
|
|
|
(declare (indent 1) (debug if-let))
|
|
|
|
|
(let ((done (gensym "done")))
|
|
|
|
|
`(catch ',done
|
|
|
|
|
(while t
|
2023-01-15 17:01:41 +00:00
|
|
|
|
;; This is `if-let*', not `if-let', deliberately, despite the
|
|
|
|
|
;; name of this macro. See bug#60758.
|
2023-01-15 16:57:41 +00:00
|
|
|
|
(if-let* ,spec
|
2022-09-28 11:19:08 +00:00
|
|
|
|
(progn
|
|
|
|
|
,@body)
|
|
|
|
|
(throw ',done nil))))))
|
2022-04-30 14:42:44 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; PUBLIC: find if the current mode derives from another.
|
|
|
|
|
|
2023-11-07 23:57:03 +00:00
|
|
|
|
(defun merge-ordered-lists (lists &optional error-function)
|
|
|
|
|
"Merge LISTS in a consistent order.
|
|
|
|
|
LISTS is a list of lists of elements.
|
|
|
|
|
Merge them into a single list containing the same elements (removing
|
2023-11-12 16:37:38 +00:00
|
|
|
|
duplicates), obeying their relative positions in each list.
|
|
|
|
|
The order of the (sub)lists determines the final order in those cases where
|
|
|
|
|
the order within the sublists does not impose a unique choice.
|
|
|
|
|
Equality of elements is tested with `eql'.
|
2023-11-07 23:57:03 +00:00
|
|
|
|
|
|
|
|
|
If a consistent order does not exist, call ERROR-FUNCTION with
|
|
|
|
|
a remaining list of lists that we do not know how to merge.
|
|
|
|
|
It should return the candidate to use to continue the merge, which
|
|
|
|
|
has to be the head of one of the lists.
|
|
|
|
|
By default we choose the head of the first list."
|
2023-11-12 16:37:38 +00:00
|
|
|
|
;; Algorithm inspired from
|
|
|
|
|
;; [C3](https://en.wikipedia.org/wiki/C3_linearization)
|
2023-11-07 23:57:03 +00:00
|
|
|
|
(let ((result '()))
|
2023-11-16 14:50:45 +00:00
|
|
|
|
(setq lists (remq nil lists)) ;Don't mutate the original `lists' argument.
|
2023-11-07 23:57:03 +00:00
|
|
|
|
(while (cdr (setq lists (delq nil lists)))
|
|
|
|
|
;; Try to find the next element of the result. This
|
|
|
|
|
;; is achieved by considering the first element of each
|
|
|
|
|
;; (non-empty) input list and accepting a candidate if it is
|
|
|
|
|
;; consistent with the rests of the input lists.
|
|
|
|
|
(let* ((next nil)
|
|
|
|
|
(tail lists))
|
|
|
|
|
(while tail
|
|
|
|
|
(let ((candidate (caar tail))
|
|
|
|
|
(other-lists lists))
|
|
|
|
|
;; Ensure CANDIDATE is not in any position but the first
|
|
|
|
|
;; in any of the element lists of LISTS.
|
|
|
|
|
(while other-lists
|
|
|
|
|
(if (not (memql candidate (cdr (car other-lists))))
|
|
|
|
|
(setq other-lists (cdr other-lists))
|
|
|
|
|
(setq candidate nil)
|
|
|
|
|
(setq other-lists nil)))
|
|
|
|
|
(if (not candidate)
|
|
|
|
|
(setq tail (cdr tail))
|
|
|
|
|
(setq next candidate)
|
|
|
|
|
(setq tail nil))))
|
|
|
|
|
(unless next ;; The graph is inconsistent.
|
|
|
|
|
(setq next (funcall (or error-function #'caar) lists))
|
|
|
|
|
(unless (assoc next lists #'eql)
|
|
|
|
|
(error "Invalid candidate returned by error-function: %S" next)))
|
|
|
|
|
;; The graph is consistent so far, add NEXT to result and
|
|
|
|
|
;; merge input lists, dropping NEXT from their heads where
|
|
|
|
|
;; applicable.
|
|
|
|
|
(push next result)
|
|
|
|
|
(setq lists
|
|
|
|
|
(mapcar (lambda (l) (if (eql (car l) next) (cdr l) l))
|
|
|
|
|
lists))))
|
|
|
|
|
(if (null result) (car lists) ;; Common case.
|
|
|
|
|
(append (nreverse result) (car lists)))))
|
|
|
|
|
|
2023-11-08 16:32:27 +00:00
|
|
|
|
(defun derived-mode-all-parents (mode &optional known-children)
|
|
|
|
|
"Return all the parents of MODE, starting with MODE.
|
2024-01-05 07:38:58 +00:00
|
|
|
|
This includes the parents set by `define-derived-mode' and additional
|
|
|
|
|
ones set by `derived-mode-add-parents'.
|
2023-11-08 16:32:27 +00:00
|
|
|
|
The returned list is not fresh, don't modify it.
|
|
|
|
|
\n(fn MODE)" ;`known-children' is for internal use only.
|
2023-11-08 19:20:09 +00:00
|
|
|
|
;; Can't use `with-memoization' :-(
|
|
|
|
|
(let ((ps (get mode 'derived-mode--all-parents)))
|
2023-11-07 23:57:03 +00:00
|
|
|
|
(cond
|
|
|
|
|
(ps ps)
|
|
|
|
|
((memq mode known-children)
|
|
|
|
|
;; These things happen, better not get all worked up about it.
|
|
|
|
|
;;(error "Cycle in the major mode hierarchy: %S" mode)
|
2023-11-12 16:37:38 +00:00
|
|
|
|
;; But do try to return something meaningful.
|
|
|
|
|
(memq mode (reverse known-children)))
|
2023-11-07 23:57:03 +00:00
|
|
|
|
(t
|
2023-11-06 21:57:05 +00:00
|
|
|
|
;; The mode hierarchy (or DAG, actually), is very static, but we
|
|
|
|
|
;; need to react to changes because `parent' may not be defined
|
|
|
|
|
;; yet (e.g. it's still just an autoload), so the recursive call
|
|
|
|
|
;; to `derived-mode-all-parents' may return an
|
|
|
|
|
;; invalid/incomplete result which we'll need to update when the
|
|
|
|
|
;; mode actually gets loaded.
|
2023-11-12 16:37:38 +00:00
|
|
|
|
(let* ((new-children (cons mode known-children))
|
|
|
|
|
(get-all-parents
|
2023-11-06 21:57:05 +00:00
|
|
|
|
(lambda (parent)
|
|
|
|
|
;; Can't use `cl-lib' here (nor `gv') :-(
|
|
|
|
|
;;(cl-assert (not (equal parent mode)))
|
|
|
|
|
;;(cl-pushnew mode (get parent 'derived-mode--followers))
|
|
|
|
|
(let ((followers (get parent 'derived-mode--followers)))
|
|
|
|
|
(unless (memq mode followers)
|
|
|
|
|
(put parent 'derived-mode--followers
|
|
|
|
|
(cons mode followers))))
|
2023-11-12 16:37:38 +00:00
|
|
|
|
(derived-mode-all-parents parent new-children)))
|
2023-11-06 21:57:05 +00:00
|
|
|
|
(parent (or (get mode 'derived-mode-parent)
|
2023-11-08 19:20:09 +00:00
|
|
|
|
;; If MODE is an alias, then follow the alias.
|
|
|
|
|
(let ((alias (symbol-function mode)))
|
2023-11-06 21:57:05 +00:00
|
|
|
|
(and (symbolp alias) alias))))
|
2023-11-12 16:37:38 +00:00
|
|
|
|
(extras (get mode 'derived-mode-extra-parents))
|
|
|
|
|
(all-parents
|
|
|
|
|
(merge-ordered-lists
|
|
|
|
|
(cons (if (and parent (not (memq parent extras)))
|
|
|
|
|
(funcall get-all-parents parent))
|
|
|
|
|
(mapcar get-all-parents extras)))))
|
|
|
|
|
;; Cache the result unless it was affected by `known-children'
|
|
|
|
|
;; because of a cycle.
|
|
|
|
|
(if (and (memq mode all-parents) known-children)
|
|
|
|
|
(cons mode (remq mode all-parents))
|
|
|
|
|
(put mode 'derived-mode--all-parents (cons mode all-parents))))))))
|
2023-11-08 16:32:27 +00:00
|
|
|
|
|
2023-11-16 22:21:18 +00:00
|
|
|
|
(defun provided-mode-derived-p (mode &optional modes &rest old-modes)
|
|
|
|
|
"Non-nil if MODE is derived from a mode that is a member of the list MODES.
|
|
|
|
|
MODES can also be a single mode instead of a list.
|
2024-01-05 07:38:58 +00:00
|
|
|
|
This examines the parent modes set by `define-derived-mode' and also
|
|
|
|
|
additional ones set by `derived-mode-add-parents'.
|
|
|
|
|
If you just want to check the current `major-mode', use `derived-mode-p'.
|
2023-11-16 22:21:18 +00:00
|
|
|
|
We also still support the deprecated calling convention:
|
|
|
|
|
\(provided-mode-derived-p MODE &rest MODES)."
|
|
|
|
|
(declare (side-effect-free t)
|
|
|
|
|
(advertised-calling-convention (mode modes) "30.1"))
|
|
|
|
|
(cond
|
|
|
|
|
(old-modes (setq modes (cons modes old-modes)))
|
|
|
|
|
((not (listp modes)) (setq modes (list modes))))
|
2023-11-08 16:32:27 +00:00
|
|
|
|
(let ((ps (derived-mode-all-parents mode)))
|
2023-11-12 16:37:38 +00:00
|
|
|
|
(while (and modes (not (memq (car modes) ps)))
|
|
|
|
|
(setq modes (cdr modes)))
|
|
|
|
|
(car modes)))
|
2017-03-19 16:52:28 +00:00
|
|
|
|
|
2023-11-16 22:21:18 +00:00
|
|
|
|
(defun derived-mode-p (&optional modes &rest old-modes)
|
2024-01-05 07:38:58 +00:00
|
|
|
|
"Return non-nil if the current major mode is derived from one of MODES.
|
2023-11-16 22:21:18 +00:00
|
|
|
|
MODES should be a list of symbols or a single mode symbol instead of a list.
|
2024-01-05 07:38:58 +00:00
|
|
|
|
This examines the parent modes set by `define-derived-mode' and also
|
|
|
|
|
additional ones set by `derived-mode-add-parents'.
|
2023-11-16 22:21:18 +00:00
|
|
|
|
We also still support the deprecated calling convention:
|
|
|
|
|
\(derived-mode-p &rest MODES)."
|
|
|
|
|
(declare (side-effect-free t)
|
2023-12-16 18:03:46 +00:00
|
|
|
|
;; FIXME: It's cumbersome for external packages to write code which
|
|
|
|
|
;; accommodates both the old and the new calling conventions *and*
|
|
|
|
|
;; doesn't cause spurious warnings. So let's be more lenient
|
|
|
|
|
;; for now and maybe remove `deprecated-args' for Emacs-31.
|
|
|
|
|
(advertised-calling-convention (modes &rest deprecated-args) "30.1"))
|
2023-11-16 22:21:18 +00:00
|
|
|
|
(provided-mode-derived-p major-mode (if old-modes (cons modes old-modes)
|
|
|
|
|
modes)))
|
2018-06-22 03:30:11 +00:00
|
|
|
|
|
2023-11-08 16:32:27 +00:00
|
|
|
|
(defun derived-mode-set-parent (mode parent)
|
|
|
|
|
"Declare PARENT to be the parent of MODE."
|
2023-11-08 19:20:09 +00:00
|
|
|
|
(put mode 'derived-mode-parent parent)
|
|
|
|
|
(derived-mode--flush mode))
|
2023-11-06 21:57:05 +00:00
|
|
|
|
|
|
|
|
|
(defun derived-mode-add-parents (mode extra-parents)
|
|
|
|
|
"Add EXTRA-PARENTS to the parents of MODE.
|
|
|
|
|
Declares the parents of MODE to be its main parent (as defined
|
2024-01-05 07:38:58 +00:00
|
|
|
|
in `define-derived-mode') plus EXTRA-PARENTS, which should be a list
|
|
|
|
|
of symbols."
|
2023-11-06 21:57:05 +00:00
|
|
|
|
(put mode 'derived-mode-extra-parents extra-parents)
|
|
|
|
|
(derived-mode--flush mode))
|
2023-11-08 19:20:09 +00:00
|
|
|
|
|
|
|
|
|
(defun derived-mode--flush (mode)
|
|
|
|
|
(put mode 'derived-mode--all-parents nil)
|
|
|
|
|
(let ((followers (get mode 'derived-mode--followers)))
|
|
|
|
|
(when followers ;; Common case.
|
|
|
|
|
(put mode 'derived-mode--followers nil)
|
|
|
|
|
(mapc #'derived-mode--flush followers))))
|
2023-11-08 16:32:27 +00:00
|
|
|
|
|
2018-06-22 03:30:11 +00:00
|
|
|
|
(defvar-local major-mode--suspended nil)
|
|
|
|
|
(put 'major-mode--suspended 'permanent-local t)
|
|
|
|
|
|
|
|
|
|
(defun major-mode-suspend ()
|
2019-09-15 18:37:26 +00:00
|
|
|
|
"Exit current major mode, remembering it."
|
2018-06-22 03:30:11 +00:00
|
|
|
|
(let* ((prev-major-mode (or major-mode--suspended
|
|
|
|
|
(unless (eq major-mode 'fundamental-mode)
|
|
|
|
|
major-mode))))
|
|
|
|
|
(kill-all-local-variables)
|
|
|
|
|
(setq-local major-mode--suspended prev-major-mode)))
|
|
|
|
|
|
|
|
|
|
(defun major-mode-restore (&optional avoided-modes)
|
|
|
|
|
"Restore major mode earlier suspended with `major-mode-suspend'.
|
|
|
|
|
If there was no earlier suspended major mode, then fallback to `normal-mode',
|
2022-11-20 11:59:39 +00:00
|
|
|
|
though trying to avoid AVOIDED-MODES."
|
2018-06-22 03:30:11 +00:00
|
|
|
|
(if major-mode--suspended
|
|
|
|
|
(funcall (prog1 major-mode--suspended
|
|
|
|
|
(kill-local-variable 'major-mode--suspended)))
|
|
|
|
|
(let ((auto-mode-alist
|
|
|
|
|
(let ((alist (copy-sequence auto-mode-alist)))
|
|
|
|
|
(dolist (mode avoided-modes)
|
|
|
|
|
(setq alist (rassq-delete-all mode alist)))
|
|
|
|
|
alist))
|
|
|
|
|
(magic-fallback-mode-alist
|
|
|
|
|
(let ((alist (copy-sequence magic-fallback-mode-alist)))
|
|
|
|
|
(dolist (mode avoided-modes)
|
|
|
|
|
(setq alist (rassq-delete-all mode alist)))
|
|
|
|
|
alist)))
|
|
|
|
|
(normal-mode))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Minor modes.
|
|
|
|
|
|
|
|
|
|
;; If a minor mode is not defined with define-minor-mode,
|
|
|
|
|
;; add it here explicitly.
|
|
|
|
|
;; isearch-mode is deliberately excluded, since you should
|
|
|
|
|
;; not call it yourself.
|
|
|
|
|
(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
|
|
|
|
|
overwrite-mode view-mode
|
|
|
|
|
hs-minor-mode)
|
|
|
|
|
"List of all minor mode functions.")
|
|
|
|
|
|
|
|
|
|
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
|
|
|
|
|
"Register a new minor mode.
|
|
|
|
|
|
2021-02-13 11:46:34 +00:00
|
|
|
|
This function shouldn't be used directly -- use `define-minor-mode'
|
|
|
|
|
instead (which will then call this function).
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
2019-11-04 02:36:05 +00:00
|
|
|
|
TOGGLE is a symbol that is the name of a buffer-local variable that
|
2005-10-22 15:01:08 +00:00
|
|
|
|
is toggled on or off to say whether the minor mode is active or not.
|
|
|
|
|
|
|
|
|
|
NAME specifies what will appear in the mode line when the minor mode
|
|
|
|
|
is active. NAME should be either a string starting with a space, or a
|
|
|
|
|
symbol whose value is such a string.
|
|
|
|
|
|
|
|
|
|
Optional KEYMAP is the keymap for the minor mode that will be added
|
|
|
|
|
to `minor-mode-map-alist'.
|
|
|
|
|
|
|
|
|
|
Optional AFTER specifies that TOGGLE should be added after AFTER
|
|
|
|
|
in `minor-mode-alist'.
|
|
|
|
|
|
|
|
|
|
Optional TOGGLE-FUN is an interactive function to toggle the mode.
|
|
|
|
|
It defaults to (and should by convention be) TOGGLE.
|
|
|
|
|
|
|
|
|
|
If TOGGLE has a non-nil `:included' property, an entry for the mode is
|
|
|
|
|
included in the mode-line minor mode menu.
|
|
|
|
|
If TOGGLE has a `:menu-tag', that is used for the menu item's label."
|
|
|
|
|
(unless (memq toggle minor-mode-list)
|
|
|
|
|
(push toggle minor-mode-list))
|
|
|
|
|
|
|
|
|
|
(unless toggle-fun (setq toggle-fun toggle))
|
|
|
|
|
(unless (eq toggle-fun toggle)
|
|
|
|
|
(put toggle :minor-mode-function toggle-fun))
|
|
|
|
|
;; Add the name to the minor-mode-alist.
|
|
|
|
|
(when name
|
|
|
|
|
(let ((existing (assq toggle minor-mode-alist)))
|
|
|
|
|
(if existing
|
|
|
|
|
(setcdr existing (list name))
|
|
|
|
|
(let ((tail minor-mode-alist) found)
|
|
|
|
|
(while (and tail (not found))
|
|
|
|
|
(if (eq after (caar tail))
|
|
|
|
|
(setq found tail)
|
|
|
|
|
(setq tail (cdr tail))))
|
|
|
|
|
(if found
|
|
|
|
|
(let ((rest (cdr found)))
|
|
|
|
|
(setcdr found nil)
|
|
|
|
|
(nconc found (list (list toggle name)) rest))
|
2010-05-05 04:27:16 +00:00
|
|
|
|
(push (list toggle name) minor-mode-alist))))))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; Add the toggle to the minor-modes menu if requested.
|
|
|
|
|
(when (get toggle :included)
|
|
|
|
|
(define-key mode-line-mode-menu
|
|
|
|
|
(vector toggle)
|
|
|
|
|
(list 'menu-item
|
|
|
|
|
(concat
|
|
|
|
|
(or (get toggle :menu-tag)
|
|
|
|
|
(if (stringp name) name (symbol-name toggle)))
|
|
|
|
|
(let ((mode-name (if (symbolp name) (symbol-value name))))
|
|
|
|
|
(if (and (stringp mode-name) (string-match "[^ ]+" mode-name))
|
|
|
|
|
(concat " (" (match-string 0 mode-name) ")"))))
|
|
|
|
|
toggle-fun
|
|
|
|
|
:button (cons :toggle toggle))))
|
2005-06-13 21:29:52 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; Add the map to the minor-mode-map-alist.
|
|
|
|
|
(when keymap
|
|
|
|
|
(let ((existing (assq toggle minor-mode-map-alist)))
|
|
|
|
|
(if existing
|
|
|
|
|
(setcdr existing keymap)
|
|
|
|
|
(let ((tail minor-mode-map-alist) found)
|
|
|
|
|
(while (and tail (not found))
|
|
|
|
|
(if (eq after (caar tail))
|
|
|
|
|
(setq found tail)
|
|
|
|
|
(setq tail (cdr tail))))
|
|
|
|
|
(if found
|
|
|
|
|
(let ((rest (cdr found)))
|
|
|
|
|
(setcdr found nil)
|
|
|
|
|
(nconc found (list (cons toggle keymap)) rest))
|
2010-05-05 04:27:16 +00:00
|
|
|
|
(push (cons toggle keymap) minor-mode-map-alist)))))))
|
2001-10-09 11:14:31 +00:00
|
|
|
|
|
2013-06-05 14:57:45 +00:00
|
|
|
|
;;;; Load history
|
2001-10-09 11:14:31 +00:00
|
|
|
|
|
2012-07-26 01:27:33 +00:00
|
|
|
|
(defsubst autoloadp (object)
|
|
|
|
|
"Non-nil if OBJECT is an autoload."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2012-07-26 01:27:33 +00:00
|
|
|
|
(eq 'autoload (car-safe object)))
|
|
|
|
|
|
|
|
|
|
;; (defun autoload-type (object)
|
|
|
|
|
;; "Returns the type of OBJECT or `function' or `command' if the type is nil.
|
|
|
|
|
;; OBJECT should be an autoload object."
|
|
|
|
|
;; (when (autoloadp object)
|
|
|
|
|
;; (let ((type (nth 3 object)))
|
|
|
|
|
;; (cond ((null type) (if (nth 2 object) 'command 'function))
|
|
|
|
|
;; ((eq 'keymap t) 'macro)
|
|
|
|
|
;; (type)))))
|
|
|
|
|
|
|
|
|
|
;; (defalias 'autoload-file #'cadr
|
|
|
|
|
;; "Return the name of the file from which AUTOLOAD will be loaded.
|
|
|
|
|
;; \n\(fn AUTOLOAD)")
|
|
|
|
|
|
2017-07-28 16:02:01 +00:00
|
|
|
|
(defun define-symbol-prop (symbol prop val)
|
|
|
|
|
"Define the property PROP of SYMBOL to be VAL.
|
|
|
|
|
This is to `put' what `defalias' is to `fset'."
|
|
|
|
|
;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)).
|
|
|
|
|
;; (cl-pushnew symbol (alist-get prop
|
|
|
|
|
;; (alist-get 'define-symbol-props
|
|
|
|
|
;; current-load-list)))
|
|
|
|
|
(let ((sps (assq 'define-symbol-props current-load-list)))
|
|
|
|
|
(unless sps
|
|
|
|
|
(setq sps (list 'define-symbol-props))
|
|
|
|
|
(push sps current-load-list))
|
|
|
|
|
(let ((ps (assq prop sps)))
|
|
|
|
|
(unless ps
|
|
|
|
|
(setq ps (list prop))
|
|
|
|
|
(setcdr sps (cons ps (cdr sps))))
|
|
|
|
|
(unless (member symbol (cdr ps))
|
|
|
|
|
(setcdr ps (cons symbol (cdr ps))))))
|
|
|
|
|
(put symbol prop val))
|
|
|
|
|
|
2022-08-03 14:16:09 +00:00
|
|
|
|
(defvar comp-native-version-dir)
|
|
|
|
|
(defvar native-comp-eln-load-path)
|
|
|
|
|
(declare-function subr-native-elisp-p "data.c")
|
|
|
|
|
(declare-function native-comp-unit-file "data.c")
|
|
|
|
|
(declare-function subr-native-comp-unit "data.c")
|
|
|
|
|
(declare-function comp-el-to-eln-rel-filename "comp.c")
|
|
|
|
|
|
|
|
|
|
(defun locate-eln-file (eln-file)
|
|
|
|
|
"Locate a natively-compiled ELN-FILE by searching its load path.
|
|
|
|
|
This function looks in directories named by `native-comp-eln-load-path'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2022-08-03 14:16:09 +00:00
|
|
|
|
(or (locate-file-internal (concat comp-native-version-dir "/" eln-file)
|
|
|
|
|
native-comp-eln-load-path)
|
|
|
|
|
(locate-file-internal
|
|
|
|
|
;; Preloaded *.eln files live in the preloaded/ subdirectory of
|
|
|
|
|
;; the last entry in `native-comp-eln-load-path'.
|
|
|
|
|
(concat comp-native-version-dir "/preloaded/" eln-file)
|
|
|
|
|
(last native-comp-eln-load-path))))
|
|
|
|
|
|
|
|
|
|
(defun symbol-file (symbol &optional type native-p)
|
2008-09-06 10:02:33 +00:00
|
|
|
|
"Return the name of the file that defined SYMBOL.
|
|
|
|
|
The value is normally an absolute file name. It can also be nil,
|
|
|
|
|
if the definition is not associated with any file. If SYMBOL
|
|
|
|
|
specifies an autoloaded function, the value can be a relative
|
|
|
|
|
file name without extension.
|
|
|
|
|
|
2022-08-03 14:16:09 +00:00
|
|
|
|
If TYPE is nil, then any kind of SYMBOL's definition is acceptable.
|
|
|
|
|
If TYPE is `defun', `defvar', or `defface', that specifies function
|
2017-07-28 16:02:01 +00:00
|
|
|
|
definition, variable definition, or face definition only.
|
2021-05-30 06:25:18 +00:00
|
|
|
|
Otherwise TYPE is assumed to be a symbol property.
|
|
|
|
|
|
2022-08-03 14:16:09 +00:00
|
|
|
|
If NATIVE-P is non-nil, and SYMBOL was loaded from a .eln file,
|
|
|
|
|
this function will return the absolute file name of that .eln file,
|
|
|
|
|
if found. Note that if the .eln file is older than its source .el
|
|
|
|
|
file, Emacs won't load such an outdated .eln file, and this function
|
|
|
|
|
will not return it. If the .eln file couldn't be found, or is
|
|
|
|
|
outdated, the function returns the corresponding .elc or .el file
|
|
|
|
|
instead.
|
|
|
|
|
|
2021-05-30 06:25:18 +00:00
|
|
|
|
This function only works for symbols defined in Lisp files. For
|
|
|
|
|
symbols that are defined in C files, use `help-C-file-name'
|
|
|
|
|
instead."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2004-12-27 16:23:34 +00:00
|
|
|
|
(if (and (or (null type) (eq type 'defun))
|
2014-01-06 23:34:05 +00:00
|
|
|
|
(symbolp symbol)
|
2012-07-26 01:27:33 +00:00
|
|
|
|
(autoloadp (symbol-function symbol)))
|
2004-12-27 16:23:34 +00:00
|
|
|
|
(nth 1 (symbol-function symbol))
|
2022-08-03 14:16:09 +00:00
|
|
|
|
(if (and native-p (or (null type) (eq type 'defun))
|
|
|
|
|
(symbolp symbol)
|
|
|
|
|
(native-comp-available-p)
|
|
|
|
|
;; If it's a defun, we have a shortcut.
|
|
|
|
|
(subr-native-elisp-p (symbol-function symbol)))
|
|
|
|
|
;; native-comp-unit-file returns unnormalized file names.
|
|
|
|
|
(expand-file-name (native-comp-unit-file (subr-native-comp-unit
|
|
|
|
|
(symbol-function symbol))))
|
|
|
|
|
(let ((elc-file
|
|
|
|
|
(catch 'found
|
|
|
|
|
(pcase-dolist (`(,file . ,elems) load-history)
|
|
|
|
|
(when (if type
|
|
|
|
|
(if (eq type 'defvar)
|
|
|
|
|
;; Variables are present just as their
|
|
|
|
|
;; names.
|
|
|
|
|
(member symbol elems)
|
|
|
|
|
;; Many other types are represented as
|
|
|
|
|
;; (TYPE . NAME).
|
|
|
|
|
(or (member (cons type symbol) elems)
|
|
|
|
|
(memq
|
|
|
|
|
symbol
|
|
|
|
|
(alist-get type
|
|
|
|
|
(alist-get 'define-symbol-props
|
|
|
|
|
elems)))))
|
|
|
|
|
;; We accept all types, so look for variable def
|
|
|
|
|
;; and then for any other kind.
|
|
|
|
|
(or (member symbol elems)
|
|
|
|
|
(let ((match (rassq symbol elems)))
|
|
|
|
|
(and match
|
|
|
|
|
(not (eq 'require (car match)))))))
|
|
|
|
|
(throw 'found file))))))
|
|
|
|
|
;; If they asked for the .eln file, try to find it.
|
|
|
|
|
(or (and elc-file
|
|
|
|
|
native-p
|
|
|
|
|
(native-comp-available-p)
|
|
|
|
|
(let* ((sans-ext (file-name-sans-extension elc-file))
|
|
|
|
|
(el-file
|
|
|
|
|
(and (fboundp 'zlib-available-p)
|
|
|
|
|
(zlib-available-p)
|
|
|
|
|
(concat sans-ext ".el.gz")))
|
|
|
|
|
(el-file-backup (concat sans-ext ".el")))
|
|
|
|
|
(or (and el-file (file-exists-p el-file))
|
|
|
|
|
(and (file-exists-p el-file-backup)
|
|
|
|
|
(setq el-file el-file-backup))
|
|
|
|
|
(setq el-file nil))
|
|
|
|
|
(when (stringp el-file)
|
|
|
|
|
(let ((eln-file (locate-eln-file
|
|
|
|
|
(comp-el-to-eln-rel-filename el-file))))
|
|
|
|
|
;; Emacs will not load an outdated .eln file,
|
|
|
|
|
;; so we mimic this behavior here.
|
|
|
|
|
(if (file-newer-than-file-p eln-file el-file)
|
|
|
|
|
eln-file)))))
|
|
|
|
|
elc-file)))))
|
2001-10-09 11:14:31 +00:00
|
|
|
|
|
2020-04-12 16:20:41 +00:00
|
|
|
|
(declare-function read-library-name "find-func" nil)
|
|
|
|
|
|
2005-10-28 16:55:48 +00:00
|
|
|
|
(defun locate-library (library &optional nosuffix path interactive-call)
|
|
|
|
|
"Show the precise file name of Emacs library LIBRARY.
|
2009-02-13 15:19:06 +00:00
|
|
|
|
LIBRARY should be a relative file name of the library, a string.
|
|
|
|
|
It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is
|
|
|
|
|
nil (which is the default, see below).
|
2024-01-21 13:09:21 +00:00
|
|
|
|
This command searches the directories in `load-path' like \\[load-library]
|
2005-10-28 16:55:48 +00:00
|
|
|
|
to find the file that `\\[load-library] RET LIBRARY RET' would load.
|
|
|
|
|
Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
|
|
|
|
|
to the specified name LIBRARY.
|
|
|
|
|
|
|
|
|
|
If the optional third arg PATH is specified, that list of directories
|
|
|
|
|
is used instead of `load-path'.
|
|
|
|
|
|
2008-06-10 03:10:06 +00:00
|
|
|
|
When called from a program, the file name is normally returned as a
|
2005-10-28 16:55:48 +00:00
|
|
|
|
string. When run interactively, the argument INTERACTIVE-CALL is t,
|
|
|
|
|
and the file name is displayed in the echo area."
|
2020-03-28 21:16:28 +00:00
|
|
|
|
(interactive (list (read-library-name) nil nil t))
|
2005-10-28 16:55:48 +00:00
|
|
|
|
(let ((file (locate-file library
|
|
|
|
|
(or path load-path)
|
2006-02-27 02:01:08 +00:00
|
|
|
|
(append (unless nosuffix (get-load-suffixes))
|
|
|
|
|
load-file-rep-suffixes))))
|
2005-10-28 16:55:48 +00:00
|
|
|
|
(if interactive-call
|
|
|
|
|
(if file
|
|
|
|
|
(message "Library is file %s" (abbreviate-file-name file))
|
|
|
|
|
(message "No library %s in search path" library)))
|
|
|
|
|
file))
|
|
|
|
|
|
2002-05-30 17:12:53 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Process stuff.
|
|
|
|
|
|
2015-03-23 03:40:29 +00:00
|
|
|
|
(defun start-process (name buffer program &rest program-args)
|
|
|
|
|
"Start a program in a subprocess. Return the process object for it.
|
|
|
|
|
NAME is name for process. It is modified if necessary to make it unique.
|
|
|
|
|
BUFFER is the buffer (or buffer name) to associate with the process.
|
|
|
|
|
|
2018-02-06 00:36:27 +00:00
|
|
|
|
Process output (both standard output and standard error streams)
|
|
|
|
|
goes at end of BUFFER, unless you specify a filter function to
|
|
|
|
|
handle the output. BUFFER may also be nil, meaning that this
|
|
|
|
|
process is not associated with any buffer.
|
2015-03-23 03:40:29 +00:00
|
|
|
|
|
|
|
|
|
PROGRAM is the program file name. It is searched for in `exec-path'
|
|
|
|
|
\(which see). If nil, just associate a pty with the buffer. Remaining
|
2016-10-18 06:24:05 +00:00
|
|
|
|
arguments PROGRAM-ARGS are strings to give program as arguments.
|
2015-03-23 03:40:29 +00:00
|
|
|
|
|
2015-04-07 08:42:09 +00:00
|
|
|
|
If you want to separate standard output from standard error, use
|
|
|
|
|
`make-process' or invoke the command through a shell and redirect
|
2017-04-02 03:15:46 +00:00
|
|
|
|
one of them using the shell syntax.
|
|
|
|
|
|
|
|
|
|
The process runs in `default-directory' if that is local (as
|
|
|
|
|
determined by `unhandled-file-name-directory'), or \"~\"
|
|
|
|
|
otherwise. If you want to run a process in a remote directory
|
|
|
|
|
use `start-file-process'."
|
2015-03-23 03:40:29 +00:00
|
|
|
|
(unless (fboundp 'make-process)
|
|
|
|
|
(error "Emacs was compiled without subprocess support"))
|
|
|
|
|
(apply #'make-process
|
|
|
|
|
(append (list :name name :buffer buffer)
|
|
|
|
|
(if program
|
|
|
|
|
(list :command (cons program program-args))))))
|
|
|
|
|
|
2020-09-19 22:16:36 +00:00
|
|
|
|
(defun process-lines-handling-status (program status-handler &rest args)
|
2007-11-17 03:42:22 +00:00
|
|
|
|
"Execute PROGRAM with ARGS, returning its output as a list of lines.
|
2021-02-28 16:29:05 +00:00
|
|
|
|
If STATUS-HANDLER is non-nil, it must be a function with one
|
2020-09-19 22:16:36 +00:00
|
|
|
|
argument, which will be called with the exit status of the
|
|
|
|
|
program before the output is collected. If STATUS-HANDLER is
|
2021-02-28 16:29:05 +00:00
|
|
|
|
nil, an error is signaled if the program returns with a non-zero
|
2020-09-19 22:16:36 +00:00
|
|
|
|
exit status."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2007-11-17 03:42:22 +00:00
|
|
|
|
(with-temp-buffer
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(let ((status (apply #'call-process program nil (current-buffer) nil args)))
|
2020-09-19 22:16:36 +00:00
|
|
|
|
(if status-handler
|
|
|
|
|
(funcall status-handler status)
|
|
|
|
|
(unless (eq status 0)
|
|
|
|
|
(error "%s exited with status %s" program status)))
|
2007-11-17 03:42:22 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(let (lines)
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(setq lines (cons (buffer-substring-no-properties
|
|
|
|
|
(line-beginning-position)
|
|
|
|
|
(line-end-position))
|
|
|
|
|
lines))
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(nreverse lines)))))
|
|
|
|
|
|
2020-09-19 22:16:36 +00:00
|
|
|
|
(defun process-lines (program &rest args)
|
|
|
|
|
"Execute PROGRAM with ARGS, returning its output as a list of lines.
|
|
|
|
|
Signal an error if the program returns with a non-zero exit status.
|
|
|
|
|
Also see `process-lines-ignore-status'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2020-09-19 22:16:36 +00:00
|
|
|
|
(apply #'process-lines-handling-status program nil args))
|
|
|
|
|
|
|
|
|
|
(defun process-lines-ignore-status (program &rest args)
|
|
|
|
|
"Execute PROGRAM with ARGS, returning its output as a list of lines.
|
|
|
|
|
The exit status of the program is ignored.
|
|
|
|
|
Also see `process-lines'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2021-02-28 16:29:05 +00:00
|
|
|
|
(apply #'process-lines-handling-status program #'ignore args))
|
2020-09-19 22:16:36 +00:00
|
|
|
|
|
2011-06-15 17:30:41 +00:00
|
|
|
|
(defun process-live-p (process)
|
lisp/*.el: Fix typos and improve some docstrings
* lisp/auth-source.el (auth-source-backend-parse-parameters)
(auth-source-search-collection)
(auth-source-secrets-listify-pattern)
(auth-source--decode-octal-string, auth-source-plstore-search):
* lisp/registry.el (registry-lookup)
(registry-lookup-breaks-before-lexbind)
(registry-lookup-secondary, registry-lookup-secondary-value)
(registry-search, registry-delete, registry-size, registry-full)
(registry-insert, registry-reindex, registry-prune)
(registry-collect-prune-candidates):
* lisp/subr.el (nbutlast, process-live-p):
* lisp/tab-bar.el (tab-bar-list):
* lisp/cedet/ede/linux.el (ede-linux--get-archs)
(ede-linux--include-path, ede-linux-load):
* lisp/erc/erc-log.el (erc-log-all-but-server-buffers):
* lisp/erc/erc-pcomplete.el (pcomplete-erc-commands)
(pcomplete-erc-ops, pcomplete-erc-not-ops, pcomplete-erc-nicks)
(pcomplete-erc-all-nicks, pcomplete-erc-channels)
(pcomplete-erc-command-name, pcomplete-erc-parse-arguments):
* lisp/eshell/em-term.el (eshell-visual-command-p):
* lisp/gnus/gnus-cache.el (gnus-cache-fully-p):
* lisp/gnus/nnmail.el (nnmail-get-active)
(nnmail-fancy-expiry-target):
* lisp/mail/mail-utils.el (mail-string-delete):
* lisp/mail/supercite.el (sc-hdr, sc-valid-index-p):
* lisp/net/ange-ftp.el (ange-ftp-use-smart-gateway-p):
* lisp/net/nsm.el (nsm-save-fingerprint-maybe)
(nsm-network-same-subnet, nsm-should-check):
* lisp/net/rcirc.el (rcirc-looking-at-input):
* lisp/net/tramp-cache.el (tramp-get-hash-table):
* lisp/net/tramp-compat.el (tramp-compat-process-running-p):
* lisp/net/tramp-smb.el (tramp-smb-get-share)
(tramp-smb-get-localname, tramp-smb-read-file-entry)
(tramp-smb-get-cifs-capabilities, tramp-smb-get-stat-capability):
* lisp/net/zeroconf.el (zeroconf-list-service-names)
(zeroconf-list-service-types, zeroconf-list-services)
(zeroconf-get-host, zeroconf-get-domain)
(zeroconf-get-host-domain):
* lisp/nxml/rng-xsd.el (rng-xsd-compile)
(rng-xsd-make-date-time-regexp, rng-xsd-convert-date-time):
* lisp/obsolete/erc-hecomplete.el (erc-hecomplete)
(erc-command-list, erc-complete-at-prompt):
* lisp/org/ob-scheme.el (org-babel-scheme-get-buffer-impl):
* lisp/org/ob-shell.el (org-babel--variable-assignments:sh-generic)
(org-babel--variable-assignments:bash_array)
(org-babel--variable-assignments:bash_assoc)
(org-babel--variable-assignments:bash):
* lisp/org/org-clock.el (org-day-of-week):
* lisp/progmodes/cperl-mode.el (cperl-char-ends-sub-keyword-p):
* lisp/progmodes/gud.el (gud-find-c-expr, gud-innermost-expr)
(gud-prev-expr, gud-next-expr):
* lisp/textmodes/table.el (table--at-cell-p, table--probe-cell)
(table--get-cell-justify-property)
(table--get-cell-valign-property)
(table--put-cell-justify-property)
(table--put-cell-valign-property): Fix typos.
* lisp/so-long.el (fboundp): Doc fix.
(so-long-mode-line-info, so-long-mode)
(so-long--check-header-modes): Fix typos.
* lisp/emulation/viper-mous.el (viper-surrounding-word)
(viper-mouse-click-get-word): Fix typos.
(viper-mouse-click-search-word): Doc fix.
* lisp/erc/erc-backend.el (erc-forward-word, erc-word-at-arg-p)
(erc-bounds-of-word-at-point): Fix typos.
(erc-decode-string-from-target, define-erc-response-handler):
Refill docstring.
* lisp/erc/erc-dcc.el (pcomplete/erc-mode/DCC): Fix typo.
(erc-dcc-get-host, erc-dcc-auto-mask-p, erc-dcc-get-file):
Doc fixes.
* lisp/erc/erc-networks.el (erc-network-name): Fix typo.
(erc-determine-network): Refill docstring.
* lisp/net/dbus.el (dbus-list-hash-table)
(dbus-string-to-byte-array, dbus-byte-array-to-string)
(dbus-check-event): Fix typos.
(dbus-introspect-get-property): Doc fix.
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler):
Rename ARGS to ARGUMENTS. Doc fix.
(tramp-adb-sh-fix-ls-output, tramp-adb-execute-adb-command)
(tramp-adb-find-test-command): Fix typos.
* lisp/net/tramp.el (tramp-set-completion-function)
(tramp-get-completion-function)
(tramp-completion-dissect-file-name)
(tramp-completion-dissect-file-name1)
(tramp-get-completion-methods, tramp-get-completion-user-host)
(tramp-get-inode, tramp-get-device, tramp-mode-string-to-int)
(tramp-call-process, tramp-call-process-region)
(tramp-process-lines): Fix typos.
(tramp-interrupt-process): Doc fix.
* lisp/org/ob-core.el (org-babel-named-src-block-regexp-for-name)
(org-babel-named-data-regexp-for-name): Doc fix.
(org-babel-src-block-names, org-babel-result-names): Fix typos.
* lisp/progmodes/inf-lisp.el (lisp-input-filter): Doc fix.
(lisp-fn-called-at-pt): Fix typo.
* lisp/progmodes/xref.el (xref-backend-identifier-at-point):
Doc fix.
(xref-backend-identifier-completion-table): Fix typo.
2019-10-20 10:12:27 +00:00
|
|
|
|
"Return non-nil if PROCESS is alive.
|
2011-05-31 18:40:00 +00:00
|
|
|
|
A process is considered alive if its status is `run', `open',
|
2013-12-02 07:13:01 +00:00
|
|
|
|
`listen', `connect' or `stop'. Value is nil if PROCESS is not a
|
|
|
|
|
process."
|
|
|
|
|
(and (processp process)
|
|
|
|
|
(memq (process-status process)
|
|
|
|
|
'(run open listen connect stop))))
|
2011-05-31 18:40:00 +00:00
|
|
|
|
|
2009-07-18 21:06:04 +00:00
|
|
|
|
(defun process-kill-buffer-query-function ()
|
|
|
|
|
"Ask before killing a buffer that has a running process."
|
|
|
|
|
(let ((process (get-buffer-process (current-buffer))))
|
|
|
|
|
(or (not process)
|
|
|
|
|
(not (memq (process-status process) '(run stop open listen)))
|
|
|
|
|
(not (process-query-on-exit-flag process))
|
2011-09-11 03:35:02 +00:00
|
|
|
|
(yes-or-no-p
|
|
|
|
|
(format "Buffer %S has a running process; kill it? "
|
|
|
|
|
(buffer-name (current-buffer)))))))
|
2009-07-18 21:06:04 +00:00
|
|
|
|
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(add-hook 'kill-buffer-query-functions #'process-kill-buffer-query-function)
|
2009-07-18 21:06:04 +00:00
|
|
|
|
|
2003-01-14 09:56:10 +00:00
|
|
|
|
;; process plist management
|
|
|
|
|
|
|
|
|
|
(defun process-get (process propname)
|
|
|
|
|
"Return the value of PROCESS' PROPNAME property.
|
|
|
|
|
This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2003-01-14 09:56:10 +00:00
|
|
|
|
(plist-get (process-plist process) propname))
|
|
|
|
|
|
|
|
|
|
(defun process-put (process propname value)
|
|
|
|
|
"Change PROCESS' PROPNAME property to VALUE.
|
|
|
|
|
It can be retrieved with `(process-get PROCESS PROPNAME)'."
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(set-process-plist process
|
2003-01-14 09:56:10 +00:00
|
|
|
|
(plist-put (process-plist process) propname value)))
|
|
|
|
|
|
2018-06-16 15:11:37 +00:00
|
|
|
|
(defun memory-limit ()
|
|
|
|
|
"Return an estimate of Emacs virtual memory usage, divided by 1024."
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function () integer))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(side-effect-free error-free))
|
2022-04-08 10:47:53 +00:00
|
|
|
|
(let ((default-directory temporary-file-directory))
|
|
|
|
|
(or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0)))
|
2018-06-16 15:11:37 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
|
|
|
|
;;;; Input and display facilities.
|
|
|
|
|
|
2021-01-02 22:10:17 +00:00
|
|
|
|
;; The following maps are used by `read-key' to remove all key
|
|
|
|
|
;; bindings while calling `read-key-sequence'. This way the keys
|
|
|
|
|
;; returned are independent of the key binding state.
|
|
|
|
|
|
|
|
|
|
(defconst read-key-empty-map (make-sparse-keymap)
|
|
|
|
|
"Used internally by `read-key'.")
|
|
|
|
|
|
|
|
|
|
(defconst read-key-full-map
|
|
|
|
|
(let ((map (make-sparse-keymap)))
|
2022-02-22 15:18:43 +00:00
|
|
|
|
(define-key map [t] #'ignore) ;Dummy binding.
|
2021-01-02 22:10:17 +00:00
|
|
|
|
|
|
|
|
|
;; ESC needs to be unbound so that escape sequences in
|
|
|
|
|
;; `input-decode-map' are still processed by `read-key-sequence'.
|
|
|
|
|
(define-key map [?\e] nil)
|
|
|
|
|
map)
|
|
|
|
|
"Used internally by `read-key'.")
|
2009-08-19 03:03:05 +00:00
|
|
|
|
|
2009-10-20 01:29:17 +00:00
|
|
|
|
(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
|
2009-08-19 03:03:05 +00:00
|
|
|
|
|
2021-01-02 22:10:17 +00:00
|
|
|
|
(defun read-key (&optional prompt disable-fallbacks)
|
2009-08-19 03:03:05 +00:00
|
|
|
|
"Read a key from the keyboard.
|
|
|
|
|
Contrary to `read-event' this will not return a raw event but instead will
|
|
|
|
|
obey the input decoding and translations usually done by `read-key-sequence'.
|
|
|
|
|
So escape sequences and keyboard encoding are taken into account.
|
|
|
|
|
When there's an ambiguity because the key looks like the prefix of
|
2021-01-02 22:10:17 +00:00
|
|
|
|
some sort of escape sequence, the ambiguity is resolved via `read-key-delay'.
|
|
|
|
|
|
2023-07-21 13:23:35 +00:00
|
|
|
|
Also in contrast to `read-event', input method text conversion
|
|
|
|
|
will be disabled while the key sequence is read, so that
|
|
|
|
|
character input events will always be generated for keyboard
|
|
|
|
|
input.
|
|
|
|
|
|
2021-01-02 22:10:17 +00:00
|
|
|
|
If the optional argument PROMPT is non-nil, display that as a
|
|
|
|
|
prompt.
|
|
|
|
|
|
|
|
|
|
If the optional argument DISABLE-FALLBACKS is non-nil, all
|
|
|
|
|
unbound fallbacks usually done by `read-key-sequence' are
|
|
|
|
|
disabled such as discarding mouse down events. This is generally
|
|
|
|
|
what you want as `read-key' temporarily removes all bindings
|
|
|
|
|
while calling `read-key-sequence'. If nil or unspecified, the
|
|
|
|
|
only unbound fallback disabled is downcasing of the last event."
|
2012-04-11 18:13:20 +00:00
|
|
|
|
;; This overriding-terminal-local-map binding also happens to
|
|
|
|
|
;; disable quail's input methods, so although read-key-sequence
|
|
|
|
|
;; always inherits the input method, in practice read-key does not
|
|
|
|
|
;; inherit the input method (at least not if it's based on quail).
|
2013-06-05 01:58:43 +00:00
|
|
|
|
(let ((overriding-terminal-local-map nil)
|
2021-01-02 22:10:17 +00:00
|
|
|
|
(overriding-local-map
|
|
|
|
|
;; FIXME: Audit existing uses of `read-key' to see if they
|
|
|
|
|
;; should always specify disable-fallbacks to be more in line
|
|
|
|
|
;; with `read-event'.
|
|
|
|
|
(if disable-fallbacks read-key-full-map read-key-empty-map))
|
2010-08-21 08:56:54 +00:00
|
|
|
|
(echo-keystrokes 0)
|
2009-08-19 03:03:05 +00:00
|
|
|
|
(old-global-map (current-global-map))
|
|
|
|
|
(timer (run-with-idle-timer
|
|
|
|
|
;; Wait long enough that Emacs has the time to receive and
|
|
|
|
|
;; process all the raw events associated with the single-key.
|
|
|
|
|
;; But don't wait too long, or the user may find the delay
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; annoying (or keep hitting more keys, which may then get
|
2009-08-19 03:03:05 +00:00
|
|
|
|
;; lost or misinterpreted).
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; This is relevant only for keys that Emacs perceives as
|
2009-08-19 03:03:05 +00:00
|
|
|
|
;; "prefixes", such as C-x (because of the C-x 8 map in
|
|
|
|
|
;; key-translate-table and the C-x @ map in function-key-map)
|
|
|
|
|
;; or ESC (because of terminal escape sequences in
|
|
|
|
|
;; input-decode-map).
|
|
|
|
|
read-key-delay t
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((keys (this-command-keys-vector)))
|
|
|
|
|
(unless (zerop (length keys))
|
|
|
|
|
;; `keys' is non-empty, so the user has hit at least
|
|
|
|
|
;; one key; there's no point waiting any longer, even
|
|
|
|
|
;; though read-key-sequence thinks we should wait
|
|
|
|
|
;; for more input to decide how to interpret the
|
|
|
|
|
;; current input.
|
|
|
|
|
(throw 'read-key keys)))))))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
2010-08-19 14:37:31 +00:00
|
|
|
|
(use-global-map
|
|
|
|
|
(let ((map (make-sparse-keymap)))
|
Frame-local tab-bar and window-local tab-line.
* etc/NEWS: Add 'tab-bar-mode' and 'global-tab-line-mode'.
* etc/TODO: Remove tab-related items.
* lisp/cus-start.el: Add tab-bar-mode, tab-bar-max-label-size.
* lisp/frame.el (frame-notice-user-settings): handle tab-bar-lines.
* lisp/loadup.el: Load "tab-bar".
* lisp/menu-bar.el (menu-bar-options-save): Add tab-bar-mode.
(menu-bar-showhide-menu): Define showhide-tab-bar.
* lisp/startup.el (tab-bar-images-pixel-height): New defconst.
(command-line): Reset tab-bar-mode.
(x-apply-session-resources): Add "tabBar", "TabBar".
* lisp/subr.el (read-key): Add tab-bar.
* lisp/tab-bar.el: New file.
* lisp/tab-line.el: New file.
* lisp/window.el (window--dump-frame): Add tab-bar-height.
* src/dispextern.h (enum window_part): Add ON_TAB_LINE.
(struct glyph_matrix): Add tab_line_p.
(struct glyph_row): Add tab_line_p.
(MATRIX_TAB_LINE_ROW): New macro.
(MATRIX_FIRST_TEXT_ROW): Handle more mode lines.
(MR_PARTIALLY_VISIBLE_AT_TOP): Add WINDOW_TAB_LINE_HEIGHT.
(MATRIX_TAB_LINE_HEIGHT, CURRENT_TAB_LINE_HEIGHT)
(DESIRED_TAB_LINE_HEIGHT): New macros.
(enum face_id): Add TAB_BAR_FACE_ID and TAB_LINE_FACE_ID.
(struct it): Add tab_line_p.
(tab_bar_item_idx, tab_bar_item_image): New enums.
(DEFAULT_TAB_BAR_LABEL_SIZE, DEFAULT_TAB_BAR_BUTTON_MARGIN)
(DEFAULT_TAB_BAR_BUTTON_RELIEF, DEFAULT_TAB_BAR_IMAGE_HEIGHT):
New constants.
* src/dispnew.c (adjust_glyph_matrix): Use window_wants_tab_line.
(shift_glyph_matrix): Add WINDOW_TAB_LINE_HEIGHT.
(clear_current_matrices, clear_desired_matrices):
Call clear_glyph_matrix on tab_bar_window.
(blank_row): Add WINDOW_TAB_LINE_HEIGHT.
(required_matrix_height): Change 2 to 3.
(fake_current_matrices): Reset tab_line_p.
(adjust_frame_glyphs_for_window_redisplay): Handle tab_bar_window.
Add FRAME_TAB_BAR_HEIGHT and FRAME_TAB_BAR_LINES.
(free_glyphs): Handle tab_bar_window.
(update_frame): Handle tab_bar_window.
(update_window): Handle row->tab_line_p.
(scrolling_window): Change arg type from bool to int.
Change header_line_p to tab_line_p.
(buffer_posn_from_coords): Add window_wants_tab_line.
(mode_line_string): Use MATRIX_TAB_LINE_ROW for part ON_TAB_LINE.
* src/frame.c (frame_default_tab_bar_height): New internal variable.
(adjust_frame_size): Handle tab_bar_window.
(make_frame): Reset tab_bar_redisplayed, tab_bar_resized and
last_tab_bar_item.
(Ftab_bar_pixel_width): New function.
(frame_parms): Add tab-bar-lines.
(gui_figure_window_size): Add new arg tabbar_p.
(syms_of_frame): Add Qtab_bar_size, Qupdate_frame_tab_bar,
Qfree_frame_tab_bar, Qtab_bar_lines, Stab_bar_pixel_width.
Add Qtab_bar_lines to frame_inhibit_implied_resize.
(tab-bar-mode): New variable.
* src/frame.h (GCALIGNED_STRUCT): Add tab_bar_window,
desired_tab_bar_string, current_tab_bar_string.
(GCALIGNED_STRUCT): Add tab_bar_items, last_tab_bar_item,
minimize_tab_bar_window_p, tab_bar_redisplayed, tab_bar_resized,
tab_bar_lines, tab_bar_height, n_tab_bar_rows, n_tab_bar_items.
(fset_tab_bar_items, fset_tab_bar_window)
(fset_current_tab_bar_string, fset_desired_tab_bar_string):
New inlines.
(FRAME_TAB_BAR_LINES, FRAME_TAB_BAR_HEIGHT): New macros.
(FRAME_TOP_MARGIN, FRAME_TOP_MARGIN_HEIGHT):
Use FRAME_TAB_BAR_LINES.
* src/fringe.c (draw_fringe_bitmap_1, update_window_fringes):
Add WINDOW_TAB_LINE_HEIGHT.
* src/gtkutil.c (xg_frame_set_char_size): Add FRAME_TABBAR_WIDTH.
(x_wm_set_size_hint): Add FRAME_TABBAR_WIDTH.
* src/keyboard.c (read_char): Handle Qtab_bar.
(kbd_buffer_get_event): Handle TAB_BAR_EVENT.
(make_lispy_position): Add WINDOW_TAB_LINE_HEIGHT.
Handle TAB_BAR_EVENT.
(tab_bar_items_vector, tab_bar_item_properties, ntab_bar_items):
New internal variables.
(tab_bar_items, process_tab_bar_item, set_prop_tab_bar)
(parse_tab_bar_item, init_tab_bar_items, append_tab_bar_item):
New functions.
(read_char_x_menu_prompt, read_key_sequence): Handle Qtab_bar.
(tab-bar-separator-image-expression): New variable.
* src/keymap.c (syms_of_keymap): Add Qtab_bar and Qtab_line.
* src/menu.c (x_popup_menu_1, Fx_popup_dialog): Handle Qtab_bar.
* src/termhooks.h (enum event_kind): Add TAB_BAR_EVENT.
(GCALIGNED_STRUCT): Add change_tab_bar_height_hook.
* src/w32fns.c (w32_frame_parm_handlers): Add w32_set_tab_bar_lines.
* src/w32term.c (w32_draw_window_cursor): Add WINDOW_TAB_LINE_HEIGHT.
* src/window.c (window_body_height): Add WINDOW_TAB_LINE_HEIGHT.
(Fwindow_tab_line_height): New function.
(coordinates_in_window): Use window_wants_tab_line with
CURRENT_TAB_LINE_HEIGHT.
(window_relative_x_coord): Add ON_TAB_LINE.
(Fcoordinates_in_window_p): Add ON_TAB_LINE.
(window_from_coordinates): Add new arg tab_bar_p.
(Fwindow_line_height): Use window_wants_tab_line with
WINDOW_TAB_LINE_HEIGHT.
(Fwindow_lines_pixel_dimensions): Add WINDOW_TAB_LINE_HEIGHT.
(make_window): Set tab_line_height to -1.
(window_wants_tab_line): New function.
(window_internal_height): Use window_wants_tab_line.
(window_scroll_pixel_based): Add WINDOW_TAB_LINE_HEIGHT.
(Frecenter): Set minimize_tab_bar_window_p to 1.
(GCALIGNED_STRUCT): Add frame_tab_bar_lines and frame_tab_bar_height.
(Fcurrent_window_configuration): Set frame_tab_bar_lines and
frame_tab_bar_height.
(set_window_scroll_bars): Add WINDOW_TAB_LINE_HEIGHT.
(syms_of_window): Add Qtab_line_format and Swindow_tab_line_height.
* src/window.h (GCALIGNED_STRUCT): Add tab_line_height.
(WINDOW_TAB_BAR_P, WINDOW_TAB_LINE_HEIGHT, WINDOW_TAB_LINE_LINES):
New macros.
(WINDOW_TOP_EDGE_Y, WINDOW_BOTTOM_EDGE_Y, WINDOW_TAB_LINE_HEIGHT):
Add WINDOW_TAB_BAR_P.
* src/xdisp.c (window_box_height): Add window_wants_tab_line with
MATRIX_TAB_LINE_ROW and CURRENT_TAB_LINE_HEIGHT.
(pos_visible_p): Use window_wants_tab_line.
Add WINDOW_TAB_LINE_HEIGHT.
(get_glyph_string_clip_rects): Add WINDOW_TAB_LINE_HEIGHT.
(get_phys_cursor_geometry): Add WINDOW_TAB_LINE_HEIGHT.
(remember_mouse_glyph): Use MATRIX_TAB_LINE_ROW for part
ON_TAB_LINE.
(init_iterator): Use MATRIX_TAB_LINE_ROW for TAB_LINE_FACE_ID.
Add WINDOW_TAB_LINE_HEIGHT. Add window_wants_tab_line.
(Fwindow_text_pixel_size): Add WINDOW_TAB_LINE_HEIGHT.
(prepare_menu_bars): Call update_tab_bar.
(update_tab_bar, build_desired_tab_bar_string)
(display_tab_bar_line, tab_bar_height, Ftab_bar_height)
(redisplay_tab_bar, tab_bar_item_info, get_tab_bar_item)
(handle_tab_bar_click, note_tab_bar_highlight): New functions.
(compute_window_start_on_continuation_line): Use window_wants_tab_line.
(try_cursor_movement): Use window_wants_tab_line with
CURRENT_TAB_LINE_HEIGHT.
(redisplay_window): Use window_wants_tab_line with
CURRENT_TAB_LINE_HEIGHT.
(try_window_reusing_current_matrix): Use window_wants_tab_line
with WINDOW_TAB_LINE_HEIGHT.
(Fdump_tab_bar_row): New function.
(compute_line_metrics): Add WINDOW_TAB_LINE_HEIGHT.
(display_line): Use window_wants_tab_line.
(display_mode_line): Set tab_line_p to true if face_id is
TAB_LINE_FACE_ID.
(Fformat_mode_line): Handle Qtab_line and Qtab_bar.
(gui_clear_end_of_line): Add WINDOW_TAB_LINE_HEIGHT.
(erase_phys_cursor): Use WINDOW_TAB_LINE_HEIGHT.
(show_mouse_face): Use tab_bar_window.
(note_mode_line_or_margin_highlight): Use MATRIX_TAB_LINE_ROW for
area ON_TAB_LINE.
(note_mouse_highlight): Call note_tab_bar_highlight,
(expose_frame): Handle tab_bar_window.
(syms_of_xdisp): Add Sdump_tab_bar_row and Stab_bar_height.
(auto-resize-tab-bars, auto-raise-tab-bar-buttons)
(tab-bar-border, tab-bar-button-margin, tab-bar-button-relief)
(tab-bar-max-label-size): New variables.
* src/xfaces.c (lookup_basic_face): Add TAB_LINE_FACE_ID and
TAB_BAR_FACE_ID.
(syms_of_xfaces): Define Qtab_bar and Qtab_line.
* src/xfns.c (x_set_tab_bar_lines, x_change_tab_bar_height):
New functions.
(xic_set_statusarea): Add FRAME_TABBAR_TOP_HEIGHT.
(frame_geometry): Add FRAME_TAB_BAR_HEIGHT and Qtab_bar_size.
* src/xterm.c (x_draw_image_relief): Use tab_bar_button_relief.
(x_draw_image_relief): Use TAB_BAR_FACE_ID.
(handle_one_xevent): Handle tab_bar_window.
(x_set_window_size_1): Add FRAME_TABBAR_WIDTH.
(x_create_terminal): Set change_tab_bar_height_hook.
* src/xterm.h (struct x_output): Add tabbar_top_height,
tabbar_bottom_height, tabbar_left_width, tabbar_right_width
tabbar_widget, tabbar_in_hbox, tabbar_is_packed.
(FRAME_TABBAR_TOP_HEIGHT): Add FRAME_TABBAR_TOP_HEIGHT,
FRAME_TABBAR_BOTTOM_HEIGHT, FRAME_TABBAR_HEIGHT,
FRAME_TABBAR_LEFT_WIDTH, FRAME_TABBAR_RIGHT_WIDTH,
FRAME_TABBAR_WIDTH.
2019-08-31 20:40:07 +00:00
|
|
|
|
;; Don't hide the menu-bar, tab-bar and tool-bar entries.
|
2010-08-19 14:37:31 +00:00
|
|
|
|
(define-key map [menu-bar] (lookup-key global-map [menu-bar]))
|
Frame-local tab-bar and window-local tab-line.
* etc/NEWS: Add 'tab-bar-mode' and 'global-tab-line-mode'.
* etc/TODO: Remove tab-related items.
* lisp/cus-start.el: Add tab-bar-mode, tab-bar-max-label-size.
* lisp/frame.el (frame-notice-user-settings): handle tab-bar-lines.
* lisp/loadup.el: Load "tab-bar".
* lisp/menu-bar.el (menu-bar-options-save): Add tab-bar-mode.
(menu-bar-showhide-menu): Define showhide-tab-bar.
* lisp/startup.el (tab-bar-images-pixel-height): New defconst.
(command-line): Reset tab-bar-mode.
(x-apply-session-resources): Add "tabBar", "TabBar".
* lisp/subr.el (read-key): Add tab-bar.
* lisp/tab-bar.el: New file.
* lisp/tab-line.el: New file.
* lisp/window.el (window--dump-frame): Add tab-bar-height.
* src/dispextern.h (enum window_part): Add ON_TAB_LINE.
(struct glyph_matrix): Add tab_line_p.
(struct glyph_row): Add tab_line_p.
(MATRIX_TAB_LINE_ROW): New macro.
(MATRIX_FIRST_TEXT_ROW): Handle more mode lines.
(MR_PARTIALLY_VISIBLE_AT_TOP): Add WINDOW_TAB_LINE_HEIGHT.
(MATRIX_TAB_LINE_HEIGHT, CURRENT_TAB_LINE_HEIGHT)
(DESIRED_TAB_LINE_HEIGHT): New macros.
(enum face_id): Add TAB_BAR_FACE_ID and TAB_LINE_FACE_ID.
(struct it): Add tab_line_p.
(tab_bar_item_idx, tab_bar_item_image): New enums.
(DEFAULT_TAB_BAR_LABEL_SIZE, DEFAULT_TAB_BAR_BUTTON_MARGIN)
(DEFAULT_TAB_BAR_BUTTON_RELIEF, DEFAULT_TAB_BAR_IMAGE_HEIGHT):
New constants.
* src/dispnew.c (adjust_glyph_matrix): Use window_wants_tab_line.
(shift_glyph_matrix): Add WINDOW_TAB_LINE_HEIGHT.
(clear_current_matrices, clear_desired_matrices):
Call clear_glyph_matrix on tab_bar_window.
(blank_row): Add WINDOW_TAB_LINE_HEIGHT.
(required_matrix_height): Change 2 to 3.
(fake_current_matrices): Reset tab_line_p.
(adjust_frame_glyphs_for_window_redisplay): Handle tab_bar_window.
Add FRAME_TAB_BAR_HEIGHT and FRAME_TAB_BAR_LINES.
(free_glyphs): Handle tab_bar_window.
(update_frame): Handle tab_bar_window.
(update_window): Handle row->tab_line_p.
(scrolling_window): Change arg type from bool to int.
Change header_line_p to tab_line_p.
(buffer_posn_from_coords): Add window_wants_tab_line.
(mode_line_string): Use MATRIX_TAB_LINE_ROW for part ON_TAB_LINE.
* src/frame.c (frame_default_tab_bar_height): New internal variable.
(adjust_frame_size): Handle tab_bar_window.
(make_frame): Reset tab_bar_redisplayed, tab_bar_resized and
last_tab_bar_item.
(Ftab_bar_pixel_width): New function.
(frame_parms): Add tab-bar-lines.
(gui_figure_window_size): Add new arg tabbar_p.
(syms_of_frame): Add Qtab_bar_size, Qupdate_frame_tab_bar,
Qfree_frame_tab_bar, Qtab_bar_lines, Stab_bar_pixel_width.
Add Qtab_bar_lines to frame_inhibit_implied_resize.
(tab-bar-mode): New variable.
* src/frame.h (GCALIGNED_STRUCT): Add tab_bar_window,
desired_tab_bar_string, current_tab_bar_string.
(GCALIGNED_STRUCT): Add tab_bar_items, last_tab_bar_item,
minimize_tab_bar_window_p, tab_bar_redisplayed, tab_bar_resized,
tab_bar_lines, tab_bar_height, n_tab_bar_rows, n_tab_bar_items.
(fset_tab_bar_items, fset_tab_bar_window)
(fset_current_tab_bar_string, fset_desired_tab_bar_string):
New inlines.
(FRAME_TAB_BAR_LINES, FRAME_TAB_BAR_HEIGHT): New macros.
(FRAME_TOP_MARGIN, FRAME_TOP_MARGIN_HEIGHT):
Use FRAME_TAB_BAR_LINES.
* src/fringe.c (draw_fringe_bitmap_1, update_window_fringes):
Add WINDOW_TAB_LINE_HEIGHT.
* src/gtkutil.c (xg_frame_set_char_size): Add FRAME_TABBAR_WIDTH.
(x_wm_set_size_hint): Add FRAME_TABBAR_WIDTH.
* src/keyboard.c (read_char): Handle Qtab_bar.
(kbd_buffer_get_event): Handle TAB_BAR_EVENT.
(make_lispy_position): Add WINDOW_TAB_LINE_HEIGHT.
Handle TAB_BAR_EVENT.
(tab_bar_items_vector, tab_bar_item_properties, ntab_bar_items):
New internal variables.
(tab_bar_items, process_tab_bar_item, set_prop_tab_bar)
(parse_tab_bar_item, init_tab_bar_items, append_tab_bar_item):
New functions.
(read_char_x_menu_prompt, read_key_sequence): Handle Qtab_bar.
(tab-bar-separator-image-expression): New variable.
* src/keymap.c (syms_of_keymap): Add Qtab_bar and Qtab_line.
* src/menu.c (x_popup_menu_1, Fx_popup_dialog): Handle Qtab_bar.
* src/termhooks.h (enum event_kind): Add TAB_BAR_EVENT.
(GCALIGNED_STRUCT): Add change_tab_bar_height_hook.
* src/w32fns.c (w32_frame_parm_handlers): Add w32_set_tab_bar_lines.
* src/w32term.c (w32_draw_window_cursor): Add WINDOW_TAB_LINE_HEIGHT.
* src/window.c (window_body_height): Add WINDOW_TAB_LINE_HEIGHT.
(Fwindow_tab_line_height): New function.
(coordinates_in_window): Use window_wants_tab_line with
CURRENT_TAB_LINE_HEIGHT.
(window_relative_x_coord): Add ON_TAB_LINE.
(Fcoordinates_in_window_p): Add ON_TAB_LINE.
(window_from_coordinates): Add new arg tab_bar_p.
(Fwindow_line_height): Use window_wants_tab_line with
WINDOW_TAB_LINE_HEIGHT.
(Fwindow_lines_pixel_dimensions): Add WINDOW_TAB_LINE_HEIGHT.
(make_window): Set tab_line_height to -1.
(window_wants_tab_line): New function.
(window_internal_height): Use window_wants_tab_line.
(window_scroll_pixel_based): Add WINDOW_TAB_LINE_HEIGHT.
(Frecenter): Set minimize_tab_bar_window_p to 1.
(GCALIGNED_STRUCT): Add frame_tab_bar_lines and frame_tab_bar_height.
(Fcurrent_window_configuration): Set frame_tab_bar_lines and
frame_tab_bar_height.
(set_window_scroll_bars): Add WINDOW_TAB_LINE_HEIGHT.
(syms_of_window): Add Qtab_line_format and Swindow_tab_line_height.
* src/window.h (GCALIGNED_STRUCT): Add tab_line_height.
(WINDOW_TAB_BAR_P, WINDOW_TAB_LINE_HEIGHT, WINDOW_TAB_LINE_LINES):
New macros.
(WINDOW_TOP_EDGE_Y, WINDOW_BOTTOM_EDGE_Y, WINDOW_TAB_LINE_HEIGHT):
Add WINDOW_TAB_BAR_P.
* src/xdisp.c (window_box_height): Add window_wants_tab_line with
MATRIX_TAB_LINE_ROW and CURRENT_TAB_LINE_HEIGHT.
(pos_visible_p): Use window_wants_tab_line.
Add WINDOW_TAB_LINE_HEIGHT.
(get_glyph_string_clip_rects): Add WINDOW_TAB_LINE_HEIGHT.
(get_phys_cursor_geometry): Add WINDOW_TAB_LINE_HEIGHT.
(remember_mouse_glyph): Use MATRIX_TAB_LINE_ROW for part
ON_TAB_LINE.
(init_iterator): Use MATRIX_TAB_LINE_ROW for TAB_LINE_FACE_ID.
Add WINDOW_TAB_LINE_HEIGHT. Add window_wants_tab_line.
(Fwindow_text_pixel_size): Add WINDOW_TAB_LINE_HEIGHT.
(prepare_menu_bars): Call update_tab_bar.
(update_tab_bar, build_desired_tab_bar_string)
(display_tab_bar_line, tab_bar_height, Ftab_bar_height)
(redisplay_tab_bar, tab_bar_item_info, get_tab_bar_item)
(handle_tab_bar_click, note_tab_bar_highlight): New functions.
(compute_window_start_on_continuation_line): Use window_wants_tab_line.
(try_cursor_movement): Use window_wants_tab_line with
CURRENT_TAB_LINE_HEIGHT.
(redisplay_window): Use window_wants_tab_line with
CURRENT_TAB_LINE_HEIGHT.
(try_window_reusing_current_matrix): Use window_wants_tab_line
with WINDOW_TAB_LINE_HEIGHT.
(Fdump_tab_bar_row): New function.
(compute_line_metrics): Add WINDOW_TAB_LINE_HEIGHT.
(display_line): Use window_wants_tab_line.
(display_mode_line): Set tab_line_p to true if face_id is
TAB_LINE_FACE_ID.
(Fformat_mode_line): Handle Qtab_line and Qtab_bar.
(gui_clear_end_of_line): Add WINDOW_TAB_LINE_HEIGHT.
(erase_phys_cursor): Use WINDOW_TAB_LINE_HEIGHT.
(show_mouse_face): Use tab_bar_window.
(note_mode_line_or_margin_highlight): Use MATRIX_TAB_LINE_ROW for
area ON_TAB_LINE.
(note_mouse_highlight): Call note_tab_bar_highlight,
(expose_frame): Handle tab_bar_window.
(syms_of_xdisp): Add Sdump_tab_bar_row and Stab_bar_height.
(auto-resize-tab-bars, auto-raise-tab-bar-buttons)
(tab-bar-border, tab-bar-button-margin, tab-bar-button-relief)
(tab-bar-max-label-size): New variables.
* src/xfaces.c (lookup_basic_face): Add TAB_LINE_FACE_ID and
TAB_BAR_FACE_ID.
(syms_of_xfaces): Define Qtab_bar and Qtab_line.
* src/xfns.c (x_set_tab_bar_lines, x_change_tab_bar_height):
New functions.
(xic_set_statusarea): Add FRAME_TABBAR_TOP_HEIGHT.
(frame_geometry): Add FRAME_TAB_BAR_HEIGHT and Qtab_bar_size.
* src/xterm.c (x_draw_image_relief): Use tab_bar_button_relief.
(x_draw_image_relief): Use TAB_BAR_FACE_ID.
(handle_one_xevent): Handle tab_bar_window.
(x_set_window_size_1): Add FRAME_TABBAR_WIDTH.
(x_create_terminal): Set change_tab_bar_height_hook.
* src/xterm.h (struct x_output): Add tabbar_top_height,
tabbar_bottom_height, tabbar_left_width, tabbar_right_width
tabbar_widget, tabbar_in_hbox, tabbar_is_packed.
(FRAME_TABBAR_TOP_HEIGHT): Add FRAME_TABBAR_TOP_HEIGHT,
FRAME_TABBAR_BOTTOM_HEIGHT, FRAME_TABBAR_HEIGHT,
FRAME_TABBAR_LEFT_WIDTH, FRAME_TABBAR_RIGHT_WIDTH,
FRAME_TABBAR_WIDTH.
2019-08-31 20:40:07 +00:00
|
|
|
|
(define-key map [tab-bar]
|
|
|
|
|
;; This hack avoids evaluating the :filter (Bug#9922).
|
|
|
|
|
(or (cdr (assq 'tab-bar global-map))
|
|
|
|
|
(lookup-key global-map [tab-bar])))
|
2012-04-27 02:24:38 +00:00
|
|
|
|
(define-key map [tool-bar]
|
|
|
|
|
;; This hack avoids evaluating the :filter (Bug#9922).
|
|
|
|
|
(or (cdr (assq 'tool-bar global-map))
|
|
|
|
|
(lookup-key global-map [tool-bar])))
|
2010-08-19 14:37:31 +00:00
|
|
|
|
map))
|
2014-10-21 20:11:22 +00:00
|
|
|
|
(let* ((keys
|
2023-07-21 13:23:35 +00:00
|
|
|
|
(catch 'read-key (read-key-sequence-vector prompt nil t
|
|
|
|
|
nil nil t)))
|
2014-10-21 20:11:22 +00:00
|
|
|
|
(key (aref keys 0)))
|
|
|
|
|
(if (and (> (length keys) 1)
|
|
|
|
|
(memq key '(mode-line header-line
|
|
|
|
|
left-fringe right-fringe)))
|
|
|
|
|
(aref keys 1)
|
|
|
|
|
key)))
|
2009-08-19 03:03:05 +00:00
|
|
|
|
(cancel-timer timer)
|
2016-04-08 18:02:24 +00:00
|
|
|
|
;; For some reason, `read-key(-sequence)' leaves the prompt in the echo
|
|
|
|
|
;; area, whereas `read-event' seems to empty it just before returning
|
2016-04-11 06:54:33 +00:00
|
|
|
|
;; (bug#22714). So, let's mimic the behavior of `read-event'.
|
2016-04-08 18:02:24 +00:00
|
|
|
|
(message nil)
|
2009-08-19 03:03:05 +00:00
|
|
|
|
(use-global-map old-global-map))))
|
|
|
|
|
|
2023-11-24 02:39:49 +00:00
|
|
|
|
(defvar touch-screen-events-received nil
|
|
|
|
|
"Whether a touch screen event has ever been translated.
|
|
|
|
|
The value of this variable governs whether
|
|
|
|
|
`read--potential-mouse-event' calls read-key or read-event.")
|
|
|
|
|
|
2021-01-02 22:10:17 +00:00
|
|
|
|
;; FIXME: Once there's a safe way to transition away from read-event,
|
|
|
|
|
;; callers to this function should be updated to that way and this
|
|
|
|
|
;; function should be deleted.
|
|
|
|
|
(defun read--potential-mouse-event ()
|
2023-11-24 02:39:49 +00:00
|
|
|
|
"Read an event that might be a mouse event.
|
2021-01-02 22:10:17 +00:00
|
|
|
|
|
|
|
|
|
This function exists for backward compatibility in code packaged
|
|
|
|
|
with Emacs. Do not call it directly in your own packages."
|
2023-11-24 02:39:49 +00:00
|
|
|
|
;; `xterm-mouse-mode' events must go through `read-key' as they
|
|
|
|
|
;; are decoded via `input-decode-map'.
|
|
|
|
|
(if (or xterm-mouse-mode
|
|
|
|
|
;; If a touch screen is being employed, then mouse events
|
|
|
|
|
;; are subject to translation as well.
|
|
|
|
|
touch-screen-events-received)
|
|
|
|
|
(read-key nil
|
|
|
|
|
;; Normally `read-key' discards all mouse button
|
|
|
|
|
;; down events. However, we want them here.
|
|
|
|
|
t)
|
|
|
|
|
(read-event)))
|
2021-01-02 22:10:17 +00:00
|
|
|
|
|
2019-12-24 16:38:19 +00:00
|
|
|
|
(defvar read-number-history nil
|
|
|
|
|
"The default history for the `read-number' function.")
|
|
|
|
|
|
|
|
|
|
(defun read-number (prompt &optional default hist)
|
2007-04-21 08:55:41 +00:00
|
|
|
|
"Read a numeric value in the minibuffer, prompting with PROMPT.
|
|
|
|
|
DEFAULT specifies a default value to return if the user just types RET.
|
2013-04-27 21:12:17 +00:00
|
|
|
|
The value of DEFAULT is inserted into PROMPT.
|
2019-12-24 16:38:19 +00:00
|
|
|
|
HIST specifies a history list variable. See `read-from-minibuffer'
|
|
|
|
|
for details of the HIST argument.
|
2022-05-10 13:33:32 +00:00
|
|
|
|
|
|
|
|
|
This function is used by the `interactive' code letter \"n\"."
|
2012-07-29 18:11:42 +00:00
|
|
|
|
(let ((n nil)
|
|
|
|
|
(default1 (if (consp default) (car default) default)))
|
|
|
|
|
(when default1
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(setq prompt
|
2004-06-02 22:44:45 +00:00
|
|
|
|
(if (string-match "\\(\\):[ \t]*\\'" prompt)
|
Replace "(default %s)" with 'format-prompt'
* lisp/cmuscheme.el (scheme-load-file, scheme-compile-file):
* lisp/comint.el (comint-get-source):
* lisp/emulation/viper-cmd.el (viper-quote-region, viper-kill-buffer)
(viper-query-replace, viper-read-string-with-history):
* lisp/eshell/esh-mode.el (eshell-find-tag):
* lisp/gnus/gnus-sum.el (gnus-articles-to-read)
(gnus-summary-search-article-forward)
(gnus-summary-search-article-backward):
* lisp/international/mule-cmds.el (set-input-method, toggle-input-method)
(describe-input-method, set-language-environment)
(describe-language-environment):
* lisp/mh-e/mh-gnus.el (mh-mml-minibuffer-read-disposition):
* lisp/mh-e/mh-letter.el (mh-insert-letter):
* lisp/mh-e/mh-mime.el (mh-display-with-external-viewer)
(mh-mime-save-parts, mh-mh-forward-message)
(mh-mml-query-cryptographic-method, mh-minibuffer-read-type):
* lisp/mh-e/mh-seq.el (mh-read-seq, mh-read-range):
* lisp/mh-e/mh-utils.el (mh-prompt-for-folder):
* lisp/progmodes/etags.el (find-tag-tag):
(find-tag-noselect, find-tag, find-tag-other-window)
(find-tag-other-frame, find-tag-regexp):
* lisp/progmodes/idlwave.el (idlwave-find-module):
* lisp/progmodes/inf-lisp.el (lisp-load-file, lisp-compile-file):
* lisp/progmodes/tcl.el (tcl-load-file, tcl-restart-with-file):
* lisp/progmodes/xref.el (xref--read-identifier):
(xref-find-definitions, xref-find-definitions-other-window)
(xref-find-definitions-other-frame, xref-find-references):
* lisp/ses.el (ses-read-printer):
(ses-read-cell-printer, ses-read-column-printer)
(ses-read-default-printer, ses-define-local-printer):
* lisp/subr.el (read-number):
* lisp/term.el (term-get-source):
* src/minibuf.c (read-buffer): Remove prompt suffix and
use 'format-prompt'.
* lisp/minibuffer.el (format-prompt): Ignore DEFAULT empty strings
(bug#47286).
2021-03-24 09:31:31 +00:00
|
|
|
|
(replace-match (format minibuffer-default-prompt-format default1) t t prompt 1)
|
2004-06-02 22:44:45 +00:00
|
|
|
|
(replace-regexp-in-string "[ \t]*\\'"
|
Replace "(default %s)" with 'format-prompt'
* lisp/cmuscheme.el (scheme-load-file, scheme-compile-file):
* lisp/comint.el (comint-get-source):
* lisp/emulation/viper-cmd.el (viper-quote-region, viper-kill-buffer)
(viper-query-replace, viper-read-string-with-history):
* lisp/eshell/esh-mode.el (eshell-find-tag):
* lisp/gnus/gnus-sum.el (gnus-articles-to-read)
(gnus-summary-search-article-forward)
(gnus-summary-search-article-backward):
* lisp/international/mule-cmds.el (set-input-method, toggle-input-method)
(describe-input-method, set-language-environment)
(describe-language-environment):
* lisp/mh-e/mh-gnus.el (mh-mml-minibuffer-read-disposition):
* lisp/mh-e/mh-letter.el (mh-insert-letter):
* lisp/mh-e/mh-mime.el (mh-display-with-external-viewer)
(mh-mime-save-parts, mh-mh-forward-message)
(mh-mml-query-cryptographic-method, mh-minibuffer-read-type):
* lisp/mh-e/mh-seq.el (mh-read-seq, mh-read-range):
* lisp/mh-e/mh-utils.el (mh-prompt-for-folder):
* lisp/progmodes/etags.el (find-tag-tag):
(find-tag-noselect, find-tag, find-tag-other-window)
(find-tag-other-frame, find-tag-regexp):
* lisp/progmodes/idlwave.el (idlwave-find-module):
* lisp/progmodes/inf-lisp.el (lisp-load-file, lisp-compile-file):
* lisp/progmodes/tcl.el (tcl-load-file, tcl-restart-with-file):
* lisp/progmodes/xref.el (xref--read-identifier):
(xref-find-definitions, xref-find-definitions-other-window)
(xref-find-definitions-other-frame, xref-find-references):
* lisp/ses.el (ses-read-printer):
(ses-read-cell-printer, ses-read-column-printer)
(ses-read-default-printer, ses-define-local-printer):
* lisp/subr.el (read-number):
* lisp/term.el (term-get-source):
* src/minibuf.c (read-buffer): Remove prompt suffix and
use 'format-prompt'.
* lisp/minibuffer.el (format-prompt): Ignore DEFAULT empty strings
(bug#47286).
2021-03-24 09:31:31 +00:00
|
|
|
|
(format minibuffer-default-prompt-format default1)
|
2004-06-07 20:54:42 +00:00
|
|
|
|
prompt t t))))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(while
|
|
|
|
|
(progn
|
2012-07-29 18:11:42 +00:00
|
|
|
|
(let ((str (read-from-minibuffer
|
2019-12-24 16:38:19 +00:00
|
|
|
|
prompt nil nil nil (or hist 'read-number-history)
|
2012-07-29 18:11:42 +00:00
|
|
|
|
(when default
|
|
|
|
|
(if (consp default)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(mapcar #'number-to-string (delq nil default))
|
2012-07-29 18:11:42 +00:00
|
|
|
|
(number-to-string default))))))
|
2007-04-22 16:56:19 +00:00
|
|
|
|
(condition-case nil
|
|
|
|
|
(setq n (cond
|
2012-07-29 18:11:42 +00:00
|
|
|
|
((zerop (length str)) default1)
|
2013-04-24 17:31:43 +00:00
|
|
|
|
((stringp str) (read str))))
|
2007-04-22 16:56:19 +00:00
|
|
|
|
(error nil)))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(unless (numberp n)
|
|
|
|
|
(message "Please enter a number.")
|
|
|
|
|
(sit-for 1)
|
|
|
|
|
t)))
|
|
|
|
|
n))
|
2006-07-10 18:52:13 +00:00
|
|
|
|
|
2020-12-30 09:54:01 +00:00
|
|
|
|
(defvar read-char-choice-use-read-key nil
|
2023-03-28 18:08:12 +00:00
|
|
|
|
"If non-nil, use `read-key' when reading a character by `read-char-choice'.
|
|
|
|
|
Otherwise, use the minibuffer (this is the default).
|
2021-09-05 10:02:16 +00:00
|
|
|
|
|
2023-03-28 18:08:12 +00:00
|
|
|
|
When reading via the minibuffer, you can use the normal commands
|
|
|
|
|
available in the minibuffer, and can, for instance, temporarily
|
|
|
|
|
switch to another buffer, do things there, and then switch back
|
|
|
|
|
to the minibuffer before entering the character. This is not
|
|
|
|
|
possible when using `read-key', but using `read-key' may be less
|
|
|
|
|
confusing to some users.")
|
2020-12-30 09:54:01 +00:00
|
|
|
|
|
2011-01-08 19:17:23 +00:00
|
|
|
|
(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
|
2023-03-28 18:08:12 +00:00
|
|
|
|
"Read and return one of the characters in CHARS, prompting with PROMPT.
|
|
|
|
|
CHARS should be a list of single characters.
|
|
|
|
|
The function discards any input character that is not one of CHARS,
|
2023-03-28 18:31:51 +00:00
|
|
|
|
and by default shows a message to the effect that it is not one of
|
|
|
|
|
the expected characters.
|
|
|
|
|
|
|
|
|
|
By default, this function uses the minibuffer to read the key
|
|
|
|
|
non-modally (see `read-char-from-minibuffer'), and the optional
|
|
|
|
|
argument INHIBIT-KEYBOARD-QUIT is ignored. However, if
|
2021-09-05 10:02:16 +00:00
|
|
|
|
`read-char-choice-use-read-key' is non-nil, the modal `read-key'
|
2023-03-28 18:31:51 +00:00
|
|
|
|
function is used instead (see `read-char-choice-with-read-key'),
|
|
|
|
|
and INHIBIT-KEYBOARD-QUIT is passed to it."
|
2021-02-27 20:00:51 +00:00
|
|
|
|
(if (not read-char-choice-use-read-key)
|
|
|
|
|
(read-char-from-minibuffer prompt chars)
|
|
|
|
|
(read-char-choice-with-read-key prompt chars inhibit-keyboard-quit)))
|
|
|
|
|
|
|
|
|
|
(defun read-char-choice-with-read-key (prompt chars &optional inhibit-keyboard-quit)
|
2023-03-28 18:08:12 +00:00
|
|
|
|
"Read and return one of the characters in CHARS, prompting with PROMPT.
|
|
|
|
|
CHARS should be a list of single characters.
|
2011-01-08 19:17:23 +00:00
|
|
|
|
Any input that is not one of CHARS is ignored.
|
|
|
|
|
|
|
|
|
|
If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
|
2023-03-28 18:08:12 +00:00
|
|
|
|
`keyboard-quit' events while waiting for valid input.
|
2020-11-21 19:49:46 +00:00
|
|
|
|
|
|
|
|
|
If you bind the variable `help-form' to a non-nil value
|
|
|
|
|
while calling this function, then pressing `help-char'
|
|
|
|
|
causes it to evaluate `help-form' and display the result."
|
2021-02-27 20:00:51 +00:00
|
|
|
|
(unless (consp chars)
|
|
|
|
|
(error "Called `read-char-choice' without valid char choices"))
|
|
|
|
|
(let (char done show-help (helpbuf " *Char Help*"))
|
|
|
|
|
(let ((cursor-in-echo-area t)
|
|
|
|
|
(executing-kbd-macro executing-kbd-macro)
|
|
|
|
|
(esc-flag nil))
|
|
|
|
|
(save-window-excursion ; in case we call help-form-show
|
|
|
|
|
(while (not done)
|
|
|
|
|
(unless (get-text-property 0 'face prompt)
|
|
|
|
|
(setq prompt (propertize prompt 'face 'minibuffer-prompt)))
|
2023-07-21 13:23:35 +00:00
|
|
|
|
;; Display the on screen keyboard if it exists.
|
2023-08-04 09:41:20 +00:00
|
|
|
|
(frame-toggle-on-screen-keyboard (selected-frame) nil)
|
2021-02-27 20:00:51 +00:00
|
|
|
|
(setq char (let ((inhibit-quit inhibit-keyboard-quit))
|
|
|
|
|
(read-key prompt)))
|
|
|
|
|
(and show-help (buffer-live-p (get-buffer helpbuf))
|
|
|
|
|
(kill-buffer helpbuf))
|
|
|
|
|
(cond
|
|
|
|
|
((not (numberp char)))
|
|
|
|
|
;; If caller has set help-form, that's enough.
|
|
|
|
|
;; They don't explicitly have to add help-char to chars.
|
|
|
|
|
((and help-form
|
|
|
|
|
(eq char help-char)
|
|
|
|
|
(setq show-help t)
|
|
|
|
|
(help-form-show)))
|
|
|
|
|
((memq char chars)
|
|
|
|
|
(setq done t))
|
|
|
|
|
((not inhibit-keyboard-quit)
|
|
|
|
|
(cond
|
|
|
|
|
((and (null esc-flag) (eq char ?\e))
|
|
|
|
|
(setq esc-flag t))
|
|
|
|
|
((memq char '(?\C-g ?\e))
|
|
|
|
|
(keyboard-quit))))))))
|
|
|
|
|
;; Display the question with the answer. But without cursor-in-echo-area.
|
|
|
|
|
(message "%s%s" prompt (char-to-string char))
|
|
|
|
|
char))
|
2011-01-08 19:17:23 +00:00
|
|
|
|
|
2023-10-13 23:28:30 +00:00
|
|
|
|
(defun sit-for (seconds &optional nodisp)
|
2014-12-15 20:09:04 +00:00
|
|
|
|
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
|
2006-07-10 18:52:13 +00:00
|
|
|
|
SECONDS may be a floating-point value.
|
|
|
|
|
\(On operating systems that do not support waiting for fractions of a
|
|
|
|
|
second, floating-point values are rounded down to the nearest integer.)
|
|
|
|
|
|
|
|
|
|
If optional arg NODISP is t, don't redisplay, just wait for input.
|
|
|
|
|
Redisplay does not happen if input is available before it starts.
|
|
|
|
|
|
2023-10-13 23:28:30 +00:00
|
|
|
|
Value is t if waited the full time with no input arriving, and nil otherwise."
|
2014-05-31 02:13:13 +00:00
|
|
|
|
;; This used to be implemented in C until the following discussion:
|
2017-11-26 06:45:41 +00:00
|
|
|
|
;; https://lists.gnu.org/r/emacs-devel/2006-07/msg00401.html
|
2014-12-15 20:09:04 +00:00
|
|
|
|
;; Then it was moved here using an implementation based on an idle timer,
|
2014-05-31 02:13:13 +00:00
|
|
|
|
;; which was then replaced by the use of read-event.
|
2006-09-11 22:21:55 +00:00
|
|
|
|
(cond
|
|
|
|
|
(noninteractive
|
|
|
|
|
(sleep-for seconds)
|
|
|
|
|
t)
|
2013-10-18 04:27:34 +00:00
|
|
|
|
((input-pending-p t)
|
2006-09-11 22:21:55 +00:00
|
|
|
|
nil)
|
2015-08-28 13:25:25 +00:00
|
|
|
|
((or (<= seconds 0)
|
|
|
|
|
;; We are going to call read-event below, which will record
|
2017-10-28 00:04:47 +00:00
|
|
|
|
;; the next key as part of the macro, even if that key
|
2015-08-28 13:25:25 +00:00
|
|
|
|
;; invokes kmacro-end-macro, so if we are recording a macro,
|
|
|
|
|
;; the macro will recursively call itself. In addition, when
|
|
|
|
|
;; that key is removed from unread-command-events, it will be
|
|
|
|
|
;; recorded the second time, so the macro will have each key
|
|
|
|
|
;; doubled. This used to happen if a macro was defined with
|
|
|
|
|
;; Flyspell mode active (because Flyspell calls sit-for in its
|
|
|
|
|
;; post-command-hook, see bug #21329.) To avoid all that, we
|
|
|
|
|
;; simply disable the wait when we are recording a macro.
|
|
|
|
|
defining-kbd-macro)
|
2006-09-11 22:21:55 +00:00
|
|
|
|
(or nodisp (redisplay)))
|
|
|
|
|
(t
|
|
|
|
|
(or nodisp (redisplay))
|
2013-07-06 00:10:54 +00:00
|
|
|
|
;; FIXME: we should not read-event here at all, because it's much too
|
|
|
|
|
;; difficult to reliably "undo" a read-event by pushing it onto
|
|
|
|
|
;; unread-command-events.
|
2014-05-29 16:38:01 +00:00
|
|
|
|
;; For bug#14782, we need read-event to do the keyboard-coding-system
|
|
|
|
|
;; decoding (hence non-nil as second arg under POSIX ttys).
|
|
|
|
|
;; For bug#15614, we need read-event not to inherit-input-method.
|
|
|
|
|
;; So we temporarily suspend input-method-function.
|
|
|
|
|
(let ((read (let ((input-method-function nil))
|
|
|
|
|
(read-event nil t seconds))))
|
2006-09-11 22:21:55 +00:00
|
|
|
|
(or (null read)
|
2006-10-22 22:32:53 +00:00
|
|
|
|
(progn
|
2017-11-26 06:45:41 +00:00
|
|
|
|
;; https://lists.gnu.org/r/emacs-devel/2006-10/msg00394.html
|
2014-05-29 15:36:09 +00:00
|
|
|
|
;; We want `read' appear in the next command's this-command-event
|
|
|
|
|
;; but not in the current one.
|
|
|
|
|
;; By pushing (cons t read), we indicate that `read' has not
|
|
|
|
|
;; yet been recorded in this-command-keys, so it will be recorded
|
|
|
|
|
;; next time it's read.
|
|
|
|
|
;; And indeed the `seconds' argument to read-event correctly
|
|
|
|
|
;; prevented recording this event in the current command's
|
|
|
|
|
;; this-command-keys.
|
|
|
|
|
(push (cons t read) unread-command-events)
|
2006-10-22 22:32:53 +00:00
|
|
|
|
nil))))))
|
2011-01-07 17:34:02 +00:00
|
|
|
|
|
2020-12-20 20:05:51 +00:00
|
|
|
|
(defun goto-char--read-natnum-interactive (prompt)
|
|
|
|
|
"Get a natural number argument, optionally prompting with PROMPT.
|
|
|
|
|
If there is a natural number at point, use it as default."
|
|
|
|
|
(if (and current-prefix-arg (not (consp current-prefix-arg)))
|
|
|
|
|
(list (prefix-numeric-value current-prefix-arg))
|
|
|
|
|
(let* ((number (number-at-point))
|
|
|
|
|
(default (and (natnump number) number)))
|
|
|
|
|
(list (read-number prompt (list default (point)))))))
|
|
|
|
|
|
2019-11-10 21:06:37 +00:00
|
|
|
|
|
|
|
|
|
(defvar read-char-history nil
|
|
|
|
|
"The default history for the `read-char-from-minibuffer' function.")
|
|
|
|
|
|
|
|
|
|
(defvar read-char-from-minibuffer-map
|
|
|
|
|
(let ((map (make-sparse-keymap)))
|
|
|
|
|
(set-keymap-parent map minibuffer-local-map)
|
2019-12-08 22:19:43 +00:00
|
|
|
|
|
2023-09-12 16:55:54 +00:00
|
|
|
|
;; (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char)
|
2021-10-10 17:31:15 +00:00
|
|
|
|
(define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other)
|
2019-12-08 22:19:43 +00:00
|
|
|
|
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom)
|
|
|
|
|
(define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command)
|
|
|
|
|
(define-key map [remap scroll-down-command] #'minibuffer-scroll-down-command)
|
|
|
|
|
(define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
|
|
|
|
|
(define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
|
2019-12-08 22:19:43 +00:00
|
|
|
|
|
2019-11-10 21:06:37 +00:00
|
|
|
|
map)
|
|
|
|
|
"Keymap for the `read-char-from-minibuffer' function.")
|
|
|
|
|
|
|
|
|
|
(defconst read-char-from-minibuffer-map-hash
|
2020-11-12 07:38:21 +00:00
|
|
|
|
(make-hash-table :test 'equal))
|
2019-11-10 21:06:37 +00:00
|
|
|
|
|
|
|
|
|
(defun read-char-from-minibuffer-insert-char ()
|
2022-03-20 16:21:44 +00:00
|
|
|
|
"Insert the character you type into the minibuffer and exit minibuffer.
|
2019-11-10 21:06:37 +00:00
|
|
|
|
Discard all previous input before inserting and exiting the minibuffer."
|
|
|
|
|
(interactive)
|
2020-12-06 21:07:36 +00:00
|
|
|
|
(when (minibufferp)
|
|
|
|
|
(delete-minibuffer-contents)
|
|
|
|
|
(insert last-command-event)
|
|
|
|
|
(exit-minibuffer)))
|
2019-11-10 21:06:37 +00:00
|
|
|
|
|
|
|
|
|
(defun read-char-from-minibuffer-insert-other ()
|
2022-03-20 16:21:44 +00:00
|
|
|
|
"Reject a disallowed character typed into the minibuffer.
|
|
|
|
|
This command is intended to be bound to keys that users are not
|
|
|
|
|
allowed to type into the minibuffer. When the user types any
|
|
|
|
|
such key, this command discard all minibuffer input and displays
|
|
|
|
|
an error message."
|
2019-11-10 21:06:37 +00:00
|
|
|
|
(interactive)
|
2023-09-12 16:55:54 +00:00
|
|
|
|
(when (minibufferp) ;;FIXME: Why?
|
2020-12-06 21:07:36 +00:00
|
|
|
|
(delete-minibuffer-contents)
|
|
|
|
|
(ding)
|
|
|
|
|
(discard-input)
|
|
|
|
|
(minibuffer-message "Wrong answer")
|
|
|
|
|
(sit-for 2)))
|
2019-11-10 21:06:37 +00:00
|
|
|
|
|
Update Android port
* doc/emacs/android.texi (Android Fonts):
* doc/emacs/input.texi (On-Screen Keyboards):
* doc/lispref/commands.texi (Misc Events): Update documentation.
* java/org/gnu/emacs/EmacsInputConnection.java (setSelection):
New function.
* java/org/gnu/emacs/EmacsSurfaceView.java (EmacsSurfaceView)
(reconfigureFrontBuffer): Make bitmap references weak
references.
* java/org/gnu/emacs/EmacsView.java (handleDirtyBitmap): Don't
clear surfaceView bitmap.
* lisp/comint.el (comint-mode):
* lisp/international/fontset.el (script-representative-chars)
(setup-default-fontset): Improve detection of CJK fonts.
* lisp/isearch.el (set-text-conversion-style): New variable.
(isearch-mode, isearch-done): Save and restore the text
conversion style.
* lisp/minibuffer.el (minibuffer-mode): Set an appropriate text
conversion style.
* lisp/simple.el (analyze-text-conversion): Run
post-self-insert-hook properly.
* lisp/subr.el (read-char-from-minibuffer): Disable text
conversion when reading character.
* src/androidterm.c (show_back_buffer): Don't check that F is
not garbaged.
(android_update_selection, android_reset_conversion): Use the
ephemeral last point and handle text conversion being disabled.
* src/buffer.c (syms_of_buffer): Convert old style DEFVAR.
* src/keyboard.c (kbd_buffer_get_event): Handle text conversion
first.
* src/lisp.h: Update prototypes.
* src/lread.c (read_filtered_event): Temporarily disable text
conversion.
* src/sfnt.c (sfnt_decompose_glyph_1, sfnt_decompose_glyph_2):
New functions.
(sfnt_decompose_glyph, sfnt_decompose_instructed_outline):
Refactor contour decomposition to those two functions.
(main): Update tests.
* src/sfntfont-android.c (system_font_directories): Add empty
field.
(Fandroid_enumerate_fonts, init_sfntfont_android): Enumerate
fonts in a user fonts directory.
* src/sfntfont.c (struct sfnt_font_desc): New field
`num_glyphs'.
(sfnt_enum_font_1): Set num_glyphs and avoid duplicate fonts.
(sfntfont_glyph_valid): New function.
(sfntfont_lookup_char, sfntfont_list_1): Make sure glyphs found
are valid.
* src/textconv.c (sync_overlay, really_commit_text)
(really_set_composing_text, really_set_composing_region)
(really_delete_surrounding_text, really_set_point_and_mark)
(handle_pending_conversion_events_1)
(handle_pending_conversion_events, conversion_disabled_p)
(disable_text_conversion, resume_text_conversion)
(Fset_text_conversion_style, syms_of_textconv): Update to
respect new options.
* src/textconv.h:
* src/window.h (GCALIGNED_STRUCT): New field
`ephemeral_last_point'.
* src/xdisp.c (mark_window_display_accurate_1): Set it.
2023-02-16 15:57:01 +00:00
|
|
|
|
;; Defined in textconv.c.
|
|
|
|
|
(defvar overriding-text-conversion-style)
|
|
|
|
|
|
2019-11-10 21:06:37 +00:00
|
|
|
|
(defun read-char-from-minibuffer (prompt &optional chars history)
|
2020-11-07 09:10:36 +00:00
|
|
|
|
"Read a character from the minibuffer, prompting for it with PROMPT.
|
2019-11-10 21:06:37 +00:00
|
|
|
|
Like `read-char', but uses the minibuffer to read and return a character.
|
2020-11-07 09:10:36 +00:00
|
|
|
|
Optional argument CHARS, if non-nil, should be a list of characters;
|
|
|
|
|
the function will ignore any input that is not one of CHARS.
|
|
|
|
|
Optional argument HISTORY, if non-nil, should be a symbol that
|
|
|
|
|
specifies the history list variable to use for navigating in input
|
2021-11-22 10:45:44 +00:00
|
|
|
|
history using \\`M-p' and \\`M-n', with \\`RET' to select a character from
|
2020-11-11 19:18:31 +00:00
|
|
|
|
history.
|
2020-11-21 19:49:46 +00:00
|
|
|
|
If you bind the variable `help-form' to a non-nil value
|
|
|
|
|
while calling this function, then pressing `help-char'
|
|
|
|
|
causes it to evaluate `help-form' and display the result.
|
|
|
|
|
There is no need to explicitly add `help-char' to CHARS;
|
|
|
|
|
`help-char' is bound automatically to `help-form-show'."
|
Update Android port
* doc/emacs/android.texi (Android Fonts):
* doc/emacs/input.texi (On-Screen Keyboards):
* doc/lispref/commands.texi (Misc Events): Update documentation.
* java/org/gnu/emacs/EmacsInputConnection.java (setSelection):
New function.
* java/org/gnu/emacs/EmacsSurfaceView.java (EmacsSurfaceView)
(reconfigureFrontBuffer): Make bitmap references weak
references.
* java/org/gnu/emacs/EmacsView.java (handleDirtyBitmap): Don't
clear surfaceView bitmap.
* lisp/comint.el (comint-mode):
* lisp/international/fontset.el (script-representative-chars)
(setup-default-fontset): Improve detection of CJK fonts.
* lisp/isearch.el (set-text-conversion-style): New variable.
(isearch-mode, isearch-done): Save and restore the text
conversion style.
* lisp/minibuffer.el (minibuffer-mode): Set an appropriate text
conversion style.
* lisp/simple.el (analyze-text-conversion): Run
post-self-insert-hook properly.
* lisp/subr.el (read-char-from-minibuffer): Disable text
conversion when reading character.
* src/androidterm.c (show_back_buffer): Don't check that F is
not garbaged.
(android_update_selection, android_reset_conversion): Use the
ephemeral last point and handle text conversion being disabled.
* src/buffer.c (syms_of_buffer): Convert old style DEFVAR.
* src/keyboard.c (kbd_buffer_get_event): Handle text conversion
first.
* src/lisp.h: Update prototypes.
* src/lread.c (read_filtered_event): Temporarily disable text
conversion.
* src/sfnt.c (sfnt_decompose_glyph_1, sfnt_decompose_glyph_2):
New functions.
(sfnt_decompose_glyph, sfnt_decompose_instructed_outline):
Refactor contour decomposition to those two functions.
(main): Update tests.
* src/sfntfont-android.c (system_font_directories): Add empty
field.
(Fandroid_enumerate_fonts, init_sfntfont_android): Enumerate
fonts in a user fonts directory.
* src/sfntfont.c (struct sfnt_font_desc): New field
`num_glyphs'.
(sfnt_enum_font_1): Set num_glyphs and avoid duplicate fonts.
(sfntfont_glyph_valid): New function.
(sfntfont_lookup_char, sfntfont_list_1): Make sure glyphs found
are valid.
* src/textconv.c (sync_overlay, really_commit_text)
(really_set_composing_text, really_set_composing_region)
(really_delete_surrounding_text, really_set_point_and_mark)
(handle_pending_conversion_events_1)
(handle_pending_conversion_events, conversion_disabled_p)
(disable_text_conversion, resume_text_conversion)
(Fset_text_conversion_style, syms_of_textconv): Update to
respect new options.
* src/textconv.h:
* src/window.h (GCALIGNED_STRUCT): New field
`ephemeral_last_point'.
* src/xdisp.c (mark_window_display_accurate_1): Set it.
2023-02-16 15:57:01 +00:00
|
|
|
|
|
|
|
|
|
;; If text conversion is enabled in this buffer, then it will only
|
|
|
|
|
;; be disabled the next time `force-mode-line-update' happens.
|
2023-04-04 10:35:11 +00:00
|
|
|
|
(when (and (bound-and-true-p overriding-text-conversion-style)
|
|
|
|
|
(bound-and-true-p text-conversion-style))
|
Update Android port
* doc/emacs/android.texi (Android Fonts):
* doc/emacs/input.texi (On-Screen Keyboards):
* doc/lispref/commands.texi (Misc Events): Update documentation.
* java/org/gnu/emacs/EmacsInputConnection.java (setSelection):
New function.
* java/org/gnu/emacs/EmacsSurfaceView.java (EmacsSurfaceView)
(reconfigureFrontBuffer): Make bitmap references weak
references.
* java/org/gnu/emacs/EmacsView.java (handleDirtyBitmap): Don't
clear surfaceView bitmap.
* lisp/comint.el (comint-mode):
* lisp/international/fontset.el (script-representative-chars)
(setup-default-fontset): Improve detection of CJK fonts.
* lisp/isearch.el (set-text-conversion-style): New variable.
(isearch-mode, isearch-done): Save and restore the text
conversion style.
* lisp/minibuffer.el (minibuffer-mode): Set an appropriate text
conversion style.
* lisp/simple.el (analyze-text-conversion): Run
post-self-insert-hook properly.
* lisp/subr.el (read-char-from-minibuffer): Disable text
conversion when reading character.
* src/androidterm.c (show_back_buffer): Don't check that F is
not garbaged.
(android_update_selection, android_reset_conversion): Use the
ephemeral last point and handle text conversion being disabled.
* src/buffer.c (syms_of_buffer): Convert old style DEFVAR.
* src/keyboard.c (kbd_buffer_get_event): Handle text conversion
first.
* src/lisp.h: Update prototypes.
* src/lread.c (read_filtered_event): Temporarily disable text
conversion.
* src/sfnt.c (sfnt_decompose_glyph_1, sfnt_decompose_glyph_2):
New functions.
(sfnt_decompose_glyph, sfnt_decompose_instructed_outline):
Refactor contour decomposition to those two functions.
(main): Update tests.
* src/sfntfont-android.c (system_font_directories): Add empty
field.
(Fandroid_enumerate_fonts, init_sfntfont_android): Enumerate
fonts in a user fonts directory.
* src/sfntfont.c (struct sfnt_font_desc): New field
`num_glyphs'.
(sfnt_enum_font_1): Set num_glyphs and avoid duplicate fonts.
(sfntfont_glyph_valid): New function.
(sfntfont_lookup_char, sfntfont_list_1): Make sure glyphs found
are valid.
* src/textconv.c (sync_overlay, really_commit_text)
(really_set_composing_text, really_set_composing_region)
(really_delete_surrounding_text, really_set_point_and_mark)
(handle_pending_conversion_events_1)
(handle_pending_conversion_events, conversion_disabled_p)
(disable_text_conversion, resume_text_conversion)
(Fset_text_conversion_style, syms_of_textconv): Update to
respect new options.
* src/textconv.h:
* src/window.h (GCALIGNED_STRUCT): New field
`ephemeral_last_point'.
* src/xdisp.c (mark_window_display_accurate_1): Set it.
2023-02-16 15:57:01 +00:00
|
|
|
|
(force-mode-line-update))
|
|
|
|
|
|
|
|
|
|
(let* ((overriding-text-conversion-style nil)
|
|
|
|
|
(map (if (consp chars)
|
2020-11-12 20:33:27 +00:00
|
|
|
|
(or (gethash (list help-form (cons help-char chars))
|
2020-11-12 01:38:44 +00:00
|
|
|
|
read-char-from-minibuffer-map-hash)
|
2020-11-11 19:18:31 +00:00
|
|
|
|
(let ((map (make-sparse-keymap))
|
|
|
|
|
(msg help-form))
|
|
|
|
|
(set-keymap-parent map read-char-from-minibuffer-map)
|
|
|
|
|
;; If we have a dynamically bound `help-form'
|
|
|
|
|
;; here, then the `C-h' (i.e., `help-char')
|
|
|
|
|
;; character should output that instead of
|
|
|
|
|
;; being a command char.
|
|
|
|
|
(when help-form
|
|
|
|
|
(define-key map (vector help-char)
|
Update Android port
* doc/emacs/android.texi (Android Fonts):
* doc/emacs/input.texi (On-Screen Keyboards):
* doc/lispref/commands.texi (Misc Events): Update documentation.
* java/org/gnu/emacs/EmacsInputConnection.java (setSelection):
New function.
* java/org/gnu/emacs/EmacsSurfaceView.java (EmacsSurfaceView)
(reconfigureFrontBuffer): Make bitmap references weak
references.
* java/org/gnu/emacs/EmacsView.java (handleDirtyBitmap): Don't
clear surfaceView bitmap.
* lisp/comint.el (comint-mode):
* lisp/international/fontset.el (script-representative-chars)
(setup-default-fontset): Improve detection of CJK fonts.
* lisp/isearch.el (set-text-conversion-style): New variable.
(isearch-mode, isearch-done): Save and restore the text
conversion style.
* lisp/minibuffer.el (minibuffer-mode): Set an appropriate text
conversion style.
* lisp/simple.el (analyze-text-conversion): Run
post-self-insert-hook properly.
* lisp/subr.el (read-char-from-minibuffer): Disable text
conversion when reading character.
* src/androidterm.c (show_back_buffer): Don't check that F is
not garbaged.
(android_update_selection, android_reset_conversion): Use the
ephemeral last point and handle text conversion being disabled.
* src/buffer.c (syms_of_buffer): Convert old style DEFVAR.
* src/keyboard.c (kbd_buffer_get_event): Handle text conversion
first.
* src/lisp.h: Update prototypes.
* src/lread.c (read_filtered_event): Temporarily disable text
conversion.
* src/sfnt.c (sfnt_decompose_glyph_1, sfnt_decompose_glyph_2):
New functions.
(sfnt_decompose_glyph, sfnt_decompose_instructed_outline):
Refactor contour decomposition to those two functions.
(main): Update tests.
* src/sfntfont-android.c (system_font_directories): Add empty
field.
(Fandroid_enumerate_fonts, init_sfntfont_android): Enumerate
fonts in a user fonts directory.
* src/sfntfont.c (struct sfnt_font_desc): New field
`num_glyphs'.
(sfnt_enum_font_1): Set num_glyphs and avoid duplicate fonts.
(sfntfont_glyph_valid): New function.
(sfntfont_lookup_char, sfntfont_list_1): Make sure glyphs found
are valid.
* src/textconv.c (sync_overlay, really_commit_text)
(really_set_composing_text, really_set_composing_region)
(really_delete_surrounding_text, really_set_point_and_mark)
(handle_pending_conversion_events_1)
(handle_pending_conversion_events, conversion_disabled_p)
(disable_text_conversion, resume_text_conversion)
(Fset_text_conversion_style, syms_of_textconv): Update to
respect new options.
* src/textconv.h:
* src/window.h (GCALIGNED_STRUCT): New field
`ephemeral_last_point'.
* src/xdisp.c (mark_window_display_accurate_1): Set it.
2023-02-16 15:57:01 +00:00
|
|
|
|
(lambda ()
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((help-form msg)) ; lexically bound msg
|
|
|
|
|
(help-form-show)))))
|
2023-09-12 16:55:54 +00:00
|
|
|
|
;; FIXME: We use `read-char-from-minibuffer-insert-char'
|
|
|
|
|
;; here only as a kind of alias of `self-insert-command'
|
|
|
|
|
;; to prevent those keys from being remapped to
|
|
|
|
|
;; `read-char-from-minibuffer-insert-other'.
|
2020-11-11 19:18:31 +00:00
|
|
|
|
(dolist (char chars)
|
|
|
|
|
(define-key map (vector char)
|
Update Android port
* doc/emacs/android.texi (Android Fonts):
* doc/emacs/input.texi (On-Screen Keyboards):
* doc/lispref/commands.texi (Misc Events): Update documentation.
* java/org/gnu/emacs/EmacsInputConnection.java (setSelection):
New function.
* java/org/gnu/emacs/EmacsSurfaceView.java (EmacsSurfaceView)
(reconfigureFrontBuffer): Make bitmap references weak
references.
* java/org/gnu/emacs/EmacsView.java (handleDirtyBitmap): Don't
clear surfaceView bitmap.
* lisp/comint.el (comint-mode):
* lisp/international/fontset.el (script-representative-chars)
(setup-default-fontset): Improve detection of CJK fonts.
* lisp/isearch.el (set-text-conversion-style): New variable.
(isearch-mode, isearch-done): Save and restore the text
conversion style.
* lisp/minibuffer.el (minibuffer-mode): Set an appropriate text
conversion style.
* lisp/simple.el (analyze-text-conversion): Run
post-self-insert-hook properly.
* lisp/subr.el (read-char-from-minibuffer): Disable text
conversion when reading character.
* src/androidterm.c (show_back_buffer): Don't check that F is
not garbaged.
(android_update_selection, android_reset_conversion): Use the
ephemeral last point and handle text conversion being disabled.
* src/buffer.c (syms_of_buffer): Convert old style DEFVAR.
* src/keyboard.c (kbd_buffer_get_event): Handle text conversion
first.
* src/lisp.h: Update prototypes.
* src/lread.c (read_filtered_event): Temporarily disable text
conversion.
* src/sfnt.c (sfnt_decompose_glyph_1, sfnt_decompose_glyph_2):
New functions.
(sfnt_decompose_glyph, sfnt_decompose_instructed_outline):
Refactor contour decomposition to those two functions.
(main): Update tests.
* src/sfntfont-android.c (system_font_directories): Add empty
field.
(Fandroid_enumerate_fonts, init_sfntfont_android): Enumerate
fonts in a user fonts directory.
* src/sfntfont.c (struct sfnt_font_desc): New field
`num_glyphs'.
(sfnt_enum_font_1): Set num_glyphs and avoid duplicate fonts.
(sfntfont_glyph_valid): New function.
(sfntfont_lookup_char, sfntfont_list_1): Make sure glyphs found
are valid.
* src/textconv.c (sync_overlay, really_commit_text)
(really_set_composing_text, really_set_composing_region)
(really_delete_surrounding_text, really_set_point_and_mark)
(handle_pending_conversion_events_1)
(handle_pending_conversion_events, conversion_disabled_p)
(disable_text_conversion, resume_text_conversion)
(Fset_text_conversion_style, syms_of_textconv): Update to
respect new options.
* src/textconv.h:
* src/window.h (GCALIGNED_STRUCT): New field
`ephemeral_last_point'.
* src/xdisp.c (mark_window_display_accurate_1): Set it.
2023-02-16 15:57:01 +00:00
|
|
|
|
#'read-char-from-minibuffer-insert-char))
|
2020-11-11 19:18:31 +00:00
|
|
|
|
(define-key map [remap self-insert-command]
|
Update Android port
* doc/emacs/android.texi (Android Fonts):
* doc/emacs/input.texi (On-Screen Keyboards):
* doc/lispref/commands.texi (Misc Events): Update documentation.
* java/org/gnu/emacs/EmacsInputConnection.java (setSelection):
New function.
* java/org/gnu/emacs/EmacsSurfaceView.java (EmacsSurfaceView)
(reconfigureFrontBuffer): Make bitmap references weak
references.
* java/org/gnu/emacs/EmacsView.java (handleDirtyBitmap): Don't
clear surfaceView bitmap.
* lisp/comint.el (comint-mode):
* lisp/international/fontset.el (script-representative-chars)
(setup-default-fontset): Improve detection of CJK fonts.
* lisp/isearch.el (set-text-conversion-style): New variable.
(isearch-mode, isearch-done): Save and restore the text
conversion style.
* lisp/minibuffer.el (minibuffer-mode): Set an appropriate text
conversion style.
* lisp/simple.el (analyze-text-conversion): Run
post-self-insert-hook properly.
* lisp/subr.el (read-char-from-minibuffer): Disable text
conversion when reading character.
* src/androidterm.c (show_back_buffer): Don't check that F is
not garbaged.
(android_update_selection, android_reset_conversion): Use the
ephemeral last point and handle text conversion being disabled.
* src/buffer.c (syms_of_buffer): Convert old style DEFVAR.
* src/keyboard.c (kbd_buffer_get_event): Handle text conversion
first.
* src/lisp.h: Update prototypes.
* src/lread.c (read_filtered_event): Temporarily disable text
conversion.
* src/sfnt.c (sfnt_decompose_glyph_1, sfnt_decompose_glyph_2):
New functions.
(sfnt_decompose_glyph, sfnt_decompose_instructed_outline):
Refactor contour decomposition to those two functions.
(main): Update tests.
* src/sfntfont-android.c (system_font_directories): Add empty
field.
(Fandroid_enumerate_fonts, init_sfntfont_android): Enumerate
fonts in a user fonts directory.
* src/sfntfont.c (struct sfnt_font_desc): New field
`num_glyphs'.
(sfnt_enum_font_1): Set num_glyphs and avoid duplicate fonts.
(sfntfont_glyph_valid): New function.
(sfntfont_lookup_char, sfntfont_list_1): Make sure glyphs found
are valid.
* src/textconv.c (sync_overlay, really_commit_text)
(really_set_composing_text, really_set_composing_region)
(really_delete_surrounding_text, really_set_point_and_mark)
(handle_pending_conversion_events_1)
(handle_pending_conversion_events, conversion_disabled_p)
(disable_text_conversion, resume_text_conversion)
(Fset_text_conversion_style, syms_of_textconv): Update to
respect new options.
* src/textconv.h:
* src/window.h (GCALIGNED_STRUCT): New field
`ephemeral_last_point'.
* src/xdisp.c (mark_window_display_accurate_1): Set it.
2023-02-16 15:57:01 +00:00
|
|
|
|
#'read-char-from-minibuffer-insert-other)
|
2020-11-12 20:33:27 +00:00
|
|
|
|
(puthash (list help-form (cons help-char chars))
|
2020-11-12 01:38:44 +00:00
|
|
|
|
map read-char-from-minibuffer-map-hash)
|
2020-11-11 19:18:31 +00:00
|
|
|
|
map))
|
2019-11-10 21:06:37 +00:00
|
|
|
|
read-char-from-minibuffer-map))
|
2020-12-06 21:07:36 +00:00
|
|
|
|
;; Protect this-command when called from pre-command-hook (bug#45029)
|
|
|
|
|
(this-command this-command)
|
2023-09-12 16:55:54 +00:00
|
|
|
|
(result (minibuffer-with-setup-hook
|
|
|
|
|
(lambda ()
|
2024-02-09 19:08:51 +00:00
|
|
|
|
(setq-local post-self-insert-hook nil)
|
2023-09-12 16:55:54 +00:00
|
|
|
|
(add-hook 'post-command-hook
|
|
|
|
|
(lambda ()
|
2024-02-09 19:08:51 +00:00
|
|
|
|
(if (<= (1+ (minibuffer-prompt-end))
|
2023-09-12 16:55:54 +00:00
|
|
|
|
(point-max))
|
|
|
|
|
(exit-minibuffer)))
|
|
|
|
|
nil 'local))
|
2023-08-19 00:48:20 +00:00
|
|
|
|
;; Disable text conversion if it is enabled.
|
|
|
|
|
;; (bug#65370)
|
|
|
|
|
(when (fboundp 'set-text-conversion-style)
|
|
|
|
|
(set-text-conversion-style text-conversion-style))
|
|
|
|
|
(read-from-minibuffer prompt nil map nil (or history t))))
|
2019-11-10 21:06:37 +00:00
|
|
|
|
(char
|
|
|
|
|
(if (> (length result) 0)
|
|
|
|
|
;; We have a string (with one character), so return the first one.
|
|
|
|
|
(elt result 0)
|
|
|
|
|
;; The default value is RET.
|
|
|
|
|
(when history (push "\r" (symbol-value history)))
|
|
|
|
|
?\r)))
|
|
|
|
|
;; Display the question with the answer.
|
|
|
|
|
(message "%s%s" prompt (char-to-string char))
|
|
|
|
|
char))
|
|
|
|
|
|
|
|
|
|
|
2013-09-18 03:50:18 +00:00
|
|
|
|
;; Behind display-popup-menus-p test.
|
2014-01-22 01:50:40 +00:00
|
|
|
|
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
|
2013-09-18 03:50:18 +00:00
|
|
|
|
|
2019-11-09 22:04:13 +00:00
|
|
|
|
(defvar y-or-n-p-history-variable nil
|
|
|
|
|
"History list symbol to add `y-or-n-p' answers to.")
|
|
|
|
|
|
|
|
|
|
(defvar y-or-n-p-map
|
|
|
|
|
(let ((map (make-sparse-keymap)))
|
|
|
|
|
(set-keymap-parent map minibuffer-local-map)
|
|
|
|
|
|
|
|
|
|
(dolist (symbol '(act act-and-show act-and-exit automatic))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map (vector 'remap symbol) #'y-or-n-p-insert-y))
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map [remap skip] #'y-or-n-p-insert-n)
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
2020-11-21 19:49:46 +00:00
|
|
|
|
(dolist (symbol '(backup undo undo-all edit edit-replacement
|
2019-11-09 22:04:13 +00:00
|
|
|
|
delete-and-edit ignore self-insert-command))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map (vector 'remap symbol) #'y-or-n-p-insert-other))
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map [remap recenter] #'minibuffer-recenter-top-bottom)
|
|
|
|
|
(define-key map [remap scroll-up] #'minibuffer-scroll-up-command)
|
|
|
|
|
(define-key map [remap scroll-down] #'minibuffer-scroll-down-command)
|
|
|
|
|
(define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
|
|
|
|
|
(define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
2021-10-10 17:31:15 +00:00
|
|
|
|
(define-key map [remap exit] #'y-or-n-p-insert-other)
|
|
|
|
|
(dolist (symbol '(exit-prefix quit))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(define-key map (vector 'remap symbol) #'abort-recursive-edit))
|
2021-10-10 17:31:15 +00:00
|
|
|
|
(define-key map [escape] #'abort-recursive-edit)
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
|
|
|
|
;; FIXME: try catch-all instead of explicit bindings:
|
2021-02-15 02:13:35 +00:00
|
|
|
|
;; (define-key map [remap t] #'y-or-n-p-insert-other)
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
|
|
|
|
map)
|
|
|
|
|
"Keymap that defines additional bindings for `y-or-n-p' answers.")
|
|
|
|
|
|
|
|
|
|
(defun y-or-n-p-insert-y ()
|
|
|
|
|
"Insert the answer \"y\" and exit the minibuffer of `y-or-n-p'.
|
|
|
|
|
Discard all previous input before inserting and exiting the minibuffer."
|
|
|
|
|
(interactive)
|
2020-12-06 21:07:36 +00:00
|
|
|
|
(when (minibufferp)
|
|
|
|
|
(delete-minibuffer-contents)
|
|
|
|
|
(insert "y")
|
|
|
|
|
(exit-minibuffer)))
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
|
|
|
|
(defun y-or-n-p-insert-n ()
|
|
|
|
|
"Insert the answer \"n\" and exit the minibuffer of `y-or-n-p'.
|
|
|
|
|
Discard all previous input before inserting and exiting the minibuffer."
|
|
|
|
|
(interactive)
|
2020-12-06 21:07:36 +00:00
|
|
|
|
(when (minibufferp)
|
|
|
|
|
(delete-minibuffer-contents)
|
|
|
|
|
(insert "n")
|
|
|
|
|
(exit-minibuffer)))
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
|
|
|
|
(defun y-or-n-p-insert-other ()
|
|
|
|
|
"Handle inserting of other answers in the minibuffer of `y-or-n-p'.
|
|
|
|
|
Display an error on trying to insert a disallowed character.
|
|
|
|
|
Also discard all previous input in the minibuffer."
|
|
|
|
|
(interactive)
|
2020-12-06 21:07:36 +00:00
|
|
|
|
(when (minibufferp)
|
|
|
|
|
(delete-minibuffer-contents)
|
|
|
|
|
(ding)
|
|
|
|
|
(discard-input)
|
|
|
|
|
(minibuffer-message "Please answer y or n")
|
|
|
|
|
(sit-for 2)))
|
2019-11-09 22:04:13 +00:00
|
|
|
|
|
2020-12-30 09:54:01 +00:00
|
|
|
|
(defvar y-or-n-p-use-read-key nil
|
2023-03-28 18:08:12 +00:00
|
|
|
|
"Use `read-key' when reading answers to \"y or n\" questions by `y-or-n-p'.
|
|
|
|
|
Otherwise, use the `read-from-minibuffer' to read the answers.
|
|
|
|
|
|
|
|
|
|
When reading via the minibuffer, you can use the normal commands
|
|
|
|
|
available in the minibuffer, and can, for instance, temporarily
|
|
|
|
|
switch to another buffer, do things there, and then switch back
|
|
|
|
|
to the minibuffer before entering the character. This is not
|
|
|
|
|
possible when using `read-key', but using `read-key' may be less
|
|
|
|
|
confusing to some users.")
|
2020-12-30 09:54:01 +00:00
|
|
|
|
|
2022-01-29 15:54:43 +00:00
|
|
|
|
(defvar from--tty-menu-p nil
|
|
|
|
|
"Non-nil means the current command was invoked from a TTY menu.")
|
2024-02-06 05:10:57 +00:00
|
|
|
|
|
|
|
|
|
(declare-function android-detect-keyboard "androidfns.c")
|
|
|
|
|
|
2024-02-25 03:41:02 +00:00
|
|
|
|
(defvar use-dialog-box-override nil
|
|
|
|
|
"Whether `use-dialog-box-p' should always return t.")
|
|
|
|
|
|
2022-01-27 18:54:48 +00:00
|
|
|
|
(defun use-dialog-box-p ()
|
2023-04-02 08:42:43 +00:00
|
|
|
|
"Return non-nil if the current command should prompt the user via a dialog box."
|
2024-02-25 03:41:02 +00:00
|
|
|
|
(or use-dialog-box-override
|
|
|
|
|
(and last-input-event ; not during startup
|
|
|
|
|
(or (consp last-nonmenu-event) ; invoked by a mouse event
|
|
|
|
|
(and (null last-nonmenu-event)
|
|
|
|
|
(consp last-input-event))
|
|
|
|
|
(and (featurep 'android) ; Prefer dialog boxes on
|
|
|
|
|
; Android.
|
|
|
|
|
(not (android-detect-keyboard))) ; If no keyboard is
|
|
|
|
|
; connected.
|
|
|
|
|
from--tty-menu-p) ; invoked via TTY menu
|
|
|
|
|
use-dialog-box)))
|
2022-01-27 18:54:48 +00:00
|
|
|
|
|
2011-01-20 02:55:36 +00:00
|
|
|
|
(defun y-or-n-p (prompt)
|
2016-04-29 22:02:46 +00:00
|
|
|
|
"Ask user a \"y or n\" question.
|
|
|
|
|
Return t if answer is \"y\" and nil if it is \"n\".
|
2021-09-16 07:23:51 +00:00
|
|
|
|
|
|
|
|
|
PROMPT is the string to display to ask the question; `y-or-n-p'
|
2023-05-12 10:45:32 +00:00
|
|
|
|
adds \"(y or n) \" to it. If PROMPT is a non-empty string, and
|
|
|
|
|
it ends with a non-space character, a space character will be
|
|
|
|
|
appended to it.
|
2011-01-08 21:17:58 +00:00
|
|
|
|
|
2020-11-21 19:49:46 +00:00
|
|
|
|
If you bind the variable `help-form' to a non-nil value
|
|
|
|
|
while calling this function, then pressing `help-char'
|
|
|
|
|
causes it to evaluate `help-form' and display the result.
|
|
|
|
|
PROMPT is also updated to show `help-char' like \"(y, n or C-h) \",
|
|
|
|
|
where `help-char' is automatically bound to `help-form-show'.
|
|
|
|
|
|
2012-09-09 06:43:47 +00:00
|
|
|
|
No confirmation of the answer is requested; a single character is
|
2021-10-10 17:31:15 +00:00
|
|
|
|
enough. SPC also means yes, and DEL means no.
|
2012-09-09 06:43:47 +00:00
|
|
|
|
|
|
|
|
|
To be precise, this function translates user input into responses
|
|
|
|
|
by consulting the bindings in `query-replace-map'; see the
|
|
|
|
|
documentation of that variable for more information. In this
|
|
|
|
|
case, the useful bindings are `act', `skip', `recenter',
|
|
|
|
|
`scroll-up', `scroll-down', and `quit'.
|
|
|
|
|
An `act' response means yes, and a `skip' response means no.
|
2019-11-09 22:04:13 +00:00
|
|
|
|
A `quit' response means to invoke `abort-recursive-edit'.
|
2012-09-09 06:43:47 +00:00
|
|
|
|
If the user enters `recenter', `scroll-up', or `scroll-down'
|
|
|
|
|
responses, perform the requested window recentering or scrolling
|
|
|
|
|
and ask again.
|
2011-01-07 17:34:02 +00:00
|
|
|
|
|
2023-05-23 14:44:23 +00:00
|
|
|
|
If dialog boxes are supported, this function will use a dialog box
|
|
|
|
|
if `use-dialog-box' is non-nil and the last input event was produced
|
|
|
|
|
by a mouse, or by some window-system gesture, or via a menu.
|
2021-09-05 10:02:16 +00:00
|
|
|
|
|
|
|
|
|
By default, this function uses the minibuffer to read the key.
|
|
|
|
|
If `y-or-n-p-use-read-key' is non-nil, `read-key' is used
|
|
|
|
|
instead (which means that the user can't change buffers (and the
|
|
|
|
|
like) while `y-or-n-p' is running)."
|
2014-02-27 14:21:28 +00:00
|
|
|
|
(let ((answer 'recenter)
|
|
|
|
|
(padded (lambda (prompt &optional dialog)
|
|
|
|
|
(let ((l (length prompt)))
|
|
|
|
|
(concat prompt
|
|
|
|
|
(if (or (zerop l) (eq ?\s (aref prompt (1- l))))
|
|
|
|
|
"" " ")
|
2020-11-21 19:49:46 +00:00
|
|
|
|
(if dialog ""
|
2023-02-04 08:15:18 +00:00
|
|
|
|
;; Don't clobber caller's match data.
|
|
|
|
|
(save-match-data
|
|
|
|
|
(substitute-command-keys
|
|
|
|
|
(if help-form
|
|
|
|
|
(format "(\\`y', \\`n' or \\`%s') "
|
|
|
|
|
(key-description
|
|
|
|
|
(vector help-char)))
|
|
|
|
|
"(\\`y' or \\`n') "))))))))
|
2022-07-11 12:51:34 +00:00
|
|
|
|
;; Preserve the actual command that eventually called
|
|
|
|
|
;; `y-or-n-p' (otherwise `repeat' will be repeating
|
|
|
|
|
;; `exit-minibuffer').
|
|
|
|
|
(real-this-command real-this-command))
|
2011-10-29 08:41:39 +00:00
|
|
|
|
(cond
|
|
|
|
|
(noninteractive
|
2014-02-27 14:21:28 +00:00
|
|
|
|
(setq prompt (funcall padded prompt))
|
2011-10-29 08:41:39 +00:00
|
|
|
|
(let ((temp-prompt prompt))
|
|
|
|
|
(while (not (memq answer '(act skip)))
|
|
|
|
|
(let ((str (read-string temp-prompt)))
|
|
|
|
|
(cond ((member str '("y" "Y")) (setq answer 'act))
|
|
|
|
|
((member str '("n" "N")) (setq answer 'skip))
|
2020-11-21 19:49:46 +00:00
|
|
|
|
((and (member str '("h" "H")) help-form) (print help-form))
|
2011-10-29 08:41:39 +00:00
|
|
|
|
(t (setq temp-prompt (concat "Please answer y or n. "
|
|
|
|
|
prompt))))))))
|
2022-01-27 18:54:48 +00:00
|
|
|
|
((use-dialog-box-p)
|
2014-02-27 14:21:28 +00:00
|
|
|
|
(setq prompt (funcall padded prompt t)
|
|
|
|
|
answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
|
2020-12-30 09:54:01 +00:00
|
|
|
|
(y-or-n-p-use-read-key
|
|
|
|
|
;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
|
|
|
|
|
;; where all the keys were unbound (i.e. it somehow got triggered
|
|
|
|
|
;; within read-key, apparently). I had to kill it.
|
|
|
|
|
(setq prompt (funcall padded prompt))
|
|
|
|
|
(while
|
|
|
|
|
(let* ((scroll-actions '(recenter scroll-up scroll-down
|
|
|
|
|
scroll-other-window scroll-other-window-down))
|
|
|
|
|
(key
|
|
|
|
|
(let ((cursor-in-echo-area t))
|
|
|
|
|
(when minibuffer-auto-raise
|
|
|
|
|
(raise-frame (window-frame (minibuffer-window))))
|
|
|
|
|
(read-key (propertize (if (memq answer scroll-actions)
|
|
|
|
|
prompt
|
|
|
|
|
(concat "Please answer y or n. "
|
|
|
|
|
prompt))
|
|
|
|
|
'face 'minibuffer-prompt)))))
|
|
|
|
|
(setq answer (lookup-key query-replace-map (vector key) t))
|
|
|
|
|
(cond
|
|
|
|
|
((memq answer '(skip act)) nil)
|
|
|
|
|
((eq answer 'recenter)
|
|
|
|
|
(recenter) t)
|
|
|
|
|
((eq answer 'scroll-up)
|
|
|
|
|
(ignore-errors (scroll-up-command)) t)
|
|
|
|
|
((eq answer 'scroll-down)
|
|
|
|
|
(ignore-errors (scroll-down-command)) t)
|
|
|
|
|
((eq answer 'scroll-other-window)
|
|
|
|
|
(ignore-errors (scroll-other-window)) t)
|
|
|
|
|
((eq answer 'scroll-other-window-down)
|
|
|
|
|
(ignore-errors (scroll-other-window-down)) t)
|
|
|
|
|
((or (memq answer '(exit-prefix quit)) (eq key ?\e))
|
|
|
|
|
(signal 'quit nil) t)
|
|
|
|
|
(t t)))
|
|
|
|
|
(ding)
|
|
|
|
|
(discard-input)))
|
2011-10-29 08:41:39 +00:00
|
|
|
|
(t
|
2014-02-27 14:21:28 +00:00
|
|
|
|
(setq prompt (funcall padded prompt))
|
2022-07-17 18:06:31 +00:00
|
|
|
|
(let* ((enable-recursive-minibuffers t)
|
2020-11-21 19:49:46 +00:00
|
|
|
|
(msg help-form)
|
2023-02-19 02:47:32 +00:00
|
|
|
|
;; Disable text conversion so that real Y or N events are
|
|
|
|
|
;; sent.
|
|
|
|
|
(overriding-text-conversion-style nil)
|
2020-11-21 19:49:46 +00:00
|
|
|
|
(keymap (let ((map (make-composed-keymap
|
|
|
|
|
y-or-n-p-map query-replace-map)))
|
|
|
|
|
(when help-form
|
|
|
|
|
;; Create a new map before modifying
|
|
|
|
|
(setq map (copy-keymap map))
|
|
|
|
|
(define-key map (vector help-char)
|
|
|
|
|
(lambda ()
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((help-form msg)) ; lexically bound msg
|
|
|
|
|
(help-form-show)))))
|
|
|
|
|
map))
|
2020-12-06 21:07:36 +00:00
|
|
|
|
;; Protect this-command when called from pre-command-hook (bug#45029)
|
|
|
|
|
(this-command this-command)
|
Update Android port
* configure.ac: Add support for HarfBuzz on Android.
* java/INSTALL: Document where to get Emacs with HarfBuzz.
* lisp/subr.el (overriding-text-conversion-style, y-or-n-p):
Correctly set text conversion style if y-or-n-p is called inside
the minibuffer.
* src/sfnt.c (sfnt_read_cmap_format_8)
(sfnt_read_cmap_format_12): Fix typos.
(sfnt_read_24, sfnt_read_cmap_format_14): New function.
(sfnt_read_cmap_table_1, sfnt_read_cmap_table): Handle format 14
cmap tables.
(sfnt_read_default_uvs_table, sfnt_read_nondefault_uvs_table)
(sfnt_compare_table_offsets, sfnt_create_uvs_context)
(sfnt_free_uvs_context, sfnt_compare_uvs_mapping)
(sfnt_variation_glyph_for_char, sfnt_map_table, sfnt_unmap_table)
(sfnt_read_table, sfnt_test_uvs): New functions.
(main): Add UVS tests.
* src/sfnt.h (struct sfnt_cmap_format_14)
(struct sfnt_variation_selector_record)
(struct sfnt_default_uvs_table, struct sfnt_unicode_value_range)
(struct sfnt_nondefault_uvs_table, struct sfnt_uvs_mapping)
(struct sfnt_mapped_variation_selector_record)
(struct sfnt_table_offset_rec, struct sfnt_uvs_context)
(struct sfnt_mapped_table): New structures. Update prototypes.
* src/sfntfont-android.c (android_sfntfont_driver): Register
HarfBuzz callbacks where required.
* src/sfntfont.c (sfntfont_select_cmap): Look for a format 14
table. Save it in new arg FORMAT14.
(sfntfont_read_cmap): Adjust accordingly.
(struct sfnt_font_info): New field `uvs'. New fields `hb_font',
`fd' and `directory'.
(sfntfont_open): Open uvs context. Under HarfBuzz, don't close
the fd or subtable, but save them in the font info instead.
(sfntfont_close): Free UVS context. Close font fd and table
directory and HarfBuzz font.
(sfntfont_draw): Handle case where s->padding_p.
(sfntfont_get_variation_glyphs): New function.
(sfntfont_unmap_blob, sfntfont_get_font_table)
(sfntfont_begin_hb_font): New functions.
* src/sfntfont.h: Update prototypes.
* src/textconv.c (Fset_text_conversion_style): Fix doc string.
2023-03-20 06:47:39 +00:00
|
|
|
|
(str (progn
|
2023-07-31 02:50:12 +00:00
|
|
|
|
;; If the minibuffer is already active, the
|
|
|
|
|
;; selected window might not change. Disable
|
|
|
|
|
;; text conversion by hand.
|
2023-08-05 09:16:16 +00:00
|
|
|
|
(when (fboundp 'set-text-conversion-style)
|
|
|
|
|
(set-text-conversion-style text-conversion-style))
|
Update Android port
* configure.ac: Add support for HarfBuzz on Android.
* java/INSTALL: Document where to get Emacs with HarfBuzz.
* lisp/subr.el (overriding-text-conversion-style, y-or-n-p):
Correctly set text conversion style if y-or-n-p is called inside
the minibuffer.
* src/sfnt.c (sfnt_read_cmap_format_8)
(sfnt_read_cmap_format_12): Fix typos.
(sfnt_read_24, sfnt_read_cmap_format_14): New function.
(sfnt_read_cmap_table_1, sfnt_read_cmap_table): Handle format 14
cmap tables.
(sfnt_read_default_uvs_table, sfnt_read_nondefault_uvs_table)
(sfnt_compare_table_offsets, sfnt_create_uvs_context)
(sfnt_free_uvs_context, sfnt_compare_uvs_mapping)
(sfnt_variation_glyph_for_char, sfnt_map_table, sfnt_unmap_table)
(sfnt_read_table, sfnt_test_uvs): New functions.
(main): Add UVS tests.
* src/sfnt.h (struct sfnt_cmap_format_14)
(struct sfnt_variation_selector_record)
(struct sfnt_default_uvs_table, struct sfnt_unicode_value_range)
(struct sfnt_nondefault_uvs_table, struct sfnt_uvs_mapping)
(struct sfnt_mapped_variation_selector_record)
(struct sfnt_table_offset_rec, struct sfnt_uvs_context)
(struct sfnt_mapped_table): New structures. Update prototypes.
* src/sfntfont-android.c (android_sfntfont_driver): Register
HarfBuzz callbacks where required.
* src/sfntfont.c (sfntfont_select_cmap): Look for a format 14
table. Save it in new arg FORMAT14.
(sfntfont_read_cmap): Adjust accordingly.
(struct sfnt_font_info): New field `uvs'. New fields `hb_font',
`fd' and `directory'.
(sfntfont_open): Open uvs context. Under HarfBuzz, don't close
the fd or subtable, but save them in the font info instead.
(sfntfont_close): Free UVS context. Close font fd and table
directory and HarfBuzz font.
(sfntfont_draw): Handle case where s->padding_p.
(sfntfont_get_variation_glyphs): New function.
(sfntfont_unmap_blob, sfntfont_get_font_table)
(sfntfont_begin_hb_font): New functions.
* src/sfntfont.h: Update prototypes.
* src/textconv.c (Fset_text_conversion_style): Fix doc string.
2023-03-20 06:47:39 +00:00
|
|
|
|
(read-from-minibuffer
|
|
|
|
|
prompt nil keymap nil
|
|
|
|
|
(or y-or-n-p-history-variable t)))))
|
2019-11-09 22:04:13 +00:00
|
|
|
|
(setq answer (if (member str '("y" "Y")) 'act 'skip)))))
|
2011-01-07 17:34:02 +00:00
|
|
|
|
(let ((ret (eq answer 'act)))
|
|
|
|
|
(unless noninteractive
|
2014-02-27 14:21:28 +00:00
|
|
|
|
(message "%s%c" prompt (if ret ?y ?n)))
|
2011-01-07 17:34:02 +00:00
|
|
|
|
ret)))
|
|
|
|
|
|
1997-12-21 00:50:07 +00:00
|
|
|
|
|
2002-04-19 00:06:54 +00:00
|
|
|
|
;;; Atomic change groups.
|
|
|
|
|
|
2002-02-06 15:20:36 +00:00
|
|
|
|
(defmacro atomic-change-group (&rest body)
|
2018-01-30 14:55:09 +00:00
|
|
|
|
"Like `progn' but perform BODY as an atomic change group.
|
2002-02-06 15:20:36 +00:00
|
|
|
|
This means that if BODY exits abnormally,
|
|
|
|
|
all of its changes to the current buffer are undone.
|
2002-08-02 17:59:22 +00:00
|
|
|
|
This works regardless of whether undo is enabled in the buffer.
|
2002-02-06 15:20:36 +00:00
|
|
|
|
|
2023-06-06 13:00:44 +00:00
|
|
|
|
Do not call functions which edit the undo list within BODY; see
|
|
|
|
|
`prepare-change-group'.
|
|
|
|
|
|
2002-02-06 15:20:36 +00:00
|
|
|
|
This mechanism is transparent to ordinary use of undo;
|
|
|
|
|
if undo is enabled in the buffer and BODY succeeds, the
|
|
|
|
|
user can undo the change normally."
|
2005-12-03 02:31:40 +00:00
|
|
|
|
(declare (indent 0) (debug t))
|
2002-02-06 15:20:36 +00:00
|
|
|
|
(let ((handle (make-symbol "--change-group-handle--"))
|
|
|
|
|
(success (make-symbol "--change-group-success--")))
|
|
|
|
|
`(let ((,handle (prepare-change-group))
|
2008-01-11 14:44:15 +00:00
|
|
|
|
;; Don't truncate any undo data in the middle of this.
|
|
|
|
|
(undo-outer-limit nil)
|
|
|
|
|
(undo-limit most-positive-fixnum)
|
|
|
|
|
(undo-strong-limit most-positive-fixnum)
|
2002-02-06 15:20:36 +00:00
|
|
|
|
(,success nil))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
;; This is inside the unwind-protect because
|
|
|
|
|
;; it enables undo if that was disabled; we need
|
|
|
|
|
;; to make sure that it gets disabled again.
|
|
|
|
|
(activate-change-group ,handle)
|
2018-01-30 14:55:09 +00:00
|
|
|
|
(prog1 ,(macroexp-progn body)
|
|
|
|
|
(setq ,success t)))
|
2002-02-06 15:20:36 +00:00
|
|
|
|
;; Either of these functions will disable undo
|
|
|
|
|
;; if it was disabled before.
|
|
|
|
|
(if ,success
|
|
|
|
|
(accept-change-group ,handle)
|
|
|
|
|
(cancel-change-group ,handle))))))
|
|
|
|
|
|
2021-11-08 05:33:39 +00:00
|
|
|
|
(defmacro with-undo-amalgamate (&rest body)
|
|
|
|
|
"Like `progn' but perform BODY with amalgamated undo barriers.
|
|
|
|
|
|
|
|
|
|
This allows multiple operations to be undone in a single step.
|
|
|
|
|
When undo is disabled this behaves like `progn'."
|
|
|
|
|
(declare (indent 0) (debug t))
|
|
|
|
|
(let ((handle (make-symbol "--change-group-handle--")))
|
|
|
|
|
`(let ((,handle (prepare-change-group))
|
|
|
|
|
;; Don't truncate any undo data in the middle of this,
|
|
|
|
|
;; otherwise Emacs might truncate part of the resulting
|
|
|
|
|
;; undo step: we want to mimic the behavior we'd get if the
|
|
|
|
|
;; undo-boundaries were never added in the first place.
|
|
|
|
|
(undo-outer-limit nil)
|
|
|
|
|
(undo-limit most-positive-fixnum)
|
|
|
|
|
(undo-strong-limit most-positive-fixnum))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(activate-change-group ,handle)
|
|
|
|
|
,@body)
|
|
|
|
|
(progn
|
|
|
|
|
(accept-change-group ,handle)
|
|
|
|
|
(undo-amalgamate-change-group ,handle))))))
|
|
|
|
|
|
2003-05-18 15:04:24 +00:00
|
|
|
|
(defun prepare-change-group (&optional buffer)
|
2002-02-06 15:20:36 +00:00
|
|
|
|
"Return a handle for the current buffer's state, for a change group.
|
2003-05-18 15:04:24 +00:00
|
|
|
|
If you specify BUFFER, make a handle for BUFFER's state instead.
|
2002-02-06 15:20:36 +00:00
|
|
|
|
|
|
|
|
|
Pass the handle to `activate-change-group' afterward to initiate
|
|
|
|
|
the actual changes of the change group.
|
|
|
|
|
|
|
|
|
|
To finish the change group, call either `accept-change-group' or
|
|
|
|
|
`cancel-change-group' passing the same handle as argument. Call
|
|
|
|
|
`accept-change-group' to accept the changes in the group as final;
|
|
|
|
|
call `cancel-change-group' to undo them all. You should use
|
|
|
|
|
`unwind-protect' to make sure the group is always finished. The call
|
|
|
|
|
to `activate-change-group' should be inside the `unwind-protect'.
|
|
|
|
|
Once you finish the group, don't use the handle again--don't try to
|
|
|
|
|
finish the same group twice. For a simple example of correct use, see
|
|
|
|
|
the source code of `atomic-change-group'.
|
|
|
|
|
|
2023-06-06 13:00:44 +00:00
|
|
|
|
As long as this handle is still in use, do not call functions
|
|
|
|
|
which edit the undo list: if it no longer contains its current
|
|
|
|
|
value, Emacs will not be able to cancel the change group. This
|
|
|
|
|
includes any \"amalgamating\" commands, such as `delete-char',
|
|
|
|
|
which call `undo-auto-amalgamate'.
|
|
|
|
|
|
2002-02-06 15:20:36 +00:00
|
|
|
|
The handle records only the specified buffer. To make a multibuffer
|
|
|
|
|
change group, call this function once for each buffer you want to
|
|
|
|
|
cover, then use `nconc' to combine the returned values, like this:
|
|
|
|
|
|
|
|
|
|
(nconc (prepare-change-group buffer-1)
|
|
|
|
|
(prepare-change-group buffer-2))
|
|
|
|
|
|
|
|
|
|
You can then activate that multibuffer change group with a single
|
|
|
|
|
call to `activate-change-group' and finish it with a single call
|
|
|
|
|
to `accept-change-group' or `cancel-change-group'."
|
|
|
|
|
|
2003-05-18 15:04:24 +00:00
|
|
|
|
(if buffer
|
|
|
|
|
(list (cons buffer (with-current-buffer buffer buffer-undo-list)))
|
|
|
|
|
(list (cons (current-buffer) buffer-undo-list))))
|
2002-02-06 15:20:36 +00:00
|
|
|
|
|
|
|
|
|
(defun activate-change-group (handle)
|
|
|
|
|
"Activate a change group made with `prepare-change-group' (which see)."
|
|
|
|
|
(dolist (elt handle)
|
|
|
|
|
(with-current-buffer (car elt)
|
|
|
|
|
(if (eq buffer-undo-list t)
|
2020-11-27 14:43:56 +00:00
|
|
|
|
(setq buffer-undo-list nil)
|
|
|
|
|
;; Add a boundary to make sure the upcoming changes won't be
|
2020-11-27 15:19:21 +00:00
|
|
|
|
;; merged/combined with any previous changes (bug#33341).
|
|
|
|
|
;; We're not supposed to introduce a real (visible)
|
|
|
|
|
;; `undo-boundary', tho, so we have to push something else
|
|
|
|
|
;; that acts like a boundary w.r.t preventing merges while
|
|
|
|
|
;; being harmless.
|
|
|
|
|
;; We use for that an "empty insertion", but in order to be harmless,
|
|
|
|
|
;; it has to be at a harmless position. Currently only
|
|
|
|
|
;; insertions are ever merged/combined, so we use such a "boundary"
|
|
|
|
|
;; only when the last change was an insertion and we use the position
|
|
|
|
|
;; of the last insertion.
|
2021-02-24 18:52:45 +00:00
|
|
|
|
(when (numberp (car-safe (car buffer-undo-list)))
|
2020-11-27 15:19:21 +00:00
|
|
|
|
(push (cons (caar buffer-undo-list) (caar buffer-undo-list))
|
|
|
|
|
buffer-undo-list))))))
|
2002-02-06 15:20:36 +00:00
|
|
|
|
|
|
|
|
|
(defun accept-change-group (handle)
|
|
|
|
|
"Finish a change group made with `prepare-change-group' (which see).
|
|
|
|
|
This finishes the change group by accepting its changes as final."
|
|
|
|
|
(dolist (elt handle)
|
|
|
|
|
(with-current-buffer (car elt)
|
2012-04-23 15:48:22 +00:00
|
|
|
|
(if (eq (cdr elt) t)
|
2002-02-06 15:20:36 +00:00
|
|
|
|
(setq buffer-undo-list t)))))
|
|
|
|
|
|
|
|
|
|
(defun cancel-change-group (handle)
|
|
|
|
|
"Finish a change group made with `prepare-change-group' (which see).
|
|
|
|
|
This finishes the change group by reverting all of its changes."
|
|
|
|
|
(dolist (elt handle)
|
|
|
|
|
(with-current-buffer (car elt)
|
|
|
|
|
(setq elt (cdr elt))
|
2008-09-07 09:16:56 +00:00
|
|
|
|
(save-restriction
|
|
|
|
|
;; Widen buffer temporarily so if the buffer was narrowed within
|
|
|
|
|
;; the body of `atomic-change-group' all changes can be undone.
|
|
|
|
|
(widen)
|
2016-07-26 17:14:50 +00:00
|
|
|
|
(let ((old-car (car-safe elt))
|
2020-03-12 14:01:54 +00:00
|
|
|
|
(old-cdr (cdr-safe elt))
|
|
|
|
|
;; Use `pending-undo-list' temporarily since `undo-more' needs
|
|
|
|
|
;; it, but restore it afterwards so as not to mess with an
|
|
|
|
|
;; ongoing sequence of `undo's.
|
|
|
|
|
(pending-undo-list
|
|
|
|
|
;; Use `buffer-undo-list' unconditionally (bug#39680).
|
|
|
|
|
buffer-undo-list))
|
2016-07-26 17:14:50 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
;; Temporarily truncate the undo log at ELT.
|
|
|
|
|
(when (consp elt)
|
|
|
|
|
(setcar elt nil) (setcdr elt nil))
|
|
|
|
|
;; Make sure there's no confusion.
|
|
|
|
|
(when (and (consp elt) (not (eq elt (last pending-undo-list))))
|
|
|
|
|
(error "Undoing to some unrelated state"))
|
|
|
|
|
;; Undo it all.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(while (listp pending-undo-list) (undo-more 1)))
|
|
|
|
|
;; Revert the undo info to what it was when we grabbed
|
|
|
|
|
;; the state.
|
|
|
|
|
(setq buffer-undo-list elt))
|
|
|
|
|
;; Reset the modified cons cell ELT to its original content.
|
|
|
|
|
(when (consp elt)
|
|
|
|
|
(setcar elt old-car)
|
2020-03-12 14:03:14 +00:00
|
|
|
|
(setcdr elt old-cdr))))))))
|
2002-02-06 15:20:36 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Display-related functions.
|
|
|
|
|
|
2001-11-28 04:03:53 +00:00
|
|
|
|
(defun momentary-string-display (string pos &optional exit-char message)
|
1990-11-05 10:06:02 +00:00
|
|
|
|
"Momentarily display STRING in the buffer at POS.
|
2004-04-27 13:07:16 +00:00
|
|
|
|
Display remains until next event is input.
|
2007-01-02 23:49:25 +00:00
|
|
|
|
If POS is a marker, only its position is used; its buffer is ignored.
|
2004-04-27 13:07:16 +00:00
|
|
|
|
Optional third arg EXIT-CHAR can be a character, event or event
|
|
|
|
|
description list. EXIT-CHAR defaults to SPC. If the input is
|
|
|
|
|
EXIT-CHAR it is swallowed; otherwise it is then available as
|
|
|
|
|
input (as a command if nothing else).
|
1990-11-05 10:06:02 +00:00
|
|
|
|
Display MESSAGE (optional fourth arg) in the echo area.
|
|
|
|
|
If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
|
2006-11-27 14:05:58 +00:00
|
|
|
|
(or exit-char (setq exit-char ?\s))
|
2008-06-10 16:12:18 +00:00
|
|
|
|
(let ((ol (make-overlay pos pos))
|
2010-03-03 03:58:26 +00:00
|
|
|
|
(str (copy-sequence string)))
|
1990-11-05 10:06:02 +00:00
|
|
|
|
(unwind-protect
|
2008-06-10 16:12:18 +00:00
|
|
|
|
(progn
|
|
|
|
|
(save-excursion
|
2010-03-03 03:58:26 +00:00
|
|
|
|
(overlay-put ol 'after-string str)
|
2008-06-10 16:12:18 +00:00
|
|
|
|
(goto-char pos)
|
|
|
|
|
;; To avoid trouble with out-of-bounds position
|
|
|
|
|
(setq pos (point))
|
2010-03-03 03:58:26 +00:00
|
|
|
|
;; If the string end is off screen, recenter now.
|
2008-06-10 16:12:18 +00:00
|
|
|
|
(if (<= (window-end nil t) pos)
|
|
|
|
|
(recenter (/ (window-height) 2))))
|
|
|
|
|
(message (or message "Type %s to continue editing.")
|
|
|
|
|
(single-key-description exit-char))
|
2013-07-06 00:10:54 +00:00
|
|
|
|
(let ((event (read-key)))
|
2010-05-31 14:13:41 +00:00
|
|
|
|
;; `exit-char' can be an event, or an event description list.
|
|
|
|
|
(or (eq event exit-char)
|
|
|
|
|
(eq event (event-convert-list exit-char))
|
2013-07-06 00:10:54 +00:00
|
|
|
|
(setq unread-command-events
|
2015-07-25 16:54:42 +00:00
|
|
|
|
(append (this-single-command-raw-keys)
|
|
|
|
|
unread-command-events)))))
|
2008-06-10 16:12:18 +00:00
|
|
|
|
(delete-overlay ol))))
|
1990-11-05 10:06:02 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2001-11-28 04:03:53 +00:00
|
|
|
|
;;;; Overlay operations
|
|
|
|
|
|
|
|
|
|
(defun copy-overlay (o)
|
|
|
|
|
"Return a copy of overlay O."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2010-02-11 19:35:36 +00:00
|
|
|
|
(let ((o1 (if (overlay-buffer o)
|
|
|
|
|
(make-overlay (overlay-start o) (overlay-end o)
|
|
|
|
|
;; FIXME: there's no easy way to find the
|
2022-12-14 18:13:47 +00:00
|
|
|
|
;; insertion-type of overlay's start and end.
|
2010-02-11 19:35:36 +00:00
|
|
|
|
(overlay-buffer o))
|
|
|
|
|
(let ((o1 (make-overlay (point-min) (point-min))))
|
|
|
|
|
(delete-overlay o1)
|
2010-02-11 19:37:11 +00:00
|
|
|
|
o1)))
|
2001-11-28 04:03:53 +00:00
|
|
|
|
(props (overlay-properties o)))
|
|
|
|
|
(while props
|
|
|
|
|
(overlay-put o1 (pop props) (pop props)))
|
|
|
|
|
o1))
|
|
|
|
|
|
2004-04-27 21:00:31 +00:00
|
|
|
|
(defun remove-overlays (&optional beg end name val)
|
2020-08-25 14:22:07 +00:00
|
|
|
|
"Remove overlays between BEG and END that have property NAME with value VAL.
|
|
|
|
|
Overlays might be moved and/or split. If any targeted overlays
|
|
|
|
|
start before BEG, the overlays will be altered so that they end
|
|
|
|
|
at BEG. Likewise, if the targeted overlays end after END, they
|
|
|
|
|
will be altered so that they start at END. Overlays that start
|
|
|
|
|
at or after BEG and end before END will be removed completely.
|
|
|
|
|
|
|
|
|
|
BEG and END default respectively to the beginning and end of the
|
|
|
|
|
buffer.
|
|
|
|
|
Values are compared with `eq'.
|
|
|
|
|
If either NAME or VAL are specified, both should be specified."
|
2006-11-08 17:31:46 +00:00
|
|
|
|
;; This speeds up the loops over overlays.
|
2004-04-27 21:00:31 +00:00
|
|
|
|
(unless beg (setq beg (point-min)))
|
|
|
|
|
(unless end (setq end (point-max)))
|
2006-11-12 19:55:58 +00:00
|
|
|
|
(overlay-recenter end)
|
2001-11-28 04:03:53 +00:00
|
|
|
|
(if (< end beg)
|
|
|
|
|
(setq beg (prog1 end (setq end beg))))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(dolist (o (overlays-in beg end))
|
|
|
|
|
(when (eq (overlay-get o name) val)
|
|
|
|
|
;; Either push this overlay outside beg...end
|
|
|
|
|
;; or split it to exclude beg...end
|
|
|
|
|
;; or delete it entirely (if it is contained in beg...end).
|
|
|
|
|
(if (< (overlay-start o) beg)
|
|
|
|
|
(if (> (overlay-end o) end)
|
|
|
|
|
(progn
|
|
|
|
|
(move-overlay (copy-overlay o)
|
|
|
|
|
(overlay-start o) beg)
|
|
|
|
|
(move-overlay o end (overlay-end o)))
|
|
|
|
|
(move-overlay o (overlay-start o) beg))
|
|
|
|
|
(if (> (overlay-end o) end)
|
|
|
|
|
(move-overlay o end (overlay-end o))
|
|
|
|
|
(delete-overlay o)))))))
|
2002-01-23 17:46:44 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
;;;; Miscellanea.
|
|
|
|
|
|
1998-02-04 21:04:41 +00:00
|
|
|
|
(defvar suspend-hook nil
|
|
|
|
|
"Normal hook run by `suspend-emacs', before suspending.")
|
|
|
|
|
|
|
|
|
|
(defvar suspend-resume-hook nil
|
|
|
|
|
"Normal hook run by `suspend-emacs', after Emacs is continued.")
|
|
|
|
|
|
2021-10-12 11:55:28 +00:00
|
|
|
|
(defvar after-pdump-load-hook nil
|
|
|
|
|
"Normal hook run after loading the .pdmp file.")
|
|
|
|
|
|
2001-12-16 18:36:50 +00:00
|
|
|
|
(defvar temp-buffer-show-hook nil
|
|
|
|
|
"Normal hook run by `with-output-to-temp-buffer' after displaying the buffer.
|
|
|
|
|
When the hook runs, the temporary buffer is current, and the window it
|
2008-08-23 03:02:23 +00:00
|
|
|
|
was displayed in is selected.")
|
2001-12-16 18:36:50 +00:00
|
|
|
|
|
|
|
|
|
(defvar temp-buffer-setup-hook nil
|
|
|
|
|
"Normal hook run by `with-output-to-temp-buffer' at the start.
|
|
|
|
|
When the hook runs, the temporary buffer is current.
|
|
|
|
|
This hook is normally set up with a function to put the buffer in Help
|
|
|
|
|
mode.")
|
|
|
|
|
|
2019-09-01 01:17:20 +00:00
|
|
|
|
(defvar user-emacs-directory
|
2019-08-31 21:47:04 +00:00
|
|
|
|
;; The value does not matter since Emacs sets this at startup.
|
|
|
|
|
nil
|
2007-06-13 00:03:28 +00:00
|
|
|
|
"Directory beneath which additional per-user Emacs-specific files are placed.
|
|
|
|
|
Various programs in Emacs store information in this directory.
|
2008-10-24 09:39:27 +00:00
|
|
|
|
Note that this should end with a directory separator.
|
|
|
|
|
See also `locate-user-emacs-file'.")
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Misc. useful functions.
|
1994-12-25 22:20:06 +00:00
|
|
|
|
|
2012-09-07 08:58:31 +00:00
|
|
|
|
(defsubst buffer-narrowed-p ()
|
|
|
|
|
"Return non-nil if the current buffer is narrowed."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2012-09-07 08:58:31 +00:00
|
|
|
|
(/= (- (point-max) (point-min)) (buffer-size)))
|
|
|
|
|
|
2023-02-13 18:11:28 +00:00
|
|
|
|
(defmacro with-restriction (start end &rest rest)
|
2022-11-25 21:43:48 +00:00
|
|
|
|
"Execute BODY with restrictions set to START and END.
|
|
|
|
|
|
|
|
|
|
The current restrictions, if any, are restored upon return.
|
|
|
|
|
|
2023-07-09 19:27:12 +00:00
|
|
|
|
When the optional LABEL argument, which is evaluated to get the
|
|
|
|
|
label to use and must yield a non-nil value, is present, inside
|
|
|
|
|
BODY, `narrow-to-region' and `widen' can be used only within the
|
|
|
|
|
START and END limits. To gain access to other portions of the
|
|
|
|
|
buffer, use `without-restriction' with the same LABEL argument.
|
2022-11-25 21:43:48 +00:00
|
|
|
|
|
2023-02-09 01:09:10 +00:00
|
|
|
|
\(fn START END [:label LABEL] BODY)"
|
2023-06-13 02:43:44 +00:00
|
|
|
|
(declare (indent 2) (debug t))
|
2023-02-09 01:09:10 +00:00
|
|
|
|
(if (eq (car rest) :label)
|
2023-08-16 15:58:39 +00:00
|
|
|
|
`(save-restriction
|
|
|
|
|
(internal--labeled-narrow-to-region ,start ,end ,(cadr rest))
|
|
|
|
|
,@(cddr rest))
|
|
|
|
|
`(save-restriction (narrow-to-region ,start ,end) ,@rest)))
|
2023-02-09 01:09:10 +00:00
|
|
|
|
|
2023-02-13 18:11:28 +00:00
|
|
|
|
(defmacro without-restriction (&rest rest)
|
2023-02-09 01:09:10 +00:00
|
|
|
|
"Execute BODY without restrictions.
|
|
|
|
|
|
|
|
|
|
The current restrictions, if any, are restored upon return.
|
|
|
|
|
|
2023-07-09 19:27:12 +00:00
|
|
|
|
When the optional LABEL argument is present, the restrictions set
|
|
|
|
|
by `with-restriction' with the same LABEL argument are lifted.
|
2023-02-09 01:09:10 +00:00
|
|
|
|
|
2023-02-09 01:09:10 +00:00
|
|
|
|
\(fn [:label LABEL] BODY)"
|
2023-03-08 09:55:06 +00:00
|
|
|
|
(declare (indent 0) (debug t))
|
2023-02-09 01:09:10 +00:00
|
|
|
|
(if (eq (car rest) :label)
|
2023-08-16 15:58:39 +00:00
|
|
|
|
`(save-restriction (internal--labeled-widen ,(cadr rest)) ,@(cddr rest))
|
|
|
|
|
`(save-restriction (widen) ,@rest)))
|
2022-08-20 16:06:15 +00:00
|
|
|
|
|
2013-06-03 08:51:50 +00:00
|
|
|
|
(defun find-tag-default-bounds ()
|
|
|
|
|
"Determine the boundaries of the default tag, based on text at point.
|
|
|
|
|
Return a cons cell with the beginning and end of the found tag.
|
2005-10-22 15:01:08 +00:00
|
|
|
|
If there is no plausible default, return nil."
|
2016-02-22 22:56:51 +00:00
|
|
|
|
(bounds-of-thing-at-point 'symbol))
|
2013-06-03 08:51:50 +00:00
|
|
|
|
|
|
|
|
|
(defun find-tag-default ()
|
|
|
|
|
"Determine default tag to search for, based on text at point.
|
|
|
|
|
If there is no plausible default, return nil."
|
|
|
|
|
(let ((bounds (find-tag-default-bounds)))
|
|
|
|
|
(when bounds
|
|
|
|
|
(buffer-substring-no-properties (car bounds) (cdr bounds)))))
|
1996-02-08 10:04:55 +00:00
|
|
|
|
|
2013-03-08 04:18:16 +00:00
|
|
|
|
(defun find-tag-default-as-regexp ()
|
|
|
|
|
"Return regexp that matches the default tag at point.
|
|
|
|
|
If there is no tag at point, return nil.
|
|
|
|
|
|
2013-03-08 08:11:59 +00:00
|
|
|
|
When in a major mode that does not provide its own
|
2013-03-08 04:18:16 +00:00
|
|
|
|
`find-tag-default-function', return a regexp that matches the
|
|
|
|
|
symbol at point exactly."
|
2013-12-20 19:55:56 +00:00
|
|
|
|
(let ((tag (funcall (or find-tag-default-function
|
|
|
|
|
(get major-mode 'find-tag-default-function)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
#'find-tag-default))))
|
2013-12-20 19:55:56 +00:00
|
|
|
|
(if tag (regexp-quote tag))))
|
|
|
|
|
|
|
|
|
|
(defun find-tag-default-as-symbol-regexp ()
|
|
|
|
|
"Return regexp that matches the default tag at point as symbol.
|
|
|
|
|
If there is no tag at point, return nil.
|
|
|
|
|
|
|
|
|
|
When in a major mode that does not provide its own
|
|
|
|
|
`find-tag-default-function', return a regexp that matches the
|
|
|
|
|
symbol at point exactly."
|
|
|
|
|
(let ((tag-regexp (find-tag-default-as-regexp)))
|
|
|
|
|
(if (and tag-regexp
|
|
|
|
|
(eq (or find-tag-default-function
|
|
|
|
|
(get major-mode 'find-tag-default-function)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
#'find-tag-default)
|
|
|
|
|
#'find-tag-default))
|
2013-12-20 19:55:56 +00:00
|
|
|
|
(format "\\_<%s\\_>" tag-regexp)
|
|
|
|
|
tag-regexp)))
|
2013-03-08 04:18:16 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun play-sound (sound)
|
|
|
|
|
"SOUND is a list of the form `(sound KEYWORD VALUE...)'.
|
|
|
|
|
The following keywords are recognized:
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
:file FILE - read sound data from FILE. If FILE isn't an
|
|
|
|
|
absolute file name, it is searched in `data-directory'.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
:data DATA - read sound data from string DATA.
|
|
|
|
|
|
|
|
|
|
Exactly one of :file or :data must be present.
|
|
|
|
|
|
|
|
|
|
:volume VOL - set volume to VOL. VOL must an integer in the
|
|
|
|
|
range 0..100 or a float in the range 0..1.0. If not specified,
|
|
|
|
|
don't change the volume setting of the sound device.
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
:device DEVICE - play sound on DEVICE. If not specified,
|
2009-01-12 20:34:48 +00:00
|
|
|
|
a system-dependent default device name is used.
|
|
|
|
|
|
|
|
|
|
Note: :data and :device are currently not supported on Windows."
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(if (fboundp 'play-sound-internal)
|
|
|
|
|
(play-sound-internal sound)
|
|
|
|
|
(error "This Emacs binary lacks sound support")))
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2007-11-19 00:09:48 +00:00
|
|
|
|
(declare-function w32-shell-dos-semantics "w32-fns" nil)
|
|
|
|
|
|
2022-03-22 09:29:16 +00:00
|
|
|
|
(defun shell-quote-argument (argument &optional posix)
|
2015-10-18 17:08:32 +00:00
|
|
|
|
"Quote ARGUMENT for passing as argument to an inferior shell.
|
|
|
|
|
|
|
|
|
|
This function is designed to work with the syntax of your system's
|
2015-10-22 03:22:34 +00:00
|
|
|
|
standard shell, and might produce incorrect results with unusual shells.
|
2022-03-22 09:29:16 +00:00
|
|
|
|
See Info node `(elisp)Security Considerations'.
|
|
|
|
|
|
|
|
|
|
If the optional POSIX argument is non-nil, ARGUMENT is quoted
|
|
|
|
|
according to POSIX shell quoting rules, regardless of the
|
|
|
|
|
system's shell."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(cond
|
2022-03-22 09:29:16 +00:00
|
|
|
|
((and (not posix) (eq system-type 'ms-dos))
|
2011-04-26 10:44:03 +00:00
|
|
|
|
;; Quote using double quotes, but escape any existing quotes in
|
|
|
|
|
;; the argument with backslashes.
|
|
|
|
|
(let ((result "")
|
|
|
|
|
(start 0)
|
|
|
|
|
end)
|
|
|
|
|
(if (or (null (string-match "[^\"]" argument))
|
|
|
|
|
(< (match-end 0) (length argument)))
|
|
|
|
|
(while (string-match "[\"]" argument start)
|
|
|
|
|
(setq end (match-beginning 0)
|
|
|
|
|
result (concat result (substring argument start end)
|
|
|
|
|
"\\" (substring argument end (1+ end)))
|
|
|
|
|
start (1+ end))))
|
|
|
|
|
(concat "\"" result (substring argument start) "\"")))
|
|
|
|
|
|
2022-03-22 09:29:16 +00:00
|
|
|
|
((and (not posix) (eq system-type 'windows-nt) (w32-shell-dos-semantics))
|
2011-04-28 19:35:20 +00:00
|
|
|
|
|
2011-04-26 10:44:03 +00:00
|
|
|
|
;; First, quote argument so that CommandLineToArgvW will
|
|
|
|
|
;; understand it. See
|
2020-10-01 13:24:21 +00:00
|
|
|
|
;; https://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx
|
2011-04-26 10:44:03 +00:00
|
|
|
|
;; After we perform that level of quoting, escape shell
|
|
|
|
|
;; metacharacters so that cmd won't mangle our argument. If the
|
|
|
|
|
;; argument contains no double quote characters, we can just
|
|
|
|
|
;; surround it with double quotes. Otherwise, we need to prefix
|
|
|
|
|
;; each shell metacharacter with a caret.
|
|
|
|
|
|
|
|
|
|
(setq argument
|
|
|
|
|
;; escape backslashes at end of string
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
"\\(\\\\*\\)$"
|
|
|
|
|
"\\1\\1"
|
|
|
|
|
;; escape backslashes and quotes in string body
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
"\\(\\\\*\\)\""
|
|
|
|
|
"\\1\\1\\\\\""
|
|
|
|
|
argument)))
|
|
|
|
|
|
2011-04-27 07:56:55 +00:00
|
|
|
|
(if (string-match "[%!\"]" argument)
|
2011-04-26 10:44:03 +00:00
|
|
|
|
(concat
|
|
|
|
|
"^\""
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
"\\([%!()\"<>&|^]\\)"
|
|
|
|
|
"^\\1"
|
|
|
|
|
argument)
|
|
|
|
|
"^\"")
|
|
|
|
|
(concat "\"" argument "\"")))
|
|
|
|
|
|
|
|
|
|
(t
|
2006-09-25 23:03:39 +00:00
|
|
|
|
(if (equal argument "")
|
|
|
|
|
"''"
|
|
|
|
|
;; Quote everything except POSIX filename characters.
|
|
|
|
|
;; This should be safe enough even for really weird shells.
|
Use string-replace instead of replace-regexp-in-string
`string-replace` is easier to understand, less error-prone, much
faster, and results in shorter Lisp and byte code. Use it where
applicable and obviously safe (erring on the conservative side).
* admin/authors.el (authors-scan-change-log):
* lisp/autoinsert.el (auto-insert-alist):
* lisp/calc/calc-prog.el (calc-edit-macro-combine-alg-ent)
(calc-edit-macro-combine-ext-command)
(calc-edit-macro-combine-var-name):
* lisp/calc/calc-units.el (math-make-unit-string):
* lisp/calendar/cal-html.el (cal-html-comment):
* lisp/calendar/cal-tex.el (cal-tex-comment):
* lisp/calendar/icalendar.el (icalendar--convert-string-for-export)
(icalendar--convert-string-for-import):
* lisp/calendar/iso8601.el (iso8601--concat-regexps)
(iso8601--full-time-match, iso8601--combined-match):
* lisp/calendar/time-date.el (format-seconds):
* lisp/calendar/todo-mode.el (todo-filter-items-filename):
* lisp/cedet/cedet-files.el (cedet-directory-name-to-file-name)
(cedet-file-name-to-directory-name):
* lisp/comint.el (comint-watch-for-password-prompt):
* lisp/dired-aux.el (dired-do-chmod):
* lisp/dired-x.el (dired-man):
* lisp/dired.el (dired-insert-directory, dired-goto-file-1):
* lisp/emacs-lisp/comp.el (comp-c-func-name):
* lisp/emacs-lisp/re-builder.el (reb-copy):
* lisp/erc/erc-dcc.el (erc-dcc-unquote-filename):
* lisp/erc/erc.el (erc-quit-reason-zippy, erc-part-reason-zippy)
(erc-update-mode-line-buffer, erc-message-english-PART):
* lisp/files.el (make-backup-file-name-1, files--transform-file-name)
(read-file-modes):
* lisp/fringe.el (fringe-mode):
* lisp/gnus/gnus-art.el (gnus-button-handle-info-url):
* lisp/gnus/gnus-group.el (gnus-group-completing-read):
* lisp/gnus/gnus-icalendar.el (gnus-icalendar-event-from-ical):
* lisp/gnus/gnus-mlspl.el (gnus-group-split-fancy):
* lisp/gnus/gnus-search.el (gnus-search-query-parse-date)
(gnus-search-transform-expression, gnus-search-run-search):
* lisp/gnus/gnus-start.el (gnus-dribble-enter):
* lisp/gnus/gnus-sum.el (gnus-summary-refer-article):
* lisp/gnus/gnus-util.el (gnus-mode-string-quote):
* lisp/gnus/message.el (message-put-addresses-in-ecomplete)
(message-parse-mailto-url, message-mailto-1):
* lisp/gnus/mml-sec.el (mml-secure-epg-sign):
* lisp/gnus/mml-smime.el (mml-smime-epg-verify):
* lisp/gnus/mml2015.el (mml2015-epg-verify):
* lisp/gnus/nnmaildir.el (nnmaildir--system-name)
(nnmaildir-request-list, nnmaildir-retrieve-groups)
(nnmaildir-request-group, nnmaildir-retrieve-headers):
* lisp/gnus/nnrss.el (nnrss-node-text):
* lisp/gnus/spam-report.el (spam-report-gmane-internal)
(spam-report-user-mail-address):
* lisp/ibuffer.el (name):
* lisp/image-dired.el (image-dired-pngnq-thumb)
(image-dired-pngcrush-thumb, image-dired-optipng-thumb)
(image-dired-create-thumb-1):
* lisp/info.el (Info-set-mode-line):
* lisp/international/mule-cmds.el (describe-language-environment):
* lisp/mail/rfc2231.el (rfc2231-parse-string):
* lisp/mail/rfc2368.el (rfc2368-parse-mailto-url):
* lisp/mail/rmail.el (rmail-insert-inbox-text)
(rmail-simplified-subject-regexp):
* lisp/mail/rmailout.el (rmail-output-body-to-file):
* lisp/mail/undigest.el (rmail-digest-rfc1153):
* lisp/man.el (Man-default-man-entry):
* lisp/mouse.el (minor-mode-menu-from-indicator):
* lisp/mpc.el (mpc--debug):
* lisp/net/browse-url.el (browse-url-mail):
* lisp/net/eww.el (eww-update-header-line-format):
* lisp/net/newst-backend.el (newsticker-save-item):
* lisp/net/rcirc.el (rcirc-sentinel):
* lisp/net/soap-client.el (soap-decode-date-time):
* lisp/nxml/rng-cmpct.el (rng-c-literal-2-re):
* lisp/nxml/xmltok.el (let*):
* lisp/obsolete/nnir.el (nnir-run-swish-e, nnir-run-hyrex)
(nnir-run-find-grep):
* lisp/play/dunnet.el (dun-doassign):
* lisp/play/handwrite.el (handwrite):
* lisp/proced.el (proced-format-args):
* lisp/profiler.el (profiler-report-header-line-format):
* lisp/progmodes/gdb-mi.el (gdb-mi-quote):
* lisp/progmodes/make-mode.el (makefile-bsdmake-rule-action-regex)
(makefile-make-font-lock-keywords):
* lisp/progmodes/prolog.el (prolog-guess-fill-prefix):
* lisp/progmodes/ruby-mode.el (ruby-toggle-string-quotes):
* lisp/progmodes/sql.el (sql-remove-tabs-filter, sql-str-literal):
* lisp/progmodes/which-func.el (which-func-current):
* lisp/replace.el (query-replace-read-from)
(occur-engine, replace-quote):
* lisp/select.el (xselect--encode-string):
* lisp/ses.el (ses-export-tab):
* lisp/subr.el (shell-quote-argument):
* lisp/term/pc-win.el (msdos-show-help):
* lisp/term/w32-win.el (w32--set-selection):
* lisp/term/xterm.el (gui-backend-set-selection):
* lisp/textmodes/picture.el (picture-tab-search):
* lisp/thumbs.el (thumbs-call-setroot-command):
* lisp/tooltip.el (tooltip-show-help-non-mode):
* lisp/transient.el (transient-format-key):
* lisp/url/url-mailto.el (url-mailto):
* lisp/vc/log-edit.el (log-edit-changelog-ours-p):
* lisp/vc/vc-bzr.el (vc-bzr-status):
* lisp/vc/vc-hg.el (vc-hg--glob-to-pcre):
* lisp/vc/vc-svn.el (vc-svn-after-dir-status):
* lisp/xdg.el (xdg-desktop-strings):
* test/lisp/electric-tests.el (defun):
* test/lisp/term-tests.el (term-simple-lines):
* test/lisp/time-stamp-tests.el (formatz-mod-del-colons):
* test/lisp/wdired-tests.el (wdired-test-bug32173-01)
(wdired-test-unfinished-edit-01):
* test/src/json-tests.el (json-parse-with-custom-null-and-false-objects):
Use `string-replace` instead of `replace-regexp-in-string`.
2021-08-08 16:58:46 +00:00
|
|
|
|
(string-replace
|
2011-04-26 10:44:03 +00:00
|
|
|
|
"\n" "'\n'"
|
|
|
|
|
(replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument))))
|
|
|
|
|
))
|
2006-04-06 19:20:38 +00:00
|
|
|
|
|
2017-02-13 03:02:56 +00:00
|
|
|
|
(defsubst string-to-list (string)
|
|
|
|
|
"Return a list of characters in STRING."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2017-02-13 03:02:56 +00:00
|
|
|
|
(append string nil))
|
|
|
|
|
|
|
|
|
|
(defsubst string-to-vector (string)
|
|
|
|
|
"Return a vector of characters in STRING."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2017-02-13 03:02:56 +00:00
|
|
|
|
(vconcat string))
|
|
|
|
|
|
2006-04-06 19:20:38 +00:00
|
|
|
|
(defun string-or-null-p (object)
|
|
|
|
|
"Return t if OBJECT is a string or nil.
|
|
|
|
|
Otherwise, return nil."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
2006-04-06 19:20:38 +00:00
|
|
|
|
(or (stringp object) (null object)))
|
|
|
|
|
|
2022-09-16 10:29:54 +00:00
|
|
|
|
(defun list-of-strings-p (object)
|
|
|
|
|
"Return t if OBJECT is nil or a list of strings."
|
2022-09-16 16:51:10 +00:00
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
2022-09-16 13:29:03 +00:00
|
|
|
|
(while (and (consp object) (stringp (car object)))
|
|
|
|
|
(setq object (cdr object)))
|
|
|
|
|
(null object))
|
2022-09-16 10:29:54 +00:00
|
|
|
|
|
2006-04-29 13:56:19 +00:00
|
|
|
|
(defun booleanp (object)
|
2010-10-03 01:11:20 +00:00
|
|
|
|
"Return t if OBJECT is one of the two canonical boolean values: t or nil.
|
|
|
|
|
Otherwise, return nil."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
2010-10-03 01:11:20 +00:00
|
|
|
|
(and (memq object '(nil t)) t))
|
2006-04-29 13:56:19 +00:00
|
|
|
|
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(defun special-form-p (object)
|
|
|
|
|
"Non-nil if and only if OBJECT is a special form."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2024-03-12 19:43:43 +00:00
|
|
|
|
(if (symbolp object) (setq object (indirect-function object)))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
|
|
|
|
|
|
2022-06-27 10:36:37 +00:00
|
|
|
|
(defun plistp (object)
|
|
|
|
|
"Non-nil if and only if OBJECT is a valid plist."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (pure t) (side-effect-free error-free))
|
2022-06-27 20:20:55 +00:00
|
|
|
|
(let ((len (proper-list-p object)))
|
|
|
|
|
(and len (zerop (% len 2)))))
|
2022-06-27 10:36:37 +00:00
|
|
|
|
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(defun macrop (object)
|
|
|
|
|
"Non-nil if and only if OBJECT is a macro."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2015-04-16 02:25:16 +00:00
|
|
|
|
(let ((def (indirect-function object)))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(when (consp def)
|
|
|
|
|
(or (eq 'macro (car def))
|
2013-08-07 15:43:57 +00:00
|
|
|
|
(and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
|
2022-08-14 16:28:37 +00:00
|
|
|
|
(defun compiled-function-p (object)
|
|
|
|
|
"Return non-nil if OBJECT is a function that has been compiled.
|
|
|
|
|
Does not distinguish between functions implemented in machine code
|
|
|
|
|
or byte-code."
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2024-03-12 19:43:43 +00:00
|
|
|
|
(or (and (subrp object) (not (eq 'unevalled (cdr (subr-arity object)))))
|
|
|
|
|
(byte-code-function-p object)))
|
2022-08-14 16:28:37 +00:00
|
|
|
|
|
2006-05-10 01:58:37 +00:00
|
|
|
|
(defun field-at-pos (pos)
|
2009-01-12 20:34:48 +00:00
|
|
|
|
"Return the field at position POS, taking stickiness etc into account."
|
Add function declarations
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
Add get-byte, string-width, unibyte-string, special-variable-p, frexp,
buffer-hash, buffer-line-statistics, load-average, md5, secure-hash,
string-collate-equalp, string-collate-lessp, string-to-unibyte,
string-version-lessp, current-cpu-time.
(side-effect-and-error-free-fns): Add equal-including-properties.
(pure-fns): Add equal-including-properties, string-version-lessp.
* lisp/emacs-lisp/bytecomp.el (important-return-value-fns):
Add match-data.
* lisp/subr.el (buffer-local-boundp, subr-primitive-p, gensym)
(frame-configuration-p, apply-partially, make-composed-keymap)
(keymap-canonicalize, listify-key-sequence, event-modifiers)
(event-basic-type, mouse-event-p, event-start, event-end)
(event-click-count, event-line-count, posnp, posn-window, posn-area)
(posn-point, posn-x-y, posn-col-row, posn-actual-col-row)
(posn-timestamp, posn-string, posn-image, posn-object)
(posn-object-x-y, posn-object-width-height, provided-mode-derived-p)
(derived-mode-p, autoloadp, locate-eln-file, symbol-file)
(process-lines-handling-status, process-lines)
(process-lines-ignore-status, process-get)
(copy-overlay, shell-quote-argument, field-at-pos):
Add appropriate function declarations.
2023-05-30 15:09:45 +00:00
|
|
|
|
(declare (important-return-value t))
|
2006-05-10 00:32:34 +00:00
|
|
|
|
(let ((raw-field (get-char-property (field-beginning pos) 'field)))
|
|
|
|
|
(if (eq raw-field 'boundary)
|
|
|
|
|
(get-char-property (1- (field-end pos)) 'field)
|
|
|
|
|
raw-field)))
|
|
|
|
|
|
2011-06-21 08:55:22 +00:00
|
|
|
|
(defun sha1 (object &optional start end binary)
|
2019-09-16 08:45:14 +00:00
|
|
|
|
"Return the SHA-1 (Secure Hash Algorithm) of an OBJECT.
|
2011-06-21 08:55:22 +00:00
|
|
|
|
OBJECT is either a string or a buffer. Optional arguments START and
|
|
|
|
|
END are character positions specifying which portion of OBJECT for
|
2023-02-11 10:28:43 +00:00
|
|
|
|
computing the hash. If BINARY is non-nil, return a 40-byte unibyte
|
|
|
|
|
string; otherwise returna 40-character string.
|
2019-09-16 08:45:14 +00:00
|
|
|
|
|
|
|
|
|
Note that SHA-1 is not collision resistant and should not be used
|
|
|
|
|
for anything security-related. See `secure-hash' for
|
|
|
|
|
alternatives."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2011-06-21 08:55:22 +00:00
|
|
|
|
(secure-hash 'sha1 object start end binary))
|
|
|
|
|
|
2012-07-26 01:27:33 +00:00
|
|
|
|
(defun function-get (f prop &optional autoload)
|
|
|
|
|
"Return the value of property PROP of function F.
|
2020-03-01 17:50:14 +00:00
|
|
|
|
If AUTOLOAD is non-nil and F is autoloaded, try to load it
|
2019-11-04 02:36:05 +00:00
|
|
|
|
in the hope that it will set PROP. If AUTOLOAD is `macro', do it only
|
2012-08-13 21:23:09 +00:00
|
|
|
|
if it's an autoloaded macro."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2012-07-26 01:27:33 +00:00
|
|
|
|
(let ((val nil))
|
|
|
|
|
(while (and (symbolp f)
|
|
|
|
|
(null (setq val (get f prop)))
|
|
|
|
|
(fboundp f))
|
|
|
|
|
(let ((fundef (symbol-function f)))
|
|
|
|
|
(if (and autoload (autoloadp fundef)
|
2012-08-13 21:23:09 +00:00
|
|
|
|
(not (equal fundef
|
|
|
|
|
(autoload-do-load fundef f
|
|
|
|
|
(if (eq autoload 'macro)
|
|
|
|
|
'macro)))))
|
2012-07-26 01:27:33 +00:00
|
|
|
|
nil ;Re-try `get' on the same `f'.
|
|
|
|
|
(setq f fundef))))
|
|
|
|
|
val))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Support for yanking and text properties.
|
Add pre-redisplay-function and rectangular region
* lisp/rect.el: Use lexical-binding. Add new rectangular region support.
(rectangle-mark): New command.
(rectangle--region): New var.
(deactivate-mark-hook): Reset rectangle--region.
(rectangle--extract-region, rectangle--insert-for-yank)
(rectangle--highlight-for-redisplay)
(rectangle--unhighlight-for-redisplay): New functions.
(region-extract-function, redisplay-unhighlight-region-function)
(redisplay-highlight-region-function): Use them to handle
rectangular region.
* lisp/simple.el (region-extract-function): New var.
(delete-backward-char, delete-forward-char, deactivate-mark): Use it.
(kill-new, kill-append): Remove obsolete `yank-handler' argument.
(kill-region): Replace obsolete `yank-handler' arg with `region'.
(copy-region-as-kill, kill-ring-save): Add `region' argument.
(redisplay-unhighlight-region-function)
(redisplay-highlight-region-function): New vars.
(redisplay--update-region-highlight): New function.
(pre-redisplay-function): Use it.
(exchange-point-and-mark): Don't deactivate the mark before
reactivate-it anyway.
* lisp/comint.el (comint-kill-region): Remove yank-handler argument.
* lisp/delsel.el (delete-backward-char, backward-delete-char-untabify)
(delete-char): Remove property, since it's now part of their
default behavior.
(self-insert-iso): Remove property since this command doesn't exist.
* src/xdisp.c (prepare_menu_bars): Call Vpre_redisplay_function.
(syms_of_xdisp): Declare pre-redisplay-function.
(markpos_of_region): Remove function.
(init_iterator, compute_stop_pos, handle_face_prop)
(face_before_or_after_it_pos, reseat_to_string)
(get_next_display_element, window_buffer_changed)
(redisplay_internal, try_cursor_movement, redisplay_window)
(try_window_reusing_current_matrix, try_window_id, display_line)
(note_mode_line_or_margin_highlight, note_mouse_highlight)
(display_string, mouse_face_from_buffer_pos): Remove region handling.
* src/window.h (struct window): Remove field `region_showing'.
* src/dispextern.h (struct it): Remove region_beg/end_charpos.
(face_at_buffer_position, face_for_overlay_string)
(face_at_string_position): Update prototypes.
* src/xfaces.c (face_at_buffer_position, face_for_overlay_string)
(face_at_string_position): Remove `region_beg' and `region_end' args.
* src/fontset.c (Finternal_char_font):
* src/font.c (font_at, font_range): Adjust calls accordingly.
* src/insdel.c (Qregion_extract_function): New var.
(syms_of_insdel): Initialize it.
(prepare_to_modify_buffer_1): Use it.
2013-10-29 16:11:50 +00:00
|
|
|
|
;; Why here in subr.el rather than in simple.el? --Stef
|
1993-04-10 06:21:55 +00:00
|
|
|
|
|
2012-08-18 05:11:38 +00:00
|
|
|
|
(defvar yank-handled-properties)
|
2002-04-19 00:06:54 +00:00
|
|
|
|
(defvar yank-excluded-properties)
|
|
|
|
|
|
2002-04-29 21:06:51 +00:00
|
|
|
|
(defun remove-yank-excluded-properties (start end)
|
2012-08-18 05:11:38 +00:00
|
|
|
|
"Process text properties between START and END, inserted for a `yank'.
|
|
|
|
|
Perform the handling specified by `yank-handled-properties', then
|
|
|
|
|
remove properties specified by `yank-excluded-properties'."
|
2015-04-25 20:49:44 +00:00
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(dolist (handler yank-handled-properties)
|
|
|
|
|
(let ((prop (car handler))
|
|
|
|
|
(fun (cdr handler))
|
|
|
|
|
(run-start start))
|
|
|
|
|
(while (< run-start end)
|
|
|
|
|
(let ((value (get-text-property run-start prop))
|
|
|
|
|
(run-end (next-single-property-change
|
|
|
|
|
run-start prop nil end)))
|
|
|
|
|
(funcall fun value run-start run-end)
|
|
|
|
|
(setq run-start run-end)))))
|
2018-01-27 22:02:45 +00:00
|
|
|
|
(if (eq yank-excluded-properties t)
|
|
|
|
|
(set-text-properties start end nil)
|
|
|
|
|
(remove-list-of-text-properties start end yank-excluded-properties))))
|
2002-04-29 21:06:51 +00:00
|
|
|
|
|
2003-01-18 23:35:06 +00:00
|
|
|
|
(defvar yank-undo-function)
|
|
|
|
|
|
|
|
|
|
(defun insert-for-yank (string)
|
2016-10-03 00:47:27 +00:00
|
|
|
|
"Insert STRING at point for the `yank' command.
|
2004-04-16 12:51:06 +00:00
|
|
|
|
|
2016-10-03 00:47:27 +00:00
|
|
|
|
This function is like `insert', except it honors the variables
|
|
|
|
|
`yank-handled-properties' and `yank-excluded-properties', and the
|
2022-05-19 22:15:28 +00:00
|
|
|
|
`yank-handler' text property, in the way that `yank' does.
|
|
|
|
|
|
|
|
|
|
It also runs the string through `yank-transform-functions'."
|
|
|
|
|
;; Allow altering the yank string.
|
2022-05-24 16:29:54 +00:00
|
|
|
|
(run-hook-wrapped 'yank-transform-functions
|
2022-05-25 17:45:49 +00:00
|
|
|
|
(lambda (f) (setq string (funcall f string)) nil))
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(let (to)
|
|
|
|
|
(while (setq to (next-single-property-change 0 'yank-handler string))
|
|
|
|
|
(insert-for-yank-1 (substring string 0 to))
|
|
|
|
|
(setq string (substring string to))))
|
|
|
|
|
(insert-for-yank-1 string))
|
|
|
|
|
|
|
|
|
|
(defun insert-for-yank-1 (string)
|
2016-10-03 00:47:27 +00:00
|
|
|
|
"Helper for `insert-for-yank', which see."
|
2003-01-19 01:07:34 +00:00
|
|
|
|
(let* ((handler (and (stringp string)
|
|
|
|
|
(get-text-property 0 'yank-handler string)))
|
|
|
|
|
(param (or (nth 1 handler) string))
|
2006-09-28 19:06:39 +00:00
|
|
|
|
(opoint (point))
|
2007-02-09 23:09:16 +00:00
|
|
|
|
(inhibit-read-only inhibit-read-only)
|
2006-09-28 19:06:39 +00:00
|
|
|
|
end)
|
|
|
|
|
|
2018-06-22 03:30:11 +00:00
|
|
|
|
;; FIXME: This throws away any yank-undo-function set by previous calls
|
|
|
|
|
;; to insert-for-yank-1 within the loop of insert-for-yank!
|
2003-01-19 01:07:34 +00:00
|
|
|
|
(setq yank-undo-function t)
|
2012-08-18 05:11:38 +00:00
|
|
|
|
(if (nth 0 handler) ; FUNCTION
|
2003-01-19 01:07:34 +00:00
|
|
|
|
(funcall (car handler) param)
|
2003-01-18 23:35:06 +00:00
|
|
|
|
(insert param))
|
2006-09-28 19:06:39 +00:00
|
|
|
|
(setq end (point))
|
|
|
|
|
|
2007-02-09 23:09:16 +00:00
|
|
|
|
;; Prevent read-only properties from interfering with the
|
|
|
|
|
;; following text property changes.
|
|
|
|
|
(setq inhibit-read-only t)
|
|
|
|
|
|
2012-08-18 05:11:38 +00:00
|
|
|
|
(unless (nth 2 handler) ; NOEXCLUDE
|
|
|
|
|
(remove-yank-excluded-properties opoint end))
|
2006-10-18 10:56:46 +00:00
|
|
|
|
|
|
|
|
|
;; If last inserted char has properties, mark them as rear-nonsticky.
|
|
|
|
|
(if (and (> end opoint)
|
|
|
|
|
(text-properties-at (1- end)))
|
|
|
|
|
(put-text-property (1- end) end 'rear-nonsticky t))
|
|
|
|
|
|
2012-08-18 05:11:38 +00:00
|
|
|
|
(if (eq yank-undo-function t) ; not set by FUNCTION
|
|
|
|
|
(setq yank-undo-function (nth 3 handler))) ; UNDO
|
|
|
|
|
(if (nth 4 handler) ; COMMAND
|
2003-01-19 01:07:34 +00:00
|
|
|
|
(setq this-command (nth 4 handler)))))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(defun insert-buffer-substring-no-properties (buffer &optional start end)
|
|
|
|
|
"Insert before point a substring of BUFFER, without text properties.
|
2002-04-21 17:00:41 +00:00
|
|
|
|
BUFFER may be a buffer or a buffer name.
|
2004-06-07 20:54:42 +00:00
|
|
|
|
Arguments START and END are character positions specifying the substring.
|
|
|
|
|
They default to the values of (point-min) and (point-max) in BUFFER."
|
2002-04-21 17:00:41 +00:00
|
|
|
|
(let ((opoint (point)))
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(insert-buffer-substring buffer start end)
|
2002-04-21 17:00:41 +00:00
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(set-text-properties opoint (point) nil))))
|
|
|
|
|
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(defun insert-buffer-substring-as-yank (buffer &optional start end)
|
|
|
|
|
"Insert before point a part of BUFFER, stripping some text properties.
|
|
|
|
|
BUFFER may be a buffer or a buffer name.
|
2004-06-07 20:54:42 +00:00
|
|
|
|
Arguments START and END are character positions specifying the substring.
|
|
|
|
|
They default to the values of (point-min) and (point-max) in BUFFER.
|
2012-10-27 05:03:52 +00:00
|
|
|
|
Before insertion, process text properties according to
|
|
|
|
|
`yank-handled-properties' and `yank-excluded-properties'."
|
2004-04-16 12:51:06 +00:00
|
|
|
|
;; Since the buffer text should not normally have yank-handler properties,
|
|
|
|
|
;; there is no need to handle them here.
|
2002-04-21 17:00:41 +00:00
|
|
|
|
(let ((opoint (point)))
|
2004-05-07 01:06:20 +00:00
|
|
|
|
(insert-buffer-substring buffer start end)
|
2002-04-29 21:06:51 +00:00
|
|
|
|
(remove-yank-excluded-properties opoint (point))))
|
2002-04-21 17:00:41 +00:00
|
|
|
|
|
2021-07-13 21:46:16 +00:00
|
|
|
|
(defun insert-into-buffer (buffer &optional start end)
|
|
|
|
|
"Insert the contents of the current buffer into BUFFER.
|
|
|
|
|
If START/END, only insert that region from the current buffer.
|
|
|
|
|
Point in BUFFER will be placed after the inserted text."
|
|
|
|
|
(let ((current (current-buffer)))
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(insert-buffer-substring current start end))))
|
|
|
|
|
|
2021-08-16 11:20:35 +00:00
|
|
|
|
(defun replace-string-in-region (string replacement &optional start end)
|
|
|
|
|
"Replace STRING with REPLACEMENT in the region from START to END.
|
|
|
|
|
The number of replaced occurrences are returned, or nil if STRING
|
|
|
|
|
doesn't exist in the region.
|
|
|
|
|
|
|
|
|
|
If START is nil, use the current point. If END is nil, use `point-max'.
|
|
|
|
|
|
|
|
|
|
Comparisons and replacements are done with fixed case."
|
|
|
|
|
(if start
|
|
|
|
|
(when (< start (point-min))
|
|
|
|
|
(error "Start before start of buffer"))
|
|
|
|
|
(setq start (point)))
|
|
|
|
|
(if end
|
|
|
|
|
(when (> end (point-max))
|
|
|
|
|
(error "End after end of buffer"))
|
|
|
|
|
(setq end (point-max)))
|
|
|
|
|
(save-excursion
|
2022-09-11 17:55:01 +00:00
|
|
|
|
(goto-char start)
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region start end)
|
|
|
|
|
(let ((matches 0)
|
|
|
|
|
(case-fold-search nil))
|
|
|
|
|
(while (search-forward string nil t)
|
|
|
|
|
(delete-region (match-beginning 0) (match-end 0))
|
|
|
|
|
(insert replacement)
|
|
|
|
|
(setq matches (1+ matches)))
|
|
|
|
|
(and (not (zerop matches))
|
|
|
|
|
matches)))))
|
2021-08-16 11:20:35 +00:00
|
|
|
|
|
|
|
|
|
(defun replace-regexp-in-region (regexp replacement &optional start end)
|
|
|
|
|
"Replace REGEXP with REPLACEMENT in the region from START to END.
|
|
|
|
|
The number of replaced occurrences are returned, or nil if REGEXP
|
|
|
|
|
doesn't exist in the region.
|
|
|
|
|
|
|
|
|
|
If START is nil, use the current point. If END is nil, use `point-max'.
|
|
|
|
|
|
|
|
|
|
Comparisons and replacements are done with fixed case.
|
|
|
|
|
|
|
|
|
|
REPLACEMENT can use the following special elements:
|
|
|
|
|
|
|
|
|
|
`\\&' in NEWTEXT means substitute original matched text.
|
|
|
|
|
`\\N' means substitute what matched the Nth `\\(...\\)'.
|
|
|
|
|
If Nth parens didn't match, substitute nothing.
|
|
|
|
|
`\\\\' means insert one `\\'.
|
|
|
|
|
`\\?' is treated literally."
|
|
|
|
|
(if start
|
|
|
|
|
(when (< start (point-min))
|
|
|
|
|
(error "Start before start of buffer"))
|
|
|
|
|
(setq start (point)))
|
|
|
|
|
(if end
|
|
|
|
|
(when (> end (point-max))
|
|
|
|
|
(error "End after end of buffer"))
|
|
|
|
|
(setq end (point-max)))
|
|
|
|
|
(save-excursion
|
2022-09-11 17:55:01 +00:00
|
|
|
|
(goto-char start)
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region start end)
|
|
|
|
|
(let ((matches 0)
|
|
|
|
|
(case-fold-search nil))
|
|
|
|
|
(while (re-search-forward regexp nil t)
|
|
|
|
|
(replace-match replacement t)
|
|
|
|
|
(setq matches (1+ matches)))
|
|
|
|
|
(and (not (zerop matches))
|
|
|
|
|
matches)))))
|
2021-08-16 11:20:35 +00:00
|
|
|
|
|
2012-08-18 05:11:38 +00:00
|
|
|
|
(defun yank-handle-font-lock-face-property (face start end)
|
|
|
|
|
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
|
|
|
|
|
START and END denote the start and end of the text to act on.
|
|
|
|
|
Do nothing if FACE is nil."
|
|
|
|
|
(and face
|
|
|
|
|
(null font-lock-defaults)
|
|
|
|
|
(put-text-property start end 'face face)))
|
|
|
|
|
|
|
|
|
|
;; This removes `mouse-face' properties in *Help* buffer buttons:
|
2017-11-26 06:45:41 +00:00
|
|
|
|
;; https://lists.gnu.org/r/emacs-devel/2002-04/msg00648.html
|
2012-08-18 05:11:38 +00:00
|
|
|
|
(defun yank-handle-category-property (category start end)
|
|
|
|
|
"Apply property category CATEGORY's properties between START and END."
|
|
|
|
|
(when category
|
|
|
|
|
(let ((start2 start))
|
|
|
|
|
(while (< start2 end)
|
|
|
|
|
(let ((end2 (next-property-change start2 nil end))
|
|
|
|
|
(original (text-properties-at start2)))
|
|
|
|
|
(set-text-properties start2 end2 (symbol-plist category))
|
|
|
|
|
(add-text-properties start2 end2 original)
|
|
|
|
|
(setq start2 end2))))))
|
|
|
|
|
|
2002-04-19 00:06:54 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Synchronous shell commands.
|
2002-04-19 00:06:54 +00:00
|
|
|
|
|
2020-12-20 18:45:11 +00:00
|
|
|
|
(defun start-process-shell-command (name buffer command)
|
1990-11-05 10:06:02 +00:00
|
|
|
|
"Start a program in a subprocess. Return the process object for it.
|
|
|
|
|
NAME is name for process. It is modified if necessary to make it unique.
|
2004-05-10 17:44:56 +00:00
|
|
|
|
BUFFER is the buffer (or buffer name) to associate with the process.
|
1990-11-05 10:06:02 +00:00
|
|
|
|
Process output goes at end of that buffer, unless you specify
|
|
|
|
|
an output stream or filter function to handle the output.
|
|
|
|
|
BUFFER may be also nil, meaning that this process is not associated
|
2021-12-11 18:33:50 +00:00
|
|
|
|
with any buffer.
|
2020-12-20 18:45:11 +00:00
|
|
|
|
COMMAND is the shell command to run."
|
2014-09-05 01:20:51 +00:00
|
|
|
|
;; We used to use `exec' to replace the shell with the command,
|
|
|
|
|
;; but that failed to handle (...) and semicolon, etc.
|
2020-12-20 18:45:11 +00:00
|
|
|
|
(start-process name buffer shell-file-name shell-command-switch command))
|
2009-10-16 05:03:56 +00:00
|
|
|
|
|
2020-12-20 18:45:11 +00:00
|
|
|
|
(defun start-file-process-shell-command (name buffer command)
|
2007-07-24 20:49:18 +00:00
|
|
|
|
"Start a program in a subprocess. Return the process object for it.
|
2009-10-16 03:21:18 +00:00
|
|
|
|
Similar to `start-process-shell-command', but calls `start-file-process'."
|
2019-03-09 15:44:24 +00:00
|
|
|
|
;; On remote hosts, the local `shell-file-name' might be useless.
|
|
|
|
|
(with-connection-local-variables
|
|
|
|
|
(start-file-process
|
2020-12-20 18:45:11 +00:00
|
|
|
|
name buffer shell-file-name shell-command-switch command)))
|
2007-07-24 20:49:18 +00:00
|
|
|
|
|
2001-10-05 12:30:20 +00:00
|
|
|
|
(defun call-process-shell-command (command &optional infile buffer display
|
|
|
|
|
&rest args)
|
|
|
|
|
"Execute the shell command COMMAND synchronously in separate process.
|
|
|
|
|
The remaining arguments are optional.
|
|
|
|
|
The program's input comes from file INFILE (nil means `/dev/null').
|
|
|
|
|
Insert output in BUFFER before point; t means current buffer;
|
|
|
|
|
nil for BUFFER means discard it; 0 means discard and don't wait.
|
|
|
|
|
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
|
|
|
|
|
REAL-BUFFER says what to do with standard output, as above,
|
|
|
|
|
while STDERR-FILE says what to do with standard error in the child.
|
|
|
|
|
STDERR-FILE may be nil (discard standard error output),
|
|
|
|
|
t (mix it with ordinary output), or a file name string.
|
|
|
|
|
|
|
|
|
|
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
|
|
|
|
|
Wildcards and redirection are handled as usual in the shell.
|
|
|
|
|
|
|
|
|
|
If BUFFER is 0, `call-process-shell-command' returns immediately with value nil.
|
|
|
|
|
Otherwise it waits for COMMAND to terminate and returns a numeric exit
|
|
|
|
|
status or a signal description string.
|
2014-09-05 01:20:51 +00:00
|
|
|
|
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
|
|
|
|
|
|
|
|
|
|
An old calling convention accepted any number of arguments after DISPLAY,
|
|
|
|
|
which were just concatenated to COMMAND. This is still supported but strongly
|
|
|
|
|
discouraged."
|
|
|
|
|
(declare (advertised-calling-convention
|
|
|
|
|
(command &optional infile buffer display) "24.5"))
|
2008-07-31 05:33:56 +00:00
|
|
|
|
;; We used to use `exec' to replace the shell with the command,
|
|
|
|
|
;; but that failed to handle (...) and semicolon, etc.
|
|
|
|
|
(call-process shell-file-name
|
|
|
|
|
infile buffer display
|
|
|
|
|
shell-command-switch
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(mapconcat #'identity (cons command args) " ")))
|
2007-07-24 20:49:18 +00:00
|
|
|
|
|
|
|
|
|
(defun process-file-shell-command (command &optional infile buffer display
|
|
|
|
|
&rest args)
|
|
|
|
|
"Process files synchronously in a separate process.
|
|
|
|
|
Similar to `call-process-shell-command', but calls `process-file'."
|
2014-09-05 01:20:51 +00:00
|
|
|
|
(declare (advertised-calling-convention
|
|
|
|
|
(command &optional infile buffer display) "24.5"))
|
2019-03-22 13:38:06 +00:00
|
|
|
|
;; On remote hosts, the local `shell-file-name' might be useless.
|
|
|
|
|
(with-connection-local-variables
|
|
|
|
|
(process-file
|
|
|
|
|
shell-file-name infile buffer display shell-command-switch
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(mapconcat #'identity (cons command args) " "))))
|
2016-08-25 13:17:56 +00:00
|
|
|
|
|
|
|
|
|
(defun call-shell-region (start end command &optional delete buffer)
|
|
|
|
|
"Send text from START to END as input to an inferior shell running COMMAND.
|
|
|
|
|
Delete the text if fourth arg DELETE is non-nil.
|
|
|
|
|
|
|
|
|
|
Insert output in BUFFER before point; t means current buffer; nil for
|
|
|
|
|
BUFFER means discard it; 0 means discard and don't wait; and `(:file
|
|
|
|
|
FILE)', where FILE is a file name string, means that it should be
|
|
|
|
|
written to that file (if the file already exists it is overwritten).
|
|
|
|
|
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
|
|
|
|
|
REAL-BUFFER says what to do with standard output, as above,
|
|
|
|
|
while STDERR-FILE says what to do with standard error in the child.
|
|
|
|
|
STDERR-FILE may be nil (discard standard error output),
|
|
|
|
|
t (mix it with ordinary output), or a file name string.
|
|
|
|
|
|
|
|
|
|
If BUFFER is 0, `call-shell-region' returns immediately with value nil.
|
|
|
|
|
Otherwise it waits for COMMAND to terminate
|
|
|
|
|
and returns a numeric exit status or a signal description string.
|
|
|
|
|
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
|
|
|
|
|
(call-process-region start end
|
|
|
|
|
shell-file-name delete buffer nil
|
|
|
|
|
shell-command-switch command))
|
1996-09-28 04:16:00 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Lisp macros to do various things temporarily.
|
|
|
|
|
|
2014-09-27 15:52:28 +00:00
|
|
|
|
(defmacro track-mouse (&rest body)
|
|
|
|
|
"Evaluate BODY with mouse movement events enabled.
|
|
|
|
|
Within a `track-mouse' form, mouse motion generates input events that
|
|
|
|
|
you can read with `read-event'.
|
|
|
|
|
Normally, mouse motion is ignored."
|
2021-05-17 08:00:36 +00:00
|
|
|
|
(declare (debug (def-body)) (indent 0))
|
2014-09-27 15:52:28 +00:00
|
|
|
|
`(internal--track-mouse (lambda () ,@body)))
|
|
|
|
|
|
2008-10-25 09:18:19 +00:00
|
|
|
|
(defmacro with-current-buffer (buffer-or-name &rest body)
|
|
|
|
|
"Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
|
|
|
|
|
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
|
|
|
|
|
The value returned is the value of the last form in BODY. See
|
|
|
|
|
also `with-temp-buffer'."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 1) (debug t))
|
|
|
|
|
`(save-current-buffer
|
2008-10-25 09:18:19 +00:00
|
|
|
|
(set-buffer ,buffer-or-name)
|
2003-05-17 22:00:40 +00:00
|
|
|
|
,@body))
|
|
|
|
|
|
2012-08-13 14:12:47 +00:00
|
|
|
|
(defun internal--before-with-selected-window (window)
|
2012-08-12 22:52:33 +00:00
|
|
|
|
(let ((other-frame (window-frame window)))
|
|
|
|
|
(list window (selected-window)
|
|
|
|
|
;; Selecting a window on another frame also changes that
|
|
|
|
|
;; frame's frame-selected-window. We must save&restore it.
|
|
|
|
|
(unless (eq (selected-frame) other-frame)
|
|
|
|
|
(frame-selected-window other-frame))
|
|
|
|
|
;; Also remember the top-frame if on ttys.
|
|
|
|
|
(unless (eq (selected-frame) other-frame)
|
|
|
|
|
(tty-top-frame other-frame)))))
|
|
|
|
|
|
2012-08-13 14:12:47 +00:00
|
|
|
|
(defun internal--after-with-selected-window (state)
|
2012-08-12 22:52:33 +00:00
|
|
|
|
;; First reset frame-selected-window.
|
|
|
|
|
(when (window-live-p (nth 2 state))
|
|
|
|
|
;; We don't use set-frame-selected-window because it does not
|
|
|
|
|
;; pass the `norecord' argument to Fselect_window.
|
|
|
|
|
(select-window (nth 2 state) 'norecord)
|
|
|
|
|
(and (frame-live-p (nth 3 state))
|
|
|
|
|
(not (eq (tty-top-frame) (nth 3 state)))
|
|
|
|
|
(select-frame (nth 3 state) 'norecord)))
|
|
|
|
|
;; Then reset the actual selected-window.
|
2012-08-14 04:37:00 +00:00
|
|
|
|
(when (window-live-p (nth 1 state))
|
|
|
|
|
(select-window (nth 1 state) 'norecord)))
|
2012-08-12 22:52:33 +00:00
|
|
|
|
|
2020-12-19 12:39:45 +00:00
|
|
|
|
(defun generate-new-buffer (name &optional inhibit-buffer-hooks)
|
2019-10-04 12:56:18 +00:00
|
|
|
|
"Create and return a buffer with a name based on NAME.
|
2020-12-19 12:39:45 +00:00
|
|
|
|
Choose the buffer's name using `generate-new-buffer-name'.
|
|
|
|
|
See `get-buffer-create' for the meaning of INHIBIT-BUFFER-HOOKS."
|
|
|
|
|
(get-buffer-create (generate-new-buffer-name name) inhibit-buffer-hooks))
|
2019-10-04 12:56:18 +00:00
|
|
|
|
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(defmacro with-selected-window (window &rest body)
|
|
|
|
|
"Execute the forms in BODY with WINDOW as the selected window.
|
|
|
|
|
The value returned is the value of the last form in BODY.
|
2005-06-25 14:04:18 +00:00
|
|
|
|
|
2008-11-02 11:02:58 +00:00
|
|
|
|
This macro saves and restores the selected window, as well as the
|
|
|
|
|
selected window of each frame. It does not change the order of
|
|
|
|
|
recently selected windows. If the previously selected window of
|
|
|
|
|
some frame is no longer live at the end of BODY, that frame's
|
|
|
|
|
selected window is left alone. If the selected window is no
|
|
|
|
|
longer live, then whatever window is selected at the end of BODY
|
|
|
|
|
remains selected.
|
|
|
|
|
|
|
|
|
|
This macro uses `save-current-buffer' to save and restore the
|
|
|
|
|
current buffer, since otherwise its normal operation could
|
|
|
|
|
potentially make a different buffer current. It does not alter
|
|
|
|
|
the buffer list ordering."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 1) (debug t))
|
2012-08-12 22:52:33 +00:00
|
|
|
|
`(let ((save-selected-window--state
|
2012-08-13 14:12:47 +00:00
|
|
|
|
(internal--before-with-selected-window ,window)))
|
2005-06-25 14:04:18 +00:00
|
|
|
|
(save-current-buffer
|
|
|
|
|
(unwind-protect
|
2012-08-12 22:52:33 +00:00
|
|
|
|
(progn (select-window (car save-selected-window--state) 'norecord)
|
2005-06-25 14:04:18 +00:00
|
|
|
|
,@body)
|
2012-08-13 14:12:47 +00:00
|
|
|
|
(internal--after-with-selected-window save-selected-window--state)))))
|
1996-09-22 04:40:37 +00:00
|
|
|
|
|
2004-05-23 02:26:21 +00:00
|
|
|
|
(defmacro with-selected-frame (frame &rest body)
|
|
|
|
|
"Execute the forms in BODY with FRAME as the selected frame.
|
|
|
|
|
The value returned is the value of the last form in BODY.
|
2008-11-02 11:02:58 +00:00
|
|
|
|
|
2012-01-07 05:57:57 +00:00
|
|
|
|
This macro saves and restores the selected frame, and changes the
|
|
|
|
|
order of neither the recently selected windows nor the buffers in
|
|
|
|
|
the buffer list."
|
2004-05-23 02:26:21 +00:00
|
|
|
|
(declare (indent 1) (debug t))
|
2006-03-12 04:12:31 +00:00
|
|
|
|
(let ((old-frame (make-symbol "old-frame"))
|
|
|
|
|
(old-buffer (make-symbol "old-buffer")))
|
|
|
|
|
`(let ((,old-frame (selected-frame))
|
|
|
|
|
(,old-buffer (current-buffer)))
|
|
|
|
|
(unwind-protect
|
2008-11-02 11:02:58 +00:00
|
|
|
|
(progn (select-frame ,frame 'norecord)
|
2006-03-12 04:12:31 +00:00
|
|
|
|
,@body)
|
2008-11-02 11:02:58 +00:00
|
|
|
|
(when (frame-live-p ,old-frame)
|
|
|
|
|
(select-frame ,old-frame 'norecord))
|
|
|
|
|
(when (buffer-live-p ,old-buffer)
|
|
|
|
|
(set-buffer ,old-buffer))))))
|
2004-05-23 02:26:21 +00:00
|
|
|
|
|
2011-02-19 05:10:33 +00:00
|
|
|
|
(defmacro save-window-excursion (&rest body)
|
2012-03-11 16:10:07 +00:00
|
|
|
|
"Execute BODY, then restore previous window configuration.
|
2012-03-11 16:16:50 +00:00
|
|
|
|
This macro saves the window configuration on the selected frame,
|
|
|
|
|
executes BODY, then calls `set-window-configuration' to restore
|
|
|
|
|
the saved window configuration. The return value is the last
|
|
|
|
|
form in BODY. The window configuration is also restored if BODY
|
|
|
|
|
exits nonlocally.
|
2011-02-19 05:10:33 +00:00
|
|
|
|
|
|
|
|
|
BEWARE: Most uses of this macro introduce bugs.
|
|
|
|
|
E.g. it should not be used to try and prevent some code from opening
|
|
|
|
|
a new window, since that window may sometimes appear in another frame,
|
|
|
|
|
in which case `save-window-excursion' cannot help."
|
|
|
|
|
(declare (indent 0) (debug t))
|
|
|
|
|
(let ((c (make-symbol "wconfig")))
|
|
|
|
|
`(let ((,c (current-window-configuration)))
|
|
|
|
|
(unwind-protect (progn ,@body)
|
|
|
|
|
(set-window-configuration ,c)))))
|
|
|
|
|
|
2012-10-23 01:18:47 +00:00
|
|
|
|
(defun internal-temp-output-buffer-show (buffer)
|
2012-09-22 16:28:46 +00:00
|
|
|
|
"Internal function for `with-output-to-temp-buffer'."
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(set-buffer-modified-p nil)
|
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
|
|
|
|
|
(if temp-buffer-show-function
|
|
|
|
|
(funcall temp-buffer-show-function buffer)
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(let* ((window
|
|
|
|
|
(let ((window-combination-limit
|
|
|
|
|
;; When `window-combination-limit' equals
|
|
|
|
|
;; `temp-buffer' or `temp-buffer-resize' and
|
|
|
|
|
;; `temp-buffer-resize-mode' is enabled in this
|
|
|
|
|
;; buffer bind it to t so resizing steals space
|
|
|
|
|
;; preferably from the window that was split.
|
|
|
|
|
(if (or (eq window-combination-limit 'temp-buffer)
|
|
|
|
|
(and (eq window-combination-limit
|
|
|
|
|
'temp-buffer-resize)
|
|
|
|
|
temp-buffer-resize-mode))
|
|
|
|
|
t
|
|
|
|
|
window-combination-limit)))
|
|
|
|
|
(display-buffer buffer)))
|
|
|
|
|
(frame (and window (window-frame window))))
|
|
|
|
|
(when window
|
|
|
|
|
(unless (eq frame (selected-frame))
|
|
|
|
|
(make-frame-visible frame))
|
|
|
|
|
(setq minibuffer-scroll-window window)
|
|
|
|
|
(set-window-hscroll window 0)
|
|
|
|
|
;; Don't try this with NOFORCE non-nil!
|
|
|
|
|
(set-window-start window (point-min) t)
|
2012-10-05 05:57:24 +00:00
|
|
|
|
;; This should not be necessary.
|
2012-09-22 16:28:46 +00:00
|
|
|
|
(set-window-point window (point-min))
|
|
|
|
|
;; Run `temp-buffer-show-hook', with the chosen window selected.
|
|
|
|
|
(with-selected-window window
|
|
|
|
|
(run-hooks 'temp-buffer-show-hook))))))
|
|
|
|
|
;; Return nil.
|
|
|
|
|
nil)
|
|
|
|
|
|
2012-11-17 02:03:58 +00:00
|
|
|
|
;; Doc is very similar to with-temp-buffer-window.
|
2011-02-21 20:12:44 +00:00
|
|
|
|
(defmacro with-output-to-temp-buffer (bufname &rest body)
|
|
|
|
|
"Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
|
|
|
|
|
|
2022-01-15 08:30:01 +00:00
|
|
|
|
This is a convenience macro meant for displaying help buffers and
|
|
|
|
|
the like. It empties the BUFNAME buffer before evaluating BODY
|
|
|
|
|
and disables undo in that buffer.
|
|
|
|
|
|
|
|
|
|
It does not make the buffer current for BODY. Instead it binds
|
|
|
|
|
`standard-output' to that buffer, so that output generated with
|
|
|
|
|
`prin1' and similar functions in BODY goes into the buffer.
|
2011-02-21 20:12:44 +00:00
|
|
|
|
|
2011-09-28 00:59:28 +00:00
|
|
|
|
At the end of BODY, this marks buffer BUFNAME unmodified and displays
|
2011-02-21 20:12:44 +00:00
|
|
|
|
it in a window, but does not select it. The normal way to do this is
|
|
|
|
|
by calling `display-buffer', then running `temp-buffer-show-hook'.
|
|
|
|
|
However, if `temp-buffer-show-function' is non-nil, it calls that
|
|
|
|
|
function instead (and does not run `temp-buffer-show-hook'). The
|
|
|
|
|
function gets one argument, the buffer to display.
|
|
|
|
|
|
|
|
|
|
The return value of `with-output-to-temp-buffer' is the value of the
|
|
|
|
|
last form in BODY. If BODY does not finish normally, the buffer
|
|
|
|
|
BUFNAME is not displayed.
|
|
|
|
|
|
|
|
|
|
This runs the hook `temp-buffer-setup-hook' before BODY,
|
|
|
|
|
with the buffer BUFNAME temporarily current. It runs the hook
|
|
|
|
|
`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
|
|
|
|
|
buffer temporarily current, and the window that was used to display it
|
|
|
|
|
temporarily selected. But it doesn't run `temp-buffer-show-hook'
|
2012-11-17 02:03:58 +00:00
|
|
|
|
if it uses `temp-buffer-show-function'.
|
|
|
|
|
|
2014-08-11 01:13:38 +00:00
|
|
|
|
By default, the setup hook puts the buffer into Help mode before running BODY.
|
|
|
|
|
If BODY does not change the major mode, the show hook makes the buffer
|
|
|
|
|
read-only, and scans it for function and variable names to make them into
|
|
|
|
|
clickable cross-references.
|
|
|
|
|
|
2012-11-17 02:03:58 +00:00
|
|
|
|
See the related form `with-temp-buffer-window'."
|
2024-02-09 19:13:29 +00:00
|
|
|
|
(declare (debug t) (indent 1))
|
2011-02-21 20:12:44 +00:00
|
|
|
|
(let ((old-dir (make-symbol "old-dir"))
|
|
|
|
|
(buf (make-symbol "buf")))
|
2011-03-30 03:27:56 +00:00
|
|
|
|
`(let* ((,old-dir default-directory)
|
|
|
|
|
(,buf
|
|
|
|
|
(with-current-buffer (get-buffer-create ,bufname)
|
|
|
|
|
(prog1 (current-buffer)
|
|
|
|
|
(kill-all-local-variables)
|
|
|
|
|
;; FIXME: delete_all_overlays
|
|
|
|
|
(setq default-directory ,old-dir)
|
|
|
|
|
(setq buffer-read-only nil)
|
|
|
|
|
(setq buffer-file-name nil)
|
|
|
|
|
(setq buffer-undo-list t)
|
|
|
|
|
(let ((inhibit-read-only t)
|
|
|
|
|
(inhibit-modification-hooks t))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(run-hooks 'temp-buffer-setup-hook)))))
|
|
|
|
|
(standard-output ,buf))
|
|
|
|
|
(prog1 (progn ,@body)
|
2012-10-23 01:18:47 +00:00
|
|
|
|
(internal-temp-output-buffer-show ,buf)))))
|
2011-02-21 20:12:44 +00:00
|
|
|
|
|
1998-11-19 09:43:40 +00:00
|
|
|
|
(defmacro with-temp-file (file &rest body)
|
|
|
|
|
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
|
|
|
|
|
The value returned is the value of the last form in BODY.
|
2020-12-19 12:39:45 +00:00
|
|
|
|
The buffer does not run the hooks `kill-buffer-hook',
|
|
|
|
|
`kill-buffer-query-functions', and `buffer-list-update-hook'.
|
1996-10-03 02:13:52 +00:00
|
|
|
|
See also `with-temp-buffer'."
|
Use `declare' in defmacros.
* lisp/window.el (save-selected-window):
* lisp/subr.el (with-temp-file, with-temp-message, with-syntax-table):
* lisp/progmodes/python.el (def-python-skeleton):
* lisp/net/dbus.el (dbus-ignore-errors):
* lisp/jka-cmpr-hook.el (with-auto-compression-mode):
* lisp/international/mule.el (with-category-table):
* lisp/emacs-lisp/timer.el (with-timeout):
* lisp/emacs-lisp/lisp-mnt.el (lm-with-file):
* lisp/emacs-lisp/eieio.el (with-slots):
* lisp/emacs-lisp/easymenu.el (easy-menu-define):
* lisp/emacs-lisp/debug.el (debugger-env-macro):
* lisp/emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq)
(Multiple-value-call, Multiple-value-prog1):
* lisp/emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key)
(cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and
edebug rule to definition.
* lisp/emacs-lisp/lisp-mode.el (save-selected-window)
(with-current-buffer, combine-after-change-calls)
(with-output-to-string, with-temp-file, with-temp-buffer)
(with-temp-message, with-syntax-table, read-if, eval-after-load)
(dolist, dotimes, when, unless):
* lisp/emacs-lisp/byte-run.el (inline): Remove indent rule, redundant.
2010-08-30 13:03:05 +00:00
|
|
|
|
(declare (indent 1) (debug t))
|
1996-09-28 04:16:00 +00:00
|
|
|
|
(let ((temp-file (make-symbol "temp-file"))
|
1996-10-03 02:13:52 +00:00
|
|
|
|
(temp-buffer (make-symbol "temp-buffer")))
|
|
|
|
|
`(let ((,temp-file ,file)
|
2020-12-19 12:39:45 +00:00
|
|
|
|
(,temp-buffer (generate-new-buffer " *temp file*" t)))
|
1996-10-03 02:13:52 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(prog1
|
|
|
|
|
(with-current-buffer ,temp-buffer
|
1998-11-19 09:43:40 +00:00
|
|
|
|
,@body)
|
1996-10-03 02:13:52 +00:00
|
|
|
|
(with-current-buffer ,temp-buffer
|
2008-05-28 17:35:34 +00:00
|
|
|
|
(write-region nil nil ,temp-file nil 0)))
|
1996-10-03 02:13:52 +00:00
|
|
|
|
(and (buffer-name ,temp-buffer)
|
|
|
|
|
(kill-buffer ,temp-buffer))))))
|
|
|
|
|
|
1998-11-19 09:43:40 +00:00
|
|
|
|
(defmacro with-temp-message (message &rest body)
|
1999-01-06 15:23:46 +00:00
|
|
|
|
"Display MESSAGE temporarily if non-nil while BODY is evaluated.
|
1998-11-19 09:43:40 +00:00
|
|
|
|
The original message is restored to the echo area after BODY has finished.
|
|
|
|
|
The value returned is the value of the last form in BODY.
|
1999-01-06 15:23:46 +00:00
|
|
|
|
MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
|
|
|
|
|
If MESSAGE is nil, the echo area and message log buffer are unchanged.
|
|
|
|
|
Use a MESSAGE of \"\" to temporarily clear the echo area."
|
Use `declare' in defmacros.
* lisp/window.el (save-selected-window):
* lisp/subr.el (with-temp-file, with-temp-message, with-syntax-table):
* lisp/progmodes/python.el (def-python-skeleton):
* lisp/net/dbus.el (dbus-ignore-errors):
* lisp/jka-cmpr-hook.el (with-auto-compression-mode):
* lisp/international/mule.el (with-category-table):
* lisp/emacs-lisp/timer.el (with-timeout):
* lisp/emacs-lisp/lisp-mnt.el (lm-with-file):
* lisp/emacs-lisp/eieio.el (with-slots):
* lisp/emacs-lisp/easymenu.el (easy-menu-define):
* lisp/emacs-lisp/debug.el (debugger-env-macro):
* lisp/emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq)
(Multiple-value-call, Multiple-value-prog1):
* lisp/emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key)
(cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and
edebug rule to definition.
* lisp/emacs-lisp/lisp-mode.el (save-selected-window)
(with-current-buffer, combine-after-change-calls)
(with-output-to-string, with-temp-file, with-temp-buffer)
(with-temp-message, with-syntax-table, read-if, eval-after-load)
(dolist, dotimes, when, unless):
* lisp/emacs-lisp/byte-run.el (inline): Remove indent rule, redundant.
2010-08-30 13:03:05 +00:00
|
|
|
|
(declare (debug t) (indent 1))
|
1999-01-06 10:05:50 +00:00
|
|
|
|
(let ((current-message (make-symbol "current-message"))
|
|
|
|
|
(temp-message (make-symbol "with-temp-message")))
|
|
|
|
|
`(let ((,temp-message ,message)
|
|
|
|
|
(,current-message))
|
1998-11-19 09:43:40 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
1999-01-06 10:05:50 +00:00
|
|
|
|
(when ,temp-message
|
|
|
|
|
(setq ,current-message (current-message))
|
1999-05-07 09:42:50 +00:00
|
|
|
|
(message "%s" ,temp-message))
|
1998-11-19 09:43:40 +00:00
|
|
|
|
,@body)
|
2001-12-16 17:41:30 +00:00
|
|
|
|
(and ,temp-message
|
|
|
|
|
(if ,current-message
|
|
|
|
|
(message "%s" ,current-message)
|
|
|
|
|
(message nil)))))))
|
1998-11-19 09:43:40 +00:00
|
|
|
|
|
|
|
|
|
(defmacro with-temp-buffer (&rest body)
|
|
|
|
|
"Create a temporary buffer, and evaluate BODY there like `progn'.
|
2020-12-19 12:39:45 +00:00
|
|
|
|
The buffer does not run the hooks `kill-buffer-hook',
|
|
|
|
|
`kill-buffer-query-functions', and `buffer-list-update-hook'.
|
1996-10-03 02:13:52 +00:00
|
|
|
|
See also `with-temp-file' and `with-output-to-string'."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 0) (debug t))
|
1996-10-03 02:13:52 +00:00
|
|
|
|
(let ((temp-buffer (make-symbol "temp-buffer")))
|
2020-12-19 12:39:45 +00:00
|
|
|
|
`(let ((,temp-buffer (generate-new-buffer " *temp*" t)))
|
2019-10-04 12:56:18 +00:00
|
|
|
|
;; `kill-buffer' can change current-buffer in some odd cases.
|
2008-03-29 22:50:11 +00:00
|
|
|
|
(with-current-buffer ,temp-buffer
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn ,@body)
|
|
|
|
|
(and (buffer-name ,temp-buffer)
|
|
|
|
|
(kill-buffer ,temp-buffer)))))))
|
1996-10-03 02:13:52 +00:00
|
|
|
|
|
2009-09-08 19:42:21 +00:00
|
|
|
|
(defmacro with-silent-modifications (&rest body)
|
Use `declare' in defmacros.
* lisp/window.el (save-selected-window):
* lisp/subr.el (with-temp-file, with-temp-message, with-syntax-table):
* lisp/progmodes/python.el (def-python-skeleton):
* lisp/net/dbus.el (dbus-ignore-errors):
* lisp/jka-cmpr-hook.el (with-auto-compression-mode):
* lisp/international/mule.el (with-category-table):
* lisp/emacs-lisp/timer.el (with-timeout):
* lisp/emacs-lisp/lisp-mnt.el (lm-with-file):
* lisp/emacs-lisp/eieio.el (with-slots):
* lisp/emacs-lisp/easymenu.el (easy-menu-define):
* lisp/emacs-lisp/debug.el (debugger-env-macro):
* lisp/emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq)
(Multiple-value-call, Multiple-value-prog1):
* lisp/emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key)
(cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and
edebug rule to definition.
* lisp/emacs-lisp/lisp-mode.el (save-selected-window)
(with-current-buffer, combine-after-change-calls)
(with-output-to-string, with-temp-file, with-temp-buffer)
(with-temp-message, with-syntax-table, read-if, eval-after-load)
(dolist, dotimes, when, unless):
* lisp/emacs-lisp/byte-run.el (inline): Remove indent rule, redundant.
2010-08-30 13:03:05 +00:00
|
|
|
|
"Execute BODY, pretending it does not modify the buffer.
|
2017-12-27 14:53:34 +00:00
|
|
|
|
This macro is typically used around modifications of
|
2019-11-04 02:36:05 +00:00
|
|
|
|
text properties that do not really affect the buffer's content.
|
2009-09-08 19:42:21 +00:00
|
|
|
|
If BODY performs real modifications to the buffer's text, other
|
|
|
|
|
than cosmetic ones, undo data may become corrupted.
|
2011-07-13 23:40:11 +00:00
|
|
|
|
|
|
|
|
|
This macro will run BODY normally, but doesn't count its buffer
|
|
|
|
|
modifications as being buffer modifications. This affects things
|
2013-06-11 16:51:12 +00:00
|
|
|
|
like `buffer-modified-p', checking whether the file is locked by
|
2011-07-13 23:40:11 +00:00
|
|
|
|
someone else, running buffer modification hooks, and other things
|
2016-04-30 21:34:29 +00:00
|
|
|
|
of that nature."
|
2009-09-08 19:42:21 +00:00
|
|
|
|
(declare (debug t) (indent 0))
|
2022-05-10 01:38:01 +00:00
|
|
|
|
(let ((modified (make-symbol "modified")))
|
2009-09-08 19:42:21 +00:00
|
|
|
|
`(let* ((,modified (buffer-modified-p))
|
|
|
|
|
(buffer-undo-list t)
|
|
|
|
|
(inhibit-read-only t)
|
2014-04-09 01:48:07 +00:00
|
|
|
|
(inhibit-modification-hooks t))
|
2009-09-08 19:42:21 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
,@body)
|
2022-05-10 01:38:01 +00:00
|
|
|
|
(when (or (not ,modified)
|
|
|
|
|
(eq ,modified 'autosaved))
|
|
|
|
|
(restore-buffer-modified-p ,modified))))))
|
2009-09-08 19:42:21 +00:00
|
|
|
|
|
1996-09-24 20:03:15 +00:00
|
|
|
|
(defmacro with-output-to-string (&rest body)
|
|
|
|
|
"Execute BODY, return the text it sent to `standard-output', as a string."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 0) (debug t))
|
2020-12-19 12:39:45 +00:00
|
|
|
|
`(let ((standard-output (generate-new-buffer " *string-output*" t)))
|
2008-09-23 17:26:40 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(let ((standard-output standard-output))
|
|
|
|
|
,@body)
|
|
|
|
|
(with-current-buffer standard-output
|
|
|
|
|
(buffer-string)))
|
|
|
|
|
(kill-buffer standard-output))))
|
1996-11-09 21:46:35 +00:00
|
|
|
|
|
2001-11-08 00:57:57 +00:00
|
|
|
|
(defmacro with-local-quit (&rest body)
|
2004-07-31 03:42:27 +00:00
|
|
|
|
"Execute BODY, allowing quits to terminate BODY but not escape further.
|
2004-10-17 06:59:15 +00:00
|
|
|
|
When a quit terminates BODY, `with-local-quit' returns nil but
|
2006-05-25 00:20:40 +00:00
|
|
|
|
requests another quit. That quit will be processed as soon as quitting
|
|
|
|
|
is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
|
2002-11-20 14:31:52 +00:00
|
|
|
|
(declare (debug t) (indent 0))
|
2001-11-08 00:57:57 +00:00
|
|
|
|
`(condition-case nil
|
|
|
|
|
(let ((inhibit-quit nil))
|
|
|
|
|
,@body)
|
2006-05-25 00:19:02 +00:00
|
|
|
|
(quit (setq quit-flag t)
|
|
|
|
|
;; This call is to give a chance to handle quit-flag
|
|
|
|
|
;; in case inhibit-quit is nil.
|
|
|
|
|
;; Without this, it will not be handled until the next function
|
|
|
|
|
;; call, and that might allow it to exit thru a condition-case
|
|
|
|
|
;; that intends to handle the quit signal next time.
|
2022-02-22 15:18:43 +00:00
|
|
|
|
(eval '(ignore nil) t))))
|
2001-11-08 00:57:57 +00:00
|
|
|
|
|
2004-12-13 19:26:42 +00:00
|
|
|
|
(defmacro while-no-input (&rest body)
|
|
|
|
|
"Execute BODY only as long as there's no pending input.
|
|
|
|
|
If input arrives, that ends the execution of BODY,
|
2005-08-09 02:51:22 +00:00
|
|
|
|
and `while-no-input' returns t. Quitting makes it return nil.
|
|
|
|
|
If BODY finishes, `while-no-input' returns whatever value BODY produced."
|
2004-12-13 19:26:42 +00:00
|
|
|
|
(declare (debug t) (indent 0))
|
|
|
|
|
(let ((catch-sym (make-symbol "input")))
|
|
|
|
|
`(with-local-quit
|
|
|
|
|
(catch ',catch-sym
|
2018-06-16 08:25:01 +00:00
|
|
|
|
(let ((throw-on-input ',catch-sym)
|
|
|
|
|
val)
|
|
|
|
|
(setq val (or (input-pending-p)
|
|
|
|
|
(progn ,@body)))
|
|
|
|
|
(cond
|
|
|
|
|
;; When input arrives while throw-on-input is non-nil,
|
|
|
|
|
;; kbd_buffer_store_buffered_event sets quit-flag to the
|
|
|
|
|
;; value of throw-on-input. If, when BODY finishes,
|
|
|
|
|
;; quit-flag still has the same value as throw-on-input, it
|
|
|
|
|
;; means BODY never tested quit-flag, and therefore ran to
|
|
|
|
|
;; completion even though input did arrive before it
|
|
|
|
|
;; finished. In that case, we must manually simulate what
|
|
|
|
|
;; 'throw' in process_quit_flag would do, and we must
|
|
|
|
|
;; reset quit-flag, because leaving it set will cause us
|
|
|
|
|
;; quit to top-level, which has undesirable consequences,
|
|
|
|
|
;; such as discarding input etc. We return t in that case
|
|
|
|
|
;; because input did arrive during execution of BODY.
|
|
|
|
|
((eq quit-flag throw-on-input)
|
|
|
|
|
(setq quit-flag nil)
|
|
|
|
|
t)
|
|
|
|
|
;; This is for when the user actually QUITs during
|
|
|
|
|
;; execution of BODY.
|
|
|
|
|
(quit-flag
|
|
|
|
|
nil)
|
|
|
|
|
(t val)))))))
|
2004-12-13 19:26:42 +00:00
|
|
|
|
|
2012-02-10 15:59:29 +00:00
|
|
|
|
(defmacro condition-case-unless-debug (var bodyform &rest handlers)
|
2013-01-13 01:23:48 +00:00
|
|
|
|
"Like `condition-case' except that it does not prevent debugging.
|
|
|
|
|
More specifically if `debug-on-error' is set then the debugger will be invoked
|
|
|
|
|
even if this catches the signal."
|
2007-07-10 19:54:43 +00:00
|
|
|
|
(declare (debug condition-case) (indent 2))
|
2013-01-13 01:23:48 +00:00
|
|
|
|
`(condition-case ,var
|
|
|
|
|
,bodyform
|
|
|
|
|
,@(mapcar (lambda (handler)
|
2023-07-03 09:10:47 +00:00
|
|
|
|
(let ((condition (car handler)))
|
|
|
|
|
(if (eq condition :success)
|
|
|
|
|
handler
|
|
|
|
|
`((debug ,@(if (listp condition) condition
|
|
|
|
|
(list condition)))
|
|
|
|
|
,@(cdr handler)))))
|
2013-01-13 01:23:48 +00:00
|
|
|
|
handlers)))
|
2007-07-10 19:54:43 +00:00
|
|
|
|
|
2013-09-10 15:30:10 +00:00
|
|
|
|
(defmacro with-demoted-errors (format &rest body)
|
2007-07-10 19:54:43 +00:00
|
|
|
|
"Run BODY and demote any errors to simple messages.
|
2014-01-24 04:11:48 +00:00
|
|
|
|
FORMAT is a string passed to `message' to format any error message.
|
|
|
|
|
It should contain a single %-sequence; e.g., \"Error: %S\".
|
|
|
|
|
|
2007-07-10 19:54:43 +00:00
|
|
|
|
If `debug-on-error' is non-nil, run BODY without catching its errors.
|
2019-11-04 02:36:05 +00:00
|
|
|
|
This is to be used around code that is not expected to signal an error
|
2022-02-05 00:39:53 +00:00
|
|
|
|
but that should be robust in the unexpected case that an error is signaled."
|
2013-09-10 15:30:10 +00:00
|
|
|
|
(declare (debug t) (indent 1))
|
2022-02-05 00:39:53 +00:00
|
|
|
|
(let* ((err (make-symbol "err"))
|
|
|
|
|
(orig-body body)
|
2022-12-28 12:10:35 +00:00
|
|
|
|
(orig-format format)
|
2022-02-05 00:39:53 +00:00
|
|
|
|
(format (if (and (stringp format) body) format
|
|
|
|
|
(prog1 "Error: %S"
|
|
|
|
|
(if format (push format body)))))
|
|
|
|
|
(exp
|
|
|
|
|
`(condition-case-unless-debug ,err
|
|
|
|
|
,(macroexp-progn body)
|
|
|
|
|
(error (message ,format ,err) nil))))
|
|
|
|
|
(if (eq orig-body body) exp
|
|
|
|
|
;; The use without `format' is obsolete, let's warn when we bump
|
|
|
|
|
;; into any such remaining uses.
|
2022-12-28 12:10:35 +00:00
|
|
|
|
(macroexp-warn-and-return
|
2023-07-10 14:31:28 +00:00
|
|
|
|
(format-message "Missing format argument in `with-demoted-errors'")
|
2023-01-03 14:58:14 +00:00
|
|
|
|
exp nil nil
|
2022-12-28 12:10:35 +00:00
|
|
|
|
orig-format))))
|
2007-07-10 19:54:43 +00:00
|
|
|
|
|
1996-11-09 21:46:35 +00:00
|
|
|
|
(defmacro combine-after-change-calls (&rest body)
|
|
|
|
|
"Execute BODY, but don't call the after-change functions till the end.
|
|
|
|
|
If BODY makes changes in the buffer, they are recorded
|
|
|
|
|
and the functions on `after-change-functions' are called several times
|
|
|
|
|
when BODY is finished.
|
1997-03-11 23:55:24 +00:00
|
|
|
|
The return value is the value of the last form in BODY.
|
1996-11-09 21:46:35 +00:00
|
|
|
|
|
|
|
|
|
If `before-change-functions' is non-nil, then calls to the after-change
|
|
|
|
|
functions can't be deferred, so in that case this macro has no effect.
|
|
|
|
|
|
|
|
|
|
Do not alter `after-change-functions' or `before-change-functions'
|
|
|
|
|
in BODY."
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 0) (debug t))
|
1996-11-09 21:46:35 +00:00
|
|
|
|
`(unwind-protect
|
|
|
|
|
(let ((combine-after-change-calls t))
|
|
|
|
|
. ,body)
|
|
|
|
|
(combine-after-change-execute)))
|
2007-04-04 15:34:43 +00:00
|
|
|
|
|
2018-04-03 16:16:49 +00:00
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
(defvar undo--combining-change-calls nil
|
|
|
|
|
"Non-nil when `combine-change-calls-1' is running.")
|
|
|
|
|
|
|
|
|
|
(defun combine-change-calls-1 (beg end body)
|
|
|
|
|
"Evaluate BODY, running the change hooks just once, for region \(BEG END).
|
|
|
|
|
|
|
|
|
|
Firstly, `before-change-functions' is invoked for the region
|
|
|
|
|
\(BEG END), then BODY (a function) is evaluated with
|
|
|
|
|
`before-change-functions' and `after-change-functions' bound to
|
|
|
|
|
nil, then finally `after-change-functions' is invoked on the
|
|
|
|
|
updated region (BEG NEW-END) with a calculated OLD-LEN argument.
|
|
|
|
|
If `inhibit-modification-hooks' is initially non-nil, the change
|
|
|
|
|
hooks are not run.
|
|
|
|
|
|
|
|
|
|
The result of `combine-change-calls-1' is the value returned by
|
|
|
|
|
BODY. BODY must not make a different buffer current, except
|
|
|
|
|
temporarily. It must not make any changes to the buffer outside
|
|
|
|
|
the specified region. It must not change
|
|
|
|
|
`before-change-functions' or `after-change-functions'.
|
|
|
|
|
|
|
|
|
|
Additionally, the buffer modifications of BODY are recorded on
|
2019-03-17 00:11:45 +00:00
|
|
|
|
the buffer's undo list as a single (apply ...) entry containing
|
2018-04-03 16:16:49 +00:00
|
|
|
|
the function `undo--wrap-and-run-primitive-undo'."
|
2021-02-10 21:39:53 +00:00
|
|
|
|
(if (markerp beg) (setq beg (marker-position beg)))
|
|
|
|
|
(if (markerp end) (setq end (marker-position end)))
|
2018-04-03 16:16:49 +00:00
|
|
|
|
(let ((old-bul buffer-undo-list)
|
|
|
|
|
(end-marker (copy-marker end t))
|
|
|
|
|
result)
|
|
|
|
|
(if undo--combining-change-calls
|
|
|
|
|
(setq result (funcall body))
|
|
|
|
|
(let ((undo--combining-change-calls t))
|
|
|
|
|
(if (not inhibit-modification-hooks)
|
|
|
|
|
(run-hook-with-args 'before-change-functions beg end))
|
2022-09-15 20:31:00 +00:00
|
|
|
|
(let ((bcf before-change-functions)
|
|
|
|
|
(acf after-change-functions)
|
|
|
|
|
(local-bcf (local-variable-p 'before-change-functions))
|
|
|
|
|
(local-acf (local-variable-p 'after-change-functions)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
;; FIXME: WIBNI we could just use `inhibit-modification-hooks'?
|
|
|
|
|
(progn
|
|
|
|
|
;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize
|
|
|
|
|
;; (e.g. via a regexp-search or sexp-movement triggering
|
|
|
|
|
;; on-the-fly syntax-propertize), make sure that this gets
|
|
|
|
|
;; properly refreshed after subsequent changes.
|
|
|
|
|
(setq-local before-change-functions
|
|
|
|
|
(if (memq #'syntax-ppss-flush-cache bcf)
|
|
|
|
|
'(syntax-ppss-flush-cache)))
|
|
|
|
|
(setq-local after-change-functions nil)
|
|
|
|
|
(setq result (funcall body)))
|
|
|
|
|
(if local-bcf (setq before-change-functions bcf)
|
|
|
|
|
(kill-local-variable 'before-change-functions))
|
|
|
|
|
(if local-acf (setq after-change-functions acf)
|
|
|
|
|
(kill-local-variable 'after-change-functions))))
|
2023-08-16 15:58:25 +00:00
|
|
|
|
;; If buffer-undo-list is neither t (in which case undo
|
|
|
|
|
;; information is not recorded) nor equal to buffer-undo-list
|
|
|
|
|
;; before body was funcalled (in which case (funcall body) did
|
|
|
|
|
;; not add items to buffer-undo-list) ...
|
|
|
|
|
(unless (or (eq buffer-undo-list t)
|
|
|
|
|
(eq buffer-undo-list old-bul))
|
|
|
|
|
(let ((ptr buffer-undo-list) body-undo-list)
|
|
|
|
|
;; ... then loop over buffer-undo-list, until the head of
|
|
|
|
|
;; buffer-undo-list before body was funcalled is found, or
|
|
|
|
|
;; ptr is nil (which may happen if garbage-collect has
|
|
|
|
|
;; been called after (funcall body) and has removed
|
|
|
|
|
;; entries of buffer-undo-list that were added by (funcall
|
|
|
|
|
;; body)), and add these entries to body-undo-list.
|
|
|
|
|
(while (and ptr (not (eq ptr old-bul)))
|
|
|
|
|
(push (car ptr) body-undo-list)
|
|
|
|
|
(setq ptr (cdr ptr)))
|
|
|
|
|
(setq body-undo-list (nreverse body-undo-list))
|
|
|
|
|
;; Warn if garbage-collect has truncated buffer-undo-list
|
|
|
|
|
;; behind our back.
|
|
|
|
|
(when (and old-bul (not ptr))
|
|
|
|
|
(message
|
|
|
|
|
"combine-change-calls: buffer-undo-list has been truncated"))
|
|
|
|
|
;; Add an (apply ...) entry to buffer-undo-list, using
|
|
|
|
|
;; body-undo-list ...
|
|
|
|
|
(push (list 'apply
|
|
|
|
|
(- end end-marker)
|
|
|
|
|
beg
|
|
|
|
|
(marker-position end-marker)
|
|
|
|
|
#'undo--wrap-and-run-primitive-undo
|
|
|
|
|
beg (marker-position end-marker)
|
|
|
|
|
body-undo-list)
|
|
|
|
|
buffer-undo-list)
|
|
|
|
|
;; ... and set the cdr of buffer-undo-list to
|
|
|
|
|
;; buffer-undo-list before body was funcalled.
|
|
|
|
|
(setcdr buffer-undo-list old-bul)))
|
2018-04-03 16:16:49 +00:00
|
|
|
|
(if (not inhibit-modification-hooks)
|
|
|
|
|
(run-hook-with-args 'after-change-functions
|
|
|
|
|
beg (marker-position end-marker)
|
|
|
|
|
(- end beg)))))
|
|
|
|
|
(set-marker end-marker nil)
|
|
|
|
|
result))
|
|
|
|
|
|
|
|
|
|
(defmacro combine-change-calls (beg end &rest body)
|
|
|
|
|
"Evaluate BODY, running the change hooks just once.
|
|
|
|
|
|
2020-05-11 04:18:14 +00:00
|
|
|
|
BODY is a sequence of Lisp forms to evaluate. BEG and END bound
|
2018-04-03 16:16:49 +00:00
|
|
|
|
the region the change hooks will be run for.
|
|
|
|
|
|
|
|
|
|
Firstly, `before-change-functions' is invoked for the region
|
|
|
|
|
\(BEG END), then the BODY forms are evaluated with
|
|
|
|
|
`before-change-functions' and `after-change-functions' bound to
|
|
|
|
|
nil, and finally `after-change-functions' is invoked on the
|
|
|
|
|
updated region. The change hooks are not run if
|
|
|
|
|
`inhibit-modification-hooks' is initially non-nil.
|
|
|
|
|
|
|
|
|
|
The result of `combine-change-calls' is the value returned by the
|
|
|
|
|
last of the BODY forms to be evaluated. BODY may not make a
|
|
|
|
|
different buffer current, except temporarily. BODY may not
|
|
|
|
|
change the buffer outside the specified region. It must not
|
|
|
|
|
change `before-change-functions' or `after-change-functions'.
|
|
|
|
|
|
|
|
|
|
Additionally, the buffer modifications of BODY are recorded on
|
|
|
|
|
the buffer's undo list as a single \(apply ...) entry containing
|
2020-05-11 04:18:14 +00:00
|
|
|
|
the function `undo--wrap-and-run-primitive-undo'."
|
2021-05-17 08:00:36 +00:00
|
|
|
|
(declare (debug (form form def-body)) (indent 2))
|
2018-04-03 16:16:49 +00:00
|
|
|
|
`(combine-change-calls-1 ,beg ,end (lambda () ,@body)))
|
|
|
|
|
|
|
|
|
|
(defun undo--wrap-and-run-primitive-undo (beg end list)
|
|
|
|
|
"Call `primitive-undo' on the undo elements in LIST.
|
|
|
|
|
|
|
|
|
|
This function is intended to be called purely by `undo' as the
|
|
|
|
|
function in an \(apply DELTA BEG END FUNNAME . ARGS) undo
|
|
|
|
|
element. It invokes `before-change-functions' and
|
|
|
|
|
`after-change-functions' once each for the entire region \(BEG
|
|
|
|
|
END) rather than once for each individual change.
|
|
|
|
|
|
|
|
|
|
Additionally the fresh \"redo\" elements which are generated on
|
|
|
|
|
`buffer-undo-list' will themselves be \"enclosed\" in
|
|
|
|
|
`undo--wrap-and-run-primitive-undo'.
|
|
|
|
|
|
|
|
|
|
Undo elements of this form are generated by the macro
|
|
|
|
|
`combine-change-calls'."
|
|
|
|
|
(combine-change-calls beg end
|
|
|
|
|
(while list
|
|
|
|
|
(setq list (primitive-undo 1 list)))))
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
2007-04-04 15:34:43 +00:00
|
|
|
|
(defmacro with-case-table (table &rest body)
|
|
|
|
|
"Execute the forms in BODY with TABLE as the current case table.
|
|
|
|
|
The value returned is the value of the last form in BODY."
|
|
|
|
|
(declare (indent 1) (debug t))
|
2007-04-06 12:15:04 +00:00
|
|
|
|
(let ((old-case-table (make-symbol "table"))
|
|
|
|
|
(old-buffer (make-symbol "buffer")))
|
|
|
|
|
`(let ((,old-case-table (current-case-table))
|
|
|
|
|
(,old-buffer (current-buffer)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn (set-case-table ,table)
|
|
|
|
|
,@body)
|
|
|
|
|
(with-current-buffer ,old-buffer
|
|
|
|
|
(set-case-table ,old-case-table))))))
|
2014-05-14 17:15:15 +00:00
|
|
|
|
|
|
|
|
|
(defmacro with-file-modes (modes &rest body)
|
|
|
|
|
"Execute BODY with default file permissions temporarily set to MODES.
|
|
|
|
|
MODES is as for `set-default-file-modes'."
|
|
|
|
|
(declare (indent 1) (debug t))
|
|
|
|
|
(let ((umask (make-symbol "umask")))
|
|
|
|
|
`(let ((,umask (default-file-modes)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(set-default-file-modes ,modes)
|
|
|
|
|
,@body)
|
|
|
|
|
(set-default-file-modes ,umask)))))
|
|
|
|
|
|
2021-09-01 10:13:19 +00:00
|
|
|
|
(defmacro with-existing-directory (&rest body)
|
|
|
|
|
"Execute BODY with `default-directory' bound to an existing directory.
|
|
|
|
|
If `default-directory' is already an existing directory, it's not changed."
|
|
|
|
|
(declare (indent 0) (debug t))
|
|
|
|
|
`(let ((default-directory (seq-find (lambda (dir)
|
|
|
|
|
(and dir
|
|
|
|
|
(file-exists-p dir)))
|
|
|
|
|
(list default-directory
|
|
|
|
|
(expand-file-name "~/")
|
2021-09-25 00:55:55 +00:00
|
|
|
|
temporary-file-directory
|
2021-09-01 10:13:19 +00:00
|
|
|
|
(getenv "TMPDIR")
|
|
|
|
|
"/tmp/")
|
|
|
|
|
"/")))
|
|
|
|
|
,@body))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;; Matching and match data.
|
2002-04-19 00:06:54 +00:00
|
|
|
|
|
1993-04-10 06:21:55 +00:00
|
|
|
|
(defmacro save-match-data (&rest body)
|
2002-02-25 17:44:03 +00:00
|
|
|
|
"Execute the BODY forms, restoring the global value of the match data.
|
2020-05-23 13:33:41 +00:00
|
|
|
|
The value returned is the value of the last form in BODY.
|
|
|
|
|
NOTE: The convention in Elisp is that any function, except for a few
|
|
|
|
|
exceptions like car/assoc/+/goto-char, can clobber the match data,
|
|
|
|
|
so `save-match-data' should normally be used to save *your* match data
|
|
|
|
|
rather than your caller's match data."
|
Fix bootstrapping problems.
Use the system locale to specify Emacs locale defaults.
* international/mule-cmds.el (global-map):
Do not use backquote, because that makes a bootstrapping
problem if you need to recompile all Lisp files using interpreted code.
* international/mule.el (charset-id, charset-bytes,
charset-dimension, charset-chars, charset-width,
charset-direction, charset-iso-final-char,
charset-iso-graphic-plane, charset-reverse-charset,
charset-short-name, charset-long-name, charset-description,
charset-plist): Likewise.
* subr.el (save-match-data): Likewise.
* international/mule-cmds.el
(set-display-table-and-terminal-coding-system): New function,
containing code migrated out of set-language-environment.
(set-language-environment, set-locale-environment): Use it.
(locale-translation-file-name): Moved here from startup.el.
(locale-language-names, locale-preferred-coding-systems):
New vars.
(locale-name-match, set-locale-environment): New functions.
* language/japan-util.el (setup-japanese-environment-internal):
Prefer japanese-iso-8bit if the system-type is usg-unix-v.
* startup.el (iso-8859-n-locale-regexp): Remove.
(locale-translation-file-name): Move to mule-cmds.el.
(command-line): Move locale-stuff into set-locale-environment.
1999-10-19 07:18:58 +00:00
|
|
|
|
;; It is better not to use backquote here,
|
|
|
|
|
;; because that makes a bootstrapping problem
|
|
|
|
|
;; if you need to recompile all the Lisp files using interpreted code.
|
2003-05-17 22:00:40 +00:00
|
|
|
|
(declare (indent 0) (debug t))
|
2022-09-07 15:55:44 +00:00
|
|
|
|
(let ((saved-match-data (make-symbol "saved-match-data")))
|
|
|
|
|
(list 'let
|
|
|
|
|
(list (list saved-match-data '(match-data)))
|
|
|
|
|
(list 'unwind-protect
|
|
|
|
|
(cons 'progn body)
|
|
|
|
|
(list 'set-match-data saved-match-data t)))))
|
1995-03-23 08:43:08 +00:00
|
|
|
|
|
1995-03-24 09:01:09 +00:00
|
|
|
|
(defun match-string (num &optional string)
|
2021-09-22 22:09:47 +00:00
|
|
|
|
"Return the string of text matched by the previous search or regexp operation.
|
2021-09-23 07:36:59 +00:00
|
|
|
|
NUM specifies the number of the parenthesized sub-expression in the last
|
|
|
|
|
regexp whose match to return. Zero means return the text matched by the
|
|
|
|
|
entire regexp or the whole string.
|
2021-09-22 22:09:47 +00:00
|
|
|
|
|
2021-09-23 07:36:59 +00:00
|
|
|
|
The return value is nil if NUMth pair didn't match anything, or if there
|
|
|
|
|
were fewer than NUM sub-expressions in the regexp used in the search.
|
2021-09-22 22:09:47 +00:00
|
|
|
|
|
|
|
|
|
STRING should be given if the last search was by `string-match'
|
|
|
|
|
on STRING. If STRING is nil, the current buffer should be the
|
2021-09-23 07:36:59 +00:00
|
|
|
|
same buffer as the one in which the search/match was performed.
|
2021-09-22 22:09:47 +00:00
|
|
|
|
|
|
|
|
|
Note that many functions in Emacs modify the match data, so this
|
|
|
|
|
function should be called \"close\" to the function that did the
|
2021-09-23 07:36:59 +00:00
|
|
|
|
regexp search. In particular, saying (for instance)
|
2021-09-22 22:09:47 +00:00
|
|
|
|
`M-: (looking-at \"[0-9]\") RET' followed by `M-: (match-string 0) RET'
|
|
|
|
|
interactively is seldom meaningful, since the Emacs command loop
|
|
|
|
|
may modify the match data."
|
2019-04-17 16:35:12 +00:00
|
|
|
|
(declare (side-effect-free t))
|
1995-03-24 09:01:09 +00:00
|
|
|
|
(if (match-beginning num)
|
|
|
|
|
(if string
|
|
|
|
|
(substring string (match-beginning num) (match-end num))
|
|
|
|
|
(buffer-substring (match-beginning num) (match-end num)))))
|
1995-01-27 07:06:27 +00:00
|
|
|
|
|
1997-12-21 02:08:37 +00:00
|
|
|
|
(defun match-string-no-properties (num &optional string)
|
|
|
|
|
"Return string of text matched by last search, without text properties.
|
|
|
|
|
NUM specifies which parenthesized expression in the last regexp.
|
|
|
|
|
Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
|
|
|
|
|
Zero means the entire text matched by the whole regexp or whole string.
|
2011-09-11 02:10:15 +00:00
|
|
|
|
STRING should be given if the last search was by `string-match' on STRING.
|
|
|
|
|
If STRING is nil, the current buffer should be the same buffer
|
|
|
|
|
the search/match was performed in."
|
2019-04-17 16:35:12 +00:00
|
|
|
|
(declare (side-effect-free t))
|
1997-12-21 02:08:37 +00:00
|
|
|
|
(if (match-beginning num)
|
|
|
|
|
(if string
|
2004-04-16 12:51:06 +00:00
|
|
|
|
(substring-no-properties string (match-beginning num)
|
|
|
|
|
(match-end num))
|
1997-12-21 02:08:37 +00:00
|
|
|
|
(buffer-substring-no-properties (match-beginning num)
|
|
|
|
|
(match-end num)))))
|
|
|
|
|
|
2007-11-10 21:48:16 +00:00
|
|
|
|
|
|
|
|
|
(defun match-substitute-replacement (replacement
|
|
|
|
|
&optional fixedcase literal string subexp)
|
|
|
|
|
"Return REPLACEMENT as it will be inserted by `replace-match'.
|
|
|
|
|
In other words, all back-references in the form `\\&' and `\\N'
|
|
|
|
|
are substituted with actual strings matched by the last search.
|
|
|
|
|
Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
|
|
|
|
|
meaning as for `replace-match'."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2007-11-10 21:48:16 +00:00
|
|
|
|
(let ((match (match-string 0 string)))
|
|
|
|
|
(save-match-data
|
2020-12-04 17:37:21 +00:00
|
|
|
|
(match-data--translate (- (match-beginning 0)))
|
2007-11-10 21:48:16 +00:00
|
|
|
|
(replace-match replacement fixedcase literal match subexp))))
|
|
|
|
|
|
|
|
|
|
|
2005-05-29 08:34:46 +00:00
|
|
|
|
(defun looking-back (regexp &optional limit greedy)
|
2003-06-18 21:49:55 +00:00
|
|
|
|
"Return non-nil if text before point matches regular expression REGEXP.
|
2004-10-16 15:29:46 +00:00
|
|
|
|
Like `looking-at' except matches before point, and is slower.
|
2006-07-24 17:01:08 +00:00
|
|
|
|
LIMIT if non-nil speeds up the search by specifying a minimum
|
|
|
|
|
starting position, to avoid checking matches that would start
|
|
|
|
|
before LIMIT.
|
2005-05-29 08:34:46 +00:00
|
|
|
|
|
2008-11-03 19:22:28 +00:00
|
|
|
|
If GREEDY is non-nil, extend the match backwards as far as
|
|
|
|
|
possible, stopping when a single additional previous character
|
|
|
|
|
cannot be part of a match for REGEXP. When the match is
|
2008-11-04 07:35:57 +00:00
|
|
|
|
extended, its starting position is allowed to occur before
|
2013-09-29 06:16:45 +00:00
|
|
|
|
LIMIT.
|
|
|
|
|
|
|
|
|
|
As a general recommendation, try to avoid using `looking-back'
|
|
|
|
|
wherever possible, since it is slow."
|
2015-04-16 02:25:16 +00:00
|
|
|
|
(declare
|
|
|
|
|
(advertised-calling-convention (regexp limit &optional greedy) "25.1"))
|
2005-05-29 08:34:46 +00:00
|
|
|
|
(let ((start (point))
|
|
|
|
|
(pos
|
|
|
|
|
(save-excursion
|
|
|
|
|
(and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
|
|
|
|
|
(point)))))
|
|
|
|
|
(if (and greedy pos)
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point-min) start)
|
|
|
|
|
(while (and (> pos (point-min))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char pos)
|
|
|
|
|
(backward-char 1)
|
|
|
|
|
(looking-at (concat "\\(?:" regexp "\\)\\'"))))
|
|
|
|
|
(setq pos (1- pos)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char pos)
|
|
|
|
|
(looking-at (concat "\\(?:" regexp "\\)\\'")))))
|
|
|
|
|
(not (null pos))))
|
|
|
|
|
|
2007-07-10 03:54:30 +00:00
|
|
|
|
(defsubst looking-at-p (regexp)
|
|
|
|
|
"\
|
|
|
|
|
Same as `looking-at' except this function does not change the match data."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2021-10-07 18:46:50 +00:00
|
|
|
|
(looking-at regexp t))
|
2007-07-10 03:54:30 +00:00
|
|
|
|
|
|
|
|
|
(defsubst string-match-p (regexp string &optional start)
|
|
|
|
|
"\
|
|
|
|
|
Same as `string-match' except this function does not change the match data."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2021-10-07 18:46:50 +00:00
|
|
|
|
(string-match regexp string start t))
|
2007-07-10 03:54:30 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun subregexp-context-p (regexp pos &optional start)
|
|
|
|
|
"Return non-nil if POS is in a normal subregexp context in REGEXP.
|
|
|
|
|
A subregexp context is one where a sub-regexp can appear.
|
|
|
|
|
A non-subregexp context is for example within brackets, or within a
|
|
|
|
|
repetition bounds operator `\\=\\{...\\}', or right after a `\\'.
|
|
|
|
|
If START is non-nil, it should be a position in REGEXP, smaller
|
|
|
|
|
than POS, and known to be in a subregexp context."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; Here's one possible implementation, with the great benefit that it
|
|
|
|
|
;; reuses the regexp-matcher's own parser, so it understands all the
|
|
|
|
|
;; details of the syntax. A disadvantage is that it needs to match the
|
|
|
|
|
;; error string.
|
|
|
|
|
(condition-case err
|
|
|
|
|
(progn
|
|
|
|
|
(string-match (substring regexp (or start 0) pos) "")
|
|
|
|
|
t)
|
|
|
|
|
(invalid-regexp
|
|
|
|
|
(not (member (cadr err) '("Unmatched [ or [^"
|
|
|
|
|
"Unmatched \\{"
|
|
|
|
|
"Trailing backslash")))))
|
|
|
|
|
;; An alternative implementation:
|
|
|
|
|
;; (defconst re-context-re
|
|
|
|
|
;; (let* ((harmless-ch "[^\\[]")
|
|
|
|
|
;; (harmless-esc "\\\\[^{]")
|
|
|
|
|
;; (class-harmless-ch "[^][]")
|
|
|
|
|
;; (class-lb-harmless "[^]:]")
|
|
|
|
|
;; (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
|
|
|
|
|
;; (class-lb (concat "\\[\\(" class-lb-harmless
|
|
|
|
|
;; "\\|" class-lb-colon-maybe-charclass "\\)"))
|
|
|
|
|
;; (class
|
|
|
|
|
;; (concat "\\[^?]?"
|
|
|
|
|
;; "\\(" class-harmless-ch
|
|
|
|
|
;; "\\|" class-lb "\\)*"
|
|
|
|
|
;; "\\[?]")) ; special handling for bare [ at end of re
|
|
|
|
|
;; (braces "\\\\{[0-9,]+\\\\}"))
|
|
|
|
|
;; (concat "\\`\\(" harmless-ch "\\|" harmless-esc
|
|
|
|
|
;; "\\|" class "\\|" braces "\\)*\\'"))
|
|
|
|
|
;; "Matches any prefix that corresponds to a normal subregexp context.")
|
|
|
|
|
;; (string-match re-context-re (substring regexp (or start 0) pos))
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
;;;; split-string
|
2003-05-30 23:11:35 +00:00
|
|
|
|
|
2003-05-22 20:59:57 +00:00
|
|
|
|
(defconst split-string-default-separators "[ \f\t\n\r\v]+"
|
|
|
|
|
"The default value of separators for `split-string'.
|
|
|
|
|
|
|
|
|
|
A regexp matching strings of whitespace. May be locale-dependent
|
|
|
|
|
\(as yet unimplemented). Should not match non-breaking spaces.
|
|
|
|
|
|
|
|
|
|
Warning: binding this to a different value and using it as default is
|
|
|
|
|
likely to have undesired semantics.")
|
|
|
|
|
|
|
|
|
|
;; The specification says that if both SEPARATORS and OMIT-NULLS are
|
|
|
|
|
;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical
|
|
|
|
|
;; expression leads to the equivalent implementation that if SEPARATORS
|
|
|
|
|
;; is defaulted, OMIT-NULLS is treated as t.
|
2013-07-19 12:18:16 +00:00
|
|
|
|
(defun split-string (string &optional separators omit-nulls trim)
|
2004-09-08 12:24:29 +00:00
|
|
|
|
"Split STRING into substrings bounded by matches for SEPARATORS.
|
2003-05-22 20:59:57 +00:00
|
|
|
|
|
|
|
|
|
The beginning and end of STRING, and each match for SEPARATORS, are
|
|
|
|
|
splitting points. The substrings matching SEPARATORS are removed, and
|
|
|
|
|
the substrings between the splitting points are collected as a list,
|
1996-09-24 21:19:03 +00:00
|
|
|
|
which is returned.
|
1997-12-21 01:35:50 +00:00
|
|
|
|
|
2003-05-22 20:59:57 +00:00
|
|
|
|
If SEPARATORS is non-nil, it should be a regular expression matching text
|
2019-11-04 02:36:05 +00:00
|
|
|
|
that separates, but is not part of, the substrings. If nil it defaults to
|
2003-05-22 20:59:57 +00:00
|
|
|
|
`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
|
|
|
|
|
OMIT-NULLS is forced to t.
|
|
|
|
|
|
2013-06-11 16:51:12 +00:00
|
|
|
|
If OMIT-NULLS is t, zero-length substrings are omitted from the list (so
|
2003-05-22 20:59:57 +00:00
|
|
|
|
that for the default value of SEPARATORS leading and trailing whitespace
|
|
|
|
|
are effectively trimmed). If nil, all zero-length substrings are retained,
|
|
|
|
|
which correctly parses CSV format, for example.
|
|
|
|
|
|
2013-07-19 12:18:16 +00:00
|
|
|
|
If TRIM is non-nil, it should be a regular expression to match
|
|
|
|
|
text to trim from the beginning and end of each substring. If trimming
|
|
|
|
|
makes the substring empty, it is treated as null.
|
|
|
|
|
|
|
|
|
|
If you want to trim whitespace from the substrings, the reliably correct
|
|
|
|
|
way is using TRIM. Making SEPARATORS match that whitespace gives incorrect
|
|
|
|
|
results when there is whitespace at the start or end of STRING. If you
|
|
|
|
|
see such calls to `split-string', please fix them.
|
|
|
|
|
|
2003-05-22 20:59:57 +00:00
|
|
|
|
Note that the effect of `(split-string STRING)' is the same as
|
2007-01-06 14:36:34 +00:00
|
|
|
|
`(split-string STRING split-string-default-separators t)'. In the rare
|
2003-05-22 20:59:57 +00:00
|
|
|
|
case that you wish to retain zero-length substrings when splitting on
|
|
|
|
|
whitespace, use `(split-string STRING split-string-default-separators)'.
|
2000-02-22 20:16:31 +00:00
|
|
|
|
|
|
|
|
|
Modifies the match data; use `save-match-data' if necessary."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2013-07-19 12:18:16 +00:00
|
|
|
|
(let* ((keep-nulls (not (if separators omit-nulls t)))
|
|
|
|
|
(rexp (or separators split-string-default-separators))
|
|
|
|
|
(start 0)
|
|
|
|
|
this-start this-end
|
|
|
|
|
notfirst
|
|
|
|
|
(list nil)
|
|
|
|
|
(push-one
|
|
|
|
|
;; Push the substring in range THIS-START to THIS-END
|
|
|
|
|
;; onto LIST, trimming it and perhaps discarding it.
|
|
|
|
|
(lambda ()
|
|
|
|
|
(when trim
|
|
|
|
|
;; Discard the trim from start of this substring.
|
|
|
|
|
(let ((tem (string-match trim string this-start)))
|
|
|
|
|
(and (eq tem this-start)
|
|
|
|
|
(setq this-start (match-end 0)))))
|
|
|
|
|
|
|
|
|
|
(when (or keep-nulls (< this-start this-end))
|
|
|
|
|
(let ((this (substring string this-start this-end)))
|
|
|
|
|
|
|
|
|
|
;; Discard the trim from end of this substring.
|
|
|
|
|
(when trim
|
|
|
|
|
(let ((tem (string-match (concat trim "\\'") this 0)))
|
|
|
|
|
(and tem (< tem (length this))
|
|
|
|
|
(setq this (substring this 0 tem)))))
|
|
|
|
|
|
|
|
|
|
;; Trimming could make it empty; check again.
|
|
|
|
|
(when (or keep-nulls (> (length this) 0))
|
|
|
|
|
(push this list)))))))
|
|
|
|
|
|
1997-12-21 01:35:50 +00:00
|
|
|
|
(while (and (string-match rexp string
|
|
|
|
|
(if (and notfirst
|
|
|
|
|
(= start (match-beginning 0))
|
|
|
|
|
(< start (length string)))
|
|
|
|
|
(1+ start) start))
|
2003-05-22 20:59:57 +00:00
|
|
|
|
(< start (length string)))
|
1997-12-21 01:35:50 +00:00
|
|
|
|
(setq notfirst t)
|
2013-07-19 12:18:16 +00:00
|
|
|
|
(setq this-start start this-end (match-beginning 0)
|
|
|
|
|
start (match-end 0))
|
|
|
|
|
|
|
|
|
|
(funcall push-one))
|
|
|
|
|
|
|
|
|
|
;; Handle the substring at the end of STRING.
|
|
|
|
|
(setq this-start start this-end (length string))
|
|
|
|
|
(funcall push-one)
|
|
|
|
|
|
1996-09-24 21:19:03 +00:00
|
|
|
|
(nreverse list)))
|
2007-06-28 01:35:10 +00:00
|
|
|
|
|
2022-09-09 21:51:05 +00:00
|
|
|
|
(defalias 'string-split #'split-string)
|
|
|
|
|
|
2007-08-12 17:59:40 +00:00
|
|
|
|
(defun combine-and-quote-strings (strings &optional separator)
|
2007-06-28 01:35:10 +00:00
|
|
|
|
"Concatenate the STRINGS, adding the SEPARATOR (default \" \").
|
|
|
|
|
This tries to quote the strings to avoid ambiguity such that
|
2007-08-12 17:59:40 +00:00
|
|
|
|
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
|
2016-07-03 13:56:36 +00:00
|
|
|
|
Only some SEPARATORs will work properly.
|
|
|
|
|
|
|
|
|
|
Note that this is not intended to protect STRINGS from
|
|
|
|
|
interpretation by shells, use `shell-quote-argument' for that."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2008-04-07 16:29:54 +00:00
|
|
|
|
(let* ((sep (or separator " "))
|
|
|
|
|
(re (concat "[\\\"]" "\\|" (regexp-quote sep))))
|
2007-06-28 01:35:10 +00:00
|
|
|
|
(mapconcat
|
|
|
|
|
(lambda (str)
|
2008-04-07 16:29:54 +00:00
|
|
|
|
(if (string-match re str)
|
2007-06-28 01:35:10 +00:00
|
|
|
|
(concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
|
|
|
|
|
str))
|
|
|
|
|
strings sep)))
|
|
|
|
|
|
2007-08-12 17:59:40 +00:00
|
|
|
|
(defun split-string-and-unquote (string &optional separator)
|
2007-06-28 01:35:10 +00:00
|
|
|
|
"Split the STRING into a list of strings.
|
2007-08-12 17:59:40 +00:00
|
|
|
|
It understands Emacs Lisp quoting within STRING, such that
|
|
|
|
|
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
|
2007-06-28 01:35:10 +00:00
|
|
|
|
The SEPARATOR regexp defaults to \"\\s-+\"."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2007-06-28 01:35:10 +00:00
|
|
|
|
(let ((sep (or separator "\\s-+"))
|
Use string-search instead of string-match[-p]
`string-search` is easier to understand, less error-prone, much
faster, does not pollute the regexp cache, and does not mutate global
state. Use it where applicable and obviously safe (erring on the
conservative side).
* admin/authors.el (authors-canonical-file-name)
(authors-scan-change-log):
* lisp/apropos.el (apropos-command)
(apropos-documentation-property, apropos-symbols-internal):
* lisp/arc-mode.el (archive-arc-summarize)
(archive-zoo-summarize):
* lisp/calc/calc-aent.el (math-read-factor):
* lisp/calc/calc-ext.el (math-read-big-expr)
(math-format-nice-expr, math-format-number-fancy):
* lisp/calc/calc-forms.el (math-read-angle-brackets):
* lisp/calc/calc-graph.el (calc-graph-set-range):
* lisp/calc/calc-keypd.el (calc-keypad-press):
* lisp/calc/calc-lang.el (tex, latex, math-read-big-rec):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-user-define-permanent, math-define-exp):
* lisp/calc/calc.el (calc-record, calcDigit-key)
(calc-count-lines):
* lisp/calc/calcalg2.el (calc-solve-for, calc-poly-roots)
(math-do-integral):
* lisp/calc/calcalg3.el (calc-find-root, calc-find-minimum)
(calc-get-fit-variables):
* lisp/cedet/ede/speedbar.el (ede-tag-expand):
* lisp/cedet/semantic/java.el (semantic-java-expand-tag):
* lisp/cedet/semantic/sb.el (semantic-sb-show-extra)
(semantic-sb-expand-group):
* lisp/cedet/semantic/wisent/python.el
(semantic-python-instance-variable-p):
* lisp/cus-edit.el (get):
* lisp/descr-text.el (describe-text-sexp):
* lisp/dired-aux.el (dired-compress-file):
* lisp/dired-x.el (dired-make-relative-symlink):
* lisp/dired.el (dired-glob-regexp):
* lisp/dos-fns.el (dos-convert-standard-filename, dos-8+3-filename):
* lisp/edmacro.el (edmacro-format-keys):
* lisp/emacs-lisp/eieio-opt.el (eieio-sb-expand):
* lisp/emacs-lisp/eieio-speedbar.el (eieio-speedbar-object-expand):
* lisp/emacs-lisp/lisp-mnt.el (lm-keywords-list):
* lisp/emacs-lisp/warnings.el (display-warning):
* lisp/emulation/viper-ex.el (viper-ex-read-file-name)
(ex-print-display-lines):
* lisp/env.el (read-envvar-name, setenv):
* lisp/epa-mail.el (epa-mail-encrypt):
* lisp/epg.el (epg--start):
* lisp/erc/erc-backend.el (erc-parse-server-response):
* lisp/erc/erc-dcc.el (erc-dcc-member):
* lisp/erc/erc-speedbar.el (erc-speedbar-expand-server)
(erc-speedbar-expand-channel, erc-speedbar-expand-user):
* lisp/erc/erc.el (erc-send-input):
* lisp/eshell/em-glob.el (eshell-glob-entries):
* lisp/eshell/esh-proc.el (eshell-needs-pipe-p):
* lisp/eshell/esh-util.el (eshell-convert):
* lisp/eshell/esh-var.el (eshell-envvar-names):
* lisp/faces.el (x-resolve-font-name):
* lisp/ffap.el (ffap-file-at-point):
* lisp/files.el (wildcard-to-regexp, shell-quote-wildcard-pattern):
* lisp/forms.el (forms--update):
* lisp/frameset.el (frameset-filter-unshelve-param):
* lisp/gnus/gnus-art.el (article-decode-charset):
* lisp/gnus/gnus-kill.el (gnus-kill-parse-rn-kill-file):
* lisp/gnus/gnus-mlspl.el (gnus-group-split-fancy):
* lisp/gnus/gnus-msg.el (gnus-summary-resend-message-insert-gcc)
(gnus-inews-insert-gcc):
* lisp/gnus/gnus-rfc1843.el (rfc1843-decode-article-body):
* lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output)
(gnus-search--complete-key-data):
* lisp/gnus/gnus-spec.el (gnus-parse-simple-format):
* lisp/gnus/gnus-sum.el (gnus-summary-refer-article):
* lisp/gnus/gnus-util.el (gnus-extract-address-components)
(gnus-newsgroup-directory-form):
* lisp/gnus/gnus-uu.el (gnus-uu-grab-view):
* lisp/gnus/gnus.el (gnus-group-native-p, gnus-short-group-name):
* lisp/gnus/message.el (message-check-news-header-syntax)
(message-make-message-id, message-user-mail-address)
(message-make-fqdn, message-get-reply-headers, message-followup):
* lisp/gnus/mm-decode.el (mm-dissect-buffer):
* lisp/gnus/nnheader.el (nnheader-insert):
* lisp/gnus/nnimap.el (nnimap-process-quirk)
(nnimap-imap-ranges-to-gnus-ranges):
* lisp/gnus/nnmaildir.el (nnmaildir--ensure-suffix):
* lisp/gnus/nnmairix.el (nnmairix-determine-original-group-from-path):
* lisp/gnus/nnrss.el (nnrss-match-macro):
* lisp/gnus/nntp.el (nntp-find-group-and-number):
* lisp/help-fns.el (help--symbol-completion-table-affixation):
* lisp/help.el (help-function-arglist):
* lisp/hippie-exp.el (he-concat-directory-file-name):
* lisp/htmlfontify.el (hfy-relstub):
* lisp/ido.el (ido-make-prompt, ido-complete, ido-copy-current-word)
(ido-exhibit):
* lisp/image/image-converter.el (image-convert-p):
* lisp/info-xref.el (info-xref-docstrings):
* lisp/info.el (Info-toc-build, Info-follow-reference)
(Info-backward-node, Info-finder-find-node)
(Info-speedbar-expand-node):
* lisp/international/mule-diag.el (print-fontset-element):
* lisp/language/korea-util.el (default-korean-keyboard):
* lisp/linum.el (linum-after-change):
* lisp/mail/ietf-drums.el (ietf-drums-parse-address):
* lisp/mail/mail-utils.el (mail-dont-reply-to):
* lisp/mail/rfc2047.el (rfc2047-encode-1, rfc2047-decode-string):
* lisp/mail/rfc2231.el (rfc2231-parse-string):
* lisp/mail/rmailkwd.el (rmail-set-label):
* lisp/mail/rmailsum.el (rmail-header-summary):
* lisp/mail/smtpmail.el (smtpmail-maybe-append-domain)
(smtpmail-user-mail-address):
* lisp/mail/uce.el (uce-reply-to-uce):
* lisp/man.el (Man-default-man-entry):
* lisp/mh-e/mh-alias.el (mh-alias-gecos-name)
(mh-alias-minibuffer-confirm-address):
* lisp/mh-e/mh-comp.el (mh-forwarded-letter-subject):
* lisp/mh-e/mh-speed.el (mh-speed-parse-flists-output):
* lisp/mh-e/mh-utils.el (mh-collect-folder-names-filter)
(mh-folder-completion-function):
* lisp/minibuffer.el (completion--make-envvar-table)
(completion-file-name-table, completion-flex-try-completion)
(completion-flex-all-completions):
* lisp/mpc.el (mpc--proc-quote-string, mpc-cmd-special-tag-p)
(mpc-constraints-tag-lookup):
* lisp/net/ange-ftp.el (ange-ftp-send-cmd)
(ange-ftp-allow-child-lookup):
* lisp/net/mailcap.el (mailcap-mime-types):
* lisp/net/mairix.el (mairix-search-thread-this-article):
* lisp/net/pop3.el (pop3-open-server):
* lisp/net/soap-client.el (soap-decode-xs-complex-type):
* lisp/net/socks.el (socks-filter):
* lisp/nxml/nxml-outln.el (nxml-highlighted-qname):
* lisp/nxml/rng-cmpct.el (rng-c-expand-name, rng-c-expand-datatype):
* lisp/nxml/rng-uri.el (rng-uri-file-name-1):
* lisp/obsolete/complete.el (partial-completion-mode)
(PC-do-completion):
* lisp/obsolete/longlines.el (longlines-encode-string):
* lisp/obsolete/nnir.el (nnir-compose-result):
* lisp/obsolete/terminal.el (te-quote-arg-for-sh):
* lisp/obsolete/tpu-edt.el (tpu-check-search-case):
* lisp/obsolete/url-ns.el (isPlainHostName):
* lisp/pcmpl-unix.el (pcomplete/scp):
* lisp/play/dunnet.el (dun-listify-string2, dun-get-path)
(dun-unix-parse, dun-doassign, dun-cat, dun-batch-unix-interface):
* lisp/progmodes/ebnf2ps.el: (ebnf-eps-header-footer-comment):
* lisp/progmodes/gdb-mi.el (gdb-var-delete)
(gdb-speedbar-expand-node, gdbmi-bnf-incomplete-record-result):
* lisp/progmodes/gud.el (gud-find-expr):
* lisp/progmodes/idlw-help.el (idlwave-do-context-help1):
* lisp/progmodes/idlw-shell.el (idlwave-shell-mode)
(idlwave-shell-filter-hidden-output, idlwave-shell-filter):
* lisp/progmodes/idlwave.el (idlwave-skip-label-or-case)
(idlwave-routine-info):
* lisp/progmodes/octave.el (inferior-octave-completion-at-point):
* lisp/progmodes/sh-script.el (sh-add-completer):
* lisp/progmodes/sql.el (defun):
* lisp/progmodes/xscheme.el (xscheme-process-filter):
* lisp/replace.el (query-replace-compile-replacement)
(map-query-replace-regexp):
* lisp/shell.el (shell--command-completion-data)
(shell-environment-variable-completion):
* lisp/simple.el (display-message-or-buffer):
* lisp/speedbar.el (speedbar-dired, speedbar-tag-file)
(speedbar-tag-expand):
* lisp/subr.el (split-string-and-unquote):
* lisp/tar-mode.el (tar-extract):
* lisp/term.el (term-command-hook, serial-read-name):
* lisp/textmodes/bibtex.el (bibtex-print-help-message):
* lisp/textmodes/ispell.el (ispell-lookup-words, ispell-filter)
(ispell-parse-output, ispell-buffer-local-parsing):
* lisp/textmodes/reftex-cite.el (reftex-do-citation):
* lisp/textmodes/reftex-parse.el (reftex-notice-new):
* lisp/textmodes/reftex-ref.el (reftex-show-entry):
* lisp/textmodes/reftex.el (reftex-compile-variables):
* lisp/textmodes/tex-mode.el (tex-send-command)
(tex-start-tex, tex-append):
* lisp/thingatpt.el (thing-at-point-url-at-point):
* lisp/tmm.el (tmm-add-one-shortcut):
* lisp/transient.el (transient-format-key):
* lisp/url/url-auth.el (url-basic-auth)
(url-digest-auth-directory-id-assoc):
* lisp/url/url-news.el (url-news):
* lisp/url/url-util.el (url-parse-query-string):
* lisp/vc/vc-cvs.el (vc-cvs-parse-entry):
* lisp/wid-browse.el (widget-browse-sexp):
* lisp/woman.el (woman-parse-colon-path, woman-mini-help)
(WoMan-getpage-in-background, woman-negative-vertical-space):
* lisp/xml.el:
* test/lisp/emacs-lisp/check-declare-tests.el
(check-declare-tests-warn):
* test/lisp/files-tests.el
(files-tests-file-name-non-special-dired-compress-handler):
* test/lisp/net/network-stream-tests.el (server-process-filter):
* test/src/coding-tests.el (ert-test-unibyte-buffer-dos-eol-decode):
Use `string-search` instead of `string-match` and `string-match-p`.
2021-08-09 09:20:00 +00:00
|
|
|
|
(i (string-search "\"" string)))
|
2007-08-12 17:59:40 +00:00
|
|
|
|
(if (null i)
|
|
|
|
|
(split-string string sep t) ; no quoting: easy
|
2007-06-28 01:35:10 +00:00
|
|
|
|
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
|
|
|
|
|
(let ((rfs (read-from-string string i)))
|
|
|
|
|
(cons (car rfs)
|
2007-08-12 17:59:40 +00:00
|
|
|
|
(split-string-and-unquote (substring string (cdr rfs))
|
|
|
|
|
sep)))))))
|
2007-06-28 01:35:10 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Replacement in strings.
|
1999-01-17 18:55:53 +00:00
|
|
|
|
|
|
|
|
|
(defun subst-char-in-string (fromchar tochar string &optional inplace)
|
|
|
|
|
"Replace FROMCHAR with TOCHAR in STRING each time it occurs.
|
|
|
|
|
Unless optional argument INPLACE is non-nil, return a new string."
|
2024-05-13 08:44:05 +00:00
|
|
|
|
(if (and (not inplace)
|
|
|
|
|
(if (multibyte-string-p string)
|
|
|
|
|
(> (max fromchar tochar) 127)
|
|
|
|
|
(> tochar 255)))
|
|
|
|
|
;; Avoid quadratic behaviour from resizing replacement.
|
|
|
|
|
(let ((res (string-replace (string fromchar) (string tochar) string)))
|
|
|
|
|
(unless (eq res string)
|
|
|
|
|
;; Mend properties broken by the replacement.
|
|
|
|
|
;; Not fast, but this case never was.
|
|
|
|
|
(dolist (p (object-intervals string))
|
|
|
|
|
(set-text-properties (nth 0 p) (nth 1 p) (nth 2 p) res)))
|
|
|
|
|
res)
|
|
|
|
|
(let ((i (length string))
|
|
|
|
|
(newstr (if inplace string (copy-sequence string))))
|
|
|
|
|
(while (> i 0)
|
|
|
|
|
(setq i (1- i))
|
|
|
|
|
(if (eq (aref newstr i) fromchar)
|
|
|
|
|
(aset newstr i tochar)))
|
|
|
|
|
newstr)))
|
2000-02-22 20:16:31 +00:00
|
|
|
|
|
2021-09-18 18:42:17 +00:00
|
|
|
|
(defun string-replace (from-string to-string in-string)
|
|
|
|
|
"Replace FROM-STRING with TO-STRING in IN-STRING each time it occurs."
|
2020-11-01 14:57:12 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2021-09-18 18:42:17 +00:00
|
|
|
|
(when (equal from-string "")
|
2021-03-07 14:55:15 +00:00
|
|
|
|
(signal 'wrong-length-argument '(0)))
|
2020-09-24 23:53:07 +00:00
|
|
|
|
(let ((start 0)
|
|
|
|
|
(result nil)
|
|
|
|
|
pos)
|
2021-09-18 18:42:17 +00:00
|
|
|
|
(while (setq pos (string-search from-string in-string start))
|
2020-09-24 23:53:07 +00:00
|
|
|
|
(unless (= start pos)
|
2021-09-18 18:42:17 +00:00
|
|
|
|
(push (substring in-string start pos) result))
|
|
|
|
|
(push to-string result)
|
|
|
|
|
(setq start (+ pos (length from-string))))
|
2020-09-26 22:17:58 +00:00
|
|
|
|
(if (null result)
|
|
|
|
|
;; No replacements were done, so just return the original string.
|
2021-09-18 18:42:17 +00:00
|
|
|
|
in-string
|
2020-09-26 22:17:58 +00:00
|
|
|
|
;; Get any remaining bit.
|
2021-09-18 18:42:17 +00:00
|
|
|
|
(unless (= start (length in-string))
|
|
|
|
|
(push (substring in-string start) result))
|
2020-09-26 22:17:58 +00:00
|
|
|
|
(apply #'concat (nreverse result)))))
|
2020-09-15 14:50:44 +00:00
|
|
|
|
|
2000-03-14 22:57:28 +00:00
|
|
|
|
(defun replace-regexp-in-string (regexp rep string &optional
|
2007-04-09 23:10:00 +00:00
|
|
|
|
fixedcase literal subexp start)
|
2000-02-22 20:16:31 +00:00
|
|
|
|
"Replace all matches for REGEXP with REP in STRING.
|
|
|
|
|
|
|
|
|
|
Return a new string containing the replacements.
|
|
|
|
|
|
|
|
|
|
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
|
|
|
|
|
arguments with the same names of function `replace-match'. If START
|
2019-06-26 09:23:32 +00:00
|
|
|
|
is non-nil, start replacements at that index in STRING, and omit
|
|
|
|
|
the first START characters of STRING from the return value.
|
2000-02-22 20:16:31 +00:00
|
|
|
|
|
|
|
|
|
REP is either a string used as the NEWTEXT arg of `replace-match' or a
|
2005-08-20 21:48:51 +00:00
|
|
|
|
function. If it is a function, it is called with the actual text of each
|
|
|
|
|
match, and its value is used as the replacement text. When REP is called,
|
2011-01-11 03:23:04 +00:00
|
|
|
|
the match data are the result of matching REGEXP against a substring
|
2015-04-25 09:38:07 +00:00
|
|
|
|
of STRING, the same substring that is the actual text of the match which
|
|
|
|
|
is passed to REP as its argument.
|
2000-02-22 20:16:31 +00:00
|
|
|
|
|
2016-06-06 16:29:17 +00:00
|
|
|
|
To replace only the first match (if any), make REGEXP match up to \\\\='
|
2000-03-14 22:57:28 +00:00
|
|
|
|
and replace a sub-expression, e.g.
|
2016-06-06 16:29:17 +00:00
|
|
|
|
(replace-regexp-in-string \"\\\\(foo\\\\).*\\\\\\='\" \"bar\" \" foo foo\" nil nil 1)
|
2012-04-11 18:13:20 +00:00
|
|
|
|
=> \" bar foo\""
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2000-02-22 20:16:31 +00:00
|
|
|
|
|
|
|
|
|
;; To avoid excessive consing from multiple matches in long strings,
|
|
|
|
|
;; don't just call `replace-match' continually. Walk down the
|
|
|
|
|
;; string looking for matches of REGEXP and building up a (reversed)
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; list MATCHES. This comprises segments of STRING that weren't
|
2000-02-22 20:16:31 +00:00
|
|
|
|
;; matched interspersed with replacements for segments that were.
|
2001-10-05 09:26:17 +00:00
|
|
|
|
;; [For a `large' number of replacements it's more efficient to
|
2000-02-22 20:16:31 +00:00
|
|
|
|
;; operate in a temporary buffer; we can't tell from the function's
|
|
|
|
|
;; args whether to choose the buffer-based implementation, though it
|
|
|
|
|
;; might be reasonable to do so for long enough STRING.]
|
|
|
|
|
(let ((l (length string))
|
|
|
|
|
(start (or start 0))
|
|
|
|
|
matches str mb me)
|
|
|
|
|
(save-match-data
|
|
|
|
|
(while (and (< start l) (string-match regexp string start))
|
|
|
|
|
(setq mb (match-beginning 0)
|
|
|
|
|
me (match-end 0))
|
2000-03-08 23:49:09 +00:00
|
|
|
|
;; If we matched the empty string, make sure we advance by one char
|
|
|
|
|
(when (= me mb) (setq me (min l (1+ mb))))
|
|
|
|
|
;; Generate a replacement for the matched substring.
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; Operate on only the substring to minimize string consing.
|
2020-11-25 14:32:08 +00:00
|
|
|
|
;; Translate the match data so that it applies to the matched substring.
|
|
|
|
|
(match-data--translate (- mb))
|
|
|
|
|
(setq str (substring string mb me))
|
2000-03-08 23:49:09 +00:00
|
|
|
|
(setq matches
|
|
|
|
|
(cons (replace-match (if (stringp rep)
|
|
|
|
|
rep
|
|
|
|
|
(funcall rep (match-string 0 str)))
|
|
|
|
|
fixedcase literal str subexp)
|
2007-04-09 23:10:00 +00:00
|
|
|
|
(cons (substring string start mb) ; unmatched prefix
|
2000-03-08 23:49:09 +00:00
|
|
|
|
matches)))
|
|
|
|
|
(setq start me))
|
2000-02-22 20:16:31 +00:00
|
|
|
|
;; Reconstruct a string from the pieces.
|
|
|
|
|
(setq matches (cons (substring string start l) matches)) ; leftover
|
|
|
|
|
(apply #'concat (nreverse matches)))))
|
1996-09-28 04:16:00 +00:00
|
|
|
|
|
2022-07-28 16:35:21 +00:00
|
|
|
|
(defsubst string-equal-ignore-case (string1 string2)
|
2022-12-02 17:08:08 +00:00
|
|
|
|
"Compare STRING1 and STRING2 case-insensitively.
|
2022-07-26 17:47:03 +00:00
|
|
|
|
Upper-case and lower-case letters are treated as equal.
|
2022-12-03 10:29:37 +00:00
|
|
|
|
Unibyte strings are converted to multibyte for comparison.
|
|
|
|
|
|
|
|
|
|
See also `string-equal'."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2022-07-26 17:47:03 +00:00
|
|
|
|
(eq t (compare-strings string1 0 nil string2 0 nil t)))
|
|
|
|
|
|
2014-06-25 10:36:51 +00:00
|
|
|
|
(defun string-prefix-p (prefix string &optional ignore-case)
|
2023-09-14 13:08:54 +00:00
|
|
|
|
"Return non-nil if STRING begins with PREFIX.
|
|
|
|
|
PREFIX should be a string; the function returns non-nil if the
|
|
|
|
|
characters at the beginning of STRING compare equal with PREFIX.
|
2009-11-25 03:59:19 +00:00
|
|
|
|
If IGNORE-CASE is non-nil, the comparison is done without paying attention
|
2023-09-14 13:08:54 +00:00
|
|
|
|
to letter-case differences."
|
2023-03-17 11:13:27 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2014-06-25 10:36:51 +00:00
|
|
|
|
(let ((prefix-length (length prefix)))
|
|
|
|
|
(if (> prefix-length (length string)) nil
|
|
|
|
|
(eq t (compare-strings prefix 0 prefix-length string
|
|
|
|
|
0 prefix-length ignore-case)))))
|
2011-08-10 19:03:56 +00:00
|
|
|
|
|
2013-11-24 08:49:44 +00:00
|
|
|
|
(defun string-suffix-p (suffix string &optional ignore-case)
|
2023-09-14 13:08:54 +00:00
|
|
|
|
"Return non-nil if STRING ends with SUFFIX.
|
|
|
|
|
SUFFIX should be a string; the function returns non-nil if the
|
|
|
|
|
characters at end of STRING compare equal with SUFFIX.
|
2013-11-24 08:49:44 +00:00
|
|
|
|
If IGNORE-CASE is non-nil, the comparison is done without paying
|
2023-09-14 13:08:54 +00:00
|
|
|
|
attention to letter-case differences."
|
2023-03-17 11:13:27 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2013-11-24 08:49:44 +00:00
|
|
|
|
(let ((start-pos (- (length string) (length suffix))))
|
|
|
|
|
(and (>= start-pos 0)
|
|
|
|
|
(eq t (compare-strings suffix nil nil
|
|
|
|
|
string start-pos nil ignore-case)))))
|
|
|
|
|
|
2011-08-18 15:53:29 +00:00
|
|
|
|
(defun bidi-string-mark-left-to-right (str)
|
2011-08-12 15:43:30 +00:00
|
|
|
|
"Return a string that can be safely inserted in left-to-right text.
|
|
|
|
|
|
2011-08-18 15:53:29 +00:00
|
|
|
|
Normally, inserting a string with right-to-left (RTL) script into
|
|
|
|
|
a buffer may cause some subsequent text to be displayed as part
|
|
|
|
|
of the RTL segment (usually this affects punctuation characters).
|
2019-11-04 02:36:05 +00:00
|
|
|
|
This function returns a string that displays as STR but forces
|
2011-08-18 15:53:29 +00:00
|
|
|
|
subsequent text to be displayed as left-to-right.
|
2011-08-12 15:43:30 +00:00
|
|
|
|
|
2011-08-18 15:53:29 +00:00
|
|
|
|
If STR contains any RTL character, this function returns a string
|
|
|
|
|
consisting of STR followed by an invisible left-to-right mark
|
|
|
|
|
\(LRM) character. Otherwise, it returns STR."
|
2011-08-10 19:03:56 +00:00
|
|
|
|
(unless (stringp str)
|
|
|
|
|
(signal 'wrong-type-argument (list 'stringp str)))
|
2011-08-18 15:53:29 +00:00
|
|
|
|
(if (string-match "\\cR" str)
|
|
|
|
|
(concat str (propertize (string ?\x200e) 'invisible t))
|
|
|
|
|
str))
|
2015-06-04 16:20:18 +00:00
|
|
|
|
|
|
|
|
|
(defun string-greaterp (string1 string2)
|
|
|
|
|
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
|
|
|
|
|
Case is significant.
|
|
|
|
|
Symbols are also allowed; their print names are used instead."
|
Move side-effect-free and pure declarations to function definitions
Some Lisp functions still had their `side-effect-free` and `pure`
properties declared in byte-opt.el; do it at their definition instead.
The lists in byte-opt.el now only contain functions implemented in C
and function aliases.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns)
(side-effect-and-error-free-fns, pure-fns):
Remove functions whose properties are now declared elsewhere
and some obsolete entries.
* lisp/custom.el (custom-variable-p):
* lisp/emacs-lisp/lisp.el (buffer-end):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt):
* lisp/env.el (getenv):
* lisp/simple.el (count-lines, mark, string-empty-p, lax-plist-get):
* lisp/subr.el (ignore, always, zerop, fixnump, bignump, lsh, last)
(eventp, mouse-movement-p, log10, memory-limit, string-greaterp)
(interactive-p):
* lisp/window.el (get-lru-window, get-largest-window, (window-edges)
(window-body-edges, window-pixel-edges, window-body-pixel-edges)
(window-absolute-pixel-edges, window-absolute-body-pixel-edges)
(one-window-p):
Declare functions `side-effect-free` and/or `pure` as appropriate.
2023-02-17 13:38:50 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2015-06-04 16:20:18 +00:00
|
|
|
|
(string-lessp string2 string1))
|
|
|
|
|
|
2013-06-05 14:57:45 +00:00
|
|
|
|
|
|
|
|
|
;;;; Specifying things to do later.
|
|
|
|
|
|
|
|
|
|
(defun load-history-regexp (file)
|
|
|
|
|
"Form a regexp to find FILE in `load-history'.
|
|
|
|
|
FILE, a string, is described in the function `eval-after-load'."
|
|
|
|
|
(if (file-name-absolute-p file)
|
|
|
|
|
(setq file (file-truename file)))
|
|
|
|
|
(concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
|
|
|
|
|
(regexp-quote file)
|
|
|
|
|
(if (file-name-extension file)
|
|
|
|
|
""
|
|
|
|
|
;; Note: regexp-opt can't be used here, since we need to call
|
|
|
|
|
;; this before Emacs has been fully started. 2006-05-21
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(concat "\\(" (mapconcat #'regexp-quote load-suffixes "\\|") "\\)?"))
|
|
|
|
|
"\\(" (mapconcat #'regexp-quote jka-compr-load-suffixes "\\|")
|
2013-06-05 14:57:45 +00:00
|
|
|
|
"\\)?\\'"))
|
|
|
|
|
|
|
|
|
|
(defun load-history-filename-element (file-regexp)
|
|
|
|
|
"Get the first elt of `load-history' whose car matches FILE-REGEXP.
|
|
|
|
|
Return nil if there isn't one."
|
|
|
|
|
(let* ((loads load-history)
|
|
|
|
|
(load-elt (and loads (car loads))))
|
|
|
|
|
(save-match-data
|
|
|
|
|
(while (and loads
|
2023-09-12 16:55:54 +00:00
|
|
|
|
(not (and (car load-elt)
|
|
|
|
|
(string-match file-regexp (car load-elt)))))
|
2013-06-05 14:57:45 +00:00
|
|
|
|
(setq loads (cdr loads)
|
|
|
|
|
load-elt (and loads (car loads)))))
|
|
|
|
|
load-elt))
|
|
|
|
|
|
|
|
|
|
(defun eval-after-load (file form)
|
|
|
|
|
"Arrange that if FILE is loaded, FORM will be run immediately afterwards.
|
|
|
|
|
If FILE is already loaded, evaluate FORM right now.
|
2013-06-13 22:24:52 +00:00
|
|
|
|
FORM can be an Elisp expression (in which case it's passed to `eval'),
|
|
|
|
|
or a function (in which case it's passed to `funcall' with no argument).
|
2013-06-05 14:57:45 +00:00
|
|
|
|
|
|
|
|
|
If a matching file is loaded again, FORM will be evaluated again.
|
|
|
|
|
|
|
|
|
|
If FILE is a string, it may be either an absolute or a relative file
|
2013-06-11 16:51:12 +00:00
|
|
|
|
name, and may have an extension (e.g. \".el\") or may lack one, and
|
2013-06-05 14:57:45 +00:00
|
|
|
|
additionally may or may not have an extension denoting a compressed
|
2013-06-11 16:51:12 +00:00
|
|
|
|
format (e.g. \".gz\").
|
2013-06-05 14:57:45 +00:00
|
|
|
|
|
|
|
|
|
When FILE is absolute, this first converts it to a true name by chasing
|
2013-06-11 16:51:12 +00:00
|
|
|
|
symbolic links. Only a file of this name (see next paragraph regarding
|
2013-06-05 14:57:45 +00:00
|
|
|
|
extensions) will trigger the evaluation of FORM. When FILE is relative,
|
|
|
|
|
a file whose absolute true name ends in FILE will trigger evaluation.
|
|
|
|
|
|
|
|
|
|
When FILE lacks an extension, a file name with any extension will trigger
|
|
|
|
|
evaluation. Otherwise, its extension must match FILE's. A further
|
2013-06-11 16:51:12 +00:00
|
|
|
|
extension for a compressed format (e.g. \".gz\") on FILE will not affect
|
2013-06-05 14:57:45 +00:00
|
|
|
|
this name matching.
|
|
|
|
|
|
|
|
|
|
Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
|
|
|
|
|
is evaluated at the end of any file that `provide's this feature.
|
|
|
|
|
If the feature is provided when evaluating code not associated with a
|
|
|
|
|
file, FORM is evaluated immediately after the provide statement.
|
|
|
|
|
|
|
|
|
|
Usually FILE is just a library name like \"font-lock\" or a feature name
|
2015-11-17 23:28:50 +00:00
|
|
|
|
like `font-lock'.
|
2013-06-05 14:57:45 +00:00
|
|
|
|
|
2021-01-28 17:16:49 +00:00
|
|
|
|
This function makes or adds to an entry on `after-load-alist'.
|
|
|
|
|
|
|
|
|
|
See also `with-eval-after-load'."
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(declare (indent 1)
|
|
|
|
|
(compiler-macro
|
2013-06-13 22:24:52 +00:00
|
|
|
|
(lambda (whole)
|
|
|
|
|
(if (eq 'quote (car-safe form))
|
|
|
|
|
;; Quote with lambda so the compiler can look inside.
|
|
|
|
|
`(eval-after-load ,file (lambda () ,(nth 1 form)))
|
|
|
|
|
whole))))
|
2013-06-05 14:57:45 +00:00
|
|
|
|
;; Add this FORM into after-load-alist (regardless of whether we'll be
|
|
|
|
|
;; evaluating it now).
|
|
|
|
|
(let* ((regexp-or-feature
|
|
|
|
|
(if (stringp file)
|
|
|
|
|
(setq file (purecopy (load-history-regexp file)))
|
|
|
|
|
file))
|
2013-06-13 22:24:52 +00:00
|
|
|
|
(elt (assoc regexp-or-feature after-load-alist))
|
|
|
|
|
(func
|
|
|
|
|
(if (functionp form) form
|
|
|
|
|
;; Try to use the "current" lexical/dynamic mode for `form'.
|
|
|
|
|
(eval `(lambda () ,form) lexical-binding))))
|
2013-06-05 14:57:45 +00:00
|
|
|
|
(unless elt
|
|
|
|
|
(setq elt (list regexp-or-feature))
|
|
|
|
|
(push elt after-load-alist))
|
|
|
|
|
;; Is there an already loaded file whose name (or `provide' name)
|
|
|
|
|
;; matches FILE?
|
|
|
|
|
(prog1 (if (if (stringp file)
|
|
|
|
|
(load-history-filename-element regexp-or-feature)
|
|
|
|
|
(featurep file))
|
2013-06-13 22:24:52 +00:00
|
|
|
|
(funcall func))
|
|
|
|
|
(let ((delayed-func
|
|
|
|
|
(if (not (symbolp regexp-or-feature)) func
|
|
|
|
|
;; For features, the after-load-alist elements get run when
|
|
|
|
|
;; `provide' is called rather than at the end of the file.
|
|
|
|
|
;; So add an indirection to make sure that `func' is really run
|
|
|
|
|
;; "after-load" in case the provide call happens early.
|
|
|
|
|
(lambda ()
|
|
|
|
|
(if (not load-file-name)
|
|
|
|
|
;; Not being provided from a file, run func right now.
|
|
|
|
|
(funcall func)
|
2013-06-14 04:11:00 +00:00
|
|
|
|
(let ((lfn load-file-name)
|
|
|
|
|
;; Don't use letrec, because equal (in
|
2021-04-23 22:51:40 +00:00
|
|
|
|
;; add/remove-hook) could get trapped in a cycle
|
2021-04-23 21:17:40 +00:00
|
|
|
|
;; (bug#46326).
|
2013-06-14 04:11:00 +00:00
|
|
|
|
(fun (make-symbol "eval-after-load-helper")))
|
|
|
|
|
(fset fun (lambda (file)
|
|
|
|
|
(when (equal file lfn)
|
|
|
|
|
(remove-hook 'after-load-functions fun)
|
|
|
|
|
(funcall func))))
|
2013-09-17 07:26:07 +00:00
|
|
|
|
(add-hook 'after-load-functions fun 'append)))))))
|
2013-06-13 22:24:52 +00:00
|
|
|
|
;; Add FORM to the element unless it's already there.
|
|
|
|
|
(unless (member delayed-func (cdr elt))
|
|
|
|
|
(nconc elt (list delayed-func)))))))
|
|
|
|
|
|
|
|
|
|
(defmacro with-eval-after-load (file &rest body)
|
|
|
|
|
"Execute BODY after FILE is loaded.
|
|
|
|
|
FILE is normally a feature name, but it can also be a file name,
|
2016-04-10 16:15:13 +00:00
|
|
|
|
in case that file does not provide any feature. See `eval-after-load'
|
|
|
|
|
for more details about the different forms of FILE and their semantics."
|
2021-05-17 08:00:36 +00:00
|
|
|
|
(declare (indent 1) (debug (form def-body)))
|
2013-06-13 22:24:52 +00:00
|
|
|
|
`(eval-after-load ,file (lambda () ,@body)))
|
2013-06-05 14:57:45 +00:00
|
|
|
|
|
|
|
|
|
(defvar after-load-functions nil
|
|
|
|
|
"Special hook run after loading a file.
|
|
|
|
|
Each function there is called with a single argument, the absolute
|
|
|
|
|
name of the file just loaded.")
|
|
|
|
|
|
|
|
|
|
(defun do-after-load-evaluation (abs-file)
|
|
|
|
|
"Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
|
|
|
|
|
ABS-FILE, a string, should be the absolute true name of a file just loaded.
|
|
|
|
|
This function is called directly from the C code."
|
|
|
|
|
;; Run the relevant eval-after-load forms.
|
2013-06-13 22:24:52 +00:00
|
|
|
|
(dolist (a-l-element after-load-alist)
|
|
|
|
|
(when (and (stringp (car a-l-element))
|
|
|
|
|
(string-match-p (car a-l-element) abs-file))
|
|
|
|
|
;; discard the file name regexp
|
|
|
|
|
(mapc #'funcall (cdr a-l-element))))
|
2013-06-05 14:57:45 +00:00
|
|
|
|
;; Complain when the user uses obsolete files.
|
2019-11-26 18:58:39 +00:00
|
|
|
|
(when (string-match-p "/obsolete/[^/]*\\'" abs-file)
|
2013-09-12 06:37:02 +00:00
|
|
|
|
;; Maybe we should just use display-warning? This seems yucky...
|
|
|
|
|
(let* ((file (file-name-nondirectory abs-file))
|
2019-06-17 10:36:01 +00:00
|
|
|
|
(package (intern (substring file 0
|
|
|
|
|
(string-match "\\.elc?\\>" file))
|
|
|
|
|
obarray))
|
2019-11-26 18:58:39 +00:00
|
|
|
|
(msg (format "Package %s is deprecated" package))
|
2019-12-15 23:58:14 +00:00
|
|
|
|
(fun (lambda (msg) (message "%s" msg))))
|
2019-06-17 10:36:01 +00:00
|
|
|
|
(when (or (not (fboundp 'byte-compile-warning-enabled-p))
|
|
|
|
|
(byte-compile-warning-enabled-p 'obsolete package))
|
2019-11-26 18:58:39 +00:00
|
|
|
|
(cond
|
2021-02-24 18:52:45 +00:00
|
|
|
|
((bound-and-true-p byte-compile-current-file)
|
2019-11-26 18:58:39 +00:00
|
|
|
|
;; Don't warn about obsolete files using other obsolete files.
|
|
|
|
|
(unless (and (stringp byte-compile-current-file)
|
|
|
|
|
(string-match-p "/obsolete/[^/]*\\'"
|
|
|
|
|
(expand-file-name
|
|
|
|
|
byte-compile-current-file
|
|
|
|
|
byte-compile-root-dir)))
|
|
|
|
|
(byte-compile-warn "%s" msg)))
|
2019-11-28 03:37:11 +00:00
|
|
|
|
(noninteractive (funcall fun msg)) ;; No timer will be run!
|
2019-11-26 18:58:39 +00:00
|
|
|
|
(t (run-with-idle-timer 0 nil fun msg))))))
|
2013-09-12 06:37:02 +00:00
|
|
|
|
|
2013-06-05 14:57:45 +00:00
|
|
|
|
;; Finally, run any other hook.
|
|
|
|
|
(run-hook-with-args 'after-load-functions abs-file))
|
|
|
|
|
|
2013-07-11 01:49:17 +00:00
|
|
|
|
|
2013-06-05 14:57:45 +00:00
|
|
|
|
(defun display-delayed-warnings ()
|
|
|
|
|
"Display delayed warnings from `delayed-warnings-list'.
|
|
|
|
|
Used from `delayed-warnings-hook' (which see)."
|
|
|
|
|
(dolist (warning (nreverse delayed-warnings-list))
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(apply #'display-warning warning))
|
2013-06-05 14:57:45 +00:00
|
|
|
|
(setq delayed-warnings-list nil))
|
|
|
|
|
|
|
|
|
|
(defun collapse-delayed-warnings ()
|
|
|
|
|
"Remove duplicates from `delayed-warnings-list'.
|
|
|
|
|
Collapse identical adjacent warnings into one (plus count).
|
|
|
|
|
Used from `delayed-warnings-hook' (which see)."
|
|
|
|
|
(let ((count 1)
|
|
|
|
|
collapsed warning)
|
|
|
|
|
(while delayed-warnings-list
|
|
|
|
|
(setq warning (pop delayed-warnings-list))
|
|
|
|
|
(if (equal warning (car delayed-warnings-list))
|
|
|
|
|
(setq count (1+ count))
|
|
|
|
|
(when (> count 1)
|
|
|
|
|
(setcdr warning (cons (format "%s [%d times]" (cadr warning) count)
|
|
|
|
|
(cddr warning)))
|
|
|
|
|
(setq count 1))
|
|
|
|
|
(push warning collapsed)))
|
|
|
|
|
(setq delayed-warnings-list (nreverse collapsed))))
|
|
|
|
|
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; At present this is used only for Emacs internals.
|
2017-11-26 06:45:41 +00:00
|
|
|
|
;; Ref https://lists.gnu.org/r/emacs-devel/2012-02/msg00085.html
|
2013-06-05 14:57:45 +00:00
|
|
|
|
(defvar delayed-warnings-hook '(collapse-delayed-warnings
|
|
|
|
|
display-delayed-warnings)
|
|
|
|
|
"Normal hook run to process and display delayed warnings.
|
|
|
|
|
By default, this hook contains functions to consolidate the
|
|
|
|
|
warnings listed in `delayed-warnings-list', display them, and set
|
|
|
|
|
`delayed-warnings-list' back to nil.")
|
|
|
|
|
|
2013-07-11 01:49:17 +00:00
|
|
|
|
(defun delay-warning (type message &optional level buffer-name)
|
|
|
|
|
"Display a delayed warning.
|
|
|
|
|
Aside from going through `delayed-warnings-list', this is equivalent
|
|
|
|
|
to `display-warning'."
|
|
|
|
|
(push (list type message level buffer-name) delayed-warnings-list))
|
|
|
|
|
|
2009-11-25 03:59:19 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; invisibility specs
|
2004-12-06 15:11:51 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(defun add-to-invisibility-spec (element)
|
|
|
|
|
"Add ELEMENT to `buffer-invisibility-spec'.
|
|
|
|
|
See documentation for `buffer-invisibility-spec' for the kind of elements
|
2018-04-24 15:20:15 +00:00
|
|
|
|
that can be added.
|
|
|
|
|
|
|
|
|
|
If `buffer-invisibility-spec' isn't a list before calling this
|
|
|
|
|
function, `buffer-invisibility-spec' will afterwards be a list
|
|
|
|
|
with the value `(t ELEMENT)'. This means that if text exists
|
2021-09-14 06:43:18 +00:00
|
|
|
|
that invisibility values that aren't either t or ELEMENT, that
|
2018-04-24 15:23:53 +00:00
|
|
|
|
text will become visible."
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(if (eq buffer-invisibility-spec t)
|
|
|
|
|
(setq buffer-invisibility-spec (list t)))
|
|
|
|
|
(setq buffer-invisibility-spec
|
|
|
|
|
(cons element buffer-invisibility-spec)))
|
|
|
|
|
|
|
|
|
|
(defun remove-from-invisibility-spec (element)
|
2018-04-24 15:20:15 +00:00
|
|
|
|
"Remove ELEMENT from `buffer-invisibility-spec'.
|
|
|
|
|
If `buffer-invisibility-spec' isn't a list before calling this
|
2021-09-14 06:43:18 +00:00
|
|
|
|
function, it will be made into a list containing just t as the
|
|
|
|
|
only list member. This means that if text exists with non-t
|
2018-04-24 15:20:15 +00:00
|
|
|
|
invisibility values, that text will become visible."
|
2015-06-24 20:39:52 +00:00
|
|
|
|
(setq buffer-invisibility-spec
|
|
|
|
|
(if (consp buffer-invisibility-spec)
|
|
|
|
|
(delete element buffer-invisibility-spec)
|
|
|
|
|
(list t))))
|
1996-09-28 04:16:00 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Syntax tables.
|
|
|
|
|
|
|
|
|
|
(defmacro with-syntax-table (table &rest body)
|
|
|
|
|
"Evaluate BODY with syntax table of current buffer set to TABLE.
|
|
|
|
|
The syntax table of the current buffer is saved, BODY is evaluated, and the
|
|
|
|
|
saved table is restored, even in case of an abnormal exit.
|
|
|
|
|
Value is what BODY returns."
|
Use `declare' in defmacros.
* lisp/window.el (save-selected-window):
* lisp/subr.el (with-temp-file, with-temp-message, with-syntax-table):
* lisp/progmodes/python.el (def-python-skeleton):
* lisp/net/dbus.el (dbus-ignore-errors):
* lisp/jka-cmpr-hook.el (with-auto-compression-mode):
* lisp/international/mule.el (with-category-table):
* lisp/emacs-lisp/timer.el (with-timeout):
* lisp/emacs-lisp/lisp-mnt.el (lm-with-file):
* lisp/emacs-lisp/eieio.el (with-slots):
* lisp/emacs-lisp/easymenu.el (easy-menu-define):
* lisp/emacs-lisp/debug.el (debugger-env-macro):
* lisp/emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq)
(Multiple-value-call, Multiple-value-prog1):
* lisp/emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key)
(cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and
edebug rule to definition.
* lisp/emacs-lisp/lisp-mode.el (save-selected-window)
(with-current-buffer, combine-after-change-calls)
(with-output-to-string, with-temp-file, with-temp-buffer)
(with-temp-message, with-syntax-table, read-if, eval-after-load)
(dolist, dotimes, when, unless):
* lisp/emacs-lisp/byte-run.el (inline): Remove indent rule, redundant.
2010-08-30 13:03:05 +00:00
|
|
|
|
(declare (debug t) (indent 1))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
(let ((old-table (make-symbol "table"))
|
|
|
|
|
(old-buffer (make-symbol "buffer")))
|
|
|
|
|
`(let ((,old-table (syntax-table))
|
|
|
|
|
(,old-buffer (current-buffer)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(set-syntax-table ,table)
|
|
|
|
|
,@body)
|
|
|
|
|
(save-current-buffer
|
|
|
|
|
(set-buffer ,old-buffer)
|
|
|
|
|
(set-syntax-table ,old-table))))))
|
1993-12-31 09:25:12 +00:00
|
|
|
|
|
1994-02-08 05:06:07 +00:00
|
|
|
|
(defun make-syntax-table (&optional oldtable)
|
1994-01-03 07:41:00 +00:00
|
|
|
|
"Return a new syntax table.
|
2019-11-04 02:36:05 +00:00
|
|
|
|
Create a syntax table that inherits from OLDTABLE (if non-nil) or
|
2001-11-08 00:57:57 +00:00
|
|
|
|
from `standard-syntax-table' otherwise."
|
|
|
|
|
(let ((table (make-char-table 'syntax-table nil)))
|
|
|
|
|
(set-char-table-parent table (or oldtable (standard-syntax-table)))
|
|
|
|
|
table))
|
1997-03-11 23:55:24 +00:00
|
|
|
|
|
2002-09-09 23:13:18 +00:00
|
|
|
|
(defun syntax-after (pos)
|
2012-09-08 14:23:01 +00:00
|
|
|
|
"Return the raw syntax descriptor for the char after POS.
|
2005-04-24 14:50:20 +00:00
|
|
|
|
If POS is outside the buffer's accessible portion, return nil."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2002-09-09 23:13:18 +00:00
|
|
|
|
(unless (or (< pos (point-min)) (>= pos (point-max)))
|
2004-11-22 06:00:51 +00:00
|
|
|
|
(let ((st (if parse-sexp-lookup-properties
|
|
|
|
|
(get-char-property pos 'syntax-table))))
|
|
|
|
|
(if (consp st) st
|
|
|
|
|
(aref (or st (syntax-table)) (char-after pos))))))
|
2002-09-09 23:13:18 +00:00
|
|
|
|
|
2005-04-19 18:11:26 +00:00
|
|
|
|
(defun syntax-class (syntax)
|
2012-09-08 14:23:01 +00:00
|
|
|
|
"Return the code for the syntax class described by SYNTAX.
|
|
|
|
|
|
|
|
|
|
SYNTAX should be a raw syntax descriptor; the return value is a
|
2019-11-04 02:36:05 +00:00
|
|
|
|
integer that encodes the corresponding syntax class. See Info
|
2012-09-08 14:23:01 +00:00
|
|
|
|
node `(elisp)Syntax Table Internals' for a list of codes.
|
|
|
|
|
|
2005-04-24 14:50:20 +00:00
|
|
|
|
If SYNTAX is nil, return nil."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2005-04-24 14:50:20 +00:00
|
|
|
|
(and syntax (logand (car syntax) 65535)))
|
2002-04-19 00:06:54 +00:00
|
|
|
|
|
2013-03-30 01:32:12 +00:00
|
|
|
|
;; Utility motion commands
|
|
|
|
|
|
Fix problems caused by new implementation of sub-word mode
* lisp/subr.el (forward-word-strictly, backward-word-strictly):
New functions.
(word-move-empty-char-table): New variable.
* etc/NEWS: Mention 'forward-word-strictly' and
'backward-word-strictly'.
* doc/lispref/positions.texi (Word Motion): Document
'find-word-boundary-function-table', 'forward-word-strictly', and
'backward-word-strictly'. (Bug#22560)
* src/syntax.c (syms_of_syntax)
<find-word-boundary-function-table>: Doc fix.
* lisp/wdired.el (wdired-xcase-word):
* lisp/textmodes/texnfo-upd.el (texinfo-copy-node-name)
(texinfo-copy-section-title, texinfo-start-menu-description)
(texinfo-copy-menu-title, texinfo-specific-section-type)
(texinfo-insert-node-lines, texinfo-copy-next-section-title):
* lisp/textmodes/texinfo.el (texinfo-clone-environment)
(texinfo-insert-@end):
* lisp/textmodes/texinfmt.el (texinfo-format-scan)
(texinfo-anchor, texinfo-multitable-widths)
(texinfo-multitable-item):
* lisp/textmodes/tex-mode.el (latex-env-before-change):
* lisp/textmodes/flyspell.el (texinfo-mode-flyspell-verify):
* lisp/skeleton.el (skeleton-insert):
* lisp/simple.el (count-words):
* lisp/progmodes/vhdl-mode.el (vhdl-beginning-of-libunit)
(vhdl-beginning-of-defun, vhdl-beginning-of-statement-1)
(vhdl-update-sensitivity-list, vhdl-template-block)
(vhdl-template-break, vhdl-template-case, vhdl-template-default)
(vhdl-template-default-indent, vhdl-template-for-loop)
(vhdl-template-if-then-use, vhdl-template-bare-loop)
(vhdl-template-nature, vhdl-template-procedural)
(vhdl-template-process, vhdl-template-selected-signal-asst)
(vhdl-template-type, vhdl-template-variable)
(vhdl-template-while-loop, vhdl-beginning-of-block)
(vhdl-hooked-abbrev, vhdl-port-copy, vhdl-hs-forward-sexp-func):
* lisp/progmodes/verilog-mode.el (verilog-backward-sexp)
(verilog-forward-sexp, verilog-beg-of-statement)
(verilog-set-auto-endcomments, verilog-backward-token)
(verilog-do-indent):
* lisp/progmodes/vera-mode.el (vera-guess-basic-syntax)
(vera-indent-block-closing):
* lisp/progmodes/simula.el (simula-context)
(simula-backward-up-level, simula-forward-down-level)
(simula-previous-statement, simula-next-statement)
(simula-skip-comment-backward, simula-calculate-indent)
(simula-find-if, simula-electric-keyword):
* lisp/progmodes/sh-script.el (sh-smie--rc-newline-semi-p):
* lisp/progmodes/ruby-mode.el (ruby-smie--redundant-do-p)
(ruby-smie--forward-token, ruby-smie--backward-token)
(ruby-singleton-class-p, ruby-calculate-indent)
(ruby-forward-sexp, ruby-backward-sexp):
* lisp/progmodes/ps-mode.el (ps-run-goto-error):
* lisp/progmodes/perl-mode.el (perl-syntax-propertize-function)
(perl-syntax-propertize-special-constructs)
(perl-backward-to-start-of-continued-exp):
* lisp/progmodes/pascal.el (pascal-indent-declaration):
* lisp/progmodes/octave.el (octave-function-file-p):
* lisp/progmodes/mantemp.el (mantemp-insert-cxx-syntax):
* lisp/progmodes/js.el (js--forward-function-decl):
* lisp/progmodes/idlwave.el (idlwave-show-begin-check)
(idlwave-beginning-of-block, idlwave-end-of-block)
(idlwave-block-jump-out, idlwave-determine-class):
* lisp/progmodes/icon.el (icon-is-continuation-line)
(icon-backward-to-start-of-continued-exp, end-of-icon-defun):
* lisp/progmodes/hideif.el (hide-ifdef-define):
* lisp/progmodes/f90.el (f90-change-keywords):
* lisp/progmodes/cperl-mode.el (cperl-electric-pod)
(cperl-linefeed, cperl-electric-terminator)
(cperl-find-pods-heres, cperl-fix-line-spacing)
(cperl-invert-if-unless):
* lisp/progmodes/cc-engine.el (c-forward-<>-arglist-recur):
* lisp/progmodes/cc-align.el (c-lineup-java-inher):
* lisp/progmodes/ada-mode.el (ada-compile-goto-error)
(ada-adjust-case-skeleton, ada-create-case-exception)
(ada-create-case-exception-substring)
(ada-case-read-exceptions-from-file, ada-after-keyword-p)
(ada-scan-paramlist, ada-get-current-indent, ada-get-indent-end)
(ada-get-indent-if, ada-get-indent-block-start)
(ada-get-indent-loop, ada-get-indent-type)
(ada-search-prev-end-stmt, ada-check-defun-name)
(ada-goto-decl-start, ada-goto-matching-start)
(ada-goto-matching-end, ada-looking-at-semi-or)
(ada-looking-at-semi-private, ada-in-paramlist-p)
(ada-search-ignore-complex-boolean, ada-move-to-start)
(ada-move-to-end, ada-which-function, ada-gen-treat-proc):
* lisp/net/quickurl.el (quickurl-grab-url):
* lisp/mail/sendmail.el (mail-do-fcc):
* lisp/mail/rmail.el (rmail-resend):
* lisp/mail/mailabbrev.el (mail-abbrev-complete-alias):
* lisp/mail/mail-extr.el (mail-extract-address-components):
* lisp/json.el (json-read-keyword):
* lisp/files.el (insert-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/completion.el (symbol-under-point, symbol-before-point)
(symbol-before-point-for-complete, next-cdabbrev)
(add-completions-from-c-buffer):
* lisp/cedet/semantic/texi.el (semantic-up-context)
(semantic-beginning-of-context):
* lisp/cedet/semantic/bovine/el.el (semantic-get-local-variables):
use 'forward-word-strictly' and 'backward-word-strictly' instead
of 'forward-word' and 'backward-word'.
[This reapplies commit c1d32a65372c72d7de4808d620eefd3214a8e92a,
which was inadvertently lost by merge commit
c71e7cc113ed0d5f01aaa2e441a3e3c9fbeb9fa5.]
2016-03-22 00:42:35 +00:00
|
|
|
|
(defvar word-move-empty-char-table nil
|
|
|
|
|
"Used in `forward-word-strictly' and `backward-word-strictly'
|
|
|
|
|
to countermand the effect of `find-word-boundary-function-table'.")
|
|
|
|
|
|
|
|
|
|
(defun forward-word-strictly (&optional arg)
|
|
|
|
|
"Move point forward ARG words (backward if ARG is negative).
|
|
|
|
|
If ARG is omitted or nil, move point forward one word.
|
|
|
|
|
Normally returns t.
|
|
|
|
|
If an edge of the buffer or a field boundary is reached, point is left there
|
|
|
|
|
and the function returns nil. Field boundaries are not noticed if
|
|
|
|
|
`inhibit-field-text-motion' is non-nil.
|
|
|
|
|
|
|
|
|
|
This function is like `forward-word', but it is not affected
|
|
|
|
|
by `find-word-boundary-function-table'. It is also not interactive."
|
|
|
|
|
(let ((find-word-boundary-function-table
|
|
|
|
|
(if (char-table-p word-move-empty-char-table)
|
|
|
|
|
word-move-empty-char-table
|
|
|
|
|
(setq word-move-empty-char-table (make-char-table nil)))))
|
|
|
|
|
(forward-word (or arg 1))))
|
|
|
|
|
|
|
|
|
|
(defun backward-word-strictly (&optional arg)
|
|
|
|
|
"Move backward until encountering the beginning of a word.
|
|
|
|
|
With argument ARG, do this that many times.
|
|
|
|
|
If ARG is omitted or nil, move point backward one word.
|
|
|
|
|
|
2023-09-05 19:05:58 +00:00
|
|
|
|
This function is like `backward-word', but it is not affected
|
Fix problems caused by new implementation of sub-word mode
* lisp/subr.el (forward-word-strictly, backward-word-strictly):
New functions.
(word-move-empty-char-table): New variable.
* etc/NEWS: Mention 'forward-word-strictly' and
'backward-word-strictly'.
* doc/lispref/positions.texi (Word Motion): Document
'find-word-boundary-function-table', 'forward-word-strictly', and
'backward-word-strictly'. (Bug#22560)
* src/syntax.c (syms_of_syntax)
<find-word-boundary-function-table>: Doc fix.
* lisp/wdired.el (wdired-xcase-word):
* lisp/textmodes/texnfo-upd.el (texinfo-copy-node-name)
(texinfo-copy-section-title, texinfo-start-menu-description)
(texinfo-copy-menu-title, texinfo-specific-section-type)
(texinfo-insert-node-lines, texinfo-copy-next-section-title):
* lisp/textmodes/texinfo.el (texinfo-clone-environment)
(texinfo-insert-@end):
* lisp/textmodes/texinfmt.el (texinfo-format-scan)
(texinfo-anchor, texinfo-multitable-widths)
(texinfo-multitable-item):
* lisp/textmodes/tex-mode.el (latex-env-before-change):
* lisp/textmodes/flyspell.el (texinfo-mode-flyspell-verify):
* lisp/skeleton.el (skeleton-insert):
* lisp/simple.el (count-words):
* lisp/progmodes/vhdl-mode.el (vhdl-beginning-of-libunit)
(vhdl-beginning-of-defun, vhdl-beginning-of-statement-1)
(vhdl-update-sensitivity-list, vhdl-template-block)
(vhdl-template-break, vhdl-template-case, vhdl-template-default)
(vhdl-template-default-indent, vhdl-template-for-loop)
(vhdl-template-if-then-use, vhdl-template-bare-loop)
(vhdl-template-nature, vhdl-template-procedural)
(vhdl-template-process, vhdl-template-selected-signal-asst)
(vhdl-template-type, vhdl-template-variable)
(vhdl-template-while-loop, vhdl-beginning-of-block)
(vhdl-hooked-abbrev, vhdl-port-copy, vhdl-hs-forward-sexp-func):
* lisp/progmodes/verilog-mode.el (verilog-backward-sexp)
(verilog-forward-sexp, verilog-beg-of-statement)
(verilog-set-auto-endcomments, verilog-backward-token)
(verilog-do-indent):
* lisp/progmodes/vera-mode.el (vera-guess-basic-syntax)
(vera-indent-block-closing):
* lisp/progmodes/simula.el (simula-context)
(simula-backward-up-level, simula-forward-down-level)
(simula-previous-statement, simula-next-statement)
(simula-skip-comment-backward, simula-calculate-indent)
(simula-find-if, simula-electric-keyword):
* lisp/progmodes/sh-script.el (sh-smie--rc-newline-semi-p):
* lisp/progmodes/ruby-mode.el (ruby-smie--redundant-do-p)
(ruby-smie--forward-token, ruby-smie--backward-token)
(ruby-singleton-class-p, ruby-calculate-indent)
(ruby-forward-sexp, ruby-backward-sexp):
* lisp/progmodes/ps-mode.el (ps-run-goto-error):
* lisp/progmodes/perl-mode.el (perl-syntax-propertize-function)
(perl-syntax-propertize-special-constructs)
(perl-backward-to-start-of-continued-exp):
* lisp/progmodes/pascal.el (pascal-indent-declaration):
* lisp/progmodes/octave.el (octave-function-file-p):
* lisp/progmodes/mantemp.el (mantemp-insert-cxx-syntax):
* lisp/progmodes/js.el (js--forward-function-decl):
* lisp/progmodes/idlwave.el (idlwave-show-begin-check)
(idlwave-beginning-of-block, idlwave-end-of-block)
(idlwave-block-jump-out, idlwave-determine-class):
* lisp/progmodes/icon.el (icon-is-continuation-line)
(icon-backward-to-start-of-continued-exp, end-of-icon-defun):
* lisp/progmodes/hideif.el (hide-ifdef-define):
* lisp/progmodes/f90.el (f90-change-keywords):
* lisp/progmodes/cperl-mode.el (cperl-electric-pod)
(cperl-linefeed, cperl-electric-terminator)
(cperl-find-pods-heres, cperl-fix-line-spacing)
(cperl-invert-if-unless):
* lisp/progmodes/cc-engine.el (c-forward-<>-arglist-recur):
* lisp/progmodes/cc-align.el (c-lineup-java-inher):
* lisp/progmodes/ada-mode.el (ada-compile-goto-error)
(ada-adjust-case-skeleton, ada-create-case-exception)
(ada-create-case-exception-substring)
(ada-case-read-exceptions-from-file, ada-after-keyword-p)
(ada-scan-paramlist, ada-get-current-indent, ada-get-indent-end)
(ada-get-indent-if, ada-get-indent-block-start)
(ada-get-indent-loop, ada-get-indent-type)
(ada-search-prev-end-stmt, ada-check-defun-name)
(ada-goto-decl-start, ada-goto-matching-start)
(ada-goto-matching-end, ada-looking-at-semi-or)
(ada-looking-at-semi-private, ada-in-paramlist-p)
(ada-search-ignore-complex-boolean, ada-move-to-start)
(ada-move-to-end, ada-which-function, ada-gen-treat-proc):
* lisp/net/quickurl.el (quickurl-grab-url):
* lisp/mail/sendmail.el (mail-do-fcc):
* lisp/mail/rmail.el (rmail-resend):
* lisp/mail/mailabbrev.el (mail-abbrev-complete-alias):
* lisp/mail/mail-extr.el (mail-extract-address-components):
* lisp/json.el (json-read-keyword):
* lisp/files.el (insert-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
* lisp/completion.el (symbol-under-point, symbol-before-point)
(symbol-before-point-for-complete, next-cdabbrev)
(add-completions-from-c-buffer):
* lisp/cedet/semantic/texi.el (semantic-up-context)
(semantic-beginning-of-context):
* lisp/cedet/semantic/bovine/el.el (semantic-get-local-variables):
use 'forward-word-strictly' and 'backward-word-strictly' instead
of 'forward-word' and 'backward-word'.
[This reapplies commit c1d32a65372c72d7de4808d620eefd3214a8e92a,
which was inadvertently lost by merge commit
c71e7cc113ed0d5f01aaa2e441a3e3c9fbeb9fa5.]
2016-03-22 00:42:35 +00:00
|
|
|
|
by `find-word-boundary-function-table'. It is also not interactive."
|
|
|
|
|
(let ((find-word-boundary-function-table
|
|
|
|
|
(if (char-table-p word-move-empty-char-table)
|
|
|
|
|
word-move-empty-char-table
|
|
|
|
|
(setq word-move-empty-char-table (make-char-table nil)))))
|
|
|
|
|
(forward-word (- (or arg 1)))))
|
|
|
|
|
|
2013-03-30 01:32:12 +00:00
|
|
|
|
;; Whitespace
|
|
|
|
|
|
|
|
|
|
(defun forward-whitespace (arg)
|
|
|
|
|
"Move point to the end of the next sequence of whitespace chars.
|
|
|
|
|
Each such sequence may be a single newline, or a sequence of
|
|
|
|
|
consecutive space and/or tab characters.
|
|
|
|
|
With prefix argument ARG, do it ARG times if positive, or move
|
|
|
|
|
backwards ARG times if negative."
|
|
|
|
|
(interactive "^p")
|
|
|
|
|
(if (natnump arg)
|
|
|
|
|
(re-search-forward "[ \t]+\\|\n" nil 'move arg)
|
|
|
|
|
(while (< arg 0)
|
|
|
|
|
(if (re-search-backward "[ \t]+\\|\n" nil 'move)
|
|
|
|
|
(or (eq (char-after (match-beginning 0)) ?\n)
|
|
|
|
|
(skip-chars-backward " \t")))
|
|
|
|
|
(setq arg (1+ arg)))))
|
|
|
|
|
|
|
|
|
|
;; Symbols
|
|
|
|
|
|
|
|
|
|
(defun forward-symbol (arg)
|
|
|
|
|
"Move point to the next position that is the end of a symbol.
|
|
|
|
|
A symbol is any sequence of characters that are in either the
|
|
|
|
|
word constituent or symbol constituent syntax class.
|
|
|
|
|
With prefix argument ARG, do it ARG times if positive, or move
|
|
|
|
|
backwards ARG times if negative."
|
|
|
|
|
(interactive "^p")
|
|
|
|
|
(if (natnump arg)
|
|
|
|
|
(re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
|
|
|
|
|
(while (< arg 0)
|
|
|
|
|
(if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move)
|
|
|
|
|
(skip-syntax-backward "w_"))
|
|
|
|
|
(setq arg (1+ arg)))))
|
|
|
|
|
|
|
|
|
|
;; Syntax blocks
|
|
|
|
|
|
|
|
|
|
(defun forward-same-syntax (&optional arg)
|
|
|
|
|
"Move point past all characters with the same syntax class.
|
|
|
|
|
With prefix argument ARG, do it ARG times if positive, or move
|
|
|
|
|
backwards ARG times if negative."
|
|
|
|
|
(interactive "^p")
|
|
|
|
|
(or arg (setq arg 1))
|
|
|
|
|
(while (< arg 0)
|
|
|
|
|
(skip-syntax-backward
|
|
|
|
|
(char-to-string (char-syntax (char-before))))
|
|
|
|
|
(setq arg (1+ arg)))
|
|
|
|
|
(while (> arg 0)
|
|
|
|
|
(skip-syntax-forward (char-to-string (char-syntax (char-after))))
|
|
|
|
|
(setq arg (1- arg))))
|
|
|
|
|
|
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Text clones
|
2001-10-25 02:26:41 +00:00
|
|
|
|
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(defvar text-clone--maintaining nil)
|
|
|
|
|
|
|
|
|
|
(defun text-clone--maintain (ol1 after beg end &optional _len)
|
2001-10-25 02:26:41 +00:00
|
|
|
|
"Propagate the changes made under the overlay OL1 to the other clones.
|
|
|
|
|
This is used on the `modification-hooks' property of text clones."
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(when (and after (not undo-in-progress)
|
|
|
|
|
(not text-clone--maintaining)
|
|
|
|
|
(overlay-start ol1))
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
|
|
|
|
|
(setq beg (max beg (+ (overlay-start ol1) margin)))
|
|
|
|
|
(setq end (min end (- (overlay-end ol1) margin)))
|
|
|
|
|
(when (<= beg end)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(when (overlay-get ol1 'text-clone-syntax)
|
|
|
|
|
;; Check content of the clone's text.
|
|
|
|
|
(let ((cbeg (+ (overlay-start ol1) margin))
|
|
|
|
|
(cend (- (overlay-end ol1) margin)))
|
|
|
|
|
(goto-char cbeg)
|
|
|
|
|
(save-match-data
|
|
|
|
|
(if (not (re-search-forward
|
|
|
|
|
(overlay-get ol1 'text-clone-syntax) cend t))
|
|
|
|
|
;; Mark the overlay for deletion.
|
2012-12-07 16:25:28 +00:00
|
|
|
|
(setq end cbeg)
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(when (< (match-end 0) cend)
|
|
|
|
|
;; Shrink the clone at its end.
|
|
|
|
|
(setq end (min end (match-end 0)))
|
|
|
|
|
(move-overlay ol1 (overlay-start ol1)
|
|
|
|
|
(+ (match-end 0) margin)))
|
|
|
|
|
(when (> (match-beginning 0) cbeg)
|
|
|
|
|
;; Shrink the clone at its beginning.
|
|
|
|
|
(setq beg (max (match-beginning 0) beg))
|
|
|
|
|
(move-overlay ol1 (- (match-beginning 0) margin)
|
|
|
|
|
(overlay-end ol1)))))))
|
|
|
|
|
;; Now go ahead and update the clones.
|
|
|
|
|
(let ((head (- beg (overlay-start ol1)))
|
|
|
|
|
(tail (- (overlay-end ol1) end))
|
|
|
|
|
(str (buffer-substring beg end))
|
|
|
|
|
(nothing-left t)
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(text-clone--maintaining t))
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(dolist (ol2 (overlay-get ol1 'text-clones))
|
|
|
|
|
(let ((oe (overlay-end ol2)))
|
|
|
|
|
(unless (or (eq ol1 ol2) (null oe))
|
|
|
|
|
(setq nothing-left nil)
|
|
|
|
|
(let ((mod-beg (+ (overlay-start ol2) head)))
|
|
|
|
|
;;(overlay-put ol2 'modification-hooks nil)
|
|
|
|
|
(goto-char (- (overlay-end ol2) tail))
|
|
|
|
|
(unless (> mod-beg (point))
|
|
|
|
|
(save-excursion (insert str))
|
|
|
|
|
(delete-region mod-beg (point)))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
;;(overlay-put ol2 'modification-hooks '(text-clone--maintain))
|
2001-10-25 02:26:41 +00:00
|
|
|
|
))))
|
|
|
|
|
(if nothing-left (delete-overlay ol1))))))))
|
|
|
|
|
|
|
|
|
|
(defun text-clone-create (start end &optional spreadp syntax)
|
|
|
|
|
"Create a text clone of START...END at point.
|
|
|
|
|
Text clones are chunks of text that are automatically kept identical:
|
|
|
|
|
changes done to one of the clones will be immediately propagated to the other.
|
|
|
|
|
|
|
|
|
|
The buffer's content at point is assumed to be already identical to
|
|
|
|
|
the one between START and END.
|
|
|
|
|
If SYNTAX is provided it's a regexp that describes the possible text of
|
|
|
|
|
the clones; the clone will be shrunk or killed if necessary to ensure that
|
|
|
|
|
its text matches the regexp.
|
|
|
|
|
If SPREADP is non-nil it indicates that text inserted before/after the
|
|
|
|
|
clone should be incorporated in the clone."
|
|
|
|
|
;; To deal with SPREADP we can either use an overlay with `nil t' along
|
|
|
|
|
;; with insert-(behind|in-front-of)-hooks or use a slightly larger overlay
|
|
|
|
|
;; (with a one-char margin at each end) with `t nil'.
|
|
|
|
|
;; We opted for a larger overlay because it behaves better in the case
|
|
|
|
|
;; where the clone is reduced to the empty string (we want the overlay to
|
|
|
|
|
;; stay when the clone's content is the empty string and we want to use
|
|
|
|
|
;; `evaporate' to make sure those overlays get deleted when needed).
|
2002-10-17 15:42:10 +00:00
|
|
|
|
;;
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(let* ((pt-end (+ (point) (- end start)))
|
|
|
|
|
(start-margin (if (or (not spreadp) (bobp) (<= start (point-min)))
|
|
|
|
|
0 1))
|
|
|
|
|
(end-margin (if (or (not spreadp)
|
|
|
|
|
(>= pt-end (point-max))
|
|
|
|
|
(>= start (point-max)))
|
|
|
|
|
0 1))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
;; FIXME: Reuse overlays at point to extend dups!
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
|
|
|
|
|
(ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
|
|
|
|
|
(dups (list ol1 ol2)))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(overlay-put ol1 'modification-hooks '(text-clone--maintain))
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(when spreadp (overlay-put ol1 'text-clone-spreadp t))
|
|
|
|
|
(when syntax (overlay-put ol1 'text-clone-syntax syntax))
|
|
|
|
|
;;(overlay-put ol1 'face 'underline)
|
|
|
|
|
(overlay-put ol1 'evaporate t)
|
|
|
|
|
(overlay-put ol1 'text-clones dups)
|
2002-10-17 15:42:10 +00:00
|
|
|
|
;;
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(overlay-put ol2 'modification-hooks '(text-clone--maintain))
|
2001-10-25 02:26:41 +00:00
|
|
|
|
(when spreadp (overlay-put ol2 'text-clone-spreadp t))
|
|
|
|
|
(when syntax (overlay-put ol2 'text-clone-syntax syntax))
|
|
|
|
|
;;(overlay-put ol2 'face 'underline)
|
|
|
|
|
(overlay-put ol2 'evaporate t)
|
|
|
|
|
(overlay-put ol2 'text-clones dups)))
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
|
|
|
|
;;;; Mail user agents.
|
2002-09-11 20:23:56 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;; Here we include just enough for other packages to be able
|
|
|
|
|
;; to define them.
|
2002-04-07 10:09:39 +00:00
|
|
|
|
|
2002-09-11 20:23:56 +00:00
|
|
|
|
(defun define-mail-user-agent (symbol composefunc sendfunc
|
|
|
|
|
&optional abortfunc hookvar)
|
|
|
|
|
"Define a symbol to identify a mail-sending package for `mail-user-agent'.
|
|
|
|
|
|
|
|
|
|
SYMBOL can be any Lisp symbol. Its function definition and/or
|
|
|
|
|
value as a variable do not matter for this usage; we use only certain
|
|
|
|
|
properties on its property list, to encode the rest of the arguments.
|
|
|
|
|
|
|
|
|
|
COMPOSEFUNC is program callable function that composes an outgoing
|
|
|
|
|
mail message buffer. This function should set up the basics of the
|
|
|
|
|
buffer without requiring user interaction. It should populate the
|
|
|
|
|
standard mail headers, leaving the `to:' and `subject:' headers blank
|
|
|
|
|
by default.
|
|
|
|
|
|
|
|
|
|
COMPOSEFUNC should accept several optional arguments--the same
|
|
|
|
|
arguments that `compose-mail' takes. See that function's documentation.
|
|
|
|
|
|
|
|
|
|
SENDFUNC is the command a user would run to send the message.
|
|
|
|
|
|
|
|
|
|
Optional ABORTFUNC is the command a user would run to abort the
|
|
|
|
|
message. For mail packages that don't have a separate abort function,
|
|
|
|
|
this can be `kill-buffer' (the equivalent of omitting this argument).
|
|
|
|
|
|
|
|
|
|
Optional HOOKVAR is a hook variable that gets run before the message
|
|
|
|
|
is actually sent. Callers that use the `mail-user-agent' may
|
|
|
|
|
install a hook function temporarily on this hook variable.
|
|
|
|
|
If HOOKVAR is nil, `mail-send-hook' is used.
|
|
|
|
|
|
|
|
|
|
The properties used on SYMBOL are `composefunc', `sendfunc',
|
|
|
|
|
`abortfunc', and `hookvar'."
|
2021-10-13 19:21:23 +00:00
|
|
|
|
(declare (indent defun))
|
2002-09-11 20:23:56 +00:00
|
|
|
|
(put symbol 'composefunc composefunc)
|
|
|
|
|
(put symbol 'sendfunc sendfunc)
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(put symbol 'abortfunc (or abortfunc #'kill-buffer))
|
2002-09-11 20:23:56 +00:00
|
|
|
|
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
|
2016-12-05 05:52:14 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun backtrace-frames (&optional base)
|
|
|
|
|
"Collect all frames of current backtrace into a list.
|
|
|
|
|
If non-nil, BASE should be a function, and frames before its
|
2020-03-01 17:50:14 +00:00
|
|
|
|
nearest activation frame are discarded."
|
2016-12-05 05:52:14 +00:00
|
|
|
|
(let ((frames nil))
|
|
|
|
|
(mapbacktrace (lambda (&rest frame) (push frame frames))
|
2023-12-18 22:42:37 +00:00
|
|
|
|
(or base #'backtrace-frames))
|
2016-12-05 05:52:14 +00:00
|
|
|
|
(nreverse frames)))
|
|
|
|
|
|
|
|
|
|
(defun backtrace-frame (nframes &optional base)
|
|
|
|
|
"Return the function and arguments NFRAMES up from current execution point.
|
|
|
|
|
If non-nil, BASE should be a function, and NFRAMES counts from its
|
2023-12-18 22:42:37 +00:00
|
|
|
|
nearest activation frame. BASE can also be of the form (OFFSET . FUNCTION)
|
|
|
|
|
in which case OFFSET will be added to NFRAMES.
|
2016-12-05 05:52:14 +00:00
|
|
|
|
If the frame has not evaluated the arguments yet (or is a special form),
|
|
|
|
|
the value is (nil FUNCTION ARG-FORMS...).
|
|
|
|
|
If the frame has evaluated its arguments and called its function already,
|
|
|
|
|
the value is (t FUNCTION ARG-VALUES...).
|
|
|
|
|
A &rest arg is represented as the tail of the list ARG-VALUES.
|
|
|
|
|
FUNCTION is whatever was supplied as car of evaluated list,
|
|
|
|
|
or a lambda expression for macro calls.
|
|
|
|
|
If NFRAMES is more than the number of frames, the value is nil."
|
|
|
|
|
(backtrace-frame--internal
|
|
|
|
|
(lambda (evald func args _) `(,evald ,func ,@args))
|
2023-12-18 22:42:37 +00:00
|
|
|
|
nframes (or base #'backtrace-frame)))
|
2016-12-05 05:52:14 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
|
2012-11-20 04:24:09 +00:00
|
|
|
|
(defvar called-interactively-p-functions nil
|
|
|
|
|
"Special hook called to skip special frames in `called-interactively-p'.
|
|
|
|
|
The functions are called with 3 arguments: (I FRAME1 FRAME2),
|
|
|
|
|
where FRAME1 is a \"current frame\", FRAME2 is the next frame,
|
|
|
|
|
I is the index of the frame after FRAME2. It should return nil
|
|
|
|
|
if those frames don't seem special and otherwise, it should return
|
|
|
|
|
the number of frames to skip (minus 1).")
|
|
|
|
|
|
2014-05-28 00:09:14 +00:00
|
|
|
|
(defconst internal--funcall-interactively
|
|
|
|
|
(symbol-function 'funcall-interactively))
|
2013-09-20 19:59:42 +00:00
|
|
|
|
|
2012-11-20 04:24:09 +00:00
|
|
|
|
(defun called-interactively-p (&optional kind)
|
|
|
|
|
"Return t if the containing function was called by `call-interactively'.
|
2019-11-04 02:36:05 +00:00
|
|
|
|
If KIND is `interactive', then return t only if the call was made
|
2012-11-20 04:24:09 +00:00
|
|
|
|
interactively by the user, i.e. not in `noninteractive' mode nor
|
|
|
|
|
when `executing-kbd-macro'.
|
|
|
|
|
If KIND is `any', on the other hand, it will return t for any kind of
|
|
|
|
|
interactive call, including being called as the binding of a key or
|
|
|
|
|
from a keyboard macro, even in `noninteractive' mode.
|
|
|
|
|
|
|
|
|
|
This function is very brittle, it may fail to return the intended result when
|
|
|
|
|
the code is debugged, advised, or instrumented in some form. Some macros and
|
|
|
|
|
special forms (such as `condition-case') may also sometimes wrap their bodies
|
|
|
|
|
in a `lambda', so any call to `called-interactively-p' from those bodies will
|
|
|
|
|
indicate whether that lambda (rather than the surrounding function) was called
|
|
|
|
|
interactively.
|
|
|
|
|
|
|
|
|
|
Instead of using this function, it is cleaner and more reliable to give your
|
|
|
|
|
function an extra optional argument whose `interactive' spec specifies
|
|
|
|
|
non-nil unconditionally (\"p\" is a good way to do this), or via
|
|
|
|
|
\(not (or executing-kbd-macro noninteractive)).
|
|
|
|
|
|
|
|
|
|
The only known proper use of `interactive' for KIND is in deciding
|
|
|
|
|
whether to display a helpful message, or how to display it. If you're
|
|
|
|
|
thinking of using it for any other purpose, it is quite likely that
|
|
|
|
|
you're making a mistake. Think: what do you want to do when the
|
|
|
|
|
command is called from a keyboard macro?"
|
|
|
|
|
(declare (advertised-calling-convention (kind) "23.1"))
|
|
|
|
|
(when (not (and (eq kind 'interactive)
|
|
|
|
|
(or executing-kbd-macro noninteractive)))
|
|
|
|
|
(let* ((i 1) ;; 0 is the called-interactively-p frame.
|
|
|
|
|
frame nextframe
|
|
|
|
|
(get-next-frame
|
|
|
|
|
(lambda ()
|
|
|
|
|
(setq frame nextframe)
|
2013-07-26 07:38:18 +00:00
|
|
|
|
(setq nextframe (backtrace-frame i 'called-interactively-p))
|
2012-11-20 04:24:09 +00:00
|
|
|
|
;; (message "Frame %d = %S" i nextframe)
|
|
|
|
|
(setq i (1+ i)))))
|
|
|
|
|
(funcall get-next-frame) ;; Get the first frame.
|
|
|
|
|
(while
|
|
|
|
|
;; FIXME: The edebug and advice handling should be made modular and
|
|
|
|
|
;; provided directly by edebug.el and nadvice.el.
|
|
|
|
|
(progn
|
|
|
|
|
;; frame =(backtrace-frame i-2)
|
|
|
|
|
;; nextframe=(backtrace-frame i-1)
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
;; `pcase' would be a fairly good fit here, but it sometimes moves
|
|
|
|
|
;; branches within local functions, which then messes up the
|
|
|
|
|
;; `backtrace-frame' data we get,
|
|
|
|
|
(or
|
|
|
|
|
;; Skip special forms (from non-compiled code).
|
|
|
|
|
(and frame (null (car frame)))
|
|
|
|
|
;; Skip also `interactive-p' (because we don't want to know if
|
2023-09-12 16:55:54 +00:00
|
|
|
|
;; interactive-p was called interactively but if its caller was).
|
2022-12-19 16:42:33 +00:00
|
|
|
|
(eq (nth 1 frame) 'interactive-p)
|
2012-11-20 04:24:09 +00:00
|
|
|
|
;; Skip package-specific stack-frames.
|
|
|
|
|
(let ((skip (run-hook-with-args-until-success
|
|
|
|
|
'called-interactively-p-functions
|
|
|
|
|
i frame nextframe)))
|
|
|
|
|
(pcase skip
|
2018-11-05 00:22:15 +00:00
|
|
|
|
('nil nil)
|
2018-10-26 23:48:35 +00:00
|
|
|
|
(0 t)
|
2012-11-20 04:24:09 +00:00
|
|
|
|
(_ (setq i (+ i skip -1)) (funcall get-next-frame)))))))
|
|
|
|
|
;; Now `frame' should be "the function from which we were called".
|
|
|
|
|
(pcase (cons frame nextframe)
|
|
|
|
|
;; No subr calls `interactive-p', so we can rule that out.
|
2020-04-24 18:24:07 +00:00
|
|
|
|
(`((,_ ,(pred (lambda (f) (subr-primitive-p (indirect-function f)))) . ,_) . ,_) nil)
|
2014-05-28 00:09:14 +00:00
|
|
|
|
;; In case #<subr funcall-interactively> without going through the
|
|
|
|
|
;; `funcall-interactively' symbol (bug#3984).
|
|
|
|
|
(`(,_ . (t ,(pred (lambda (f)
|
|
|
|
|
(eq internal--funcall-interactively
|
|
|
|
|
(indirect-function f))))
|
|
|
|
|
. ,_))
|
|
|
|
|
t)))))
|
2012-11-20 04:24:09 +00:00
|
|
|
|
|
|
|
|
|
(defun interactive-p ()
|
|
|
|
|
"Return t if the containing function was run directly by user input.
|
|
|
|
|
This means that the function was called with `call-interactively'
|
|
|
|
|
\(which includes being called as the binding of a key)
|
|
|
|
|
and input is currently coming from the keyboard (not a keyboard macro),
|
|
|
|
|
and Emacs is not running in batch mode (`noninteractive' is nil).
|
|
|
|
|
|
|
|
|
|
The only known proper use of `interactive-p' is in deciding whether to
|
|
|
|
|
display a helpful message, or how to display it. If you're thinking
|
|
|
|
|
of using it for any other purpose, it is quite likely that you're
|
|
|
|
|
making a mistake. Think: what do you want to do when the command is
|
|
|
|
|
called from a keyboard macro or in batch mode?
|
|
|
|
|
|
|
|
|
|
To test whether your function was called with `call-interactively',
|
|
|
|
|
either (i) add an extra optional argument and give it an `interactive'
|
|
|
|
|
spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
|
2017-05-29 00:04:41 +00:00
|
|
|
|
use `called-interactively-p'.
|
|
|
|
|
|
|
|
|
|
To test whether a function can be called interactively, use
|
|
|
|
|
`commandp'."
|
2020-12-06 09:34:14 +00:00
|
|
|
|
;; Kept around for now. See discussion at:
|
|
|
|
|
;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html
|
Change 'type' declaration to 'ftype'
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Update function type declaration.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(internal-pop-keymap): Likewise.
* lisp/simple.el (count-lines, mark, string-empty-p): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp--final): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
* lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Rename 'type'
-> 'ftype'.
2024-05-14 07:24:05 +00:00
|
|
|
|
(declare (ftype (function () boolean))
|
Move lisp function arg type declarations to the functions itself
* lisp/emacs-lisp/comp-common.el (comp-primitive-type-specifiers):
Remove type declaration of lisp functions.
* lisp/window.el (get-lru-window, get-largest-window)
(one-window-p): Declare type.
* lisp/subr.el (ignore, error, zerop, fixnump, bignump, lsh)
(last, eventp, mouse-movement-p, log10, memory-limit)
(interactive-p): Likewise.
* lisp/simple.el (count-lines, mark, lax-plist-get): Likewise.
* lisp/files.el (parse-colon-path): Likewise.
* lisp/env.el (getenv): Likewise.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt): Likewise.
* lisp/emacs-lisp/lisp.el (buffer-end): Likewise.
* lisp/emacs-lisp/comp.el (comp-hint-fixnum, comp-hint-cons): Likewise.
* lisp/custom.el (custom-variable-p): Likewise.
2024-04-10 20:07:16 +00:00
|
|
|
|
(obsolete called-interactively-p "23.2")
|
Move side-effect-free and pure declarations to function definitions
Some Lisp functions still had their `side-effect-free` and `pure`
properties declared in byte-opt.el; do it at their definition instead.
The lists in byte-opt.el now only contain functions implemented in C
and function aliases.
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns)
(side-effect-and-error-free-fns, pure-fns):
Remove functions whose properties are now declared elsewhere
and some obsolete entries.
* lisp/custom.el (custom-variable-p):
* lisp/emacs-lisp/lisp.el (buffer-end):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt):
* lisp/env.el (getenv):
* lisp/simple.el (count-lines, mark, string-empty-p, lax-plist-get):
* lisp/subr.el (ignore, always, zerop, fixnump, bignump, lsh, last)
(eventp, mouse-movement-p, log10, memory-limit, string-greaterp)
(interactive-p):
* lisp/window.el (get-lru-window, get-largest-window, (window-edges)
(window-body-edges, window-pixel-edges, window-body-pixel-edges)
(window-absolute-pixel-edges, window-absolute-body-pixel-edges)
(one-window-p):
Declare functions `side-effect-free` and/or `pure` as appropriate.
2023-02-17 13:38:50 +00:00
|
|
|
|
(side-effect-free error-free))
|
2012-11-20 04:24:09 +00:00
|
|
|
|
(called-interactively-p 'interactive))
|
|
|
|
|
|
2013-06-13 20:43:53 +00:00
|
|
|
|
(defun internal-push-keymap (keymap symbol)
|
|
|
|
|
(let ((map (symbol-value symbol)))
|
|
|
|
|
(unless (memq keymap map)
|
|
|
|
|
(unless (memq 'add-keymap-witness (symbol-value symbol))
|
|
|
|
|
(setq map (make-composed-keymap nil (symbol-value symbol)))
|
|
|
|
|
(push 'add-keymap-witness (cdr map))
|
|
|
|
|
(set symbol map))
|
|
|
|
|
(push keymap (cdr map)))))
|
|
|
|
|
|
|
|
|
|
(defun internal-pop-keymap (keymap symbol)
|
|
|
|
|
(let ((map (symbol-value symbol)))
|
|
|
|
|
(when (memq keymap map)
|
|
|
|
|
(setf (cdr map) (delq keymap (cdr map))))
|
|
|
|
|
(let ((tail (cddr map)))
|
|
|
|
|
(and (or (null tail) (keymapp tail))
|
|
|
|
|
(eq 'add-keymap-witness (nth 1 map))
|
|
|
|
|
(set symbol tail)))))
|
|
|
|
|
|
2013-12-31 00:27:27 +00:00
|
|
|
|
(define-obsolete-function-alias
|
2021-02-15 02:13:35 +00:00
|
|
|
|
'set-temporary-overlay-map #'set-transient-map "24.4")
|
2013-12-31 00:27:27 +00:00
|
|
|
|
|
2022-07-06 17:39:41 +00:00
|
|
|
|
(defvar set-transient-map-timeout nil
|
2022-07-07 06:29:51 +00:00
|
|
|
|
"Timeout in seconds for deactivation of a transient keymap.
|
|
|
|
|
If this is a number, it specifies the amount of idle time
|
|
|
|
|
after which to deactivate the keymap set by `set-transient-map',
|
|
|
|
|
thus overriding the value of the TIMEOUT argument to that function.")
|
2022-07-06 17:39:41 +00:00
|
|
|
|
|
|
|
|
|
(defvar set-transient-map-timer nil
|
|
|
|
|
"Timer for `set-transient-map-timeout'.")
|
|
|
|
|
|
|
|
|
|
(defun set-transient-map (map &optional keep-pred on-exit message timeout)
|
2013-12-23 03:59:10 +00:00
|
|
|
|
"Set MAP as a temporary keymap taking precedence over other keymaps.
|
|
|
|
|
Normally, MAP is used only once, to look up the very next key.
|
|
|
|
|
However, if the optional argument KEEP-PRED is t, MAP stays
|
|
|
|
|
active if a key from MAP is used. KEEP-PRED can also be a
|
2014-10-21 20:11:22 +00:00
|
|
|
|
function of no arguments: it is called from `pre-command-hook' and
|
|
|
|
|
if it returns non-nil, then MAP stays active.
|
2013-12-23 03:59:10 +00:00
|
|
|
|
|
|
|
|
|
Optional arg ON-EXIT, if non-nil, specifies a function that is
|
|
|
|
|
called, with no arguments, after MAP is deactivated.
|
|
|
|
|
|
2022-07-07 06:29:51 +00:00
|
|
|
|
Optional arg MESSAGE, if non-nil, requests display of an informative
|
|
|
|
|
message after activating the transient map. If MESSAGE is a string,
|
|
|
|
|
it specifies the format string for the message to display, and the %k
|
|
|
|
|
specifier in the string is replaced with the list of keys from the
|
|
|
|
|
transient map. Any other non-nil value of MESSAGE means to use the
|
|
|
|
|
message format string \"Repeat with %k\". Upon deactivating the map,
|
|
|
|
|
the displayed message will be cleared out.
|
|
|
|
|
|
|
|
|
|
Optional arg TIMEOUT, if non-nil, should be a number specifying the
|
|
|
|
|
number of seconds of idle time after which the map is deactivated.
|
|
|
|
|
The variable `set-transient-map-timeout', if non-nil, overrides the
|
|
|
|
|
value of TIMEOUT.
|
2022-07-06 17:39:41 +00:00
|
|
|
|
|
|
|
|
|
This function uses `overriding-terminal-local-map', which takes precedence
|
|
|
|
|
over all other keymaps. As usual, if no match for a key is found in MAP,
|
|
|
|
|
the normal key lookup sequence then continues.
|
2014-10-21 20:11:22 +00:00
|
|
|
|
|
|
|
|
|
This returns an \"exit function\", which can be called with no argument
|
|
|
|
|
to deactivate this transient map, regardless of KEEP-PRED."
|
2022-07-06 17:39:41 +00:00
|
|
|
|
(let* ((timeout (or set-transient-map-timeout timeout))
|
|
|
|
|
(message
|
|
|
|
|
(when message
|
|
|
|
|
(let (keys)
|
|
|
|
|
(map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
|
|
|
|
|
(format-spec (if (stringp message) message "Repeat with %k")
|
|
|
|
|
`((?k . ,(mapconcat
|
|
|
|
|
(lambda (key)
|
|
|
|
|
(substitute-command-keys
|
|
|
|
|
(format "\\`%s'"
|
|
|
|
|
(key-description (vector key)))))
|
|
|
|
|
keys ", ")))))))
|
|
|
|
|
(clearfun (make-symbol "clear-transient-map"))
|
2014-10-21 20:11:22 +00:00
|
|
|
|
(exitfun
|
|
|
|
|
(lambda ()
|
|
|
|
|
(internal-pop-keymap map 'overriding-terminal-local-map)
|
|
|
|
|
(remove-hook 'pre-command-hook clearfun)
|
2022-07-06 17:39:41 +00:00
|
|
|
|
;; Clear the prompt after exiting.
|
|
|
|
|
(when message (message ""))
|
|
|
|
|
(when set-transient-map-timer (cancel-timer set-transient-map-timer))
|
2014-10-21 20:11:22 +00:00
|
|
|
|
(when on-exit (funcall on-exit)))))
|
2021-04-23 22:51:40 +00:00
|
|
|
|
;; Don't use letrec, because equal (in add/remove-hook) could get trapped
|
2021-04-23 21:17:40 +00:00
|
|
|
|
;; in a cycle. (bug#46326)
|
2013-06-14 04:11:00 +00:00
|
|
|
|
(fset clearfun
|
|
|
|
|
(lambda ()
|
2013-12-23 03:59:10 +00:00
|
|
|
|
(with-demoted-errors "set-transient-map PCH: %S"
|
2022-07-06 17:39:41 +00:00
|
|
|
|
(if (cond
|
2014-05-31 20:02:47 +00:00
|
|
|
|
((null keep-pred) nil)
|
2016-08-04 15:39:28 +00:00
|
|
|
|
((and (not (eq map (cadr overriding-terminal-local-map)))
|
|
|
|
|
(memq map (cddr overriding-terminal-local-map)))
|
2014-01-06 19:29:39 +00:00
|
|
|
|
;; There's presumably some other transient-map in
|
|
|
|
|
;; effect. Wait for that one to terminate before we
|
|
|
|
|
;; remove ourselves.
|
|
|
|
|
;; For example, if isearch and C-u both use transient
|
|
|
|
|
;; maps, then the lifetime of the C-u should be nested
|
|
|
|
|
;; within isearch's, so the pre-command-hook of
|
|
|
|
|
;; isearch should be suspended during the C-u one so
|
|
|
|
|
;; we don't exit isearch just because we hit 1 after
|
|
|
|
|
;; C-u and that 1 exits isearch whereas it doesn't
|
|
|
|
|
;; exit C-u.
|
|
|
|
|
t)
|
|
|
|
|
((eq t keep-pred)
|
2016-10-26 19:29:02 +00:00
|
|
|
|
(let ((mc (lookup-key map (this-command-keys-vector))))
|
2022-05-23 11:08:17 +00:00
|
|
|
|
;; We may have a remapped command, so chase
|
|
|
|
|
;; down that.
|
|
|
|
|
(when (and mc (symbolp mc))
|
2022-05-24 12:54:40 +00:00
|
|
|
|
(setq mc (or (command-remapping mc) mc)))
|
2016-10-26 19:29:02 +00:00
|
|
|
|
;; If the key is unbound `this-command` is
|
|
|
|
|
;; nil and so is `mc`.
|
|
|
|
|
(and mc (eq this-command mc))))
|
2014-01-06 19:29:39 +00:00
|
|
|
|
(t (funcall keep-pred)))
|
2022-07-06 17:39:41 +00:00
|
|
|
|
;; Repeat the message for the next command.
|
|
|
|
|
(when message (message "%s" message))
|
2014-10-21 20:11:22 +00:00
|
|
|
|
(funcall exitfun)))))
|
2013-06-13 20:43:53 +00:00
|
|
|
|
(add-hook 'pre-command-hook clearfun)
|
2014-10-21 20:11:22 +00:00
|
|
|
|
(internal-push-keymap map 'overriding-terminal-local-map)
|
2022-07-06 17:39:41 +00:00
|
|
|
|
(when timeout
|
|
|
|
|
(when set-transient-map-timer (cancel-timer set-transient-map-timer))
|
|
|
|
|
(setq set-transient-map-timer (run-with-idle-timer timeout nil exitfun)))
|
|
|
|
|
(when message (message "%s" message))
|
2014-10-21 20:11:22 +00:00
|
|
|
|
exitfun))
|
2012-05-05 01:47:04 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Progress reporters.
|
2004-10-08 17:23:40 +00:00
|
|
|
|
|
|
|
|
|
;; Progress reporter has the following structure:
|
|
|
|
|
;;
|
|
|
|
|
;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
|
|
|
|
|
;; MIN-VALUE
|
|
|
|
|
;; MAX-VALUE
|
|
|
|
|
;; MESSAGE
|
|
|
|
|
;; MIN-CHANGE
|
2019-05-25 23:44:41 +00:00
|
|
|
|
;; MIN-TIME
|
|
|
|
|
;; MESSAGE-SUFFIX])
|
2004-10-08 17:23:40 +00:00
|
|
|
|
;;
|
2011-11-23 07:03:56 +00:00
|
|
|
|
;; This weirdness is for optimization reasons: we want
|
2004-10-08 17:23:40 +00:00
|
|
|
|
;; `progress-reporter-update' to be as fast as possible, so
|
|
|
|
|
;; `(car reporter)' is better than `(aref reporter 0)'.
|
|
|
|
|
;;
|
|
|
|
|
;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple
|
|
|
|
|
;; digits of precision, it doesn't really matter here. On the other
|
|
|
|
|
;; hand, it greatly simplifies the code.
|
|
|
|
|
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(defsubst progress-reporter-update (reporter &optional value suffix)
|
2004-10-09 21:50:57 +00:00
|
|
|
|
"Report progress of an operation in the echo area.
|
2010-03-29 23:18:48 +00:00
|
|
|
|
REPORTER should be the result of a call to `make-progress-reporter'.
|
|
|
|
|
|
|
|
|
|
If REPORTER is a numerical progress reporter---i.e. if it was
|
|
|
|
|
made using non-nil MIN-VALUE and MAX-VALUE arguments to
|
|
|
|
|
`make-progress-reporter'---then VALUE should be a number between
|
|
|
|
|
MIN-VALUE and MAX-VALUE.
|
2004-10-09 21:50:57 +00:00
|
|
|
|
|
2019-05-25 23:44:41 +00:00
|
|
|
|
Optional argument SUFFIX is a string to be displayed after
|
|
|
|
|
REPORTER's main message and progress text. If REPORTER is a
|
|
|
|
|
non-numerical reporter, then VALUE should be nil, or a string to
|
|
|
|
|
use instead of SUFFIX.
|
2004-10-08 17:23:40 +00:00
|
|
|
|
|
2010-03-29 23:18:48 +00:00
|
|
|
|
This function is relatively inexpensive. If the change since
|
|
|
|
|
last update is too small or insufficient time has passed, it does
|
|
|
|
|
nothing."
|
|
|
|
|
(when (or (not (numberp value)) ; For pulsing reporter
|
|
|
|
|
(>= value (car reporter))) ; For numerical reporter
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(progress-reporter-do-update reporter value suffix)))
|
2010-03-29 23:18:48 +00:00
|
|
|
|
|
|
|
|
|
(defun make-progress-reporter (message &optional min-value max-value
|
|
|
|
|
current-value min-change min-time)
|
|
|
|
|
"Return progress reporter object for use with `progress-reporter-update'.
|
|
|
|
|
|
|
|
|
|
MESSAGE is shown in the echo area, with a status indicator
|
|
|
|
|
appended to the end. When you call `progress-reporter-done', the
|
|
|
|
|
word \"done\" is printed after the MESSAGE. You can change the
|
|
|
|
|
MESSAGE of an existing progress reporter by calling
|
|
|
|
|
`progress-reporter-force-update'.
|
|
|
|
|
|
|
|
|
|
MIN-VALUE and MAX-VALUE, if non-nil, are starting (0% complete)
|
|
|
|
|
and final (100% complete) states of operation; the latter should
|
|
|
|
|
be larger. In this case, the status message shows the percentage
|
|
|
|
|
progress.
|
|
|
|
|
|
|
|
|
|
If MIN-VALUE and/or MAX-VALUE is omitted or nil, the status
|
|
|
|
|
message shows a \"spinning\", non-numeric indicator.
|
|
|
|
|
|
|
|
|
|
Optional CURRENT-VALUE is the initial progress; the default is
|
|
|
|
|
MIN-VALUE.
|
|
|
|
|
Optional MIN-CHANGE is the minimal change in percents to report;
|
|
|
|
|
the default is 1%.
|
|
|
|
|
CURRENT-VALUE and MIN-CHANGE do not have any effect if MIN-VALUE
|
|
|
|
|
and/or MAX-VALUE are nil.
|
|
|
|
|
|
|
|
|
|
Optional MIN-TIME specifies the minimum interval time between
|
2017-10-21 03:13:09 +00:00
|
|
|
|
echo area updates (default is 0.2 seconds.) If the OS is not
|
|
|
|
|
capable of measuring fractions of seconds, this parameter is
|
|
|
|
|
effectively rounded up."
|
2011-06-02 18:04:44 +00:00
|
|
|
|
(when (string-match "[[:alnum:]]\\'" message)
|
|
|
|
|
(setq message (concat message "...")))
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(unless min-time
|
|
|
|
|
(setq min-time 0.2))
|
|
|
|
|
(let ((reporter
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(cons (or min-value 0)
|
2017-10-21 03:13:09 +00:00
|
|
|
|
(vector (if (>= min-time 0.02)
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(float-time) nil)
|
|
|
|
|
min-value
|
|
|
|
|
max-value
|
|
|
|
|
message
|
|
|
|
|
(if min-change (max (min min-change 50) 1) 1)
|
2019-05-25 23:44:41 +00:00
|
|
|
|
min-time
|
|
|
|
|
;; SUFFIX
|
|
|
|
|
nil))))
|
2023-09-12 16:55:54 +00:00
|
|
|
|
;; Force a call to `message' now.
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(progress-reporter-update reporter (or current-value min-value))
|
|
|
|
|
reporter))
|
|
|
|
|
|
2024-02-04 09:28:18 +00:00
|
|
|
|
(defalias 'progress-reporter-make #'make-progress-reporter)
|
|
|
|
|
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(defun progress-reporter-force-update (reporter &optional value new-message suffix)
|
2004-10-08 17:23:40 +00:00
|
|
|
|
"Report progress of an operation in the echo area unconditionally.
|
|
|
|
|
|
2019-05-25 23:44:41 +00:00
|
|
|
|
REPORTER, VALUE, and SUFFIX are the same as in `progress-reporter-update'.
|
2010-03-29 23:18:48 +00:00
|
|
|
|
NEW-MESSAGE, if non-nil, sets a new message for the reporter."
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(let ((parameters (cdr reporter)))
|
|
|
|
|
(when new-message
|
|
|
|
|
(aset parameters 3 new-message))
|
|
|
|
|
(when (aref parameters 0)
|
|
|
|
|
(aset parameters 0 (float-time)))
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(progress-reporter-do-update reporter value suffix)))
|
2004-10-08 17:23:40 +00:00
|
|
|
|
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
|
|
|
|
|
"Characters to use for pulsing progress reporters.")
|
|
|
|
|
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(defun progress-reporter-do-update (reporter value &optional suffix)
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(let* ((parameters (cdr reporter))
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(update-time (aref parameters 0))
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(min-value (aref parameters 1))
|
|
|
|
|
(max-value (aref parameters 2))
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(text (aref parameters 3))
|
2004-10-08 17:23:40 +00:00
|
|
|
|
(enough-time-passed
|
|
|
|
|
;; See if enough time has passed since the last update.
|
|
|
|
|
(or (not update-time)
|
Avoid some double-rounding of Lisp timestamps
Also, simplify some time-related Lisp timestamp code
while we’re in the neighborhood.
* lisp/battery.el (battery-linux-proc-acpi)
(battery-linux-sysfs, battery-upower, battery-bsd-apm):
* lisp/calendar/timeclock.el (timeclock-seconds-to-string)
(timeclock-log, timeclock-last-period)
(timeclock-entry-length, timeclock-entry-list-span)
(timeclock-find-discrep, timeclock-generate-report):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/completion.el (cmpl-hours-since-origin):
* lisp/ecomplete.el (ecomplete-decay-1):
* lisp/emacs-lisp/ert.el (ert--results-update-stats-display)
(ert--results-update-stats-display-maybe):
* lisp/emacs-lisp/timer-list.el (list-timers):
* lisp/emacs-lisp/timer.el (timer-until)
(timer-event-handler):
* lisp/erc/erc-backend.el (erc-server-send-ping)
(erc-server-send-queue, erc-handle-parsed-server-response)
(erc-handle-unknown-server-response):
* lisp/erc/erc-track.el (erc-buffer-visible):
* lisp/erc/erc.el (erc-lurker-cleanup, erc-lurker-p)
(erc-cmd-PING, erc-send-current-line):
* lisp/eshell/em-pred.el (eshell-pred-file-time):
* lisp/eshell/em-unix.el (eshell-show-elapsed-time):
* lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:org-timestamp):
* lisp/gnus/gnus-int.el (gnus-backend-trace):
* lisp/gnus/gnus-sum.el (gnus-user-date):
* lisp/gnus/mail-source.el (mail-source-delete-crash-box):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/ibuf-ext.el (ibuffer-mark-old-buffers):
* lisp/gnus/nnmaildir.el (nnmaildir--scan):
* lisp/mouse.el (mouse--down-1-maybe-follows-link)
(mouse--click-1-maybe-follows-link):
* lisp/mpc.el (mpc--faster-toggle):
* lisp/net/rcirc.el (rcirc-handler-ctcp-KEEPALIVE)
(rcirc-sentinel):
* lisp/net/tramp-cache.el (tramp-get-file-property):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-newer-than-file-p)
(tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
* lisp/org/org-clock.el (org-clock-resolve):
(org-resolve-clocks, org-clock-in, org-clock-out, org-clock-sum):
* lisp/org/org-timer.el (org-timer-start)
(org-timer-pause-or-continue, org-timer-seconds):
* lisp/org/org.el (org-evaluate-time-range):
* lisp/org/ox-publish.el (org-publish-cache-ctime-of-src):
* lisp/pixel-scroll.el (pixel-scroll-in-rush-p):
* lisp/play/hanoi.el (hanoi-move-ring):
* lisp/proced.el (proced-format-time):
* lisp/progmodes/cpp.el (cpp-progress-message):
* lisp/progmodes/flymake.el (flymake--handle-report):
* lisp/progmodes/js.el (js--wait-for-matching-output):
* lisp/subr.el (progress-reporter-do-update):
* lisp/term/xterm.el (xterm--read-event-for-query):
* lisp/time.el (display-time-update, emacs-uptime):
* lisp/tooltip.el (tooltip-delay):
* lisp/url/url-cookie.el (url-cookie-parse-file-netscape):
* lisp/url/url-queue.el (url-queue-prune-old-entries):
* lisp/url/url.el (url-retrieve-synchronously):
* lisp/xt-mouse.el (xterm-mouse-event):
Avoid double-rounding of time-related values. Simplify.
* lisp/calendar/icalendar.el (icalendar--decode-isodatetime):
When hoping for the best (unlikely), use a better decoded time.
(icalendar--convert-sexp-to-ical): Avoid unnecessary encode-time.
* lisp/calendar/timeclock.el (timeclock-when-to-leave):
* lisp/cedet/ede/detect.el (ede-detect-qtest):
* lisp/desktop.el (desktop-create-buffer):
* lisp/emacs-lisp/benchmark.el (benchmark-elapse):
* lisp/gnus/gnus-art.el (article-lapsed-string):
* lisp/gnus/gnus-group.el (gnus-group-timestamp-delta):
* lisp/gnus/nnmail.el (nnmail-expired-article-p):
* lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles):
* lisp/nxml/rng-maint.el (rng-time-function):
* lisp/org/org-clock.el (org-clock-get-clocked-time)
(org-clock-resolve, org-resolve-clocks, org-resolve-clocks-if-idle):
* lisp/org/org-habit.el (org-habit-insert-consistency-graphs):
* lisp/progmodes/vhdl-mode.el (vhdl-update-progress-info)
(vhdl-fix-case-region-1):
Use time-since instead of open-coding most of it.
* lisp/erc/erc-dcc.el (erc-dcc-get-sentinel):
* lisp/erc/erc.el (erc-string-to-emacs-time, erc-time-gt):
Now obsolete. All uses changed.
(erc-time-diff): Accept all Lisp time values.
All uses changed.
* lisp/gnus/gnus-demon.el (gnus-demon-idle-since):
* lisp/gnus/gnus-score.el (gnus-score-headers):
* lisp/gnus/nneething.el (nneething-make-head):
* lisp/gnus/nnheader.el (nnheader-message-maybe):
* lisp/gnus/nnimap.el (nnimap-keepalive):
* lisp/image.el (image-animate-timeout):
* lisp/mail/feedmail.el (feedmail-rfc822-date):
* lisp/net/imap.el (imap-wait-for-tag):
* lisp/net/newst-backend.el (newsticker--image-get):
* lisp/net/rcirc.el (rcirc-handler-317, rcirc-handler-333):
* lisp/obsolete/xesam.el (xesam-refresh-entry):
* lisp/org/org-agenda.el (org-agenda-show-clocking-issues)
(org-agenda-check-clock-gap, org-agenda-to-appt):
* lisp/org/org-capture.el (org-capture-set-target-location):
* lisp/org/org-clock.el (org-clock-resolve-clock)
(org-clocktable-steps):
* lisp/org/org-colview.el (org-columns-edit-value)
(org-columns, org-agenda-columns):
* lisp/org/org-duration.el (org-duration-from-minutes):
* lisp/org/org-element.el (org-element-cache-sync-duration)
(org-element-cache-sync-break)
(org-element--cache-interrupt-p, org-element--cache-sync):
* lisp/org/org-habit.el (org-habit-get-faces)
* lisp/org/org-indent.el (org-indent-add-properties):
* lisp/org/org-table.el (org-table-sum):
* lisp/org/org-timer.el (org-timer-show-remaining-time)
(org-timer-set-timer):
* lisp/org/org.el (org-babel-load-file, org-today)
(org-auto-repeat-maybe, org-2ft, org-time-stamp)
(org-read-date-analyze, org-time-stamp-to-now)
(org-small-year-to-year, org-goto-calendar):
* lisp/org/ox.el (org-export-insert-default-template):
* lisp/ses.el (ses--time-check):
* lisp/type-break.el (type-break-time-warning)
(type-break-statistics, type-break-demo-boring):
* lisp/url/url-cache.el (url-cache-expired)
(url-cache-prune-cache):
* lisp/vc/vc-git.el (vc-git-stash-snapshot):
* lisp/erc/erc-match.el (erc-log-matches-come-back):
Simplify.
2019-02-23 02:32:31 +00:00
|
|
|
|
(when (time-less-p update-time nil)
|
2004-10-08 17:23:40 +00:00
|
|
|
|
;; Calculate time for the next update
|
|
|
|
|
(aset parameters 0 (+ update-time (aref parameters 5)))))))
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(cond ((and min-value max-value)
|
|
|
|
|
;; Numerical indicator
|
|
|
|
|
(let* ((one-percent (/ (- max-value min-value) 100.0))
|
|
|
|
|
(percentage (if (= max-value min-value)
|
|
|
|
|
0
|
|
|
|
|
(truncate (/ (- value min-value)
|
|
|
|
|
one-percent)))))
|
|
|
|
|
;; Calculate NEXT-UPDATE-VALUE. If we are not printing
|
|
|
|
|
;; message because not enough time has passed, use 1
|
|
|
|
|
;; instead of MIN-CHANGE. This makes delays between echo
|
|
|
|
|
;; area updates closer to MIN-TIME.
|
|
|
|
|
(setcar reporter
|
|
|
|
|
(min (+ min-value (* (+ percentage
|
|
|
|
|
(if enough-time-passed
|
|
|
|
|
;; MIN-CHANGE
|
|
|
|
|
(aref parameters 4)
|
|
|
|
|
1))
|
|
|
|
|
one-percent))
|
|
|
|
|
max-value))
|
|
|
|
|
(when (integerp value)
|
|
|
|
|
(setcar reporter (ceiling (car reporter))))
|
2019-11-04 02:36:05 +00:00
|
|
|
|
;; Print message only if enough time has passed
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(when enough-time-passed
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(if suffix
|
|
|
|
|
(aset parameters 6 suffix)
|
|
|
|
|
(setq suffix (or (aref parameters 6) "")))
|
|
|
|
|
(if (> percentage 0)
|
|
|
|
|
(message "%s%d%% %s" text percentage suffix)
|
|
|
|
|
(message "%s %s" text suffix)))))
|
2010-03-29 23:18:48 +00:00
|
|
|
|
;; Pulsing indicator
|
|
|
|
|
(enough-time-passed
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(when (and value (not suffix))
|
|
|
|
|
(setq suffix value))
|
|
|
|
|
(if suffix
|
|
|
|
|
(aset parameters 6 suffix)
|
|
|
|
|
(setq suffix (or (aref parameters 6) "")))
|
|
|
|
|
(let* ((index (mod (1+ (car reporter)) 4))
|
|
|
|
|
(message-log-max nil)
|
|
|
|
|
(pulse-char (aref progress-reporter--pulse-characters
|
|
|
|
|
index)))
|
2010-03-29 23:18:48 +00:00
|
|
|
|
(setcar reporter index)
|
2019-05-25 23:44:41 +00:00
|
|
|
|
(message "%s %s %s" text pulse-char suffix))))))
|
2004-10-08 17:23:40 +00:00
|
|
|
|
|
|
|
|
|
(defun progress-reporter-done (reporter)
|
|
|
|
|
"Print reporter's message followed by word \"done\" in echo area."
|
|
|
|
|
(message "%sdone" (aref (cdr reporter) 3)))
|
|
|
|
|
|
2018-06-17 09:28:34 +00:00
|
|
|
|
(defmacro dotimes-with-progress-reporter (spec reporter-or-message &rest body)
|
2005-01-19 23:44:48 +00:00
|
|
|
|
"Loop a certain number of times and report progress in the echo area.
|
|
|
|
|
Evaluate BODY with VAR bound to successive integers running from
|
|
|
|
|
0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get
|
|
|
|
|
the return value (nil if RESULT is omitted).
|
|
|
|
|
|
2018-06-17 09:28:34 +00:00
|
|
|
|
REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter
|
|
|
|
|
case, use this string to create a progress reporter.
|
|
|
|
|
|
|
|
|
|
At each iteration, print the reporter message followed by progress
|
|
|
|
|
percentage in the echo area. After the loop is finished,
|
2018-06-17 10:13:52 +00:00
|
|
|
|
print the reporter message followed by the word \"done\".
|
2018-06-17 09:28:34 +00:00
|
|
|
|
|
|
|
|
|
This macro is a convenience wrapper around `make-progress-reporter' and friends.
|
2005-01-19 23:44:48 +00:00
|
|
|
|
|
2018-06-17 10:13:52 +00:00
|
|
|
|
\(fn (VAR COUNT [RESULT]) REPORTER-OR-MESSAGE BODY...)"
|
2005-01-19 23:44:48 +00:00
|
|
|
|
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
|
2018-06-17 09:28:34 +00:00
|
|
|
|
(let ((prep (make-symbol "--dotimes-prep--"))
|
|
|
|
|
(end (make-symbol "--dotimes-end--")))
|
|
|
|
|
`(let ((,prep ,reporter-or-message)
|
|
|
|
|
(,end ,(cadr spec)))
|
|
|
|
|
(when (stringp ,prep)
|
|
|
|
|
(setq ,prep (make-progress-reporter ,prep 0 ,end)))
|
|
|
|
|
(dotimes (,(car spec) ,end)
|
|
|
|
|
,@body
|
|
|
|
|
(progress-reporter-update ,prep (1+ ,(car spec))))
|
|
|
|
|
(progress-reporter-done ,prep)
|
|
|
|
|
(or ,@(cdr (cdr spec)) nil))))
|
2005-08-26 12:31:55 +00:00
|
|
|
|
|
2018-06-17 09:28:34 +00:00
|
|
|
|
(defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body)
|
|
|
|
|
"Loop over a list and report progress in the echo area.
|
|
|
|
|
Evaluate BODY with VAR bound to each car from LIST, in turn.
|
|
|
|
|
Then evaluate RESULT to get return value, default nil.
|
|
|
|
|
|
|
|
|
|
REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter
|
|
|
|
|
case, use this string to create a progress reporter.
|
|
|
|
|
|
|
|
|
|
At each iteration, print the reporter message followed by progress
|
|
|
|
|
percentage in the echo area. After the loop is finished,
|
2018-06-17 10:13:52 +00:00
|
|
|
|
print the reporter message followed by the word \"done\".
|
2018-06-17 09:28:34 +00:00
|
|
|
|
|
2018-06-17 10:13:52 +00:00
|
|
|
|
\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)"
|
2018-06-17 09:28:34 +00:00
|
|
|
|
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
|
|
|
|
|
(let ((prep (make-symbol "--dolist-progress-reporter--"))
|
|
|
|
|
(count (make-symbol "--dolist-count--"))
|
|
|
|
|
(list (make-symbol "--dolist-list--")))
|
|
|
|
|
`(let ((,prep ,reporter-or-message)
|
|
|
|
|
(,count 0)
|
|
|
|
|
(,list ,(cadr spec)))
|
|
|
|
|
(when (stringp ,prep)
|
2021-07-12 15:26:43 +00:00
|
|
|
|
(setq ,prep (make-progress-reporter ,prep 0 (length ,list))))
|
2018-06-17 09:28:34 +00:00
|
|
|
|
(dolist (,(car spec) ,list)
|
|
|
|
|
,@body
|
|
|
|
|
(progress-reporter-update ,prep (setq ,count (1+ ,count))))
|
|
|
|
|
(progress-reporter-done ,prep)
|
|
|
|
|
(or ,@(cdr (cdr spec)) nil))))
|
|
|
|
|
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2005-10-22 15:01:08 +00:00
|
|
|
|
;;;; Comparing version strings.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2009-11-11 06:36:41 +00:00
|
|
|
|
(defconst version-separator "."
|
2010-11-02 01:50:22 +00:00
|
|
|
|
"Specify the string used to separate the version elements.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
Usually the separator is \".\", but it can be any other string.")
|
|
|
|
|
|
|
|
|
|
|
2009-11-11 06:36:41 +00:00
|
|
|
|
(defconst version-regexp-alist
|
2015-12-05 09:32:01 +00:00
|
|
|
|
'(("^[-._+ ]?snapshot$" . -4)
|
2013-11-14 17:07:03 +00:00
|
|
|
|
;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
|
2015-12-05 09:32:01 +00:00
|
|
|
|
("^[-._+]$" . -4)
|
2013-11-14 17:07:03 +00:00
|
|
|
|
;; treat "1.2.3-CVS" as snapshot release
|
2015-12-05 09:32:01 +00:00
|
|
|
|
("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
|
2019-10-13 02:59:44 +00:00
|
|
|
|
;; treat "-unknown" the same as snapshots.
|
|
|
|
|
("^[-._+ ]?unknown$" . -4)
|
2015-12-05 09:32:01 +00:00
|
|
|
|
("^[-._+ ]?alpha$" . -3)
|
|
|
|
|
("^[-._+ ]?beta$" . -2)
|
|
|
|
|
("^[-._+ ]?\\(pre\\|rc\\)$" . -1))
|
2010-11-02 01:50:22 +00:00
|
|
|
|
"Specify association between non-numeric version and its priority.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
This association is used to handle version string like \"1.0pre2\",
|
|
|
|
|
\"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the
|
2010-03-27 12:31:04 +00:00
|
|
|
|
non-numeric part of a version string to an integer. For example:
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
String Version Integer List Version
|
2013-11-02 09:48:11 +00:00
|
|
|
|
\"0.9snapshot\" (0 9 -4)
|
|
|
|
|
\"1.0-git\" (1 0 -4)
|
2015-12-05 09:32:01 +00:00
|
|
|
|
\"1.0.cvs\" (1 0 -4)
|
2005-08-25 01:37:47 +00:00
|
|
|
|
\"1.0pre2\" (1 0 -1 2)
|
|
|
|
|
\"1.0PRE2\" (1 0 -1 2)
|
|
|
|
|
\"22.8beta3\" (22 8 -2 3)
|
2005-12-12 14:23:06 +00:00
|
|
|
|
\"22.8 Beta3\" (22 8 -2 3)
|
2005-08-25 01:37:47 +00:00
|
|
|
|
\"0.9alpha1\" (0 9 -3 1)
|
|
|
|
|
\"0.9AlphA1\" (0 9 -3 1)
|
2005-12-12 14:23:06 +00:00
|
|
|
|
\"0.9 alpha\" (0 9 -3)
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
Each element has the following form:
|
|
|
|
|
|
|
|
|
|
(REGEXP . PRIORITY)
|
|
|
|
|
|
|
|
|
|
Where:
|
|
|
|
|
|
|
|
|
|
REGEXP regexp used to match non-numeric part of a version string.
|
2010-03-27 12:31:04 +00:00
|
|
|
|
It should begin with the `^' anchor and end with a `$' to
|
2005-09-24 10:41:18 +00:00
|
|
|
|
prevent false hits. Letter-case is ignored while matching
|
|
|
|
|
REGEXP.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
PRIORITY a negative integer specifying non-numeric priority of REGEXP.")
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun version-to-list (ver)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Convert version string VER into a list of integers.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
The version syntax is given by the following EBNF:
|
|
|
|
|
|
|
|
|
|
VERSION ::= NUMBER ( SEPARATOR NUMBER )*.
|
|
|
|
|
|
|
|
|
|
NUMBER ::= (0|1|2|3|4|5|6|7|8|9)+.
|
|
|
|
|
|
|
|
|
|
SEPARATOR ::= `version-separator' (which see)
|
|
|
|
|
| `version-regexp-alist' (which see).
|
|
|
|
|
|
2005-09-24 10:41:18 +00:00
|
|
|
|
The NUMBER part is optional if SEPARATOR is a match for an element
|
|
|
|
|
in `version-regexp-alist'.
|
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
Examples of valid version syntax:
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2015-12-05 09:32:01 +00:00
|
|
|
|
1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta 2.4.snapshot .5
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
Examples of invalid version syntax:
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2015-12-05 09:32:01 +00:00
|
|
|
|
1.0prepre2 1.0..7.5 22.8X3 alpha3.2
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
Examples of version conversion:
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
Version String Version as a List of Integers
|
2015-12-05 09:32:01 +00:00
|
|
|
|
\".5\" (0 5)
|
|
|
|
|
\"0.9 alpha\" (0 9 -3)
|
2005-08-25 01:37:47 +00:00
|
|
|
|
\"0.9AlphA1\" (0 9 -3 1)
|
2013-11-02 09:48:11 +00:00
|
|
|
|
\"0.9snapshot\" (0 9 -4)
|
|
|
|
|
\"1.0-git\" (1 0 -4)
|
2015-12-05 09:32:01 +00:00
|
|
|
|
\"1.0.7.5\" (1 0 7 5)
|
|
|
|
|
\"1.0.cvs\" (1 0 -4)
|
|
|
|
|
\"1.0PRE2\" (1 0 -1 2)
|
|
|
|
|
\"1.0pre2\" (1 0 -1 2)
|
|
|
|
|
\"22.8 Beta3\" (22 8 -2 3)
|
|
|
|
|
\"22.8beta3\" (22 8 -2 3)
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
See documentation for `version-separator' and `version-regexp-alist'."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2015-12-05 09:32:01 +00:00
|
|
|
|
(unless (stringp ver)
|
|
|
|
|
(error "Version must be a string"))
|
2005-12-12 14:23:06 +00:00
|
|
|
|
;; Change .x.y to 0.x.y
|
|
|
|
|
(if (and (>= (length ver) (length version-separator))
|
|
|
|
|
(string-equal (substring ver 0 (length version-separator))
|
2007-04-09 23:10:00 +00:00
|
|
|
|
version-separator))
|
2005-12-12 14:23:06 +00:00
|
|
|
|
(setq ver (concat "0" ver)))
|
2015-12-05 09:32:01 +00:00
|
|
|
|
(unless (string-match-p "^[0-9]" ver)
|
|
|
|
|
(error "Invalid version syntax: `%s' (must start with a number)" ver))
|
|
|
|
|
|
2005-08-25 01:37:47 +00:00
|
|
|
|
(save-match-data
|
|
|
|
|
(let ((i 0)
|
2005-09-24 10:41:18 +00:00
|
|
|
|
(case-fold-search t) ; ignore case in matching
|
2005-08-25 01:37:47 +00:00
|
|
|
|
lst s al)
|
2015-12-05 09:32:01 +00:00
|
|
|
|
;; Parse the version-string up to a separator until there are none left
|
2005-08-25 01:37:47 +00:00
|
|
|
|
(while (and (setq s (string-match "[0-9]+" ver i))
|
|
|
|
|
(= s i))
|
2015-12-05 09:32:01 +00:00
|
|
|
|
;; Add the numeric part to the beginning of the version list;
|
|
|
|
|
;; lst gets reversed at the end
|
2005-08-25 01:37:47 +00:00
|
|
|
|
(setq lst (cons (string-to-number (substring ver i (match-end 0)))
|
|
|
|
|
lst)
|
|
|
|
|
i (match-end 0))
|
|
|
|
|
;; handle non-numeric part
|
|
|
|
|
(when (and (setq s (string-match "[^0-9]+" ver i))
|
|
|
|
|
(= s i))
|
|
|
|
|
(setq s (substring ver i (match-end 0))
|
|
|
|
|
i (match-end 0))
|
|
|
|
|
;; handle alpha, beta, pre, etc. separator
|
|
|
|
|
(unless (string= s version-separator)
|
|
|
|
|
(setq al version-regexp-alist)
|
|
|
|
|
(while (and al (not (string-match (caar al) s)))
|
|
|
|
|
(setq al (cdr al)))
|
2010-08-29 01:31:45 +00:00
|
|
|
|
(cond (al
|
|
|
|
|
(push (cdar al) lst))
|
2015-12-05 09:32:01 +00:00
|
|
|
|
;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc., but only if
|
|
|
|
|
;; the letter is the end of the version-string, to avoid
|
|
|
|
|
;; 22.8X3 being valid
|
|
|
|
|
((and (string-match "^[-._+ ]?\\([a-zA-Z]\\)$" s)
|
|
|
|
|
(= i (length ver)))
|
2010-08-29 01:31:45 +00:00
|
|
|
|
(push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
|
|
|
|
|
lst))
|
Go back to grave quoting in source-code docstrings etc.
This reverts almost all my recent changes to use curved quotes
in docstrings and/or strings used for error diagnostics.
There are a few exceptions, e.g., Bahá’í proper names.
* admin/unidata/unidata-gen.el (unidata-gen-table):
* lisp/abbrev.el (expand-region-abbrevs):
* lisp/align.el (align-region):
* lisp/allout.el (allout-mode, allout-solicit-alternate-bullet)
(outlineify-sticky):
* lisp/apropos.el (apropos-library):
* lisp/bookmark.el (bookmark-default-annotation-text):
* lisp/button.el (button-category-symbol, button-put)
(make-text-button):
* lisp/calc/calc-aent.el (math-read-if, math-read-factor):
* lisp/calc/calc-embed.el (calc-do-embedded):
* lisp/calc/calc-ext.el (calc-user-function-list):
* lisp/calc/calc-graph.el (calc-graph-show-dumb):
* lisp/calc/calc-help.el (calc-describe-key)
(calc-describe-thing, calc-full-help):
* lisp/calc/calc-lang.el (calc-c-language)
(math-parse-fortran-vector-end, math-parse-tex-sum)
(math-parse-eqn-matrix, math-parse-eqn-prime)
(calc-yacas-language, calc-maxima-language, calc-giac-language)
(math-read-giac-subscr, math-read-math-subscr)
(math-read-big-rec, math-read-big-balance):
* lisp/calc/calc-misc.el (calc-help, report-calc-bug):
* lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes)
(calc-auto-recompute):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-read-parse-table-part, calc-user-define-invocation)
(math-do-arg-check):
* lisp/calc/calc-store.el (calc-edit-variable):
* lisp/calc/calc-units.el (math-build-units-table-buffer):
* lisp/calc/calc-vec.el (math-read-brackets):
* lisp/calc/calc-yank.el (calc-edit-mode):
* lisp/calc/calc.el (calc, calc-do, calc-user-invocation):
* lisp/calendar/appt.el (appt-display-message):
* lisp/calendar/diary-lib.el (diary-check-diary-file)
(diary-mail-entries, diary-from-outlook):
* lisp/calendar/icalendar.el (icalendar-export-region)
(icalendar--convert-float-to-ical)
(icalendar--convert-date-to-ical)
(icalendar--convert-ical-to-diary)
(icalendar--convert-recurring-to-diary)
(icalendar--add-diary-entry):
* lisp/calendar/time-date.el (format-seconds):
* lisp/calendar/timeclock.el (timeclock-mode-line-display)
(timeclock-make-hours-explicit, timeclock-log-data):
* lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category)
(todo-item-mark, todo-check-format)
(todo-insert-item--next-param, todo-edit-item--next-key)
(todo-mode):
* lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules):
* lisp/cedet/mode-local.el (describe-mode-local-overload)
(mode-local-print-binding, mode-local-describe-bindings-2):
* lisp/cedet/semantic/complete.el (semantic-displayor-show-request):
* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-start.el (standard):
* lisp/cus-theme.el (describe-theme-1):
* lisp/custom.el (custom-add-dependencies, custom-check-theme)
(custom--sort-vars-1, load-theme):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log):
* lisp/emacs-lisp/advice.el (ad-read-advised-function)
(ad-read-advice-class, ad-read-advice-name, ad-enable-advice)
(ad-disable-advice, ad-remove-advice, ad-set-argument)
(ad-set-arguments, ad--defalias-fset, ad-activate)
(ad-deactivate):
* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand)
(byte-compile-unfold-lambda, byte-optimize-form-code-walker)
(byte-optimize-while, byte-optimize-apply):
* lisp/emacs-lisp/byte-run.el (defun, defsubst):
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode)
(byte-compile-log-file, byte-compile-format-warn)
(byte-compile-nogroup-warn, byte-compile-arglist-warn)
(byte-compile-cl-warn)
(byte-compile-warn-about-unresolved-functions)
(byte-compile-file, byte-compile--declare-var)
(byte-compile-file-form-defmumble, byte-compile-form)
(byte-compile-normal-call, byte-compile-check-variable)
(byte-compile-variable-ref, byte-compile-variable-set)
(byte-compile-subr-wrong-args, byte-compile-setq-default)
(byte-compile-negation-optimizer)
(byte-compile-condition-case--old)
(byte-compile-condition-case--new, byte-compile-save-excursion)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form)
(byte-compile-make-variable-buffer-local, display-call-tree)
(batch-byte-compile):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use):
* lisp/emacs-lisp/chart.el (chart-space-usage):
* lisp/emacs-lisp/check-declare.el (check-declare-scan)
(check-declare-warn, check-declare-file)
(check-declare-directory):
* lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine)
(checkdoc-message-text-engine):
* lisp/emacs-lisp/cl-extra.el (cl-parse-integer)
(cl--describe-class):
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric)
(cl--generic-describe, cl-generic-generalizers):
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody)
(cl-symbol-macrolet):
* lisp/emacs-lisp/cl.el (cl-unload-function, flet):
* lisp/emacs-lisp/copyright.el (copyright)
(copyright-update-directory):
* lisp/emacs-lisp/edebug.el (edebug-read-list):
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-read):
* lisp/emacs-lisp/eieio-core.el (eieio--slot-override)
(eieio-oref):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor):
* lisp/emacs-lisp/eieio-speedbar.el:
(eieio-speedbar-child-make-tag-lines)
(eieio-speedbar-child-description):
* lisp/emacs-lisp/eieio.el (defclass, change-class):
* lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms)
(elint-init-form, elint-check-defalias-form)
(elint-check-let-form):
* lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu)
(ert-results-pop-to-backtrace-for-test-at-point)
(ert-results-pop-to-messages-for-test-at-point)
(ert-results-pop-to-should-forms-for-test-at-point)
(ert-describe-test):
* lisp/emacs-lisp/find-func.el (find-function-search-for-symbol)
(find-function-library):
* lisp/emacs-lisp/generator.el (iter-yield):
* lisp/emacs-lisp/gv.el (gv-define-simple-setter):
* lisp/emacs-lisp/lisp-mnt.el (lm-verify):
* lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning):
* lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
* lisp/emacs-lisp/nadvice.el (advice--make-docstring)
(advice--make, define-advice):
* lisp/emacs-lisp/package-x.el (package-upload-file):
* lisp/emacs-lisp/package.el (package-version-join)
(package-disabled-p, package-activate-1, package-activate)
(package--download-one-archive)
(package--download-and-read-archives)
(package-compute-transaction, package-install-from-archive)
(package-install, package-install-selected-packages)
(package-delete, package-autoremove, describe-package-1)
(package-install-button-action, package-delete-button-action)
(package-menu-hide-package, package-menu--list-to-prompt)
(package-menu--perform-transaction)
(package-menu--find-and-notify-upgrades):
* lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1):
* lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode):
* lisp/emacs-lisp/ring.el (ring-previous, ring-next):
* lisp/emacs-lisp/rx.el (rx-check, rx-anything)
(rx-check-any-string, rx-check-any, rx-check-not, rx-=)
(rx-repeat, rx-check-backref, rx-syntax, rx-check-category)
(rx-form):
* lisp/emacs-lisp/smie.el (smie-config-save):
* lisp/emacs-lisp/subr-x.el (internal--check-binding):
* lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag):
* lisp/emacs-lisp/testcover.el (testcover-1value):
* lisp/emacs-lisp/timer.el (timer-event-handler):
* lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments)
(viper-toggle-search-style, viper-kill-buffer)
(viper-brac-function):
* lisp/emulation/viper-macs.el (viper-record-kbd-macro):
* lisp/env.el (setenv):
* lisp/erc/erc-button.el (erc-nick-popup):
* lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english):
* lisp/eshell/em-dirs.el (eshell/cd):
* lisp/eshell/em-glob.el (eshell-glob-regexp)
(eshell-glob-entries):
* lisp/eshell/em-pred.el (eshell-parse-modifiers):
* lisp/eshell/esh-opt.el (eshell-show-usage):
* lisp/facemenu.el (facemenu-add-new-face)
(facemenu-add-new-color):
* lisp/faces.el (read-face-name, read-face-font, describe-face)
(x-resolve-font-name):
* lisp/files-x.el (modify-file-local-variable):
* lisp/files.el (locate-user-emacs-file, find-alternate-file)
(set-auto-mode, hack-one-local-variable--obsolete)
(dir-locals-set-directory-class, write-file, basic-save-buffer)
(delete-directory, copy-directory, recover-session)
(recover-session-finish, insert-directory)
(file-modes-char-to-who, file-modes-symbolic-to-number)
(move-file-to-trash):
* lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer):
* lisp/find-cmd.el (find-generic, find-to-string):
* lisp/finder.el (finder-commentary):
* lisp/font-lock.el (font-lock-fontify-buffer):
* lisp/format.el (format-write-file, format-find-file)
(format-insert-file):
* lisp/frame.el (get-device-terminal, select-frame-by-name):
* lisp/fringe.el (fringe--check-style):
* lisp/gnus/nnmairix.el (nnmairix-widget-create-query):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--parent-mode)
(help-fns--obsolete, help-fns--interactive-only)
(describe-function-1, describe-variable):
* lisp/help.el (describe-mode)
(describe-minor-mode-from-indicator):
* lisp/image.el (image-type):
* lisp/international/ccl.el (ccl-dump):
* lisp/international/fontset.el (x-must-resolve-font-name):
* lisp/international/mule-cmds.el (prefer-coding-system)
(select-safe-coding-system-interactively)
(select-safe-coding-system, activate-input-method)
(toggle-input-method, describe-current-input-method)
(describe-language-environment):
* lisp/international/mule-conf.el (code-offset):
* lisp/international/mule-diag.el (describe-character-set)
(list-input-methods-1):
* lisp/mail/feedmail.el (feedmail-run-the-queue):
* lisp/mouse.el (minor-mode-menu-from-indicator):
* lisp/mpc.el (mpc-playlist-rename):
* lisp/msb.el (msb--choose-menu):
* lisp/net/ange-ftp.el (ange-ftp-shell-command):
* lisp/net/imap.el (imap-interactive-login):
* lisp/net/mairix.el (mairix-widget-create-query):
* lisp/net/newst-backend.el (newsticker--sentinel-work):
* lisp/net/newst-treeview.el (newsticker--treeview-load):
* lisp/net/rlogin.el (rlogin):
* lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer):
* lisp/obsolete/otodo-mode.el (todo-more-important-p):
* lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region):
* lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region):
* lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region):
* lisp/org/ob-core.el (org-babel-goto-named-src-block)
(org-babel-goto-named-result):
* lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap):
* lisp/org/ob-ref.el (org-babel-ref-resolve):
* lisp/org/org-agenda.el (org-agenda-prepare):
* lisp/org/org-clock.el (org-clock-notify-once-if-expired)
(org-clock-resolve):
* lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag):
* lisp/org/org-feed.el (org-feed-parse-atom-entry):
* lisp/org/org-habit.el (org-habit-parse-todo):
* lisp/org/org-mouse.el (org-mouse-popup-global-menu)
(org-mouse-context-menu):
* lisp/org/org-table.el (org-table-edit-formulas):
* lisp/org/ox.el (org-export-async-start):
* lisp/proced.el (proced-log):
* lisp/progmodes/ada-mode.el (ada-get-indent-case)
(ada-check-matching-start, ada-goto-matching-start):
* lisp/progmodes/ada-prj.el (ada-prj-display-page):
* lisp/progmodes/ada-xref.el (ada-find-executable):
* lisp/progmodes/ebrowse.el (ebrowse-tags-apropos):
* lisp/progmodes/etags.el (etags-tags-apropos-additional):
* lisp/progmodes/flymake.el (flymake-parse-err-lines)
(flymake-start-syntax-check-process):
* lisp/progmodes/python.el (python-shell-get-process-or-error)
(python-define-auxiliary-skeleton):
* lisp/progmodes/sql.el (sql-comint):
* lisp/progmodes/verilog-mode.el (verilog-load-file-at-point):
* lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate):
* lisp/recentf.el (recentf-open-files):
* lisp/replace.el (query-replace-read-from)
(occur-after-change-function, occur-1):
* lisp/scroll-bar.el (scroll-bar-columns):
* lisp/server.el (server-get-auth-key):
* lisp/simple.el (execute-extended-command)
(undo-outer-limit-truncate, list-processes--refresh)
(compose-mail, set-variable, choose-completion-string)
(define-alternatives):
* lisp/startup.el (site-run-file, tty-handle-args, command-line)
(command-line-1):
* lisp/subr.el (noreturn, define-error, add-to-list)
(read-char-choice, version-to-list):
* lisp/term/common-win.el (x-handle-xrm-switch)
(x-handle-name-switch, x-handle-args):
* lisp/term/x-win.el (x-handle-parent-id, x-handle-smid):
* lisp/textmodes/reftex-ref.el (reftex-label):
* lisp/textmodes/reftex-toc.el (reftex-toc-rename-label):
* lisp/textmodes/two-column.el (2C-split):
* lisp/tutorial.el (tutorial--describe-nonstandard-key)
(tutorial--find-changed-keys):
* lisp/type-break.el (type-break-noninteractive-query):
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
* lisp/whitespace.el (whitespace-report-region):
Prefer grave quoting in source-code strings used to generate help
and diagnostics.
* lisp/faces.el (face-documentation):
No need to convert quotes, since the result is a docstring.
* lisp/info.el (Info-virtual-index-find-node)
(Info-virtual-index, info-apropos):
Simplify by generating only curved quotes, since info files are
typically that ways nowadays anyway.
* lisp/international/mule-diag.el (list-input-methods):
Don’t assume text quoting style is curved.
* lisp/org/org-bibtex.el (org-bibtex-fields):
Revert my recent changes, going back to the old quoting style.
2015-09-07 15:41:44 +00:00
|
|
|
|
(t (error "Invalid version syntax: `%s'" ver))))))
|
2015-12-05 09:32:01 +00:00
|
|
|
|
(nreverse lst))))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(defun version-list-< (l1 l2)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Return t if L1, a list specification of a version, is lower than L2.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
Note that a version specified by the list (1) is equal to (1 0),
|
|
|
|
|
\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
|
|
|
|
|
Also, a version given by the list (1) is higher than (1 -1), which in
|
|
|
|
|
turn is higher than (1 -2), which is higher than (1 -3)."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
(while (and l1 l2 (= (car l1) (car l2)))
|
|
|
|
|
(setq l1 (cdr l1)
|
|
|
|
|
l2 (cdr l2)))
|
|
|
|
|
(cond
|
|
|
|
|
;; l1 not null and l2 not null
|
|
|
|
|
((and l1 l2) (< (car l1) (car l2)))
|
|
|
|
|
;; l1 null and l2 null ==> l1 length = l2 length
|
|
|
|
|
((and (null l1) (null l2)) nil)
|
|
|
|
|
;; l1 not null and l2 null ==> l1 length > l2 length
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(l1 (< (version-list-not-zero l1) 0))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
;; l1 null and l2 not null ==> l2 length > l1 length
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(t (< 0 (version-list-not-zero l2)))))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(defun version-list-= (l1 l2)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Return t if L1, a list specification of a version, is equal to L2.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
Note that a version specified by the list (1) is equal to (1 0),
|
|
|
|
|
\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
|
|
|
|
|
Also, a version given by the list (1) is higher than (1 -1), which in
|
|
|
|
|
turn is higher than (1 -2), which is higher than (1 -3)."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
(while (and l1 l2 (= (car l1) (car l2)))
|
|
|
|
|
(setq l1 (cdr l1)
|
|
|
|
|
l2 (cdr l2)))
|
|
|
|
|
(cond
|
|
|
|
|
;; l1 not null and l2 not null
|
|
|
|
|
((and l1 l2) nil)
|
|
|
|
|
;; l1 null and l2 null ==> l1 length = l2 length
|
|
|
|
|
((and (null l1) (null l2)))
|
|
|
|
|
;; l1 not null and l2 null ==> l1 length > l2 length
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(l1 (zerop (version-list-not-zero l1)))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
;; l1 null and l2 not null ==> l2 length > l1 length
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(t (zerop (version-list-not-zero l2)))))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(defun version-list-<= (l1 l2)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Return t if L1, a list specification of a version, is lower or equal to L2.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
|
2010-11-02 01:50:22 +00:00
|
|
|
|
etc. That is, the trailing zeroes are insignificant. Also, integer
|
2005-08-25 01:37:47 +00:00
|
|
|
|
list (1) is greater than (1 -1) which is greater than (1 -2)
|
|
|
|
|
which is greater than (1 -3)."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
(while (and l1 l2 (= (car l1) (car l2)))
|
|
|
|
|
(setq l1 (cdr l1)
|
|
|
|
|
l2 (cdr l2)))
|
|
|
|
|
(cond
|
|
|
|
|
;; l1 not null and l2 not null
|
|
|
|
|
((and l1 l2) (< (car l1) (car l2)))
|
|
|
|
|
;; l1 null and l2 null ==> l1 length = l2 length
|
|
|
|
|
((and (null l1) (null l2)))
|
|
|
|
|
;; l1 not null and l2 null ==> l1 length > l2 length
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(l1 (<= (version-list-not-zero l1) 0))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
;; l1 null and l2 not null ==> l2 length > l1 length
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(t (<= 0 (version-list-not-zero l2)))))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(defun version-list-not-zero (lst)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Return the first non-zero element of LST, which is a list of integers.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2010-03-27 12:31:04 +00:00
|
|
|
|
If all LST elements are zeros or LST is nil, return zero."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (pure t) (side-effect-free t))
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(while (and lst (zerop (car lst)))
|
|
|
|
|
(setq lst (cdr lst)))
|
|
|
|
|
(if lst
|
|
|
|
|
(car lst)
|
|
|
|
|
;; there is no element different of zero
|
|
|
|
|
0))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun version< (v1 v2)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Return t if version V1 is lower (older) than V2.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
|
2010-03-27 12:31:04 +00:00
|
|
|
|
etc. That is, the trailing \".0\"s are insignificant. Also, version
|
|
|
|
|
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
|
2013-11-04 14:09:36 +00:00
|
|
|
|
which is higher than \"1alpha\", which is higher than \"1snapshot\".
|
|
|
|
|
Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(version-list-< (version-to-list v1) (version-to-list v2)))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
(defun version<= (v1 v2)
|
2010-03-27 12:31:04 +00:00
|
|
|
|
"Return t if version V1 is lower (older) than or equal to V2.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
|
|
|
|
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
|
2010-11-02 01:50:22 +00:00
|
|
|
|
etc. That is, the trailing \".0\"s are insignificant. Also, version
|
2010-03-27 12:31:04 +00:00
|
|
|
|
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
|
2013-11-04 14:09:36 +00:00
|
|
|
|
which is higher than \"1alpha\", which is higher than \"1snapshot\".
|
|
|
|
|
Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(version-list-<= (version-to-list v1) (version-to-list v2)))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(defun version= (v1 v2)
|
|
|
|
|
"Return t if version V1 is equal to V2.
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2005-08-26 12:31:55 +00:00
|
|
|
|
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
|
2010-11-02 01:50:22 +00:00
|
|
|
|
etc. That is, the trailing \".0\"s are insignificant. Also, version
|
2010-03-27 12:31:04 +00:00
|
|
|
|
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
|
2013-11-04 14:09:36 +00:00
|
|
|
|
which is higher than \"1alpha\", which is higher than \"1snapshot\".
|
|
|
|
|
Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2005-08-26 12:31:55 +00:00
|
|
|
|
(version-list-= (version-to-list v1) (version-to-list v2)))
|
2005-08-25 01:37:47 +00:00
|
|
|
|
|
2014-10-01 22:13:11 +00:00
|
|
|
|
(defvar package--builtin-versions
|
2022-08-04 14:41:39 +00:00
|
|
|
|
;; Mostly populated by loaddefs.el.
|
2014-10-01 22:13:11 +00:00
|
|
|
|
(purecopy `((emacs . ,(version-to-list emacs-version))))
|
|
|
|
|
"Alist giving the version of each versioned builtin package.
|
|
|
|
|
I.e. each element of the list is of the form (NAME . VERSION) where
|
|
|
|
|
NAME is the package name as a symbol, and VERSION is its version
|
|
|
|
|
as a list.")
|
|
|
|
|
|
|
|
|
|
(defun package--description-file (dir)
|
2019-09-22 00:21:54 +00:00
|
|
|
|
"Return package description file name for package DIR."
|
2014-10-01 22:13:11 +00:00
|
|
|
|
(concat (let ((subdir (file-name-nondirectory
|
|
|
|
|
(directory-file-name dir))))
|
|
|
|
|
(if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
|
|
|
|
|
(match-string 1 subdir) subdir))
|
|
|
|
|
"-pkg.el"))
|
|
|
|
|
|
2012-08-20 13:56:02 +00:00
|
|
|
|
|
|
|
|
|
;;; Thread support.
|
|
|
|
|
|
|
|
|
|
(defmacro with-mutex (mutex &rest body)
|
|
|
|
|
"Invoke BODY with MUTEX held, releasing MUTEX when done.
|
|
|
|
|
This is the simplest safe way to acquire and release a mutex."
|
|
|
|
|
(declare (indent 1) (debug t))
|
|
|
|
|
(let ((sym (make-symbol "mutex")))
|
|
|
|
|
`(let ((,sym ,mutex))
|
|
|
|
|
(mutex-lock ,sym)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn ,@body)
|
|
|
|
|
(mutex-unlock ,sym)))))
|
|
|
|
|
|
2020-12-19 18:54:46 +00:00
|
|
|
|
|
|
|
|
|
;;; Apropos.
|
|
|
|
|
|
|
|
|
|
(defun apropos-internal (regexp &optional predicate)
|
|
|
|
|
"Show all symbols whose names contain match for REGEXP.
|
|
|
|
|
If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
|
|
|
|
|
for each symbol and a symbol is mentioned only if that returns non-nil.
|
|
|
|
|
Return list of symbols found."
|
|
|
|
|
(let (found)
|
|
|
|
|
(mapatoms (lambda (symbol)
|
|
|
|
|
(when (and (string-match regexp (symbol-name symbol))
|
|
|
|
|
(or (not predicate)
|
|
|
|
|
(funcall predicate symbol)))
|
|
|
|
|
(push symbol found))))
|
|
|
|
|
(sort found #'string-lessp)))
|
|
|
|
|
|
2009-08-09 02:57:45 +00:00
|
|
|
|
|
|
|
|
|
;;; Misc.
|
2016-05-26 02:58:18 +00:00
|
|
|
|
|
|
|
|
|
(defvar definition-prefixes (make-hash-table :test 'equal)
|
|
|
|
|
"Hash table mapping prefixes to the files in which they're used.
|
2016-05-27 16:33:57 +00:00
|
|
|
|
This can be used to automatically fetch not-yet-loaded definitions.
|
2019-06-10 21:47:01 +00:00
|
|
|
|
More specifically, if there is a value of the form (FILES...) for
|
|
|
|
|
a string PREFIX it means that the FILES define variables or functions
|
|
|
|
|
with names that start with PREFIX.
|
2016-05-27 16:33:57 +00:00
|
|
|
|
|
|
|
|
|
Note that it does not imply that all definitions starting with PREFIX can
|
|
|
|
|
be found in those files. E.g. if prefix is \"gnus-article-\" there might
|
2019-06-10 21:47:01 +00:00
|
|
|
|
still be definitions of the form \"gnus-article-toto-titi\" in other files,
|
|
|
|
|
which would presumably appear in this table under another prefix such as
|
|
|
|
|
\"gnus-\" or \"gnus-article-toto-\".")
|
2016-05-26 02:58:18 +00:00
|
|
|
|
|
|
|
|
|
(defun register-definition-prefixes (file prefixes)
|
|
|
|
|
"Register that FILE uses PREFIXES."
|
|
|
|
|
(dolist (prefix prefixes)
|
|
|
|
|
(puthash prefix (cons file (gethash prefix definition-prefixes))
|
|
|
|
|
definition-prefixes)))
|
|
|
|
|
|
2009-11-11 05:57:51 +00:00
|
|
|
|
(defconst menu-bar-separator '("--")
|
|
|
|
|
"Separator for menus.")
|
2009-08-09 02:57:45 +00:00
|
|
|
|
|
|
|
|
|
;; The following statement ought to be in print.c, but `provide' can't
|
|
|
|
|
;; be used there.
|
2017-11-26 06:45:41 +00:00
|
|
|
|
;; https://lists.gnu.org/r/emacs-devel/2009-08/msg00236.html
|
2009-08-09 02:57:45 +00:00
|
|
|
|
(when (hash-table-p (car (read-from-string
|
|
|
|
|
(prin1-to-string (make-hash-table)))))
|
|
|
|
|
(provide 'hashtable-print-readable))
|
|
|
|
|
|
2013-05-16 10:14:30 +00:00
|
|
|
|
;; This is used in lisp/Makefile.in and in leim/Makefile.in to
|
|
|
|
|
;; generate file names for autoloads, custom-deps, and finder-data.
|
2013-05-25 16:05:19 +00:00
|
|
|
|
(defun unmsys--file-name (file)
|
2013-05-25 07:19:50 +00:00
|
|
|
|
"Produce the canonical file name for FILE from its MSYS form.
|
2013-04-19 08:42:34 +00:00
|
|
|
|
|
|
|
|
|
On systems other than MS-Windows, just returns FILE.
|
|
|
|
|
On MS-Windows, converts /d/foo/bar form of file names
|
|
|
|
|
passed by MSYS Make into d:/foo/bar that Emacs can grok.
|
|
|
|
|
|
2013-05-25 07:19:50 +00:00
|
|
|
|
This function is called from lisp/Makefile and leim/Makefile."
|
2013-04-19 08:42:34 +00:00
|
|
|
|
(when (and (eq system-type 'windows-nt)
|
|
|
|
|
(string-match "\\`/[a-zA-Z]/" file))
|
|
|
|
|
(setq file (concat (substring file 1 2) ":" (substring file 2))))
|
|
|
|
|
file)
|
|
|
|
|
|
New function flatten-tree
Co-authored-by: Basil L. Contovounesios <contovob@tcd.ie>
* doc/lispref/lists.texi: Document `flatten-tree'.
* lisp/progmodes/js.el (js--maybe-join):
* lisp/printing.el (pr-switches):
* lisp/lpr.el (lpr-print-region):
* lisp/gnus/nnimap.el (nnimap-find-wanted-parts):
* lisp/gnus/message.el (message-talkative-question):
* lisp/gnus/gnus-sum.el (gnus-remove-thread)
(gnus-thread-highest-number, gnus-thread-latest-date):
* lisp/eshell/esh-util.el (eshell-flatten-and-stringify):
* lisp/eshell/esh-opt.el (eshell-eval-using-options):
* lisp/eshell/esh-ext.el (eshell-external-command):
* lisp/eshell/em-xtra.el (eshell/expr):
* lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template)
(eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep)
(eshell/du, eshell/time, eshell/diff, eshell/locate):
* lisp/eshell/em-tramp.el (eshell/su, eshell/sudo):
* lisp/eshell/em-term.el (eshell-exec-visual):
* lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd):
* lisp/eshell/em-basic.el (eshell/printnl):
Use new flatten-tree.
* lisp/progmodes/js.el (js--flatten-list):
* lisp/lpr.el (lpr-flatten-list):
* lisp/gnus/message.el (message-flatten-list):
* lisp/eshell/esh-util.el (eshell-flatten-list):
Obsolete in favor of Emacs-wide `flatten-tree'.
* lisp/subr.el (flatten-list): Alias to `flatten-tree' for
discoverability.
* lisp/subr.el (flatten-tree): New defun.
* test/lisp/subr-tests.el (subr-tests-flatten-tree): New test.
2018-12-17 11:15:09 +00:00
|
|
|
|
(defun flatten-tree (tree)
|
2018-12-17 17:55:06 +00:00
|
|
|
|
"Return a \"flattened\" copy of TREE.
|
|
|
|
|
In other words, return a list of the non-nil terminal nodes, or
|
|
|
|
|
leaves, of the tree of cons cells rooted at TREE. Leaves in the
|
|
|
|
|
returned list are in the same order as in TREE.
|
New function flatten-tree
Co-authored-by: Basil L. Contovounesios <contovob@tcd.ie>
* doc/lispref/lists.texi: Document `flatten-tree'.
* lisp/progmodes/js.el (js--maybe-join):
* lisp/printing.el (pr-switches):
* lisp/lpr.el (lpr-print-region):
* lisp/gnus/nnimap.el (nnimap-find-wanted-parts):
* lisp/gnus/message.el (message-talkative-question):
* lisp/gnus/gnus-sum.el (gnus-remove-thread)
(gnus-thread-highest-number, gnus-thread-latest-date):
* lisp/eshell/esh-util.el (eshell-flatten-and-stringify):
* lisp/eshell/esh-opt.el (eshell-eval-using-options):
* lisp/eshell/esh-ext.el (eshell-external-command):
* lisp/eshell/em-xtra.el (eshell/expr):
* lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template)
(eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep)
(eshell/du, eshell/time, eshell/diff, eshell/locate):
* lisp/eshell/em-tramp.el (eshell/su, eshell/sudo):
* lisp/eshell/em-term.el (eshell-exec-visual):
* lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd):
* lisp/eshell/em-basic.el (eshell/printnl):
Use new flatten-tree.
* lisp/progmodes/js.el (js--flatten-list):
* lisp/lpr.el (lpr-flatten-list):
* lisp/gnus/message.el (message-flatten-list):
* lisp/eshell/esh-util.el (eshell-flatten-list):
Obsolete in favor of Emacs-wide `flatten-tree'.
* lisp/subr.el (flatten-list): Alias to `flatten-tree' for
discoverability.
* lisp/subr.el (flatten-tree): New defun.
* test/lisp/subr-tests.el (subr-tests-flatten-tree): New test.
2018-12-17 11:15:09 +00:00
|
|
|
|
|
|
|
|
|
\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
|
2018-12-17 17:55:06 +00:00
|
|
|
|
=> (1 2 3 4 5 6 7)"
|
Add some `pure` and `side-effect-free` declarations
* lisp/subr.el (string-to-list, string-to-vector, string-or-null-p)
(booleanp, special-form-p, plistp, macrop, compiled-function-p)
(flatten-tree):
* lisp/emacs-lisp/subr-x.el (string-join, string-truncate-left)
(string-blank-p, string-remove-prefix, string-remove-suffix)
(string-pad, string-chop-newline):
Declare functions pure, side-effect-free, and/or error-free.
2023-02-15 11:01:25 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2018-12-17 17:54:14 +00:00
|
|
|
|
(let (elems)
|
|
|
|
|
(while (consp tree)
|
|
|
|
|
(let ((elem (pop tree)))
|
|
|
|
|
(while (consp elem)
|
|
|
|
|
(push (cdr elem) tree)
|
|
|
|
|
(setq elem (car elem)))
|
|
|
|
|
(if elem (push elem elems))))
|
|
|
|
|
(if tree (push tree elems))
|
New function flatten-tree
Co-authored-by: Basil L. Contovounesios <contovob@tcd.ie>
* doc/lispref/lists.texi: Document `flatten-tree'.
* lisp/progmodes/js.el (js--maybe-join):
* lisp/printing.el (pr-switches):
* lisp/lpr.el (lpr-print-region):
* lisp/gnus/nnimap.el (nnimap-find-wanted-parts):
* lisp/gnus/message.el (message-talkative-question):
* lisp/gnus/gnus-sum.el (gnus-remove-thread)
(gnus-thread-highest-number, gnus-thread-latest-date):
* lisp/eshell/esh-util.el (eshell-flatten-and-stringify):
* lisp/eshell/esh-opt.el (eshell-eval-using-options):
* lisp/eshell/esh-ext.el (eshell-external-command):
* lisp/eshell/em-xtra.el (eshell/expr):
* lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template)
(eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep)
(eshell/du, eshell/time, eshell/diff, eshell/locate):
* lisp/eshell/em-tramp.el (eshell/su, eshell/sudo):
* lisp/eshell/em-term.el (eshell-exec-visual):
* lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd):
* lisp/eshell/em-basic.el (eshell/printnl):
Use new flatten-tree.
* lisp/progmodes/js.el (js--flatten-list):
* lisp/lpr.el (lpr-flatten-list):
* lisp/gnus/message.el (message-flatten-list):
* lisp/eshell/esh-util.el (eshell-flatten-list):
Obsolete in favor of Emacs-wide `flatten-tree'.
* lisp/subr.el (flatten-list): Alias to `flatten-tree' for
discoverability.
* lisp/subr.el (flatten-tree): New defun.
* test/lisp/subr-tests.el (subr-tests-flatten-tree): New test.
2018-12-17 11:15:09 +00:00
|
|
|
|
(nreverse elems)))
|
|
|
|
|
|
|
|
|
|
;; Technically, `flatten-list' is a misnomer, but we provide it here
|
|
|
|
|
;; for discoverability:
|
2021-02-15 02:13:35 +00:00
|
|
|
|
(defalias 'flatten-list #'flatten-tree)
|
2013-04-19 08:42:34 +00:00
|
|
|
|
|
2021-03-24 08:22:40 +00:00
|
|
|
|
(defun string-trim-left (string &optional regexp)
|
|
|
|
|
"Trim STRING of leading string matching REGEXP.
|
|
|
|
|
|
|
|
|
|
REGEXP defaults to \"[ \\t\\n\\r]+\"."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2023-05-20 10:06:46 +00:00
|
|
|
|
(if (string-match (if regexp
|
|
|
|
|
(concat "\\`\\(?:" regexp "\\)")
|
|
|
|
|
"\\`[ \t\n\r]+")
|
|
|
|
|
string)
|
2021-03-24 08:22:40 +00:00
|
|
|
|
(substring string (match-end 0))
|
|
|
|
|
string))
|
|
|
|
|
|
|
|
|
|
(defun string-trim-right (string &optional regexp)
|
|
|
|
|
"Trim STRING of trailing string matching REGEXP.
|
|
|
|
|
|
|
|
|
|
REGEXP defaults to \"[ \\t\\n\\r]+\"."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2023-05-20 10:06:46 +00:00
|
|
|
|
(let ((i (string-match-p (if regexp
|
|
|
|
|
(concat "\\(?:" regexp "\\)\\'")
|
|
|
|
|
"[ \t\n\r]+\\'")
|
2021-03-24 08:22:40 +00:00
|
|
|
|
string)))
|
|
|
|
|
(if i (substring string 0 i) string)))
|
|
|
|
|
|
|
|
|
|
(defun string-trim (string &optional trim-left trim-right)
|
|
|
|
|
"Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT.
|
|
|
|
|
|
|
|
|
|
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
|
Add more function declarations
* lisp/subr.el (buffer-narrowed-p, sha1, match-substitute-replacement)
(version-to-list, version<, version<=, version=)
(function-get, subregexp-context-p, split-string)
(combine-and-quote-strings, split-string-and-unquote)
(replace-regexp-in-string, syntax-after)
(string-trim-left, string-trim):
* lisp/emacs-lisp/subr-x.el (hash-table-empty-p, hash-table-keys)
(hash-table-values, string-glyph-split)
(string-clean-whitespace, string-fill, string-limit)
(string-pixel-width):
* lisp/env.el (substitute-env-vars, substitute-env-in-file-name)
(setenv-internal):
* lisp/emacs-lisp/rx.el (rx-to-string):
* lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth)
(regexp-opt-charset):
Add appropriate declarations: pure, side-effect-free, and/or
important-return-value.
2023-05-26 10:28:15 +00:00
|
|
|
|
(declare (important-return-value t))
|
2021-03-24 08:22:40 +00:00
|
|
|
|
(string-trim-left (string-trim-right string trim-right) trim-left))
|
|
|
|
|
|
Add standard unmatchable regexp
Add `regexp-unmatchable' as a standard unmatchable regexp, defined as
"\\`a\\`". Use it where such a regexp is needed, replacing slower
expressions in several places.
From a suggestion by Philippe Schnoebelen.
* lisp/subr.el (regexp-unmatchable): New defconst.
* etc/NEWS (Lisp Changes): Mention `regexp-unmatchable'.
* doc/lispref/searching.texi (Regexp Functions): Document it.
* lisp/emacs-lisp/regexp-opt.el (regexp-opt)
* lisp/progmodes/cc-defs.el (cc-conditional-require-after-load)
(c-make-keywords-re)
* lisp/progmodes/cc-engine.el (c-beginning-of-statement-1)
(c-forward-<>-arglist-recur, c-forward-decl-or-cast-1)
(c-looking-at-decl-block)
* lisp/progmodes/cc-fonts.el (c-doc-line-join-re)
(c-doc-bright-comment-start-re)
* lisp/progmodes/cc-langs.el (c-populate-syntax-table)
(c-assignment-op-regexp)
(c-block-comment-ender-regexp, c-font-lock-comment-end-skip)
(c-block-comment-start-regexp, c-line-comment-start-regexp)
(c-doc-comment-start-regexp, c-decl-start-colon-kwd-re)
(c-type-decl-prefix-key, c-type-decl-operator-prefix-key)
(c-pre-id-bracelist-key, c-enum-clause-introduction-re)
(c-nonlabel-token-2-key)
* lisp/progmodes/cc-mode.el (c-doc-fl-decl-start, c-doc-fl-decl-end)
* lisp/progmodes/cc-vars.el (c-noise-macro-with-parens-name-re)
(c-noise-macro-name-re, c-make-noise-macro-regexps)
* lisp/progmodes/octave.el (octave-help-mode)
* lisp/vc/vc-bzr.el (vc-bzr-log-view-mode, vc-bzr-revision-completion-table)
* lisp/vc/vc-git.el (vc-git-log-view-mode)
* lisp/vc/vc-hg.el (vc-hg-log-view-mode)
* lisp/vc/vc-mtn.el (vc-mtn-log-view-mode):
Use `regexp-unmatchable'.
* lisp/textmodes/ispell.el (ispell-non-empty-string):
Use `regexp-unmatchable', fixing a broken never-match regexp.
2019-05-14 09:43:49 +00:00
|
|
|
|
;; The initial anchoring is for better performance in searching matches.
|
|
|
|
|
(defconst regexp-unmatchable "\\`a\\`"
|
|
|
|
|
"Standard regexp guaranteed not to match any string at all.")
|
|
|
|
|
|
2020-12-07 14:40:23 +00:00
|
|
|
|
(defun run-hook-query-error-with-timeout (hook)
|
|
|
|
|
"Run HOOK, catching errors, and querying the user about whether to continue.
|
|
|
|
|
If a function in HOOK signals an error, the user will be prompted
|
|
|
|
|
whether to continue or not. If the user doesn't respond,
|
|
|
|
|
evaluation will continue if the user doesn't respond within five
|
|
|
|
|
seconds."
|
|
|
|
|
(run-hook-wrapped
|
|
|
|
|
hook
|
|
|
|
|
(lambda (fun)
|
|
|
|
|
(condition-case err
|
|
|
|
|
(funcall fun)
|
|
|
|
|
(error
|
|
|
|
|
(unless (y-or-n-p-with-timeout (format "Error %s; continue?" err)
|
|
|
|
|
5 t)
|
|
|
|
|
(error err))))
|
|
|
|
|
;; Continue running.
|
|
|
|
|
nil)))
|
|
|
|
|
|
2020-12-10 21:36:18 +00:00
|
|
|
|
(defun internal--fill-string-single-line (str)
|
|
|
|
|
"Fill string STR to `fill-column'.
|
|
|
|
|
This is intended for very simple filling while bootstrapping
|
|
|
|
|
Emacs itself, and does not support all the customization options
|
|
|
|
|
of fill.el (for example `fill-region')."
|
2021-09-24 15:47:43 +00:00
|
|
|
|
(if (< (length str) fill-column)
|
2020-12-10 21:36:18 +00:00
|
|
|
|
str
|
2021-09-24 15:47:43 +00:00
|
|
|
|
(let* ((limit (min fill-column (length str)))
|
|
|
|
|
(fst (substring str 0 limit))
|
|
|
|
|
(lst (substring str limit)))
|
|
|
|
|
(cond ((string-match "\\( \\)$" fst)
|
|
|
|
|
(setq fst (replace-match "\n" nil nil fst 1)))
|
|
|
|
|
((string-match "^ \\(.*\\)" lst)
|
|
|
|
|
(setq fst (concat fst "\n"))
|
|
|
|
|
(setq lst (match-string 1 lst)))
|
|
|
|
|
((string-match ".*\\( \\(.+\\)\\)$" fst)
|
|
|
|
|
(setq lst (concat (match-string 2 fst) lst))
|
|
|
|
|
(setq fst (replace-match "\n" nil nil fst 1))))
|
2020-12-10 21:36:18 +00:00
|
|
|
|
(concat fst (internal--fill-string-single-line lst)))))
|
|
|
|
|
|
|
|
|
|
(defun internal--format-docstring-line (string &rest objects)
|
2021-09-28 11:30:02 +00:00
|
|
|
|
"Format a single line from a documentation string out of STRING and OBJECTS.
|
|
|
|
|
Signal an error if STRING contains a newline.
|
2021-10-02 19:56:22 +00:00
|
|
|
|
This is intended for internal use only. Avoid using this for the
|
|
|
|
|
first line of a docstring; the first line should be a complete
|
|
|
|
|
sentence (see Info node `(elisp) Documentation Tips')."
|
2021-09-28 11:30:02 +00:00
|
|
|
|
(when (string-match "\n" string)
|
|
|
|
|
(error "Unable to fill string containing newline: %S" string))
|
2020-12-10 21:36:18 +00:00
|
|
|
|
(internal--fill-string-single-line (apply #'format string objects)))
|
|
|
|
|
|
2021-07-21 10:49:11 +00:00
|
|
|
|
(defun json-available-p ()
|
2024-03-30 14:13:24 +00:00
|
|
|
|
"Return non-nil if Emacs has native JSON support."
|
|
|
|
|
t)
|
2021-07-21 10:49:11 +00:00
|
|
|
|
|
2021-09-21 18:30:57 +00:00
|
|
|
|
(defun ensure-list (object)
|
2021-09-21 18:51:38 +00:00
|
|
|
|
"Return OBJECT as a list.
|
|
|
|
|
If OBJECT is already a list, return OBJECT itself. If it's
|
|
|
|
|
not a list, return a one-element list containing OBJECT."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2021-09-21 18:30:57 +00:00
|
|
|
|
(if (listp object)
|
|
|
|
|
object
|
|
|
|
|
(list object)))
|
|
|
|
|
|
2021-10-25 15:10:34 +00:00
|
|
|
|
(defmacro with-delayed-message (args &rest body)
|
2021-10-24 20:20:19 +00:00
|
|
|
|
"Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds.
|
|
|
|
|
The MESSAGE form will be evaluated immediately, but the resulting
|
2021-10-25 15:10:34 +00:00
|
|
|
|
string will be displayed only if BODY takes longer than TIMEOUT seconds.
|
|
|
|
|
|
|
|
|
|
\(fn (timeout message) &rest body)"
|
|
|
|
|
(declare (indent 1))
|
|
|
|
|
`(funcall-with-delayed-message ,(car args) ,(cadr args)
|
2021-10-24 20:20:19 +00:00
|
|
|
|
(lambda ()
|
|
|
|
|
,@body)))
|
|
|
|
|
|
2023-02-20 14:23:12 +00:00
|
|
|
|
(defun function-alias-p (func &optional _noerror)
|
2022-01-13 08:38:47 +00:00
|
|
|
|
"Return nil if FUNC is not a function alias.
|
2023-02-20 14:23:12 +00:00
|
|
|
|
If FUNC is a function alias, return the function alias chain."
|
|
|
|
|
(declare (advertised-calling-convention (func) "30.1")
|
|
|
|
|
(side-effect-free error-free))
|
|
|
|
|
(let ((chain nil))
|
|
|
|
|
(while (and (symbolp func)
|
|
|
|
|
(setq func (symbol-function func))
|
|
|
|
|
(symbolp func))
|
|
|
|
|
(push func chain))
|
|
|
|
|
(nreverse chain)))
|
2022-01-13 08:38:47 +00:00
|
|
|
|
|
2022-01-22 14:11:17 +00:00
|
|
|
|
(defun readablep (object)
|
|
|
|
|
"Say whether OBJECT has a readable syntax.
|
|
|
|
|
This means that OBJECT can be printed out and then read back
|
|
|
|
|
again by the Lisp reader. This function returns nil if OBJECT is
|
|
|
|
|
unreadable, and the printed representation (from `prin1') of
|
|
|
|
|
OBJECT if it is readable."
|
2022-07-31 13:45:16 +00:00
|
|
|
|
(declare (side-effect-free error-free))
|
2022-01-22 14:11:17 +00:00
|
|
|
|
(catch 'unreadable
|
|
|
|
|
(let ((print-unreadable-function
|
|
|
|
|
(lambda (_object _escape)
|
|
|
|
|
(throw 'unreadable nil))))
|
|
|
|
|
(prin1-to-string object))))
|
|
|
|
|
|
2022-02-10 12:44:55 +00:00
|
|
|
|
(defun delete-line ()
|
|
|
|
|
"Delete the current line."
|
2022-08-21 16:13:00 +00:00
|
|
|
|
(delete-region (pos-bol) (pos-bol 2)))
|
2022-02-10 12:44:55 +00:00
|
|
|
|
|
2022-04-02 14:53:24 +00:00
|
|
|
|
(defun ensure-empty-lines (&optional lines)
|
|
|
|
|
"Ensure that there are LINES number of empty lines before point.
|
|
|
|
|
If LINES is nil or omitted, ensure that there is a single empty
|
|
|
|
|
line before point.
|
|
|
|
|
|
|
|
|
|
If called interactively, LINES is given by the prefix argument.
|
|
|
|
|
|
|
|
|
|
If there are more than LINES empty lines before point, the number
|
|
|
|
|
of empty lines is reduced to LINES.
|
|
|
|
|
|
|
|
|
|
If point is not at the beginning of a line, a newline character
|
|
|
|
|
is inserted before adjusting the number of empty lines."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(unless (bolp)
|
|
|
|
|
(insert "\n"))
|
|
|
|
|
(let ((lines (or lines 1))
|
|
|
|
|
(start (save-excursion
|
|
|
|
|
(if (re-search-backward "[^\n]" nil t)
|
|
|
|
|
(+ (point) 2)
|
|
|
|
|
(point-min)))))
|
|
|
|
|
(cond
|
|
|
|
|
((> (- (point) start) lines)
|
|
|
|
|
(delete-region (point) (- (point) (- (point) start lines))))
|
|
|
|
|
((< (- (point) start) lines)
|
|
|
|
|
(insert (make-string (- lines (- (point) start)) ?\n))))))
|
|
|
|
|
|
2022-04-30 10:46:40 +00:00
|
|
|
|
(defun string-lines (string &optional omit-nulls keep-newlines)
|
2022-04-02 14:53:24 +00:00
|
|
|
|
"Split STRING into a list of lines.
|
2022-04-30 10:46:40 +00:00
|
|
|
|
If OMIT-NULLS, empty lines will be removed from the results.
|
|
|
|
|
If KEEP-NEWLINES, don't strip trailing newlines from the result
|
|
|
|
|
lines."
|
2023-02-26 15:56:24 +00:00
|
|
|
|
(declare (side-effect-free t))
|
2022-05-01 21:05:06 +00:00
|
|
|
|
(if (equal string "")
|
2022-05-02 07:56:49 +00:00
|
|
|
|
(if omit-nulls
|
|
|
|
|
nil
|
|
|
|
|
(list ""))
|
2022-05-01 21:05:06 +00:00
|
|
|
|
(let ((lines nil)
|
|
|
|
|
(start 0))
|
|
|
|
|
(while (< start (length string))
|
|
|
|
|
(let ((newline (string-search "\n" string start)))
|
|
|
|
|
(if newline
|
|
|
|
|
(progn
|
|
|
|
|
(when (or (not omit-nulls)
|
|
|
|
|
(not (= start newline)))
|
|
|
|
|
(let ((line (substring string start
|
|
|
|
|
(if keep-newlines
|
|
|
|
|
(1+ newline)
|
|
|
|
|
newline))))
|
|
|
|
|
(when (not (and keep-newlines omit-nulls
|
|
|
|
|
(equal line "\n")))
|
|
|
|
|
(push line lines))))
|
|
|
|
|
(setq start (1+ newline)))
|
|
|
|
|
;; No newline in the remaining part.
|
|
|
|
|
(if (zerop start)
|
|
|
|
|
;; Avoid a string copy if there are no newlines at all.
|
|
|
|
|
(push string lines)
|
|
|
|
|
(push (substring string start) lines))
|
|
|
|
|
(setq start (length string)))))
|
|
|
|
|
(nreverse lines))))
|
2022-04-02 14:53:24 +00:00
|
|
|
|
|
2023-10-21 00:42:04 +00:00
|
|
|
|
(defvar buffer-match-p--past-warnings nil)
|
|
|
|
|
|
|
|
|
|
(defun buffer-match-p (condition buffer-or-name &rest args)
|
2022-03-07 19:49:42 +00:00
|
|
|
|
"Return non-nil if BUFFER-OR-NAME matches CONDITION.
|
|
|
|
|
CONDITION is either:
|
2022-07-30 11:16:12 +00:00
|
|
|
|
- the symbol t, to always match,
|
|
|
|
|
- the symbol nil, which never matches,
|
2022-03-07 19:49:42 +00:00
|
|
|
|
- a regular expression, to match a buffer name,
|
2023-10-21 00:42:04 +00:00
|
|
|
|
- a predicate function that takes BUFFER-OR-NAME plus ARGS as
|
2022-03-07 19:49:42 +00:00
|
|
|
|
arguments, and returns non-nil if the buffer matches,
|
|
|
|
|
- a cons-cell, where the car describes how to interpret the cdr.
|
|
|
|
|
The car can be one of the following:
|
2022-06-17 12:22:29 +00:00
|
|
|
|
* `derived-mode': the buffer matches if the buffer's major mode
|
|
|
|
|
is derived from the major mode in the cons-cell's cdr.
|
|
|
|
|
* `major-mode': the buffer matches if the buffer's major mode
|
|
|
|
|
is eq to the cons-cell's cdr. Prefer using `derived-mode'
|
|
|
|
|
instead when both can work.
|
2024-04-02 16:51:51 +00:00
|
|
|
|
* `category': the buffer matches a category as a symbol if
|
|
|
|
|
the caller of `display-buffer' provides `(category . symbol)'
|
|
|
|
|
in its action argument.
|
2022-12-31 14:04:18 +00:00
|
|
|
|
* `not': the cadr is interpreted as a negation of a condition.
|
2022-03-07 19:49:42 +00:00
|
|
|
|
* `and': the cdr is a list of recursive conditions, that all have
|
|
|
|
|
to be met.
|
|
|
|
|
* `or': the cdr is a list of recursive condition, of which at
|
|
|
|
|
least one has to be met."
|
|
|
|
|
(letrec
|
|
|
|
|
((buffer (get-buffer buffer-or-name))
|
|
|
|
|
(match
|
|
|
|
|
(lambda (conditions)
|
|
|
|
|
(catch 'match
|
|
|
|
|
(dolist (condition conditions)
|
2022-09-03 12:15:29 +00:00
|
|
|
|
(when (pcase condition
|
|
|
|
|
('t t)
|
|
|
|
|
((pred stringp)
|
|
|
|
|
(string-match-p condition (buffer-name buffer)))
|
|
|
|
|
((pred functionp)
|
2023-10-21 00:42:04 +00:00
|
|
|
|
(if (cdr args)
|
|
|
|
|
;; New in Emacs>29.1. no need for compatibility hack.
|
|
|
|
|
(apply condition buffer-or-name args)
|
|
|
|
|
(condition-case-unless-debug err
|
|
|
|
|
(apply condition buffer-or-name args)
|
|
|
|
|
(wrong-number-of-arguments
|
|
|
|
|
(unless (member condition
|
|
|
|
|
buffer-match-p--past-warnings)
|
|
|
|
|
(message "%s" (error-message-string err))
|
|
|
|
|
(push condition buffer-match-p--past-warnings))
|
|
|
|
|
(apply condition buffer-or-name
|
|
|
|
|
(if args nil '(nil)))))))
|
2024-04-02 16:51:51 +00:00
|
|
|
|
(`(category . ,category)
|
|
|
|
|
(eq (alist-get 'category (cdar args)) category))
|
2022-09-03 12:15:29 +00:00
|
|
|
|
(`(major-mode . ,mode)
|
|
|
|
|
(eq
|
|
|
|
|
(buffer-local-value 'major-mode buffer)
|
|
|
|
|
mode))
|
|
|
|
|
(`(derived-mode . ,mode)
|
|
|
|
|
(provided-mode-derived-p
|
|
|
|
|
(buffer-local-value 'major-mode buffer)
|
|
|
|
|
mode))
|
|
|
|
|
(`(not . ,cond)
|
|
|
|
|
(not (funcall match cond)))
|
|
|
|
|
(`(or . ,args)
|
|
|
|
|
(funcall match args))
|
|
|
|
|
(`(and . ,args)
|
|
|
|
|
(catch 'fail
|
|
|
|
|
(dolist (c args)
|
|
|
|
|
(unless (funcall match (list c))
|
|
|
|
|
(throw 'fail nil)))
|
|
|
|
|
t)))
|
2022-03-07 19:49:42 +00:00
|
|
|
|
(throw 'match t)))))))
|
|
|
|
|
(funcall match (list condition))))
|
|
|
|
|
|
2023-10-21 00:42:04 +00:00
|
|
|
|
(defun match-buffers (condition &optional buffers &rest args)
|
2023-04-10 09:30:23 +00:00
|
|
|
|
"Return a list of buffers that match CONDITION, or nil if none match.
|
|
|
|
|
See `buffer-match-p' for various supported CONDITIONs.
|
|
|
|
|
By default all buffers are checked, but the optional
|
|
|
|
|
argument BUFFERS can restrict that: its value should be
|
|
|
|
|
an explicit list of buffers to check.
|
2023-10-21 00:42:04 +00:00
|
|
|
|
Optional arguments ARGS are passed to `buffer-match-p', for
|
2023-04-10 09:30:23 +00:00
|
|
|
|
predicate conditions in CONDITION."
|
2022-03-07 19:49:42 +00:00
|
|
|
|
(let (bufs)
|
|
|
|
|
(dolist (buf (or buffers (buffer-list)))
|
2023-10-21 00:42:04 +00:00
|
|
|
|
(when (apply #'buffer-match-p condition (get-buffer buf) args)
|
2022-03-07 19:49:42 +00:00
|
|
|
|
(push buf bufs)))
|
|
|
|
|
bufs))
|
|
|
|
|
|
2023-12-26 03:32:17 +00:00
|
|
|
|
(defmacro handler-bind (handlers &rest body)
|
|
|
|
|
"Setup error HANDLERS around execution of BODY.
|
|
|
|
|
HANDLERS is a list of (CONDITIONS HANDLER) where
|
|
|
|
|
CONDITIONS should be a list of condition names (symbols) or
|
|
|
|
|
a single condition name, and HANDLER is a form whose evaluation
|
|
|
|
|
returns a function.
|
|
|
|
|
When an error is signaled during execution of BODY, if that
|
|
|
|
|
error matches CONDITIONS, then the associated HANDLER
|
|
|
|
|
function is called with the error object as argument.
|
|
|
|
|
HANDLERs can either transfer the control via a non-local exit,
|
|
|
|
|
or return normally. If a handler returns normally, the search for an
|
|
|
|
|
error handler continues from where it left off."
|
|
|
|
|
;; FIXME: Completion support as in `condition-case'?
|
|
|
|
|
(declare (indent 1) (debug ((&rest (sexp form)) body)))
|
|
|
|
|
(let ((args '()))
|
|
|
|
|
(dolist (cond+handler handlers)
|
|
|
|
|
(let ((handler (car (cdr cond+handler)))
|
|
|
|
|
(conds (car cond+handler)))
|
|
|
|
|
(push `',(ensure-list conds) args)
|
|
|
|
|
(push handler args)))
|
|
|
|
|
`(handler-bind-1 (lambda () ,@body) ,@(nreverse args))))
|
|
|
|
|
|
2022-06-24 08:54:01 +00:00
|
|
|
|
(defmacro with-memoization (place &rest code)
|
|
|
|
|
"Return the value of CODE and stash it in PLACE.
|
|
|
|
|
If PLACE's value is non-nil, then don't bother evaluating CODE
|
|
|
|
|
and return the value found in PLACE instead."
|
|
|
|
|
(declare (indent 1) (debug (gv-place body)))
|
|
|
|
|
(gv-letplace (getter setter) place
|
|
|
|
|
`(or ,getter
|
|
|
|
|
,(macroexp-let2 nil val (macroexp-progn code)
|
|
|
|
|
`(progn
|
|
|
|
|
,(funcall setter val)
|
|
|
|
|
,val)))))
|
|
|
|
|
|
1992-07-15 21:31:44 +00:00
|
|
|
|
;;; subr.el ends here
|