tsm.el (4613B)
1 ;;;;;; tsm-mode: Minor mode to display transient symbols in picolisp-mode. 2 ;;;;;; Version: 1.0 3 4 ;;; Copyright (c) 2009, Guillermo R. Palavecino 5 6 ;; This file is NOT part of GNU emacs. 7 8 ;;;; Contact: 9 ;; For comments, bug reports, questions, etc, you can contact me via IRC 10 ;; to the user named grpala (or armadillo) on irc.freenode.net in the 11 ;; #picolisp channel or via email to the author's nickname at gmail.com 12 ;; 13 ;;;; License: 14 ;; This work is released under the GPL 2 or (at your option) any later 15 ;; version. 16 17 (defvar tsm-face 'tsm-face) 18 19 (defface tsm-face 20 '((((class color)) 21 (:inherit font-lock-string-face :underline t) ) ) 22 "Face for displaying transient symbols in picolisp-mode" 23 :group 'faces ) 24 25 (defun tsm-revert (beg end) 26 (remove-text-properties beg end '(display "")) 27 (remove-text-properties beg end '(face tsm-face)) ) 28 29 (defvar tsm-regex "\"") 30 31 ;;; Sorry, but the following 3 function definitions are write-only for now. 32 33 (defun find-opening-dblquote () 34 (catch 'return 35 (while (re-search-forward "\\(\"\\)" (line-end-position) t) 36 (when (save-excursion 37 (and (ignore-errors (match-beginning 1)) 38 (not (progn 39 (goto-char (match-beginning 1)) 40 (picolisp-in-string-p) ) ) 41 (progn 42 (forward-char) 43 (picolisp-in-string-p) ) ) ) 44 (throw 'return (point)) ) ) 45 (backward-char) ) ) 46 47 (defun find-closing-dblquote () 48 (catch 'return 49 (while (re-search-forward "\\(\"\\)" (line-end-position) t) 50 (when (save-excursion 51 (and (ignore-errors (match-beginning 1)) 52 (progn 53 (goto-char (match-beginning 1)) 54 (picolisp-in-string-p) ) 55 (not (progn 56 (forward-char) 57 (picolisp-in-string-p) ) ) ) ) 58 (throw 'return (point)) ) ) ) ) 59 60 (defun tsm-line () 61 (while (and (find-opening-dblquote) 62 (save-excursion (find-closing-dblquote)) ) 63 (let ((opening (point)) 64 (closing (find-closing-dblquote)) ) 65 (add-text-properties (1- opening) opening '(display "")) 66 (add-text-properties (1- closing) closing '(display "")) 67 (add-text-properties (1- opening) closing '(face tsm-face)) 68 (dotimes (i (- closing opening 1)) 69 (let ((i (+ i opening))) 70 (when (and (eq 92 (char-before i)) 71 (eq 34 (char-before (1+ i))) ) 72 (add-text-properties (1- i) i '(display "")) ) ) ) ) ) ) 73 74 (defun tsm-change (beg end) 75 (save-excursion 76 (goto-char beg) 77 (while (re-search-forward "^.*\"" (save-excursion 78 (goto-char end) 79 (line-end-position) ) t ) 80 (beginning-of-line) 81 (tsm-revert (line-beginning-position) (line-end-position)) 82 (tsm-line) ) ) ) 83 84 (defvar tsm-lock 85 '(("\"" 86 (0 (when tsm-mode 87 (setq global-disable-point-adjustment t) 88 (save-excursion 89 (beginning-of-line) 90 (remove-text-properties (line-beginning-position) (line-end-position) '(display "")) 91 (tsm-line) ) 92 nil ) ) ) ) ) 93 94 95 ;;;###autoload 96 (define-minor-mode tsm-mode 97 "Minor mode to display transient symbols like in the terminal repl in picolisp-mode." 98 :group 'tsm :lighter " *Tsm" 99 (save-excursion 100 (save-restriction 101 (widen) 102 ;; We erase all the properties to avoid problems. 103 (tsm-revert (point-min) (point-max)) 104 105 (if tsm-mode 106 (progn 107 (if (not (and (not font-lock-mode) (not global-font-lock-mode))) 108 (font-lock-add-keywords major-mode tsm-lock) 109 (jit-lock-register 'tsm-change) 110 (remove-hook 'after-change-functions 111 'font-lock-after-change-function t ) 112 (set (make-local-variable 'font-lock-fontified) t) 113 114 ;; Tell jit-lock how we extend the region to refontify. 115 (add-hook 'jit-lock-after-change-extend-region-functions 116 'font-lock-extend-jit-lock-region-after-change 117 nil t ) ) 118 119 (setq global-disable-point-adjustment t) ) 120 (progn 121 (if (and (not font-lock-mode) (not global-font-lock-mode)) 122 (jit-lock-unregister 'tsm-change) 123 (font-lock-remove-keywords major-mode tsm-lock) ) 124 (setq global-disable-point-adjustment nil) ) ) 125 126 (if font-lock-mode (font-lock-fontify-buffer)) ) ) ) 127 128 ;;; Announce 129 130 (provide 'tsm)