dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

editorconfig-fnmatch.el (10963B)


      1 ;;; editorconfig-fnmatch.el --- Glob pattern matching in Emacs lisp  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2011-2023 EditorConfig Team
      4 
      5 ;; Author: EditorConfig Team <editorconfig@googlegroups.com>
      6 
      7 ;; See
      8 ;; https://github.com/editorconfig/editorconfig-emacs/graphs/contributors
      9 ;; or the CONTRIBUTORS file for the list of contributors.
     10 
     11 ;; This file is part of EditorConfig Emacs Plugin.
     12 
     13 ;; EditorConfig Emacs Plugin is free software: you can redistribute it and/or
     14 ;; modify it under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation, either version 3 of the License, or (at your
     16 ;; option) any later version.
     17 
     18 ;; EditorConfig Emacs Plugin is distributed in the hope that it will be useful,
     19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
     21 ;; Public License for more details.
     22 
     23 ;; You should have received a copy of the GNU General Public License along with
     24 ;; EditorConfig Emacs Plugin. If not, see <https://www.gnu.org/licenses/>.
     25 
     26 ;;; Commentary:
     27 
     28 ;; editorconfig-fnmatch.el provides a fnmatch implementation with a few
     29 ;; extensions.
     30 ;; The main usage of this library is glob pattern matching for EditorConfig, but
     31 ;; it can also act solely.
     32 
     33 ;; editorconfig-fnmatch-p (name pattern)
     34 
     35 ;; Test whether NAME match PATTERN.
     36 
     37 ;; PATTERN should be a shell glob pattern, and some zsh-like wildcard matchings
     38 ;; can be used:
     39 
     40 ;; *           Matches any string of characters, except path separators (/)
     41 ;; **          Matches any string of characters
     42 ;; ?           Matches any single character
     43 ;; [name]      Matches any single character in name
     44 ;; [^name]     Matches any single character not in name
     45 ;; {s1,s2,s3}  Matches any of the strings given (separated by commas)
     46 ;; {min..max}  Matches any number between min and max
     47 
     48 
     49 ;; This library is a port from editorconfig-core-py library.
     50 ;; https://github.com/editorconfig/editorconfig-core-py/blob/master/editorconfig/fnmatch.py
     51 
     52 ;;; Code:
     53 
     54 (require 'cl-lib)
     55 
     56 (defvar editorconfig-fnmatch--cache-hashtable
     57   nil
     58   "Cache of shell pattern and its translation.")
     59 ;; Clear cache on file reload
     60 (setq editorconfig-fnmatch--cache-hashtable
     61       (make-hash-table :test 'equal))
     62 
     63 
     64 (defconst editorconfig-fnmatch--left-brace-regexp
     65   "\\(^\\|[^\\]\\){"
     66   "Regular expression for left brace ({).")
     67 
     68 (defconst editorconfig-fnmatch--right-brace-regexp
     69   "\\(^\\|[^\\]\\)}"
     70   "Regular expression for right brace (}).")
     71 
     72 
     73 (defconst editorconfig-fnmatch--numeric-range-regexp
     74   "\\([+-]?[0-9]+\\)\\.\\.\\([+-]?[0-9]+\\)"
     75   "Regular expression for numeric range (like {-3..+3}).")
     76 
     77 (defun editorconfig-fnmatch--match-num (regexp string)
     78   "Return how many times REGEXP is found in STRING."
     79   (let ((num 0))
     80     ;; START arg does not work as expected in this case
     81     (while (string-match regexp string)
     82       (setq num (1+ num)
     83             string (substring string (match-end 0))))
     84     num))
     85 
     86 ;;;###autoload
     87 (defun editorconfig-fnmatch-p (string pattern)
     88   "Test whether STRING match PATTERN.
     89 
     90 Matching ignores case if `case-fold-search' is non-nil.
     91 
     92 PATTERN should be a shell glob pattern, and some zsh-like wildcard matchings can
     93 be used:
     94 
     95 *           Matches any string of characters, except path separators (/)
     96 **          Matches any string of characters
     97 ?           Matches any single character
     98 [name]      Matches any single character in name
     99 [^name]     Matches any single character not in name
    100 {s1,s2,s3}  Matches any of the strings given (separated by commas)
    101 {min..max}  Matches any number between min and max"
    102   (string-match (editorconfig-fnmatch-translate pattern)
    103                 string))
    104 
    105 ;;(editorconfig-fnmatch-translate "{a,{-3..3}}.js")
    106 ;;(editorconfig-fnmatch-p "1.js" "{a,{-3..3}}.js")
    107 
    108 (defun editorconfig-fnmatch-translate (pattern)
    109   "Translate a shell PATTERN to a regular expression.
    110 
    111 Translation result will be cached, so same translation will not be done twice."
    112   (let ((cached (gethash pattern
    113                          editorconfig-fnmatch--cache-hashtable)))
    114     (or cached
    115         (puthash pattern
    116                  (editorconfig-fnmatch--do-translate pattern)
    117                  editorconfig-fnmatch--cache-hashtable))))
    118 
    119 
    120 (defun editorconfig-fnmatch--do-translate (pattern &optional nested)
    121   "Translate a shell PATTERN to a regular expression.
    122 
    123 Set NESTED to t when this function is called from itself.
    124 
    125 This function is called from `editorconfig-fnmatch-translate', when no cached
    126 translation is found for PATTERN."
    127   (let ((index 0)
    128         (length (length pattern))
    129         (brace-level 0)
    130         (in-brackets nil)
    131         ;; List of strings of resulting regexp
    132         (result ())
    133         (is-escaped nil)
    134         (matching-braces (= (editorconfig-fnmatch--match-num
    135                              editorconfig-fnmatch--left-brace-regexp
    136                              pattern)
    137                             (editorconfig-fnmatch--match-num
    138                              editorconfig-fnmatch--right-brace-regexp
    139                              pattern)))
    140 
    141         current-char
    142         pos
    143         has-slash
    144         has-comma
    145         num-range)
    146 
    147     (while (< index length)
    148       (if (and (not is-escaped)
    149                (string-match "[^]\\*?[{},/\\-]+"
    150                              ;;(string-match "[^]\\*?[{},/\\-]+" "?.a")
    151                              pattern
    152                              index)
    153                (eq index (match-beginning 0)))
    154           (setq result `(,@result ,(regexp-quote (match-string 0 pattern)))
    155                 index (match-end 0)
    156                 is-escaped nil)
    157 
    158         (setq current-char (aref pattern index)
    159               index (1+ index))
    160 
    161         (cl-case current-char
    162           (?*
    163            (setq pos index)
    164            (if (and (< pos length)
    165                     (= (aref pattern pos) ?*))
    166                (setq result `(,@result ".*"))
    167              (setq result `(,@result "[^/]*"))))
    168 
    169           (??
    170            (setq result `(,@result "[^/]")))
    171 
    172           (?\[
    173            (if in-brackets
    174                (setq result `(,@result "\\["))
    175              (if (= (aref pattern index) ?/)
    176                  ;; Slash after an half-open bracket
    177                  (setq result `(,@result "\\[/")
    178                        index (+ index 1))
    179                (setq pos index
    180                      has-slash nil)
    181                (while (and (< pos length)
    182                            (not (= (aref pattern pos) ?\]))
    183                            (not has-slash))
    184                  (if (and (= (aref pattern pos) ?/)
    185                           (not (= (aref pattern (- pos 1)) ?\\)))
    186                      (setq has-slash t)
    187                    (setq pos (1+ pos))))
    188                (if has-slash
    189                    (setq result `(,@result ,(concat "\\["
    190                                                     (substring pattern
    191                                                                index
    192                                                                (1+ pos))
    193                                                     "\\]"))
    194                          index (+ pos 2))
    195                  (if (and (< index length)
    196                           (memq (aref pattern index)
    197                                 '(?! ?^)))
    198                      (setq index (1+ index)
    199                            result `(,@result "[^"))
    200                    (setq result `(,@result "[")))
    201                  (setq in-brackets t)))))
    202 
    203           (?-
    204            (if in-brackets
    205                (setq result `(,@result "-"))
    206              (setq result `(,@result "\\-"))))
    207 
    208           (?\]
    209            (setq result `(,@result "]")
    210                  in-brackets nil))
    211 
    212           (?{
    213            (setq pos index
    214                  has-comma nil)
    215            (while (and (or (and (< pos length)
    216                                 (not (= (aref pattern pos) ?})))
    217                            is-escaped)
    218                        (not has-comma))
    219              (if (and (eq (aref pattern pos) ?,)
    220                       (not is-escaped))
    221                  (setq has-comma t)
    222                (setq is-escaped (and (eq (aref pattern pos)
    223                                          ?\\)
    224                                      (not is-escaped))
    225                      pos (1+ pos))))
    226            (if (and (not has-comma)
    227                     (< pos length))
    228                (let ((pattern-sub (substring pattern index pos)))
    229                  (setq num-range (string-match editorconfig-fnmatch--numeric-range-regexp
    230                                                pattern-sub))
    231                  (if num-range
    232                      (let ((number-start (string-to-number (match-string 1
    233                                                                          pattern-sub)))
    234                            (number-end (string-to-number (match-string 2
    235                                                                        pattern-sub))))
    236                        (setq result `(,@result ,(concat "\\(?:"
    237                                                         (mapconcat 'number-to-string
    238                                                                    (cl-loop for i from number-start to number-end
    239                                                                             collect i)
    240                                                                    "\\|")
    241                                                         "\\)"))))
    242                    (let ((inner (editorconfig-fnmatch--do-translate pattern-sub t)))
    243                      (setq result `(,@result ,(format "{%s}" inner)))))
    244                  (setq index (1+ pos)))
    245              (if matching-braces
    246                  (setq result `(,@result "\\(?:")
    247                        brace-level (1+ brace-level))
    248                (setq result `(,@result "{")))))
    249 
    250           (?,
    251            (if (and (> brace-level 0)
    252                     (not is-escaped))
    253                (setq result `(,@result "\\|"))
    254              (setq result `(,@result "\\,"))))
    255 
    256           (?}
    257            (if (and (> brace-level 0)
    258                     (not is-escaped))
    259                (setq result `(,@result "\\)")
    260                      brace-level (- brace-level 1))
    261              (setq result `(,@result "}"))))
    262 
    263           (?/
    264            (if (and (<= (+ index 3) (length pattern))
    265                     (string= (substring pattern index (+ index 3)) "**/"))
    266                (setq result `(,@result "\\(?:/\\|/.*/\\)")
    267                      index (+ index 3))
    268              (setq result `(,@result "/"))))
    269 
    270           (t
    271            (unless (= current-char ?\\)
    272              (setq result `(,@result ,(regexp-quote (char-to-string current-char)))))))
    273 
    274         (if (= current-char ?\\)
    275             (progn (when is-escaped
    276                      (setq result `(,@result "\\\\")))
    277                    (setq is-escaped (not is-escaped)))
    278           (setq is-escaped nil))))
    279     (unless nested
    280       (setq result `("^" ,@result "\\'")))
    281     (apply #'concat result)))
    282 
    283 (provide 'editorconfig-fnmatch)
    284 ;;; editorconfig-fnmatch.el ends here