Emacs is linked. With LD_RUN_PATH set, the linker will include a
specified run-time search path in the executable.
-On some systems, Emacs can crash due to problems with dynamic
-linking. Specifically, on SGI Irix 6.5, crashes were reported with
-backtraces like this:
-
- (dbx) where
- 0 strcmp(0xf49239d, 0x4031184, 0x40302b4, 0x12, 0xf0000000, 0xf4923aa, 0x0, 0x492ddb2) ["/xlv22/ficus-jan23/work/irix/lib/libc/libc_n32_M3_ns/strings/strcmp.s":35, 0xfb7e480]
- 1 general_find_symbol(0xf49239d, 0x0, 0x0, 0x0, 0xf0000000, 0xf4923aa, 0x0, 0x492ddb2)
- ["/comp2/mtibuild/v73/workarea/v7.3/rld/rld.c":2140, 0xfb65a98]
- 2 resolve_symbol(0xf49239d, 0x4031184, 0x0, 0xfbdd438, 0x0, 0xf4923aa, 0x0, 0x492ddb2)
- ["/comp2/mtibuild/v73/workarea/v7.3/rld/rld.c":1947, 0xfb657e4]
- 3 lazy_text_resolve(0xd18, 0x1a3, 0x40302b4, 0x12, 0xf0000000, 0xf4923aa, 0x0, 0x492ddb2)
- ["/comp2/mtibuild/v73/workarea/v7.3/rld/rld.c":997, 0xfb64d44]
- 4 _rld_text_resolve(0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0)
- ["/comp2/mtibuild/v73/workarea/v7.3/rld/rld_bridge.s":175, 0xfb6032c]
-
-('rld' is the dynamic linker.) We don't know why this
-happens, but setting the environment variable LD_BIND_NOW to 1 (which
-forces the dynamic linker to bind all shared objects early on) seems
-to work around the problem.
-
Please refer to the documentation of your dynamic linker for details.
*** When you run Ispell from Emacs, it reports a "misalignment" error.
can cause this error. Remove that file, execute 'ispell-kill-ispell'
in Emacs, and then try spell-checking again.
-*** Emacs eats all file descriptors when using kqueue file notifications.
-See <http://debbugs.gnu.org/22814>.
-
-When you have a large number of buffers running auto-revert-mode, and
-Emacs is configured to use the kqueue file notification library, it
-uses an own file descriptor for every watched file. On systems with a
-small limit of file descriptors allowed per process, like OS X, you
-could run out of file descriptors. You won't be able to open new files.
-
-auto-revert-use-notify is set to nil in global-auto-revert-mode, therefore.
-
* Runtime problems related to font handling
** Characters are displayed as empty boxes or with wrong font under X.
and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
compiling with GCC 4.2.3 or CC 5.7, with no optimizations.
-** Irix
-
-*** Irix: Trouble using ptys, or running out of ptys.
-
-The program mkpts (which may be in '/usr/adm' or '/usr/sbin') needs to
-be set-UID to root, or non-root programs like Emacs will not be able
-to allocate ptys reliably.
-
* Runtime problems specific to MS-Windows
** Emacs on Windows 9X requires UNICOWS.DLL
(using the location of the 32-bit X libraries on your system).
+ *** Building on FreeBSD 11 fails at link time due to unresolved symbol
+
+ The symbol is sendmmsg@FBSD_1.4. This is due to a faulty libgio
+ library on these systems. The solution is to reconfigure Emacs while
+ disabling all the features that require libgio: rsvg, dbus, gconf, and
+ imagemagick.
+
*** Building Emacs for Cygwin can fail with GCC 3
As of Emacs 22.1, there have been stability problems with Cygwin
or from Lisp without specifying the optional argument FIND-FILE;
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
- (fundamental-mode)
+ (kill-all-local-variables)
+ (unless delay-mode-hooks
+ (run-hooks 'change-major-mode-after-body-hook
+ 'after-change-major-mode-hook))
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
;; FIXME this is less efficient than it could be, since both
;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
(with-demoted-errors "File mode specification error: %s"
(set-auto-mode))
- (with-demoted-errors "File local-variables error: %s"
- (hack-local-variables)))
+ ;; `delay-mode-hooks' being non-nil will have prevented the major
+ ;; mode's call to `run-mode-hooks' from calling
+ ;; `hack-local-variables'. In that case, call it now.
+ (when delay-mode-hooks
+ (with-demoted-errors "File local-variables error: %s"
+ (hack-local-variables 'no-mode))))
;; Turn font lock off and on, to make sure it takes account of
;; whatever file local variables are relevant to it.
(when (and font-lock-mode
;; TODO? Warn once per file rather than once per session?
(defvar hack-local-variables--warned-lexical nil)
-(defun hack-local-variables (&optional mode-only)
+(defun hack-local-variables (&optional handle-mode)
"Parse and put into effect this buffer's local variables spec.
Uses `hack-local-variables-apply' to apply the variables.
-If MODE-ONLY is non-nil, all we do is check whether a \"mode:\"
+If HANDLE-MODE is nil, we apply all the specified local
+variables. If HANDLE-MODE is neither nil nor t, we do the same,
+except that any settings of `mode' are ignored.
+
+If HANDLE-MODE is t, all we do is check whether a \"mode:\"
is specified, and return the corresponding mode symbol, or nil.
In this case, we try to ignore minor-modes, and only return a
major-mode.
(let ((enable-local-variables
(and local-enable-local-variables enable-local-variables))
result)
- (unless mode-only
+ (unless (eq handle-mode t)
(setq file-local-variables-alist nil)
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
;; This entire function is basically a no-op if enable-local-variables
;; is nil. All it does is set file-local-variables-alist to nil.
(when enable-local-variables
- ;; This part used to ignore enable-local-variables when mode-only
- ;; was non-nil. That was inappropriate, eg consider the
+ ;; This part used to ignore enable-local-variables when handle-mode
+ ;; was t. That was inappropriate, eg consider the
;; (artificial) example of:
;; (setq local-enable-local-variables nil)
;; Open a file foo.txt that contains "mode: sh".
;; It correctly opens in text-mode.
;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
(unless (or (inhibit-local-variables-p)
- ;; If MODE-ONLY is non-nil, and the prop line specifies a
+ ;; If HANDLE-MODE is t, and the prop line specifies a
;; mode, then we're done, and have no need to scan further.
- (and (setq result (hack-local-variables-prop-line mode-only))
- mode-only))
+ (and (setq result (hack-local-variables-prop-line
+ (eq handle-mode t)))
+ (eq handle-mode t)))
;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(goto-char (point-min))
(while (not (or (eobp)
- (and mode-only result)))
+ (and (eq handle-mode t) result)))
;; Find the variable name;
(unless (looking-at hack-local-variable-regexp)
(error "Malformed local variable line: %S"
(forward-char 1)
(let ((read-circle nil))
(setq val (read (current-buffer))))
- (if mode-only
+ (if (eq handle-mode t)
(and (eq var 'mode)
;; Specifying minor-modes via mode: is
;; deprecated, but try to reject them anyway.
;; to use 'thisbuf's name in the
;; warning message.
(or (buffer-file-name thisbuf) ""))))))
+ ((and (eq var 'mode) handle-mode))
(t
(ignore-errors
(push (cons (if (eq var 'eval)
val) result))))))
(forward-line 1))))))))
;; Now we've read all the local variables.
- ;; If MODE-ONLY is non-nil, return whether the mode was specified.
- (if mode-only result
+ ;; If HANDLE-MODE is t, return whether the mode was specified.
+ (if (eq handle-mode t) result
;; Otherwise, set the variables.
(hack-local-variables-filter result nil)
(hack-local-variables-apply)))))
(error
;; The file's content might be invalid (e.g. have a merge conflict), but
;; that shouldn't prevent the user from opening the file.
- (message ".dir-locals error: %s" (error-message-string err))
+ (message "%s error: %s" dir-locals-file (error-message-string err))
nil))))
(defun dir-locals-set-directory-class (directory class &optional mtime)
(defconst dir-locals-file ".dir-locals.el"
"File that contains directory-local variables.
-It has to be constant to enforce uniform values
-across different environments and users.")
+It has to be constant to enforce uniform values across different
+environments and users.
+See also `dir-locals-file-2', whose values override this one's.
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defconst dir-locals-file-2 ".dir-locals-2.el"
+ "File that contains directory-local variables.
+This essentially a second file that can be used like
+`dir-locals-file', so that users can have specify their personal
+dir-local variables even if the current directory already has a
+`dir-locals-file' that is shared with other users (such as in a
+git repository).
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defun dir-locals--all-files (directory)
+ "Return a list of all readable dir-locals files in DIRECTORY.
+The returned list is sorted by increasing priority. That is,
+values specified in the last file should take precedence over
+those in the first."
+ (when (file-readable-p directory)
+ (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos)
+ (dosified-file-name dir-locals-file)
+ dir-locals-file)
+ directory))
+ (file-2 (when (string-match "\\.el\\'" file-1)
+ (replace-match "-2.el" t nil file-1)))
+ (out nil))
+ ;; The order here is important.
+ (dolist (f (list file-2 file-1))
+ (when (and f
+ (file-readable-p f)
+ (file-regular-p f)
+ (not (file-directory-p f)))
+ (push f out)))
+ out)))
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
time stored in the cache matches the current file modification time.
If not, the cache entry is cleared so that the file will be re-read.
-This function returns either nil (no directory local variables found),
-or the matching entry from `dir-locals-directory-cache' (a list),
-or the full path to the `dir-locals-file' (a string) in the case
-of no valid cache entry."
+This function returns either:
+ - nil (no directory local variables found),
+ - the matching entry from `dir-locals-directory-cache' (a list),
+ - or the full path to the directory (a string) containing at
+ least one `dir-locals-file' in the case of no valid cache
+ entry."
(setq file (expand-file-name file))
- (let* ((dir-locals-file-name
- (if (eq system-type 'ms-dos)
- (dosified-file-name dir-locals-file)
- dir-locals-file))
- (locals-file (locate-dominating-file file dir-locals-file-name))
- (dir-elt nil))
+ (let* ((locals-dir (locate-dominating-file (file-name-directory file)
+ #'dir-locals--all-files))
+ dir-elt)
;; `locate-dominating-file' may have abbreviated the name.
- (and locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
- ;; Let dir-locals-read-from-file inform us via demoted-errors
- ;; about unreadable files, etc.
- ;; Maybe we'd want to keep searching though - that is
- ;; a locate-dominating-file issue.
-;;; (or (not (file-readable-p locals-file))
-;;; (not (file-regular-p locals-file)))
-;;; (setq locals-file nil))
+ (when locals-dir
+ (setq locals-dir (expand-file-name locals-dir)))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (string-prefix-p (car elt) file
- (memq system-type
- '(windows-nt cygwin ms-dos)))
- (> (length (car elt)) (length (car dir-elt))))
- (setq dir-elt elt)))
+ (memq system-type
+ '(windows-nt cygwin ms-dos)))
+ (> (length (car elt)) (length (car dir-elt))))
+ (setq dir-elt elt)))
(if (and dir-elt
- (or (null locals-file)
- (<= (length (file-name-directory locals-file))
- (length (car dir-elt)))))
- ;; Found a potential cache entry. Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-file (expand-file-name dir-locals-file-name
- (car dir-elt))))
- (and (file-readable-p cached-file)
- (equal (nth 2 dir-elt)
- (nth 5 (file-attributes cached-file))))))
- ;; This cache entry is OK.
- dir-elt
- ;; This cache entry is invalid; clear it.
- (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
- ;; Return the first existing dir-locals file. Might be the same
- ;; as dir-elt's, might not (eg latter might have been deleted).
- locals-file)
+ (or (null locals-dir)
+ (<= (length locals-dir)
+ (length (car dir-elt)))))
+ ;; Found a potential cache entry. Check validity.
+ ;; A cache entry with no MTIME is assumed to always be valid
+ ;; (ie, set directly, not from a dir-locals file).
+ ;; Note, we don't bother to check that there is a matching class
+ ;; element in dir-locals-class-alist, since that's done by
+ ;; dir-locals-set-directory-class.
+ (if (or (null (nth 2 dir-elt))
+ (let ((cached-files (dir-locals--all-files (car dir-elt))))
+ ;; The entry MTIME should match the most recent
+ ;; MTIME among matching files.
+ (and cached-files
+ (= (float-time (nth 2 dir-elt))
+ (apply #'max (mapcar (lambda (f)
+ (float-time
+ (nth 5 (file-attributes f))))
+ cached-files))))))
+ ;; This cache entry is OK.
+ dir-elt
+ ;; This cache entry is invalid; clear it.
+ (setq dir-locals-directory-cache
+ (delq dir-elt dir-locals-directory-cache))
+ ;; Return the first existing dir-locals file. Might be the same
+ ;; as dir-elt's, might not (eg latter might have been deleted).
+ locals-dir)
;; No cache entry.
- locals-file)))
-
-(defun dir-locals-read-from-file (file)
- "Load a variables FILE and register a new class and instance.
-FILE is the name of the file holding the variables to apply.
-The new class name is the same as the directory in which FILE
-is found. Returns the new class name."
- (with-temp-buffer
+ locals-dir)))
+
+(defun dir-locals-read-from-dir (dir)
+ "Load all variables files in DIR and register a new class and instance.
+DIR is the absolute name of a directory which must contain at
+least one dir-local file (which is a file holding variables to
+apply).
+Return the new class name, which is a symbol named DIR."
+ (require 'map)
+ (let* ((class-name (intern dir))
+ (files (dir-locals--all-files dir))
+ (read-circle nil)
+ (success nil)
+ (variables))
(with-demoted-errors "Error reading dir-locals: %S"
- (insert-file-contents file)
- (unless (zerop (buffer-size))
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name)))))
+ (dolist (file files)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (condition-case-unless-debug nil
+ (setq variables
+ (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
+ variables
+ (read (current-buffer))))
+ (end-of-file nil))))
+ (setq success t))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class
+ dir class-name
+ (seconds-to-time
+ (if success
+ (apply #'max (mapcar (lambda (file)
+ (float-time (nth 5 (file-attributes file))))
+ files))
+ ;; If there was a problem, use the values we could get but
+ ;; don't let the cache prevent future reads.
+ 0)))
+ class-name))
+
+(define-obsolete-function-alias 'dir-locals-read-from-file
+ 'dir-locals-read-from-dir "25.1")
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file
- (or (buffer-file-name) default-directory)))
+ (let ((dir-or-cache (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
- ((stringp variables-file)
- (setq dir-name (file-name-directory variables-file)
- class (dir-locals-read-from-file variables-file)))
- ((consp variables-file)
- (setq dir-name (nth 0 variables-file))
- (setq class (nth 1 variables-file))))
+ ((stringp dir-or-cache)
+ (setq dir-name dir-or-cache
+ class (dir-locals-read-from-dir dir-or-cache)))
+ ((consp dir-or-cache)
+ (setq dir-name (nth 0 dir-or-cache))
+ (setq class (nth 1 dir-or-cache))))
(when class
(let ((variables
(dir-locals-collect-variables
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, each character from the
- set [ \\t\\n;<>&|()`'\"#$] is quoted with a backslash; for DOS/Windows, all
+ set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all
the parts of the pattern which don't include wildcard characters are
quoted with double quotes.
;; Simulate the message printed by `ls'.
(insert (format "%s: No such file or directory\n" file))))
-(defvar kill-emacs-query-functions nil
+(defcustom kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is canceled.
`save-buffers-kill-emacs' calls these functions, but `kill-emacs',
-the low level primitive, does not. See also `kill-emacs-hook'.")
+the low level primitive, does not. See also `kill-emacs-hook'."
+ :type 'hook
+ :version "25.2"
+ :group 'convenience)
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.
-If the current frame has no client, kill Emacs itself.
+If the current frame has no client, kill Emacs itself using
+`save-buffers-kill-emacs'.
With prefix ARG, silently save all file-visiting buffers, then kill.
(let ((delete-by-moving-to-trash nil))
(rename-file fn new-fn)))))))))
+(defsubst file-attribute-type (attributes)
+ "The type field in ATTRIBUTES returned by `file-attribute'.
+The value is either t for directory, string (name linked to) for
+symbolic link, or nil."
+ (nth 0 attributes))
+
+(defsubst file-attribute-link-number (attributes)
+ "Return the number of links in ATTRIBUTES returned by `file-attribute'."
+ (nth 1 attributes))
+
+(defsubst file-attribute-user-id (attributes)
+ "The UID field in ATTRIBUTES returned by `file-attribute'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 2 attributes))
+
+(defsubst file-attribute-group-id (attributes)
+ "The GID field in ATTRIBUTES returned by `file-attribute'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 3 attributes))
+
+(defsubst file-attribute-access-time (attributes)
+ "The last access time in ATTRIBUTES returned by `file-attribute'.
+This a list of integers (HIGH LOW USEC PSEC) in the same style
+as (current-time)."
+ (nth 4 attributes))
+
+(defsubst file-attribute-modification-time (attributes)
+ "The modification time in ATTRIBUTES returned by `file-attribute'.
+This is the time of the last change to the file's contents, and
+is a list of integers (HIGH LOW USEC PSEC) in the same style
+as (current-time)."
+ (nth 5 attributes))
+
+(defsubst file-attribute-status-change-time (attributes)
+ "The status modification time in ATTRIBUTES returned by `file-attribute'.
+This is the time of last change to the file's attributes: owner
+and group, access mode bits, etc, and is a list of integers (HIGH
+LOW USEC PSEC) in the same style as (current-time)."
+ (nth 6 attributes))
+
+(defsubst file-attribute-size (attributes)
+ "The size (in bytes) in ATTRIBUTES returned by `file-attribute'.
+This is a floating point number if the size is too large for an integer."
+ (nth 7 attributes))
+
+(defsubst file-attribute-modes (attributes)
+ "The file modes in ATTRIBUTES returned by `file-attribute'.
+This is a string of ten letters or dashes as in ls -l."
+ (nth 8 attributes))
+
+(defsubst file-attribute-inode-number (attributes)
+ "The inode number in ATTRIBUTES returned by `file-attribute'.
+If it is larger than what an Emacs integer can hold, this is of
+the form (HIGH . LOW): first the high bits, then the low 16 bits.
+If even HIGH is too large for an Emacs integer, this is instead
+of the form (HIGH MIDDLE . LOW): first the high bits, then the
+middle 24 bits, and finally the low 16 bits."
+ (nth 10 attributes))
+
+(defsubst file-attribute-device-number (attributes)
+ "The file system device number in ATTRIBUTES returned by `file-attribute'.
+If it is larger than what an Emacs integer can hold, this is of
+the form (HIGH . LOW): first the high bits, then the low 16 bits.
+If even HIGH is too large for an Emacs integer, this is instead
+of the form (HIGH MIDDLE . LOW): first the high bits, then the
+middle 24 bits, and finally the low 16 bits."
+ (nth 11 attributes))
+
\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(when (and mouse-1-click-follows-link
(eq (if (eq mouse-1-click-follows-link 'double)
'double-down-mouse-1 'down-mouse-1)
- (car-safe last-input-event))
- (mouse-on-link-p (event-start last-input-event))
- (or mouse-1-click-in-non-selected-windows
- (eq (selected-window)
- (posn-window (event-start last-input-event)))))
- (let ((timedout
- (sit-for (if (numberp mouse-1-click-follows-link)
- (/ (abs mouse-1-click-follows-link) 1000.0)
- 0))))
- (if (if (and (numberp mouse-1-click-follows-link)
- (>= mouse-1-click-follows-link 0))
- timedout (not timedout))
- nil
-
- (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode!
- (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double)
- 'double-mouse-1 'mouse-1))
- ;; Turn the mouse-1 into a mouse-2 to follow links.
- (let ((newup (if (eq mouse-1-click-follows-link 'double)
- 'double-mouse-2 'mouse-2)))
- ;; If mouse-2 has never been done by the user, it doesn't have
- ;; the necessary property to be interpreted correctly.
- (unless (get newup 'event-kind)
- (put newup 'event-kind (get (car event) 'event-kind)))
- (push (cons newup (cdr event)) unread-command-events)
- ;; Don't change the down event, only the up-event (bug#18212).
- nil)
- (push event unread-command-events)
- nil))))))
+ (car-safe last-input-event)))
+ (let ((action (mouse-on-link-p (event-start last-input-event))))
+ (when (and action
+ (or mouse-1-click-in-non-selected-windows
+ (eq (selected-window)
+ (posn-window (event-start last-input-event)))))
+ (let ((timedout
+ (sit-for (if (numberp mouse-1-click-follows-link)
+ (/ (abs mouse-1-click-follows-link) 1000.0)
+ 0))))
+ (if (if (and (numberp mouse-1-click-follows-link)
+ (>= mouse-1-click-follows-link 0))
+ timedout (not timedout))
+ nil
+ ;; Use read-key so it works for xterm-mouse-mode!
+ (let ((event (read-key)))
+ (if (eq (car-safe event)
+ (if (eq mouse-1-click-follows-link 'double)
+ 'double-mouse-1 'mouse-1))
+ (progn
+ ;; Turn the mouse-1 into a mouse-2 to follow links,
+ ;; but only if ‘mouse-on-link-p’ hasn’t returned a
+ ;; string or vector (see its docstring).
+ (if (or (stringp action) (vectorp action))
+ (push (aref action 0) unread-command-events)
+ (let ((newup (if (eq mouse-1-click-follows-link 'double)
+ 'double-mouse-2 'mouse-2)))
+ ;; If mouse-2 has never been done by the user, it
+ ;; doesn't have the necessary property to be
+ ;; interpreted correctly.
+ (unless (get newup 'event-kind)
+ (put newup 'event-kind (get (car event) 'event-kind)))
+ (push (cons newup (cdr event)) unread-command-events)))
+ ;; Don't change the down event, only the up-event
+ ;; (bug#18212).
+ nil)
+ (push event unread-command-events)
+ nil))))))))
(define-key key-translation-map [down-mouse-1]
#'mouse--down-1-maybe-follows-link)
(if (fboundp mm-fun) ; bug#20201
`(keymap
,indicator
- (turn-off menu-item "Turn Off minor mode" ,mm-fun)
+ (turn-off menu-item "Turn off minor mode" ,mm-fun)
(help menu-item "Help for minor mode"
(lambda () (interactive)
(describe-function ',mm-fun)))))))
(or (not resize-mini-windows)
(eq minibuffer-window
(active-minibuffer-window)))))))
- (setq draggable nil))))
+ (setq draggable nil)))
+ ((eq line 'vertical)
+ (let ((divider-width (frame-right-divider-width frame)))
+ (when (and (or (not (numberp divider-width))
+ (zerop divider-width))
+ (eq (cdr (assq 'vertical-scroll-bars
+ (frame-parameters frame)))
+ 'left))
+ (setq window (window-in-direction 'left window t))))))
(let* ((exitfun nil)
(move
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;; Commentary:
-
-;;; Code:
-
;; Beware: while this file has tag `utf-8', before it's compiled, it gets
;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
-(defmacro declare-function (_fn _file &optional _arglist _fileonly)
+
+;; declare-function's args use &rest, not &optional, for compatibility
+;; with byte-compile-macroexpand-declare-function.
+
+(defmacro declare-function (_fn _file &rest _args)
"Tell the byte-compiler that function FN is defined, in FILE.
-Optional ARGLIST is the argument list used by the function.
The FILE argument is not used by the byte-compiler, but by the
`check-declare' package, which checks that FILE contains a
-definition for FN. ARGLIST is used by both the byte-compiler
-and `check-declare' to check for consistency.
+definition for FN.
FILE can be either a Lisp file (in which case the \".el\"
extension is optional), or a C file. C files are expanded
`check-declare' will check such files if they are found, and skip
them without error if they are not.
-FILEONLY non-nil means that `check-declare' will only check that
-FILE exists, not that it defines FN. This is intended for
-function-definitions that `check-declare' does not recognize, e.g.
-`defstruct'.
+Optional ARGLIST specifies FN's arguments, or is t to not specify
+FN's arguments. An omitted ARGLIST defaults to t, not nil: a nil
+ARGLIST specifies an empty argument list, and an explicit t
+ARGLIST is a placeholder that allows supplying a later arg.
-To specify a value for FILEONLY without passing an argument list,
-set ARGLIST to t. This is necessary because nil means an
-empty argument list, rather than an unspecified one.
+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'.
Note that for the purposes of `check-declare', this statement
must be the first non-whitespace on a line.
For more information, see Info node `(elisp)Declaring Functions'."
+ (declare (advertised-calling-convention
+ (fn file &optional arglist fileonly) nil))
;; Does nothing - byte-compile-declare-function does the work.
nil)
;;;; Basic Lisp macros.
(defalias 'not 'null)
+(defalias 'sxhash 'sxhash-equal)
(defmacro noreturn (form)
"Evaluate FORM, expecting it not to return.
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."
- (interactive "KSet key globally: \nCSet key %s to command: ")
+ (interactive
+ (let* ((menu-prompting nil)
+ (key (read-key-sequence "Set key globally: ")))
+ (list key
+ (read-command (format "Set key %s to command: "
+ (key-description key))))))
(or (vectorp key) (stringp key)
(signal 'wrong-type-argument (list 'arrayp key)))
(define-key (current-global-map) key command))
(declare (indent 2) (debug (form sexp body))
(obsolete "use a <foo>-function variable modified by `add-function'."
"24.4"))
+ `(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."
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(let ((funs (make-symbol "funs"))
(make-variable-buffer-local 'delayed-mode-hooks)
(put 'delay-mode-hooks 'permanent-local t)
+(defvar delayed-after-hook-forms nil
+ "List of delayed :after-hook forms waiting to be run.
+These forms come from `define-derived-mode'.")
+(make-variable-buffer-local 'delayed-after-hook-forms)
+
(defvar change-major-mode-after-body-hook nil
"Normal hook run in major mode functions, before the mode hooks.")
(defun run-mode-hooks (&rest hooks)
"Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
-If the variable `delay-mode-hooks' is non-nil, does not run any hooks,
+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,
just adds the HOOKS to the list `delayed-mode-hooks'.
Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',
-`delayed-mode-hooks' (in reverse order), HOOKS, and finally
-`after-change-major-mode-hook'. Major mode functions should use
-this instead of `run-hooks' when running their FOO-mode-hook."
+`delayed-mode-hooks' (in reverse order), HOOKS, then runs
+`hack-local-variables', runs the hook `after-change-major-mode-hook', and
+finally evaluates the forms in `delayed-after-hook-forms' (see
+`define-derived-mode').
+
+Major mode functions should use this instead of `run-hooks' when
+running their FOO-mode-hook."
(if delay-mode-hooks
;; Delaying case.
(dolist (hook hooks)
(setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
(setq delayed-mode-hooks nil)
(apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))
- (run-hooks 'after-change-major-mode-hook)))
+ (if (buffer-file-name)
+ (with-demoted-errors "File local-variables error: %s"
+ (hack-local-variables 'no-mode)))
+ (run-hooks 'after-change-major-mode-hook)
+ (dolist (form (nreverse delayed-after-hook-forms))
+ (eval form))
+ (setq delayed-after-hook-forms nil)))
(defmacro delay-mode-hooks (&rest body)
"Execute BODY, but delay any `run-mode-hooks'.
(message "%s%s" prompt (char-to-string char))
char))
+(defun read-multiple-choice (prompt choices)
+ "Ask user a multiple choice question.
+PROMPT should be a string that will be displayed as the prompt.
+
+CHOICES is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for
+the entry to be displayed while prompting (if there's room, it
+might be shortened), and the third, optional entry is a longer
+explanation that will be displayed in a help buffer if the user
+requests more help.
+
+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 `recenter', `scroll-up', and `scroll-down'. If the
+user enters `recenter', `scroll-up', or `scroll-down' responses,
+perform the requested window recentering or scrolling and ask
+again.
+
+The return value is the matching entry from the CHOICES list.
+
+Usage example:
+
+\(read-multiple-choice \"Continue connecting?\"
+ '((?a \"always\")
+ (?s \"session only\")
+ (?n \"no\")))"
+ (let* ((altered-names nil)
+ (full-prompt
+ (format
+ "%s (%s): "
+ prompt
+ (mapconcat
+ (lambda (elem)
+ (let* ((name (cadr elem))
+ (pos (seq-position name (car elem)))
+ (altered-name
+ (cond
+ ;; Not in the name string.
+ ((not pos)
+ (format "[%c] %s" (car elem) name))
+ ;; The prompt character is in the name, so highlight
+ ;; it on graphical terminals...
+ ((display-supports-face-attributes-p
+ '(:underline t) (window-frame))
+ (setq name (copy-sequence name))
+ (put-text-property pos (1+ pos)
+ 'face 'read-multiple-choice-face
+ name)
+ name)
+ ;; And put it in [bracket] on non-graphical terminals.
+ (t
+ (concat
+ (substring name 0 pos)
+ "["
+ (upcase (substring name pos (1+ pos)))
+ "]"
+ (substring name (1+ pos)))))))
+ (push (cons (car elem) altered-name)
+ altered-names)
+ altered-name))
+ (append choices '((?? "?")))
+ ", ")))
+ tchar buf wrong-char answer)
+ (save-window-excursion
+ (save-excursion
+ (while (not tchar)
+ (message "%s%s"
+ (if wrong-char
+ "Invalid choice. "
+ "")
+ full-prompt)
+ (setq tchar
+ (if (and (display-popup-menus-p)
+ last-input-event ; not during startup
+ (listp last-nonmenu-event)
+ use-dialog-box)
+ (x-popup-dialog
+ t
+ (cons prompt
+ (mapcar
+ (lambda (elem)
+ (cons (capitalize (cadr elem))
+ (car elem)))
+ choices)))
+ (condition-case nil
+ (let ((cursor-in-echo-area t))
+ (read-char))
+ (error nil))))
+ (setq answer (lookup-key query-replace-map (vector tchar) t))
+ (setq tchar
+ (cond
+ ((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)
+ (t tchar)))
+ (when (eq tchar t)
+ (setq wrong-char nil
+ tchar nil))
+ ;; The user has entered an invalid choice, so display the
+ ;; help messages.
+ (when (and (not (eq tchar nil))
+ (not (assq tchar choices)))
+ (setq wrong-char (not (memq tchar '(?? ?\C-h)))
+ tchar nil)
+ (when wrong-char
+ (ding))
+ (with-help-window (setq buf (get-buffer-create
+ "*Multiple Choice Help*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (pop-to-buffer buf)
+ (insert prompt "\n\n")
+ (let* ((columns (/ (window-width) 25))
+ (fill-column 21)
+ (times 0)
+ (start (point)))
+ (dolist (elem choices)
+ (goto-char start)
+ (unless (zerop times)
+ (if (zerop (mod times columns))
+ ;; Go to the next "line".
+ (goto-char (setq start (point-max)))
+ ;; Add padding.
+ (while (not (eobp))
+ (end-of-line)
+ (insert (make-string (max (- (* (mod times columns)
+ (+ fill-column 4))
+ (current-column))
+ 0)
+ ?\s))
+ (forward-line 1))))
+ (setq times (1+ times))
+ (let ((text
+ (with-temp-buffer
+ (insert (format
+ "%c: %s\n"
+ (car elem)
+ (cdr (assq (car elem) altered-names))))
+ (fill-region (point-min) (point-max))
+ (when (nth 2 elem)
+ (let ((start (point)))
+ (insert (nth 2 elem))
+ (unless (bolp)
+ (insert "\n"))
+ (fill-region start (point-max))))
+ (buffer-string))))
+ (goto-char start)
+ (dolist (line (split-string text "\n"))
+ (end-of-line)
+ (if (bolp)
+ (insert line "\n")
+ (insert line))
+ (forward-line 1)))))))))))
+ (when (buffer-live-p buf)
+ (kill-buffer buf))
+ (assq tchar choices)))
+
(defun sit-for (seconds &optional nodisp obsolete)
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
SECONDS may be a floating-point value.
of STRING, the same substring that is the actual text of the match which
is passed to REP as its argument.
- To replace only the first match (if any), make REGEXP match up to \\'
+ To replace only the first match (if any), make REGEXP match up to \\\\='
and replace a sub-expression, e.g.
- (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
+ (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\\\='\" \"bar\" \" foo foo\" nil nil 1)
=> \" bar foo\""
;; To avoid excessive consing from multiple matches in long strings,
`inhibit-field-text-motion' is non-nil.
This function is like `forward-word', but it is not affected
-by `find-word-boundary-function-table' (as set up by
-e.g. `subword-mode'). It is also not interactive."
+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
If ARG is omitted or nil, move point backward one word.
This function is like `forward-word', but it is not affected
-by `find-word-boundary-function-table' (as set up by
-e.g. `subword-mode'). It is also not interactive."
+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
\f
;;; Misc.
+
+(defvar definition-prefixes (make-hash-table :test 'equal)
+ "Hash table mapping prefixes to the files in which they're used.
+This can be used to automatically fetch not-yet-loaded definitions.
+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.
+
+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
+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-\".")
+
+(defun register-definition-prefixes (file prefixes)
+ "Register that FILE uses PREFIXES."
+ (dolist (prefix prefixes)
+ (puthash prefix (cons file (gethash prefix definition-prefixes))
+ definition-prefixes)))
+
(defconst menu-bar-separator '("--")
"Separator for menus.")
return (flags >> 19) & 1;
}
static bool
+SYNTAX_FLAGS_COMSTARTEND_FIRST (int flags)
+{
+ return (flags & 0x50000) != 0;
+}
+static bool
SYNTAX_FLAGS_PREFIX (int flags)
{
return (flags >> 20) & 1;
ptrdiff_t comstr_start; /* Position of last comment/string starter. */
Lisp_Object levelstarts; /* Char numbers of starts-of-expression
of levels (starting from outermost). */
+ int prev_syntax; /* Syntax of previous position scanned, when
+ that position (potentially) holds the first char
+ of a 2-char construct, i.e. comment delimiter
+ or Sescape, etc. Smax otherwise. */
};
\f
/* These variables are a cache for finding the start of a defun.
static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, bool);
static void scan_sexps_forward (struct lisp_parse_state *,
ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
- bool, Lisp_Object, int);
+ bool, int);
+static void internalize_parse_state (Lisp_Object, struct lisp_parse_state *);
static bool in_classes (int, Lisp_Object);
static void parse_sexp_propertize (ptrdiff_t charpos);
ptrdiff_t comment_end = from;
ptrdiff_t comment_end_byte = from_byte;
ptrdiff_t comstart_pos = 0;
- ptrdiff_t comstart_byte IF_LINT (= 0);
+ ptrdiff_t comstart_byte;
/* Place where the containing defun starts,
or 0 if we didn't come across it yet. */
ptrdiff_t defun_start = 0;
}
do
{
+ internalize_parse_state (Qnil, &state);
scan_sexps_forward (&state,
defun_start, defun_start_byte,
comment_end, TYPE_MINIMUM (EMACS_INT),
- 0, Qnil, 0);
+ 0, 0);
defun_start = comment_end;
if (!adjusted)
{
ptrdiff_t start_point = PT;
ptrdiff_t pos = PT;
ptrdiff_t pos_byte = PT_BYTE;
- unsigned char *p = PT_ADDR, *endp, *stop;
-
- if (forwardp)
- {
- endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim));
- stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp;
- }
- else
- {
- endp = CHAR_POS_ADDR (XINT (lim));
- stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
- }
+ unsigned char *p, *endp, *stop;
immediate_quit = 1;
SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
+
if (forwardp)
{
- if (multibyte)
+ while (true)
{
- while (1)
+ p = BYTE_POS_ADDR (pos_byte);
+ endp = XINT (lim) == GPT ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim));
+ stop = pos < GPT && GPT < XINT (lim) ? GPT_ADDR : endp;
+
+ do
{
int nbytes;
if (p >= stop)
{
if (p >= endp)
- break;
+ goto done;
p = GAP_END_ADDR;
stop = endp;
}
- c = STRING_CHAR_AND_LENGTH (p, nbytes);
+ if (multibyte)
+ c = STRING_CHAR_AND_LENGTH (p, nbytes);
+ else
+ c = *p, nbytes = 1;
if (! fastmap[SYNTAX (c)])
- break;
+ goto done;
p += nbytes, pos++, pos_byte += nbytes;
- UPDATE_SYNTAX_TABLE_FORWARD (pos);
- }
- }
- else
- {
- while (1)
- {
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- if (! fastmap[SYNTAX (*p)])
- break;
- p++, pos++, pos_byte++;
- UPDATE_SYNTAX_TABLE_FORWARD (pos);
}
+ while (!parse_sexp_lookup_properties
+ || pos < gl_state.e_property);
+
+ update_syntax_table_forward (pos + gl_state.offset,
+ false, gl_state.object);
}
}
else
{
+ p = BYTE_POS_ADDR (pos_byte);
+ endp = CHAR_POS_ADDR (XINT (lim));
+ stop = pos >= GPT && GPT > XINT (lim) ? GAP_END_ADDR : endp;
+
if (multibyte)
{
while (1)
}
}
+ done:
SET_PT_BOTH (pos, pos_byte);
immediate_quit = 0;
PREV_SYNTAX is the SYNTAX_WITH_FLAGS of the previous character
(or 0 If the search cannot start in the middle of a two-character).
- If successful, return true and store the charpos of the comment's end
- into *CHARPOS_PTR and the corresponding bytepos into *BYTEPOS_PTR.
- Else, return false and store the charpos STOP into *CHARPOS_PTR, the
- corresponding bytepos into *BYTEPOS_PTR and the current nesting
- (as defined for state.incomment) in *INCOMMENT_PTR.
+ If successful, return true and store the charpos of the comment's
+ end into *CHARPOS_PTR and the corresponding bytepos into
+ *BYTEPOS_PTR. Else, return false and store the charpos STOP into
+ *CHARPOS_PTR, the corresponding bytepos into *BYTEPOS_PTR and the
+ current nesting (as defined for state->incomment) in
+ *INCOMMENT_PTR. Should the last character scanned in an incomplete
+ comment be a possible first character of a two character construct,
+ we store its SYNTAX_WITH_FLAGS into *last_syntax_ptr. Otherwise,
+ we store Smax into *last_syntax_ptr.
The comment end is the last character of the comment rather than the
character just after the comment.
forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
EMACS_INT nesting, int style, int prev_syntax,
ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
- EMACS_INT *incomment_ptr)
+ EMACS_INT *incomment_ptr, int *last_syntax_ptr)
{
register int c, c1;
register enum syntaxcode code;
/* Enter the loop in the middle so that we find
a 2-char comment ender if we start in the middle of it. */
syntax = prev_syntax;
- if (syntax != 0) goto forw_incomment;
+ code = syntax & 0xff;
+ if (syntax != 0 && from < stop) goto forw_incomment;
while (1)
{
*incomment_ptr = nesting;
*charpos_ptr = from;
*bytepos_ptr = from_byte;
+ *last_syntax_ptr =
+ (code == Sescape || code == Scharquote
+ || SYNTAX_FLAGS_COMEND_FIRST (syntax)
+ || (nesting > 0
+ && SYNTAX_FLAGS_COMSTART_FIRST (syntax)))
+ ? syntax : Smax ;
return 0;
}
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
SYNTAX_FLAGS_COMMENT_NESTED (other_syntax))
? nesting > 0 : nesting < 0))
{
- if (--nesting <= 0)
+ syntax = Smax; /* So that "|#" (lisp) can not return
+ the syntax of "#" in *last_syntax_ptr. */
+ if (--nesting <= 0)
/* We have encountered a comment end of the same style
as the comment sequence which began this comment section. */
break;
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
{
+ syntax = Smax; /* So that "#|#" isn't also a comment ender. */
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
nesting++;
}
*charpos_ptr = from;
*bytepos_ptr = from_byte;
+ *last_syntax_ptr = Smax; /* Any syntactic power the last byte had is
+ used up. */
return 1;
}
EMACS_INT count1;
ptrdiff_t out_charpos, out_bytepos;
EMACS_INT dummy;
+ int dummy2;
CHECK_NUMBER (count);
count1 = XINT (count);
}
/* We're at the start of a comment. */
found = forw_comment (from, from_byte, stop, comnested, comstyle, 0,
- &out_charpos, &out_bytepos, &dummy);
+ &out_charpos, &out_bytepos, &dummy, &dummy2);
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
ptrdiff_t from_byte;
ptrdiff_t out_bytepos, out_charpos;
EMACS_INT dummy;
+ int dummy2;
bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
if (depth > 0) min_depth = 0;
UPDATE_SYNTAX_TABLE_FORWARD (from);
found = forw_comment (from, from_byte, stop,
comnested, comstyle, 0,
- &out_charpos, &out_bytepos, &dummy);
+ &out_charpos, &out_bytepos, &dummy,
+ &dummy2);
from = out_charpos, from_byte = out_bytepos;
if (!found)
{
DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
0, 0, 0,
doc: /* Move point backward over any number of chars with prefix syntax.
- This includes chars with expression prefix syntax class (') and those with
+ This includes chars with expression prefix syntax class (\\=') and those with
the prefix syntax flag (p). */)
(void)
{
}
\f
/* Parse forward from FROM / FROM_BYTE to END,
- assuming that FROM has state OLDSTATE (nil means FROM is start of function),
+ assuming that FROM has state STATE,
and return a description of the state of the parse at END.
If STOPBEFORE, stop at the start of an atom.
If COMMENTSTOP is 1, stop at the start of a comment.
after the beginning of a string, or after the end of a string. */
static void
-scan_sexps_forward (struct lisp_parse_state *stateptr,
+scan_sexps_forward (struct lisp_parse_state *state,
ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t end,
EMACS_INT targetdepth, bool stopbefore,
- Lisp_Object oldstate, int commentstop)
+ int commentstop)
{
- struct lisp_parse_state state;
enum syntaxcode code;
int c1;
bool comnested;
Lisp_Object tem;
ptrdiff_t prev_from; /* Keep one character before FROM. */
ptrdiff_t prev_from_byte;
- int prev_from_syntax;
+ int prev_from_syntax, prev_prev_from_syntax;
bool boundary_stop = commentstop == -1;
bool nofence;
bool found;
do { prev_from = from; \
prev_from_byte = from_byte; \
temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \
+ prev_prev_from_syntax = prev_from_syntax; \
prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
INC_BOTH (from, from_byte); \
if (from < end) \
immediate_quit = 1;
QUIT;
- if (NILP (oldstate))
- {
- depth = 0;
- state.instring = -1;
- state.incomment = 0;
- state.comstyle = 0; /* comment style a by default. */
- state.comstr_start = -1; /* no comment/string seen. */
- }
- else
- {
- tem = Fcar (oldstate);
- if (!NILP (tem))
- depth = XINT (tem);
- else
- depth = 0;
-
- oldstate = Fcdr (oldstate);
- oldstate = Fcdr (oldstate);
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- /* Check whether we are inside string_fence-style string: */
- state.instring = (!NILP (tem)
- ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE)
- : -1);
-
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- state.incomment = (!NILP (tem)
- ? (INTEGERP (tem) ? XINT (tem) : -1)
- : 0);
-
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- start_quoted = !NILP (tem);
+ depth = state->depth;
+ start_quoted = state->quoted;
+ prev_prev_from_syntax = Smax;
+ prev_from_syntax = state->prev_syntax;
- /* if the eighth element of the list is nil, we are in comment
- style a. If it is non-nil, we are in comment style b */
- oldstate = Fcdr (oldstate);
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- state.comstyle = (NILP (tem)
- ? 0
- : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE)
- ? XINT (tem)
- : ST_COMMENT_STYLE));
-
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- state.comstr_start =
- RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1;
- oldstate = Fcdr (oldstate);
- tem = Fcar (oldstate);
- while (!NILP (tem)) /* >= second enclosing sexps. */
- {
- Lisp_Object temhd = Fcar (tem);
- if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
- curlevel->last = XINT (temhd);
- if (++curlevel == endlevel)
- curlevel--; /* error ("Nesting too deep for parser"); */
- curlevel->prev = -1;
- curlevel->last = -1;
- tem = Fcdr (tem);
- }
+ tem = state->levelstarts;
+ while (!NILP (tem)) /* >= second enclosing sexps. */
+ {
+ Lisp_Object temhd = Fcar (tem);
+ if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
+ curlevel->last = XINT (temhd);
+ if (++curlevel == endlevel)
+ curlevel--; /* error ("Nesting too deep for parser"); */
+ curlevel->prev = -1;
+ curlevel->last = -1;
+ tem = Fcdr (tem);
}
- state.quoted = 0;
- mindepth = depth;
-
curlevel->prev = -1;
curlevel->last = -1;
- SETUP_SYNTAX_TABLE (prev_from, 1);
- temp = FETCH_CHAR (prev_from_byte);
- prev_from_syntax = SYNTAX_WITH_FLAGS (temp);
- UPDATE_SYNTAX_TABLE_FORWARD (from);
+ state->quoted = 0;
+ mindepth = depth;
+
+ SETUP_SYNTAX_TABLE (from, 1);
/* Enter the loop at a place appropriate for initial state. */
- if (state.incomment)
+ if (state->incomment)
goto startincomment;
- if (state.instring >= 0)
+ if (state->instring >= 0)
{
- nofence = state.instring != ST_STRING_STYLE;
+ nofence = state->instring != ST_STRING_STYLE;
if (start_quoted)
goto startquotedinstring;
goto startinstring;
while (from < end)
{
int syntax;
- INC_FROM;
- code = prev_from_syntax & 0xff;
- if (from < end
- && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
+ if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
&& (c1 = FETCH_CHAR (from_byte),
syntax = SYNTAX_WITH_FLAGS (c1),
SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
/* Record the comment style we have entered so that only
the comment-end sequence of the same style actually
terminates the comment section. */
- state.comstyle
+ state->comstyle
= SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
| SYNTAX_FLAGS_COMMENT_NESTED (syntax));
- state.incomment = comnested ? 1 : -1;
- state.comstr_start = prev_from;
+ state->incomment = comnested ? 1 : -1;
+ state->comstr_start = prev_from;
INC_FROM;
+ prev_from_syntax = Smax; /* the syntax has already been
+ "used up". */
code = Scomment;
}
- else if (code == Scomment_fence)
- {
- /* Record the comment style we have entered so that only
- the comment-end sequence of the same style actually
- terminates the comment section. */
- state.comstyle = ST_COMMENT_STYLE;
- state.incomment = -1;
- state.comstr_start = prev_from;
- code = Scomment;
- }
- else if (code == Scomment)
- {
- state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
- state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
- 1 : -1);
- state.comstr_start = prev_from;
- }
+ else
+ {
+ INC_FROM;
+ code = prev_from_syntax & 0xff;
+ if (code == Scomment_fence)
+ {
+ /* Record the comment style we have entered so that only
+ the comment-end sequence of the same style actually
+ terminates the comment section. */
+ state->comstyle = ST_COMMENT_STYLE;
+ state->incomment = -1;
+ state->comstr_start = prev_from;
+ code = Scomment;
+ }
+ else if (code == Scomment)
+ {
+ state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
+ state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
+ 1 : -1);
+ state->comstr_start = prev_from;
+ }
+ }
if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
continue;
case Scomment_fence: /* Can't happen because it's handled above. */
case Scomment:
- if (commentstop || boundary_stop) goto done;
+ if (commentstop || boundary_stop) goto done;
startincomment:
/* The (from == BEGV) test was to enter the loop in the middle so
that we find a 2-char comment ender even if we start in the
middle of it. We don't want to do that if we're just at the
beginning of the comment (think of (*) ... (*)). */
found = forw_comment (from, from_byte, end,
- state.incomment, state.comstyle,
- (from == BEGV || from < state.comstr_start + 3)
- ? 0 : prev_from_syntax,
- &out_charpos, &out_bytepos, &state.incomment);
+ state->incomment, state->comstyle,
+ from == BEGV ? 0 : prev_from_syntax,
+ &out_charpos, &out_bytepos, &state->incomment,
+ &prev_from_syntax);
from = out_charpos; from_byte = out_bytepos;
- /* Beware! prev_from and friends are invalid now.
- Luckily, the `done' doesn't use them and the INC_FROM
- sets them to a sane value without looking at them. */
+ /* Beware! prev_from and friends (except prev_from_syntax)
+ are invalid now. Luckily, the `done' doesn't use them
+ and the INC_FROM sets them to a sane value without
+ looking at them. */
if (!found) goto done;
INC_FROM;
- state.incomment = 0;
- state.comstyle = 0; /* reset the comment style */
- if (boundary_stop) goto done;
+ state->incomment = 0;
+ state->comstyle = 0; /* reset the comment style */
+ prev_from_syntax = Smax; /* For the comment closer */
+ if (boundary_stop) goto done;
break;
case Sopen:
case Sstring:
case Sstring_fence:
- state.comstr_start = from - 1;
+ state->comstr_start = from - 1;
if (stopbefore) goto stop; /* this arg means stop at sexp start */
curlevel->last = prev_from;
- state.instring = (code == Sstring
+ state->instring = (code == Sstring
? (FETCH_CHAR_AS_MULTIBYTE (prev_from_byte))
: ST_STRING_STYLE);
if (boundary_stop) goto done;
startinstring:
{
- nofence = state.instring != ST_STRING_STYLE;
+ nofence = state->instring != ST_STRING_STYLE;
while (1)
{
/* Check C_CODE here so that if the char has
a syntax-table property which says it is NOT
a string character, it does not end the string. */
- if (nofence && c == state.instring && c_code == Sstring)
+ if (nofence && c == state->instring && c_code == Sstring)
break;
switch (c_code)
}
}
string_end:
- state.instring = -1;
+ state->instring = -1;
curlevel->prev = curlevel->last;
INC_FROM;
if (boundary_stop) goto done;
stop: /* Here if stopping before start of sexp. */
from = prev_from; /* We have just fetched the char that starts it; */
from_byte = prev_from_byte;
+ prev_from_syntax = prev_prev_from_syntax;
goto done; /* but return the position before it. */
endquoted:
- state.quoted = 1;
+ state->quoted = 1;
done:
- state.depth = depth;
- state.mindepth = mindepth;
- state.thislevelstart = curlevel->prev;
- state.prevlevelstart
+ state->depth = depth;
+ state->mindepth = mindepth;
+ state->thislevelstart = curlevel->prev;
+ state->prevlevelstart
= (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
- state.location = from;
- state.location_byte = from_byte;
- state.levelstarts = Qnil;
+ state->location = from;
+ state->location_byte = from_byte;
+ state->levelstarts = Qnil;
while (curlevel > levelstart)
- state.levelstarts = Fcons (make_number ((--curlevel)->last),
- state.levelstarts);
+ state->levelstarts = Fcons (make_number ((--curlevel)->last),
+ state->levelstarts);
+ state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
+ || state->quoted) ? prev_from_syntax : Smax;
immediate_quit = 0;
+}
+
+/* Convert a (lisp) parse state to the internal form used in
+ scan_sexps_forward. */
+static void
+internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state)
+{
+ Lisp_Object tem;
+
+ if (NILP (external))
+ {
+ state->depth = 0;
+ state->instring = -1;
+ state->incomment = 0;
+ state->quoted = 0;
+ state->comstyle = 0; /* comment style a by default. */
+ state->comstr_start = -1; /* no comment/string seen. */
+ state->levelstarts = Qnil;
+ state->prev_syntax = Smax;
+ }
+ else
+ {
+ tem = Fcar (external);
+ if (!NILP (tem))
+ state->depth = XINT (tem);
+ else
+ state->depth = 0;
+
+ external = Fcdr (external);
+ external = Fcdr (external);
+ external = Fcdr (external);
+ tem = Fcar (external);
+ /* Check whether we are inside string_fence-style string: */
+ state->instring = (!NILP (tem)
+ ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE)
+ : -1);
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->incomment = (!NILP (tem)
+ ? (INTEGERP (tem) ? XINT (tem) : -1)
+ : 0);
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->quoted = !NILP (tem);
- *stateptr = state;
+ /* if the eighth element of the list is nil, we are in comment
+ style a. If it is non-nil, we are in comment style b */
+ external = Fcdr (external);
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->comstyle = (NILP (tem)
+ ? 0
+ : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE)
+ ? XINT (tem)
+ : ST_COMMENT_STYLE));
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->comstr_start =
+ RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1;
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->levelstarts = tem;
+
+ external = Fcdr (external);
+ tem = Fcar (external);
+ state->prev_syntax = NILP (tem) ? Smax : XINT (tem);
+ }
}
DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
point is set to where parsing stops.
If fifth arg OLDSTATE is omitted or nil,
parsing assumes that FROM is the beginning of a function.
+
Value is a list of elements describing final state of parsing:
0. depth in parens.
1. character address of start of innermost containing list; nil if none.
6. the minimum paren-depth encountered during this scan.
7. style of comment, if any.
8. character address of start of comment or string; nil if not in one.
- 9. Intermediate data for continuation of parsing (subject to change).
+ 9. List of positions of currently open parens, outermost first.
+10. When the last position scanned holds the first character of a
+ (potential) two character construct, the syntax of that position,
+ otherwise nil. That construct can be a two character comment
+ delimiter or an Escaped or Char-quoted character.
+11..... Possible further internal information used by `parse-partial-sexp'.
+
If third arg TARGETDEPTH is non-nil, parsing stops if the depth
in parentheses becomes equal to TARGETDEPTH.
-Fourth arg STOPBEFORE non-nil means stop when come to
+Fourth arg STOPBEFORE non-nil means stop when we come to
any character that starts a sexp.
Fifth arg OLDSTATE is a list like what this function returns.
It is used to initialize the state of the parse. Elements number 1, 2, 6
are ignored.
-Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
- If it is symbol `syntax-table', stop after the start of a comment or a
+Sixth arg COMMENTSTOP non-nil means stop after the start of a comment.
+ If it is the symbol `syntax-table', stop after the start of a comment or a
string, or after end of a comment or a string. */)
(Lisp_Object from, Lisp_Object to, Lisp_Object targetdepth,
Lisp_Object stopbefore, Lisp_Object oldstate, Lisp_Object commentstop)
target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth. */
validate_region (&from, &to);
+ internalize_parse_state (oldstate, &state);
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
XINT (to),
- target, !NILP (stopbefore), oldstate,
+ target, !NILP (stopbefore),
(NILP (commentstop)
? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
SET_PT_BOTH (state.location, state.location_byte);
- return Fcons (make_number (state.depth),
+ return
+ Fcons (make_number (state.depth),
Fcons (state.prevlevelstart < 0
? Qnil : make_number (state.prevlevelstart),
Fcons (state.thislevelstart < 0
? Qsyntax_table
: make_number (state.comstyle))
: Qnil),
- Fcons (((state.incomment
- || (state.instring >= 0))
- ? make_number (state.comstr_start)
- : Qnil),
- Fcons (state.levelstarts, Qnil))))))))));
+ Fcons (((state.incomment
+ || (state.instring >= 0))
+ ? make_number (state.comstr_start)
+ : Qnil),
+ Fcons (state.levelstarts,
+ Fcons (state.prev_syntax == Smax
+ ? Qnil
+ : make_number (state.prev_syntax),
+ Qnil)))))))))));
}
\f
void