From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Mark Oteiza Newsgroups: gmane.emacs.bugs Subject: bug#28362: 26.0.50; [PATCH] gensym in core elisp Date: Tue, 05 Sep 2017 13:11:23 -0400 Message-ID: <8737812hqc.fsf@holos> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1504631557 16523 195.159.176.226 (5 Sep 2017 17:12:37 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 5 Sep 2017 17:12:37 +0000 (UTC) To: 28362@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Sep 05 19:12:21 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dpHOe-0003PM-FE for geb-bug-gnu-emacs@m.gmane.org; Tue, 05 Sep 2017 19:12:20 +0200 Original-Received: from localhost ([::1]:60285 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dpHOj-0004Ej-Ht for geb-bug-gnu-emacs@m.gmane.org; Tue, 05 Sep 2017 13:12:25 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42776) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dpHOT-00049J-C2 for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:12:16 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dpHOM-0002bL-5O for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:12:09 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:43025) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dpHOL-0002aw-Vo for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:12:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dpHOL-0000y4-Om for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:12:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mark Oteiza Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 05 Sep 2017 17:12:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 28362 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.15046315183707 (code B ref -1); Tue, 05 Sep 2017 17:12:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 5 Sep 2017 17:11:58 +0000 Original-Received: from localhost ([127.0.0.1]:51706 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dpHOH-0000xi-0d for submit@debbugs.gnu.org; Tue, 05 Sep 2017 13:11:57 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:51571) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dpHOE-0000xW-NP for submit@debbugs.gnu.org; Tue, 05 Sep 2017 13:11:55 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dpHO2-0002FK-Kj for submit@debbugs.gnu.org; Tue, 05 Sep 2017 13:11:49 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:37557) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1dpHO2-0002F7-Em for submit@debbugs.gnu.org; Tue, 05 Sep 2017 13:11:42 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42377) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dpHNv-0003ou-EG for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:11:42 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dpHNo-00023A-Nx for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:11:35 -0400 Original-Received: from mail-qk0-x22e.google.com ([2607:f8b0:400d:c09::22e]:34532) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dpHNo-00020v-Cs for bug-gnu-emacs@gnu.org; Tue, 05 Sep 2017 13:11:28 -0400 Original-Received: by mail-qk0-x22e.google.com with SMTP id b23so13438171qkg.1 for ; Tue, 05 Sep 2017 10:11:25 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=udel-edu.20150623.gappssmtp.com; s=20150623; h=from:to:subject:date:message-id:mime-version; bh=e+nzK/cBh8rrlZUnCAwRi7HHAxeA2S5+HCijoLLfAFw=; b=fcsJzD2lmoX8qaC5CJRewgctNoFJFREiNCuFBP1gjPAZJsmsLQl0z/V1j8GaGcP3yT y/V86AraAIEXjacP6DlSDw8dFm1Mzr2GgYZRIcqftUFRgpix13US5vhxdqTNdV4vlz7q 2yI2wgNZw7sT6vD97Zdw+3jKQDJbGjpVWM/rAd88EpRlcSAHocBNP7hUrGBKBx92Vb5s oskRlKe26fKNIQddIFhwrXS6z9sNxyIvb7yiZyeyaS+ZIDIGKejtSo6Q6GxjS9VkDeFy 9wXH9+T4DxkYuuC/wIkBqg78/vYKsOoWsdvZxwoTD+C+aAjIK3q/Elz9ceEVfATjufOC UG9Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:mime-version; bh=e+nzK/cBh8rrlZUnCAwRi7HHAxeA2S5+HCijoLLfAFw=; b=ZuABEYr39LLJAdyhXJXHUTNa6+Tz8XYk0PN3OFzf+beSUaXpMOdW1XigsV9OJULFvV vD1baPNbrDSRUEeSQoIJgGFKNY0Um/nAzrXsMwhFvD/KjFmqNCHrwDCQFfV/yovML1d/ 9CImePL5nxr0vcxeKFGYWoQtEHY5hWpAcki4MEBnoHI/6squKr935Qe91mc1A19j0XIy CzIc5BPt6jPkwDkIQY5jaUWV7ycaKvAiKC/vsY07JZHb/I2gVmGTzHiEglj+FLI2H9CH 3qDFr2weHbtACohs8sJbmCVzmmHnPr16tLQtMuJ5assfvHn6Wkinwpg5EJtqDSXi/Mu2 MgIA== X-Gm-Message-State: AHPjjUgTtMxuza6lFShoh0NrIJ1HlHH/gYuk2I/FRwz+QFZLbM6jG/II wzxeXC6TkKmjVu/fjZ+2tA== X-Google-Smtp-Source: ADKCNb6Y2ijDnrwCcAbTZDWVlMTIN5l1b7X0S5bT1oPmLd/8AOGnFG6rNzgZd2T+yS3YtdRJsOPQww== X-Received: by 10.55.200.210 with SMTP id t79mr1639088qkl.299.1504631485186; Tue, 05 Sep 2017 10:11:25 -0700 (PDT) Original-Received: from holos.localdomain (pool-173-67-36-61.bltmmd.fios.verizon.net. [173.67.36.61]) by smtp.gmail.com with ESMTPSA id s6sm700378qtb.55.2017.09.05.10.11.24 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 05 Sep 2017 10:11:24 -0700 (PDT) Original-Received: by holos.localdomain (Postfix, from userid 1000) id 8E3FA68E72; Tue, 5 Sep 2017 13:11:23 -0400 (EDT) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:136612 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Wishlist. It would be nice to have gensym live in subr.el or C for the utility of having uniquely named uninterned symbols. It is helpful, for instance, in the readability of macroexpansions of pcase and other macros that generate many uninterned symbols of the same name. As far as C vs Elisp--cl-gensym is about 10x slower than make-symbol, but as far as macroexpansion goes, I get the impression gensym is not a big contributing factor. Consider the following: (defmacro case-lambda (&rest spec) "Return an arbitrary arity function." (declare (indent 0) (debug (&rest (pcase-QPAT body)))) (let ((args (make-symbol "args"))) `(lambda (&rest ,args) (pcase-exhaustive ,args ,@spec)))) (benchmark-run-compiled 1000 (macroexpand-all '(case-lambda (`() t) (`(,x) (cons x 1)) (`(,x ,y) (list x y 2)) (`(,x ,y . ,z) (pcase-lambda (`(,cat ,dog)) (vector cat dog x y z 8))))) The difference between the benchmark with make-symbol and make-symbol fset to gensym is less than 1% (looking at profiler samples, interval set to 1us). I wrote a na=C3=AFve gensym in C that is only about 1.5x to 2x faster than cl-gensym (and incompatible because of the inaccessible counter). Patch attached. I also attached a patch putting gensym into subr.el. I've tested both patches. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=gensym_alloc_c.patch Content-Description: gensym implemented in alloc.c 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); --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=gensym.patch Content-Description: gensym moved to subr.el diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index b1ada00f4a..d8f3dbf93d 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..4073e26956 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/gv.el b/lisp/emacs-lisp/gv.el index a8b8974cb4..42b1c21695 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -431,7 +431,7 @@ setf ;; code is large, but otherwise results in more efficient code. `(if ,test ,(gv-get then do) ,@(macroexp-unprogn (gv-get (macroexp-progn else) do))) - (let ((v (make-symbol "v"))) + (let ((v (gensym "v"))) (macroexp-let2 nil gv `(if ,test ,(gv-letplace (getter setter) then `(cons (lambda () ,getter) @@ -456,7 +456,7 @@ setf (gv-get (macroexp-progn (cdr branch)) do))) (gv-get (car branch) do))) branches)) - (let ((v (make-symbol "v"))) + (let ((v (gensym "v"))) (macroexp-let2 nil gv `(cond ,@(mapcar diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index ce46f66aef..cf8e2f22d8 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -218,7 +218,7 @@ inline--do-letlisteval `(let* ((,bsym ()) (,listvar (mapcar (lambda (e) (if (macroexp-copyable-p e) e - (let ((v (make-symbol "v"))) + (let ((v (gensym "v"))) (push (list v e) ,bsym) v))) ,listvar))) 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/subr.el b/lisp/subr.el index b3f9f90234..83c1fbfe8c 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." --=-=-=--