mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-06-14 12:21:20 +00:00
Attempting to revamp commentor
This commit is contained in:
Benson Chu
parent
2be00b0067
commit
856d5875fd
1 changed files with 182 additions and 0 deletions
182
lisp/ti-config/work-commentor-2.el
Normal file
182
lisp/ti-config/work-commentor-2.el
Normal file
|
|
@ -0,0 +1,182 @@
|
|||
;;; work-commentor.el --- -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2020 Benson Chu
|
||||
|
||||
;; Author: Benson Chu <bensonchu457@gmail.com>
|
||||
;; Created: [2020-09-15 16:13]
|
||||
|
||||
;; This file is not part of GNU Emacs
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(defvar banner/styles nil)
|
||||
(defvar banner/current-style nil)
|
||||
|
||||
(defclass banner-comment-style ()
|
||||
((align :initarg :align :type symbol :initform 'left)
|
||||
(fill :initarg :fill :type character :initform (string-to-char " "))
|
||||
(empty-fill :initarg :empty-fill)
|
||||
(padding :initarg :padding :type string :initform "")
|
||||
(start :initarg :start :initform nil)
|
||||
(end :initarg :end :initform nil)
|
||||
(right-ornament :initarg :rorn :initform "")))
|
||||
|
||||
(cl-defun banner/new-style (sym &key (align 'left) (fill (string-to-char " ")) (padding "") start end empty rorn)
|
||||
(add-to-list 'banner/styles
|
||||
(cons sym
|
||||
(make-instance
|
||||
'banner-comment-style
|
||||
:align align :fill fill :padding padding
|
||||
:start start :end end :empty-fill (or empty fill) :rorn rorn))))
|
||||
|
||||
(banner/new-style 'llvm-start :padding "===" :fill ?-
|
||||
:end '(string-reverse (string-trim comment-start))
|
||||
:rorn "-*- C++ -*-")
|
||||
(banner/new-style 'ti-box
|
||||
:fill (string-to-char " ")
|
||||
:empty ?- :end '(string-reverse comment-start))
|
||||
|
||||
(defun banner/change-alignment (align)
|
||||
(interactive (list (intern (completing-read "Alignment? " '(left right center)))))
|
||||
(setf (slot-value banner/current-style 'align)
|
||||
align))
|
||||
|
||||
;; (setq banner/current-style (cdr (car banner/styles)))
|
||||
|
||||
(defun banner/extract-comment-string (expr other)
|
||||
(when (or (not (null expr))
|
||||
(not (null other)))
|
||||
(cond ((null expr) (banner/extract-comment-string other nil))
|
||||
((member (type-of expr) '(symbol cons))
|
||||
(banner/extract-comment-string (eval expr) other))
|
||||
((eq 'string (type-of expr))
|
||||
(string-trim expr)))))
|
||||
|
||||
(defun my/banner-select-style (style)
|
||||
(interactive
|
||||
(list (intern (completing-read "Style? " (mapcar #'car banner/styles)))))
|
||||
(setq banner/current-style (alist-get style banner/styles)))
|
||||
|
||||
(defun my/construct-comment-string (string indent &optional style)
|
||||
(with-slots (align fill empty-fill padding start end) (or style banner/current-style)
|
||||
(let* ((comm-start (concat (banner/extract-comment-string start comment-start)
|
||||
padding))
|
||||
(comm-end (concat (string-reverse padding)
|
||||
(banner/extract-comment-string end comment-end)))
|
||||
(fill-column (- fill-column indent)))
|
||||
(concat
|
||||
(make-string indent ? )
|
||||
(if (string-empty-p string)
|
||||
(-->
|
||||
comm-start
|
||||
(string-pad it (- fill-column (length comm-end) indent) empty-fill)
|
||||
(concat it comm-end))
|
||||
(let* ((len (length (concat comm-start " " string " " comm-end))))
|
||||
(when (> len fill-column)
|
||||
(user-error "string too long"))
|
||||
(let* ((fill-left (- fill-column len))
|
||||
left right)
|
||||
(pcase align
|
||||
('center
|
||||
(setq left (/ fill-left 2)
|
||||
right (- fill-left left)))
|
||||
('left
|
||||
(setq left 0
|
||||
right fill-left))
|
||||
('right
|
||||
(setq right 0
|
||||
left fill-left)))
|
||||
(concat
|
||||
comm-start
|
||||
" "
|
||||
(make-string left fill)
|
||||
string
|
||||
(make-string right fill)
|
||||
" "
|
||||
comm-end))))))))
|
||||
|
||||
(defun my/looking-at-comment (style)
|
||||
(interactive
|
||||
(list banner/current-style))
|
||||
(with-slots (align fill empty-fill padding start end) style
|
||||
(let* ((comm-start (banner/extract-comment-string start (string-trim comment-start)))
|
||||
(comm-end (banner/extract-comment-string end (string-trim comment-end)))
|
||||
(regexp
|
||||
(rx-to-string
|
||||
`(and
|
||||
line-start
|
||||
(group (* " "))
|
||||
(group
|
||||
,comm-start
|
||||
,padding)
|
||||
(group
|
||||
(* nonl))
|
||||
(group
|
||||
,(string-reverse padding)
|
||||
,comm-end)
|
||||
))))
|
||||
(save-excursion
|
||||
(goto-char (point-at-bol))
|
||||
(aprog1 (and (looking-at regexp) (save-match-data (length (match-string 1))))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(if it
|
||||
(message "Looking at comment! space: '%s', beg: '%s', mid: '%s', end: '%s'"
|
||||
(match-string 1) (match-string 2) (match-string 3) (match-string 4))
|
||||
(message "Not looking at comment!"))))))))
|
||||
|
||||
(defun banner/parse-comment (style)
|
||||
(interactive (list banner/current-style))
|
||||
(with-slots (align fill empty-fill padding start end) style
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(goto-char (point-at-bol))
|
||||
(let ((res (my/looking-at-comment style)))
|
||||
(if (not res)
|
||||
(let ((string (buffer-substring (line-beginning-position) (line-end-position))))
|
||||
(string-match "^\\( *\\)\\(.*\\)$" string)
|
||||
(cons (length (match-string 1 string)) (match-string 2 string)))
|
||||
(cons res
|
||||
(let ((mid (match-string 3)))
|
||||
(cond
|
||||
((string-match-p (rx-to-string `(and line-start (+ ,empty-fill) line-end))
|
||||
mid)
|
||||
"")
|
||||
((string-match (rx-to-string `(and line-start
|
||||
(* ,empty-fill)
|
||||
(group (+ (not (any "\n" ,empty-fill))))
|
||||
(+ ,empty-fill)
|
||||
line-end))
|
||||
mid)
|
||||
(match-string 1 mid))
|
||||
((eq align 'center) (string-trim mid))
|
||||
((eq align 'left) (string-trim-right (substring mid 1 (length mid))))
|
||||
((eq align 'right) (string-trim-left (substring mid 0 (1- (length mid))))))))))))))
|
||||
|
||||
(defun my/banner-comment (style)
|
||||
(interactive
|
||||
(list banner/current-style))
|
||||
(let* ((res (banner/parse-comment style))
|
||||
(new-line (my/construct-comment-string (cdr res) (car res) style)))
|
||||
(let ((point (point)))
|
||||
(goto-char (line-beginning-position))
|
||||
(when (not (looking-at-p "^$"))
|
||||
(kill-region (line-beginning-position) (line-end-position)))
|
||||
(insert new-line)
|
||||
(goto-char point))))
|
||||
|
||||
(provide 'work-commentor)
|
||||
;;; work-commentor.el ends here
|
||||
Loading…
Reference in a new issue