| commit | author | age | ||
| 5cb5f7 | 1 | ;;; Srefactor --- A refactoring tool based on Semantic parser framework |
| C | 2 | ;; |
| 3 | ;; Filename: srefactor-lisp.el | |
| 4 | ;; Description: A refactoring tool based on Semantic parser framework | |
| 5 | ;; Author: Tu, Do Hoang <tuhdo1710@gmail.com> | |
| 6 | ;; URL : https://github.com/tuhdo/semantic-refactor | |
| 7 | ;; Maintainer: Tu, Do Hoang | |
| 8 | ;; Created: Wed Feb 11 21:25:51 2015 (+0700) | |
| 9 | ;; Version: 0.3 | |
| 10 | ;; Package-Requires: ((emacs "24.3+")) | |
| 11 | ;; Last-Updated: Wed Feb 11 21:25:51 2015 (+0700) | |
| 12 | ;; By: Tu, Do Hoang | |
| 13 | ;; Update #: 1 | |
| 14 | ;; URL: | |
| 15 | ;; Doc URL: | |
| 16 | ;; Keywords: emacs-lisp, languages, tools | |
| 17 | ;; Compatibility: GNU Emacs: 24.3+ | |
| 18 | ;; | |
| 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 20 | ;; | |
| 21 | ;;; Commentary: | |
| 22 | ;; | |
| 23 | ;; Semantic is a package that provides a framework for writing | |
| 24 | ;; parsers. Parsing is a process of analyzing source code based on | |
| 25 | ;; programming language syntax. This package relies on Semantic for | |
| 26 | ;; analyzing source code and uses its results to perform smart code | |
| 27 | ;; refactoring that based on code structure of the analyzed language, | |
| 28 | ;; instead of plain text structure. | |
| 29 | ;; | |
| 30 | ;; This package provides the following features for Emacs Lisp: | |
| 31 | ;; | |
| 32 | ;; - `srefactor-lisp-format-buffer': Format whole buffer. | |
| 33 | ;; - `srefactor-lisp-format-defun': Format the current defun point is in. | |
| 34 | ;; - `srefactor-lisp-one-line': Transform all sub-sexpressions current sexpression at | |
| 35 | ;; point into one line separated each one by a space. | |
| 36 | ;; | |
| 37 | ;; - `srefactor-lisp-format-sexp': Transform all sub-sexpressions current sexpression | |
| 38 | ;; at point into multiple lines separated. If the head symbol belongs to the | |
| 39 | ;; list `srefactor-lisp-symbol-to-skip', then the first N next symbol/sexpressions | |
| 40 | ;; (where N is the nummber associated with the head symbol as stated in the | |
| 41 | ;; list) are skipped before a newline is inserted. | |
| 42 | ;; | |
| 43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 44 | ;; | |
| 45 | ;; This program is free software: you can redistribute it and/or modify | |
| 46 | ;; it under the terms of the GNU General Public License as published by | |
| 47 | ;; the Free Software Foundation, either version 3 of the License, or (at | |
| 48 | ;; your option) any later version. | |
| 49 | ;; | |
| 50 | ;; This program is distributed in the hope that it will be useful, but | |
| 51 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 52 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 53 | ;; General Public License for more details. | |
| 54 | ;; | |
| 55 | ;; You should have received a copy of the GNU General Public License | |
| 56 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
| 57 | ;; | |
| 58 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 59 | ;; | |
| 60 | ;;; Code: | |
| 61 | (require 'semantic/bovine/el) | |
| 62 | ||
| 63 | (defcustom srefactor-newline-threshold 40 | |
| 64 | "If a token is about to be inserted, if the current posistion | |
| 65 | exceeds this threshold characters, insert the token in the next | |
| 66 | line isntead. Note that this does not account for indentation | |
| 67 | but the total number of characters in a line." | |
| 68 | :group 'srefactor) | |
| 69 | ||
| 70 | (defcustom srefactor-lisp-symbol-to-skip '(("progn" . 0) | |
| 71 | ("cond" . 0) | |
| 72 | ("save-excursion" . 0) | |
| 73 | ("unwind-protect" . 0) | |
| 74 | ("with-temp-buffer" . 0) | |
| 75 | ;; ("condition-case" . 1) | |
| 76 | ;; ("with-current-buffer" . 1) | |
| 77 | ;; ("with-open-file" . 1) | |
| 78 | ;; ("let" . 1) | |
| 79 | ;; ("let*" . 1) | |
| 80 | ;; ("if" . 1) | |
| 81 | ;; ("while" . 1) | |
| 82 | ;; ("dolist" . 1) | |
| 83 | ;; ("do" . 1) | |
| 84 | ;; ("when" . 1) | |
| 85 | ;; ("buffer-substring-no-properties" . 1) | |
| 86 | ;; ("unless" . 1) | |
| 87 | ;; ("not" . 1) | |
| 88 | ;; ("null" . 1) | |
| 89 | ;; ("null?" . 1) | |
| 90 | ;; ("concat" . 1) | |
| 91 | ;; ("or" . 1) | |
| 92 | ;; ("and" . 1) | |
| 93 | ;; ("catch" . 1) | |
| 94 | ;; ("mapcar" . 1) | |
| 95 | ;; ("mapcan" . 1) | |
| 96 | ;; ("mapc" . 1) | |
| 97 | ;; ("+" . 1) | |
| 98 | ;; ("-" . 1) | |
| 99 | ;; ("*" . 1) | |
| 100 | ;; ("/" . 1) | |
| 101 | ;; ("error" . 1) | |
| 102 | ;; ("goto-char" . 1) | |
| 103 | ;; ("insert" . 1) | |
| 104 | ;; ("car" . 1) | |
| 105 | ;; ("cdr" . 1) | |
| 106 | ;; ("lambda" . 1) | |
| 107 | ;; ("1+" . 1) | |
| 108 | ;; ("1-" . 1) | |
| 109 | ("defmethod" . 1) | |
| 110 | ("cons" . 2) | |
| 111 | ("kill-region" . 2) | |
| 112 | ("equal" . 2) | |
| 113 | ("member" . 2) | |
| 114 | ("eq?" . 2) | |
| 115 | ("eq" . 2) | |
| 116 | ("get" . 2) | |
| 117 | ("assoc" . 2) | |
| 118 | ("defun" . 2) | |
| 119 | ("defclass" . 2) | |
| 120 | ("defstruct" . 2) | |
| 121 | ("defmacro" . 2) | |
| 122 | ("defsubst" . 2) | |
| 123 | ("defface" . 2) | |
| 124 | ("defalias" . 2) | |
| 125 | ("defcustom" . 2) | |
| 126 | ("declare" . 2) | |
| 127 | ("defvar" . 2) | |
| 128 | ("defparameter" . 2) | |
| 129 | ("defconst" . 2) | |
| 130 | ("string-match" . 2) | |
| 131 | ("defcustom" . 2) | |
| 132 | ("setq" . 2) | |
| 133 | ("setq-default" . 2) | |
| 134 | ("member" . 2) | |
| 135 | ("setf" . 2) | |
| 136 | (">" . 2) | |
| 137 | ("<" . 2) | |
| 138 | ("<=" . 2) | |
| 139 | (">=" . 2) | |
| 140 | ("/=" . 2) | |
| 141 | ("=" . 2) | |
| 142 | ("some" . 2) | |
| 143 | ("define-key" . 3) | |
| 144 | ("modify-syntax-entry" . 3)) | |
| 145 | "A list of pairs of a symbol and a number that denotes how many | |
| 146 | sexp to skip before inserting the first newline. " | |
| 147 | :group 'srefactor) | |
| 148 | ||
| 149 | (defcustom srefactor-clojure-symbol-to-skip '(("fn" . 1) | |
| 150 | ("ns" . 1) | |
| 151 | (":require" . 1) | |
| 152 | (":import" . 1) | |
| 153 | ("def" . 2) | |
| 154 | ("struct-map" . 1) | |
| 155 | ("defmacro" . 1) | |
| 156 | ("binding" . 1) | |
| 157 | ("with-bindings" . 1) | |
| 158 | ("doseq" . 1) | |
| 159 | ("catch" . 2) | |
| 160 | ("defn" . 2)) | |
| 161 | "A list of pairs of a symbol and a number that denotes how many | |
| 162 | sexp to skip before inserting a newline. This will be merged | |
| 163 | with `srefactor-lisp-symbol-to-skip'. Symbols in this list | |
| 164 | overrides symbols in `srefactor-lisp-symbol-to-skip'." | |
| 165 | :group 'srefactor) | |
| 166 | ||
| 167 | ;; Internal variables of parser state | |
| 168 | (defvar token nil) | |
| 169 | (defvar token-type nil) | |
| 170 | (defvar token-str nil) | |
| 171 | (defvar ignore-num nil) | |
| 172 | (defvar tok-start nil) | |
| 173 | (defvar next-token nil) | |
| 174 | (defvar next-token-start nil) | |
| 175 | (defvar next-token-end nil) | |
| 176 | (defvar next-token-type nil) | |
| 177 | (defvar next-token-str nil) | |
| 178 | (defvar tok-end nil) | |
| 179 | (defvar cur-buf nil) | |
| 180 | (defvar first-token nil) | |
| 181 | (defvar first-token-name nil) | |
| 182 | (defvar second-token nil) | |
| 183 | (defvar lexemes nil) | |
| 184 | (defvar comment-token nil) | |
| 185 | (defvar comment-content nil) | |
| 186 | (defvar token-real-line nil) | |
| 187 | (defvar next-token-real-line nil) | |
| 188 | (defvar comment-real-line-start nil) | |
| 189 | (defvar comment-real-line-end nil) | |
| 190 | (defvar comment-token-start nil) | |
| 191 | (defvar comment-token-end nil) | |
| 192 | (defvar format-type nil) | |
| 193 | (defvar recursive-p nil) | |
| 194 | (defvar orig-format-type nil) | |
| 195 | ||
| 196 | ||
| 197 | (defun srefactor--appropriate-major-mode (major-mode) | |
| 198 | (cond | |
| 199 | ((eq major-mode 'emacs-lisp-mode) | |
| 200 | (emacs-lisp-mode)) | |
| 201 | ((eq major-mode 'scheme-mode) | |
| 202 | (scheme-mode)) | |
| 203 | ((eq major-mode 'common-lisp-mode) | |
| 204 | (common-lisp-mode)) | |
| 205 | ((and (fboundp 'clojure-mode) | |
| 206 | (eq major-mode 'clojure-mode)) | |
| 207 | (clojure-mode)) | |
| 208 | (t (emacs-lisp-mode)))) | |
| 209 | ||
| 210 | (defun srefactor--define-skip-list-for-mode (major-mode) | |
| 211 | (cond | |
| 212 | ((and (fboundp 'clojure-mode) | |
| 213 | (eq major-mode 'clojure-mode)) | |
| 214 | (cl-remove-duplicates (append srefactor-lisp-symbol-to-skip srefactor-clojure-symbol-to-skip) | |
| 215 | :test (lambda (a b) | |
| 216 | (equal (car a) (car b))))) | |
| 217 | (t srefactor-lisp-symbol-to-skip))) | |
| 218 | ||
| 219 | (defun srefactor-lisp-format-buffer () | |
| 220 | "Format current buffer." | |
| 221 | (interactive) | |
| 222 | (let ((cur-pos (point)) | |
| 223 | (buf-content (buffer-substring-no-properties (point-min) | |
| 224 | (point-max))) | |
| 225 | (cur-major-mode major-mode) | |
| 226 | (orig-skip-list srefactor-lisp-symbol-to-skip) | |
| 227 | (cur-indent-mode indent-tabs-mode)) | |
| 228 | (setq buf-content (with-temp-buffer | |
| 229 | (semantic-default-elisp-setup) | |
| 230 | (emacs-lisp-mode) | |
| 231 | (setq indent-tabs-mode cur-indent-mode) | |
| 232 | (setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode)) | |
| 233 | (semantic-lex-init) | |
| 234 | (insert buf-content) | |
| 235 | (goto-char (point-max)) | |
| 236 | (while (beginning-of-defun-raw) | |
| 237 | (let ((beg (point)) | |
| 238 | (end (save-excursion | |
| 239 | (forward-sexp) | |
| 240 | (point)))) | |
| 241 | (srefactor--lisp-format-one-or-multi-lines | |
| 242 | beg end beg 'multi-line nil t) | |
| 243 | (goto-char beg))) | |
| 244 | (srefactor--appropriate-major-mode cur-major-mode) | |
| 245 | (indent-region (point-min) | |
| 246 | (point-max)) | |
| 247 | (setq srefactor-lisp-symbol-to-skip orig-skip-list) | |
| 248 | (buffer-substring-no-properties (point-min) | |
| 249 | (point-max)))) | |
| 250 | (kill-region (point-min) (point-max)) | |
| 251 | (insert buf-content) | |
| 252 | (goto-char cur-pos))) | |
| 253 | ||
| 254 | (defun srefactor-lisp-format-defun () | |
| 255 | "Format current defun point is in." | |
| 256 | (interactive) | |
| 257 | (let* ((orig-point (point)) | |
| 258 | (beg (save-excursion | |
| 259 | (forward-char 1) | |
| 260 | (beginning-of-defun-raw) | |
| 261 | (point))) | |
| 262 | (end (save-excursion | |
| 263 | (goto-char beg) | |
| 264 | (forward-sexp) | |
| 265 | (point))) | |
| 266 | (orig-skip-list srefactor-lisp-symbol-to-skip) | |
| 267 | (cur-indent-mode indent-tabs-mode) | |
| 268 | (cur-major-mode major-mode) | |
| 269 | (content (buffer-substring-no-properties beg end))) | |
| 270 | (progn | |
| 271 | (setq content (with-temp-buffer | |
| 272 | (semantic-default-elisp-setup) | |
| 273 | (emacs-lisp-mode) | |
| 274 | (setq indent-tabs-mode cur-indent-mode) | |
| 275 | (setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode)) | |
| 276 | (semantic-lex-init) | |
| 277 | (insert content) | |
| 278 | (srefactor--lisp-format-one-or-multi-lines (point-min) | |
| 279 | (point-max) | |
| 280 | (point-min)'multi-line | |
| 281 | nil | |
| 282 | t) | |
| 283 | (srefactor--appropriate-major-mode cur-major-mode) | |
| 284 | (setq srefactor-lisp-symbol-to-skip orig-skip-list) | |
| 285 | (indent-region (point-min) | |
| 286 | (point-max)) | |
| 287 | (buffer-substring-no-properties (point-min) | |
| 288 | (point-max)))) | |
| 289 | (kill-region beg end) | |
| 290 | (insert content) | |
| 291 | (goto-char orig-point)))) | |
| 292 | ||
| 293 | (defun srefactor-lisp-format-sexp () | |
| 294 | "Transform all sub-sexpressions current sexpression at point | |
| 295 | into multiple lines separatedly. If the head symbol belongs to the | |
| 296 | list `srefactor-lisp-symbol-to-skip', then the first N next | |
| 297 | symbol/sexpressions (where N is the nummber associated with the | |
| 298 | head symbol as stated in the list) are skipped before a newline | |
| 299 | is inserted." | |
| 300 | (interactive) | |
| 301 | (let* ((orig-point (point)) | |
| 302 | (beg (save-excursion | |
| 303 | (unless (looking-at "[({[]") | |
| 304 | (backward-up-list)) | |
| 305 | (point))) | |
| 306 | (end (save-excursion | |
| 307 | (goto-char beg) | |
| 308 | (forward-sexp) | |
| 309 | (point))) | |
| 310 | (orig-skip-list srefactor-lisp-symbol-to-skip) | |
| 311 | (cur-indent-mode indent-tabs-mode) | |
| 312 | (cur-major-mode major-mode) | |
| 313 | (content (buffer-substring-no-properties beg end))) | |
| 314 | (progn | |
| 315 | (setq content (with-temp-buffer | |
| 316 | (semantic-default-elisp-setup) | |
| 317 | (emacs-lisp-mode) | |
| 318 | (setq indent-tabs-mode cur-indent-mode) | |
| 319 | (setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode)) | |
| 320 | (semantic-lex-init) | |
| 321 | (insert content) | |
| 322 | (srefactor--lisp-format-one-or-multi-lines (point-min) | |
| 323 | (point-max) | |
| 324 | (point-min)'multi-line | |
| 325 | nil | |
| 326 | t) | |
| 327 | (srefactor--appropriate-major-mode cur-major-mode) | |
| 328 | (setq srefactor-lisp-symbol-to-skip orig-skip-list) | |
| 329 | (buffer-substring-no-properties (point-min) | |
| 330 | (point-max)))) | |
| 331 | (kill-region beg end) | |
| 332 | (insert content) | |
| 333 | (goto-char beg) | |
| 334 | (forward-sexp) | |
| 335 | (setq end (point)) | |
| 336 | (indent-region beg end) | |
| 337 | (goto-char orig-point)))) | |
| 338 | ||
| 339 | (defun srefactor-lisp-one-line (recursive-p) | |
| 340 | "Transform all sub-sexpressions current sexpression at point | |
| 341 | into one line separated each one by a space." | |
| 342 | (interactive "P") | |
| 343 | (let* ((orig-point (point)) | |
| 344 | (beg (save-excursion | |
| 345 | (unless (looking-at "[({[]") | |
| 346 | (backward-up-list)) | |
| 347 | (point))) | |
| 348 | (end (save-excursion | |
| 349 | (goto-char beg) | |
| 350 | (forward-sexp) | |
| 351 | (point))) | |
| 352 | (orig-skip-list srefactor-lisp-symbol-to-skip) | |
| 353 | (cur-indent-mode indent-tabs-mode) | |
| 354 | (cur-major-mode major-mode) | |
| 355 | (content (buffer-substring-no-properties beg end))) | |
| 356 | (progn | |
| 357 | (setq content (with-temp-buffer | |
| 358 | (semantic-default-elisp-setup) | |
| 359 | (emacs-lisp-mode) | |
| 360 | (setq indent-tabs-mode cur-indent-mode) | |
| 361 | (setq srefactor-lisp-symbol-to-skip (srefactor--define-skip-list-for-mode cur-major-mode)) | |
| 362 | (semantic-lex-init) | |
| 363 | (insert content) | |
| 364 | (srefactor--lisp-format-one-or-multi-lines (point-min) | |
| 365 | (point-max) | |
| 366 | (point-min)'one-line | |
| 367 | nil | |
| 368 | recursive-p) | |
| 369 | (srefactor--appropriate-major-mode cur-major-mode) | |
| 370 | (setq srefactor-lisp-symbol-to-skip orig-skip-list) | |
| 371 | (indent-region (point-min) | |
| 372 | (point-max)) | |
| 373 | (buffer-substring-no-properties (point-min) | |
| 374 | (point-max)))) | |
| 375 | (kill-region beg end) | |
| 376 | (insert content) | |
| 377 | (goto-char orig-point)))) | |
| 378 | ||
| 379 | (defun srefactor--lisp-format-one-or-multi-lines (beg end orig-point format-type &optional | |
| 380 | newline-betwen-semantic-lists recursive-p) | |
| 381 | "Turn the current sexpression into one line/multi-line depends | |
| 382 | on the value of FORMAT-TYPE. If FORMAT-TYPE is 'one-line, | |
| 383 | transforms all sub-sexpressions of the same level into one | |
| 384 | line. If FORMAT-TYPE is 'multi-line, transforms all | |
| 385 | sub-sexpressions of the same level into multiple lines. | |
| 386 | ||
| 387 | Return the position of last closing sexp." | |
| 388 | (let* ((lexemes (semantic-emacs-lisp-lexer beg end 1)) | |
| 389 | (cur-buf (current-buffer)) | |
| 390 | (first-token (cadr lexemes)) | |
| 391 | (first-token-name (srefactor--lisp-token-text first-token)) | |
| 392 | (second-token (caddr lexemes)) | |
| 393 | (tmp-buf (generate-new-buffer (make-temp-name ""))) | |
| 394 | (orig-format-type format-type) | |
| 395 | token-str | |
| 396 | ignore-pair | |
| 397 | ignore-num | |
| 398 | token) | |
| 399 | (unwind-protect | |
| 400 | (progn | |
| 401 | (unless (assoc 'semantic-list lexemes) | |
| 402 | (setq format-type 'one-line)) | |
| 403 | (if (or (eq (car first-token) 'semantic-list) | |
| 404 | (assoc first-token-name srefactor-lisp-symbol-to-skip)) | |
| 405 | (setq newline-betwen-semantic-lists t)) | |
| 406 | (setq ignore-pair (assoc first-token-name srefactor-lisp-symbol-to-skip)) | |
| 407 | (setq ignore-num (cdr ignore-pair)) | |
| 408 | (while lexemes | |
| 409 | (let* (token-type tok-start tok-end next-token next-token-start | |
| 410 | next-token-type next-token-str) | |
| 411 | (srefactor--lisp-forward-token) | |
| 412 | (with-current-buffer tmp-buf | |
| 413 | (insert token-str) | |
| 414 | (srefactor--lisp-comment-formatter) | |
| 415 | (cond | |
| 416 | ((and (eq token-type 'number) | |
| 417 | (member next-token-str '("+" "-" "*" "/"))) | |
| 418 | (srefactor--lisp-number-formatter)) | |
| 419 | ((or (eq token-type 'punctuation) | |
| 420 | (eq token-type 'open-paren) | |
| 421 | (eq token-type 'close-paren) | |
| 422 | (eq next-token-type 'close-paren)) | |
| 423 | (srefactor--lisp-punctuation-formatter)) | |
| 424 | ((eq token-type 'symbol) | |
| 425 | (srefactor--lisp-symbol-formatter)) | |
| 426 | ((eq format-type 'one-line) | |
| 427 | (srefactor--lisp-oneline-formatter)) | |
| 428 | ((eq format-type 'multi-line) | |
| 429 | (srefactor--lisp-multiline-formatter)))))) | |
| 430 | (kill-region beg end) | |
| 431 | (setq beg (point)) | |
| 432 | (insert (with-current-buffer tmp-buf | |
| 433 | (buffer-substring-no-properties (point-min) | |
| 434 | (point-max)))) | |
| 435 | (setq end (point)) | |
| 436 | ;; descend into sub-sexpressions | |
| 437 | (setq lexemes (semantic-emacs-lisp-lexer beg end 1)) | |
| 438 | (when recursive-p | |
| 439 | (srefactor--lisp-visit-semantic-list-lex (nreverse lexemes)))) | |
| 440 | (kill-buffer tmp-buf)))) | |
| 441 | ||
| 442 | (defun srefactor--lisp-number-formatter () | |
| 443 | "Make use of dynamic scope of its parent | |
| 444 | function `srefactor--lisp-format-one-or-multi-lines'" | |
| 445 | (goto-char (semantic-lex-token-end token)) | |
| 446 | (insert next-token-str) | |
| 447 | (srefactor--lisp-comment-formatter) | |
| 448 | (insert " ") | |
| 449 | (setq first-token (semantic-lex-token 'symbol | |
| 450 | (semantic-lex-token-start token) | |
| 451 | (1+ (semantic-lex-token-end token)))) | |
| 452 | (setq first-token-name (concat token-str next-token-str)) | |
| 453 | (setq second-token (cadr lexemes)) | |
| 454 | (srefactor--lisp-forward-token)) | |
| 455 | ||
| 456 | (defun srefactor--lisp-punctuation-formatter () | |
| 457 | "Make use of dynamic scope of its parent | |
| 458 | function `srefactor--lisp-format-one-or-multi-lines'" | |
| 459 | (let ((orig-token token) | |
| 460 | token | |
| 461 | token-str) | |
| 462 | (while (srefactor--lisp-token-in-punctuation-p (srefactor--lisp-forward-token)) | |
| 463 | (insert token-str) | |
| 464 | (srefactor--lisp-comment-formatter)) | |
| 465 | (when (eq first-token-name (srefactor--lisp-token-text orig-token)) | |
| 466 | (srefactor--lisp-forward-first-second-token)) | |
| 467 | (when token | |
| 468 | (push token lexemes)))) | |
| 469 | ||
| 470 | (defun srefactor--lisp-symbol-formatter () | |
| 471 | "Insert additional text based on symbol appearance. Make use of | |
| 472 | dynamic scope of its parent function `srefactor--lisp-format-one-or-multi-lines'" | |
| 473 | (cond | |
| 474 | ((and (not (equal token-str first-token-name)) | |
| 475 | (eq orig-format-type 'multi-line) | |
| 476 | (string-match ":.*" token-str)) | |
| 477 | (insert " ") | |
| 478 | (srefactor--lisp-forward-token) | |
| 479 | (while (member token-type '(punctuation open-paren semantic-list)) | |
| 480 | (insert token-str) | |
| 481 | (srefactor--lisp-forward-token)) | |
| 482 | (insert token-str) | |
| 483 | (cond | |
| 484 | ((or (equal next-token-str "}")) | |
| 485 | (insert next-token-str "\n" " ") | |
| 486 | (srefactor--lisp-comment-formatter) | |
| 487 | (srefactor--lisp-forward-token)) | |
| 488 | ((not (or (srefactor--lisp-token-in-punctuation-p next-token) | |
| 489 | (null next-token))) | |
| 490 | (insert "\n")) | |
| 491 | (t))) | |
| 492 | ((member token-str '("~@" "?")) "") | |
| 493 | ((string-equal token-str ".") (insert " ")) | |
| 494 | ((eq format-type 'one-line) | |
| 495 | (srefactor--lisp-oneline-formatter)) | |
| 496 | ((eq format-type 'multi-line) | |
| 497 | (srefactor--lisp-multiline-formatter)))) | |
| 498 | ||
| 499 | (defun srefactor--lisp-forward-first-second-token () | |
| 500 | (setq first-token token) | |
| 501 | (setq first-token-name (srefactor--lisp-token-text first-token)) | |
| 502 | (setq second-token (car lexemes))) | |
| 503 | ||
| 504 | (defun srefactor--lisp-forward-token () | |
| 505 | (setq token (pop lexemes)) | |
| 506 | (when token | |
| 507 | (setq token-type (semantic-lex-token-class token)) | |
| 508 | (setq tok-start (semantic-lex-token-start token)) | |
| 509 | (setq tok-end (semantic-lex-token-end token)) | |
| 510 | (setq token-str (srefactor--lisp-token-text token)) | |
| 511 | (setq next-token (car lexemes)) | |
| 512 | (setq next-token-type (semantic-lex-token-class next-token)) | |
| 513 | (setq next-token-start (semantic-lex-token-start next-token)) | |
| 514 | (setq next-token-end (semantic-lex-token-end next-token)) | |
| 515 | (setq next-token-str (if next-token | |
| 516 | (srefactor--lisp-token-text next-token) | |
| 517 | "")) | |
| 518 | token)) | |
| 519 | ||
| 520 | (defun srefactor--lisp-comment-formatter () | |
| 521 | (let (comment-token comment-token-start comment-token-end | |
| 522 | comment-content next-token-real-line token-real-line | |
| 523 | comment-real-line-start comment-real-line-end) | |
| 524 | (when (and tok-end next-token-start) | |
| 525 | (setq comment-token (with-current-buffer cur-buf ;; asdf | |
| 526 | (condition-case nil | |
| 527 | (car (semantic-comment-lexer tok-end next-token-start)) | |
| 528 | (error nil)))) | |
| 529 | (when comment-token | |
| 530 | (setq comment-content (with-current-buffer cur-buf | |
| 531 | ;; set values inside the buffer to avoid global variable | |
| 532 | (setq comment-token-start (semantic-lex-token-start comment-token)) | |
| 533 | (setq comment-token-end (semantic-lex-token-end comment-token)) | |
| 534 | (setq comment-real-line-start (line-number-at-pos comment-token-start)) | |
| 535 | (setq comment-real-line-end (line-number-at-pos comment-token-end)) | |
| 536 | (setq token-real-line (line-number-at-pos tok-end)) | |
| 537 | (setq next-token-real-line (line-number-at-pos next-token-start)) | |
| 538 | (buffer-substring-no-properties comment-token-start | |
| 539 | comment-token-end))) | |
| 540 | (cond | |
| 541 | ;; if comment token is next to a string, chances are it is below the | |
| 542 | ;; docstring. Add a newlien in between. | |
| 543 | ((eq token-type 'string) | |
| 544 | (insert "\n" comment-content)) | |
| 545 | ((= token-real-line comment-real-line-start) | |
| 546 | (insert " " comment-content)) | |
| 547 | ((not (= token-real-line comment-real-line-start)) | |
| 548 | (insert "\n" comment-content)) | |
| 549 | (t)) | |
| 550 | ;; If the current/next token is a punctuation (open/close paren, | |
| 551 | ;; punctuation) add a newline no matter what; otherwise it destroys the | |
| 552 | ;; layout of sexp because nonewline is inserted after the current/next | |
| 553 | ;; token and it will be in the same line with the just inserted comment | |
| 554 | ;; and be part of it, which is dangerous | |
| 555 | (when (or (srefactor--lisp-token-in-punctuation-p token) | |
| 556 | (srefactor--lisp-token-in-punctuation-p next-token) | |
| 557 | (string-match "[]}]" token-str)) | |
| 558 | (insert "\n")))))) | |
| 559 | ||
| 560 | (defun srefactor--lisp-oneline-formatter () | |
| 561 | (unless (srefactor--lisp-token-in-punctuation-p token) | |
| 562 | (let ((distance (- (point) | |
| 563 | (line-beginning-position)))) | |
| 564 | (if (or (eq orig-format-type 'one-line) | |
| 565 | (<= distance srefactor-newline-threshold)) | |
| 566 | (insert " ") | |
| 567 | (insert "\n"))))) | |
| 568 | ||
| 569 | (defun srefactor--lisp-multiline-formatter () | |
| 570 | (cond | |
| 571 | (ignore-num (when (and (equal first-token-name token-str)) | |
| 572 | (insert " ") | |
| 573 | (when (and ignore-num | |
| 574 | (= ignore-num 0)) | |
| 575 | (setq ignore-num (1- ignore-num)))) | |
| 576 | (while (> ignore-num 0) | |
| 577 | (if (srefactor--lisp-token-paren-p token) | |
| 578 | (progn | |
| 579 | (delete-char -1) | |
| 580 | (push token lexemes) | |
| 581 | (setq ignore-num 0)) | |
| 582 | (srefactor--lisp-forward-token) | |
| 583 | (insert token-str) | |
| 584 | (srefactor--lisp-comment-formatter) | |
| 585 | (if (srefactor--lisp-token-in-punctuation-p token) | |
| 586 | (srefactor--lisp-forward-first-second-token) | |
| 587 | (setq ignore-num (1- ignore-num)) | |
| 588 | (insert " ")))) | |
| 589 | (delete-char -1) | |
| 590 | (if (srefactor--lisp-token-paren-p (car lexemes)) | |
| 591 | (srefactor--lisp-punctuation-formatter) | |
| 592 | (insert "\n")) | |
| 593 | (setq ignore-num nil)) | |
| 594 | ((and (equal first-token-name token-str) | |
| 595 | (not (eq next-token-type 'semantic-list))) | |
| 596 | (insert " ")) | |
| 597 | ((and (eq next-token-type 'semantic-list) | |
| 598 | (eq token-type 'symbol) | |
| 599 | (equal first-token-name token-str)) | |
| 600 | (insert " ")) | |
| 601 | ((eq token-type 'semantic-list) | |
| 602 | (insert "\n")) | |
| 603 | ((or (null ignore-num) | |
| 604 | (= ignore-num 0)) | |
| 605 | (insert "\n")) | |
| 606 | (t (insert "\n")))) | |
| 607 | ||
| 608 | (defun srefactor--lisp-token-name-in-skip-list-p (token-name) | |
| 609 | (member token-name srefactor-lisp-symbol-to-skip)) | |
| 610 | ||
| 611 | (defun srefactor--lisp-token-in-punctuation-p (token) | |
| 612 | (member (semantic-lex-token-class token) '(open-paren charquote close-paren punctuation))) | |
| 613 | ||
| 614 | (defun srefactor--lisp-token-paren-p (token) | |
| 615 | (member (semantic-lex-token-class token) '(open-paren close-paren))) | |
| 616 | ||
| 617 | (defun srefactor--lisp-token-text (token) | |
| 618 | (if token | |
| 619 | (with-current-buffer cur-buf | |
| 620 | (buffer-substring-no-properties (semantic-lex-token-start token) | |
| 621 | (semantic-lex-token-end token))) | |
| 622 | "")) | |
| 623 | ||
| 624 | (defun srefactor--lisp-visit-semantic-list-lex (lexemes) | |
| 625 | "Visit and format all sub-sexpressions (semantic list) in LEXEMES." | |
| 626 | (dolist (token lexemes) | |
| 627 | (let ((tok-start (semantic-lex-token-start token)) | |
| 628 | (tok-end (semantic-lex-token-end token)) | |
| 629 | tok-str) | |
| 630 | (when (and (eq (car token) 'semantic-list) | |
| 631 | (> (- tok-end tok-start) 2)) | |
| 632 | (goto-char (semantic-lex-token-start token)) | |
| 633 | (srefactor--lisp-format-one-or-multi-lines tok-start | |
| 634 | tok-end | |
| 635 | tok-start | |
| 636 | format-type | |
| 637 | (assoc tok-str srefactor-lisp-symbol-to-skip) | |
| 638 | recursive-p))))) | |
| 639 | ||
| 640 | (defun srefactor--lisp-comment-debug-messages () | |
| 641 | (message "comment-token: %s" comment-token) | |
| 642 | (message "comment-start: %s" comment-token-start) | |
| 643 | (message "comment-end: %s" comment-token-end) | |
| 644 | (message "comment-content: %s" comment-content) | |
| 645 | (message "comment-content: %s" comment-content) | |
| 646 | (message "token-real-line: %s" token-real-line) | |
| 647 | (message "next-token-real-line: %s" next-token-real-line) | |
| 648 | (message "comment-real-line-start: %s" comment-real-line-start) | |
| 649 | (message "comment-real-line-end %s" comment-real-line-end)) | |
| 650 | ||
| 651 | (defun srefactor--lisp-debug-messages () | |
| 652 | (message "token: %s" token) | |
| 653 | (message "token-type: %s" token-type) | |
| 654 | (message "token-str: %s" token-str) | |
| 655 | (when ignore-num | |
| 656 | (message "ignore-num: %s" ignore-num)) | |
| 657 | (message "next-token: %s" next-token) | |
| 658 | (message "next-token-type: %s" next-token-type) | |
| 659 | (message "next-token-str: %s" next-token-str)) | |
| 660 | ||
| 661 | (provide 'srefactor-lisp) | |
