diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index b1ada00f4a..2db256d631 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -161,25 +161,19 @@ cl--expr-depends-p ;;; Symbols. -(defvar cl--gensym-counter 0) +(defvaralias 'cl--gensym-counter 'gensym-counter) ;;;###autoload -(defun cl-gensym (&optional prefix) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) - (num (if (integerp prefix) prefix - (prog1 cl--gensym-counter - (setq cl--gensym-counter (1+ cl--gensym-counter)))))) - (make-symbol (format "%s%d" pfix num)))) +(cl--defalias 'cl-gensym 'gensym) +(defvar cl--gentemp-counter 0) ;;;###autoload (defun cl-gentemp (&optional prefix) "Generate a new interned symbol with a unique name. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) +The name is made by appending a number to PREFIX, default \"T\"." + (let ((pfix (if (stringp prefix) prefix "T")) name) - (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter))) - (setq cl--gensym-counter (1+ cl--gensym-counter))) + (while (intern-soft (setq name (format "%s%d" pfix cl--gentemp-counter))) + (setq cl--gentemp-counter (1+ cl--gentemp-counter))) (intern name))) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 73eb9a4e86..306237ca38 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -250,7 +250,6 @@ cl-unload-function eval-when destructuring-bind gentemp - gensym pairlis acons subst diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index c6ef8d7a99..3190346497 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1193,7 +1193,7 @@ edebug-make-enter-wrapper ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. ;; Do this after parsing since that may find a name. (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) + (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) `(edebug-enter (quote ,edebug-def-name) ,(if edebug-inside-func diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 4cf9d9609e..1413b9cd0b 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -295,7 +295,7 @@ ert-with-message-capture code under test from the behavior of the *Messages* buffer." (declare (debug (symbolp body)) (indent 1)) - (let ((g-advice (cl-gensym))) + (let ((g-advice (gensym))) `(let* ((,var "") (,g-advice (lambda (func &rest args) (if (or (null args) (equal (car args) "")) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index c232b08bd1..07acc20ae8 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -293,8 +293,8 @@ ert--expand-should-1 (error `(signal ',(car err) ',(cdr err)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) - (let ((value (cl-gensym "value-"))) - `(let ((,value (cl-gensym "ert-form-evaluation-aborted-"))) + (let ((value (gensym "value-"))) + `(let ((,value (gensym "ert-form-evaluation-aborted-"))) ,(funcall inner-expander `(setq ,value ,form) `(list ',whole :form ',form :value ,value) @@ -307,10 +307,10 @@ ert--expand-should-1 (and (consp fn-name) (eql (car fn-name) 'lambda) (listp (cdr fn-name))))) - (let ((fn (cl-gensym "fn-")) - (args (cl-gensym "args-")) - (value (cl-gensym "value-")) - (default-value (cl-gensym "ert-form-evaluation-aborted-"))) + (let ((fn (gensym "fn-")) + (args (gensym "args-")) + (value (gensym "value-")) + (default-value (gensym "ert-form-evaluation-aborted-"))) `(let* ((,fn (function ,fn-name)) (,args (condition-case err (let ((signal-hook-function #'ert--should-signal-hook)) @@ -352,7 +352,7 @@ ert--expand-should (ert--expand-should-1 whole form (lambda (inner-form form-description-form value-var) - (let ((form-description (cl-gensym "form-description-"))) + (let ((form-description (gensym "form-description-"))) `(let (,form-description) ,(funcall inner-expander `(unwind-protect @@ -430,8 +430,8 @@ ert--should-error-handle-error `(should-error ,form ,@keys) form (lambda (inner-form form-description-form value-var) - (let ((errorp (cl-gensym "errorp")) - (form-description-fn (cl-gensym "form-description-fn-"))) + (let ((errorp (gensym "errorp")) + (form-description-fn (gensym "form-description-fn-"))) `(let ((,errorp nil) (,form-description-fn (lambda () ,form-description-form))) (condition-case -condition- diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index c96b400809..fe5d2d0728 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -86,10 +86,7 @@ cps--cleanup-table-symbol (defvar cps--cleanup-function nil) (defmacro cps--gensym (fmt &rest args) - ;; Change this function to use `cl-gensym' if you want the generated - ;; code to be easier to read and debug. - ;; (cl-gensym (apply #'format fmt args)) - `(progn (ignore ,@args) (make-symbol ,fmt))) + `(gensym (format ,fmt ,@args))) (defvar cps--dynamic-wrappers '(identity) "List of transformer functions to apply to atomic forms we diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 253b60e753..5935845743 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -213,7 +213,7 @@ pcase--make-docstring (defmacro pcase-exhaustive (exp &rest cases) "The exhaustive version of `pcase' (which see)." (declare (indent 1) (debug pcase)) - (let* ((x (make-symbol "x")) + (let* ((x (gensym "x")) (pcase--dontwarn-upats (cons x pcase--dontwarn-upats))) (pcase--expand ;; FIXME: Could we add the FILE:LINE data in the error message? @@ -304,7 +304,7 @@ pcase-dolist (declare (indent 1) (debug ((pcase-PAT form) body))) (if (pcase--trivial-upat-p (car spec)) `(dolist ,spec ,@body) - (let ((tmpvar (make-symbol "x"))) + (let ((tmpvar (gensym "x"))) `(dolist (,tmpvar ,@(cdr spec)) (pcase-let* ((,(car spec) ,tmpvar)) ,@body))))) @@ -715,7 +715,7 @@ pcase--funcall (call (progn (when (memq arg vs) ;; `arg' is shadowed by `env'. - (let ((newsym (make-symbol "x"))) + (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) (if (functionp fun) @@ -842,7 +842,7 @@ pcase--u1 ;; A upat of the form (app FUN PAT) (pcase--mark-used sym) (let* ((fun (nth 1 upat)) - (nsym (make-symbol "x")) + (nsym (gensym "x")) (body ;; We don't change `matches' to reuse the newly computed value, ;; because we assume there shouldn't be such redundancy in there. diff --git a/lisp/json.el b/lisp/json.el index 64486258cc..fd2f63324c 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -683,6 +683,23 @@ json-readtable table) "Readtable for JSON reader.") +(defmacro json-readtable-dispatch (char) + "Dispatch reader function for CHAR." + (declare (debug (symbolp))) + (let ((table + '((?t json-read-keyword "true") + (?f json-read-keyword "false") + (?n json-read-keyword "null") + (?{ json-read-object) + (?\[ json-read-array) + (?\" json-read-string))) + res) + (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (push (list c 'json-read-number) table)) + (pcase-dolist (`(,c . ,rest) table) + (push `(,c (,@rest)) res)) + `(pcase ,char ,@res (_ (signal 'json-readtable-error ,char))))) + (defun json-read () "Parse and return the JSON object following point. Advances point just past JSON object." @@ -690,10 +707,7 @@ json-read (let ((char (json-peek))) (if (zerop char) (signal 'json-end-of-file nil) - (let ((record (cdr (assq char json-readtable)))) - (if (functionp (car record)) - (apply (car record) (cdr record)) - (signal 'json-readtable-error record)))))) + (json-readtable-dispatch char)))) ;; Syntactic sugar for the reader diff --git a/lisp/subr.el b/lisp/subr.el index 2ad52f6a63..ebb8b53b50 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -280,6 +280,20 @@ ignore-errors ;;;; Basic Lisp functions. +(defvar gensym-counter 0 + "Number used to construct the name of the next symbol created by `gensym'.") + +(defun gensym (&optional prefix) + "Return a new uninterned symbol. +The name is made by appending `gensym-counter' to PREFIX. +PREFIX can be a string, and defaults to \"G\". +If PREFIX is a number, it replaces the value of `gensym-counter'." + (let ((pfix (if (stringp prefix) prefix "G")) + (num (if (integerp prefix) prefix + (prog1 gensym-counter + (setq gensym-counter (1+ gensym-counter)))))) + (make-symbol (format "%s%d" pfix num)))) + (defun ignore (&rest _ignore) "Do nothing and return nil. This function accepts any number of arguments, but ignores them." diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index d03ee5eb31..59a72006a8 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -1,4 +1,4 @@ -;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files +;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files -*- lexical-binding: t -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. diff --git a/lisp/xdg.el b/lisp/xdg.el index 4973065f91..19accd71e9 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -29,6 +29,7 @@ ;; - XDG Base Directory Specification ;; - Thumbnail Managing Standard ;; - xdg-user-dirs configuration +;; - Desktop Entry Specification ;;; Code: @@ -146,6 +147,64 @@ xdg-user-dir (let ((dir (cdr (assoc name xdg-user-dirs)))) (when dir (expand-file-name dir)))) + +;; Desktop Entry Specification +;; https://specifications.freedesktop.org/desktop-entry-spec/latest/ + +(defconst xdg-desktop-group-regexp + (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]") + "Regexp matching desktop file group header names.") + +(defconst xdg-desktop-entry-regexp + (rx (group-n 1 (+ (in "A-Za-z0-9-"))) + (* blank) "=" (* blank) + (group-n 2 (* nonl))) + "Regexp matching desktop file entry key-value pairs.") + +(defconst xdg-desktop-things + '("OnlyShowIn" "NotShowIn" "Actions" "MimeType" "Categories" "Implements") + "Names of recognized keys of type \"string(s)\".") + +(defun xdg--desktop-value-partition (str) + "Partition STRING into elements delimited by unescaped semicolons." + (let (res) + (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" str) ";")) + (push (replace-regexp-in-string "\0" "\\\\;" x) res)) + (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res)) + (nreverse res))) + +(defun xdg--desktop-parse-line () + (skip-chars-forward "[:blank:]") + (when (/= (following-char) ?#) + (cond + ((looking-at xdg-desktop-group-regexp) + (match-string 1)) + ((looking-at xdg-desktop-entry-regexp) + (cons (match-string 1) (match-string 2)))))) + +(defun xdg-desktop-read-file (filename) + "Return contents of desktop file FILENAME as an alist." + (let (elt group entries res) + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (while (not (eobp)) + (when (setq elt (xdg--desktop-parse-line)) + (cond + ((stringp elt) + (if (null group) (setq group elt) + (push (cons group (nreverse entries)) res) + (setq group nil entries nil))) + ((consp elt) + (pcase-let ((`(,k . ,v) elt)) + (if (member k xdg-desktop-things) + (push (cons k (xdg--desktop-value-partition v)) entries) + (push elt entries)))))) + (forward-line)) + (when (and group entries) + (push (cons group entries) res))) + (nreverse res))) + (provide 'xdg) ;;; xdg.el ends here diff --git a/src/alloc.c b/src/alloc.c index 2cee646256..89372c11b5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3632,6 +3632,32 @@ Its value is void, and its function definition and property list are nil. */) return val; } +static Lisp_Object default_gensym_prefix; + +DEFUN ("gensym", Fgensym, Sgensym, 0, 1, 0, + doc: /* Return a new uninterned symbol. +The name is made by concatenating PREFIX with a counter value. +PREFIX is a string and defaults to "g". +There is no provision for resetting the counter. */) + (Lisp_Object prefix) +{ + static int gensym_counter = 0; + + Lisp_Object suffix, name; + int len; + char buf[INT_STRLEN_BOUND (EMACS_INT)]; + + if (NILP (prefix)) + prefix = default_gensym_prefix; + CHECK_STRING (prefix); + + EMACS_INT count = gensym_counter++; + len = sprintf (buf, "%"pI"d", count); + suffix = make_string (buf, len); + name = concat2 (prefix, suffix); + return Fmake_symbol (name); +} + /*********************************************************************** @@ -7515,6 +7541,8 @@ The time is in seconds as a floating point value. */); DEFVAR_INT ("gcs-done", gcs_done, doc: /* Accumulated number of garbage collections done. */); + default_gensym_prefix = build_pure_c_string ("g"); + defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); @@ -7527,6 +7555,7 @@ The time is in seconds as a floating point value. */); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol); + defsubr (&Sgensym); defsubr (&Smake_marker); defsubr (&Smake_finalizer); defsubr (&Spurecopy);