commit 4306aba2d0447fd79c0b749a984ccd7bdbc92361 (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Fri May 10 09:52:09 2024 +0300 * lisp/imenu.el (imenu-flatten): New defcustom (bug#70846). (imenu-level-separator): Adjust the docstring. (imenu--flatten-index-alist): New function revived from the initial implementation of this package. (imenu-choose-buffer-index): Use imenu--flatten-index-alist when imenu-flatten is non-nil. (imenu-buffer-menubar): Remove obsolete variable. * doc/emacs/programs.texi (Imenu): Document imenu-flatten. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index de28a9f1dd4..01a1462044c 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -338,10 +338,13 @@ where it treats each chapter, section, etc., as a definition. together.) @findex imenu +@vindex imenu-flatten If you type @kbd{M-g i} (@code{imenu}), it reads the name of a definition using the minibuffer, then moves point to that definition. You can use completion to specify the name; the command always -displays the whole list of valid names. +displays the whole list of valid names. If you set @code{imenu-flatten} +to a non-@code{nil} value, then instead of the nested menu +you can select a completion candidate from the flat list. @findex imenu-add-menubar-index Alternatively, you can bind the command @code{imenu} to a mouse diff --git a/etc/NEWS b/etc/NEWS index a0a06c58941..d2bedd64b2c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1039,6 +1039,13 @@ docstring, or a comment, or (re)indents the surrounding defun if point is not in a comment or a string. It is by default bound to 'M-q' in 'prog-mode' and all its descendants. +** Imenu + ++++ +*** New user option 'imenu-flatten'. +It defines whether to flatten the list of sections in an imenu +or show it nested. + ** Which Function mode +++ diff --git a/lisp/imenu.el b/lisp/imenu.el index f628936cedc..dd924b449cf 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -142,10 +142,17 @@ names work as tokens." (defcustom imenu-level-separator ":" "The separator between index names of different levels. -Used for making mouse-menu titles and for flattening nested indexes -with name concatenation." +Used for flattening nested indexes with name concatenation." :type 'string) +(defcustom imenu-flatten nil + "Whether to flatten the list of sections in an imenu or show it nested. +If non-nil, popup the completion buffer with a flattened menu. +The string from `imenu-level-separator' is used to separate names of +nested levels while flattening nested indexes with name concatenation." + :type 'boolean + :version "30.1") + (defcustom imenu-generic-skip-comments-and-strings t "When non-nil, ignore text inside comments and strings. Only affects `imenu-default-create-index-function' (and any @@ -763,6 +770,26 @@ Returns t for rescan and otherwise an element or subelement of INDEX-ALIST." menu))))) (popup-menu map event))) +(defun imenu--flatten-index-alist (index-alist &optional concat-names prefix) + ;; Takes a nested INDEX-ALIST and returns a flat index alist. + ;; If optional CONCAT-NAMES is non-nil, then a nested index has its + ;; name and a space concatenated to the names of the children. + ;; Third argument PREFIX is for internal use only. + (mapcan + (lambda (item) + (let* ((name (car item)) + (pos (cdr item)) + (new-prefix (and concat-names + (if prefix + (concat prefix imenu-level-separator name) + name)))) + (cond + ((or (markerp pos) (numberp pos)) + (list (cons new-prefix pos))) + (t + (imenu--flatten-index-alist pos concat-names new-prefix))))) + index-alist)) + (defun imenu-choose-buffer-index (&optional prompt alist) "Let the user select from a buffer index and return the chosen index. @@ -792,6 +819,8 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)." ;; Create a list for this buffer only when needed. (while (eq result t) (setq index-alist (if alist alist (imenu--make-index-alist))) + (when imenu-flatten + (setq index-alist (imenu--flatten-index-alist index-alist t))) (setq result (if (and imenu-use-popup-menu (or (eq imenu-use-popup-menu t) mouse-triggered)) @@ -836,8 +865,6 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook." (interactive) (imenu-add-to-menubar "Index")) -(defvar imenu-buffer-menubar nil) - (defvar-local imenu-menubar-modified-tick 0 "Value of (buffer-chars-modified-tick) when `imenu-update-menubar' was called.") commit 33878f29d1dee4aa1c7d0f30ed57e52138aa566b Author: Jim Porter Date: Thu May 9 22:02:00 2024 -0700 ; Remove unnecessary defvars defined in a file we already 'require' * lisp/eshell/esh-cmd.el (eshell-output-handle, eshell-error-handle): Remove superfluous declarations. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 30494bafb48..b220855299e 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -785,9 +785,6 @@ this grossness will be made to disappear by using `call/cc'..." (eshell-errorn (error-message-string err)) (eshell-close-handles 1)))) -(defvar eshell-output-handle) ;Defined in esh-io.el. -(defvar eshell-error-handle) ;Defined in esh-io.el. - (defmacro eshell-with-copied-handles (object &optional steal-p) "Duplicate current I/O handles, so OBJECT works with its own copy. If STEAL-P is non-nil, these new handles will be stolen from the commit ea2b251ab2b2bc9a3d6f52a22408655be20de266 Author: Po Lu Date: Fri May 10 11:42:37 2024 +0800 Remove redundant encoding of strings in androidvfs.c * java/org/gnu/emacs/EmacsService.java (getDocumentTrees): Accept PROVIDER as a String. * src/android.c (android_init_emacs_service): * src/androidvfs.c (android_saf_root_opendir): Adjust to match. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 1e5f72eed37..2dcaad16e50 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -1401,22 +1401,12 @@ else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.M) otherwise. */ public String[] - getDocumentTrees (byte provider[]) + getDocumentTrees (String provider) { - String providerName; List treeList; List permissions; Uri uri; - try - { - providerName = new String (provider, "US-ASCII"); - } - catch (UnsupportedEncodingException exception) - { - return null; - } - permissions = resolver.getPersistedUriPermissions (); treeList = new ArrayList (); @@ -1425,7 +1415,7 @@ else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.M) uri = permission.getUri (); if (DocumentsContract.isTreeUri (uri) - && uri.getAuthority ().equals (providerName) + && uri.getAuthority ().equals (provider) && permission.isReadPermission ()) /* Make sure the tree document ID is encoded. Refrain from encoding characters such as +:&?#, since they don't @@ -1435,6 +1425,9 @@ else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.M) " +:&?#")); } + /* The empty string array that is ostensibly allocated to provide + the first argument provides just the type of the array to be + returned. */ return treeList.toArray (new String[0]); } diff --git a/src/android.c b/src/android.c index 0dd7702b301..d3b0bc21478 100644 --- a/src/android.c +++ b/src/android.c @@ -1659,7 +1659,7 @@ android_init_emacs_service (void) FIND_METHOD (request_directory_access, "requestDirectoryAccess", "()I"); FIND_METHOD (get_document_trees, "getDocumentTrees", - "([B)[Ljava/lang/String;"); + "(Ljava/lang/String;)[Ljava/lang/String;"); FIND_METHOD (document_id_from_name, "documentIdFromName", "(Ljava/lang/String;Ljava/lang/String;" "[Ljava/lang/String;)I"); diff --git a/src/androidvfs.c b/src/androidvfs.c index 284b1370549..004abd62518 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -4033,7 +4033,7 @@ android_saf_root_opendir (struct android_vnode *vnode) struct android_saf_root_vnode *vp; jobjectArray array; jmethodID method; - jbyteArray authority; + jstring authority; struct android_saf_root_vdir *dir; size_t length; @@ -4043,15 +4043,10 @@ android_saf_root_opendir (struct android_vnode *vnode) { /* Build a string containing the authority. */ length = strlen (vp->authority); - authority = (*android_java_env)->NewByteArray (android_java_env, - length); + authority = (*android_java_env)->NewStringUTF (android_java_env, + vp->authority); android_exception_check (); - /* Copy the authority name to that byte array. */ - (*android_java_env)->SetByteArrayRegion (android_java_env, - authority, 0, length, - (jbyte *) vp->authority); - /* Acquire a list of every tree provided by this authority. */ method = service_class.get_document_trees; @@ -6566,10 +6561,11 @@ static struct android_special_vnode special_vnodes[] = to CODING, and return a Lisp string with the data so produced. Calling this function creates an implicit assumption that - file-name-coding-system is compatible with utf-8-emacs, which is not - unacceptable as users with cause to modify file-name-coding-system - should be aware and prepared for consequences towards files stored on - different filesystems, including virtual ones. */ + `file-name-coding-system' is compatible with `utf-8-emacs', which is + not unacceptable as users with cause to modify + file-name-coding-system should be aware and prepared for adverse + consequences affecting files stored on different filesystems, + including virtual ones. */ static Lisp_Object android_vfs_convert_name (const char *name, Lisp_Object coding) commit dc5390d06a65f4d481b8bb20da4f6715c2079ea6 Author: Po Lu Date: Fri May 10 11:32:42 2024 +0800 Document a problem with Microsoft SwiftKey * etc/PROBLEMS (Runtime problems specific to Android): Document incompatibility with Microsoft Swiftkey. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 27761dddf04..2922f5a384c 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3623,6 +3623,17 @@ The organization of the Settings app might disagree with that illustrated above, which if true you should consult the documentation or any search mechanism for it. +** Emacs is not compatible with the "Microsoft SwiftKey" input method. + +When enabled, windows are repeatedly recentered around earlier buffer +positions as they are scrolled. The underlying cause is that Microsoft +SwiftKey aggressively forces point towards word boundaries, which motion +is sometimes received and duly processed by Emacs after the window in +question has already been scrolled past its target position, with the +result that the next redisplay recenters the window around this outdated +position. There is no solution but installing a more +cooperative--and preferably free--input method. + * Build-time problems ** Configuration commit 671c9e08b2286d8c32ac6ca00eadc4c8d5e1d5e4 Author: Po Lu Date: Fri May 10 11:01:29 2024 +0800 Fix bug#70856 * lisp/pixel-scroll.el (pixel-scroll-precision-scroll-down) (pixel-scroll-precision-scroll-up): Apply finer threshold for the minimum unit of scrolling. (pixel-scroll-precision-scroll-down-page): Document true restrictions on DELTA. (bug#70856) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 4bf912e54c0..20c7f3fe596 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -501,8 +501,8 @@ Otherwise, redisplay will reset the window's vscroll." ;;;###autoload (defun pixel-scroll-precision-scroll-down-page (delta) "Scroll the current window down by DELTA pixels. -Note that this function doesn't work if DELTA is larger than -the height of the current window." +Note that this function doesn't work if DELTA is larger than or +equal to the height of the current window." (let* ((desired-pos (posn-at-x-y 0 (+ delta (window-tab-line-height) (window-header-line-height)))) @@ -551,8 +551,7 @@ the height of the current window." (defun pixel-scroll-precision-scroll-down (delta) "Scroll the current window down by DELTA pixels." - (let ((max-height (- (window-text-height nil t) - (frame-char-height)))) + (let ((max-height (1- (window-text-height nil t)))) (while (> delta max-height) (pixel-scroll-precision-scroll-down-page max-height) (setq delta (- delta max-height))) @@ -666,8 +665,7 @@ to `pixel-scroll-precision-interpolation-factor'." (defun pixel-scroll-precision-scroll-up (delta) "Scroll the current window up by DELTA pixels." - (let ((max-height (- (window-text-height nil t) - (frame-char-height)))) + (let ((max-height (window-text-height nil t))) (when (> max-height 0) (while (> delta max-height) (pixel-scroll-precision-scroll-up-page max-height) commit c900c707e8f3075dfe57c39a8a6363ba4575035f Author: Po Lu Date: Fri May 10 09:05:54 2024 +0800 Fix earlier change to content URI resolution on Android * java/org/gnu/emacs/EmacsService.java (openContentUri): Return -1 if fd be NULL. * src/androidvfs.c (android_authority_open): Detect SecurityException and suchlike. (android_vfs_init): Initialize exception classes on Android 4.4. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 5548748ddfa..1e5f72eed37 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -968,7 +968,7 @@ invocation of app_process (through android-emacs) can string; make it writable if WRITABLE, and readable if READABLE. Truncate the file if TRUNCATE. - Value is the resulting file descriptor or an exception will be + Value is the resulting file descriptor, -1, or an exception will be raised. */ public int @@ -999,6 +999,9 @@ invocation of app_process (through android-emacs) can minimum requirement for access to /content/by-authority. */ fd = resolver.openFileDescriptor (Uri.parse (uri), mode); + if (fd == null) + return -1; + i = fd.detachFd (); fd.close (); diff --git a/src/androidvfs.c b/src/androidvfs.c index c326896d4c3..284b1370549 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -3023,6 +3023,104 @@ android_check_content_access (const char *uri, int mode) +/* Functions shared by authority and SAF nodes. */ + +/* Check for JNI exceptions, clear them, and set errno accordingly. + Also, free each of the N local references given as arguments if an + exception takes place. + + Value is 1 if an exception has taken place, 0 otherwise. + + If the exception thrown derives from FileNotFoundException, set + errno to ENOENT. + + If the exception thrown derives from SecurityException, set errno + to EACCES. + + If the exception thrown derives from OperationCanceledException, + set errno to EINTR. + + If the exception thrown derives from UnsupportedOperationException, + set errno to ENOSYS. + + If the exception thrown derives from OutOfMemoryException, call + `memory_full'. + + If the exception thrown is anything else, set errno to EIO. */ + +static int +android_saf_exception_check (int n, ...) +{ + jthrowable exception; + JNIEnv *env; + va_list ap; + int new_errno; + + env = android_java_env; + va_start (ap, n); + + /* First, check for an exception. */ + + if (!(*env)->ExceptionCheck (env)) + { + /* No exception has taken place. Return 0. */ + va_end (ap); + return 0; + } + + /* Print the exception. */ + (*env)->ExceptionDescribe (env); + + exception = (*env)->ExceptionOccurred (env); + + if (!exception) + /* JNI couldn't return a local reference to the exception. */ + memory_full (0); + + /* Clear the exception, making it safe to subsequently call other + JNI functions. */ + (*env)->ExceptionClear (env); + + /* Delete each of the N arguments. */ + + while (n > 0) + { + ANDROID_DELETE_LOCAL_REF (va_arg (ap, jobject)); + n--; + } + + /* Now set errno or signal memory_full as required. */ + + if ((*env)->IsInstanceOf (env, (jobject) exception, + file_not_found_exception)) + new_errno = ENOENT; + else if ((*env)->IsInstanceOf (env, (jobject) exception, + security_exception)) + new_errno = EACCES; + else if ((*env)->IsInstanceOf (env, (jobject) exception, + operation_canceled_exception)) + new_errno = EINTR; + else if ((*env)->IsInstanceOf (env, (jobject) exception, + unsupported_operation_exception)) + new_errno = ENOSYS; + else if ((*env)->IsInstanceOf (env, (jobject) exception, + out_of_memory_error)) + { + ANDROID_DELETE_LOCAL_REF ((jobject) exception); + memory_full (0); + } + else + new_errno = EIO; + + /* expression is still a local reference! */ + ANDROID_DELETE_LOCAL_REF ((jobject) exception); + errno = new_errno; + va_end (ap); + return 1; +} + + + /* Content authority-based vnode implementation. /content/by-authority is a simple vnode implementation that converts @@ -3201,7 +3299,9 @@ android_authority_open (struct android_vnode *vnode, int flags, (jboolean) !(mode & O_WRONLY), (jboolean) ((mode & O_TRUNC) != 0)); - android_exception_check_1 (string); + if (android_saf_exception_check (1, string)) + return -1; + ANDROID_DELETE_LOCAL_REF (string); /* If fd is -1, just assume that the file does not exist, and return -1 with errno set to ENOENT. */ @@ -3209,18 +3309,12 @@ android_authority_open (struct android_vnode *vnode, int flags, if (fd == -1) { errno = ENOENT; - goto skip; + return -1; } if (mode & O_CLOEXEC) android_close_on_exec (fd); - skip: - ANDROID_DELETE_LOCAL_REF (string); - - if (fd == -1) - return -1; - *fd_return = fd; return 0; } @@ -4089,100 +4183,6 @@ android_saf_root_get_directory (int dirfd) thread. */ static bool inside_saf_critical_section; -/* Check for JNI exceptions, clear them, and set errno accordingly. - Also, free each of the N local references given as arguments if an - exception takes place. - - Value is 1 if an exception has taken place, 0 otherwise. - - If the exception thrown derives from FileNotFoundException, set - errno to ENOENT. - - If the exception thrown derives from SecurityException, set errno - to EACCES. - - If the exception thrown derives from OperationCanceledException, - set errno to EINTR. - - If the exception thrown derives from UnsupportedOperationException, - set errno to ENOSYS. - - If the exception thrown derives from OutOfMemoryException, call - `memory_full'. - - If the exception thrown is anything else, set errno to EIO. */ - -static int -android_saf_exception_check (int n, ...) -{ - jthrowable exception; - JNIEnv *env; - va_list ap; - int new_errno; - - env = android_java_env; - va_start (ap, n); - - /* First, check for an exception. */ - - if (!(*env)->ExceptionCheck (env)) - { - /* No exception has taken place. Return 0. */ - va_end (ap); - return 0; - } - - /* Print the exception. */ - (*env)->ExceptionDescribe (env); - - exception = (*env)->ExceptionOccurred (env); - - if (!exception) - /* JNI couldn't return a local reference to the exception. */ - memory_full (0); - - /* Clear the exception, making it safe to subsequently call other - JNI functions. */ - (*env)->ExceptionClear (env); - - /* Delete each of the N arguments. */ - - while (n > 0) - { - ANDROID_DELETE_LOCAL_REF (va_arg (ap, jobject)); - n--; - } - - /* Now set errno or signal memory_full as required. */ - - if ((*env)->IsInstanceOf (env, (jobject) exception, - file_not_found_exception)) - new_errno = ENOENT; - else if ((*env)->IsInstanceOf (env, (jobject) exception, - security_exception)) - new_errno = EACCES; - else if ((*env)->IsInstanceOf (env, (jobject) exception, - operation_canceled_exception)) - new_errno = EINTR; - else if ((*env)->IsInstanceOf (env, (jobject) exception, - unsupported_operation_exception)) - new_errno = ENOSYS; - else if ((*env)->IsInstanceOf (env, (jobject) exception, - out_of_memory_error)) - { - ANDROID_DELETE_LOCAL_REF ((jobject) exception); - memory_full (0); - } - else - new_errno = EIO; - - /* expression is still a local reference! */ - ANDROID_DELETE_LOCAL_REF ((jobject) exception); - errno = new_errno; - va_end (ap); - return 1; -} - /* Return file status for the document designated by ID_NAME within the document tree identified by URI_NAME. @@ -6883,15 +6883,9 @@ android_vfs_init (JNIEnv *env, jobject manager) eassert (java_string_class); (*env)->DeleteLocalRef (env, old); - /* And initialize those used on Android 5.0 and later. */ - - if (android_get_current_api_level () < 21) + if (android_get_current_api_level () < 19) return; - android_init_cursor_class (env); - android_init_entry_class (env); - android_init_fd_class (env); - /* Initialize each of the exception classes used by `android_saf_exception_check'. */ @@ -6920,6 +6914,15 @@ android_vfs_init (JNIEnv *env, jobject manager) (*env)->DeleteLocalRef (env, old); eassert (out_of_memory_error); + /* And initialize those used on Android 5.0 and later. */ + + if (android_get_current_api_level () < 21) + return; + + android_init_cursor_class (env); + android_init_entry_class (env); + android_init_fd_class (env); + /* Initialize the semaphore used to wait for SAF operations to complete. */ commit d335f28aa9bfb85d0e35b838ca867d97ebe5b974 Author: Andrew G Cohen Date: Mon Apr 8 07:36:17 2024 +0800 Don't limit gnus thread searches to a single message * lisp/gnus/gnus-search.el (gnus-search-single-p): Searches for a single message id finish after finding this one message; thread searches continue until all messages are found. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index a967d6d71da..9cff2e2f109 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1002,10 +1002,11 @@ Responsible for handling and, or, and parenthetical expressions.") (defsubst gnus-search-single-p (query) "Return t if QUERY is a search for a single message." - (let ((q (alist-get 'parsed-query query))) - (and (= (length q ) 1) - (consp (car-safe q)) - (eq (caar q) 'id)))) + (unless (alist-get 'thread query) + (let ((q (alist-get 'parsed-query query))) + (and (= (length q ) 1) + (consp (car-safe q)) + (eq (caar q) 'id))))) (cl-defmethod gnus-search-transform ((engine gnus-search-engine) (query list)) commit 006d5b70f343d95c7154632a2b59056d940018d5 Author: Andrew G Cohen Date: Fri Oct 6 14:34:28 2023 +0800 Improve doc-type determination in doc-view * lisp/doc-view.el (doc-view-set-doc-type): If buffer-file-name is not set try the buffer-name to identify the doc type. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index c4b384c35c6..4ae9a5e6629 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -2092,35 +2092,35 @@ GOTO-PAGE-FN other than `doc-view-goto-page'." (defun doc-view-set-doc-type () "Figure out the current document type (`doc-view-doc-type')." (let ((name-types - (when buffer-file-name - (cdr (assoc-string - (file-name-extension buffer-file-name) - '( - ;; DVI - ("dvi" dvi) - ;; PDF - ("pdf" pdf) ("epdf" pdf) - ;; EPUB - ("epub" epub) - ;; PostScript - ("ps" ps) ("eps" ps) - ;; DjVu - ("djvu" djvu) - ;; OpenDocument formats. - ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf) - ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf) - ("ots" odf) ("otp" odf) ("otg" odf) - ;; Microsoft Office formats (also handled by the odf - ;; conversion chain). - ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) - ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf) - ;; CBZ - ("cbz" cbz) - ;; FB2 - ("fb2" fb2) - ;; (Open)XPS - ("xps" xps) ("oxps" oxps)) - t)))) + (cdr (assoc-string + (file-name-extension + (or buffer-file-name (buffer-name (current-buffer)))) + '( + ;; DVI + ("dvi" dvi) + ;; PDF + ("pdf" pdf) ("epdf" pdf) + ;; EPUB + ("epub" epub) + ;; PostScript + ("ps" ps) ("eps" ps) + ;; DjVu + ("djvu" djvu) + ;; OpenDocument formats. + ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf) + ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf) + ("ots" odf) ("otp" odf) ("otg" odf) + ;; Microsoft Office formats (also handled by the odf + ;; conversion chain). + ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) + ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf) + ;; CBZ + ("cbz" cbz) + ;; FB2 + ("fb2" fb2) + ;; (Open)XPS + ("xps" xps) ("oxps" oxps)) + t))) (content-types (save-excursion (goto-char (point-min)) commit e29eb0e0f18d7b1e4724c1bb26ff9718fe08548b Author: Andrew G Cohen Date: Sat Apr 27 09:10:44 2024 +0800 Find correct parent for articles in gnus * lisp/gnus/gnus-sum.el (gnus-summary-refer-parent-article): When an article's headers have been altered, use the altered headers to find the parent. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index dc66e1375ab..d4895f3c5f8 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -8939,7 +8939,8 @@ The difference between N and the number of articles fetched is returned." (while (and (> n 0) (not error)) (setq header (gnus-summary-article-header)) - (if (and (eq (mail-header-number header) + (if (and (null gnus-alter-header-function) + (eq (mail-header-number header) (cdr gnus-article-current)) (equal gnus-newsgroup-name (car gnus-article-current))) @@ -8947,7 +8948,8 @@ The difference between N and the number of articles fetched is returned." ;; displayed article, then we take a look at the actual ;; References header, since this is slightly more ;; reliable than the References field we got from the - ;; server. + ;; server. But if we altered the header, we should prefer + ;; the version from the header vector. (with-current-buffer gnus-original-article-buffer (nnheader-narrow-to-headers) (unless (setq ref (message-fetch-field "references")) @@ -8955,8 +8957,8 @@ The difference between N and the number of articles fetched is returned." (setq ref (gnus-extract-message-id-from-in-reply-to ref)))) (widen)) (setq ref - ;; It's not the current article, so we take a bet on - ;; the value we got from the server. + ;; It's not the current article, or we altered the header, + ;; so we use whats in the header vector. (mail-header-references header))) (if (and ref (not (equal ref ""))) commit 1b8613063cf6a3b9a1f484e1179877e36ba4b5e0 Author: Andrew G Cohen Date: Thu May 9 16:44:21 2024 +0800 ; Provide documentation example for gnus-alter-header-function * doc/misc/gnus.texi (Low-Level Threading): Provide an example of using gnus-alter-header-function to remove unwanted items in References header. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 8aa7f855aea..c5e4c885ccf 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -7423,6 +7423,22 @@ meaningful. Here's one example: header)))) @end lisp +And another example: the protonmail bridge adds fake message-ids to +@code{References} in message headers, which can confuse threading. To +remove these spurious ids + +@lisp +(setq gnus-alter-header-function 'fix-protonmail-references) + +(defun fix-protonmail-references (header) + (setf (mail-header-references header) + (mapconcat + #'(lambda (x) (if (string-search "protonmail.internalid" x) "" x)) + (gnus-split-references (mail-header-references header)) " ")) + header) + + @end lisp + @end table commit 082666e528646aa9a299bd77854305c9b8231015 Author: Andrew G Cohen Date: Fri May 10 08:01:15 2024 +0800 ; * lisp/mail/smtpmail.el (smtpmail-try-auth-method): quote symbol. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index ed21e777b28..98083c0489a 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -638,7 +638,7 @@ USER and PASSWORD should be non-nil." 235)) (cl-defmethod smtpmail-try-auth-method - (process (_mech (eql xoauth2)) user password) + (process (_mech (eql 'xoauth2)) user password) (smtpmail-command-or-throw process (concat "AUTH XOAUTH2 " commit 42c0686d6180a7ca1b89f7bde2f9fd17d6a67217 Author: Jim Porter Date: Thu May 9 17:15:14 2024 -0700 ; Fix an edge case with Eshell globs when the directory part is quoted * lisp/eshell/esh-util.el (eshell-split-filename): Escaping shouldn't matter for splitting the name (no other shells handle it like this). * test/lisp/eshell/em-glob-tests.el (em-glob-test/convert/quoted-start-directory): New test. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 129134814e3..47645231b75 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -458,8 +458,7 @@ Prepend remote identification of `default-directory', if any." (string-prefix-p "//" filename)) (setq index 2)) (while (< index len) - (when (and (eq (aref filename index) ?/) - (not (get-text-property index 'escaped filename))) + (when (eq (aref filename index) ?/) (push (if (= curr-start index) "/" (substring filename curr-start (1+ index))) parts) diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 40cdfd1a676..d7d8f59eda0 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -146,6 +146,12 @@ value of `eshell-glob-splice-results'." `(,(format "%s/some/where/" remote) (("\\`.*\\.el\\'" . "\\`\\.")) nil))))) +(ert-deftest em-glob-test/convert/quoted-start-directory () + "Test converting a glob starting in a quoted directory name." + (should (equal (eshell-glob-convert + (concat (eshell-escape-arg "some where/") "*.el")) + '("./some where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + ;; Glob matching commit e2e8c892ceaf27dcde9049f4a757d8fa853fe54a Author: Jakub Ječmínek Date: Tue Mar 19 21:34:57 2024 +0100 ; Reference the xoauth2 method in nnimap-authenticator docstring * lisp/gnus/nnimap.el (nnimap-authenticator): Update variable documentation to include xoauth2 method. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 17a55f988c9..c61dfecfa7a 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -97,7 +97,7 @@ Uses the same syntax as `nnmail-split-methods'.") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods), `anonymous', -`login', `plain' and `cram-md5'.") +`login', `plain', `cram-md5' and `xoauth2'.") (defvoo nnimap-expunge 'on-exit "When to expunge deleted messages. commit fd333fd214f8e0740a4ec51705a32ed6cca93c57 Author: Paul Eggert Date: Thu May 9 12:24:18 2024 -0700 Improve static checking when using upcoming GCC 13.3 * src/lisp.h: In GCC 13.3 and later, do not ignore -Wanalyzer-allocation-size. * src/marker.c: In GCC 13.3 and later, do not ignore -Wanalyzer-deref-before-check. diff --git a/src/lisp.h b/src/lisp.h index bf928f51b17..010d63e4dd9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5701,7 +5701,7 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577 which causes GCC to mistakenly complain about the memory allocation in SAFE_ALLOCA_LISP_EXTRA. */ -#if GNUC_PREREQ (13, 0, 0) && !GNUC_PREREQ (14, 0, 0) +#if __GNUC__ == 13 && __GNUC_MINOR__ < 3 # pragma GCC diagnostic ignored "-Wanalyzer-allocation-size" #endif diff --git a/src/marker.c b/src/marker.c index 2abc951fc76..f016bf9c088 100644 --- a/src/marker.c +++ b/src/marker.c @@ -21,7 +21,7 @@ along with GNU Emacs. If not, see . */ #include /* Work around GCC bug 113253. */ -#if __GNUC__ == 13 +#if __GNUC__ == 13 && __GNUC_MINOR__ < 3 # pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check" #endif commit e8ac15500424ebf40739422f40d966dc067f42df Author: Daniel Semyonov Date: Mon Apr 29 23:40:50 2024 +0300 ; Fix example code in nnfeed * lisp/gnus/nnfeed.el: Backend declaration example was incorrect. diff --git a/lisp/gnus/nnfeed.el b/lisp/gnus/nnfeed.el index 0bf599553e4..d6963b2e929 100644 --- a/lisp/gnus/nnfeed.el +++ b/lisp/gnus/nnfeed.el @@ -46,7 +46,7 @@ ;; (defvoo nnfoo-read-feed-function #'nnfoo--read-feed ;; nil nnfeed-read-feed-function) ;; ... -;; (gnus-declare-backend (symbol-name nnfeed-backend) 'address) +;; (gnus-declare-backend (symbol-name nnfeed-backend) 'none 'address) ;; ;; (provide 'nnfoo) ;; commit 04363f9924c0f63d28f789ccdadd81a87e6f7417 Author: Michael Albinus Date: Thu May 9 10:38:37 2024 +0200 Tramp code cleanup * lisp/net/tramp-compat.el (tramp-compat-seq-keep): New defalias. * lisp/net/tramp.el (tramp-enable-method): * lisp/net/tramp-adb.el (tramp-adb-parse-device-names): * lisp/net/tramp-cache.el (tramp-list-connections): * lisp/net/tramp-cmds.el (tramp-bug, tramp-append-tramp-buffers): * lisp/net/tramp-container.el (tramp-container--completion-function) (tramp-toolbox--completion-function) (tramp-flatpak--completion-function) (tramp-apptainer--completion-function): * lisp/net/tramp-rclone.el (tramp-rclone-parse-device-names): Use it. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index da23d062c2e..b794d8b481a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -222,15 +222,14 @@ arguments to pass to the OPERATION." ;;;###tramp-autoload (defun tramp-adb-parse-device-names (_ignore) "Return a list of (nil host) tuples allowed to access." - (delq nil - (mapcar - (lambda (line) - (when (string-match - (rx bol (group (+ (not blank))) (+ blank) "device" eol) line) - ;; Replace ":" by "#". - `(nil ,(tramp-compat-string-replace - ":" tramp-prefix-port-format (match-string 1 line))))) - (tramp-process-lines nil tramp-adb-program "devices")))) + (tramp-compat-seq-keep + (lambda (line) + (when (string-match + (rx bol (group (+ (not blank))) (+ blank) "device" eol) line) + ;; Replace ":" by "#". + `(nil ,(tramp-compat-string-replace + ":" tramp-prefix-port-format (match-string 1 line))))) + (tramp-process-lines nil tramp-adb-program "devices"))) (defun tramp-adb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 225a26ad1cd..30c38d19fb7 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -540,13 +540,13 @@ PROPERTIES is a list of file properties (strings)." (defun tramp-list-connections () "Return all active `tramp-file-name' structs according to `tramp-cache-data'." (let ((tramp-verbose 0)) - (delq nil (mapcar - (lambda (key) - (and (tramp-file-name-p key) - (null (tramp-file-name-localname key)) - (tramp-connection-property-p key "process-buffer") - key)) - (hash-table-keys tramp-cache-data))))) + (tramp-compat-seq-keep + (lambda (key) + (and (tramp-file-name-p key) + (null (tramp-file-name-localname key)) + (tramp-connection-property-p key "process-buffer") + key)) + (hash-table-keys tramp-cache-data)))) (defun tramp-dump-connection-properties () "Write persistent connection properties into file \ diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index d3af7a009ec..f381c2e9ff0 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -691,25 +691,25 @@ This is needed if there are compatibility problems." (format "tramp (%s %s/%s)" ; package name and version tramp-version tramp-repository-branch tramp-repository-version) (sort - (delq nil (mapcar - (lambda (x) - (and x (boundp x) (not (get x 'tramp-suppress-trace)) - (cons x 'tramp-reporter-dump-variable))) - (append - (mapcar #'intern (all-completions "tramp-" obarray #'boundp)) - ;; Non-Tramp variables of interest. - '(shell-prompt-pattern - backup-by-copying - backup-by-copying-when-linked - backup-by-copying-when-mismatch - backup-by-copying-when-privileged-mismatch - backup-directory-alist - password-cache - password-cache-expiry - remote-file-name-inhibit-cache - connection-local-profile-alist - connection-local-criteria-alist - file-name-handler-alist)))) + (tramp-compat-seq-keep + (lambda (x) + (and x (boundp x) (not (get x 'tramp-suppress-trace)) + (cons x 'tramp-reporter-dump-variable))) + (append + (mapcar #'intern (all-completions "tramp-" obarray #'boundp)) + ;; Non-Tramp variables of interest. + '(shell-prompt-pattern + backup-by-copying + backup-by-copying-when-linked + backup-by-copying-when-mismatch + backup-by-copying-when-privileged-mismatch + backup-directory-alist + password-cache + password-cache-expiry + remote-file-name-inhibit-cache + connection-local-profile-alist + connection-local-criteria-alist + file-name-handler-alist))) (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y))))) 'tramp-load-report-modules ; pre-hook @@ -792,12 +792,10 @@ buffer in your bug report. ;; Dump buffer local variables. (insert "\nlocal variables:\n================") - (dolist (buffer - (delq nil - (mapcar - (lambda (b) - (when (string-match-p "\\*tramp/" (buffer-name b)) b)) - (buffer-list)))) + (dolist (buffer (tramp-compat-seq-keep + (lambda (b) + (when (string-match-p "\\*tramp/" (buffer-name b)) b)) + (buffer-list))) (let ((reporter-eval-buffer buffer) (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) (with-current-buffer elbuf diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 98de0dba7ff..d7492be63f2 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -294,6 +294,13 @@ Also see `ignore'." (autoload 'netrc-parse "netrc") (netrc-parse file)))) +;; Function `seq-keep' is new in Emacs 29.1. +(defalias 'tramp-compat-seq-keep + (if (fboundp 'seq-keep) + #'seq-keep + (lambda (function sequence) + (delq nil (seq-map function sequence))))) + ;; User option `password-colon-equivalents' is new in Emacs 30.1. (if (boundp 'password-colon-equivalents) (defvaralias diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 7559f958838..902fc6a451b 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -230,7 +230,7 @@ see its function help for a description of the format." (concat program " ps --format '{{.ID}}\t{{.Names}}'"))) (lines (split-string raw-list "\n" 'omit)) (names - (mapcar + (tramp-compat-seq-keep (lambda (line) (when (string-match (rx bol (group (1+ nonl)) @@ -238,7 +238,7 @@ see its function help for a description of the format." line) (or (match-string 2 line) (match-string 1 line)))) lines))) - (mapcar (lambda (name) (list nil name)) (delq nil names))))) + (mapcar (lambda (name) (list nil name)) names)))) ;;;###tramp-autoload (defun tramp-kubernetes--completion-function (method) @@ -360,7 +360,7 @@ see its function help for a description of the format." (when-let ((raw-list (shell-command-to-string (concat program " list -c"))) ;; Ignore header line. (lines (cdr (split-string raw-list "\n" 'omit))) - (names (mapcar + (names (tramp-compat-seq-keep (lambda (line) (when (string-match (rx bol (1+ (not space)) @@ -368,7 +368,7 @@ see its function help for a description of the format." line) (match-string 1 line))) lines))) - (mapcar (lambda (name) (list nil name)) (delq nil names))))) + (mapcar (lambda (name) (list nil name)) names)))) ;;;###tramp-autoload (defun tramp-flatpak--completion-function (method) @@ -384,7 +384,7 @@ see its function help for a description of the format." ;; Ignore header line. (concat program " ps --columns=instance,application | cat -"))) (lines (split-string raw-list "\n" 'omit)) - (names (mapcar + (names (tramp-compat-seq-keep (lambda (line) (when (string-match (rx bol (* space) (group (+ (not space))) @@ -392,7 +392,7 @@ see its function help for a description of the format." line) (or (match-string 2 line) (match-string 1 line)))) lines))) - (mapcar (lambda (name) (list nil name)) (delq nil names))))) + (mapcar (lambda (name) (list nil name)) names)))) ;;;###tramp-autoload (defun tramp-apptainer--completion-function (method) @@ -405,7 +405,7 @@ see its function help for a description of the format." (shell-command-to-string (concat program " instance list"))) ;; Ignore header line. (lines (cdr (split-string raw-list "\n" 'omit))) - (names (mapcar + (names (tramp-compat-seq-keep (lambda (line) (when (string-match (rx bol (group (1+ (not space))) @@ -414,7 +414,7 @@ see its function help for a description of the format." line) (match-string 1 line))) lines))) - (mapcar (lambda (name) (list nil name)) (delq nil names))))) + (mapcar (lambda (name) (list nil name)) names)))) ;;;###tramp-autoload (defvar tramp-default-remote-shell) ;; Silence byte compiler. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index ced3c1b5aa8..03b0dedbb70 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -189,12 +189,11 @@ arguments to pass to the OPERATION." (defun tramp-rclone-parse-device-names (_ignore) "Return a list of (nil host) tuples allowed to access." (with-tramp-connection-property nil "rclone-device-names" - (delq nil - (mapcar - (lambda (line) - (when (string-match (rx bol (group (+ (not blank))) ":" eol) line) - `(nil ,(match-string 1 line)))) - (tramp-process-lines nil tramp-rclone-program "listremotes"))))) + (tramp-compat-seq-keep + (lambda (line) + (when (string-match (rx bol (group (+ (not blank))) ":" eol) line) + `(nil ,(match-string 1 line)))) + (tramp-process-lines nil tramp-rclone-program "listremotes")))) ;; File name primitives. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7d599377969..f92a7ff14d4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1466,7 +1466,7 @@ calling HANDLER.") (list (completing-read "method: " - (seq-keep + (tramp-compat-seq-keep (lambda (x) (when-let ((name (symbol-name x)) ;; It must match `tramp-enable-METHOD-method'. commit e0ca21f9fb82fb27bb6a55a3c07b2ad1492f7680 Author: Charalampos Mitrodimas Date: Sat May 4 22:45:15 2024 +0300 Fix 'srecode-all-template-hash' always returning nil The issue was that the function always returned nil because the closing parentheses were in the wrong position. This meant that the function couldn't give back the data it was supposed to, making the whole srecode system not work properly. By moving the parentheses to the correct place, the function now returns a hash table with all the templates it finds. * lisp/cedet/srecode/find.el (srecode-all-template-hash): Adjusted the position of closing parentheses so that the mhash variable is returned correctly. (Bug#70765) Copyright-paperwork-exempt: yes diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index 41030aa6944..db6b3988562 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -233,8 +233,8 @@ templates." (when (or (not predicate) (funcall predicate temp)) (puthash key temp mhash))) - (oref tab namehash)))) - mhash)))) + (oref tab namehash)))))) + mhash)) (defun srecode-calculate-default-template-string (hash) "Calculate the name of the template to use as a DEFAULT. commit 751e21af42e905d0448baa7be4a7ae6d6ae6734a Author: Lin Sun Date: Wed May 1 06:55:31 2024 +0000 ; Check process in 'python-shell-completion-at-point' * lisp/progmodes/python.el (python-shell-completion-at-point): Check the PROCESS argument at the beginning of the function. (Bug#70707) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 0bee98871e4..831bec7f4af 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4738,6 +4738,8 @@ as one line, which is required by native completion." Optional argument PROCESS forces completions to be retrieved using that one instead of current buffer's process." (setq process (or process (get-buffer-process (current-buffer)))) + (unless process + (user-error "No active python inferior process")) (let* ((is-shell-buffer (derived-mode-p 'inferior-python-mode)) (line-start (if is-shell-buffer ;; Working on a shell buffer: use prompt end. commit 08799957f0bade04a8f65a06dac1606346ee8733 Author: Noah Peart Date: Tue Apr 30 03:19:11 2024 -0700 Add bitwise assignment operators to 'python--treesit-operators' * lisp/progmodes/python.el (python--treesit-operators): Add bitwise assignment operators. (Bug#70666) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 764ef03da8a..0bee98871e4 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1022,9 +1022,9 @@ It makes underscores and dots word constituent chars.") "copyright" "credits" "exit" "license" "quit")) (defvar python--treesit-operators - '("-" "-=" "!=" "*" "**" "**=" "*=" "/" "//" "//=" "/=" "&" "%" "%=" - "^" "+" "->" "+=" "<" "<<" "<=" "<>" "=" ":=" "==" ">" ">=" ">>" "|" - "~" "@" "@=")) + '("-" "-=" "!=" "*" "**" "**=" "*=" "/" "//" "//=" "/=" "&" "&=" "%" "%=" + "^" "^=" "+" "->" "+=" "<" "<<" "<<=" "<=" "<>" "=" ":=" "==" ">" ">=" + ">>" ">>=" "|" "|=" "~" "@" "@=")) (defvar python--treesit-special-attributes '("__annotations__" "__closure__" "__code__" commit 58a7b99823c5c42161e9acf2abf6c22afd4da4cd Author: Po Lu Date: Thu May 9 15:02:06 2024 +0800 Intern additional symbols ahead-of-time * src/gnutls.c (Fgnutls_available_p, syms_of_gnutls): * src/minibuf.c (Fread_buffer, syms_of_minibuf): Define and intern symbols overlooked in the previous change. diff --git a/src/gnutls.c b/src/gnutls.c index efee2dccbb4..3ff7f21d5a5 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -2953,22 +2953,22 @@ Any GnuTLS extension with ID up to 100 return Qnil; # endif /* WINDOWSNT */ - capabilities = Fcons (intern("gnutls"), capabilities); + capabilities = Fcons (Qgnutls, capabilities); # ifdef HAVE_GNUTLS_EXT__DUMBFW - capabilities = Fcons (intern("ClientHello Padding"), capabilities); + capabilities = Fcons (QClientHello_Padding, capabilities); # endif # ifdef HAVE_GNUTLS3 - capabilities = Fcons (intern("gnutls3"), capabilities); - capabilities = Fcons (intern("digests"), capabilities); - capabilities = Fcons (intern("ciphers"), capabilities); + capabilities = Fcons (Qgnutls3, capabilities); + capabilities = Fcons (Qdigests, capabilities); + capabilities = Fcons (Qciphers, capabilities); # ifdef HAVE_GNUTLS_AEAD - capabilities = Fcons (intern("AEAD-ciphers"), capabilities); + capabilities = Fcons (QAEAD_ciphers, capabilities); # endif - capabilities = Fcons (intern("macs"), capabilities); + capabilities = Fcons (Qmacs, capabilities); # ifdef HAVE_GNUTLS_EXT_GET_NAME for (unsigned int ext=0; ext < 100; ext++) @@ -3120,6 +3120,7 @@ are as per the GnuTLS logging conventions. */); defsubr (&Sgnutls_available_p); + DEFSYM (QAEAD_ciphers, "AEAD-ciphers"); DEFSYM (QCcertificate, ":certificate"); DEFSYM (QCcertificate_id, ":certificate-id"); DEFSYM (QCcertificate_security_level, ":certificate-security-level"); @@ -3135,6 +3136,7 @@ are as per the GnuTLS logging conventions. */); DEFSYM (QCissuer, ":issuer"); DEFSYM (QCissuer_unique_id, ":issuer-unique-id"); DEFSYM (QCkey_exchange, ":key-exchange"); + DEFSYM (QClientHello_Padding, "ClientHello Padding"); DEFSYM (QCmac, ":mac"); DEFSYM (QCmissing_ocsp_status, ":missing-ocsp-status"); DEFSYM (QCno_host_match, ":no-host-match"); @@ -3163,4 +3165,9 @@ are as per the GnuTLS logging conventions. */); DEFSYM (QCvalid_to, ":valid-to"); DEFSYM (QCversion, ":version"); DEFSYM (QCwarnings, ":warnings"); + DEFSYM (Qciphers, "ciphers"); + DEFSYM (Qdigests, "digests"); + DEFSYM (Qgnutls, "gnutls"); + DEFSYM (Qgnutls3, "gnutls3"); + DEFSYM (Qmacs, "macs"); } diff --git a/src/minibuf.c b/src/minibuf.c index 86877badd2a..9c1c86680d4 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1538,7 +1538,7 @@ function, instead of the usual behavior. */) STRING_MULTIBYTE (prompt)); } - prompt = CALLN (Ffuncall, intern("format-prompt"), + prompt = CALLN (Ffuncall, Qformat_prompt, prompt, CONSP (def) ? XCAR (def) : def); } @@ -2533,4 +2533,5 @@ showing the *Completions* buffer, if any. */); DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit"); DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer"); DEFSYM (Qcompleting_read_function, "completing-read-function"); + DEFSYM (Qformat_prompt, "format-prompt"); } commit 67ab6bcdbac572a6266d7c9d15833bd2ddd049fa Author: Po Lu Date: Thu May 9 14:58:45 2024 +0800 Replace calls to intern with a constant string with DEFSYMs * src/alloc.c (display_malloc_warning, syms_of_alloc): * src/buffer.c (Fmake_indirect_buffer, Fbuffer_local_variables) (Frename_buffer, Fkill_buffer, Fset_buffer_major_mode) (Fset_buffer_multibyte, syms_of_buffer): * src/callint.c (read_file_name, Fcall_interactively) (syms_of_callint): * src/callproc.c (call_process, create_temp_file) (syms_of_callproc): * src/charset.c (Fdefine_charset_internal, syms_of_charset): * src/cmds.c (internal_self_insert, syms_of_cmds): * src/coding.c (record_conversion_result) (Fdefine_coding_system_internal, syms_of_coding): * src/dbusbind.c (xd_signature, Fdbus_message_internal) (syms_of_dbusbind): * src/dispnew.c (init_faces_initial): * src/doc.c (Fsnarf_documentation, syms_of_doc): * src/dosfns.c (system_process_attributes, syms_of_dosfns): * src/emacs.c (init_cmdargs, Fdump_emacs, decode_env_path) (syms_of_emacs): * src/eval.c (call_debugger, Fdefvaralias, syms_of_eval): * src/fileio.c (barf_or_query_if_file_exists) (Finsert_file_contents, auto_save_error, Fdo_auto_save) (syms_of_fileio): * src/filelock.c (lock_file_1, syms_of_filelock): * src/fontset.c (fontset_from_font, syms_of_fontset): * src/frame.c (make_frame_without_minibuffer, syms_of_frame): * src/gnutls.c (emacs_gnutls_certificate_details) (Fgnutls_peer_status_warning_describe, Fgnutls_peer_status) (gnutls_verify_boot, syms_of_gnutls): * src/gtkutil.c (style_changed_cb, find_rtl_image): * src/image.c (imagemagick_filename_hint, gs_load) (syms_of_image): * src/keyboard.c (command_loop_1, read_char, timer_start_idle) (read_char_minibuf_menu_prompt, Fsuspend_emacs) (syms_of_keyboard): * src/keymap.c (Fmap_keymap, Flookup_key, Fdescribe_vector) (describe_vector, syms_of_keymap): * src/lread.c (Fread, Fread_positioning_symbols, syms_of_lread): * src/minibuf.c (Fabort_minibuffers, Fread_buffer) (Fcompleting_read, syms_of_minibuf): * src/msdos.c (XMenuActivate, run_msdos_command, syms_of_msdos): * src/nsfns.m (Fx_display_backing_store, Fx_display_visual_class) (Fns_hide_emacs, Fsystem_move_file_to_trash, ns_create_tip_frame) (x_hide_tip, Fx_show_tip, syms_of_nsfns): * src/nsfont.m (ns_spec_to_descriptor, ns_descriptor_to_entity) (syms_of_nsfont): * src/pdumper.c (Fdump_emacs_portable): * src/pgtkfns.c (Fx_display_visual_class, x_create_tip_frame) (Fx_show_tip, syms_of_pgtkfns): * src/pgtkterm.c (syms_of_pgtkterm, pgtk_cr_export_frames): * src/term.c (term_get_fkeys_1, set_tty_color_mode, Fsuspend_tty) (Fresume_tty, tty_menu_activate, syms_of_term): * src/terminal.c (create_terminal, syms_of_terminal): * src/w32fns.c (Fx_display_backing_store) (Fx_display_visual_class, Fset_message_beep, Fx_open_connection) (Fx_show_tip, Fx_file_dialog, Fsystem_move_file_to_trash) (Fw32_toggle_lock_key, syms_of_w32fns): * src/w32font.c (w32_enumfont_pattern_entity, syms_of_w32font): * src/w32term.c (w32_bitmap_icon, syms_of_w32term): * src/xdisp.c (message_dolog, define_frame_cursor1) (syms_of_xdisp): * src/xfaces.c (tty_lookup_color, syms_of_xfaces): * src/xml.c (make_dom, syms_of_xml): * src/xterm.c (syms_of_xterm): * src/xwidget.c (store_xwidget_download_callback_event) (store_xwidget_js_callback_event, syms_of_xwidget): Define symbols for symbols interned with `intern' from a constant string, delete duplicate DEFSYM directives, and substitute them for such calls to intern. This excludes only those symbols which are interned and referenced only once during Emacs's initialization, the timing of whose interning is inconsequential, and symbols in w32.c, which would need to be transferred to a new syms_of_w32 function that I cannot test. diff --git a/src/alloc.c b/src/alloc.c index 47a8e4f4bd2..4226cb1d1a0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -668,10 +668,10 @@ malloc_warning (const char *str) void display_malloc_warning (void) { - call3 (intern ("display-warning"), - intern ("alloc"), + call3 (Qdisplay_warning, + Qalloc, build_string (pending_malloc_warning), - intern (":emergency")); + QCemergency); pending_malloc_warning = 0; } @@ -8317,6 +8317,8 @@ N should be nonnegative. */); 4, 4, "watch_gc_cons_percentage", {0}, lisp_h_Qnil}}; XSETSUBR (watcher, &Swatch_gc_cons_percentage.s); Fadd_variable_watcher (Qgc_cons_percentage, watcher); + DEFSYM (Qalloc, "alloc"); + DEFSYM (QCemergency, ":emergency"); } #ifdef HAVE_X_WINDOWS diff --git a/src/buffer.c b/src/buffer.c index 291c7d3f911..8f983692124 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -931,8 +931,8 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */) bset_local_minor_modes (b, Qnil); bset_auto_save_file_name (b, Qnil); set_buffer_internal_1 (b); - Fset (intern ("buffer-save-without-query"), Qnil); - Fset (intern ("buffer-file-number"), Qnil); + Fset (Qbuffer_save_without_query, Qnil); + Fset (Qbuffer_file_number, Qnil); if (!NILP (Flocal_variable_p (Qbuffer_stale_function, base_buffer))) Fkill_local_variable (Qbuffer_stale_function); /* Cloned buffers need extra setup, to do things such as deep @@ -1477,7 +1477,7 @@ No argument or nil as argument means use current buffer as BUFFER. */) } tem = buffer_local_variables_1 (buf, PER_BUFFER_VAR_OFFSET (undo_list), - intern ("buffer-undo-list")); + Qbuffer_undo_list); if (!NILP (tem)) result = Fcons (tem, result); @@ -1704,11 +1704,11 @@ This does not change the name of the visited file (if any). */) Fsetcar (Frassq (buf, Vbuffer_alist), newname); if (NILP (BVAR (current_buffer, filename)) && !NILP (BVAR (current_buffer, auto_save_file_name))) - call0 (intern ("rename-auto-save-file")); + call0 (Qrename_auto_save_file); run_buffer_list_update_hook (current_buffer); - call2 (intern ("uniquify--rename-buffer-advice"), + call2 (Quniquify__rename_buffer_advice, requestedname, unique); /* Refetch since that last call may have done GC. */ @@ -1956,7 +1956,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) { tem = do_yes_or_no_p (build_string ("Delete auto-save file? ")); if (!NILP (tem)) - call0 (intern ("delete-auto-save-file-if-necessary")); + call0 (Qdelete_auto_save_file_if_necessary); } /* If the hooks have killed the buffer, exit now. */ @@ -2251,7 +2251,7 @@ the current buffer's major mode. */) error ("Attempt to set major mode for a dead buffer"); if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0) - function = find_symbol_value (intern ("initial-major-mode")); + function = find_symbol_value (Qinitial_major_mode); else { function = BVAR (&buffer_defaults, major_mode); @@ -2936,7 +2936,7 @@ current buffer is cleared. */) /* Represent all the above changes by a special undo entry. */ bset_undo_list (current_buffer, Fcons (list3 (Qapply, - intern ("set-buffer-multibyte"), + Qset_buffer_multibyte, NILP (flag) ? Qt : Qnil), old_undo)); } @@ -6112,4 +6112,13 @@ There is no reason to change that value except for debugging purposes. */); DEFSYM (Qbuffer_stale_function, "buffer-stale-function"); Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); + + DEFSYM (Qbuffer_save_without_query, "buffer-save-without-query"); + DEFSYM (Qbuffer_file_number, "buffer-file-number"); + DEFSYM (Qbuffer_undo_list, "buffer-undo-list"); + DEFSYM (Qrename_auto_save_file, "rename-auto-save-file"); + DEFSYM (Quniquify__rename_buffer_advice, "uniquify--rename-buffer-advice"); + DEFSYM (Qdelete_auto_save_file_if_necessary, "delete-auto-save-file-if-necessary"); + DEFSYM (Qinitial_major_mode, "initial-major-mode"); + DEFSYM (Qset_buffer_multibyte, "set-buffer-multibyte"); } diff --git a/src/callint.c b/src/callint.c index 9d6f2ab2888..1af9666e5a4 100644 --- a/src/callint.c +++ b/src/callint.c @@ -228,7 +228,7 @@ static Lisp_Object read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object initial, Lisp_Object predicate) { - return CALLN (Ffuncall, intern ("read-file-name"), + return CALLN (Ffuncall, Qread_file_name, callint_message, Qnil, default_filename, mustmatch, initial, predicate); } @@ -330,7 +330,7 @@ invoke it (via an `interactive' spec that contains, for instance, an and turn them into things we can eval. */ Lisp_Object values = quotify_args (Fcopy_sequence (specs)); fix_command (function, values); - call4 (intern ("add-to-history"), intern ("command-history"), + call4 (Qadd_to_history, Qcommand_history, Fcons (function, values), Qnil, Qt); } @@ -687,12 +687,12 @@ invoke it (via an `interactive' spec that contains, for instance, an break; case 'x': /* Lisp expression read but not evaluated. */ - args[i] = call1 (intern ("read-minibuffer"), callint_message); + args[i] = call1 (Qread_minibuffer, callint_message); visargs[i] = last_minibuf_string; break; case 'X': /* Lisp expression read and evaluated. */ - args[i] = call1 (intern ("eval-minibuffer"), callint_message); + args[i] = call1 (Qeval_minibuffer, callint_message); visargs[i] = last_minibuf_string; break; @@ -766,7 +766,7 @@ invoke it (via an `interactive' spec that contains, for instance, an visargs[i] = (varies[i] > 0 ? list1 (intern (callint_argfuns[varies[i]])) : quotify_arg (args[i])); - call4 (intern ("add-to-history"), intern ("command-history"), + call4 (Qadd_to_history, Qcommand_history, Flist (nargs - 1, visargs + 1), Qnil, Qt); } @@ -912,4 +912,7 @@ use `event-start', `event-end', and `event-click-count'. */); defsubr (&Sprefix_numeric_value); DEFSYM (Qinteractive_args, "interactive-args"); + DEFSYM (Qread_file_name, "read-file-name"); + DEFSYM (Qcommand_history, "command-history"); + DEFSYM (Qeval_minibuffer, "eval-minibuffer"); } diff --git a/src/callproc.c b/src/callproc.c index db36ef569e6..e116298baef 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -914,7 +914,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, /* If the caller required, let the buffer inherit the coding-system used to decode the process output. */ if (inherit_process_coding_system) - call1 (intern ("after-insert-file-set-buffer-file-coding-system"), + call1 (Qafter_insert_file_set_buffer_file_coding_system, make_fixnum (total_read)); } @@ -1041,7 +1041,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, { specpdl_ref count1 = SPECPDL_INDEX (); - specbind (intern ("coding-system-for-write"), val); + specbind (Qcoding_system_for_write, val); /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we happen to get a ".Z" suffix. */ specbind (Qfile_name_handler_alist, Qnil); @@ -2246,4 +2246,8 @@ the system. */); defsubr (&Scall_process); defsubr (&Sgetenv_internal); defsubr (&Scall_process_region); + + DEFSYM (Qafter_insert_file_set_buffer_file_coding_system, + "after-insert-file-set-buffer-file-coding-system"); + DEFSYM (Qcoding_system_for_write, "coding-system-for-write"); } diff --git a/src/charset.c b/src/charset.c index 4bacc011e85..675097c6843 100644 --- a/src/charset.c +++ b/src/charset.c @@ -862,7 +862,7 @@ usage: (define-charset-internal ...) */) if (nargs != charset_arg_max) Fsignal (Qwrong_number_of_arguments, - Fcons (intern ("define-charset-internal"), + Fcons (Qdefine_charset_internal, make_fixnum (nargs))); attrs = make_nil_vector (charset_attr_max); @@ -2354,6 +2354,7 @@ void syms_of_charset (void) { DEFSYM (Qcharsetp, "charsetp"); + DEFSYM (Qdefine_charset_internal, "define-charset-internal"); /* Special charset symbols. */ DEFSYM (Qascii, "ascii"); diff --git a/src/cmds.c b/src/cmds.c index 81788b07242..f7a3f9e7ac6 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -428,7 +428,7 @@ internal_self_insert (int c, EMACS_INT n) && SYMBOLP (XSYMBOL (sym)->u.s.function)) { Lisp_Object prop; - prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert")); + prop = Fget (XSYMBOL (sym)->u.s.function, Qno_self_insert); if (! NILP (prop)) return 1; } @@ -507,6 +507,7 @@ syms_of_cmds (void) DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate"); DEFSYM (Qundo_auto__this_command_amalgamating, "undo-auto--this-command-amalgamating"); + DEFSYM (Qno_self_insert, "no-self-insert"); DEFSYM (Qkill_forward_chars, "kill-forward-chars"); diff --git a/src/coding.c b/src/coding.c index b21f2ecf00a..5e4e92ea6e2 100644 --- a/src/coding.c +++ b/src/coding.c @@ -806,7 +806,7 @@ record_conversion_result (struct coding_system *coding, case CODING_RESULT_SUCCESS: break; default: - Vlast_code_conversion_error = intern ("Unknown error"); + Vlast_code_conversion_error = QUnknown_error; } } @@ -11508,7 +11508,7 @@ usage: (define-coding-system-internal ...) */) short_args: Fsignal (Qwrong_number_of_arguments, - Fcons (intern ("define-coding-system-internal"), + Fcons (Qdefine_coding_system_internal, make_fixnum (nargs))); } @@ -12291,6 +12291,9 @@ internal character representation. */); Fset (AREF (Vcoding_category_table, i), Qno_conversion); pdumper_do_now_and_after_load (reset_coding_after_pdumper_load); + + DEFSYM (QUnknown_error, "Unknown error"); + DEFSYM (Qdefine_coding_system_internal, "define-coding-system-internal"); } static void diff --git a/src/dbusbind.c b/src/dbusbind.c index 0441b07a3b2..9f93f2894c2 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -474,7 +474,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); if (strcmp (subsig, x) != 0) - wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt)); + wrong_type_argument (QD_Bus, CAR_SAFE (elt)); elt = CDR_SAFE (XD_NEXT_VALUE (elt)); } @@ -493,7 +493,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt)))) - wrong_type_argument (intern ("D-Bus"), + wrong_type_argument (QD_Bus, CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt)))); sprintf (signature, "%c", dtype); @@ -528,7 +528,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* Check the parent object type. */ if (parent_type != DBUS_TYPE_ARRAY) - wrong_type_argument (intern ("D-Bus"), object); + wrong_type_argument (QD_Bus, object); /* Compose the signature from the elements. It is enclosed by curly braces. */ @@ -542,7 +542,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) xd_signature_cat (signature, x); if (!XD_BASIC_DBUS_TYPE (subtype)) - wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt))); + wrong_type_argument (QD_Bus, CAR_SAFE (XD_NEXT_VALUE (elt))); /* Second element. */ elt = CDR_SAFE (XD_NEXT_VALUE (elt)); @@ -552,7 +552,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) xd_signature_cat (signature, x); if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt)))) - wrong_type_argument (intern ("D-Bus"), + wrong_type_argument (QD_Bus, CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt)))); /* Closing signature. */ @@ -560,7 +560,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; default: - wrong_type_argument (intern ("D-Bus"), object); + wrong_type_argument (QD_Bus, object); } XD_DEBUG_MESSAGE ("%s", signature); @@ -1480,7 +1480,7 @@ usage: (dbus-message-internal &rest REST) */) bus or an unknown name, we regard it as broadcast message due to backward compatibility. */ if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL)) - uname = call2 (intern ("dbus-get-name-owner"), bus, service); + uname = call2 (Qdbus_get_name_owner, bus, service); else uname = Qnil; @@ -1886,6 +1886,7 @@ syms_of_dbusbind (void) list2 (Qdbus_error, Qerror)); Fput (Qdbus_error, Qerror_message, build_pure_c_string ("D-Bus error")); + DEFSYM (QD_Bus, "D-Bus"); /* Lisp symbols of the system and session buses. */ DEFSYM (QCsystem, ":system"); @@ -1924,6 +1925,9 @@ syms_of_dbusbind (void) DEFSYM (QCsignal, ":signal"); DEFSYM (QCmonitor, ":monitor"); + /* Miscellaneous Lisp symbols. */ + DEFSYM (Qdbus_get_name_owner, "dbus-get-name-owner"); + DEFVAR_LISP ("dbus-compiled-version", Vdbus_compiled_version, doc: /* The version of D-Bus Emacs is compiled against. */); diff --git a/src/dispnew.c b/src/dispnew.c index c204a9dbf1b..8eda8dbb358 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6503,7 +6503,7 @@ init_faces_initial (void) FRAME_FOREGROUND_PIXEL (sf) = FACE_TTY_DEFAULT_FG_COLOR; FRAME_BACKGROUND_PIXEL (sf) = FACE_TTY_DEFAULT_BG_COLOR; - call0 (intern ("tty-set-up-initial-frame-faces")); + call0 (Qtty_set_up_initial_frame_faces); } /* Initialization done when Emacs fork is started, before doing stty. diff --git a/src/doc.c b/src/doc.c index b698591f704..36633a920c6 100644 --- a/src/doc.c +++ b/src/doc.c @@ -564,8 +564,8 @@ the same file name is found in the `doc-directory'. */) ptrdiff_t dirlen; /* Preloaded defcustoms using custom-initialize-delay are added to this list, but kept unbound. See https://debbugs.gnu.org/11565 */ - Lisp_Object delayed_init = - find_symbol_value (intern ("custom-delayed-init-variables")); + Lisp_Object delayed_init + = find_symbol_value (Qcustom_delayed_init_variables); if (!CONSP (delayed_init)) delayed_init = Qnil; @@ -779,4 +779,5 @@ compute the correct value for the current terminal in the nil case. */); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation); defsubr (&Stext_quoting_style); + DEFSYM (Qcustom_delayed_init_variables, "custom-delayed-init-variables"); } diff --git a/src/dosfns.c b/src/dosfns.c index 96087116c19..f883c7a8b8a 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -563,7 +563,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qtime, tem), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum (1)), attrs); attrs = Fcons (Fcons (Qstart, - Fsymbol_value (intern ("before-init-time"))), + Fsymbol_value (Qbefore_init_time)), attrs); attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER ((unsigned long) sbrk (0) / 1024)), @@ -794,5 +794,6 @@ If non-zero, this variable contains the character to be returned when the decimal point key in the numeric keypad is pressed when Num Lock is on. If zero, the decimal point key returns the country code specific value. */); dos_decimal_point = 0; + DEFSYM (Qbefore_init_time, "before-init-time"); } #endif /* MSDOS */ diff --git a/src/emacs.c b/src/emacs.c index 77e6c41e822..22da39a4d1c 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -565,9 +565,8 @@ init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) { if (NILP (Vpurify_flag)) { - Lisp_Object file_truename = intern ("file-truename"); - if (!NILP (Ffboundp (file_truename))) - dir = call1 (file_truename, dir); + if (!NILP (Ffboundp (Qfile_truename))) + dir = call1 (Qfile_truename, dir); } dir = Fexpand_file_name (build_string ("../.."), dir); } @@ -3194,7 +3193,7 @@ You must run Emacs in batch mode in order to dump it. */) /* Bind `command-line-processed' to nil before dumping, so that the dumped Emacs will process its command line and set up to work with X windows if appropriate. */ - symbol = intern ("command-line-processed"); + symbol = Qcommand_line_processed; specbind (symbol, Qnil); CHECK_STRING (filename); @@ -3445,7 +3444,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) if (SYMBOLP (tem)) { Lisp_Object prop; - prop = Fget (tem, intern ("safe-magic")); + prop = Fget (tem, Qsafe_magic); if (! NILP (prop)) tem = Qnil; } @@ -3554,6 +3553,9 @@ syms_of_emacs (void) DEFSYM (Qkill_emacs_hook, "kill-emacs-hook"); DEFSYM (Qrun_hook_query_error_with_timeout, "run-hook-query-error-with-timeout"); + DEFSYM (Qfile_truename, "file-truename"); + DEFSYM (Qcommand_line_processed, "command-line-processed"); + DEFSYM (Qsafe_magic, "safe-magic"); #ifdef HAVE_UNEXEC defsubr (&Sdump_emacs); diff --git a/src/eval.c b/src/eval.c index d3761c31f88..637c874871d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -292,7 +292,7 @@ call_debugger (Lisp_Object arg) displayed if the debugger is invoked during redisplay. */ debug_while_redisplaying = redisplaying_p; redisplaying_p = 0; - specbind (intern ("debugger-may-continue"), + specbind (Qdebugger_may_continue, debug_while_redisplaying ? Qnil : Qt); specbind (Qinhibit_redisplay, Qnil); specbind (Qinhibit_debugger, Qt); @@ -668,8 +668,8 @@ signal a `cyclic-variable-indirection' error. */) else if (!NILP (Fboundp (new_alias)) && !EQ (find_symbol_value (new_alias), find_symbol_value (base_variable))) - call2 (intern ("display-warning"), - list3 (Qdefvaralias, intern ("losing-value"), new_alias), + call2 (Qdisplay_warning, + list3 (Qdefvaralias, Qlosing_value, new_alias), CALLN (Fformat_message, build_string ("Overwriting value of `%s' by aliasing to `%s'"), @@ -4313,6 +4313,9 @@ before making `inhibit-quit' nil. */); DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug_early, "debug-early"); DEFSYM (Qdebug_early__handler, "debug-early--handler"); + DEFSYM (Qdebugger_may_continue, "debugger-may-continue"); + DEFSYM (Qdisplay_warning, "display-warning"); + DEFSYM (Qlosing_value, "losing-value"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. diff --git a/src/fileio.c b/src/fileio.c index 12da7a9ed3a..960a3b21dc0 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2205,7 +2205,7 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist, AUTO_STRING (format, "File %s already exists; %s anyway? "); tem = CALLN (Fformat, format, absname, build_string (querystring)); if (quick) - tem = call1 (intern ("y-or-n-p"), tem); + tem = call1 (Qy_or_n_p, tem); else tem = do_yes_or_no_p (tem); if (NILP (tem)) @@ -4550,7 +4550,7 @@ by calling `format-decode', which see. */) current_buffer->modtime earlier, but we could still end up calling ask-user-about-supersession-threat if the file is modified while we read it, so we bind buffer-file-name instead. */ - specbind (intern ("buffer-file-name"), Qnil); + specbind (Qbuffer_file_name, Qnil); del_range_byte (same_at_start, same_at_end); /* Insert from the file at the proper position. */ temp = BYTE_TO_CHAR (same_at_start); @@ -4660,7 +4660,7 @@ by calling `format-decode', which see. */) if (same_at_start != same_at_end) { /* See previous specbind for the reason behind this. */ - specbind (intern ("buffer-file-name"), Qnil); + specbind (Qbuffer_file_name, Qnil); del_range_byte (same_at_start, same_at_end); } inserted = 0; @@ -4710,7 +4710,7 @@ by calling `format-decode', which see. */) inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE); /* See previous specbind for the reason behind this. */ - specbind (intern ("buffer-file-name"), Qnil); + specbind (Qbuffer_file_name, Qnil); if (same_at_end != same_at_start) { del_range_byte (same_at_start, same_at_end); @@ -6107,8 +6107,8 @@ auto_save_error (Lisp_Object error_val) AUTO_STRING (format, "Auto-saving %s: %s"); Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name), Ferror_message_string (error_val)); - call3 (intern ("display-warning"), - intern ("auto-save"), msg, intern (":error")); + call3 (Qdisplay_warning, + Qauto_save, msg, QCerror); return Qnil; } @@ -6223,7 +6223,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) oquit = Vquit_flag; Vquit_flag = Qnil; - hook = intern ("auto-save-hook"); + hook = Qauto_save_hook; safe_run_hooks (hook); if (STRINGP (Vauto_save_list_file_name)) @@ -6914,4 +6914,8 @@ This includes interactive calls to `delete-file' and #endif /* HAVE_SYNC */ DEFSYM (Qif_regular, "if-regular"); + DEFSYM (Qbuffer_file_name, "buffer-file-name"); + DEFSYM (Qauto_save, "auto-save"); + DEFSYM (QCerror, ":error"); + DEFSYM (Qauto_save_hook, "auto-save-hook"); } diff --git a/src/filelock.c b/src/filelock.c index e5b352cb6ff..050cac565c9 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -274,7 +274,7 @@ lock_file_1 (Lisp_Object lfname, bool force) /* Protect against the extremely unlikely case of the host name containing an @ character. */ if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@')) - lhost_name = CALLN (Ffuncall, intern ("string-replace"), + lhost_name = CALLN (Ffuncall, Qstring_replace, build_string ("@"), build_string ("-"), lhost_name); @@ -791,6 +791,7 @@ Info node `(emacs)Interlocking'. */); DEFSYM (Qunlock_file, "unlock-file"); DEFSYM (Qfile_locked_p, "file-locked-p"); DEFSYM (Qmake_lock_file_name, "make-lock-file-name"); + DEFSYM (Qstring_replace, "string-replace"); defsubr (&Slock_file); defsubr (&Sunlock_file); diff --git a/src/fontset.c b/src/fontset.c index dfa0d59d31d..a98d75606b3 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1823,7 +1823,7 @@ fontset_from_font (Lisp_Object font_object) if (CONSP (val)) return XFIXNUM (FONTSET_ID (XCDR (val))); if (num_auto_fontsets++ == 0) - alias = intern ("fontset-startup"); + alias = Qfontset_startup; else { char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)]; @@ -2174,6 +2174,7 @@ syms_of_fontset (void) Fput (Qfontset, Qchar_table_extra_slots, make_fixnum (8)); DEFSYM (Qfontset_info, "fontset-info"); Fput (Qfontset_info, Qchar_table_extra_slots, make_fixnum (1)); + DEFSYM (Qfontset_startup, "fontset-startup"); DEFSYM (Qappend, "append"); DEFSYM (Qlatin, "latin"); diff --git a/src/frame.c b/src/frame.c index a671dbaa31d..80aa4a4a2e8 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1114,12 +1114,12 @@ make_frame_without_minibuffer (Lisp_Object mini_window, KBOARD *kb, if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))) { - Lisp_Object frame_dummy; + Lisp_Object initial_frame; - XSETFRAME (frame_dummy, f); /* If there's no minibuffer frame to use, create one. */ - kset_default_minibuffer_frame - (kb, call1 (intern ("make-initial-minibuffer-frame"), display)); + initial_frame = call1 (Qmake_initial_minibuffer_frame, + display); + kset_default_minibuffer_frame (kb, initial_frame); } mini_window @@ -6268,6 +6268,7 @@ syms_of_frame (void) DEFSYM (Qframe_windows_min_size, "frame-windows-min-size"); DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes"); DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total"); + DEFSYM (Qmake_initial_minibuffer_frame, "make-initial-minibuffer-frame"); DEFSYM (Qexplicit_name, "explicit-name"); DEFSYM (Qheight, "height"); DEFSYM (Qicon, "icon"); diff --git a/src/gnutls.c b/src/gnutls.c index 54b7eb4c90e..efee2dccbb4 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1142,7 +1142,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) int version = gnutls_x509_crt_get_version (cert); check_memory_full (version); if (version >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":version"), + res = nconc2 (res, list2 (QCversion, make_fixnum (version))); } @@ -1156,7 +1156,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_serial (cert, serial, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":serial-number"), + res = nconc2 (res, list2 (QCserial_number, gnutls_hex_string (serial, buf_size, ""))); xfree (serial); } @@ -1171,7 +1171,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_issuer_dn (cert, dn, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":issuer"), + res = nconc2 (res, list2 (QCissuer, make_string (dn, buf_size))); xfree (dn); } @@ -1185,11 +1185,11 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) time_t tim = gnutls_x509_crt_get_activation_time (cert); if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t)) - res = nconc2 (res, list2 (intern (":valid-from"), build_string (buf))); + res = nconc2 (res, list2 (QCvalid_from, build_string (buf))); tim = gnutls_x509_crt_get_expiration_time (cert); if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t)) - res = nconc2 (res, list2 (intern (":valid-to"), build_string (buf))); + res = nconc2 (res, list2 (QCvalid_to, build_string (buf))); } /* Subject. */ @@ -1202,7 +1202,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_dn (cert, dn, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":subject"), + res = nconc2 (res, list2 (QCsubject, make_string (dn, buf_size))); xfree (dn); } @@ -1217,12 +1217,12 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) { const char *name = gnutls_pk_algorithm_get_name (err); if (name) - res = nconc2 (res, list2 (intern (":public-key-algorithm"), + res = nconc2 (res, list2 (QCpublic_key_algorithm, build_string (name))); name = gnutls_sec_param_get_name (gnutls_pk_bits_to_sec_param (err, bits)); - res = nconc2 (res, list2 (intern (":certificate-security-level"), + res = nconc2 (res, list2 (QCcertificate_security_level, build_string (name))); } } @@ -1237,7 +1237,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_issuer_unique_id (cert, buf, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":issuer-unique-id"), + res = nconc2 (res, list2 (QCissuer_unique_id, make_string (buf, buf_size))); xfree (buf); } @@ -1251,7 +1251,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_subject_unique_id (cert, buf, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":subject-unique-id"), + res = nconc2 (res, list2 (QCsubject_unique_id, make_string (buf, buf_size))); xfree (buf); } @@ -1263,7 +1263,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) { const char *name = gnutls_sign_get_name (err); if (name) - res = nconc2 (res, list2 (intern (":signature-algorithm"), + res = nconc2 (res, list2 (QCsignature_algorithm, build_string (name))); } @@ -1277,7 +1277,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_key_id (cert, 0, buf, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":public-key-id"), + res = nconc2 (res, list2 (QCpublic_key_id, gnutls_hex_string (buf, buf_size, "sha1:"))); xfree (buf); } @@ -1293,7 +1293,7 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) err = gnutls_x509_crt_get_key_id (cert, GNUTLS_KEYID_USE_SHA256, buf, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":public-key-id-sha256"), + res = nconc2 (res, list2 (QCpublic_key_id_sha256, gnutls_hex_string (buf, buf_size, "sha256:"))); xfree (buf); } @@ -1311,13 +1311,13 @@ emacs_gnutls_certificate_details (gnutls_x509_crt_t cert) buf, &buf_size); check_memory_full (err); if (err >= GNUTLS_E_SUCCESS) - res = nconc2 (res, list2 (intern (":certificate-id"), + res = nconc2 (res, list2 (QCcertificate_id, gnutls_hex_string (buf, buf_size, "sha1:"))); xfree (buf); } /* PEM */ - res = nconc2 (res, list2 (intern (":pem"), + res = nconc2 (res, list2 (QCpem, emacs_gnutls_certificate_export_pem(cert))); return res; @@ -1329,55 +1329,55 @@ DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_descri { CHECK_SYMBOL (status_symbol); - if (EQ (status_symbol, intern (":invalid"))) + if (EQ (status_symbol, QCinvalid)) return build_string ("certificate could not be verified"); - if (EQ (status_symbol, intern (":revoked"))) + if (EQ (status_symbol, QCrevoked)) return build_string ("certificate was revoked (CRL)"); - if (EQ (status_symbol, intern (":self-signed"))) + if (EQ (status_symbol, QCself_signed)) return build_string ("certificate signer was not found (self-signed)"); - if (EQ (status_symbol, intern (":unknown-ca"))) + if (EQ (status_symbol, QCunknown_ca)) return build_string ("the certificate was signed by an unknown " "and therefore untrusted authority"); - if (EQ (status_symbol, intern (":not-ca"))) + if (EQ (status_symbol, QCnot_ca)) return build_string ("certificate signer is not a CA"); - if (EQ (status_symbol, intern (":insecure"))) + if (EQ (status_symbol, QCinsecure)) return build_string ("certificate was signed with an insecure algorithm"); - if (EQ (status_symbol, intern (":not-activated"))) + if (EQ (status_symbol, QCnot_activated)) return build_string ("certificate is not yet activated"); - if (EQ (status_symbol, intern (":expired"))) + if (EQ (status_symbol, QCexpired)) return build_string ("certificate has expired"); - if (EQ (status_symbol, intern (":no-host-match"))) + if (EQ (status_symbol, QCno_host_match)) return build_string ("certificate host does not match hostname"); - if (EQ (status_symbol, intern (":signature-failure"))) + if (EQ (status_symbol, QCsignature_failure)) return build_string ("certificate signature could not be verified"); - if (EQ (status_symbol, intern (":revocation-data-superseded"))) + if (EQ (status_symbol, QCrevocation_data_superseded)) return build_string ("certificate revocation data are old and have been " "superseded"); - if (EQ (status_symbol, intern (":revocation-data-issued-in-future"))) + if (EQ (status_symbol, QCrevocation_data_issued_in_future)) return build_string ("certificate revocation data have a future issue date"); - if (EQ (status_symbol, intern (":signer-constraints-failure"))) + if (EQ (status_symbol, QCsigner_constraints_failure)) return build_string ("certificate signer constraints were violated"); - if (EQ (status_symbol, intern (":purpose-mismatch"))) + if (EQ (status_symbol, QCpurpose_mismatch)) return build_string ("certificate does not match the intended purpose"); - if (EQ (status_symbol, intern (":missing-ocsp-status"))) + if (EQ (status_symbol, QCmissing_ocsp_status)) return build_string ("certificate requires the server to send a OCSP " "certificate status, but no status was received"); - if (EQ (status_symbol, intern (":invalid-ocsp-status"))) + if (EQ (status_symbol, QCinvalid_ocsp_status)) return build_string ("the received OCSP certificate status is invalid"); return Qnil; @@ -1411,50 +1411,50 @@ returned as the :certificate entry. */) verification = XPROCESS (proc)->gnutls_peer_verification; if (verification & GNUTLS_CERT_INVALID) - warnings = Fcons (intern (":invalid"), warnings); + warnings = Fcons (QCinvalid, warnings); if (verification & GNUTLS_CERT_REVOKED) - warnings = Fcons (intern (":revoked"), warnings); + warnings = Fcons (QCrevoked, warnings); if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND) - warnings = Fcons (intern (":unknown-ca"), warnings); + warnings = Fcons (QCunknown_ca, warnings); if (verification & GNUTLS_CERT_SIGNER_NOT_CA) - warnings = Fcons (intern (":not-ca"), warnings); + warnings = Fcons (QCnot_ca, warnings); if (verification & GNUTLS_CERT_INSECURE_ALGORITHM) - warnings = Fcons (intern (":insecure"), warnings); + warnings = Fcons (QCinsecure, warnings); if (verification & GNUTLS_CERT_NOT_ACTIVATED) - warnings = Fcons (intern (":not-activated"), warnings); + warnings = Fcons (QCnot_activated, warnings); if (verification & GNUTLS_CERT_EXPIRED) - warnings = Fcons (intern (":expired"), warnings); + warnings = Fcons (QCexpired, warnings); # if GNUTLS_VERSION_NUMBER >= 0x030100 if (verification & GNUTLS_CERT_SIGNATURE_FAILURE) - warnings = Fcons (intern (":signature-failure"), warnings); + warnings = Fcons (QCsignature_failure, warnings); # if GNUTLS_VERSION_NUMBER >= 0x030114 if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED) - warnings = Fcons (intern (":revocation-data-superseded"), warnings); + warnings = Fcons (QCrevocation_data_superseded, warnings); if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE) - warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings); + warnings = Fcons (QCrevocation_data_issued_in_future, warnings); if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE) - warnings = Fcons (intern (":signer-constraints-failure"), warnings); + warnings = Fcons (QCsigner_constraints_failure, warnings); # if GNUTLS_VERSION_NUMBER >= 0x030400 if (verification & GNUTLS_CERT_PURPOSE_MISMATCH) - warnings = Fcons (intern (":purpose-mismatch"), warnings); + warnings = Fcons (QCpurpose_mismatch, warnings); # if GNUTLS_VERSION_NUMBER >= 0x030501 if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS) - warnings = Fcons (intern (":missing-ocsp-status"), warnings); + warnings = Fcons (QCmissing_ocsp_status, warnings); if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS) - warnings = Fcons (intern (":invalid-ocsp-status"), warnings); + warnings = Fcons (QCinvalid_ocsp_status, warnings); # endif # endif # endif @@ -1462,17 +1462,17 @@ returned as the :certificate entry. */) if (XPROCESS (proc)->gnutls_extra_peer_verification & CERTIFICATE_NOT_MATCHING) - warnings = Fcons (intern (":no-host-match"), warnings); + warnings = Fcons (QCno_host_match, warnings); /* This could get called in the INIT stage, when the certificate is not yet set. */ if (XPROCESS (proc)->gnutls_certificates != NULL && gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0], XPROCESS (proc)->gnutls_certificates[0])) - warnings = Fcons (intern (":self-signed"), warnings); + warnings = Fcons (QCself_signed, warnings); if (!NILP (warnings)) - result = list2 (intern (":warnings"), warnings); + result = list2 (QCwarnings, warnings); /* This could get called in the INIT stage, when the certificate is not yet set. */ @@ -1485,11 +1485,11 @@ returned as the :certificate entry. */) certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details (XPROCESS (proc)->gnutls_certificates[i]))); - result = nconc2 (result, list2 (intern (":certificates"), certs)); + result = nconc2 (result, list2 (QCcertificates, certs)); /* Return the host certificate in its own element for compatibility reasons. */ - result = nconc2 (result, list2 (intern (":certificate"), Fcar (certs))); + result = nconc2 (result, list2 (QCcertificate, Fcar (certs))); } state = XPROCESS (proc)->gnutls_state; @@ -1499,38 +1499,38 @@ returned as the :certificate entry. */) int bits = gnutls_dh_get_prime_bits (state); check_memory_full (bits); if (bits > 0) - result = nconc2 (result, list2 (intern (":diffie-hellman-prime-bits"), + result = nconc2 (result, list2 (QCdiffie_hellman_prime_bits, make_fixnum (bits))); } /* Key exchange. */ result = nconc2 - (result, list2 (intern (":key-exchange"), + (result, list2 (QCkey_exchange, build_string (gnutls_kx_get_name (gnutls_kx_get (state))))); /* Protocol name. */ gnutls_protocol_t proto = gnutls_protocol_get_version (state); result = nconc2 - (result, list2 (intern (":protocol"), + (result, list2 (QCprotocol, build_string (gnutls_protocol_get_name (proto)))); /* Cipher name. */ result = nconc2 - (result, list2 (intern (":cipher"), + (result, list2 (QCcipher, build_string (gnutls_cipher_get_name (gnutls_cipher_get (state))))); /* MAC name. */ result = nconc2 - (result, list2 (intern (":mac"), + (result, list2 (QCmac, build_string (gnutls_mac_get_name (gnutls_mac_get (state))))); /* Compression name. */ # ifdef HAVE_GNUTLS_COMPRESSION_GET result = nconc2 - (result, list2 (intern (":compression"), + (result, list2 (QCcompression, build_string (gnutls_compression_get_name (gnutls_compression_get (state))))); # endif @@ -1538,14 +1538,14 @@ returned as the :certificate entry. */) /* Encrypt-then-MAC. */ # ifdef HAVE_GNUTLS_ETM_STATUS result = nconc2 - (result, list2 (intern (":encrypt-then-mac"), + (result, list2 (QCencrypt_then_mac, gnutls_session_etm_status (state) ? Qt : Qnil)); # endif /* Renegotiation Indication */ if (proto <= GNUTLS_TLS1_2) result = nconc2 - (result, list2 (intern (":safe-renegotiation"), + (result, list2 (QCsafe_renegotiation, gnutls_safe_renegotiation_status (state) ? Qt : Qnil)); return result; @@ -1701,7 +1701,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) p->gnutls_peer_verification = peer_verification; - warnings = plist_get (Fgnutls_peer_status (proc), intern (":warnings")); + warnings = plist_get (Fgnutls_peer_status (proc), QCwarnings); if (!NILP (warnings)) { for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail)) @@ -3119,4 +3119,48 @@ are as per the GnuTLS logging conventions. */); #endif /* HAVE_GNUTLS */ defsubr (&Sgnutls_available_p); + + DEFSYM (QCcertificate, ":certificate"); + DEFSYM (QCcertificate_id, ":certificate-id"); + DEFSYM (QCcertificate_security_level, ":certificate-security-level"); + DEFSYM (QCcertificates, ":certificates"); + DEFSYM (QCcipher, ":cipher"); + DEFSYM (QCcompression, ":compression"); + DEFSYM (QCdiffie_hellman_prime_bits, ":diffie-hellman-prime-bits"); + DEFSYM (QCencrypt_then_mac, ":encrypt-then-mac"); + DEFSYM (QCexpired, ":expired"); + DEFSYM (QCinsecure, ":insecure"); + DEFSYM (QCinvalid, ":invalid"); + DEFSYM (QCinvalid_ocsp_status, ":invalid-ocsp-status"); + DEFSYM (QCissuer, ":issuer"); + DEFSYM (QCissuer_unique_id, ":issuer-unique-id"); + DEFSYM (QCkey_exchange, ":key-exchange"); + DEFSYM (QCmac, ":mac"); + DEFSYM (QCmissing_ocsp_status, ":missing-ocsp-status"); + DEFSYM (QCno_host_match, ":no-host-match"); + DEFSYM (QCnot_activated, ":not-activated"); + DEFSYM (QCnot_ca, ":not-ca"); + DEFSYM (QCpem, ":pem"); + DEFSYM (QCprotocol, ":protocol"); + DEFSYM (QCpublic_key_algorithm, ":public-key-algorithm"); + DEFSYM (QCpublic_key_id, ":public-key-id"); + DEFSYM (QCpublic_key_id_sha256, ":public-key-id-sha256"); + DEFSYM (QCpurpose_mismatch, ":purpose-mismatch"); + DEFSYM (QCrevocation_data_issued_in_future, + ":revocation-data-issued-in-future"); + DEFSYM (QCrevocation_data_superseded, ":revocation-data-superseded"); + DEFSYM (QCrevoked, ":revoked"); + DEFSYM (QCsafe_renegotiation, ":safe-renegotiation"); + DEFSYM (QCself_signed, ":self-signed"); + DEFSYM (QCserial_number, ":serial-number"); + DEFSYM (QCsignature_algorithm, ":signature-algorithm"); + DEFSYM (QCsignature_failure, ":signature-failure"); + DEFSYM (QCsigner_constraints_failure, ":signer-constraints-failure"); + DEFSYM (QCsubject, ":subject"); + DEFSYM (QCsubject_unique_id, ":subject-unique-id"); + DEFSYM (QCunknown_ca, ":unknown-ca"); + DEFSYM (QCvalid_from, ":valid-from"); + DEFSYM (QCvalid_to, ":valid-to"); + DEFSYM (QCversion, ":version"); + DEFSYM (QCwarnings, ":warnings"); } diff --git a/src/gtkutil.c b/src/gtkutil.c index c067f7b53ac..7de8eba0aa1 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1471,8 +1471,7 @@ style_changed_cb (GObject *go, EVENT_INIT (event); event.kind = CONFIG_CHANGED_EVENT; event.frame_or_window = build_string (display_name); - /* Theme doesn't change often, so intern is called seldom. */ - event.arg = intern ("theme-name"); + event.arg = Qtheme_name; kbd_buffer_store_event (&event); update_theme_scrollbar_width (); @@ -5506,8 +5505,8 @@ find_rtl_image (struct frame *f, Lisp_Object image, Lisp_Object rtl) Lisp_Object rtl_image = PROP (TOOL_BAR_ITEM_IMAGES); if (!NILP (file = file_for_image (rtl_image))) { - file = call1 (intern ("file-name-sans-extension"), - Ffile_name_nondirectory (file)); + file = call1 (Qfile_name_sans_extension, + Ffile_name_nondirectory (file)); if (! NILP (Fequal (file, rtl_name))) { image = rtl_image; diff --git a/src/image.c b/src/image.c index b15d68bf9bf..e93fc3183af 100644 --- a/src/image.c +++ b/src/image.c @@ -10721,14 +10721,14 @@ imagemagick_error (MagickWand *wand) static char * imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent]) { - Lisp_Object symbol = intern ("image-format-suffixes"); + Lisp_Object symbol = Qimage_format_suffixes; Lisp_Object val = find_symbol_value (symbol); Lisp_Object format; if (! CONSP (val)) return NULL; - format = image_spec_value (spec, intern (":format"), NULL); + format = image_spec_value (spec, QCformat, NULL); val = Fcar_safe (Fcdr_safe (Fassq (format, val))); if (! STRINGP (val)) return NULL; @@ -12477,7 +12477,7 @@ gs_load (struct frame *f, struct image *img) XSETFRAME (frame, f); loader = image_spec_value (img->spec, QCloader, NULL); if (NILP (loader)) - loader = intern ("gs-load-image"); + loader = Qgs_load_image; img->lisp_data = call6 (loader, frame, img->spec, make_fixnum (img->width), @@ -12853,6 +12853,7 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (QCloader, ":loader"); DEFSYM (QCpt_width, ":pt-width"); DEFSYM (QCpt_height, ":pt-height"); + DEFSYM (Qgs_load_image, "gs-load-image"); #endif /* HAVE_GHOSTSCRIPT */ #ifdef HAVE_NTGUI @@ -13032,5 +13033,8 @@ The options are: */); /* MagickExportImagePixels is in 6.4.6-9, but not 6.4.4-10. */ imagemagick_render_type = 0; -#endif + + DEFSYM (Qimage_format_suffixes, "image-format-suffixes"); + DEFSYM (QCformat, ":format"); +#endif /* HAVE_IMAGEMAGICK */ } diff --git a/src/keyboard.c b/src/keyboard.c index 69d29ededc0..bd1bb3bb4be 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1646,7 +1646,7 @@ command_loop_1 (void) } if (current_buffer != prev_buffer || MODIFF != prev_modiff) - run_hook (intern ("activate-mark-hook")); + run_hook (Qactivate_mark_hook); } Vsaved_region_selection = Qnil; @@ -3077,7 +3077,7 @@ read_char (int commandflag, Lisp_Object map, #ifdef HAVE_NS if (CONSP (c) - && (EQ (XCAR (c), intern ("ns-unput-working-text")))) + && (EQ (XCAR (c), Qns_unput_working_text))) input_was_pending = input_pending; #endif @@ -4603,7 +4603,7 @@ timer_start_idle (void) timer_last_idleness_start_time = timer_idleness_start_time; /* Mark all idle-time timers as once again candidates for running. */ - call0 (intern ("internal-timer-start-idle")); + call0 (Qinternal_timer_start_idle); } /* Record that Emacs is no longer idle, so stop running idle-time timers. */ @@ -10129,7 +10129,7 @@ read_char_minibuf_menu_prompt (int commandflag, } /* Prompt with that and read response. */ - message3_nolog (apply1 (intern ("concat"), Fnreverse (menu_strings))); + message3_nolog (apply1 (Qconcat, Fnreverse (menu_strings))); /* Make believe it's not a keyboard macro in case the help char is pressed. Help characters are not recorded because menu prompting @@ -11906,7 +11906,7 @@ On such systems, Emacs starts a subshell instead of suspending. */) if (!NILP (stuffstring)) CHECK_STRING (stuffstring); - run_hook (intern ("suspend-hook")); + run_hook (Qsuspend_hook); get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height); reset_all_sys_modes (); @@ -11927,7 +11927,7 @@ On such systems, Emacs starts a subshell instead of suspending. */) if (width != old_width || height != old_height) change_frame_size (SELECTED_FRAME (), width, height, false, false, false); - run_hook (intern ("suspend-resume-hook")); + run_hook (Qsuspend_resume_hook); return Qnil; } @@ -13702,7 +13702,7 @@ you could say something like: Also see `set-message-function' (which controls how non-error messages are displayed). */); - Vcommand_error_function = intern ("command-error-default-function"); + Vcommand_error_function = Qcommand_error_default_function; DEFVAR_LISP ("enable-disabled-menus-and-buttons", Venable_disabled_menus_and_buttons, @@ -13752,7 +13752,7 @@ of processing the event normally through `special-event-map'. Currently, the only supported values for this variable are `sigusr1' and `sigusr2'. */); - Vdebug_on_event = intern_c_string ("sigusr2"); + Vdebug_on_event = Qsigusr2; DEFVAR_BOOL ("attempt-stack-overflow-recovery", attempt_stack_overflow_recovery, @@ -13854,6 +13854,15 @@ function is called to remap that sequence. */); DEFSYM (Qcurrent_key_remap_sequence, "current-key-remap-sequence"); pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); + + DEFSYM (Qactivate_mark_hook, "activate-mark-hook"); + DEFSYM (Qns_unput_working_text, "ns-unput-working-text"); + DEFSYM (Qinternal_timer_start_idle, "internal-timer-start-idle"); + DEFSYM (Qconcat, "concat"); + DEFSYM (Qsuspend_hook, "suspend-hook"); + DEFSYM (Qsuspend_resume_hook, "suspend-resume-hook"); + DEFSYM (Qcommand_error_default_function, "command-error-default-function"); + DEFSYM (Qsigusr2, "sigusr2"); } static void diff --git a/src/keymap.c b/src/keymap.c index b9d8d18931d..0f50d804dff 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -642,7 +642,7 @@ usage: (map-keymap FUNCTION KEYMAP) */) (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first) { if (! NILP (sort_first)) - return call2 (intern ("map-keymap-sorted"), function, keymap); + return call2 (Qmap_keymap_sorted, function, keymap); map_keymap (keymap, map_keymap_call, function, NULL, 1); return Qnil; @@ -1334,7 +1334,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) /* Initialize the unicode case table, if it wasn't already. */ if (NILP (unicode_case_table)) { - unicode_case_table = uniprop_table (intern ("lowercase")); + unicode_case_table = uniprop_table (Qlowercase); /* uni-lowercase.el might be unavailable during bootstrap. */ if (NILP (unicode_case_table)) return found; @@ -3053,7 +3053,7 @@ DESCRIBER is the output function used; nil means use `princ'. */) { specpdl_ref count = SPECPDL_INDEX (); if (NILP (describer)) - describer = intern ("princ"); + describer = Qprinc; specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR_OR_CHAR_TABLE (vector); describe_vector (vector, Qnil, describer, describe_vector_princ, 0, @@ -3169,7 +3169,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, Lisp_Object kludge = make_nil_vector (1); if (partial) - suppress = intern ("suppress-keymap"); + suppress = Qsuppress_keymap; /* STOP is a boundary between normal characters (-#x3FFF7F) and 8-bit characters (#x3FFF80-), used below when VECTOR is a @@ -3342,6 +3342,7 @@ syms_of_keymap (void) { DEFSYM (Qkeymap, "keymap"); DEFSYM (Qhelp__describe_map_tree, "help--describe-map-tree"); + DEFSYM (Qmap_keymap_sorted, "map-keymap-sorted"); DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize"); @@ -3485,6 +3486,7 @@ that describe key bindings. That is why the default is nil. */); DEFSYM (Qkey_parse, "key-parse"); DEFSYM (Qkey_valid_p, "key-valid-p"); - DEFSYM (Qnon_key_event, "non-key-event"); + DEFSYM (Qprinc, "princ"); + DEFSYM (Qsuppress_keymap, "suppress-keymap"); } diff --git a/src/lread.c b/src/lread.c index d0067fb974b..c92b2ede932 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2741,7 +2741,7 @@ STREAM or the value of `standard-input' may be: minibuffer without a stream, as in (read). But is this feature ever used, and if so, why? IOW, will anything break if this feature is removed !? */ - return call1 (intern ("read-minibuffer"), + return call1 (Qread_minibuffer, build_string ("Lisp expression: ")); return read_internal_start (stream, Qnil, Qnil, false); @@ -2769,7 +2769,7 @@ STREAM or the value of `standard-input' may be: stream = Qread_char; if (EQ (stream, Qread_char)) /* FIXME: ?! When is this used !? */ - return call1 (intern ("read-minibuffer"), + return call1 (Qread_minibuffer, build_string ("Lisp expression: ")); return read_internal_start (stream, Qnil, Qnil, true); @@ -6218,4 +6218,5 @@ Only valid during macro-expansion. Internal use only. */); DEFSYM (Qinternal_macroexpand_for_load, "internal-macroexpand-for-load"); + DEFSYM (Qread_minibuffer, "read-minibuffer"); } diff --git a/src/minibuf.c b/src/minibuf.c index 1029fcdb1ba..86877badd2a 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -494,12 +494,11 @@ confirm the aborting of the current minibuffer and all contained ones. */) to abort any extra non-minibuffer recursive edits. Thus, the number of recursive edits we have to abort equals the number of minibuffers we have to abort. */ - CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"), - array[1]); + call1 (Qminibuffer_quit_recursive_edit, array[1]); } } else - CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit")); + call0 (Qminibuffer_quit_recursive_edit); return Qnil; } @@ -1544,7 +1543,7 @@ function, instead of the usual behavior. */) CONSP (def) ? XCAR (def) : def); } - result = Fcompleting_read (prompt, intern ("internal-complete-buffer"), + result = Fcompleting_read (prompt, Qinternal_complete_buffer, predicate, require_match, Qnil, Qbuffer_name_history, def, Qnil); } @@ -2032,7 +2031,7 @@ See also `completing-read-function'. */) (Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate, Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist, Lisp_Object def, Lisp_Object inherit_input_method) { return CALLN (Ffuncall, - Fsymbol_value (intern ("completing-read-function")), + Fsymbol_value (Qcompleting_read_function), prompt, collection, predicate, require_match, initial_input, hist, def, inherit_input_method); } @@ -2531,4 +2530,7 @@ showing the *Completions* buffer, if any. */); defsubr (&Stest_completion); defsubr (&Sassoc_string); defsubr (&Scompleting_read); + DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit"); + DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer"); + DEFSYM (Qcompleting_read_function, "completing-read-function"); } diff --git a/src/msdos.c b/src/msdos.c index 7e78c35027e..e9faa48fa70 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -3070,12 +3070,12 @@ XMenuActivate (Display *foo, XMenu *menu, int *pane, int *selidx, state = alloca (menu->panecount * sizeof (struct IT_menu_state)); screensize = screen_size * 2; faces[0] - = lookup_derived_face (NULL, sf, intern ("msdos-menu-passive-face"), + = lookup_derived_face (NULL, sf, Qmsdos_menu_passive_face, DEFAULT_FACE_ID, 1); faces[1] - = lookup_derived_face (NULL, sf, intern ("msdos-menu-active-face"), + = lookup_derived_face (NULL, sf, Qmsdos_menu_active_face, DEFAULT_FACE_ID, 1); - selectface = intern ("msdos-menu-select-face"); + selectface = Qmsdos_menu_select_face; faces[2] = lookup_derived_face (NULL, sf, selectface, faces[0], 1); faces[3] = lookup_derived_face (NULL, sf, selectface, @@ -3740,7 +3740,7 @@ run_msdos_command (char **argv, const char *working_dir, *pl = '\0'; cmd = Ffile_name_nondirectory (build_string (lowcase_argv0)); - msshell = !NILP (Fmember (cmd, Fsymbol_value (intern ("msdos-shells")))) + msshell = !NILP (Fmember (cmd, Fsymbol_value (Qmsdos_shells))) && !strcmp ("-c", argv[1]); if (msshell) { @@ -4324,6 +4324,11 @@ This variable is used only by MS-DOS terminals. */); defsubr (&Smsdos_downcase_filename); defsubr (&Smsdos_remember_default_colors); defsubr (&Smsdos_set_mouse_buttons); + + DEFSYM (Qmsdos_menu_passive_face, "msdos-menu-passive-face"); + DEFSYM (Qmsdos_menu_active_face, "msdos-menu-active-face"); + DEFSYM (Qmsdos_menu_select_face, "msdos-menu-select-face"); + DEFSYM (Qmsdos_shells, "msdos-shells"); } #endif /* MSDOS */ diff --git a/src/nsfns.m b/src/nsfns.m index c521140bd68..b08d053610f 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2046,12 +2046,12 @@ Frames are listed from topmost (first) to bottommost (last). */) switch ([ns_get_window (terminal) backingType]) { case NSBackingStoreBuffered: - return intern ("buffered"); + return Qbuffered; #if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 101300 case NSBackingStoreRetained: - return intern ("retained"); + return Qretained; case NSBackingStoreNonretained: - return intern ("non-retained"); + return Qnon_retained; #endif default: error ("Strange value for backingType parameter of frame"); @@ -2071,19 +2071,19 @@ Frames are listed from topmost (first) to bottommost (last). */) depth = [[[NSScreen screens] objectAtIndex:0] depth]; if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL)) - return intern ("static-gray"); + return Qstatic_gray; else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL)) - return intern ("gray-scale"); + return Qgray_scale; else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL)) - return intern ("pseudo-color"); + return Qpseudo_color; else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL)) - return intern ("true-color"); + return Qtrue_color; else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL)) - return intern ("direct-color"); + return Qdirect_color; else /* Color management as far as we do it is really handled by Nextstep itself anyway. */ - return intern ("direct-color"); + return Qdirect_color; } @@ -2183,13 +2183,13 @@ Frames are listed from topmost (first) to bottommost (last). */) (Lisp_Object on) { check_window_system (NULL); - if (EQ (on, intern ("activate"))) + if (EQ (on, Qactivate)) { [NSApp unhide: NSApp]; [NSApp activateIgnoringOtherApps: YES]; } #if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION >= 27 - else if (EQ (on, intern ("activate-front"))) + else if (EQ (on, Qactivate_front)) { [NSApp unhide: NSApp]; [[NSRunningApplication currentApplication] @@ -2530,7 +2530,7 @@ Frames are listed from topmost (first) to bottommost (last). */) if (!NILP (Ffile_directory_p (filename)) && NILP (Ffile_symlink_p (filename))) { - operation = intern ("delete-directory"); + operation = Qdelete_directory; filename = Fdirectory_file_name (filename); } @@ -3149,7 +3149,7 @@ internalBorderWidth or internalBorder (which is what xterm calls /* Set the `display-type' frame parameter before setting up faces. */ { - Lisp_Object disptype = intern ("color"); + Lisp_Object disptype = Qcolor; if (NILP (Fframe_parameter (frame, Qdisplay_type))) { @@ -3208,7 +3208,7 @@ internalBorderWidth or internalBorder (which is what xterm calls { if (!NILP (tip_timer)) { - call1 (intern ("cancel-timer"), tip_timer); + call1 (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -3359,7 +3359,7 @@ internalBorderWidth or internalBorder (which is what xterm calls tip_f = XFRAME (tip_frame); if (!NILP (tip_timer)) { - call1 (intern ("cancel-timer"), tip_timer); + call1 (Qcancel_timer, tip_timer); tip_timer = Qnil; } @@ -3406,12 +3406,12 @@ internalBorderWidth or internalBorder (which is what xterm calls break; } else - tip_last_parms = - call2 (intern ("assq-delete-all"), parm, tip_last_parms); + tip_last_parms + = call2 (Qassq_delete_all, parm, tip_last_parms); } else - tip_last_parms = - call2 (intern ("assq-delete-all"), parm, tip_last_parms); + tip_last_parms + = call2 (Qassq_delete_all, parm, tip_last_parms); } /* Now check if every parameter in what is left of @@ -3573,8 +3573,8 @@ internalBorderWidth or internalBorder (which is what xterm calls start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, - intern ("x-hide-tip")); + tip_timer = call3 (Qrun_at_time, timeout, Qnil, + Qx_hide_tip); } return unbind_to (count, Qnil); @@ -4076,4 +4076,20 @@ - (Lisp_Object)lispString as_script = Qnil; staticpro (&as_script); as_result = 0; + + DEFSYM (Qbuffered, "buffered"); + DEFSYM (Qretained, "retained"); + DEFSYM (Qnon_retained, "non-retained"); + DEFSYM (Qstatic_gray, "static-gray"); + DEFSYM (Qgray_scale, "gray-scale"); + DEFSYM (Qpseudo_color, "pseudo-color"); + DEFSYM (Qtrue_color, "true-color"); + DEFSYM (Qdirect_color, "direct-color"); + DEFSYM (Qactivate, "activate"); + DEFSYM (Qactivate_front, "activate-front"); + DEFSYM (Qcolor, "color"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qassq_delete_all, "assq-delete-all"); + DEFSYM (Qrun_at_time, "run-at-time"); + DEFSYM (Qx_hide_tip, "x-hide-tip"); } diff --git a/src/nsfont.m b/src/nsfont.m index e1b1b097c17..ddbaea11967 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -337,8 +337,8 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, if (EQ (tem, Qitalic) || EQ (tem, Qoblique)) [tdict setObject: [NSNumber numberWithFloat: 1.0] forKey: NSFontSlantTrait]; - else if (EQ (tem, intern ("reverse-italic")) - || EQ (tem, intern ("reverse-oblique"))) + else if (EQ (tem, Qreverse_italic) + || EQ (tem, Qreverse_oblique)) [tdict setObject: [NSNumber numberWithFloat: -1.0] forKey: NSFontSlantTrait]; else @@ -451,7 +451,7 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, data.slant == GS_FONT_SLANT_ITALIC ? Qitalic : (data.slant == GS_FONT_SLANT_REVERSE_ITALIC - ? intern ("reverse-italic") : Qnormal)); + ? Qreverse_italic : Qnormal)); } else FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, Qnormal); @@ -461,7 +461,7 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, data.width == GS_FONT_WIDTH_CONDENSED ? Qcondensed : (data.width == GS_FONT_WIDTH_EXPANDED - ? intern ("expanded") : Qnormal)); + ? Qexpanded : Qnormal)); } else FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, Qnormal); @@ -1744,7 +1744,6 @@ is false when (FROM > 0 || TO < S->nchars). */ syms_of_nsfont (void) { DEFSYM (Qcondensed, "condensed"); - DEFSYM (Qexpanded, "expanded"); DEFSYM (Qmedium, "medium"); DEFVAR_LISP ("ns-reg-to-script", Vns_reg_to_script, @@ -1752,6 +1751,11 @@ is false when (FROM > 0 || TO < S->nchars). */ Vns_reg_to_script = Qnil; pdumper_do_now_and_after_load (syms_of_nsfont_for_pdumper); + + /* Font slant styles. */ + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qreverse_oblique, "reverse-oblique"); + DEFSYM (Qexpanded, "expanded"); } static void diff --git a/src/pdumper.c b/src/pdumper.c index 65da3feff75..3806953f2c2 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4156,7 +4156,7 @@ types. */) /* Bind `command-line-processed' to nil before dumping, so that the dumped Emacs will process its command line and set up to work with X windows if appropriate. */ - Lisp_Object symbol = intern ("command-line-processed"); + Lisp_Object symbol = Qcommand_line_processed; specbind (symbol, Qnil); CHECK_STRING (filename); diff --git a/src/pgtkfns.c b/src/pgtkfns.c index f43eed6ad23..6a8efb6d0bf 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -2148,7 +2148,7 @@ If omitted or nil, that stands for the selected frame's display. On PGTK, always return true-color. */) (Lisp_Object terminal) { - return intern ("true-color"); + return Qtrue_color; } @@ -2844,7 +2844,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct { Lisp_Object disptype; - disptype = intern ("color"); + disptype = Qcolor; if (NILP (Fframe_parameter (frame, Qdisplay_type))) { @@ -3391,8 +3391,7 @@ Text larger than the specified size is clipped. */) start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, - intern ("x-hide-tip")); + tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); } @@ -3967,4 +3966,8 @@ syms_of_pgtkfns (void) DEFSYM (Qlandscape, "landscape"); DEFSYM (Qreverse_portrait, "reverse-portrait"); DEFSYM (Qreverse_landscape, "reverse-landscape"); + DEFSYM (Qtrue_color, "true-color"); + DEFSYM (Qcolor, "color"); + DEFSYM (Qrun_at_time, "run-at-time"); + DEFSYM (Qx_hide_tip, "x-hide-tip"); } diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 72bc636485a..8d9a47b932f 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7182,6 +7182,9 @@ syms_of_pgtkterm (void) DEFSYM (Qsuper, "super"); DEFSYM (Qcontrol, "control"); DEFSYM (QUTF8_STRING, "UTF8_STRING"); + /* Referenced in gtkutil.c. */ + DEFSYM (Qtheme_name, "theme-name"); + DEFSYM (Qfile_name_sans_extension, "file-name-sans-extension"); DEFSYM (Qfile, "file"); DEFSYM (Qurl, "url"); @@ -7199,7 +7202,6 @@ syms_of_pgtkterm (void) DEFSYM (Qlink, "link"); DEFSYM (Qprivate, "private"); - Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); @@ -7479,5 +7481,5 @@ pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) unbind_to (count, Qnil); - return CALLN (Fapply, intern ("concat"), Fnreverse (acc)); + return CALLN (Fapply, Qconcat, Fnreverse (acc)); } diff --git a/src/term.c b/src/term.c index 903444ef69f..351b0a4310c 100644 --- a/src/term.c +++ b/src/term.c @@ -1416,9 +1416,9 @@ term_get_fkeys_1 (void) /* Define f0 first, so that f10 takes precedence in case the key sequences happens to be the same. */ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - make_vector (1, intern ("f0")), Qnil); + make_vector (1, Qf0), Qnil); Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), - make_vector (1, intern ("f10")), Qnil); + make_vector (1, Qf10), Qnil); } else if (k0) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), @@ -2275,7 +2275,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) tty->previous_color_mode = mode; tty_setup_colors (tty , mode); /* This recomputes all the faces given the new color definitions. */ - safe_calln (intern ("tty-set-up-initial-frame-faces")); + safe_calln (Qtty_set_up_initial_frame_faces); } } @@ -2387,7 +2387,7 @@ A suspended tty may be resumed by calling `resume-tty' on it. */) the tty state. */ Lisp_Object term; XSETTERMINAL (term, t); - CALLN (Frun_hook_with_args, intern ("suspend-tty-functions"), term); + CALLN (Frun_hook_with_args, Qsuspend_tty_functions, term); reset_sys_modes (t->display_info.tty); delete_keyboard_wait_descriptor (fileno (f)); @@ -2494,7 +2494,7 @@ frame's terminal). */) /* Run `resume-tty-functions'. */ Lisp_Object term; XSETTERMINAL (term, t); - CALLN (Frun_hook_with_args, intern ("resume-tty-functions"), term); + CALLN (Frun_hook_with_args, Qresume_tty_functions, term); } set_tty_hooks (t); @@ -3277,10 +3277,10 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx, SAFE_NALLOCA (state, 1, menu->panecount); memset (state, 0, sizeof (*state)); faces[0] - = lookup_derived_face (NULL, sf, intern ("tty-menu-disabled-face"), + = lookup_derived_face (NULL, sf, Qtty_menu_disabled_face, DEFAULT_FACE_ID, 1); faces[1] - = lookup_derived_face (NULL, sf, intern ("tty-menu-enabled-face"), + = lookup_derived_face (NULL, sf, Qtty_menu_enabled_face, DEFAULT_FACE_ID, 1); selectface = intern ("tty-menu-selected-face"); faces[2] = lookup_derived_face (NULL, sf, selectface, @@ -4798,4 +4798,12 @@ trigger redisplay. */); DEFSYM (Qtty_menu_mouse_movement, "tty-menu-mouse-movement"); DEFSYM (Qtty_menu_navigation_map, "tty-menu-navigation-map"); #endif + DEFSYM (Qf0, "f0"); + DEFSYM (Qf10, "f10"); + DEFSYM (Qtty_set_up_initial_frame_faces, + "tty-set-up-initial-frame-faces"); + DEFSYM (Qsuspend_tty_functions, "suspend-tty-functions"); + DEFSYM (Qresume_tty_functions, "resume-tty-functions"); + DEFSYM (Qtty_menu_disabled_face, "tty-menu-disabled-face"); + DEFSYM (Qtty_menu_enabled_face, "tty-menu-enabled-face"); } diff --git a/src/terminal.c b/src/terminal.c index 23a5582d4d9..e8316ba32e8 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -287,14 +287,12 @@ create_terminal (enum output_method type, struct redisplay_interface *rif) /* If default coding systems for the terminal and the keyboard are already defined, use them in preference to the defaults. This is needed when Emacs runs in daemon mode. */ - keyboard_coding = - find_symbol_value (intern ("default-keyboard-coding-system")); + keyboard_coding = find_symbol_value (Qdefault_keyboard_coding_system); if (NILP (keyboard_coding) || BASE_EQ (keyboard_coding, Qunbound) || NILP (Fcoding_system_p (keyboard_coding))) keyboard_coding = Qno_conversion; - terminal_coding = - find_symbol_value (intern ("default-terminal-coding-system")); + terminal_coding = find_symbol_value (Qdefault_terminal_coding_system); if (NILP (terminal_coding) || BASE_EQ (terminal_coding, Qunbound) || NILP (Fcoding_system_p (terminal_coding))) @@ -654,7 +652,6 @@ delete_initial_terminal (struct terminal *terminal) void syms_of_terminal (void) { - DEFVAR_LISP ("ring-bell-function", Vring_bell_function, doc: /* Non-nil means call this function to ring the bell. The function should accept no arguments. */); @@ -681,4 +678,6 @@ or some time later. */); defsubr (&Sset_terminal_parameter); Fprovide (intern_c_string ("multi-tty"), Qnil); + DEFSYM (Qdefault_keyboard_coding_system, "default-keyboard-coding-system"); + DEFSYM (Qdefault_terminal_coding_system, "default-terminal-coding-system"); } diff --git a/src/w32fns.c b/src/w32fns.c index ace8d1016a5..8b61b54bdc5 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6539,7 +6539,7 @@ DEFUN ("x-display-backing-store", Fx_display_backing_store, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { - return intern ("not-useful"); + return Qnot_useful; } DEFUN ("x-display-visual-class", Fx_display_visual_class, @@ -6551,13 +6551,13 @@ DEFUN ("x-display-visual-class", Fx_display_visual_class, Lisp_Object result = Qnil; if (dpyinfo->has_palette) - result = intern ("pseudo-color"); + result = Qpseudo_color; else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1) - result = intern ("static-gray"); + result = Qstatic_gray; else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4) - result = intern ("static-color"); + result = Qstatic_color; else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8) - result = intern ("true-color"); + result = Qtrue_color; return result; } @@ -6773,17 +6773,17 @@ SOUND is nil to use the normal beep. */) if (NILP (sound)) sound_type = 0xFFFFFFFF; - else if (EQ (sound, intern ("asterisk"))) + else if (EQ (sound, Qasterisk)) sound_type = MB_ICONASTERISK; - else if (EQ (sound, intern ("exclamation"))) + else if (EQ (sound, Qexclamation)) sound_type = MB_ICONEXCLAMATION; - else if (EQ (sound, intern ("hand"))) + else if (EQ (sound, Qhand)) sound_type = MB_ICONHAND; - else if (EQ (sound, intern ("question"))) + else if (EQ (sound, Qquestion)) sound_type = MB_ICONQUESTION; - else if (EQ (sound, intern ("ok"))) + else if (EQ (sound, Qok)) sound_type = MB_OK; - else if (EQ (sound, intern ("silent"))) + else if (EQ (sound, Qsilent)) sound_type = MB_EMACS_SILENT; else sound_type = 0xFFFFFFFF; @@ -6854,7 +6854,7 @@ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, if (NILP (Ffile_readable_p (color_file))) color_file = Fexpand_file_name (build_string ("rgb.txt"), - Fsymbol_value (intern ("data-directory"))); + Fsymbol_value (Qdata_directory)); Vw32_color_map = Fx_load_color_file (color_file); } @@ -7749,8 +7749,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, - intern ("x-hide-tip")); + tip_timer = call3 (Qrun_at_time, timeout, Qnil, + Qx_hide_tip); return unbind_to (count, Qnil); } @@ -8188,15 +8188,14 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, filename = Qnil; /* An error occurred, fallback on reading from the mini-buffer. */ else - filename = Fcompleting_read ( - orig_prompt, - intern ("read-file-name-internal"), - orig_dir, - mustmatch, - orig_dir, - Qfile_name_history, - default_filename, - Qnil); + filename = Fcompleting_read (orig_prompt, + Qread_file_name_internal, + orig_dir, + mustmatch, + orig_dir, + Qfile_name_history, + default_filename, + Qnil); } /* Make "Cancel" equivalent to C-g. */ @@ -8223,7 +8222,7 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, if (!NILP (Ffile_directory_p (filename)) && NILP (Ffile_symlink_p (filename))) { - operation = intern ("delete-directory"); + operation = Qdelete_directory; filename = Fdirectory_file_name (filename); } @@ -8927,11 +8926,11 @@ to change the state. */) int vk_code; LPARAM lparam; - if (EQ (key, intern ("capslock"))) + if (EQ (key, Qcapslock)) vk_code = VK_CAPITAL; - else if (EQ (key, intern ("kp-numlock"))) + else if (EQ (key, Qkp_numlock)) vk_code = VK_NUMLOCK; - else if (EQ (key, intern ("scroll"))) + else if (EQ (key, Qscroll)) vk_code = VK_SCROLL; else return Qnil; @@ -10714,6 +10713,7 @@ syms_of_w32fns (void) DEFSYM (Qtip_frame, "tip-frame"); DEFSYM (Qassq_delete_all, "assq-delete-all"); DEFSYM (Qunicode_sip, "unicode-sip"); + DEFSYM (Qread_file_name_internal, "read-file-name-internal"); #if defined WINDOWSNT && !defined HAVE_DBUS DEFSYM (QCicon, ":icon"); DEFSYM (QCtip, ":tip"); @@ -11108,6 +11108,23 @@ keys when IME input is received. */); defsubr (&Ssystem_move_file_to_trash); defsubr (&Sw32_set_wallpaper); #endif + + DEFSYM (Qnot_useful, "not-useful"); + DEFSYM (Qpseudo_color, "pseudo-color"); + DEFSYM (Qstatic_gray, "static-gray"); + DEFSYM (Qstatic_color, "static-color"); + DEFSYM (Qtrue_color, "true-color"); + DEFSYM (Qasterisk, "asterisk"); + DEFSYM (Qexclamation, "exclamation"); + DEFSYM (Qquestion, "question"); + DEFSYM (Qok, "ok"); + DEFSYM (Qsilent, "silent"); + DEFSYM (Qdata_directory, "data-directory"); + DEFSYM (Qrun_at_time, "run-at-time"); + DEFSYM (Qx_hide_tip, "x-hide-tip"); + DEFSYM (Qcapslock, "capslock"); + DEFSYM (Qkp_numlock, "kp-numlock"); + DEFSYM (Qscroll, "scroll"); } diff --git a/src/w32font.c b/src/w32font.c index 56061c0d9ce..1c2da1b26fc 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1196,15 +1196,15 @@ w32_enumfont_pattern_entity (Lisp_Object frame, if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE)) tem = Qopentype; else if (font_type & TRUETYPE_FONTTYPE) - tem = intern ("truetype"); + tem = Qtruetype; else if (full_type & NTM_PS_OPENTYPE) tem = Qpostscript; else if (full_type & NTM_TYPE1) - tem = intern ("type1"); + tem = Qtype1; else if (font_type & RASTER_FONTTYPE) - tem = intern ("w32bitmap"); + tem = Qw32bitmap; else - tem = intern ("w32vector"); + tem = Qw32vector; font_put_extra (entity, QCformat, tem); @@ -2773,6 +2773,12 @@ syms_of_w32font (void) DEFSYM (Qsubpixel, "subpixel"); DEFSYM (Qnatural, "natural"); + /* Font formats. */ + DEFSYM (Qtruetype, "truetype"); + DEFSYM (Qtype1, "type1"); + DEFSYM (Qw32bitmap, "w32bitmap"); + DEFSYM (Qw32vector, "w32vector"); + /* Languages */ DEFSYM (Qzh, "zh"); diff --git a/src/w32term.c b/src/w32term.c index 64dbafab3fd..9b10e4c3342 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6417,17 +6417,17 @@ w32_bitmap_icon (struct frame *f, Lisp_Object icon) { LPCTSTR name; - if (EQ (icon, intern ("application"))) + if (EQ (icon, Qapplication)) name = (LPCTSTR) IDI_APPLICATION; - else if (EQ (icon, intern ("hand"))) + else if (EQ (icon, Qhand)) name = (LPCTSTR) IDI_HAND; - else if (EQ (icon, intern ("question"))) + else if (EQ (icon, Qquestion)) name = (LPCTSTR) IDI_QUESTION; - else if (EQ (icon, intern ("exclamation"))) + else if (EQ (icon, Qexclamation)) name = (LPCTSTR) IDI_EXCLAMATION; - else if (EQ (icon, intern ("asterisk"))) + else if (EQ (icon, Qasterisk)) name = (LPCTSTR) IDI_ASTERISK; - else if (EQ (icon, intern ("winlogo"))) + else if (EQ (icon, Qwinlogo)) name = (LPCTSTR) IDI_WINLOGO; else return 1; @@ -7834,6 +7834,10 @@ syms_of_w32term (void) DEFSYM (Qrenamed_from, "renamed-from"); DEFSYM (Qrenamed_to, "renamed-to"); + /* Bitmap icon constants. */ + DEFSYM (Qapplication, "application"); + DEFSYM (Qwinlogo, "winlogo"); + DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout, doc: /* SKIP: real doc in xterm.c. */); Vx_wait_for_event_timeout = make_float (0.1); diff --git a/src/xdisp.c b/src/xdisp.c index a52c5250c5c..a7cae804006 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12053,8 +12053,8 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name)); Fset_buffer (Fget_buffer_create (Vmessages_buffer_name, Qnil)); if (newbuffer - && !NILP (Ffboundp (intern ("messages-buffer-mode")))) - call0 (intern ("messages-buffer-mode")); + && !NILP (Ffboundp (Qmessages_buffer_mode))) + call0 (Qmessages_buffer_mode); bset_undo_list (current_buffer, Qt); bset_cache_long_scans (current_buffer, Qnil); @@ -35379,15 +35379,15 @@ define_frame_cursor1 (struct frame *f, Emacs_Cursor cursor, Lisp_Object pointer) cursor = FRAME_OUTPUT_DATA (f)->hand_cursor; else if (EQ (pointer, Qtext)) cursor = FRAME_OUTPUT_DATA (f)->text_cursor; - else if (EQ (pointer, intern ("hdrag"))) + else if (EQ (pointer, Qhdrag)) cursor = FRAME_OUTPUT_DATA (f)->horizontal_drag_cursor; - else if (EQ (pointer, intern ("nhdrag"))) + else if (EQ (pointer, Qnhdrag)) cursor = FRAME_OUTPUT_DATA (f)->vertical_drag_cursor; # ifdef HAVE_X_WINDOWS - else if (EQ (pointer, intern ("vdrag"))) + else if (EQ (pointer, Qvdrag)) cursor = FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor; # endif - else if (EQ (pointer, intern ("hourglass"))) + else if (EQ (pointer, Qhourglass)) cursor = FRAME_OUTPUT_DATA (f)->hourglass_cursor; else if (EQ (pointer, Qmodeline)) cursor = FRAME_OUTPUT_DATA (f)->modeline_cursor; @@ -38263,6 +38263,13 @@ depending on your patience and the speed of your system. */); /* Called by decode_mode_spec. */ DEFSYM (Qfile_remote_p, "file-remote-p"); + + /* Called or compared against by various functions. */ + DEFSYM (Qmessages_buffer_mode, "messages-buffer-mode"); + DEFSYM (Qhdrag, "hdrag"); + DEFSYM (Qnhdrag, "nhdrag"); + DEFSYM (Qvdrag, "vdrag"); + DEFSYM (Qhourglass, "hourglass"); } diff --git a/src/xfaces.c b/src/xfaces.c index d5079491258..5192b22ce0a 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1084,7 +1084,7 @@ tty_lookup_color (struct frame *f, Lisp_Object color, Emacs_Color *tty_color, return true; } - else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist")))) + else if (NILP (Fsymbol_value (Qtty_defined_color_alist))) /* We were called early during startup, and the colors are not yet set up in tty-defined-color-alist. Don't return a failure indication, since this produces the annoying "Unable to @@ -7408,6 +7408,7 @@ syms_of_xfaces (void) /* The name of the function used to compute colors on TTYs. */ DEFSYM (Qtty_color_alist, "tty-color-alist"); + DEFSYM (Qtty_defined_color_alist, "tty-defined-color-alist"); Vface_alternative_font_family_alist = Qnil; staticpro (&Vface_alternative_font_family_alist); diff --git a/src/xml.c b/src/xml.c index 85f16746289..dc707bea864 100644 --- a/src/xml.c +++ b/src/xml.c @@ -165,7 +165,7 @@ make_dom (xmlNode *node) else if (node->type == XML_COMMENT_NODE) { if (node->content) - return list3 (intern ("comment"), Qnil, + return list3 (Qcomment, Qnil, build_string ((char *) node->content)); else return Qnil; @@ -353,4 +353,6 @@ syms_of_xml (void) defsubr (&Slibxml_parse_xml_region); #endif defsubr (&Slibxml_available_p); + + DEFSYM (Qcomment, "comment"); } diff --git a/src/xterm.c b/src/xterm.c index 44f0cc55fd7..33ef18d8da5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32569,9 +32569,6 @@ syms_of_xterm (void) x_dnd_unsupported_drop_data = Qnil; staticpro (&x_dnd_unsupported_drop_data); - /* Used by x_cr_export_frames. */ - DEFSYM (Qconcat, "concat"); - DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms"); DEFSYM (Qlatin_1, "latin-1"); DEFSYM (Qnow, "now"); @@ -32677,6 +32674,10 @@ Android does not support scroll bars at all. */); DEFSYM (Qraise_and_focus, "raise-and-focus"); DEFSYM (Qreally_fast, "really-fast"); + /* Referenced in gtkutil.c. */ + DEFSYM (Qtheme_name, "theme-name"); + DEFSYM (Qfile_name_sans_extension, "file-name-sans-extension"); + DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which modifer value Emacs reports when Ctrl is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or diff --git a/src/xwidget.c b/src/xwidget.c index 389c48ca7f5..04ebcbfe96c 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -2286,7 +2286,7 @@ store_xwidget_download_callback_event (struct xwidget *xw, EVENT_INIT (event); event.kind = XWIDGET_EVENT; event.frame_or_window = Qnil; - event.arg = list5 (intern ("download-callback"), + event.arg = list5 (Qdownload_callback, xwl, build_string (url), build_string (mimetype), @@ -2305,7 +2305,7 @@ store_xwidget_js_callback_event (struct xwidget *xw, EVENT_INIT (event); event.kind = XWIDGET_EVENT; event.frame_or_window = Qnil; - event.arg = list4 (intern ("javascript-callback"), xwl, proc, argument); + event.arg = list4 (Qjavascript_callback, xwl, proc, argument); kbd_buffer_store_event (&event); } @@ -4001,6 +4001,8 @@ to take effect. */); staticpro (&dummy_tooltip_string); #endif #endif + DEFSYM (Qdownload_callback, "download-callback"); + DEFSYM (Qjavascript_callback, "javascript-callback"); } commit 9b7dd30807ed4be9afe4f66cfa5130aa7d178989 Author: Juri Linkov Date: Thu May 9 09:28:50 2024 +0300 * lisp/treesit.el (treesit-outline-search): Handle bobp specially. At the beginning of the buffer call 'treesit-outline-search' recursively with the `looking-at' argument set to t, since `treesit-navigate-thing' can't find a thing at bobp (bug#70789). diff --git a/lisp/treesit.el b/lisp/treesit.el index e55e04e53b3..86ed1bbae33 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2884,15 +2884,21 @@ See the descriptions of arguments in `outline-search-function'." (start (treesit-node-start node))) (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) - (let* ((pos + (let* ((bob-pos + ;; `treesit-navigate-thing' can't find a thing at bobp, + ;; so use `looking-at' to match at bobp. + (and (bobp) (treesit-outline-search bound move backward t) (point))) + (pos ;; When function wants to find the current outline, point ;; is at the beginning of the current line. When it wants ;; to find the next outline, point is at the second column. - (if (eq (point) (pos-bol)) - (if (bobp) (point) (1- (point))) - (pos-eol))) - (found (treesit-navigate-thing pos (if backward -1 1) 'beg - treesit-outline-predicate))) + (unless bob-pos + (if (eq (point) (pos-bol)) + (if (bobp) (point) (1- (point))) + (pos-eol)))) + (found (or bob-pos + (treesit-navigate-thing pos (if backward -1 1) 'beg + treesit-outline-predicate)))) (if found (if (or (not bound) (if backward (>= found bound) (<= found bound))) (progn commit 24c02c700cad3ed94687cf694856a0bee42405ba Author: Noah Peart Date: Thu May 2 06:58:34 2024 -0700 Fontify for_statement variable in python-ts-mode (bug#70718) * lisp/progmodes/python.el (python--treesit-settings): Add font-lock query for for_statement variable in assignment feature. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 7f28f583543..764ef03da8a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1251,6 +1251,7 @@ fontified." @font-lock-variable-name-face) (named_expression name: (identifier) @font-lock-variable-name-face) + (for_statement left: (identifier) @font-lock-variable-name-face) (pattern_list [(identifier) (list_splat_pattern (identifier))] @font-lock-variable-name-face) commit c6a5aae3da17459be7550c8f183c0c350ba8ccb0 Author: Yuan Fu Date: Wed May 8 21:25:40 2024 -0700 Fontify namespace in c++-ts-mode * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Add a rule for namespace. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 730671da781..b703999d788 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -665,7 +665,9 @@ MODE is either `c' or `cpp'." (qualified_identifier scope: (namespace_identifier) @font-lock-type-face) - (operator_cast) type: (type_identifier) @font-lock-type-face)) + (operator_cast) type: (type_identifier) @font-lock-type-face + + (namespace_identifier) @font-lock-constant-face)) [,@c-ts-mode--type-keywords] @font-lock-type-face) :language mode commit 80ba6b7b96aad3659675b76a8965788fd0d73476 Author: Yuan Fu Date: Wed May 8 20:50:24 2024 -0700 Fix #if defined directive fontification in c-ts-mode * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Fontify each part separately so the identifier isn't overriden. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 2d431d75d21..730671da781 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -617,8 +617,11 @@ MODE is either `c' or `cpp'." (preproc_params (identifier) @font-lock-variable-name-face) - (preproc_defined) @font-lock-preprocessor-face - (preproc_defined (identifier) @font-lock-variable-name-face) + (preproc_defined + "defined" @font-lock-preprocessor-face + "(" @font-lock-preprocessor-face + (identifier) @font-lock-variable-name-face + ")" @font-lock-preprocessor-face) [,@c-ts-mode--preproc-keywords] @font-lock-preprocessor-face) :language mode commit 73d2b829f06124fec8b65eebc68e87da48808086 Author: john muhl Date: Fri May 3 15:51:01 2024 -0500 Improve indentation in 'lua-ts-mode' (bug#70785) * lisp/progmodes/lua-ts-mode.el (lua-ts--simple-indent-rules): - Ignore comments when aligning arguments, parameters and fields. - Apply simpler rules to simpler usage of anonymous functions. - Better handling of table as a function argument. (lua-ts--comment-first-sibling-matcher): (lua-ts--first-real-sibling-anchor): (lua-ts--last-arg-function-call-matcher): (lua-ts--top-level-function-call-matcher): New function. (lua-ts--g-parent): (lua-ts--g-g-parent): New function. (lua-ts--g-g-g-parent): Use it. * test/lisp/progmodes/lua-ts-mode-resources/indent.erts: Add tests. diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 06663e5bd0e..f15edd040cc 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -291,6 +291,14 @@ values of OVERRIDE." (parent-is "string_content") (node-is "]]")) no-indent 0) + ((and (n-p-gp "field" "table_constructor" "arguments") + lua-ts--multi-arg-function-call-matcher + lua-ts--last-arg-function-call-matcher) + standalone-parent lua-ts-indent-offset) + ((and (n-p-gp "}" "table_constructor" "arguments") + lua-ts--multi-arg-function-call-matcher + lua-ts--last-arg-function-call-matcher) + standalone-parent 0) ((and (n-p-gp "field" "table_constructor" "arguments") lua-ts--multi-arg-function-call-matcher) parent lua-ts-indent-offset) @@ -311,10 +319,15 @@ values of OVERRIDE." (and (parent-is "parameters") lua-ts--first-child-matcher) (and (parent-is "table_constructor") lua-ts--first-child-matcher)) standalone-parent lua-ts-indent-offset) + ((and (not lua-ts--comment-first-sibling-matcher) + (or (parent-is "arguments") + (parent-is "parameters") + (parent-is "table_constructor"))) + lua-ts--first-real-sibling-anchor 0) ((or (parent-is "arguments") (parent-is "parameters") (parent-is "table_constructor")) - (nth-sibling 1) 0) + standalone-parent lua-ts-indent-offset) ((and (n-p-gp "block" "function_definition" "parenthesized_expression") lua-ts--nested-function-block-matcher lua-ts--nested-function-block-include-matcher) @@ -337,6 +350,9 @@ values of OVERRIDE." lua-ts--nested-function-end-matcher lua-ts--nested-function-last-function-matcher) parent 0) + ((and (n-p-gp "end" "function_definition" "arguments") + lua-ts--top-level-function-call-matcher) + standalone-parent 0) ((n-p-gp "end" "function_definition" "arguments") parent 0) ((or (match "end" "function_definition") (node-is "end")) @@ -385,24 +401,39 @@ values of OVERRIDE." "Return t if NODE is a function_definition." (equal "function_definition" (treesit-node-type node))) +(defun lua-ts--g-parent (node) + "Return the grand-parent of NODE." + (let ((parent (treesit-node-parent node))) + (treesit-node-parent parent))) + +(defun lua-ts--g-g-parent (node) + "Return the great-grand-parent of NODE." + (treesit-node-parent (lua-ts--g-parent node))) + (defun lua-ts--g-g-g-parent (node) "Return the great-great-grand-parent of NODE." - (let* ((parent (treesit-node-parent node)) - (g-parent (treesit-node-parent parent)) - (g-g-parent (treesit-node-parent g-parent))) - (treesit-node-parent g-g-parent))) + (treesit-node-parent (lua-ts--g-g-parent node))) (defun lua-ts--multi-arg-function-call-matcher (_n parent &rest _) "Matches if PARENT has multiple arguments." (> (treesit-node-child-count (treesit-node-parent parent)) 3)) +(defun lua-ts--last-arg-function-call-matcher (node parent &rest _) + "Matches if NODE's PARENT is the last argument in a function call." + (let* ((g-parent (lua-ts--g-parent node)) + (last (1- (treesit-node-child-count g-parent t)))) + (treesit-node-eq parent (seq-elt (treesit-node-children g-parent t) last)))) + (defun lua-ts--nested-function-argument-matcher (node &rest _) "Matches if NODE is in a nested function argument." (save-excursion (goto-char (treesit-node-start node)) (treesit-beginning-of-defun) (backward-char 2) - (not (looking-at ")(")))) + (and (not (looking-at ")(")) + (not (equal "chunk" + (treesit-node-type + (lua-ts--g-parent (treesit-node-at (point))))))))) (defun lua-ts--nested-function-block-matcher (node &rest _) "Matches if NODE is in a nested function block." @@ -438,6 +469,26 @@ values of OVERRIDE." (treesit-induce-sparse-tree parent #'lua-ts--function-definition-p))) (= 1 (length (cadr sparse-tree))))) +(defun lua-ts--comment-first-sibling-matcher (node &rest _) + "Matches if NODE if it's previous sibling is a comment." + (let ((sibling (treesit-node-prev-sibling node))) + (equal "comment" (treesit-node-type sibling)))) + +(defun lua-ts--top-level-function-call-matcher (node &rest _) + "Matches if NODE is within a top-level function call." + (let* ((g-g-p (lua-ts--g-g-parent node)) + (g-g-g-p (lua-ts--g-g-g-parent node))) + (and (equal "function_call" (treesit-node-type g-g-p)) + (equal "chunk" (treesit-node-type g-g-g-p))))) + +(defun lua-ts--first-real-sibling-anchor (_n parent _) + "Return the start position of the first non-comment child of PARENT." + (treesit-node-start + (seq-first + (seq-filter + (lambda (n) (not (equal "comment" (treesit-node-type n)))) + (treesit-node-children parent t))))) + (defun lua-ts--variable-declaration-continuation (node &rest _) "Matches if NODE is part of a multi-line variable declaration." (treesit-parent-until node diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts index 48184160b4d..ba7bad1b452 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts @@ -66,6 +66,10 @@ end return f end +f6(function() +print'ok' +end) + ;(function () return true end)() @@ -118,6 +122,10 @@ function f6(...) return f end +f6(function() + print'ok' +end) + ;(function () return true end)() @@ -406,6 +414,15 @@ a = 1, b = 2, }, nil) + +Test(nil, { + a = 1, + b = 2, + }) + +fn( -- comment + 1, + 2) =-= h( "string", @@ -443,6 +460,15 @@ Test({ b = 2, }, nil) + +Test(nil, { + a = 1, + b = 2, +}) + +fn( -- comment + 1, + 2) =-=-= Name: Parameter Indent @@ -464,6 +490,9 @@ local f3 = function( a, b, c, d ) print(a,b,c,d) end + +local f4 = function(-- comment +a, b, c) =-= function f1( a, @@ -481,6 +510,9 @@ local f3 = function( a, b, c, d ) print(a,b,c,d) end + +local f4 = function(-- comment + a, b, c) =-=-= Name: Table Indent @@ -506,6 +538,10 @@ a = 1, b = 2, c = 3, } + +local a = { -- hello world! + b = 10 +} =-= local Other = { First={up={Step=true,Jump=true}, @@ -527,6 +563,10 @@ local Other = { b = 2, c = 3, } + +local a = { -- hello world! + b = 10 +} =-=-= Name: Continuation Indent commit 4eb363acc825ef3aaa5468ab5e206ecab5883acb Author: john muhl Date: Sat Apr 27 18:52:41 2024 -0500 ; Quietly skip 'lua-ts-mode' tests (bug#70786) * test/lisp/align-tests.el (align-lua): * test/lisp/progmodes/lua-ts-mode-tests.el (lua-ts-test-indentation): (lua-ts-test-movement): (lua-ts-test-font-lock): (lua-ts-test-which-function): Suppress warnings when the grammar is not installed. diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el index cd309ea07bf..eaebaf8360c 100644 --- a/test/lisp/align-tests.el +++ b/test/lisp/align-tests.el @@ -52,7 +52,7 @@ (autoload 'treesit-ready-p "treesit") (ert-deftest align-lua () - (skip-unless (treesit-ready-p 'lua)) + (skip-unless (treesit-ready-p 'lua t)) (let ((comment-column 20) (indent-tabs-mode nil)) (ert-test-erts-file (ert-resource-file "lua-ts-mode.erts") diff --git a/test/lisp/progmodes/lua-ts-mode-tests.el b/test/lisp/progmodes/lua-ts-mode-tests.el index a7b637d18d1..68b8c9ccfaa 100644 --- a/test/lisp/progmodes/lua-ts-mode-tests.el +++ b/test/lisp/progmodes/lua-ts-mode-tests.el @@ -26,20 +26,20 @@ (require 'which-func) (ert-deftest lua-ts-test-indentation () - (skip-unless (treesit-ready-p 'lua)) + (skip-unless (treesit-ready-p 'lua t)) (ert-test-erts-file (ert-resource-file "indent.erts"))) (ert-deftest lua-ts-test-movement () - (skip-unless (treesit-ready-p 'lua)) + (skip-unless (treesit-ready-p 'lua t)) (ert-test-erts-file (ert-resource-file "movement.erts"))) (ert-deftest lua-ts-test-font-lock () - (skip-unless (treesit-ready-p 'lua)) + (skip-unless (treesit-ready-p 'lua t)) (let ((treesit-font-lock-level 4)) (ert-font-lock-test-file (ert-resource-file "font-lock.lua") 'lua-ts-mode))) (ert-deftest lua-ts-test-which-function () - (skip-unless (treesit-ready-p 'lua)) + (skip-unless (treesit-ready-p 'lua t)) (with-temp-buffer (insert-file-contents (ert-resource-file "which-function.lua")) (lua-ts-mode) commit 03d4b96da62fbb7abfb7fa8fcfc963313e394f22 Author: Yuan Fu Date: Wed May 8 20:27:12 2024 -0700 Fontify doc comment in c-ts-mode with doc-face * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Add rule for /** comments. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index a1b2b1f500c..2d431d75d21 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -597,8 +597,9 @@ MODE is either `c' or `cpp'." (treesit-font-lock-rules :language mode :feature 'comment - `((comment) @font-lock-comment-face - (comment) @contextual) + `(((comment) @font-lock-doc-face + (:match ,(rx bos "/**") @font-lock-doc-face)) + (comment) @font-lock-comment-face) :language mode :feature 'preprocessor commit 86187d43e2db841f8ca2893a31f05669f4a1247b Author: Dmitry Gutov Date: Thu May 9 05:57:07 2024 +0300 xref--collect-matches: Fix the application of syntax-propertize * lisp/progmodes/xref.el (xref--collect-matches): Add syntax-ppss-flush-cache call when needed (bug#53749). diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 9fa8383ef10..90ed8eb20e9 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -2100,6 +2100,8 @@ Such as the current syntax table and the applied syntax properties." (pcase-let* ((`(,line ,file ,text) hit) (file (and file (concat xref--hits-remote-id file))) (buf (xref--find-file-buffer file)) + ;; This is fairly dangerouns, but improves performance + ;; for large lists, see https://debbugs.gnu.org/53749#227 (inhibit-modification-hooks t)) (if buf (with-current-buffer buf @@ -2131,6 +2133,8 @@ Such as the current syntax table and the applied syntax properties." (erase-buffer)) (insert text) (goto-char (point-min)) + (when syntax-needed + (syntax-ppss-flush-cache (point))) (xref--collect-matches-1 regexp file line (point) (point-max) commit ff3f17ca3cdd9e82355942f577e7807acc76ddcd Author: Dmitry Gutov Date: Thu May 9 05:30:32 2024 +0300 choose-completion: Retain the suffix after completion boundary * lisp/minibuffer.el (completion-base-suffix): Remove as not optimal after all (bug#48356). (completion--replace): Use insert-before-markers-and-inherit. (minibuffer-completion-help): Don't set completion-base-affixes, implement the same logic more optimally by local search and querying for field boundaries. Also fix the problem with completion table, predicate and extra-props being looked up in the wrong buffer. (minibuffer-next-completion, minibuffer-choose-completion): Don't bind completion-use-base-affixes anymore. * lisp/simple.el (completion-base-affixes) (completion-use-base-affixes): Remove. (completion-list-insert-choice-function): Don't pass them through anymore. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ad6a0928cda..61395577035 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -112,20 +112,6 @@ the closest directory separators." (cons (or (cadr boundaries) 0) (or (cddr boundaries) (length suffix))))) -(defun completion-base-suffix (start end collection predicate) - "Return suffix of completion of buffer text between START and END. -COLLECTION and PREDICATE are, respectively, the completion's -completion table and predicate, as in `completion-boundaries' (which see). -Value is a substring of buffer text between point and END. It is -the completion suffix that follows the completion boundary." - (let ((suffix (buffer-substring (point) end))) - (substring - suffix - (cdr (completion-boundaries (buffer-substring start (point)) - collection - predicate - suffix))))) - (defun completion-metadata (string table pred) "Return the metadata of elements to complete at the end of STRING. This metadata is an alist. Currently understood keys are: @@ -1377,7 +1363,7 @@ Moves point to the end of the new text." (setq newtext (substring newtext 0 (- suffix-len)))) (goto-char beg) (let ((length (- end beg))) ;Read `end' before we insert the text. - (insert-and-inherit newtext) + (insert-before-markers-and-inherit newtext) (delete-region (point) (+ (point) length))) (forward-char suffix-len))) @@ -2598,17 +2584,23 @@ The candidate will still be chosen by `choose-completion' unless (base-size (or (cdr last) 0)) (prefix (unless (zerop base-size) (substring string 0 base-size))) (minibuffer-completion-base (substring string 0 base-size)) - (base-prefix (buffer-substring (minibuffer--completion-prompt-end) - (+ start base-size))) - (base-suffix (concat (completion-base-suffix start end - minibuffer-completion-table - minibuffer-completion-predicate) - (buffer-substring end (point-max)))) + (ctable minibuffer-completion-table) + (cpred minibuffer-completion-predicate) + (cprops completion-extra-properties) + (field-end + (save-excursion + (forward-char + (cdr (completion-boundaries (buffer-substring start (point)) + ctable + cpred + (buffer-substring (point) end)))) + (point-marker))) + (field-char (and (< field-end end) (char-after field-end))) (all-md (completion--metadata (buffer-substring-no-properties start (point)) base-size md - minibuffer-completion-table - minibuffer-completion-predicate)) + ctable + cpred)) (ann-fun (completion-metadata-get all-md 'annotation-function)) (aff-fun (completion-metadata-get all-md 'affixation-function)) (sort-fun (completion-metadata-get all-md 'display-sort-function)) @@ -2687,38 +2679,31 @@ The candidate will still be chosen by `choose-completion' unless (with-current-buffer standard-output (setq-local completion-base-position - (list (+ start base-size) - ;; FIXME: We should pay attention to completion - ;; boundaries here, but currently - ;; completion-all-completions does not give us the - ;; necessary information. - end)) - (setq-local completion-base-affixes - (list base-prefix base-suffix)) + (list (+ start base-size) field-end)) (setq-local completion-list-insert-choice-function - (let ((ctable minibuffer-completion-table) - (cpred minibuffer-completion-predicate) - (cprops completion-extra-properties)) (lambda (start end choice) - (if (and (stringp start) (stringp end)) - (progn - (delete-minibuffer-contents) - (insert start choice) - ;; Keep point after completion before suffix - (save-excursion (insert - (completion--merge-suffix - choice - (1- (length choice)) - end)))) - (unless (or (zerop (length prefix)) - (equal prefix - (buffer-substring-no-properties - (max (point-min) - (- start (length prefix))) - start))) - (message "*Completions* out of date")) - ;; FIXME: Use `md' to do quoting&terminator here. - (completion--replace start end choice)) + (unless (or (zerop (length prefix)) + (equal prefix + (buffer-substring-no-properties + (max (point-min) + (- start (length prefix))) + start))) + (message "*Completions* out of date")) + (when (> (point) end) + ;; Completion suffix has changed, have to adapt. + (setq end (+ end + (cdr (completion-boundaries + (concat prefix choice) ctable cpred + (buffer-substring end (point)))))) + ;; Stopped before some field boundary. + (when (> (point) end) + (setq field-char (char-after end)))) + (when (and field-char + (= (aref choice (1- (length choice))) + field-char)) + (setq end (1+ end))) + ;; FIXME: Use `md' to do quoting&terminator here. + (completion--replace start end choice) (let* ((minibuffer-completion-table ctable) (minibuffer-completion-predicate cpred) (completion-extra-properties cprops) @@ -2729,7 +2714,7 @@ The candidate will still be chosen by `choose-completion' unless ;; completion is not finished. (completion--done result (if (eq (car bounds) (length result)) - 'exact 'finished))))))) + 'exact 'finished)))))) (display-completion-list completions nil group-fun))))) nil))) @@ -4877,8 +4862,7 @@ insert the selected completion candidate to the minibuffer." (next-line-completion (or n 1)) (next-completion (or n 1))) (when auto-choose - (let ((completion-use-base-affixes t) - (completion-auto-deselect nil)) + (let ((completion-auto-deselect nil)) (choose-completion nil t t)))))) (defun minibuffer-previous-completion (&optional n) @@ -4916,8 +4900,7 @@ If NO-QUIT is non-nil, insert the completion candidate at point to the minibuffer, but don't quit the completions window." (interactive "P") (with-minibuffer-completions-window - (let ((completion-use-base-affixes t)) - (choose-completion nil no-exit no-quit)))) + (choose-completion nil no-exit no-quit))) (defun minibuffer-choose-completion-or-exit (&optional no-exit no-quit) "Choose the completion from the minibuffer or exit the minibuffer. diff --git a/lisp/simple.el b/lisp/simple.el index a459f6ecfd2..deab52c4201 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9858,16 +9858,6 @@ Its value is a list of the form (START END) where START is the place where the completion should be inserted and END (if non-nil) is the end of the text to replace. If END is nil, point is used instead.") -(defvar completion-base-affixes nil - "Base context of the text corresponding to the shown completions. -This variable is used in the *Completions* buffer. -Its value is a list of the form (PREFIX SUFFIX) where PREFIX is the text -before the place where completion should be inserted, and SUFFIX is the text -after the completion.") - -(defvar completion-use-base-affixes nil - "Non-nil means to restore original prefix and suffix in the minibuffer.") - (defvar completion-list-insert-choice-function #'completion--replace "Function to use to insert the text chosen in *Completions*. Called with three arguments (BEG END TEXT), it should replace the text @@ -10128,7 +10118,6 @@ minibuffer, but don't quit the completions window." (with-current-buffer (window-buffer (posn-window (event-start event))) (let ((buffer completion-reference-buffer) (base-position completion-base-position) - (base-affixes completion-base-affixes) (insert-function completion-list-insert-choice-function) (completion-no-auto-exit (if no-exit t completion-no-auto-exit)) (choice @@ -10161,13 +10150,7 @@ minibuffer, but don't quit the completions window." (with-current-buffer buffer (choose-completion-string choice buffer - ;; Don't allow affixes to replace the whole buffer when not - ;; in the minibuffer. Thus check for `completion-in-region-mode' - ;; to ignore non-nil value of `completion-use-base-affixes' set by - ;; `minibuffer-choose-completion'. - (or (and (not completion-in-region-mode) - completion-use-base-affixes base-affixes) - base-position + (or base-position ;; If all else fails, just guess. (list (choose-completion-guess-base-position choice))) insert-function))))) @@ -10323,11 +10306,9 @@ Called from `temp-buffer-show-hook'." (buffer-substring (minibuffer-prompt-end) (point))))))) (with-current-buffer standard-output (let ((base-position completion-base-position) - (base-affixes completion-base-affixes) (insert-fun completion-list-insert-choice-function)) (completion-list-mode) (setq-local completion-base-position base-position) - (setq-local completion-base-affixes base-affixes) (setq-local completion-list-insert-choice-function insert-fun)) (setq-local completion-reference-buffer mainbuf) (if base-dir (setq default-directory base-dir)) commit 8bc4292673dfc04ce781e242596779809f1a3634 Author: Po Lu Date: Thu May 9 09:00:02 2024 +0800 Don't report erroneous /content directory on Android 4.3 and earlier * src/androidvfs.c (android_content_opendir): Skip two, not one, elements on Android <= 4.4. diff --git a/src/androidvfs.c b/src/androidvfs.c index 38bec7d349a..c326896d4c3 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -2813,7 +2813,7 @@ android_content_opendir (struct android_vnode *vnode) /* Android 4.3 and earlier don't support /content/by-authority. */ if (api < 19) - dir->next_name++; + dir->next_name += 2; /* Link this stream onto the list of all content directory streams. */ commit 36c68e7e34df996bbde4cc82c04ea1619349b64a Author: F. Jason Park Date: Mon May 6 21:59:48 2024 -0700 Prefer erc--skip property to erc-track--skipped-msgs * lisp/erc/erc-stamp.el (erc-add-timestamp): Honor an overriding `erc--ts' "msg prop". (erc-stamp--defer-date-insertion-on-post-modify): Add `erc--skip' for the `track' module. * lisp/erc/erc-track.el (erc-track--skipped-msgs): Remove unused variable. Originally added as part of bug#60936. (erc-track-modified-channels): Rely on the `erc--skip' "msg prop" instead of the now defunct `erc-track--skipped-msgs' variable for detecting requests to omit `track' mode-line updates during `erc-display-message'. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 77981bc9d07..fd137c0548a 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -243,7 +243,8 @@ or `erc-send-modify-hook'." (unless (and (not erc-stamp--allow-unmanaged-p) (or (null erc--msg-props) (erc--memq-msg-prop 'erc--skip 'stamp))) - (let* ((ct (erc-stamp--current-time)) + (let* ((ct (or (erc--check-msg-prop 'erc--ts) + (erc-stamp--current-time))) (invisible (get-text-property (point-min) 'invisible)) (erc-stamp--invisible-property ;; FIXME on major version bump, make this `erc-' prefixed. @@ -737,7 +738,8 @@ non-nil." (setq erc-stamp--deferred-date-stamp nil) (let* ((aligned (erc-stamp--time-as-day ct)) (erc-stamp--current-time aligned) - (erc--msg-props (map-into '((erc--msg . datestamp)) + (erc--msg-props (map-into '((erc--msg . datestamp) + (erc--skip track)) 'hash-table)) (erc-insert-post-hook `(,(lambda () diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 04ee76a9349..40e83fff974 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -959,9 +959,6 @@ NEW-FACES has a cdr." (throw 'face candidate)))))) choice))) -(defvar erc-track--skipped-msgs '(datestamp) - "Values of `erc--msg' text prop to ignore.") - (defun erc-track-modified-channels () "Hook function for `erc-insert-post-hook'. Check if the current buffer should be added to the mode line as a @@ -980,8 +977,7 @@ the current buffer is in `erc-mode'." erc-track-exclude-types) ;; Skip certain non-server-sent messages. (and (not parsed) - (erc--check-msg-prop 'erc--msg - erc-track--skipped-msgs)))))) + (erc--memq-msg-prop 'erc--skip 'track)))))) ;; If the active buffer is not visible (not shown in a ;; window), and not to be excluded, determine the kinds of ;; faces used in the current message, and unless the user commit d647a5238705bbb4a9277d71bb8069fba2cac7f3 Author: F. Jason Park Date: Wed May 8 15:26:29 2024 -0700 Avoid shared-ref read syntax in ERC message catalogs * lisp/erc/erc.el (erc--message-speaker-ctcp-action-input) (erc--message-speaker-ctcp-action-statusmsg-input): Don't use shared/circular references, like #1=foo ... #1#, in literal strings because it triggers CI validation failures. These message-format definitions were originally introduced as part of bug#67677. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ce805fdab13..c92fd42322a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6135,7 +6135,8 @@ NUH, and the current `erc-response' object.") ;; The format strings in the following `-speaker' catalog shouldn't ;; contain any non-protocol words, so they make sense in any language. - +;; Note that the following definitions generally avoid `propertize' +;; because it reverses the order of the text properties it's given. (defvar erc--message-speaker-statusmsg #("(%p%n%s) %m" 0 1 (font-lock-face erc-default-face) @@ -6227,11 +6228,11 @@ NUH, and the current `erc-response' object.") "Message template for a CTCP ACTION from another user.") (defvar erc--message-speaker-ctcp-action-input - #("* %p%n %m" - 0 2 (font-lock-face #1=(erc-input-face erc-action-face)) - 2 4 (font-lock-face (erc-my-nick-prefix-face . #1#)) - 4 6 (font-lock-face (erc-my-nick-face . #1#)) - 6 9 (font-lock-face #1#)) + (let ((base '(erc-input-face erc-action-face))) ; shared + (concat (propertize "* " 'font-lock-face base) + (propertize "%p" 'font-lock-face `(erc-my-nick-prefix-face ,@base)) + (propertize "%n" 'font-lock-face `(erc-my-nick-face ,@base)) + (propertize " %m" 'font-lock-face base))) "Message template for a CTCP ACTION from current client.") (defvar erc--message-speaker-ctcp-action-statusmsg @@ -6244,12 +6245,12 @@ NUH, and the current `erc-response' object.") "Template for a CTCP ACTION status message from another chan op.") (defvar erc--message-speaker-ctcp-action-statusmsg-input - #("* (%p%n%s) %m" - 0 3 (font-lock-face #1=(erc-input-face erc-action-face)) - 3 5 (font-lock-face (erc-my-nick-prefix-face . #1#)) - 5 7 (font-lock-face (erc-my-nick-face . #1#)) - 7 9 (font-lock-face (erc-notice-face . #1#)) - 9 13 (font-lock-face #1#)) + (let ((base '(erc-input-face erc-action-face))) ; shared + (concat (propertize "* (" 'font-lock-face base) + (propertize "%p" 'font-lock-face `(erc-my-nick-prefix-face ,@base)) + (propertize "%n" 'font-lock-face `(erc-my-nick-face ,@base)) + (propertize "%s" 'font-lock-face `(erc-notice-face ,@base)) + (propertize ") %m" 'font-lock-face base))) "Template for a CTCP ACTION status message from current client.") (defun erc--speakerize-nick (nick &optional disp) commit caddc4e727a46e6b6ec7146c9e1cdc7b954f5c16 Author: F. Jason Park Date: Thu May 2 20:16:07 2024 -0700 Add format-catalog entry for unknown chan mode in ERC * lisp/erc/erc.el (erc--process-channel-modes): Use format spec catalog entry, and convert char to string. (erc-message-english-channel-mode-unknown): New variable. ;; * test/lisp/erc/erc-scenarios-base-renick.el ;; (erc-scenarios-base-renick-queries-solo): Adjust timeout. ;; * test/lisp/erc/erc-scenarios-ignore.el (erc-scenarios-ignore/basic): ;; Adjust timeouts. ;; * test/lisp/erc/erc-scenarios-misc.el (erc-scenarios-base-flood): ;; Adjust timeouts. ;; * test/lisp/erc/resources/base/assoc/bouncer-history/barnet.eld: ;; Adjust timeouts. ;; * test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld: ;; Adjust timeouts. ;; * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-run-basic): ;; Adjust timeouts. ;; * test/lisp/erc/resources/sasl/plain.eld: Adjust timeouts. ;; * test/lisp/erc/resources/sasl/external.eld: Adjust timeout. ;; * test/lisp/erc/resources/base/auth-source/foonet.eld: Adjust ;; timeout. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e37b28669a4..ce805fdab13 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7473,7 +7473,7 @@ complement relevant letters in STRING." t)) ((not fallbackp) (erc-display-message nil '(notice error) (erc-server-buffer) - (format "Unknown channel mode: %S" c))))) + 'channel-mode-unknown ?c (string c))))) (setq erc-channel-modes (sort erc-channel-modes #'string<)) (setq erc--mode-line-mode-string (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len))) @@ -9404,6 +9404,7 @@ SOFTP, only do so when defined as a variable." (incorrect-args . "Incorrect arguments. Usage:\n%c %u\n%d") (cannot-find-file . "Cannot find file %f") (cannot-read-file . "Cannot read file %f") + (channel-mode-unknown . "Unknown channel mode: %c") (connect . "Connecting to %S:%p... ") (country . "%c") (country-unknown . "%d: No such domain") diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index 35f37a0159e..3001fde6da0 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -177,7 +177,7 @@ (ert-info ("Joined by bouncer to #foo, pal persent") (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo")) - (erc-d-t-search-for 1 "On Thursday") + (erc-d-t-search-for 5 "On Thursday") (erc-scenarios-common-say "hi"))) (erc-d-t-wait-for 10 "Query buffer appears with message from pal" diff --git a/test/lisp/erc/erc-scenarios-ignore.el b/test/lisp/erc/erc-scenarios-ignore.el index 1142bbef14d..55be613b51b 100644 --- a/test/lisp/erc/erc-scenarios-ignore.el +++ b/test/lisp/erc/erc-scenarios-ignore.el @@ -62,8 +62,8 @@ (funcall expect 10 "ignoring alice for 1m0s") (funcall expect 10 " alice: Signior Iachimo") (erc-scenarios-common-say "/ignore") - (funcall expect 10 "alice 59s") - (funcall expect 10 "mike 59m59s") + (funcall expect 20 '(: "alice 5" (any "0-9") "s")) + (funcall expect 10 '(: "mike 59m5" (any "0-9") "s")) (funcall expect -0.1 "") (funcall expect 10 " alice: The ground is bloody") (erc-scenarios-common-say "/unignore alice") diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index 2afa1ce67a4..4cb5e65b15a 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el @@ -49,7 +49,7 @@ (ert-info ("#chan@foonet exists") (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan/foonet")) - (erc-d-t-search-for 2 "") + (erc-d-t-search-for 10 "") (erc-d-t-absent-for 0.1 "") (erc-d-t-absent-for 0.1 " Date: Wed May 8 18:05:20 2024 +0200 (repeat-echo-message-string): Reuse 'r-m-c' prompt formatting Now that 'repeat-mode' supports adding labels ("hints") next to available keys, its prompt is very similar in its structure to what we have in 'read-multiple-choice' (a list of labeled keys). To make the two interfaces more consistent, reuse the prompt formatting that 'read-multiple-choice' employs. See short discussion at https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00467.html * lisp/repeat.el (repeat-echo-message-string): Use 'rmc--add-key-description' to format keys and their labels. diff --git a/lisp/repeat.el b/lisp/repeat.el index 412afc35ba7..374a925d70c 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -558,14 +558,14 @@ This function can be used to force exit of repetition while it's active." (format-message "Repeat with %s%s" (mapconcat (lambda (key-cmd) - (let* ((key (car key-cmd)) - (cmd (cdr key-cmd)) - (hint (when (symbolp cmd) - (get cmd 'repeat-hint)))) - (substitute-command-keys - (format "\\`%s'%s" - (key-description (vector key)) - (if hint (format ":%s" hint) ""))))) + (let ((key (car key-cmd)) + (cmd (cdr key-cmd))) + (if-let ((hint (and (symbolp cmd) + (get cmd 'repeat-hint)))) + ;; Reuse `read-multiple-choice' formatting. + (cdr (rmc--add-key-description (list key hint))) + (propertize (key-description (vector key)) + 'face 'read-multiple-choice-face)))) keys ", ") (if repeat-exit-key (substitute-command-keys commit de5a89254cb8645143e9f4e51a1727a7237109e8 Author: Mattias Engdegård Date: Wed May 8 12:13:48 2024 +0200 Don't mutate strings in cl-substitute This fixes cl-substitute, cl-substitute-if, cl-substitute-if-not, cl-nsubstitute, cl-nsubstitute-if and cl-nsubstitute-if-not, when called with a string sequence argument. * lisp/emacs-lisp/cl-seq.el (cl-nsubstitute): Avoid running in O(n^2) time and make future-safe. diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index e46955fd968..42f54603899 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -452,14 +452,15 @@ to avoid corrupting the original SEQ. (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys)) ;;;###autoload -(defun cl-nsubstitute (cl-new cl-old cl-seq &rest cl-keys) +(defun cl-nsubstitute (cl-new cl-old seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. \nKeywords supported: :test :test-not :key :count :start :end :from-end \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" (cl--parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () - (let ((len (length cl-seq))) + (let* ((cl-seq (if (stringp seq) (string-to-vector seq) seq)) + (len (length cl-seq))) (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0) (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2)))) (let ((cl-p (nthcdr cl-start cl-seq))) @@ -483,8 +484,8 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (progn (aset cl-seq cl-start cl-new) (setq cl-count (1- cl-count)))) - (setq cl-start (1+ cl-start))))))) - cl-seq)) + (setq cl-start (1+ cl-start)))))) + (if (stringp seq) (concat cl-seq) cl-seq)))) ;;;###autoload (defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) commit b82a003544c607b5c54bab13870d52b53e70aeb8 Author: Po Lu Date: Wed May 8 20:25:47 2024 +0800 Correct documentation relating to tool-bar-position * doc/emacs/android.texi (Android Windowing): Don't claim that tool-bar-position is unsupported on Android. * lisp/tool-bar.el (tool-bar-position): Update doc string to mention that bottom is supported on all systems but Nextstep. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 84cb6445c96..09b7762ed03 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -904,9 +904,9 @@ devices. @item The @code{alpha}, @code{alpha-background}, @code{z-group}, @code{override-redirect}, @code{mouse-color}, @code{title}, -@code{wait-for-wm}, @code{sticky}, @code{undecorated} and -@code{tool-bar-position} frame parameters (@pxref{Frame Parameters,,, -elisp, the Emacs Lisp Reference Manual}) are unsupported. +@code{wait-for-wm}, @code{sticky}, and @code{undecorated} frame +parameters (@pxref{Frame Parameters,,, elisp, the Emacs Lisp Reference +Manual}) are unsupported. @item On Android 4.0 and earlier, the @code{fullscreen} frame parameter is diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 96b61c7b229..0f645338674 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -360,11 +360,12 @@ holds a keymap." (if (featurep 'move-toolbar) (defcustom tool-bar-position 'top "Specify on which side the tool bar shall be. -Possible values are `top' (tool bar on top), `bottom' (tool bar at bottom), -`left' (tool bar on left) and `right' (tool bar on right). -This option has effect only on graphical frames and only -if Emacs was built with GTK. -Customize `tool-bar-mode' if you want to show or hide the tool bar." +Possible values are `top' (tool bar on top), `bottom' (tool bar at +bottom), `left' (tool bar on left) and `right' (tool bar on right). +This option takes effect only on graphical frames, the values `left' and +`right' only if Emacs was built with GTK, and `bottom' only on systems +besides Nextstep. Customize `tool-bar-mode' if you want to show or hide +the tool bar." :version "24.1" :type '(choice (const top) (const bottom) commit 32b8c078177d6a27da535cdb5365aad90bf0f8af Author: Po Lu Date: Wed May 8 20:22:29 2024 +0800 Correct earlier change to map-ynp * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): Don't call set-text-conversion-style if not bound. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 1a9655b1f7b..7b135c54a15 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -178,9 +178,11 @@ The function's value is the number of actions taken." ;; https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00441.html ;; for the details. (let ((overriding-text-conversion-style nil)) - (set-text-conversion-style text-conversion-style) + (when (fboundp 'set-text-conversion-style) + (set-text-conversion-style text-conversion-style)) (setq char (read-event))) - (set-text-conversion-style text-conversion-style)) + (when (fboundp 'set-text-conversion-style) + (set-text-conversion-style text-conversion-style))) ;; Show the answer to the question. (message "%s(y, n, !, ., q, %sor %s) %s" prompt user-keys commit 339b8349f436b3738cfa02b236e05c3da4c5a8a5 Author: Michael Albinus Date: Wed May 8 13:44:15 2024 +0200 More Tramp optional methods * doc/misc/tramp.texi (Inline methods) : (External methods) : These are optional methods. * etc/NEWS: Mention more optional Tramp methods. * lisp/net/tramp-androidsu.el (tramp-enable-androidsu-method): Use proper regexp for `tramp-default-user-alist'. * lisp/net/tramp-sh.el (tramp-enable-nc-method) (tramp-enable-ksu-method, tramp-enable-krlogin-method) (tramp-enable-fcp-method): New defuns. Move respective configurations there. * lisp/net/tramp.el (tramp-enable-method): Implement completion for interactive use. * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults) (tramp-test03-file-name-host-rules): Extend tests. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 74516555a2c..2b0a982e7f9 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -923,12 +923,15 @@ missing shell prompts that confuses @value{tramp}. This method is also similar to @option{ssh}. It uses the @command{krlogin -x} command only for remote host login. +This method is an optional method, @ref{Optional methods}. + @item @option{ksu} @cindex method @option{ksu} @cindex @option{ksu} method @cindex kerberos (with @option{ksu} method) -This is another method from the Kerberos suite. It behaves like @option{su}. +This is another method from the Kerberos suite. It behaves like +@option{su}. It is an optional method, @ref{Optional methods}. @item @option{plink} @cindex method @option{plink} @@ -1151,6 +1154,8 @@ The command used for this connection is: @samp{fsh @var{host} -l not useful for @value{tramp}. @command{fsh} connects to remote host and @value{tramp} keeps that one connection open. +This is an optional method, @ref{Optional methods}. + @item @option{nc} @cindex method @option{nc} @cindex @option{nc} method @@ -1162,6 +1167,8 @@ NAS hosts. These dumb devices have severely restricted local shells, such as the @command{busybox} and do not host any other encode or decode programs. +This is an optional method, @ref{Optional methods}. + @item @option{sudoedit} @cindex method @option{sudoedit} @cindex @option{sudoedit} method diff --git a/etc/NEWS b/etc/NEWS index 80fdb63ca76..a0a06c58941 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1053,7 +1053,8 @@ mode line. 'header' will display in the header line; +++ *** Tramp methods can be optional. An optional connection method is not enabled by default. The user must -enable it explicitly by the 'tramp-enable-method' command. +enable it explicitly by the 'tramp-enable-method' command. The existing +methods "fcp", "krlogin", " ksu" and "nc" are optional now. +++ *** New optional connection method "androidsu". diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 09dcd4d7bed..953f75ad9f3 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -91,7 +91,8 @@ may edit files belonging to any and all applications." (tramp-shell-name ,tramp-androidsu-local-shell-name))) (add-to-list 'tramp-default-user-alist - `(,tramp-androidsu-method nil ,tramp-root-id-string))) + `(,(rx bos (literal tramp-androidsu-method) eos) + nil ,tramp-root-id-string))) ;;;###tramp-autoload (tramp--with-startup diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 60478707c2d..408e1611632 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -272,22 +272,6 @@ The string is used in `tramp-methods'.") (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")))) - (add-to-list 'tramp-methods - `("nc" - (tramp-login-program "telnet") - (tramp-login-args (("%h") ("%p") ("%n"))) - (tramp-remote-shell ,tramp-default-remote-shell) - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-copy-program "nc") - ;; We use "-v" for better error tracking. - (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) - (tramp-copy-file-name (("%f"))) - (tramp-remote-copy-program "nc") - ;; We use "-p" as required for newer busyboxes. For older - ;; busybox/nc versions, the value must be (("-l") ("%r")). This - ;; can be achieved by tweaking `tramp-connection-properties'. - (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n"))))) (add-to-list 'tramp-methods `("su" (tramp-login-program "su") @@ -328,21 +312,6 @@ The string is used in `tramp-methods'.") (tramp-connection-timeout 10) (tramp-session-timeout 300) (tramp-password-previous-hop t))) - (add-to-list 'tramp-methods - `("ksu" - (tramp-login-program "ksu") - (tramp-login-args (("%u") ("-q"))) - (tramp-remote-shell ,tramp-default-remote-shell) - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) - (add-to-list 'tramp-methods - `("krlogin" - (tramp-login-program "krlogin") - (tramp-login-args (("%h") ("-l" "%u") ("-x"))) - (tramp-remote-shell ,tramp-default-remote-shell) - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")))) (add-to-list 'tramp-methods `("plink" (tramp-login-program "plink") @@ -403,30 +372,18 @@ The string is used in `tramp-methods'.") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k"))) (tramp-copy-keep-date t))) - (add-to-list 'tramp-methods - `("fcp" - (tramp-login-program "fsh") - (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) - (tramp-remote-shell ,tramp-default-remote-shell) - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-i") ("-c")) - (tramp-copy-program "fcp") - (tramp-copy-args (("-p" "%k"))) - (tramp-copy-keep-date t))) (add-to-list 'tramp-default-method-alist `(,tramp-local-host-regexp ,(rx bos (literal tramp-root-id-string) eos) "su")) (add-to-list 'tramp-default-user-alist - `(,(rx bos (| "su" "sudo" "doas" "ksu") eos) + `(,(rx bos (| "su" "sudo" "doas") eos) nil ,tramp-root-id-string)) ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored. ;; Do not add "plink" based methods, they ask interactively for the user. (add-to-list 'tramp-default-user-alist - `(,(rx bos - (| "rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp") - eos) + `(,(rx bos (| "rcp" "remcp" "rsh" "telnet") eos) nil ,(user-login-name)))) (defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f")) @@ -508,20 +465,94 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) (tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet) - (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet) (tramp-set-completion-function "su" tramp-completion-function-alist-su) (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) (tramp-set-completion-function "doas" tramp-completion-function-alist-su) - (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) (tramp-set-completion-function "sg" tramp-completion-function-alist-sg) - (tramp-set-completion-function - "krlogin" tramp-completion-function-alist-rsh) (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) (tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty) (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) - (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh) - (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)) + (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)) + +;;;###tramp-autoload +(defun tramp-enable-nc-method () + "Enable \"ksu\" method." + (add-to-list 'tramp-methods + `("nc" + (tramp-login-program "telnet") + (tramp-login-args (("%h") ("%p") ("%n"))) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-copy-program "nc") + ;; We use "-v" for better error tracking. + (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) + (tramp-copy-file-name (("%f"))) + (tramp-remote-copy-program "nc") + ;; We use "-p" as required for newer busyboxes. For + ;; older busybox/nc versions, the value must be + ;; (("-l") ("%r")). This can be achieved by tweaking + ;; `tramp-connection-properties'. + (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n"))))) + + (add-to-list 'tramp-default-user-alist + `(,(rx bos "nc" eos) nil ,(user-login-name))) + + (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet)) + +;;;###tramp-autoload +(defun tramp-enable-ksu-method () + "Enable \"ksu\" method." + (add-to-list 'tramp-methods + `("ksu" + (tramp-login-program "ksu") + (tramp-login-args (("%u") ("-q"))) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) + + (add-to-list 'tramp-default-user-alist + `(,(rx bos "ksu" eos) nil ,tramp-root-id-string)) + + (tramp-set-completion-function "ksu" tramp-completion-function-alist-su)) + +;;;###tramp-autoload +(defun tramp-enable-krlogin-method () + "Enable \"krlogin\" method." + (add-to-list 'tramp-methods + `("krlogin" + (tramp-login-program "krlogin") + (tramp-login-args (("%h") ("-l" "%u") ("-x"))) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")))) + + (add-to-list 'tramp-default-user-alist + `(,(rx bos "krlogin" eos) nil ,(user-login-name))) + + (tramp-set-completion-function + "krlogin" tramp-completion-function-alist-rsh)) + +;;;###tramp-autoload +(defun tramp-enable-fcp-method () + "Enable \"fcp\" method." + (add-to-list 'tramp-methods + `("fcp" + (tramp-login-program "fsh") + (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i") ("-c")) + (tramp-copy-program "fcp") + (tramp-copy-args (("-p" "%k"))) + (tramp-copy-keep-date t))) + + (add-to-list 'tramp-default-user-alist + `(,(rx bos "fcp" eos) nil ,(user-login-name))) + + (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)) (defcustom tramp-sh-extra-args `((,(rx (| bos "/") "bash" eos) . "-noediting -norc -noprofile") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f6d02847927..7d599377969 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1462,7 +1462,27 @@ calling HANDLER.") (defun tramp-enable-method (method) "Enable optional METHOD if possible." - (interactive "Mmethod: ") + (interactive + (list + (completing-read + "method: " + (seq-keep + (lambda (x) + (when-let ((name (symbol-name x)) + ;; It must match `tramp-enable-METHOD-method'. + ((string-match + (rx "tramp-enable-" + (group (regexp tramp-method-regexp)) + "-method") + name)) + (method (match-string 1 name)) + ;; It must not be enabled yet. + ((not (assoc method tramp-methods)))) + method)) + ;; All method enabling functions. + (mapcar + #'intern (all-completions "tramp-enable-" obarray #'functionp)))))) + (when-let (((not (assoc method tramp-methods))) (fn (intern (format "tramp-enable-%s-method" method))) ((functionp fn))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 68095c93a00..f7c83f3b8eb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2103,14 +2103,18 @@ is greater than 10. (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))) ;; Default values in tramp-sh.el and tramp-sudoedit.el. (when (assoc "su" tramp-methods) - (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) + (dolist + (h `("127.0.0.1" "[::1]" "localhost" "localhost4" "localhost6" + "ip6-localhost" "ip6-loopback" ,(system-name))) (should - (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su"))) - (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit")) + (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))) + (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit")) + (when (assoc m tramp-methods) (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")) (should - (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name)))) - (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc")) + (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))) + (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc")) + (when (assoc m tramp-methods) (should (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))) @@ -2128,21 +2132,22 @@ is greater than 10. ;; Host names must match rules in case the command template of a ;; method doesn't use them. (dolist (m '("su" "sg" "sudo" "doas" "ksu")) - (let (tramp-connection-properties tramp-default-proxies-alist) - (ignore-errors - (tramp-cleanup-connection tramp-test-vec nil 'keep-password)) - ;; Single hop. The host name must match `tramp-local-host-regexp'. - (should-error - (find-file (format "/%s:foo:" m)) - :type 'user-error) - ;; Multi hop. The host name must match the previous hop. - (should-error - (find-file - (format - "%s|%s:foo:" - (substring (file-remote-p ert-remote-temporary-file-directory) 0 -1) - m)) - :type 'user-error)))) + (when (assoc m tramp-methods) + (let (tramp-connection-properties tramp-default-proxies-alist) + (ignore-errors + (tramp-cleanup-connection tramp-test-vec nil 'keep-password)) + ;; Single hop. The host name must match `tramp-local-host-regexp'. + (should-error + (find-file (format "/%s:foo:" m)) + :type 'user-error) + ;; Multi hop. The host name must match the previous hop. + (should-error + (find-file + (format + "%s|%s:foo:" + (substring (file-remote-p ert-remote-temporary-file-directory) 0 -1) + m)) + :type 'user-error))))) (ert-deftest tramp-test03-file-name-method-rules () "Check file name rules for some methods." commit e020f4e9ce5d98438033fea098d943c311b0fa3d Author: Po Lu Date: Wed May 8 16:03:49 2024 +0800 Fix hang after failed yank-media on Android * java/org/gnu/emacs/EmacsClipboard.java (getClipboardTargets) (getClipboardData): * java/org/gnu/emacs/EmacsSdk11Clipboard.java (getClipboardTargets, getClipboardData): * java/org/gnu/emacs/EmacsSdk8Clipboard.java (getClipboardTargets, getClipboardData): Return string data as Strings rather than byte arrays. * src/androidselect.c (android_init_emacs_clipboard) (Fandroid_get_clipboard_targets): Adjust to match. (extract_fd_offsets): Remove duplicated semicolon. (Fandroid_get_clipboard_data): Call unblock_input before returning if extract_fd_offsets fails. diff --git a/java/org/gnu/emacs/EmacsClipboard.java b/java/org/gnu/emacs/EmacsClipboard.java index f27d96129ef..86553f478ed 100644 --- a/java/org/gnu/emacs/EmacsClipboard.java +++ b/java/org/gnu/emacs/EmacsClipboard.java @@ -32,8 +32,8 @@ public abstract class EmacsClipboard public abstract boolean clipboardExists (); public abstract byte[] getClipboard (); - public abstract byte[][] getClipboardTargets (); - public abstract AssetFileDescriptor getClipboardData (byte[] target); + public abstract String[] getClipboardTargets (); + public abstract AssetFileDescriptor getClipboardData (String target); /* Create the correct kind of clipboard for this system. */ diff --git a/java/org/gnu/emacs/EmacsSdk11Clipboard.java b/java/org/gnu/emacs/EmacsSdk11Clipboard.java index 71381b0f114..dfc714476ec 100644 --- a/java/org/gnu/emacs/EmacsSdk11Clipboard.java +++ b/java/org/gnu/emacs/EmacsSdk11Clipboard.java @@ -172,12 +172,12 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard clipboard, or NULL if there are none. */ @Override - public byte[][] + public String[] getClipboardTargets () { ClipData clip; ClipDescription description; - byte[][] typeArray; + String[] typeArray; int i; /* N.B. that Android calls the clipboard the ``primary clip''; it @@ -189,17 +189,10 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard description = clip.getDescription (); i = description.getMimeTypeCount (); - typeArray = new byte[i][i]; + typeArray = new String[i]; - try - { - for (i = 0; i < description.getMimeTypeCount (); ++i) - typeArray[i] = description.getMimeType (i).getBytes ("UTF-8"); - } - catch (UnsupportedEncodingException exception) - { - return null; - } + for (i = 0; i < description.getMimeTypeCount (); ++i) + typeArray[i] = description.getMimeType (i); return typeArray; } @@ -219,26 +212,17 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard @Override public AssetFileDescriptor - getClipboardData (byte[] target) + getClipboardData (String target) { ClipData data; String mimeType; AssetFileDescriptor assetFd; Uri uri; - /* Decode the target given by Emacs. */ - try - { - mimeType = new String (target, "UTF-8"); - } - catch (UnsupportedEncodingException exception) - { - return null; - } - /* Now obtain the clipboard data and the data corresponding to that MIME type. */ + mimeType = target; data = manager.getPrimaryClip (); if (data == null || data.getItemCount () < 1) diff --git a/java/org/gnu/emacs/EmacsSdk8Clipboard.java b/java/org/gnu/emacs/EmacsSdk8Clipboard.java index 3d0504b1924..344ec6f7997 100644 --- a/java/org/gnu/emacs/EmacsSdk8Clipboard.java +++ b/java/org/gnu/emacs/EmacsSdk8Clipboard.java @@ -122,7 +122,7 @@ public final class EmacsSdk8Clipboard extends EmacsClipboard clipboard, or NULL if there are none. */ @Override - public byte[][] + public String[] getClipboardTargets () { return null; @@ -143,7 +143,7 @@ public final class EmacsSdk8Clipboard extends EmacsClipboard @Override public AssetFileDescriptor - getClipboardData (byte[] target) + getClipboardData (String target) { return null; } diff --git a/src/androidselect.c b/src/androidselect.c index d9c35746f11..7c93607848a 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -99,9 +99,10 @@ android_init_emacs_clipboard (void) FIND_METHOD (clipboard_exists, "clipboardExists", "()Z"); FIND_METHOD (get_clipboard, "getClipboard", "()[B"); FIND_METHOD (get_clipboard_targets, "getClipboardTargets", - "()[[B"); + "()[Ljava/lang/String;"); FIND_METHOD (get_clipboard_data, "getClipboardData", - "([B)Landroid/content/res/AssetFileDescriptor;"); + "(Ljava/lang/String;)Landroid/content/res/" + "AssetFileDescriptor;"); clipboard_class.make_clipboard = (*android_java_env)->GetStaticMethodID (android_java_env, @@ -283,11 +284,11 @@ Value is a list of MIME types as strings, each defining a single extra data type available from the clipboard. */) (void) { - jarray bytes_array; - jbyteArray bytes; + jarray all_targets; + jstring string; jmethodID method; - size_t length, length1, i; - jbyte *data; + size_t length, i; + const char *data; Lisp_Object targets, tem; if (!android_init_gui) @@ -296,44 +297,42 @@ data type available from the clipboard. */) targets = Qnil; block_input (); method = clipboard_class.get_clipboard_targets; - bytes_array = (*android_java_env)->CallObjectMethod (android_java_env, + all_targets = (*android_java_env)->CallObjectMethod (android_java_env, clipboard, method); android_exception_check (); - if (!bytes_array) + if (!all_targets) goto fail; length = (*android_java_env)->GetArrayLength (android_java_env, - bytes_array); + all_targets); for (i = 0; i < length; ++i) { /* Retrieve the MIME type. */ - bytes + string = (*android_java_env)->GetObjectArrayElement (android_java_env, - bytes_array, i); - android_exception_check_nonnull (bytes, bytes_array); + all_targets, i); + android_exception_check_nonnull (string, all_targets); /* Cons it onto the list of targets. */ - length1 = (*android_java_env)->GetArrayLength (android_java_env, - bytes); - data = (*android_java_env)->GetByteArrayElements (android_java_env, - bytes, NULL); - android_exception_check_nonnull_1 (data, bytes, bytes_array); + data = (*android_java_env)->GetStringUTFChars (android_java_env, + string, NULL); + android_exception_check_nonnull_1 ((void *) data, string, + all_targets); /* Decode the string. */ - tem = make_unibyte_string ((char *) data, length1); - tem = code_convert_string_norecord (tem, Qutf_8, false); + tem = build_unibyte_string ((char *) data); + tem = code_convert_string_norecord (tem, Qandroid_jni, false); targets = Fcons (tem, targets); /* Delete the retrieved data. */ - (*android_java_env)->ReleaseByteArrayElements (android_java_env, - bytes, data, - JNI_ABORT); - ANDROID_DELETE_LOCAL_REF (bytes); + (*android_java_env)->ReleaseStringUTFChars (android_java_env, + string, data); + ANDROID_DELETE_LOCAL_REF (string); } unblock_input (); - ANDROID_DELETE_LOCAL_REF (bytes_array); + ANDROID_DELETE_LOCAL_REF (all_targets); return Fnreverse (targets); fail: @@ -432,7 +431,7 @@ extract_fd_offsets (jobject afd, int *fd, jlong *offset, jlong *length) #if __ANDROID_API__ <= 11 static int (*jniGetFDFromFileDescriptor) (JNIEnv *, jobject); #endif /* __ANDROID_API__ <= 11 */ - static int (*AFileDescriptor_getFd) (JNIEnv *, jobject);; + static int (*AFileDescriptor_getFd) (JNIEnv *, jobject); jmethodID method; method = asset_fd_class.get_start_offset; @@ -538,7 +537,7 @@ does not have any corresponding data. In that case, use (Lisp_Object type) { jobject afd; - jbyteArray bytes; + jstring mime_type; jmethodID method; int fd; ptrdiff_t rc; @@ -549,25 +548,17 @@ does not have any corresponding data. In that case, use if (!android_init_gui) error ("No Android display connection!"); - /* Encode the string as UTF-8. */ CHECK_STRING (type); - type = ENCODE_UTF_8 (type); - /* Then give it to the selection code. */ + /* Convert TYPE into a Java string. */ block_input (); - bytes = (*android_java_env)->NewByteArray (android_java_env, - SBYTES (type)); - (*android_java_env)->SetByteArrayRegion (android_java_env, bytes, - 0, SBYTES (type), - (jbyte *) SDATA (type)); - android_exception_check (); - + mime_type = android_build_string (type, NULL); method = clipboard_class.get_clipboard_data; afd = (*android_java_env)->CallObjectMethod (android_java_env, clipboard, method, - bytes); - android_exception_check_1 (bytes); - ANDROID_DELETE_LOCAL_REF (bytes); + mime_type); + android_exception_check_1 (mime_type); + ANDROID_DELETE_LOCAL_REF (mime_type); if (!afd) goto fail; @@ -578,7 +569,10 @@ does not have any corresponding data. In that case, use record_unwind_protect_ptr (close_asset_fd, &afd); if (extract_fd_offsets (afd, &fd, &offset, &length)) - return unbind_to (ref, Qnil); + { + unblock_input (); + return unbind_to (ref, Qnil); + } unblock_input (); /* Now begin reading from fd. */