add lisp packages
This commit is contained in:
661
lisp/srefactor/srefactor-lisp.el
Normal file
661
lisp/srefactor/srefactor-lisp.el
Normal file
@@ -0,0 +1,661 @@
|
||||
;;; Srefactor --- A refactoring tool based on Semantic parser framework
|
||||
;;
|
||||
;; Filename: srefactor-lisp.el
|
||||
;; Description: A refactoring tool based on Semantic parser framework
|
||||
;; Author: Tu, Do Hoang <tuhdo1710@gmail.com>
|
||||
;; URL : https://github.com/tuhdo/semantic-refactor
|
||||
;; Maintainer: Tu, Do Hoang
|
||||
;; Created: Wed Feb 11 21:25:51 2015 (+0700)
|
||||
;; Version: 0.3
|
||||
;; Package-Requires: ((emacs "24.3+"))
|
||||
;; Last-Updated: Wed Feb 11 21:25:51 2015 (+0700)
|
||||
;; By: Tu, Do Hoang
|
||||
;; Update #: 1
|
||||
;; URL:
|
||||
;; Doc URL:
|
||||
;; Keywords: emacs-lisp, languages, tools
|
||||
;; Compatibility: GNU Emacs: 24.3+
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Semantic is a package that provides a framework for writing
|
||||
;; parsers. Parsing is a process of analyzing source code based on
|
||||
;; programming language syntax. This package relies on Semantic for
|
||||
;; analyzing source code and uses its results to perform smart code
|
||||
;; refactoring that based on code structure of the analyzed language,
|
||||
;; instead of plain text structure.
|
||||
;;
|
||||
;; This package provides the following features for Emacs Lisp:
|
||||
;;
|
||||
;; - `srefactor-lisp-format-buffer': Format whole buffer.
|
||||
;; - `srefactor-lisp-format-defun': Format the current defun point is in.
|
||||
;; - `srefactor-lisp-one-line': Transform all sub-sexpressions current sexpression at
|
||||
;; point into one line separated each one by a space.
|
||||
;;
|
||||
;; - `srefactor-lisp-format-sexp': Transform all sub-sexpressions current sexpression
|
||||
;; at point into multiple lines separated. If the head symbol belongs to the
|
||||
;; list `srefactor-lisp-symbol-to-skip', then the first N next symbol/sexpressions
|
||||
;; (where N is the nummber associated with the head symbol as stated in the
|
||||
;; list) are skipped before a newline is inserted.
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Code:
|
||||
(require 'semantic/bovine/el)
|
||||
|
||||
(defcustom srefactor-newline-threshold 40
|
||||
"If a token is about to be inserted, if the current posistion
|
||||
exceeds this threshold characters, insert the token in the next
|
||||
line isntead. Note that this does not account for indentation
|
||||
but the total number of characters in a line."
|
||||
:group 'srefactor)
|
||||
|
||||
(defcustom srefactor-lisp-symbol-to-skip '(("progn" . 0)
|
||||
("cond" . 0)
|
||||
("save-excursion" . 0)
|
||||
("unwind-protect" . 0)
|
||||
("with-temp-buffer" . 0)
|
||||
;; ("condition-case" . 1)
|
||||
;; ("with-current-buffer" . 1)
|
||||
;; ("with-open-file" . 1)
|
||||
;; ("let" . 1)
|
||||
;; ("let*" . 1)
|
||||
;; ("if" . 1)
|
||||
;; ("while" . 1)
|
||||
;; ("dolist" . 1)
|
||||
;; ("do" . 1)
|
||||
;; ("when" . 1)
|
||||
;; ("buffer-substring-no-properties" . 1)
|
||||
;; ("unless" . 1)
|
||||
;; ("not" . 1)
|
||||
;; ("null" . 1)
|
||||
;; ("null?" . 1)
|
||||
;; ("concat" . 1)
|
||||
;; ("or" . 1)
|
||||
;; ("and" . 1)
|
||||
;; ("catch" . 1)
|
||||
;; ("mapcar" . 1)
|
||||
;; ("mapcan" . 1)
|
||||
;; ("mapc" . 1)
|
||||
;; ("+" . 1)
|
||||
;; ("-" . 1)
|
||||
;; ("*" . 1)
|
||||
;; ("/" . 1)
|
||||
;; ("error" . 1)
|
||||
;; ("goto-char" . 1)
|
||||
;; ("insert" . 1)
|
||||
;; ("car" . 1)
|
||||
;; ("cdr" . 1)
|
||||
;; ("lambda" . 1)
|
||||
;; ("1+" . 1)
|
||||
;; ("1-" . 1)
|
||||
("defmethod" . 1)
|
||||
("cons" . 2)
|
||||
("kill-region" . 2)
|
||||
("equal" . 2)
|
||||
("member" . 2)
|
||||
("eq?" . 2)
|
||||
("eq" . 2)
|
||||
("get" . 2)
|
||||
("assoc" . 2)
|
||||
("defun" . 2)
|
||||
("defclass" . 2)
|
||||
("defstruct" . 2)
|
||||
("defmacro" . 2)
|
||||
("defsubst" . 2)
|
||||
("defface" . 2)
|
||||
("defalias" . 2)
|
||||
("defcustom" . 2)
|
||||
("declare" . 2)
|
||||
("defvar" . 2)
|
||||
("defparameter" . 2)
|
||||
("defconst" . 2)
|
||||
("string-match" . 2)
|
||||
("defcustom" . 2)
|
||||
("setq" . 2)
|
||||
("setq-default" . 2)
|
||||
("member" . 2)
|
||||
("setf" . 2)
|
||||
(">" . 2)
|
||||
("<" . 2)
|
||||
("<=" . 2)
|
||||
(">=" . 2)
|
||||
("/=" . 2)
|
||||
("=" . 2)
|
||||
("some" . 2)
|
||||
("define-key" . 3)
|
||||
("modify-syntax-entry" . 3))
|
||||
"A list of pairs of a symbol and a number that denotes how many
|
||||
sexp to skip before inserting the first newline. "
|
||||
:group 'srefactor)
|
||||
|
||||
(defcustom srefactor-clojure-symbol-to-skip '(("fn" . 1)
|
||||
("ns" . 1)
|
||||
(":require" . 1)
|
||||
(":import" . 1)
|
||||
("def" . 2)
|
||||
("struct-map" . 1)
|
||||
("defmacro" . 1)
|
||||
("binding" . 1)
|
||||
("with-bindings" . 1)
|
||||
("doseq" . 1)
|
||||
("catch" . 2)
|
||||
("defn" . 2))
|
||||
"A list of pairs of a symbol and a number that denotes how many
|
||||
sexp to skip before inserting a newline. This will be merged
|
||||
with `srefactor-lisp-symbol-to-skip'. Symbols in this list
|
||||
overrides symbols in `srefactor-lisp-symbol-to-skip'."
|
||||
:group 'srefactor)
|
||||
|
||||
;; Internal variables of parser state
|
||||
(defvar token nil)
|
||||
(defvar token-type nil)
|
||||
(defvar token-str nil)
|
||||
(defvar ignore-num nil)
|
||||
(defvar tok-start nil)
|
||||
(defvar next-token nil)
|
||||
(defvar next-token-start nil)
|
||||
(defvar next-token-end nil)
|
||||
(defvar next-token-type nil)
|
||||
(defvar next-token-str nil)
|
||||
(defvar tok-end nil)
|
||||
(defvar cur-buf nil)
|
||||
(defvar first-token nil)
|
||||
(defvar first-token-name nil)
|
||||
(defvar second-token nil)
|
||||
(defvar lexemes nil)
|
||||
(defvar comment-token nil)
|
||||
(defvar comment-content nil)
|
||||
(defvar token-real-line nil)
|
||||
(defvar next-token-real-line nil)
|
||||
(defvar comment-real-line-start nil)
|
||||
(defvar comment-real-line-end nil)
|
||||
(defvar comment-token-start nil)
|
||||
(defvar comment-token-end nil)
|
||||
(defvar format-type nil)
|
||||
(defvar recursive-p nil)
|
||||
(defvar orig-format-type nil)
|
||||
|
||||
|
||||
(defun srefactor--appropriate-major-mode (major-mode)
|
||||
(cond
|
||||
((eq major-mode 'emacs-lisp-mode)
|
||||
(emacs-lisp-mode))
|
||||
((eq major-mode 'scheme-mode)
|
||||
(scheme-mode))
|
||||
((eq major-mode 'common-lisp-mode)
|
||||
(common-lisp-mode))
|
||||
((and (fboundp 'clojure-mode)
|
||||
(eq major-mode 'clojure-mode))
|
||||
(clojure-mode))
|
||||
(t (emacs-lisp-mode))))
|
||||
|
||||
(defun srefactor--define-skip-list-for-mode (major-mode)
|
||||
(cond
|
||||
((and (fboundp 'clojure-mode)
|
||||
(eq major-mode 'clojure-mode))
|
||||
(cl-remove-duplicates (append srefactor-lisp-symbol-to-skip srefactor-clojure-symbol-to-skip)
|
||||
:test (lambda (a b)
|
||||
(equal (car a) (car b)))))
|
||||
(t srefactor-lisp-symbol-to-skip)))
|
||||
|
||||
(defun srefactor-lisp-format-buffer ()
|
||||
"Format current buffer."
|
||||
(interactive)
|
||||
(let ((cur-pos (point))
|
||||
(buf-content (buffer-substring-no-properties (point-min)
|
||||
(point-max)))
|
||||
(cur-major-mode major-mode)
|
||||
(orig-skip-list srefactor-lisp-symbol-to-skip)
|
||||
(cur-indent-mode indent-tabs-mode))
|
||||
(setq buf-content (with-temp-buffer
|
||||
(semantic-default-elisp-setup)
|
||||
(emacs-lisp-mode)
|
||||
(setq indent-tabs-mode cur-indent-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode))
|
||||
(semantic-lex-init)
|
||||
(insert buf-content)
|
||||
(goto-char (point-max))
|
||||
(while (beginning-of-defun-raw)
|
||||
(let ((beg (point))
|
||||
(end (save-excursion
|
||||
(forward-sexp)
|
||||
(point))))
|
||||
(srefactor--lisp-format-one-or-multi-lines
|
||||
beg end beg 'multi-line nil t)
|
||||
(goto-char beg)))
|
||||
(srefactor--appropriate-major-mode cur-major-mode)
|
||||
(indent-region (point-min)
|
||||
(point-max))
|
||||
(setq srefactor-lisp-symbol-to-skip orig-skip-list)
|
||||
(buffer-substring-no-properties (point-min)
|
||||
(point-max))))
|
||||
(kill-region (point-min) (point-max))
|
||||
(insert buf-content)
|
||||
(goto-char cur-pos)))
|
||||
|
||||
(defun srefactor-lisp-format-defun ()
|
||||
"Format current defun point is in."
|
||||
(interactive)
|
||||
(let* ((orig-point (point))
|
||||
(beg (save-excursion
|
||||
(forward-char 1)
|
||||
(beginning-of-defun-raw)
|
||||
(point)))
|
||||
(end (save-excursion
|
||||
(goto-char beg)
|
||||
(forward-sexp)
|
||||
(point)))
|
||||
(orig-skip-list srefactor-lisp-symbol-to-skip)
|
||||
(cur-indent-mode indent-tabs-mode)
|
||||
(cur-major-mode major-mode)
|
||||
(content (buffer-substring-no-properties beg end)))
|
||||
(progn
|
||||
(setq content (with-temp-buffer
|
||||
(semantic-default-elisp-setup)
|
||||
(emacs-lisp-mode)
|
||||
(setq indent-tabs-mode cur-indent-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode))
|
||||
(semantic-lex-init)
|
||||
(insert content)
|
||||
(srefactor--lisp-format-one-or-multi-lines (point-min)
|
||||
(point-max)
|
||||
(point-min)'multi-line
|
||||
nil
|
||||
t)
|
||||
(srefactor--appropriate-major-mode cur-major-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip orig-skip-list)
|
||||
(indent-region (point-min)
|
||||
(point-max))
|
||||
(buffer-substring-no-properties (point-min)
|
||||
(point-max))))
|
||||
(kill-region beg end)
|
||||
(insert content)
|
||||
(goto-char orig-point))))
|
||||
|
||||
(defun srefactor-lisp-format-sexp ()
|
||||
"Transform all sub-sexpressions current sexpression at point
|
||||
into multiple lines separatedly. If the head symbol belongs to the
|
||||
list `srefactor-lisp-symbol-to-skip', then the first N next
|
||||
symbol/sexpressions (where N is the nummber associated with the
|
||||
head symbol as stated in the list) are skipped before a newline
|
||||
is inserted."
|
||||
(interactive)
|
||||
(let* ((orig-point (point))
|
||||
(beg (save-excursion
|
||||
(unless (looking-at "[({[]")
|
||||
(backward-up-list))
|
||||
(point)))
|
||||
(end (save-excursion
|
||||
(goto-char beg)
|
||||
(forward-sexp)
|
||||
(point)))
|
||||
(orig-skip-list srefactor-lisp-symbol-to-skip)
|
||||
(cur-indent-mode indent-tabs-mode)
|
||||
(cur-major-mode major-mode)
|
||||
(content (buffer-substring-no-properties beg end)))
|
||||
(progn
|
||||
(setq content (with-temp-buffer
|
||||
(semantic-default-elisp-setup)
|
||||
(emacs-lisp-mode)
|
||||
(setq indent-tabs-mode cur-indent-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode))
|
||||
(semantic-lex-init)
|
||||
(insert content)
|
||||
(srefactor--lisp-format-one-or-multi-lines (point-min)
|
||||
(point-max)
|
||||
(point-min)'multi-line
|
||||
nil
|
||||
t)
|
||||
(srefactor--appropriate-major-mode cur-major-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip orig-skip-list)
|
||||
(buffer-substring-no-properties (point-min)
|
||||
(point-max))))
|
||||
(kill-region beg end)
|
||||
(insert content)
|
||||
(goto-char beg)
|
||||
(forward-sexp)
|
||||
(setq end (point))
|
||||
(indent-region beg end)
|
||||
(goto-char orig-point))))
|
||||
|
||||
(defun srefactor-lisp-one-line (recursive-p)
|
||||
"Transform all sub-sexpressions current sexpression at point
|
||||
into one line separated each one by a space."
|
||||
(interactive "P")
|
||||
(let* ((orig-point (point))
|
||||
(beg (save-excursion
|
||||
(unless (looking-at "[({[]")
|
||||
(backward-up-list))
|
||||
(point)))
|
||||
(end (save-excursion
|
||||
(goto-char beg)
|
||||
(forward-sexp)
|
||||
(point)))
|
||||
(orig-skip-list srefactor-lisp-symbol-to-skip)
|
||||
(cur-indent-mode indent-tabs-mode)
|
||||
(cur-major-mode major-mode)
|
||||
(content (buffer-substring-no-properties beg end)))
|
||||
(progn
|
||||
(setq content (with-temp-buffer
|
||||
(semantic-default-elisp-setup)
|
||||
(emacs-lisp-mode)
|
||||
(setq indent-tabs-mode cur-indent-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode))
|
||||
(semantic-lex-init)
|
||||
(insert content)
|
||||
(srefactor--lisp-format-one-or-multi-lines (point-min)
|
||||
(point-max)
|
||||
(point-min)'one-line
|
||||
nil
|
||||
recursive-p)
|
||||
(srefactor--appropriate-major-mode cur-major-mode)
|
||||
(setq srefactor-lisp-symbol-to-skip orig-skip-list)
|
||||
(indent-region (point-min)
|
||||
(point-max))
|
||||
(buffer-substring-no-properties (point-min)
|
||||
(point-max))))
|
||||
(kill-region beg end)
|
||||
(insert content)
|
||||
(goto-char orig-point))))
|
||||
|
||||
(defun srefactor--lisp-format-one-or-multi-lines (beg end orig-point format-type &optional
|
||||
newline-betwen-semantic-lists recursive-p)
|
||||
"Turn the current sexpression into one line/multi-line depends
|
||||
on the value of FORMAT-TYPE. If FORMAT-TYPE is 'one-line,
|
||||
transforms all sub-sexpressions of the same level into one
|
||||
line. If FORMAT-TYPE is 'multi-line, transforms all
|
||||
sub-sexpressions of the same level into multiple lines.
|
||||
|
||||
Return the position of last closing sexp."
|
||||
(let* ((lexemes (semantic-emacs-lisp-lexer beg end 1))
|
||||
(cur-buf (current-buffer))
|
||||
(first-token (cadr lexemes))
|
||||
(first-token-name (srefactor--lisp-token-text first-token))
|
||||
(second-token (caddr lexemes))
|
||||
(tmp-buf (generate-new-buffer (make-temp-name "")))
|
||||
(orig-format-type format-type)
|
||||
token-str
|
||||
ignore-pair
|
||||
ignore-num
|
||||
token)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(unless (assoc 'semantic-list lexemes)
|
||||
(setq format-type 'one-line))
|
||||
(if (or (eq (car first-token) 'semantic-list)
|
||||
(assoc first-token-name srefactor-lisp-symbol-to-skip))
|
||||
(setq newline-betwen-semantic-lists t))
|
||||
(setq ignore-pair (assoc first-token-name srefactor-lisp-symbol-to-skip))
|
||||
(setq ignore-num (cdr ignore-pair))
|
||||
(while lexemes
|
||||
(let* (token-type tok-start tok-end next-token next-token-start
|
||||
next-token-type next-token-str)
|
||||
(srefactor--lisp-forward-token)
|
||||
(with-current-buffer tmp-buf
|
||||
(insert token-str)
|
||||
(srefactor--lisp-comment-formatter)
|
||||
(cond
|
||||
((and (eq token-type 'number)
|
||||
(member next-token-str '("+" "-" "*" "/")))
|
||||
(srefactor--lisp-number-formatter))
|
||||
((or (eq token-type 'punctuation)
|
||||
(eq token-type 'open-paren)
|
||||
(eq token-type 'close-paren)
|
||||
(eq next-token-type 'close-paren))
|
||||
(srefactor--lisp-punctuation-formatter))
|
||||
((eq token-type 'symbol)
|
||||
(srefactor--lisp-symbol-formatter))
|
||||
((eq format-type 'one-line)
|
||||
(srefactor--lisp-oneline-formatter))
|
||||
((eq format-type 'multi-line)
|
||||
(srefactor--lisp-multiline-formatter))))))
|
||||
(kill-region beg end)
|
||||
(setq beg (point))
|
||||
(insert (with-current-buffer tmp-buf
|
||||
(buffer-substring-no-properties (point-min)
|
||||
(point-max))))
|
||||
(setq end (point))
|
||||
;; descend into sub-sexpressions
|
||||
(setq lexemes (semantic-emacs-lisp-lexer beg end 1))
|
||||
(when recursive-p
|
||||
(srefactor--lisp-visit-semantic-list-lex (nreverse lexemes))))
|
||||
(kill-buffer tmp-buf))))
|
||||
|
||||
(defun srefactor--lisp-number-formatter ()
|
||||
"Make use of dynamic scope of its parent
|
||||
function `srefactor--lisp-format-one-or-multi-lines'"
|
||||
(goto-char (semantic-lex-token-end token))
|
||||
(insert next-token-str)
|
||||
(srefactor--lisp-comment-formatter)
|
||||
(insert " ")
|
||||
(setq first-token (semantic-lex-token 'symbol
|
||||
(semantic-lex-token-start token)
|
||||
(1+ (semantic-lex-token-end token))))
|
||||
(setq first-token-name (concat token-str next-token-str))
|
||||
(setq second-token (cadr lexemes))
|
||||
(srefactor--lisp-forward-token))
|
||||
|
||||
(defun srefactor--lisp-punctuation-formatter ()
|
||||
"Make use of dynamic scope of its parent
|
||||
function `srefactor--lisp-format-one-or-multi-lines'"
|
||||
(let ((orig-token token)
|
||||
token
|
||||
token-str)
|
||||
(while (srefactor--lisp-token-in-punctuation-p (srefactor--lisp-forward-token))
|
||||
(insert token-str)
|
||||
(srefactor--lisp-comment-formatter))
|
||||
(when (eq first-token-name (srefactor--lisp-token-text orig-token))
|
||||
(srefactor--lisp-forward-first-second-token))
|
||||
(when token
|
||||
(push token lexemes))))
|
||||
|
||||
(defun srefactor--lisp-symbol-formatter ()
|
||||
"Insert additional text based on symbol appearance. Make use of
|
||||
dynamic scope of its parent function `srefactor--lisp-format-one-or-multi-lines'"
|
||||
(cond
|
||||
((and (not (equal token-str first-token-name))
|
||||
(eq orig-format-type 'multi-line)
|
||||
(string-match ":.*" token-str))
|
||||
(insert " ")
|
||||
(srefactor--lisp-forward-token)
|
||||
(while (member token-type '(punctuation open-paren semantic-list))
|
||||
(insert token-str)
|
||||
(srefactor--lisp-forward-token))
|
||||
(insert token-str)
|
||||
(cond
|
||||
((or (equal next-token-str "}"))
|
||||
(insert next-token-str "\n" " ")
|
||||
(srefactor--lisp-comment-formatter)
|
||||
(srefactor--lisp-forward-token))
|
||||
((not (or (srefactor--lisp-token-in-punctuation-p next-token)
|
||||
(null next-token)))
|
||||
(insert "\n"))
|
||||
(t)))
|
||||
((member token-str '("~@" "?")) "")
|
||||
((string-equal token-str ".") (insert " "))
|
||||
((eq format-type 'one-line)
|
||||
(srefactor--lisp-oneline-formatter))
|
||||
((eq format-type 'multi-line)
|
||||
(srefactor--lisp-multiline-formatter))))
|
||||
|
||||
(defun srefactor--lisp-forward-first-second-token ()
|
||||
(setq first-token token)
|
||||
(setq first-token-name (srefactor--lisp-token-text first-token))
|
||||
(setq second-token (car lexemes)))
|
||||
|
||||
(defun srefactor--lisp-forward-token ()
|
||||
(setq token (pop lexemes))
|
||||
(when token
|
||||
(setq token-type (semantic-lex-token-class token))
|
||||
(setq tok-start (semantic-lex-token-start token))
|
||||
(setq tok-end (semantic-lex-token-end token))
|
||||
(setq token-str (srefactor--lisp-token-text token))
|
||||
(setq next-token (car lexemes))
|
||||
(setq next-token-type (semantic-lex-token-class next-token))
|
||||
(setq next-token-start (semantic-lex-token-start next-token))
|
||||
(setq next-token-end (semantic-lex-token-end next-token))
|
||||
(setq next-token-str (if next-token
|
||||
(srefactor--lisp-token-text next-token)
|
||||
""))
|
||||
token))
|
||||
|
||||
(defun srefactor--lisp-comment-formatter ()
|
||||
(let (comment-token comment-token-start comment-token-end
|
||||
comment-content next-token-real-line token-real-line
|
||||
comment-real-line-start comment-real-line-end)
|
||||
(when (and tok-end next-token-start)
|
||||
(setq comment-token (with-current-buffer cur-buf ;; asdf
|
||||
(condition-case nil
|
||||
(car (semantic-comment-lexer tok-end next-token-start))
|
||||
(error nil))))
|
||||
(when comment-token
|
||||
(setq comment-content (with-current-buffer cur-buf
|
||||
;; set values inside the buffer to avoid global variable
|
||||
(setq comment-token-start (semantic-lex-token-start comment-token))
|
||||
(setq comment-token-end (semantic-lex-token-end comment-token))
|
||||
(setq comment-real-line-start (line-number-at-pos comment-token-start))
|
||||
(setq comment-real-line-end (line-number-at-pos comment-token-end))
|
||||
(setq token-real-line (line-number-at-pos tok-end))
|
||||
(setq next-token-real-line (line-number-at-pos next-token-start))
|
||||
(buffer-substring-no-properties comment-token-start
|
||||
comment-token-end)))
|
||||
(cond
|
||||
;; if comment token is next to a string, chances are it is below the
|
||||
;; docstring. Add a newlien in between.
|
||||
((eq token-type 'string)
|
||||
(insert "\n" comment-content))
|
||||
((= token-real-line comment-real-line-start)
|
||||
(insert " " comment-content))
|
||||
((not (= token-real-line comment-real-line-start))
|
||||
(insert "\n" comment-content))
|
||||
(t))
|
||||
;; If the current/next token is a punctuation (open/close paren,
|
||||
;; punctuation) add a newline no matter what; otherwise it destroys the
|
||||
;; layout of sexp because nonewline is inserted after the current/next
|
||||
;; token and it will be in the same line with the just inserted comment
|
||||
;; and be part of it, which is dangerous
|
||||
(when (or (srefactor--lisp-token-in-punctuation-p token)
|
||||
(srefactor--lisp-token-in-punctuation-p next-token)
|
||||
(string-match "[]}]" token-str))
|
||||
(insert "\n"))))))
|
||||
|
||||
(defun srefactor--lisp-oneline-formatter ()
|
||||
(unless (srefactor--lisp-token-in-punctuation-p token)
|
||||
(let ((distance (- (point)
|
||||
(line-beginning-position))))
|
||||
(if (or (eq orig-format-type 'one-line)
|
||||
(<= distance srefactor-newline-threshold))
|
||||
(insert " ")
|
||||
(insert "\n")))))
|
||||
|
||||
(defun srefactor--lisp-multiline-formatter ()
|
||||
(cond
|
||||
(ignore-num (when (and (equal first-token-name token-str))
|
||||
(insert " ")
|
||||
(when (and ignore-num
|
||||
(= ignore-num 0))
|
||||
(setq ignore-num (1- ignore-num))))
|
||||
(while (> ignore-num 0)
|
||||
(if (srefactor--lisp-token-paren-p token)
|
||||
(progn
|
||||
(delete-char -1)
|
||||
(push token lexemes)
|
||||
(setq ignore-num 0))
|
||||
(srefactor--lisp-forward-token)
|
||||
(insert token-str)
|
||||
(srefactor--lisp-comment-formatter)
|
||||
(if (srefactor--lisp-token-in-punctuation-p token)
|
||||
(srefactor--lisp-forward-first-second-token)
|
||||
(setq ignore-num (1- ignore-num))
|
||||
(insert " "))))
|
||||
(delete-char -1)
|
||||
(if (srefactor--lisp-token-paren-p (car lexemes))
|
||||
(srefactor--lisp-punctuation-formatter)
|
||||
(insert "\n"))
|
||||
(setq ignore-num nil))
|
||||
((and (equal first-token-name token-str)
|
||||
(not (eq next-token-type 'semantic-list)))
|
||||
(insert " "))
|
||||
((and (eq next-token-type 'semantic-list)
|
||||
(eq token-type 'symbol)
|
||||
(equal first-token-name token-str))
|
||||
(insert " "))
|
||||
((eq token-type 'semantic-list)
|
||||
(insert "\n"))
|
||||
((or (null ignore-num)
|
||||
(= ignore-num 0))
|
||||
(insert "\n"))
|
||||
(t (insert "\n"))))
|
||||
|
||||
(defun srefactor--lisp-token-name-in-skip-list-p (token-name)
|
||||
(member token-name srefactor-lisp-symbol-to-skip))
|
||||
|
||||
(defun srefactor--lisp-token-in-punctuation-p (token)
|
||||
(member (semantic-lex-token-class token) '(open-paren charquote close-paren punctuation)))
|
||||
|
||||
(defun srefactor--lisp-token-paren-p (token)
|
||||
(member (semantic-lex-token-class token) '(open-paren close-paren)))
|
||||
|
||||
(defun srefactor--lisp-token-text (token)
|
||||
(if token
|
||||
(with-current-buffer cur-buf
|
||||
(buffer-substring-no-properties (semantic-lex-token-start token)
|
||||
(semantic-lex-token-end token)))
|
||||
""))
|
||||
|
||||
(defun srefactor--lisp-visit-semantic-list-lex (lexemes)
|
||||
"Visit and format all sub-sexpressions (semantic list) in LEXEMES."
|
||||
(dolist (token lexemes)
|
||||
(let ((tok-start (semantic-lex-token-start token))
|
||||
(tok-end (semantic-lex-token-end token))
|
||||
tok-str)
|
||||
(when (and (eq (car token) 'semantic-list)
|
||||
(> (- tok-end tok-start) 2))
|
||||
(goto-char (semantic-lex-token-start token))
|
||||
(srefactor--lisp-format-one-or-multi-lines tok-start
|
||||
tok-end
|
||||
tok-start
|
||||
format-type
|
||||
(assoc tok-str srefactor-lisp-symbol-to-skip)
|
||||
recursive-p)))))
|
||||
|
||||
(defun srefactor--lisp-comment-debug-messages ()
|
||||
(message "comment-token: %s" comment-token)
|
||||
(message "comment-start: %s" comment-token-start)
|
||||
(message "comment-end: %s" comment-token-end)
|
||||
(message "comment-content: %s" comment-content)
|
||||
(message "comment-content: %s" comment-content)
|
||||
(message "token-real-line: %s" token-real-line)
|
||||
(message "next-token-real-line: %s" next-token-real-line)
|
||||
(message "comment-real-line-start: %s" comment-real-line-start)
|
||||
(message "comment-real-line-end %s" comment-real-line-end))
|
||||
|
||||
(defun srefactor--lisp-debug-messages ()
|
||||
(message "token: %s" token)
|
||||
(message "token-type: %s" token-type)
|
||||
(message "token-str: %s" token-str)
|
||||
(when ignore-num
|
||||
(message "ignore-num: %s" ignore-num))
|
||||
(message "next-token: %s" next-token)
|
||||
(message "next-token-type: %s" next-token-type)
|
||||
(message "next-token-str: %s" next-token-str))
|
||||
|
||||
(provide 'srefactor-lisp)
|
||||
12
lisp/srefactor/srefactor-pkg.el
Normal file
12
lisp/srefactor/srefactor-pkg.el
Normal file
@@ -0,0 +1,12 @@
|
||||
(define-package "srefactor" "20180703.1810" "A refactoring tool based on Semantic parser framework"
|
||||
'((emacs "24.4"))
|
||||
:keywords
|
||||
'("c" "languages" "tools")
|
||||
:authors
|
||||
'(("Tu, Do Hoang" . "tuhdo1710@gmail.com"))
|
||||
:maintainer
|
||||
'("Tu, Do Hoang")
|
||||
:url "https://github.com/tuhdo/semantic-refactor")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
437
lisp/srefactor/srefactor-ui.el
Normal file
437
lisp/srefactor/srefactor-ui.el
Normal file
@@ -0,0 +1,437 @@
|
||||
;;; srefactor-ui.el --- A refactoring tool based on Semantic parser framework
|
||||
;;
|
||||
;; Filename: srefactor-ui.el
|
||||
;; Description: A refactoring tool based on Semantic parser framework
|
||||
;; Author: Tu, Do Hoang <tuhdo1710@gmail.com
|
||||
;; Maintainer: Tu, Do Hoang
|
||||
;; Created: Wed Feb 11 21:25:51 2015 (+0700)
|
||||
;; Version: 0.1
|
||||
;; Package-Requires: ()
|
||||
;; Last-Updated: Wed Feb 11 21:25:51 2015 (+0700)
|
||||
;; By: Tu, Do Hoang
|
||||
;; Update #: 1
|
||||
;; URL:
|
||||
;; Doc URL:
|
||||
;; Keywords: c, languages, tools
|
||||
;; Compatibility: GNU Emacs: 24.3+
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This package provides a UI to interact with users of Srefactor
|
||||
;; package.
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Code:
|
||||
(with-no-warnings
|
||||
(require 'cl))
|
||||
(require 'recentf)
|
||||
(require 'eieio)
|
||||
(require 'semantic/format)
|
||||
(autoload 'srefactor--refactor-based-on-tag-class "srefactor")
|
||||
(autoload 'srefactor--insert-tag "srefactor")
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Variables
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defvar srefactor-ui--current-active-window nil
|
||||
"Store the current active window where the menu is invoked.")
|
||||
|
||||
(defvar srefactor-ui--current-active-region-start nil
|
||||
"Store the start of an active region of current window if any.")
|
||||
|
||||
(defvar srefactor-ui--current-active-region-end nil
|
||||
"Store the end of an active region of current window if any.")
|
||||
|
||||
(defvar srefactor-ui--current-active-menu nil
|
||||
"Current menu object biing used.")
|
||||
|
||||
(defvar srefactor-ui--func-type nil
|
||||
"What type of refactoring to perform.")
|
||||
|
||||
(defvar srefactor-ui--current-active-tag-overlay nil
|
||||
"Overlay of tag in srefactor-ui--current-active-window.")
|
||||
|
||||
(defcustom srefactor-ui-menu-show-help t
|
||||
"Turn on/off help message."
|
||||
:group 'srefactor-ui
|
||||
:type 'boolean)
|
||||
|
||||
(defsubst srefactor-ui--menu-label (e)
|
||||
(car e))
|
||||
|
||||
(defsubst srefactor-ui--menu-value-item (e)
|
||||
(cdr e))
|
||||
|
||||
(defsubst srefactor-ui--digit-shortcut-command-name (n)
|
||||
"Return a command name to open the Nth most recent file.
|
||||
See also the command `recentf-open-most-recent-file'."
|
||||
(intern (format "srefactor-ui--refactor-based-on-tag-class-%d" n)))
|
||||
|
||||
(defsubst srefactor-ui--make-menu-element (menu-item menu-value)
|
||||
"Create a new menu-element.
|
||||
A menu element is a pair (MENU-ITEM . MENU-VALUE), where MENU-ITEM is
|
||||
the menu item string displayed. MENU-VALUE is the file to be open
|
||||
when the corresponding MENU-ITEM is selected."
|
||||
(cons menu-item menu-value))
|
||||
|
||||
(defclass srefactor-ui-menu ()
|
||||
((name
|
||||
:initarg :name
|
||||
:initform "*Srefactor Menu*"
|
||||
:accessor name
|
||||
:type string
|
||||
:documentation
|
||||
"Name of the menu to be displayed in the modeline.")
|
||||
(items
|
||||
:initarg :items
|
||||
:initform nil
|
||||
:accessor items
|
||||
:type list
|
||||
:documentation
|
||||
"Item list to be displayed in a menu. Item is a list
|
||||
'(DISPLAY REAL OPTIONS).")
|
||||
(action
|
||||
:initarg :action
|
||||
:initform nil
|
||||
:accessor action
|
||||
:documentation
|
||||
"An action to run when a menu item is selected.")
|
||||
(context
|
||||
:initarg :context
|
||||
:initform nil
|
||||
:accessor context
|
||||
:documentation
|
||||
"Current Semantic tag in scope, used as context to
|
||||
select appropriate refactor actions.")
|
||||
(shortcut-p
|
||||
:initarg :shortcut-p
|
||||
:initform nil
|
||||
:accessor shortcut-p
|
||||
:type boolean
|
||||
:documentation
|
||||
"If t, first 9 actions can be executed by digit keys 1-9.")
|
||||
(persistent-action
|
||||
:initarg :persistent-action
|
||||
:initform nil
|
||||
:accessor persistent-action
|
||||
:documentation
|
||||
"An action to execute without exiting the menu.")
|
||||
(keymap
|
||||
:initarg :keymap
|
||||
:initform nil
|
||||
:accessor keymap
|
||||
:documentation
|
||||
"A function that set define keys in srefactor-ui-menu-mode-map.")
|
||||
(post-handler
|
||||
:initarg :post-handler
|
||||
:initform nil
|
||||
:accessor post-handler
|
||||
:documentation
|
||||
"A function to be executed after the menu is created."))
|
||||
"Class srefactor-ui-menu ")
|
||||
|
||||
(defmacro srefactor-ui--menu (name &rest forms)
|
||||
"Show a dialog buffer with NAME, setup with FORMS."
|
||||
(declare (indent 1) (debug t))
|
||||
`(with-current-buffer (get-buffer-create ,name)
|
||||
;; Cleanup buffer
|
||||
(let ((inhibit-read-only t)
|
||||
(ol (overlay-lists)))
|
||||
(mapc 'delete-overlay (car ol))
|
||||
(mapc 'delete-overlay (cdr ol))
|
||||
(erase-buffer))
|
||||
(srefactor-ui-menu-mode)
|
||||
,@forms
|
||||
(widget-setup)
|
||||
(switch-to-buffer (current-buffer))
|
||||
(hl-line-mode 1)))
|
||||
|
||||
(defun srefactor-ui-create-menu (menu)
|
||||
(interactive)
|
||||
(unless (items menu)
|
||||
(error "No available action."))
|
||||
(setq srefactor-ui--current-active-window (car (window-list)))
|
||||
(setq srefactor-ui--current-active-menu menu)
|
||||
(if (region-active-p)
|
||||
(progn
|
||||
(setq srefactor-ui--current-active-region-start (region-beginning))
|
||||
(setq srefactor-ui--current-active-region-end (region-end)))
|
||||
(setq srefactor-ui--current-active-region-start nil)
|
||||
(setq srefactor-ui--current-active-region-end nil))
|
||||
(condition-case nil
|
||||
(with-selected-window (select-window (split-window-below))
|
||||
(srefactor-ui--menu
|
||||
(or (name srefactor-ui--current-active-menu)
|
||||
(format "*%s*" "*Srefactor Menu*"))
|
||||
(let ((major-mode 'c++-mode))
|
||||
(widget-insert (if (context srefactor-ui--current-active-menu)
|
||||
(concat (semantic-format-tag-summarize (context srefactor-ui--current-active-menu) nil t) "\n")
|
||||
"")
|
||||
(if srefactor-ui-menu-show-help
|
||||
(concat (if (shortcut-p srefactor-ui--current-active-menu)
|
||||
(concat "Press "
|
||||
(propertize "1-9" 'face 'font-lock-preprocessor-face)
|
||||
" or click on an action to execute.\n")
|
||||
"Click on an action to execute.\n")
|
||||
"Press "
|
||||
(propertize "o" 'face 'bold)
|
||||
" or "
|
||||
(propertize "O" 'face 'bold)
|
||||
" to switch to next/previous option."
|
||||
"\n"
|
||||
"Click on "
|
||||
(propertize "[Cancel]" 'face 'bold)
|
||||
" or press "
|
||||
(propertize "q" 'face 'bold)
|
||||
" to quit.\n")
|
||||
"")))
|
||||
(apply 'widget-create
|
||||
`(group
|
||||
:indent 2
|
||||
:format "\n%v\n"
|
||||
,@(srefactor-ui--generate-items
|
||||
(items srefactor-ui--current-active-menu)
|
||||
(action srefactor-ui--current-active-menu)
|
||||
(shortcut-p srefactor-ui--current-active-menu))))
|
||||
(widget-create
|
||||
'push-button
|
||||
:notify 'srefactor-ui--menu-quit
|
||||
(propertize "Cancel" 'face 'bold))
|
||||
(recentf-dialog-goto-first 'link)
|
||||
(when (post-handler menu)
|
||||
(funcall (post-handler menu)))
|
||||
(when (keymap menu)
|
||||
(funcall (keymap menu))))
|
||||
(fit-window-to-buffer (car (window-list))
|
||||
(/ (* (frame-height) 50)
|
||||
100)
|
||||
(/ (* (frame-height) 10)
|
||||
100))
|
||||
(when (and (fboundp 'evil-mode)
|
||||
evil-mode)
|
||||
(evil-local-mode)))
|
||||
(error (srefactor-ui--clean-up-menu-window)
|
||||
(message "Error when creating menu."))))
|
||||
|
||||
(defun srefactor-ui--return-option-list (type)
|
||||
(let (options)
|
||||
(cond
|
||||
((eq type 'file)
|
||||
(push "(Current file)" options)
|
||||
(push "(Other file)" options)
|
||||
(when (featurep 'projectile)
|
||||
(push "(Project file)" options))
|
||||
(push "(File)" options))
|
||||
((eq type 'tag)
|
||||
'("(Before)" "(Inside)" "(After)"))
|
||||
(t))))
|
||||
|
||||
(defun srefactor-ui--generate-items (commands action &optional add-shortcut)
|
||||
"Return a list of widgets to display FILES in a dialog buffer."
|
||||
(mapcar (lambda (w)
|
||||
(srefactor-ui--create-menu-widget w action))
|
||||
(if add-shortcut
|
||||
(srefactor-ui--show-digit-shortcut (mapcar 'srefactor-ui--make-default-menu-element
|
||||
commands))
|
||||
(mapcar 'srefactor-ui--make-default-menu-element
|
||||
commands))))
|
||||
|
||||
(defun srefactor-ui--show-digit-shortcut (l)
|
||||
"Filter the list of menu-elements L to show digit shortcuts."
|
||||
(let ((i 0))
|
||||
(dolist (e l)
|
||||
(setq i (1+ i))
|
||||
(setcar e (format (if (< i 10)
|
||||
"[%s] %s"
|
||||
" %s %s")
|
||||
(if (< i 10 )
|
||||
(propertize (number-to-string (% i 10))
|
||||
'face 'font-lock-preprocessor-face
|
||||
'mouse-face 'italic)
|
||||
" ")
|
||||
(srefactor-ui--menu-label e))))
|
||||
l))
|
||||
|
||||
(defun srefactor-ui--make-default-menu-element (command)
|
||||
(srefactor-ui--make-menu-element (srefactor-ui--menu-label command)
|
||||
(srefactor-ui--menu-value-item command)))
|
||||
|
||||
(defun srefactor-ui--create-menu-widget (menu-element action)
|
||||
"Return a widget to display MENU-ELEMENT in a dialog buffer."
|
||||
`(link :tag ,(srefactor-ui--menu-label menu-element)
|
||||
:button-prefix ""
|
||||
:button-suffix ""
|
||||
:button-face nil
|
||||
:format "%[%t\n%]"
|
||||
:help-echo ""
|
||||
:action ,action
|
||||
,(srefactor-ui--menu-value-item menu-element)))
|
||||
|
||||
(defun srefactor-ui--clean-up-menu-window (&optional kill-buffer)
|
||||
(interactive)
|
||||
(when kill-buffer
|
||||
(kill-buffer (current-buffer)))
|
||||
(delete-window (car (window-list)))
|
||||
(select-window srefactor-ui--current-active-window)
|
||||
(when (and srefactor-ui--current-active-region-start
|
||||
srefactor-ui--current-active-region-end)
|
||||
(goto-char srefactor-ui--current-active-region-start)
|
||||
(set-mark-command nil)
|
||||
(goto-char srefactor-ui--current-active-region-end)
|
||||
(setq deactivate-mark nil))
|
||||
(when srefactor-ui--current-active-tag-overlay
|
||||
(delete-overlay srefactor-ui--current-active-tag-overlay)))
|
||||
|
||||
(defun srefactor-ui--refactor-action (widget &rest _ignore)
|
||||
"Open the file stored in WIDGET's value when notified.
|
||||
-IGNORE other arguments."
|
||||
(interactive)
|
||||
(srefactor-ui--clean-up-menu-window t)
|
||||
(srefactor--refactor-based-on-tag-class (car (widget-value widget))
|
||||
(srefactor-ui--get-current-menu-option (widget-get widget :tag))))
|
||||
|
||||
(defun srefactor-ui--tag-action (widget &rest _ignore)
|
||||
(interactive)
|
||||
(srefactor-ui--clean-up-menu-window t)
|
||||
(srefactor--insert-tag (context srefactor-ui--current-active-menu)
|
||||
(car (widget-value widget))
|
||||
srefactor-ui--func-type
|
||||
(srefactor-ui--get-current-menu-option (widget-get widget :tag))))
|
||||
|
||||
(defun srefactor-ui--menu-quit (&rest ignored)
|
||||
(interactive)
|
||||
(srefactor-ui--clean-up-menu-window t))
|
||||
|
||||
(defvar srefactor-ui--shortcuts-keymap
|
||||
(let ((km (make-sparse-keymap)))
|
||||
(dolist (k '(9 8 7 6 5 4 3 2 1))
|
||||
(let ((cmd (srefactor-ui--digit-shortcut-command-name k)))
|
||||
;; Define a shortcut command.
|
||||
(defalias cmd
|
||||
`(lambda ()
|
||||
(interactive)
|
||||
(unless (search-forward (number-to-string ,k) nil t)
|
||||
(search-backward (number-to-string ,k)) nil t)
|
||||
(srefactor-ui--refactor-action (get-char-property (point) 'button))))
|
||||
;; Bind it to a digit key.
|
||||
(define-key km (vector (+ k ?0)) cmd)))
|
||||
km)
|
||||
"Digit shortcuts keymap.")
|
||||
|
||||
(defun srefactor-ui--previous-page-target-window ()
|
||||
(interactive)
|
||||
(let ((menu-window (car (window-list))))
|
||||
(select-window srefactor-ui--current-active-window)
|
||||
(condition-case nil
|
||||
(scroll-down)
|
||||
(error nil))
|
||||
(select-window menu-window)))
|
||||
|
||||
(defun srefactor-ui--next-page-target-window ()
|
||||
(interactive)
|
||||
(let ((menu-window (car (window-list))))
|
||||
(select-window srefactor-ui--current-active-window)
|
||||
(condition-case nil
|
||||
(scroll-up)
|
||||
(error nil))
|
||||
(select-window menu-window)))
|
||||
|
||||
(defun srefactor-ui--cycle-option (direction current-option options)
|
||||
(let* ((options options)
|
||||
(pos (position current-option options :test #'string-equal))
|
||||
(l (length options)))
|
||||
(if (eq direction 'next)
|
||||
(if (< pos (1- l))
|
||||
(nth (1+ pos) options)
|
||||
(car options))
|
||||
(if (> pos 0)
|
||||
(nth (1- pos) options)
|
||||
(nth (1- l) options)))))
|
||||
|
||||
(defun srefactor-ui--get-current-menu-option (menu-string)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(string-match "(\\(.*\\))" menu-string)
|
||||
(match-string 0 menu-string))
|
||||
(error nil)))
|
||||
|
||||
(defun srefactor-ui--cycle (direction)
|
||||
(let* ((pos (point))
|
||||
(link (get-char-property pos 'button))
|
||||
(current-opt (srefactor-ui--get-current-menu-option (widget-get link :tag)))
|
||||
(options (cadr (widget-value-value-get link)))
|
||||
(check (unless current-opt (throw 'option-not-available "No option is available for this tag.")))
|
||||
(next-opt (srefactor-ui--cycle-option direction current-opt options))
|
||||
(next-tag (replace-regexp-in-string "(\\(.*\\))" "" (widget-get link :tag))))
|
||||
(when link
|
||||
(widget-put link :tag (concat next-tag next-opt))
|
||||
(widget-delete (get-char-property pos 'button))
|
||||
(widget-create link)
|
||||
(forward-line -1)
|
||||
(widget-forward 1))))
|
||||
|
||||
(defvar srefactor-ui-menu-mode-map
|
||||
(let ((km (copy-keymap srefactor-ui--shortcuts-keymap)))
|
||||
(set-keymap-parent km widget-keymap)
|
||||
(define-key km "q" 'srefactor-ui--menu-quit)
|
||||
(define-key km "n" 'widget-forward)
|
||||
(define-key km "p" 'widget-backward)
|
||||
(define-key km "j" 'widget-forward)
|
||||
(define-key km "k" 'widget-backward)
|
||||
(define-key km (kbd "TAB") (lambda ()
|
||||
(interactive)
|
||||
(when (persistent-action srefactor-ui--current-active-menu)
|
||||
(funcall (persistent-action srefactor-ui--current-active-menu)))))
|
||||
(define-key km "o" (lambda ()
|
||||
(interactive)
|
||||
(message "%s"
|
||||
(catch 'option-not-available
|
||||
(srefactor-ui--cycle 'next)))))
|
||||
(define-key km "O" (lambda ()
|
||||
(interactive)
|
||||
(message "%s"
|
||||
(catch 'option-not-available
|
||||
(srefactor-ui--cycle 'prev)))))
|
||||
(define-key km (kbd "M-<next>") 'srefactor-ui--next-page-target-window)
|
||||
(define-key km (kbd "M-<prior>") 'srefactor-ui--previous-page-target-window)
|
||||
(when (featurep 'evil)
|
||||
(define-key km (kbd "/") 'evil-search-forward)
|
||||
(define-key km (kbd "?") 'evil-search-backward))
|
||||
(define-key km (kbd "C-g") 'srefactor-ui--menu-quit)
|
||||
(define-key km [follow-link] "\C-m")
|
||||
km)
|
||||
"Keymap used in recentf dialogs.")
|
||||
|
||||
(define-derived-mode srefactor-ui-menu-mode nil "srefactor-ui-menu"
|
||||
"Major mode of recentf dialogs.
|
||||
"
|
||||
:syntax-table nil
|
||||
:abbrev-table nil
|
||||
(setq truncate-lines t))
|
||||
|
||||
(provide 'srefactor-ui)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; srefactor-ui.el ends here
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
1667
lisp/srefactor/srefactor.el
Normal file
1667
lisp/srefactor/srefactor.el
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user