code.delx.au - gnu-emacs-elpa/blob - packages/sed-mode/sed-mode.el

   1 ;;; sed-mode.el --- Major mode to edit sed scripts  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6 ;; Version: 1.0
   7 ;; Keywords:
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; If you need this major mode, you might also want to
  25 ;; consider spending some time with `M-x doctor'.
  26
  27 ;;; Code:
  28
  29 (require 'cl-lib)
  30 (require 'smie)
  31
  32 (defgroup sed-mode nil
  33   "Major mode to edit sed code."
  34   :group 'programming)
  35
  36
  37 (defvar sed-mode-syntax-table
  38   (let ((st (make-syntax-table)))
  39     (modify-syntax-entry ?# "<" st)
  40     (modify-syntax-entry ?\n ">" st)
  41     (modify-syntax-entry ?\\ "." st)
  42     st))
  43
  44 (defconst sed-commands ":=aiqQrRbcdDhHgGlnNpPstTwWxy")
  45
  46 (eval-and-compile
  47   (defconst sed-command-prefix-regexp "\\(?:^\\|[$/0-9;]\\)[ \t]*")
  48   (defconst sed-address-prefix-regexp "\\(?:^\\|[,;]\\)[ \t]*"))
  49
  50 (defconst sed-label-regexp "[[:alnum:]]+")
  51
  52 (defun sed-syntax-propertize (beg end)
  53   (goto-char beg)
  54   (sed-syntax-propertize-string end)
  55   (funcall
  56    (syntax-propertize-rules
  57     ("\\\\$"
  58      (0 (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
  59           (put-text-property (match-beginning 0) (match-end 0)
  60                              'syntax-table (string-to-syntax "|"))
  61           (sed-syntax-propertize-string end)
  62           nil)))
  63     ((concat "\\(?:" sed-address-prefix-regexp
  64              "\\(?:\\(?1:/\\)\\|\\\\\\(?1:.\\)\\)"
  65              "\\|" sed-command-prefix-regexp "[sy]\\(?1:.\\)"
  66              "\\)")
  67      (0 (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
  68           (put-text-property (match-beginning 1) (match-end 1)
  69                              'syntax-table (string-to-syntax "\""))
  70           (sed-syntax-propertize-string end)
  71           nil))))
  72    (point) end))
  73
  74 (defun sed-syntax-propertize-string (end)
  75   (let* ((ppss (syntax-ppss))
  76          (c (nth 3 ppss)))
  77     (when c
  78       (let ((count (cond
  79                     ((or (eq c t)
  80                          (not (memq (char-before (nth 8 ppss)) '(?s ?y))))
  81                      1)
  82                     (t 2))))
  83         (goto-char (1+ (nth 8 ppss)))
  84         (when (re-search-forward
  85                (if (eq c t) "[^\\]\n" (regexp-quote (string c)))
  86                end 'move count)
  87           (put-text-property (1- (match-end 0)) (match-end 0)
  88                              'syntax-table
  89                              (if (eq c t) (string-to-syntax "|")
  90                                (string-to-syntax "\""))))))))
  91
  92 (defun sed--font-lock-command (cmd)
  93   (unless (nth 8 (syntax-ppss))
  94     (pcase cmd
  95       (?: (if (looking-at (concat "[    ]*\\(" sed-label-regexp "\\)"))
  96               (put-text-property (match-beginning 1) (match-end 1) 'face
  97                                  font-lock-function-name-face)))
  98       ((or ?b ?t ?T)
  99        (if (looking-at (concat "[       ]*\\(" sed-label-regexp "\\)"))
 100            (put-text-property (match-beginning 1) (match-end 1) 'face
 101                               font-lock-constant-face))))
 102     font-lock-keyword-face))
 103
 104 (defconst sed-font-lock-keywords
 105   `((,(concat sed-command-prefix-regexp "\\([" sed-commands "]\\)")
 106      (1 (sed--font-lock-command (char-after (match-beginning 1)))))))
 107
 108 (defconst sed-smie-grammar nil)
 109
 110 (defun sed-smie-rules (kind token)
 111   (pcase (cons kind token)
 112     (`(:list-intro . ,_) t)
 113     ))
 114
 115 ;;;###autoload (add-to-list 'auto-mode-alist '("\\.sed\\'" . sed-mode))
 116 ;;;###autoload (add-to-list 'interpreter-mode-alist '("sed" . sed-mode))
 117
 118 ;;;###autoload
 119 (define-derived-mode sed-mode prog-mode "Sed"
 120   "Sed editing mode."
 121   ;; (setq-local font-lock-support-mode nil) ;; To help debugging.
 122   (setq-local comment-start "# ")
 123   (setq-local comment-end "")
 124   (setq-local parse-sexp-lookup-properties t)
 125   (setq-local open-paren-in-column-0-is-defun-start nil)
 126   (setq-local syntax-propertize-function #'sed-syntax-propertize)
 127   (setq-local font-lock-defaults '(sed-font-lock-keywords))
 128   (smie-setup sed-smie-grammar #'sed-smie-rules
 129               ;; :backward-token #'sm-c-smie-backward-token
 130               ;; :forward-token #'sm-c-smie-forward-token
 131               )
 132   ;; Backslash auto-realign.
 133   ;; (add-hook 'after-change-functions #'sm-c--bs-after-change nil t)
 134   ;; (add-hook 'post-command-hook #'sm-c--bs-realign nil t)
 135   ;; (setq-local add-log-current-defun-header-regexp sm-c--def-regexp)
 136   ;; (setq-local imenu-generic-expression `((nil ,sm-c--def-regexp 1)))
 137   )
 138
 139 (provide 'sed-mode)
 140 ;;; sed-mode.el ends here