├── utf-tool.el ├── smart-dnd.el ├── utf-8m.el ├── smart-compile.el └── mac-key-mode.el /utf-tool.el: -------------------------------------------------------------------------------- 1 | ;;; -*- coding: iso-2022-7bit -*- 2 | 3 | ;; Copyright (C) 2006, 2012, 2014, 2016 by Seiji Zenitani 4 | 5 | ;; Author: Seiji Zenitani 6 | ;; Compatibility: Emacs 22 only 7 | ;; URL(en): https://github.com/zenitani/elisp/blob/master/utf-tool.el 8 | ;; URL(jp): https://sci.nao.ac.jp/MEMBER/zenitani/elisp-j.html#utf-sty 9 | 10 | ;; utf $B%Q%C%1!<%8(B (utf.sty) $B$rJXMx$K;H$&$?$a$N4X?t$rDs6!$7$^$9!#(B 11 | ;; M-x utf-sty-encode-buffer, utf-sty-encode-region $B$O(B 12 | ;; $B%P%C%U%!!&%j!<%8%g%sFb$N%F%-%9%H$r(B \UTF{...} $B$J$I$KJQ49$7$^$9!#(B 13 | ;; M-x utf-sty-decode-buffer, utf-sty-decode-region $B$O(B 14 | ;; $B$=$N5U$N=hM}$r9T$$$^$9!#(B 15 | ;; 16 | ;; $BNc!K?9$(Dl?$B30(B $B"N(B $B?9(B\UTF{9DD7}$B30(B 17 | ;; 18 | ;; $B$^$?!"(Bprefix$B!J(BC-u$B!K$rIU$1$F;H$&$3$H$b$G$-$^$9!#(B 19 | ;; C-u M-x utf-sty-encode-buffer = M-x utf-sty-decode-buffer 20 | 21 | ;; $B$3$N%U%!%$%k$O(B GPL $B%i%$%;%s%9(B v2 $B$N$b$H$G:FG[I[2DG=$G$9!#(B 22 | 23 | ;;; Code: 24 | 25 | (defun utf-sty-encode-buffer (&optional arg) 26 | (interactive "*p") 27 | (utf-sty-encode-region (point-min) (point-max) arg) 28 | ) 29 | (defun utf-sty-decode-buffer (&optional arg) 30 | (interactive "*p") 31 | (utf-sty-decode-region (point-min) (point-max) arg) 32 | ) 33 | 34 | (defun utf-sty-encode-region (start end &optional arg) 35 | (interactive "*r\np") 36 | (save-excursion 37 | (save-restriction 38 | (narrow-to-region start end) 39 | (cond 40 | ((= arg 1) (utf-sty-encode1)) ; M-x 41 | ((= arg 4) (utf-sty-decode1)) ; C-u M-x 42 | )))) 43 | 44 | (defun utf-sty-decode-region (start end &optional arg) 45 | (interactive "*r\np") 46 | (save-excursion 47 | (save-restriction 48 | (narrow-to-region start end) 49 | (cond 50 | ((= arg 1) (utf-sty-decode1)) ; M-x 51 | ((= arg 4) (utf-sty-encode1)) ; C-u M-x 52 | )))) 53 | 54 | (defun utf-sty-encode1() 55 | (goto-char (point-min)) 56 | (while (not (eobp)) 57 | (let* ((char (char-after)) 58 | (charset (char-charset char)) 59 | ;; (charset-description charset) 60 | ;; (split (split-char char)) 61 | (pos (point)) 62 | (unicode nil)) 63 | (unless 64 | (memq charset '(ascii japanese-jisx0208 katakana-jisx0201)) 65 | (if (or (< char 256) 66 | (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) 67 | (get-char-property pos 'untranslated-utf-8)) 68 | (setq unicode (or (get-char-property pos 'untranslated-utf-8) 69 | (encode-char char 'ucs)))) 70 | (when unicode 71 | (delete-char 1) 72 | (cond 73 | ((eq charset 'korean-ksc5601) 74 | (insert-string (format "\\UTFK{%04X}" unicode))) 75 | ((eq charset 'chinese-gb2312) 76 | (insert-string (format "\\UTFC{%04X}" unicode))) 77 | ((eq charset 'chinese-big5-1) 78 | (insert-string (format "\\UTFT{%04X}" unicode))) 79 | (t 80 | (insert-string (format "\\UTF{%04X}" unicode))) 81 | )) 82 | ) 83 | (if (not (eobp))(forward-char)) 84 | ))) 85 | 86 | (defun utf-sty-decode1() 87 | (goto-char (point-min)) 88 | (while (re-search-forward 89 | "\\\\\\(UTF\\|UTFK\\|UTFT\\|UTFC\\)\{\\([0-9a-f][0-9a-f][0-9a-f][0-9a-f]\\)\}" 90 | nil t 1) 91 | (let ((str (match-string 2))) 92 | (replace-match "" t nil) 93 | (if (stringp str) (ucs-insert (string-to-number str 16))) 94 | ))) 95 | 96 | (provide 'utf-tool) 97 | 98 | ;; utf-tool.el ends here. -------------------------------------------------------------------------------- /smart-dnd.el: -------------------------------------------------------------------------------- 1 | ;;; smart-dnd.el --- user-configurable drag-n-drop feature 2 | 3 | ;; Copyright (C) 2003-2008, 2012, 2014, 2017, 2020 by Seiji Zenitani 4 | 5 | ;; Author: Seiji Zenitani 6 | ;; Keywords: tools 7 | ;; Created: 2003-04-27 8 | ;; Compatibility: Emacs 22 or later 9 | ;; URL(en): https://github.com/zenitani/elisp/blob/master/smart-dnd.el 10 | ;; URL(jp): https://sci.nao.ac.jp/MEMBER/zenitani/elisp-j.html#smart-dnd 11 | 12 | ;; This file is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation; either version 3, or (at your option) 15 | ;; any later version. 16 | 17 | ;; This file is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the 24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25 | ;; Boston, MA 02110-1301, USA. 26 | 27 | ;;; Commentary 28 | 29 | ;; This package provides user-configurable drag-n-drop feature to Emacs 22. 30 | ;; 31 | ;; Usage: 32 | ;; 33 | ;; First, evaluate `smart-dnd-setup' function with an alist in the buffer. 34 | ;; The code modifies drag-n-drop behaviour in the local buffer and then 35 | ;; a string "image file: file.png" will be inserted when *.png file is dropped. 36 | ;; 37 | ;; (require 'smart-dnd) 38 | ;; (smart-dnd-setup 39 | ;; '( 40 | ;; ("\\.png\\'" . "image file: %f\n") 41 | ;; ("\\.jpg\\'" . "image file: %f\n") 42 | ;; (".exe\\'" . (message (concat "executable: " f))) 43 | ;; (".*" . "any filename: %f\n") 44 | ;; )) 45 | ;; 46 | ;; String elements will be formatted by `smart-dnd-string'. 47 | ;; You can also put elisp expression into the alist. 48 | ;; In the case of ".exe" in the above list, a local variable 'f' 49 | ;; will be replaced by the dropped filename in the expression. 50 | ;; 51 | ;; Major-mode-hook is a good place to install your configuration. 52 | ;; For example, 53 | ;; 54 | ;; html-mode: 55 | ;; 56 | ;; (add-hook 57 | ;; 'html-mode-hook 58 | ;; (lambda () 59 | ;; (smart-dnd-setup 60 | ;; '( 61 | ;; ("\\.png\\'" . "\n") 62 | ;; ("\\.gif\\'" . "\n") 63 | ;; ("\\.jpg\\'" . "\n") 64 | ;; ("\\.css\\'" . "\n" ) 65 | ;; ("\\.js\\'" . "\n" ) 66 | ;; (".*" . "%f\n") 67 | ;; )))) 68 | ;; 69 | ;; LaTeX mode: 70 | ;; 71 | ;; (add-hook 72 | ;; 'latex-mode-hook 73 | ;; (lambda () 74 | ;; (smart-dnd-setup 75 | ;; '( 76 | ;; ("\\.tex\\'" . "\\input{%r}\n") 77 | ;; ("\\.cls\\'" . "\\documentclass{%f}\n") 78 | ;; ("\\.sty\\'" . "\\usepackage{%f}\n") 79 | ;; ("\\.eps\\'" . "\\includegraphics[]{%r}\n") 80 | ;; ("\\.ps\\'" . "\\includegraphics[]{%r}\n") 81 | ;; ("\\.pdf\\'" . "\\includegraphics[]{%r}\n") 82 | ;; ("\\.jpg\\'" . "\\includegraphics[]{%r}\n") 83 | ;; ("\\.png\\'" . "\\includegraphics[]{%r}\n") 84 | ;; )))) 85 | ;; 86 | ;; C/C++ mode: 87 | ;; 88 | ;; (add-hook 'c-mode-common-hook 89 | ;; (lambda () (smart-dnd-setup '(("\\.h\\'" . "#include <%f>"))))) 90 | ;; 91 | 92 | 93 | ;;; Code: 94 | 95 | (require 'dnd) 96 | 97 | (defvar smart-dnd-protocol-alist 98 | '(("^file:///" . smart-dnd-handle-local-file) 99 | ("^file://" . smart-dnd-handle-file) 100 | ("^file:" . smart-dnd-handle-local-file)) 101 | "The functions to call when a file is dropped to the buffer. 102 | See `dnd-protocol-alist' for more information." 103 | ) 104 | (put 'smart-dnd-protocol-alist 'risky-local-variable t) 105 | 106 | (defvar smart-dnd-replace-alist 107 | '( 108 | ("%F" . f) 109 | ("%f" . (file-name-nondirectory f)) 110 | ("%r" . (if buffer-file-name 111 | (file-relative-name 112 | f (file-name-directory buffer-file-name)) 113 | f)) 114 | ("%R" . (if buffer-file-name 115 | (file-relative-name 116 | f (file-name-directory buffer-file-name)) 117 | (concat "file://" f))) 118 | ("%n" . (file-name-sans-extension (file-name-nondirectory f))) 119 | ("%e" . (or (file-name-extension f) "")) 120 | )) 121 | (put 'smart-dnd-replace-alist 'risky-local-variable t) 122 | 123 | (defun smart-dnd-handle-local-file (uri action) 124 | "Open a local file. See also `dnd-open-local-file'." 125 | 126 | (let* ((f (dnd-get-local-file-name uri t))) 127 | (if (and f (file-readable-p f)) 128 | (progn 129 | (or (smart-dnd-execute f) 130 | (dnd-open-local-file uri action)) 131 | 'private) 132 | (error "Can not read %s" uri)))) 133 | 134 | (defun smart-dnd-handle-file (uri action) 135 | "Handle a local or remote file." 136 | (let ((local-file (dnd-get-local-file-uri uri))) 137 | (if local-file (smart-dnd-handle-local-file local-file action) 138 | (error "Remote files not supported")))) 139 | 140 | (defun smart-dnd-execute (f) 141 | "Execute a Drag'n'Drop action with filename F 142 | depending on `smart-dnd-string-alist'." 143 | (interactive "f") 144 | (save-excursion 145 | (if (eq (car-safe last-nonmenu-event) 'drag-n-drop) 146 | (goto-char (posn-point (car (cdr-safe last-nonmenu-event))))) 147 | (let( (alist smart-dnd-string-alist) 148 | (case-fold-search nil) 149 | (my-string nil) 150 | (succeed nil) ) 151 | (while alist 152 | (when (string-match (caar alist) f) 153 | (setq my-string (cdar alist)) 154 | (when (stringp my-string) 155 | (insert (smart-dnd-string my-string f)) 156 | (setq alist nil) 157 | (setq succeed t) 158 | ) 159 | (when (not (stringp my-string)) 160 | (eval (cdar alist)) 161 | (setq alist nil) 162 | (setq succeed t) 163 | ) 164 | ) 165 | (setq alist (cdr alist)) 166 | ) 167 | succeed))) 168 | 169 | ;;;###autoload 170 | (defun smart-dnd-setup (alist) 171 | "Install smart-dnd feature to the local buffer." 172 | (interactive) 173 | (set (make-local-variable 'dnd-protocol-alist) 174 | (append smart-dnd-protocol-alist dnd-protocol-alist)) 175 | (set (make-local-variable 'smart-dnd-string-alist) alist) 176 | ) 177 | 178 | (defun smart-dnd-string (string filename) 179 | "Generate a string, based on a format STRING and the FILENAME. 180 | You can use the following keywords in the format control STRING. 181 | %F means absolute pathname. [ /home/zenitani/public_html/index.html ] 182 | %f means file name without directory. [ index.html ] 183 | %r and %R means relative path to the FILENAME from a file in the current buffer. 184 | [ public_html/index.html ] 185 | When the target buffer hasn't been assigned a file name yet, 186 | %r returns the absolute pathname [ /home/zenitani/public_html/index.html ] 187 | while %R returns the URL. [ file:///home/zenitani/ .. /index.html ] 188 | %n means file name without extension. [ index ] 189 | %e means extension of file name. [ html ] 190 | " 191 | (interactive) 192 | (let ((rlist smart-dnd-replace-alist) 193 | (case-fold-search nil) 194 | (f filename)) 195 | (while rlist 196 | (while (string-match (caar rlist) string) 197 | (setq string 198 | (replace-match 199 | (eval (cdar rlist)) t nil string))) 200 | (setq rlist (cdr rlist)) 201 | )) 202 | string) 203 | 204 | 205 | (provide 'smart-dnd) 206 | 207 | ;;; smart-dnd.el ends here 208 | -------------------------------------------------------------------------------- /utf-8m.el: -------------------------------------------------------------------------------- 1 | ;;; -*- coding: iso-2022-7bit -*- 2 | ;;; utf-8m.el --- modified UTF-8 encoding for Mac OS X hfs plus volume format 3 | 4 | ;; Copyright (C) 2004-2008, 2012, 2014 Seiji Zenitani 5 | 6 | ;; Author: Seiji Zenitani 7 | ;; Keywords: mac, multilingual, Unicode, UTF-8 8 | ;; Created: 2004-02-20 9 | ;; Compatibility: Emacs 22 only 10 | ;; URL(jp): http://th.nao.ac.jp/MEMBER/zenitani/emacs-j.html 11 | ;; URL(en): http://th.nao.ac.jp/MEMBER/zenitani/emacs-e.html 12 | 13 | ;; Contributed by Eiji Honjoh and Carsten Bormann 14 | 15 | ;; This file is free software; you can redistribute it and/or modify 16 | ;; it under the terms of the GNU General Public License as published by 17 | ;; the Free Software Foundation; either version 3, or (at your option) 18 | ;; any later version. 19 | 20 | ;; This file is distributed in the hope that it will be useful, 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 | ;; GNU General Public License for more details. 24 | 25 | ;; You should have received a copy of the GNU General Public License 26 | ;; along with GNU Emacs; see the file COPYING. If not, write to 27 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 28 | ;; Boston, MA 02111-1307, USA. 29 | 30 | ;;; Commentary: 31 | 32 | ;; This package provides a modified utf-8 encoding (utf-8m) for Mac OSX 33 | ;; hfs plus volume format. By setting utf-8m as the file-name-coding-system, 34 | ;; emacs can read the following characters in filenames. 35 | ;; 36 | ;; * Japanese Kana characters with Dakuten/Han-Dakuten signs 37 | ;; * Korean Hangul characters 38 | ;; * Latin characters with diacritical marks (accents, umlauts, tilde, etc.) 39 | ;; 40 | ;; Note that utf-8m does not restore the above characters when 41 | ;; it exports the filenames. Fortunately, it seems that the filesystem 42 | ;; knows how to deal with such invalid filenames. 43 | ;; 44 | ;; In order to use, add the below line to your .emacs file. 45 | ;; 46 | ;; (set-file-name-coding-system 'utf-8m) 47 | ;; 48 | 49 | ;;; utf-8m $B$K$D$$$F(B 50 | 51 | ;; Mac OS X $B$N(B HFS+ $B%U%!%$%k%7%9%F%`$N%U%!%$%kL>$rFI$`$?$a$N(B 52 | ;; $B=$@5(B UTF8 $B%(%s%3!<%G%#%s%0(B (utf-8m) $B$rDs6!$7$^$9!#(B 53 | ;; $B%U%!%$%kL>$rFI$_9~$`:]$K@55,2=J}<0$rJQ99$9$k$N$G(B 54 | ;; $BF|K\8l$NByE@!&H>ByE@J8;z$H%O%s%0%kJ8;z!"%"%/%;%s%HIU$-$N%i%F%sJ8;z$,(B 55 | ;; $BJ8;z2=$1$7$J$$$h$&$K$J$j$^$9!#%U%!%$%kL>$r=q$-=P$9:]$NJQ49$O(B 56 | ;; $B9MN8$7$F$$$^$;$s$,!"%U%!%$%k%7%9%F%`B&$,$&$^$/=hM}$7$F$/$l$k$h$&$G$9!#(B 57 | ;; utf-8m $B$r;HMQ$9$k$?$a$K$O!"$3$N%U%!%$%k$rFI$_9~$s$@$N$A!"(B 58 | ;; 59 | ;; (set-file-name-coding-system 'utf-8m) 60 | ;; 61 | ;; $B$H$7$F2<$5$$!#(B 62 | 63 | 64 | ;;; Code: 65 | 66 | 67 | ;; Japanese Kana characters with Dakuten/Han-Dakuten signs 68 | 69 | (defvar utf-8m-fix-kana1-alist 70 | (string-to-list "$B$+$-$/$1$3$5$7$9$;$=$?$A$D$F$H$O$R$U$X$[%+%-%/%1%3%5%7%9%;%=%?%A%D%F%H%O%R%U%X%[!3!5(B")) 71 | (defvar utf-8m-fix-kana2-alist (string-to-list "$B$O$R$U$X$[%O%R%U%X%[(B")) 72 | (defvar utf-8m-fix-kana3-alist (string-to-list "$B%o%p%q%r(B")) 73 | 74 | (defun utf-8m-post-read-kana-conversion (length) 75 | "Document forthcoming..." 76 | (save-excursion 77 | (while (not (eobp)) 78 | (let ((ch1 (char-before)) 79 | (ch2 (char-after))) 80 | (cond 81 | ((= ch2 ?$,2>y(B) ;; 302969 or 12441 82 | (cond 83 | ((memq ch1 utf-8m-fix-kana1-alist) 84 | (delete-char -1) 85 | (delete-char 1) 86 | (insert (+ ch1 1)) 87 | (setq length (- length 1)) 88 | ) 89 | ;; ((memq ch1 utf-8m-fix-kana3-alist) 90 | ;; (delete-char -1) 91 | ;; (delete-char 1) 92 | ;; (insert (+ ch1 1244)) 93 | ;; (setq length (- length 1)) 94 | ;; ) 95 | ((= ch1 ?$B%&(B) 96 | (delete-char -1) 97 | (delete-char 1) 98 | (insert ?$B%t(B) 99 | (setq length (- length 1)) 100 | ))) 101 | ((= ch2 ?$,2>z(B) ;; 302970 or 12442 102 | (cond 103 | ((memq ch1 utf-8m-fix-kana2-alist) 104 | (delete-char -1) 105 | (delete-char 1) 106 | (insert (+ ch1 2)) 107 | (setq length (- length 1)) 108 | )))) 109 | (if (not (eobp))(forward-char)) 110 | ))) 111 | length) 112 | 113 | 114 | ;; Latin characters with diacritical marks 115 | 116 | (defvar utf-8m-fix-latin-alist 117 | '( 118 | (?$,1%@(B . ( ;; grave 332480 (e22) or 768 (e23) 119 | (?A . ?,A@(B) (?E . ?,AH(B) (?I . ?,AL(B) (?O . ?,AR(B) (?U . ?,AY(B) 120 | (?a . ?,A`(B) (?e . ?,Ah(B) (?i . ?,Al(B) (?o . ?,Ar(B) (?u . ?,Ay(B) 121 | )) 122 | (?$,1%A(B . ( ;; acute 332481, 769 123 | (?A . ?,AA(B) (?E . ?,AI(B) (?I . ?,AM(B) (?O . ?,AS(B) (?U . ?,AZ(B) (?Y . ?,b](B) 124 | (?C . ?$,1 &(B) (?L . ?$,1 Y(B) (?N . ?$,1 c(B) (?R . ?$,1 t(B) (?S . ?$,1 z(B) (?Z . ?$,1!9(B) 125 | (?a . ?,Aa(B) (?e . ?,Ai(B) (?i . ?,Am(B) (?o . ?,As(B) (?u . ?,Az(B) (?y . ?,b}(B) 126 | (?c . ?$,1 '(B) (?l . ?$,1 Z(B) (?n . ?$,1 d(B) (?r . ?$,1 u(B) (?s . ?$,1 {(B) (?z . ?$,1!:(B) 127 | )) 128 | (?$,1%B(B . ( ;; circumflex 332482, 770 129 | (?A . ?,AB(B) (?E . ?,AJ(B) (?I . ?,AN(B) (?O . ?,AT(B) (?U . ?,A[(B) 130 | (?a . ?,Ab(B) (?e . ?,Aj(B) (?i . ?,An(B) (?o . ?,At(B) (?u . ?,A{(B) 131 | )) 132 | (?$,1%C(B . ( ;; tilda 332483, 771 133 | (?A . ?,bC(B) (?N . ?,bQ(B) (?O . ?,bU(B) 134 | (?a . ?,bc(B) (?n . ?,bq(B) (?o . ?,bu(B) 135 | )) 136 | (?$,1%D(B . ( ;; macron 332484, 772 137 | (?A . ?$,1 (B) (?E . ?$,1 2(B) (?I . ?$,1 J(B) (?O . ?$,1 l(B) (?U . ?$,1!*(B) 138 | (?a . ?$,1 !(B) (?e . ?$,1 3(B) (?i . ?$,1 K(B) (?o . ?$,1 m(B) (?u . ?$,1!+(B) 139 | )) 140 | (?$,1%G(B . ( ;; dot above 332487, 775 141 | (?E . ?$,1 6(B) (?Z . ?$,1!;(B) 142 | (?e . ?$,1 7(B) (?z . ?$,1!<(B) 143 | )) 144 | (?$,1%H(B . ( ;; umlaut 332488, 776 145 | (?A . ?,AD(B) (?E . ?,AK(B) (?I . ?,AO(B) (?O . ?,AV(B) (?U . ?,A\(B) (?Y . ?,b>(B) 146 | (?a . ?,Ad(B) (?e . ?,Ak(B) (?i . ?,Ao(B) (?o . ?,Av(B) (?u . ?,A|(B) (?y . ?,A(B) 147 | )) 148 | (?$,1%J(B . ( ;; angstrom / ring above 332490, 778 149 | (?A . ?,AE(B) (?U . ?$,1!.(B) 150 | (?a . ?,Ae(B) (?u . ?$,1!/(B) 151 | )) 152 | (?$,1%K(B . ( ;; double accute 332491, 779 153 | (?O . ?$,1 p(B) (?U . ?$,1!0(B) 154 | (?o . ?$,1 q(B) (?u . ?$,1!1(B) 155 | )) 156 | (?$,1%L(B . ( ;; caron 332492, 780 157 | (?C . ?$,1 ,(B) (?D . ?$,1 .(B) (?E . ?$,1 :(B) (?L . ?$,1 ](B) (?N . ?$,1 g(B) 158 | (?R . ?$,1 x(B) (?S . ?$,1! (B) (?T . ?$,1!$(B) (?Z . ?$,1!=(B) 159 | (?c . ?$,1 -(B) (?d . ?$,1 /(B) (?e . ?$,1 ;(B) (?l . ?$,1 ^(B) (?n . ?$,1 h(B) 160 | (?r . ?$,1 y(B) (?s . ?$,1!!(B) (?t . ?$,1!%(B) (?z . ?$,1!>(B) 161 | )) 162 | (?$,1%g(B . ( ;; cedilla 332519, 807 163 | (?C . ?,bG(B) (?G . ?$,1 B(B) (?K . ?$,1 V(B) (?L . ?$,1 [(B) (?N . ?$,1 e(B) (?R . ?$,1 v(B) 164 | (?c . ?,bg(B) (?g . ?$,1 C(B) (?k . ?$,1 W(B) (?l . ?$,1 \(B) (?n . ?$,1 f(B) (?r . ?$,1 w(B) 165 | )) 166 | (?$,1%h(B . ( ;; ogonek 332520, 808 167 | (?A . ?$,1 $(B) (?E . ?$,1 8(B) (?I . ?$,1 N(B) (?U . ?$,1!2(B) 168 | (?a . ?$,1 %(B) (?e . ?$,1 9(B) (?i . ?$,1 O(B) (?u . ?$,1!3(B) 169 | )) 170 | )) 171 | 172 | (defun utf-8m-post-read-latin-conversion (length) 173 | "Document forthcoming..." 174 | (save-excursion 175 | (dotimes (i length) (forward-char)) 176 | (let ((accent_char nil) 177 | (accent_count 0)) 178 | (while (not (bobp)) 179 | (let ((ch (char-before))) 180 | (cond 181 | ((and (= accent_count 1) 182 | (assoc accent_char utf-8m-fix-latin-alist) 183 | (assoc ch (cdr (assoc accent_char utf-8m-fix-latin-alist))) 184 | ) 185 | (delete-char -1) 186 | (delete-char 1) 187 | (insert 188 | (cdr (assoc ch 189 | (cdr (assoc accent_char utf-8m-fix-latin-alist)) 190 | ))) 191 | (setq length (- length 1)) 192 | (setq accent_count 0) 193 | ) 194 | ((assoc ch utf-8m-fix-latin-alist) 195 | (setq accent_char ch) 196 | (setq accent_count (+ accent_count 1)) 197 | ) 198 | (t (setq accent_count 0)) 199 | ) 200 | (if (not (bobp))(backward-char)) 201 | ) 202 | ))) 203 | length) 204 | 205 | 206 | ;; Korean Hangul characters 207 | ;; ref. http://www.unicode.org/reports/tr15/#Hangul 208 | 209 | (defun utf-8m-post-read-hangul-conversion (length) 210 | "Document forthcoming..." 211 | (save-excursion 212 | (let* ((ch1 nil) 213 | (ch2 nil) 214 | (sbase #xac00) 215 | (lbase #x1100) 216 | (vbase #x1161) 217 | (tbase #x11a7) 218 | (lcount 19) 219 | (vcount 21) 220 | (tcount 28) 221 | (ncount (* vcount tcount)) ; 588 222 | (scount (* lcount ncount)) ; 11172 223 | (lindex nil) 224 | (vindex nil) 225 | (sindex nil) 226 | (tindex nil)) 227 | (if (not (eobp)) (forward-char)) 228 | (if (not (eobp)) (setq ch1 (encode-char (char-before) 'ucs))) 229 | (while (not (eobp)) 230 | (setq ch2 (encode-char (char-after) 'ucs)) 231 | ; (message "ch1:%X ch2:%X" ch1 ch2) 232 | (setq lindex (- ch1 lbase)) 233 | (setq vindex (- ch2 vbase)) 234 | (setq sindex (- ch1 sbase)) 235 | (setq tindex (- ch2 tbase)) 236 | (if (and (>= lindex 0)(< lindex lcount) 237 | (>= vindex 0)(< vindex vcount)) 238 | (progn 239 | ; (message "first loop") 240 | (setq ch1 (+ sbase (* (+ (* lindex vcount) vindex) tcount))) 241 | (delete-char -1) 242 | (delete-char 1) 243 | (ucs-insert ch1) 244 | (setq length (- length 1)) 245 | ) 246 | (if (and (>= sindex 0)(< sindex scount) 247 | (= (% sindex tcount) 0) 248 | (>= tindex 0)(< tindex tcount)) 249 | (progn 250 | ; (message "second loop") 251 | (setq ch1 (+ ch1 tindex)) 252 | (delete-char -1) 253 | (delete-char 1) 254 | (ucs-insert ch1) 255 | (setq length (- length 1)) 256 | ) 257 | (progn 258 | (setq ch1 ch2) 259 | (if (not (eobp))(forward-char)) 260 | ) 261 | )) 262 | ))) 263 | length) 264 | 265 | 266 | ;; ---- post-read-converters ---- 267 | 268 | 269 | ;; Emacs 22 version 270 | (defun utf-8m-e22-post-read-conversion (length) 271 | "Document forthcoming..." 272 | (save-excursion 273 | (setq length (utf-8-post-read-conversion length))) 274 | (save-excursion 275 | (setq length (utf-8m-post-read-kana-conversion length))) 276 | (save-excursion 277 | (setq length (utf-8m-post-read-hangul-conversion length))) 278 | (save-excursion 279 | (setq length (utf-8m-post-read-latin-conversion length))) 280 | length) 281 | 282 | ;; Emacs 22 version (mac-only) 283 | ;; convert utf-8 (NFD) to utf-8 (NFC) by calling `mac-code-convert-string'. 284 | ;; ref. http://lists.gnu.org/archive/html/emacs-devel/2005-07/msg01067.html 285 | (defun utf-8m-e22-mac-post-read-conversion (length) 286 | "Document forthcoming..." 287 | (save-excursion ;; the original converter 288 | (setq length (utf-8-post-read-conversion length))) 289 | (save-excursion ;; additional conversion (NFD -> NFC) 290 | (save-restriction 291 | (narrow-to-region (point) (+ (point) length)) 292 | (let ((str (buffer-string))) 293 | (delete-region (point-min) (point-max)) 294 | (insert 295 | (decode-coding-string 296 | (mac-code-convert-string 297 | (encode-coding-string str 'utf-8) 'utf-8 'utf-8 'NFC) 298 | 'utf-8)) 299 | (- (point-max) (point-min)) 300 | )))) 301 | 302 | ;; Emacs 23 version 303 | (defun utf-8m-e23-post-read-conversion (length) 304 | "Document forthcoming..." 305 | (save-excursion 306 | (setq length (utf-8m-post-read-kana-conversion length))) 307 | (save-excursion 308 | (setq length (utf-8m-post-read-hangul-conversion length))) 309 | (save-excursion 310 | (setq length (utf-8m-post-read-latin-conversion length))) 311 | length) 312 | 313 | 314 | ;; ---- define a coding system (utf-8m) ---- 315 | 316 | (cond 317 | 318 | ;; Emacs 22 319 | ((equal emacs-major-version 22) 320 | (make-coding-system 321 | 'utf-8m 4 ?U 322 | "modified UTF-8 encoding for Mac OS X hfs plus volume format." 323 | '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8) 324 | `((safe-charsets 325 | ascii 326 | eight-bit-control 327 | eight-bit-graphic 328 | latin-iso8859-1 329 | mule-unicode-0100-24ff 330 | mule-unicode-2500-33ff 331 | mule-unicode-e000-ffff 332 | ,@(if utf-translate-cjk-mode 333 | utf-translate-cjk-charsets)) 334 | (mime-charset . nil) 335 | (coding-category . coding-category-utf-8) 336 | (valid-codes (0 . 255)) 337 | (pre-write-conversion . utf-8-pre-write-conversion) 338 | ; (pre-write-conversion . utf-8m-pre-write-conversion) 339 | ; (post-read-conversion . utf-8-post-read-conversion) 340 | ,(if (functionp 'mac-code-convert-string) 341 | '(post-read-conversion . utf-8m-e22-mac-post-read-conversion) 342 | '(post-read-conversion . utf-8m-e22-post-read-conversion)) 343 | (translation-table-for-encode . utf-translation-table-for-encode) 344 | (dependency unify-8859-on-encoding-mode 345 | unify-8859-on-decoding-mode 346 | utf-fragment-on-decoding 347 | utf-translate-cjk-mode))) 348 | ) 349 | 350 | ;; Emacs 23 (doesn't work) 351 | (nil ;(equal emacs-major-version 23) 352 | (define-coding-system 'utf-8m 353 | "UTF-8 Mac file system encoding." 354 | :coding-type 'utf-8 355 | :mnemonic ?U 356 | :charset-list '(unicode) 357 | :post-read-conversion 'utf-8m-e23-post-read-conversion) 358 | ) 359 | 360 | ) ;; (cond 361 | 362 | 363 | ;; (set-file-name-coding-system 'utf-8m) 364 | 365 | (provide 'utf-8m) 366 | 367 | ;; utf-8m.el ends here. 368 | -------------------------------------------------------------------------------- /smart-compile.el: -------------------------------------------------------------------------------- 1 | ;;; smart-compile.el --- an interface to `compile' -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 1998-2025 by Seiji Zenitani 4 | 5 | ;; Author: Seiji Zenitani 6 | ;; Version: 20251123 7 | ;; Keywords: tools, unix 8 | ;; Created: 1998-12-27 9 | ;; Compatibility: Emacs 24 or later 10 | ;; URL(en): https://github.com/zenitani/elisp/blob/master/smart-compile.el 11 | ;; URL(jp): https://sci.nao.ac.jp/MEMBER/zenitani/elisp-j.html#smart-compile 12 | 13 | ;; Acknowledgments: 14 | ;; I thank Sakito Hisakura, Pierre Téchoueyres, and Danny McClanahan for their contributions. 15 | ;; I also employed Greg Pfell's GPL codelet. 16 | 17 | ;; This file is free software; you can redistribute it and/or modify 18 | ;; it under the terms of the GNU General Public License as published by 19 | ;; the Free Software Foundation; either version 3, or (at your option) 20 | ;; any later version. 21 | 22 | ;; This file is distributed in the hope that it will be useful, 23 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 24 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 | ;; GNU General Public License for more details. 26 | 27 | ;; You should have received a copy of the GNU General Public License 28 | ;; along with GNU Emacs; see the file COPYING. If not, write to the 29 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 30 | ;; Boston, MA 02110-1301, USA. 31 | 32 | ;;; Commentary: 33 | 34 | ;; This package provides `smart-compile' function. 35 | ;; You can associate a particular file with a particular compile function, 36 | ;; by editing `smart-compile-alist'. 37 | ;; If you are using a build system such as make or cargo, you can associate its build system file with a 38 | ;; compile function as well, by editing `smart-compile-build-system-alist'. 39 | ;; 40 | ;; To use this package, add these lines to your .emacs file: 41 | ;; (require 'smart-compile) 42 | ;; 43 | ;; Note that it requires emacs 21 or later. 44 | 45 | ;;; Code: 46 | 47 | (defgroup smart-compile nil 48 | "An interface to `compile'." 49 | :group 'processes 50 | :prefix "smart-compile") 51 | 52 | (defcustom smart-compile-alist '( 53 | (emacs-lisp-mode . (emacs-lisp-byte-compile)) 54 | (html-mode . (browse-url-of-buffer)) 55 | (nxhtml-mode . (browse-url-of-buffer)) 56 | (html-helper-mode . (browse-url-of-buffer)) 57 | (octave-mode . (run-octave)) 58 | ("\\.c\\'" . "gcc -O2 %f -lm -o %n") 59 | ;; ("\\.c\\'" . "gcc -O2 %f -lm -o %n && ./%n") ;; unix, macOS 60 | ;; ("\\.c\\'" . "gcc -O2 %f -lm -o %n && %n") ;; win 61 | ("\\.[Cc]+[Pp]*\\'" . "g++ -O2 %f -lm -o %n") 62 | ("\\.cron\\(tab\\)?\\'" . "crontab %f") 63 | ("\\.cu\\'" . "nvcc %f -o %n") 64 | ("\\.cuf\\'" . "nvfortran -cuda -O2 %f -o %n") 65 | ("\\.ex[s]?\\'" . "elixirc %f") 66 | ("\\.[Ff]\\'" . "gfortran %f -o %n") 67 | ("\\.[Ff]9[05]\\'" . "gfortran %f -o %n") 68 | ("\\.go\\'" . "go run %f") 69 | ("\\.hs\\'" . "ghc %f -o %n") 70 | ("\\.java\\'" . "javac %f") 71 | ("\\.jl\\'" . "julia %f") 72 | ("\\.kt[s]?\\'" . "kotlinc %f -o %n") 73 | ("\\.lua\\'" . "lua %f") 74 | ("\\.m\\'" . "gcc -O2 %f -lobjc -lpthread -o %n") 75 | ("\\.mojo\\'" . "mojo %f") 76 | ("\\.mp\\'" . "mptopdf %f") 77 | ("\\.php\\'" . "php %f") 78 | ("\\.pl\\'" . "perl %f") 79 | ("\\.p[l]?6\\'" . "perl6 %f") 80 | ("\\.py\\'" . "python3 %f") 81 | ("\\.raku\\'" . "perl6 %f") 82 | ("\\.rb\\'" . "ruby %f") 83 | ("\\.rs\\'" . "rustc %f -o %n") 84 | ("\\.swift\\'" . "swiftc %f -o %n") 85 | ("\\.tex\\'" . (tex-file)) 86 | ("\\.texi\\'" . "makeinfo %f") 87 | ("\\.ts\\'" . "tsc %f --outFile %n") 88 | ;; ("\\.php\\'" . "php -l %f") ; syntax check 89 | ;; ("\\.pl\\'" . "perl -cw %f") ; syntax check 90 | ;; ("\\.rb\\'" . "ruby -cw %f") ; syntax check 91 | ) "Alist of filename patterns vs corresponding format control strings. 92 | Each element looks like (REGEXP . STRING) or (MAJOR-MODE . STRING). 93 | Visiting a file whose name matches REGEXP specifies STRING as the 94 | format control string. Instead of REGEXP, MAJOR-MODE can also be used. 95 | The compilation command will be generated from STRING. 96 | The following %-sequences will be replaced by: 97 | 98 | %F absolute pathname ( /home/zenitani/Desktop/test.py ) 99 | %f file name without directory ( test.py ) 100 | %n file name without extension ( test ) 101 | %e extension of file name ( py ) 102 | 103 | %o value of `smart-compile-option-string' ( \"user-defined\" ). 104 | %p set the cursor position where the %p is (or at the end) in minibuffer. 105 | 106 | If the second item of the alist element is an emacs-lisp FUNCTION, 107 | evaluate FUNCTION instead of running a compilation command. 108 | " 109 | :type '(repeat 110 | (cons 111 | (choice 112 | (regexp :tag "Filename pattern") 113 | (function :tag "Major-mode")) 114 | (choice 115 | (string :tag "Compilation command") 116 | (sexp :tag "Lisp expression")))) 117 | :group 'smart-compile) 118 | (put 'smart-compile-alist 'risky-local-variable t) 119 | 120 | (defvar smart-compile-build-root-directory nil 121 | "The directory that the current file path should be taken relative to. 122 | 123 | This is usually the `default-directory', but if there's a \"build system\" (see 124 | `smart-compile-build-system-alist'), it will be the directory that the current file path should be 125 | taken relative to.") 126 | (make-variable-buffer-local 'smart-compile-build-root-directory) 127 | 128 | (defconst smart-compile-replace-alist '( 129 | ("%F" . (buffer-file-name)) 130 | ("%f" . (file-relative-name 131 | (buffer-file-name) 132 | smart-compile-build-root-directory)) 133 | ("%n" . (file-relative-name 134 | (file-name-sans-extension (buffer-file-name)) 135 | smart-compile-build-root-directory)) 136 | ("%e" . (or (file-name-extension (buffer-file-name)) "")) 137 | ("%o" . smart-compile-option-string) 138 | ("%p" . "") 139 | ;; ("%U" . (user-login-name)) 140 | ) 141 | "Alist of %-sequences for format control strings in `smart-compile-alist'.") 142 | (put 'smart-compile-replace-alist 'risky-local-variable t) 143 | 144 | (defcustom smart-compile-make-program "make " 145 | "The command by which to invoke the make program." 146 | :type 'string 147 | :group 'smart-compile) 148 | 149 | (defcustom smart-compile-build-system-alist 150 | '(("\\`[mM]akefile\\'" . smart-compile-make-program) 151 | ("\\`Gemfile\\'" . "bundle install") 152 | ("\\`Rakefile\\'" . "rake") 153 | ("\\`Cargo.toml\\'" . "cargo build ") 154 | ("\\`pants\\'" . "./pants %f")) 155 | "Alist of \"build system file\" patterns vs corresponding format control strings. 156 | 157 | Similar to `smart-compile-alist', each element may look like (REGEXP . STRING) or 158 | (REGEXP . SEXP). 159 | 160 | If a \"build system file\" matching the regexp exists in any parent directory, the `compile-command' 161 | first changes to the directory containing the build system file, and then the string or the sexp 162 | result is used as the rest of the command. 163 | 164 | NOTE: If the matching alist entry is a (REGEXP . STRING), then a similar sequence of %-sequence 165 | replacements from `smart-compile-replace-alist' are applied to the string, but %f and %n are 166 | relative to the \"build root\" directory containing the \"build system file\"." 167 | :type '(repeat 168 | (cons 169 | (regexp :tag "Build system filename pattern") 170 | (choice 171 | (string :tag "Compilation command") 172 | (sexp :tag "Lisp expression")))) 173 | :group 'smart-compile) 174 | (put 'smart-compile-build-system-alist 'risky-local-variable t) 175 | 176 | (defvar smart-compile-check-build-system t) 177 | (make-variable-buffer-local 'smart-compile-check-build-system) 178 | 179 | (defcustom smart-compile-option-string "" 180 | "The option string that replaces %o. The default is empty." 181 | :type 'string 182 | :group 'smart-compile) 183 | 184 | (defun smart-compile--is-root-directory (dir) 185 | "Taken from `ido-is-root-directory'." 186 | (or 187 | (string-equal "/" dir) 188 | (and (memq system-type '(windows-nt ms-dos)) 189 | (string-match "\\`[a-zA-Z]:[/\\]\\'" dir)) 190 | (string-match "\\`/[^:/][^:/]+:\\'" dir))) 191 | 192 | (defun smart-compile--filter-files (paths) 193 | "Return a list with the members of PATHS that are regular files." 194 | (let ((ret nil)) 195 | (dolist (path paths ret) 196 | (when (file-regular-p path) 197 | (push path ret))))) 198 | 199 | (defun smart-compile--find-build-system-file (alist) 200 | "Find the ALIST entry with a matching regexp in any parent directory." 201 | (let ((cur-dir default-directory) 202 | (found-entry nil)) 203 | (while (and (not found-entry) 204 | (not (smart-compile--is-root-directory cur-dir))) 205 | ;; Within each parent directory, loop over the alist and try matching each regexp. 206 | (let ((cur-alist alist)) 207 | (while (and (not found-entry) 208 | cur-alist) 209 | (let* ((regexp (caar cur-alist)) 210 | (build-system-files 211 | (smart-compile--filter-files (directory-files cur-dir t regexp nil)))) 212 | (if build-system-files 213 | (setq found-entry (cons (car build-system-files) (cdar cur-alist))) 214 | (setq cur-alist (cdr cur-alist)))))) 215 | (setq cur-dir (expand-file-name ".." cur-dir))) 216 | found-entry)) 217 | 218 | (defun smart-compile--explicit-same-dir-filename (path) 219 | "Return a file path that always has a leading directory component." 220 | (if (file-name-directory path) 221 | path 222 | (format "./%s" path))) 223 | 224 | ;;;###autoload 225 | (defun smart-compile (&optional arg) 226 | "An interface to `compile'. 227 | It calls `compile' or other compile function, 228 | which is defined in `smart-compile-alist'." 229 | (interactive "p") 230 | (let ((name (buffer-file-name)) 231 | (not-yet t)) 232 | 233 | (if (not name)(error "cannot get filename.")) 234 | ;; (message (number-to-string arg)) 235 | 236 | ;; Set the "root" directory next to the file, for most cases. 237 | (setq smart-compile-build-root-directory default-directory) 238 | (cond 239 | 240 | ;; local command 241 | ;; The prefix 4 (C-u M-x smart-compile) skips this section 242 | ;; in order to re-generate the compile-command 243 | ((and (not (= arg 4)) ; C-u M-x smart-compile 244 | (local-variable-p 'compile-command) 245 | compile-command) 246 | (call-interactively 'compile) 247 | (setq not-yet nil) 248 | ) 249 | 250 | ;; make? or other build systems? 251 | (smart-compile-check-build-system 252 | (let ((maybe-build-system-file 253 | (smart-compile--find-build-system-file smart-compile-build-system-alist))) 254 | (if maybe-build-system-file 255 | (let* ((build-system-file (expand-file-name (car maybe-build-system-file))) 256 | (command-or-string-entry (cdr maybe-build-system-file)) 257 | (command-string 258 | (if (stringp command-or-string-entry) 259 | ;; Set the root directory as the one containing the "build system file". 260 | (let ((smart-compile-build-root-directory 261 | (file-name-directory build-system-file))) 262 | (smart-compile-string command-or-string-entry)) 263 | (eval command-or-string-entry)))) 264 | (if (y-or-n-p (format "%s is found. Try '%s'? " 265 | (smart-compile--explicit-same-dir-filename build-system-file) 266 | command-string)) 267 | ;; Same directory returns nil for `file-name-directory'. 268 | (let ((default-directory (or (file-name-directory build-system-file) 269 | default-directory))) 270 | (set (make-local-variable 'compile-command) 271 | command-string) 272 | (call-interactively 'compile) 273 | (setq not-yet nil)) 274 | (setq smart-compile-check-build-system nil)))) 275 | )) 276 | ) ;; end of (cond ...) 277 | 278 | ;; compile 279 | (let( (alist smart-compile-alist) 280 | (case-fold-search nil) 281 | (function nil) ) 282 | (while (and alist not-yet) 283 | (if (or 284 | (and (symbolp (caar alist)) 285 | (eq (caar alist) major-mode)) 286 | (and (stringp (caar alist)) 287 | (string-match (caar alist) name)) 288 | ) 289 | (progn 290 | (setq function (cdar alist)) 291 | (if (stringp function) 292 | (progn 293 | (set (make-local-variable 'compile-command) 294 | (smart-compile-string function)) 295 | (call-interactively 'compile) 296 | ) 297 | (if (listp function) 298 | (eval function) 299 | )) 300 | (setq alist nil) 301 | (setq not-yet nil) 302 | ) 303 | (setq alist (cdr alist)) ) 304 | )) 305 | 306 | ;; If compile-command is not defined and the contents begins with "#!", 307 | ;; set compile-command to filename. 308 | (if (and not-yet 309 | (not (memq system-type '(windows-nt ms-dos))) 310 | (not (string-match "/\\.[^/]+$" name)) 311 | (not 312 | (and (local-variable-p 'compile-command) 313 | compile-command)) 314 | ) 315 | (save-restriction 316 | (widen) 317 | (if (equal "#!" (buffer-substring 1 (min 3 (point-max)))) 318 | (set (make-local-variable 'compile-command) name) 319 | )) 320 | ) 321 | 322 | ;; compile 323 | (if not-yet (call-interactively 'compile) ) 324 | 325 | )) 326 | 327 | (defun smart-compile-string (format-string) 328 | "Replace all the special format specifiers from `smart-compile-replace-alist' in FORMAT-STRING. 329 | 330 | If `buffer-file-name' is not bound to a string, no replacements will be made." 331 | (when (and (boundp 'buffer-file-name) 332 | (stringp buffer-file-name)) 333 | (let ((case-fold-search nil) 334 | curpos) 335 | (dolist (elt smart-compile-replace-alist) 336 | (let ((token (car elt)) 337 | (replace (cdr elt))) 338 | (while (string-match token format-string) 339 | (when (string= "%p" token) 340 | (setq curpos (match-beginning 0))) 341 | (setq format-string 342 | (replace-match 343 | (eval (or replace "")) t nil format-string))))) 344 | `(cons ,format-string ,(1+ (or curpos (length format-string)))) 345 | ))) 346 | 347 | (provide 'smart-compile) 348 | 349 | ;;; smart-compile.el ends here 350 | -------------------------------------------------------------------------------- /mac-key-mode.el: -------------------------------------------------------------------------------- 1 | ;;; mac-key-mode.el --- mac-style key bindings for Emacs -*- lexical-binding: nil -*- 2 | 3 | ;; Copyright (C) 2004-2010, 2025 Seiji Zenitani 4 | 5 | ;; Author: Seiji Zenitani 6 | ;; Keywords: tools, mac 7 | ;; Created: 2004-12-27 8 | ;; Compatibility: Emacs 30 on macOS 9 | ;; URL: https://github.com/zenitani/elisp 10 | 11 | ;; This file is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation; either version 3, or (at your option) 14 | ;; any later version. 15 | 16 | ;; This file is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to 23 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 | ;; Boston, MA 02111-1307, USA. 25 | 26 | ;;; Commentary: 27 | 28 | ;; This package provides mac-key-mode, a minor mode that provides 29 | ;; additional mac-like key bindings and elisp functions. 30 | ;; 31 | ;; To use this package, add these lines to your .emacs file: 32 | ;; 33 | ;; (require 'mac-key-mode) 34 | ;; (mac-key-mode 1) 35 | ;; 36 | ;; With help from htmlize.el , 37 | ;; it provides the following printing functions. 38 | ;; 39 | ;; * M-x mac-key-print-buffer 40 | ;; * M-x mac-key-print-buffer-with-faces 41 | 42 | 43 | ;;; Code: 44 | 45 | (defgroup mac-key-mode nil 46 | "Mac-style key-binding mode." 47 | :group 'ns) 48 | (defconst mac-key-mode-lighter 49 | (char-to-string 8984) ;; the command mark 50 | ;; (char-to-string 127822) ;; the Apple mark (Emoji) 51 | "A lighter string which is displayed in the modeline 52 | when `mac-key-mode' is on.") 53 | 54 | (defcustom mac-key-mode-hook nil 55 | "The hook to run when mac-key-mode is toggled." 56 | :type 'hook 57 | :group 'mac-key-mode) 58 | 59 | 60 | (defcustom mac-key-printing t 61 | "If non-nil, activate printing functions. 62 | This requires htmlize.el ." 63 | :group 'mac-key-mode 64 | :type 'boolean) 65 | 66 | (defcustom mac-key-print-kill-view-buffers t 67 | "If non-nil, delete the temporary buffer after sending it to TextEdit.app, 68 | when printing with the `mac-key-print-buffer' functions. " 69 | :group 'mac-key-mode 70 | :type 'boolean) 71 | 72 | (defcustom mac-key-print-font-size 8 73 | "Font size, in points, for ordinary text, for `mac-key-printing'. " 74 | :group 'mac-key-mode) 75 | 76 | 77 | ;; process objects 78 | (defvar mac-key-speech-process nil 79 | "The process object for text-to-speech subprocess.") 80 | (defvar mac-key-ql-process nil 81 | "The process object for Quick Look subprocess.") 82 | 83 | 84 | (defvar mac-key-mode-map 85 | (let ((map (make-sparse-keymap))) 86 | (define-key map [?\s-w] 'mac-key-close-window) 87 | (define-key map [?\s-Z] 'undo-redo) 88 | (define-key map [?\s-i] 'mac-key-show-in-finder) 89 | (define-key map [?\s-p] 'mac-key-print-buffer-with-faces) 90 | (define-key map [?\s-/] 'info) 91 | (define-key map [?\s-.] 'keyboard-quit) 92 | (define-key map [s-up] 'beginning-of-buffer) 93 | (define-key map [s-down] 'end-of-buffer) 94 | (define-key map [s-mouse-1] 'browse-url-at-mouse) 95 | (define-key map [C-down-mouse-1] 'mac-key-context-menu) 96 | ;; (define-key map [mouse-3] 'mac-key-context-menu) 97 | ;; (define-key map [A-S-mouse-1] 'mouse-buffer-menu) 98 | ;; (define-key map [S-down-mouse-1] 'mac-key-shift-mouse-select) 99 | map) 100 | "Keymap for `mac-key-mode'.") 101 | 102 | ;; mode-line menu 103 | (define-key-after mode-line-mode-menu [mac-key-mode] 104 | `(menu-item ,(purecopy 105 | (concat "Mac Key (" mac-key-mode-lighter ")")) 106 | mac-key-mode :button (:toggle . mac-key-mode)) 107 | 'highlight-changes-mode) 108 | 109 | ;;;###autoload 110 | (define-minor-mode mac-key-mode 111 | "Toggle Mac Key mode. 112 | With arg, turn Mac Key mode on if arg is positive. 113 | When Mac Key mode is enabled, mac-style key bindings are provided." 114 | :global t 115 | :group 'mac-key-mode 116 | :lighter (" " mac-key-mode-lighter) 117 | :keymap mac-key-mode-map 118 | (if mac-key-mode 119 | (progn 120 | 121 | ;; menu items 122 | (define-key-after menu-bar-file-menu [mac-key-file-separator1] 123 | '("--" . nil) 'recover-session) 124 | (define-key-after menu-bar-file-menu [mac-key-print-buffer-color] 125 | '(menu-item "Print Buffer" mac-key-print-buffer-with-faces 126 | :help "Print current file/directory via TextEdit.app" 127 | :enable (and mac-key-printing (featurep 'htmlize))) 128 | 'mac-key-file-separator1) 129 | (define-key-after menu-bar-file-menu [mac-key-print-buffer-mono] 130 | '(menu-item "Print Buffer (Mono)" mac-key-print-buffer 131 | :help "Print current file/directory via TextEdit.app" 132 | :enable (and mac-key-printing (featurep 'htmlize))) 133 | 'mac-key-print-buffer-color) 134 | (define-key-after menu-bar-file-menu [mac-key-file-separator2] 135 | '("--" . nil) 'mac-key-print-buffer-mono) 136 | (define-key-after menu-bar-file-menu [mac-key-show-in-finder] 137 | '(menu-item "Show In Finder" mac-key-show-in-finder 138 | :help "Display current file/directory in a Finder window" 139 | :enable (or (and (boundp 'buffer-file-name) buffer-file-name) 140 | (and (boundp 'dired-directory) dired-directory))) 141 | 'mac-key-file-separator2) 142 | (define-key-after menu-bar-file-menu [mac-key-open-terminal] 143 | '(menu-item "Open Terminal" mac-key-open-terminal 144 | :help "Launch Terminal.app and go to the relevant directory") 145 | 'mac-key-show-in-finder) 146 | 147 | ;; assign mac-key-quick-look to the SPC key 148 | (if (boundp 'dired-mode-map) 149 | (define-key dired-mode-map " " 'mac-key-quick-look) 150 | (add-hook 'dired-mode-hook 151 | (lambda () (interactive) 152 | (define-key dired-mode-map " " 'mac-key-quick-look))) 153 | ) 154 | 155 | );) 156 | (progn 157 | 158 | ;; menu items 159 | (global-unset-key [menu-bar file mac-key-file-separator1]) 160 | (global-unset-key [menu-bar file mac-key-print-buffer-color]) 161 | (global-unset-key [menu-bar file mac-key-print-buffer-mono]) 162 | (global-unset-key [menu-bar file mac-key-file-separator2]) 163 | (global-unset-key [menu-bar file mac-key-show-in-finder]) 164 | (global-unset-key [menu-bar file mac-key-open-terminal]) 165 | 166 | ;; restore SPC to dired-next-line (a bad way to deal with it) 167 | (if (boundp 'dired-mode-map) 168 | (define-key dired-mode-map " " 'dired-next-line)) 169 | (remove-hook 'dired-mode-hook 170 | (lambda () (interactive) 171 | (define-key dired-mode-map " " 'mac-key-quick-look))) 172 | 173 | ) 174 | )) 175 | 176 | 177 | ;; close window (command + W) 178 | (defun mac-key-close-window () 179 | "Close the Quick Look window or kill the current buffer." 180 | (interactive) 181 | (let ((mybuffer (and mac-key-ql-process 182 | (process-buffer mac-key-ql-process)))) 183 | (if (buffer-live-p mybuffer) 184 | (kill-buffer mybuffer)) 185 | (kill-this-buffer) 186 | )) 187 | 188 | 189 | ;; Show In Finder (command + I) 190 | (defun mac-key-show-in-finder (&optional path) 191 | "Display current file/directory in a Finder window" 192 | (interactive) 193 | (let ((item (or path 194 | (and (boundp 'buffer-file-name) buffer-file-name) 195 | (and (eq major-mode 'dired-mode) default-directory)) )) 196 | (cond 197 | ((not (stringp item))) 198 | ((file-remote-p item) 199 | (error "This item is located on a remote system.")) 200 | (t 201 | (setq item (expand-file-name item)) 202 | (condition-case err 203 | (progn 204 | (do-applescript 205 | (concat 206 | "tell application \"Finder\" to select (\"" 207 | item "\" as POSIX file)")) 208 | (do-applescript "tell application \"Finder\" to activate") 209 | ) 210 | (error err))) 211 | 212 | ))) 213 | 214 | 215 | ;; Open Terminal.app 216 | (defun mac-key-open-terminal (&optional path) 217 | "Launch Terminal and go to the relevant directory" 218 | (interactive) 219 | (let ((item (or path default-directory))) 220 | 221 | (cond 222 | ((not (stringp item))) 223 | ((file-remote-p item) 224 | (error "This item is located on a remote system.")) 225 | ((file-directory-p item) 226 | (setq item (expand-file-name item)) 227 | (condition-case err 228 | (progn 229 | (do-applescript 230 | (concat "tell application \"Terminal\" to do script" 231 | " with command \"cd \" & quoted form of \"" 232 | item "\"" )) 233 | (do-applescript "tell application \"Terminal\" to activate") 234 | ) 235 | (error err)) 236 | ) 237 | (t (error "An error occured")) 238 | ))) 239 | 240 | 241 | ;; Print buffer contents (command + P) 242 | (defun mac-key-print-buffer-with-faces(&optional region-only) 243 | "Convert buffer contents to html, preserving colors and decoration, and 244 | print it via TextEdit.app. 245 | If REGION-ONLY is non-nil then only the region is printed." 246 | (interactive) 247 | (if (not (featurep 'htmlize)) 248 | (message "It doesn't work, because htmlize is not available.") 249 | 250 | (let* ((default-directory "~/") ;; When editing a remote file 251 | (htmlize-after-hook nil) 252 | (htmlize-generate-hyperlinks nil) 253 | (htmlize-output-type 'css) 254 | (htmlize-head-tags 255 | (concat "\n")) 259 | ) 260 | (message "printing...") 261 | (do-applescript "tell application \"TextEdit.app\" to activate") 262 | (do-applescript (concat " 263 | tell application \"TextEdit.app\" 264 | try 265 | print alias (POSIX file \"" (mac-key-print-htmlize-buffer-to-tempfile region-only) "\") with print dialog 266 | end try 267 | end tell 268 | ")) 269 | (message "printing... done") 270 | ))) 271 | 272 | ;; Print buffer contents (no color) 273 | (defun mac-key-print-buffer(&optional region-only) 274 | "Convert buffer contents to html, and then print it via TextEdit.app. 275 | If REGION-ONLY is non-nil then only the region is printed." 276 | (interactive) 277 | (if (not (featurep 'htmlize)) 278 | (message "It doesn't work, because htmlize is not available.") 279 | 280 | (let* ((default-directory "~/") ;; When editing a remote file 281 | (htmlize-after-hook '(mac-key-print-monolize-html)) 282 | (htmlize-generate-hyperlinks nil) 283 | (htmlize-output-type 'css) 284 | (htmlize-head-tags 285 | (concat "\n")) 289 | ) 290 | (message "printing...") 291 | (do-applescript "tell application \"TextEdit.app\" to activate") 292 | (do-applescript (concat " 293 | tell application \"TextEdit.app\" 294 | try 295 | print alias (POSIX file \"" (mac-key-print-htmlize-buffer-to-tempfile region-only) "\") with print dialog 296 | end try 297 | end tell 298 | ")) 299 | (message "printing... done") 300 | ))) 301 | 302 | (defun mac-key-print-monolize-html () 303 | (narrow-to-region 304 | (search-forward " ")) 306 | (goto-char (point-min)) 307 | (replace-regexp " color: \#.*" "") 308 | (replace-regexp " background-color: \#.*" "") 309 | (widen) 310 | ) 311 | 312 | (defun mac-key-print-htmlize-buffer-to-tempfile(region-only) 313 | "Convert buffer contents to html, preserving colors and decoration. 314 | If REGION-ONLY is non-nil then only region contents are htmlized. 315 | Return a cons with temporary file name followed by temporary buffer." 316 | (save-excursion 317 | (let (;; Just use Fundamental mode for the temp buffer 318 | magic-mode-alist 319 | auto-mode-alist 320 | (html-temp-buffer 321 | (if (not region-only) 322 | (htmlize-buffer (current-buffer)) 323 | (let ((start (mark)) (end (point))) 324 | (or (<= start end) 325 | (setq start (prog1 end (setq end start)))) 326 | (htmlize-region start end)))) 327 | (file (make-temp-file "emacs-print-" nil ".html"))) 328 | (set-buffer html-temp-buffer) 329 | (write-file file nil) 330 | (if mac-key-print-kill-view-buffers (kill-buffer html-temp-buffer)) 331 | file))) 332 | 333 | 334 | 335 | ;; Text-to-Speech functions 336 | (defun mac-key-speak-buffer () 337 | "Speak buffer contents." 338 | (interactive) 339 | (mac-key-speak-region (point-min)(point-max))) 340 | 341 | (defun mac-key-speak-region (beg end) 342 | "Speak the region contents." 343 | (interactive "r") 344 | (mac-key-stop-speaking) 345 | (let ((buffer-file-coding-system 'utf-8-unix) 346 | (tmp-file (make-temp-file "emacs-speech-" nil ".txt"))) 347 | (write-region beg end tmp-file nil) 348 | (message "Invoking text-to-speech...") 349 | (setq mac-key-speech-process 350 | (start-process "text-to-speech" "*Text-to-Speech Output*" 351 | "/usr/bin/say" "-f" tmp-file)) 352 | )) 353 | 354 | (defun mac-key-stop-speaking () 355 | "Terminate the text-to-speech subprocess, if it is running." 356 | (interactive) 357 | (let ((mybuffer (and mac-key-speech-process 358 | (process-buffer mac-key-speech-process)))) 359 | (when (buffer-live-p mybuffer) 360 | (kill-buffer mybuffer) 361 | (beep)) 362 | )) 363 | 364 | 365 | ;; Quick Look 366 | ;; inspired by https://news.mynavi.jp/article/osx-263/ 367 | (defun mac-key-quick-look () 368 | "Display the Quick Look information for the current line\'s file. 369 | You might use dired-mode-hook to use this function in dired mode, 370 | like this: 371 | 372 | (add-hook \'dired-mode-hook 373 | (lambda() (local-set-key \" \" \'mac-key-quick-look))) 374 | " 375 | (interactive) 376 | 377 | (let ((mybuffer (and mac-key-ql-process 378 | (process-buffer mac-key-ql-process))) 379 | (item default-directory)) 380 | (cond 381 | ;; (eq (process-status mac-key-ql-process) 'run) 382 | ;; (kill-process mac-key-ql-process)) 383 | ((file-remote-p item) 384 | (error "This item is located on a remote system.")) 385 | (t 386 | (if (buffer-live-p mybuffer) 387 | (kill-buffer mybuffer)) 388 | (setq item (expand-file-name item)) 389 | (condition-case err 390 | (setq item (dired-get-file-for-visit)) 391 | (error err)) 392 | (condition-case err 393 | (setq mac-key-ql-process 394 | (start-process "quicklook" "*QuickLook Output*" 395 | "/usr/bin/qlmanage" "-p" 396 | (shell-quote-argument item))) 397 | (error err))) 398 | ))) 399 | 400 | 401 | ;; Contextual menu 402 | (defun mac-key-context-menu (event) 403 | "Pop up a contextual menu." 404 | (interactive "e") 405 | 406 | (let ((editable (not buffer-read-only)) 407 | (pt (save-excursion (mouse-set-point last-nonmenu-event))) 408 | beg end 409 | ) 410 | 411 | ;; getting word boundaries 412 | (if (and mark-active 413 | (<= (region-beginning) pt) (<= pt (region-end)) ) 414 | (setq beg (region-beginning) 415 | end (region-end)) 416 | (save-excursion 417 | (goto-char pt) 418 | (setq end (progn (forward-word) (point))) 419 | (setq beg (progn (backward-word) (point))) 420 | )) 421 | 422 | ;; popup menu 423 | (popup-menu 424 | '(nil 425 | ;; ["Search in Spotlight" 426 | ;; (mac-spotlight-search (buffer-substring-no-properties beg end)) 427 | ;; :active (fboundp 'mac-spotlight-search) 428 | ;; :help "Do a Spotlight search of word at cursor"] 429 | ["Search in Google" 430 | (browse-url 431 | (concat "http://www.google.com/search?q=" 432 | (url-hexify-string (buffer-substring-no-properties beg end)))) 433 | :help "Ask a WWW browser to do a Google search"] 434 | ["--" nil] 435 | ["Look Up in Dictionary" 436 | (browse-url 437 | (concat "dict:///" 438 | (url-hexify-string (buffer-substring-no-properties beg end)))) 439 | :active t 440 | :help "Look up word at cursor in Dictionary.app"] 441 | ["--" nil] 442 | ["Cut" (clipboard-kill-region beg end) :active (and editable mark-active) 443 | :help "Delete text in region and copy it to the clipboard"] 444 | ["Copy" (clipboard-kill-ring-save beg end) :active mark-active 445 | :help "Copy text in region to the clipboard"] 446 | ["Paste" (clipboard-yank) :active editable 447 | :help "Paste text from clipboard"] 448 | ["--" nil] 449 | ("Spelling" 450 | ["Spelling..." 451 | (progn (goto-char end)(ispell-word)) :active editable 452 | :help "Spell-check word at cursor"] 453 | ["Check Spelling" (ispell-buffer) :active editable 454 | :help "Check spelling of the current buffer"] 455 | ["Check Spelling as You Type" 456 | (flyspell-mode) 457 | :style toggle :selected flyspell-mode :active editable 458 | :help "Check spelling while you edit the text"] 459 | ) 460 | ("Font" 461 | ["Show Fonts" (ignore) :active nil] 462 | ["Bold" (ignore) :active nil] 463 | ["Italic" (ignore) :active nil] 464 | ["Underline" (ignore) :active nil] 465 | ["Outline" (ignore) :active nil] 466 | ["Styles..." (ignore) :active nil] 467 | ["--" nil] 468 | ["Show Colors" (ignore) :active nil] 469 | ) 470 | ("Speech" 471 | ["Start Speaking" 472 | (if (and mark-active 473 | (<= (region-beginning) pt) (<= pt (region-end)) ) 474 | (mac-key-speak-region beg end) 475 | (mac-key-speak-buffer) ) 476 | :help "Speak text through the sound output"] 477 | ["Stop Speaking" (mac-key-stop-speaking) 478 | :active (and mac-key-speech-process 479 | (eq (process-status mac-key-speech-process) 'run)) 480 | :help "Stop speaking"] 481 | ) 482 | ["--" nil] 483 | ["Buffers" mouse-buffer-menu 484 | :help "Pop up a menu of buffers for selection with the mouse"] 485 | )))) 486 | 487 | 488 | (provide 'mac-key-mode) 489 | 490 | ;;; mac-key-mode.el ends here. 491 | --------------------------------------------------------------------------------