Mercurial > hg > Members > kokubo > emacs

annotate .emacs.d/haskell-mode/haskell-str.el @ 0:2764b4f45f9f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
1st commit
author Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
date Mon, 21 Apr 2014 04:30:59 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 ;;; haskell-str.el --- Haskell related string utilities
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 ;; Copyright (C) 2013 Herbert Valerio Riedel
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 ;; Author: Herbert Valerio Riedel <hvr@gnu.org>
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 ;; This file is not part of GNU Emacs.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 ;; This file is free software; you can redistribute it and/or modify
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 3 of the License, or
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 ;; (at your option) any later version.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 ;; This file is distributed in the hope that it will be useful,
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 ;; GNU General Public License for more details.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 ;;; Commentary:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 ;;; Todo:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 ;; - write ERT tests
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 ;;; Code:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 (defun haskell-str-trim (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 "Remove whitespace around STRING.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 A Whitespace character is defined in the Haskell Report as follows
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 whitechar -> newline | vertab | space | tab | uniWhite
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 newline -> return linefeed | return | linefeed | formfeed
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 uniWhite -> any Unicode character defined as whitespace
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 Note: The implementation currently only supports ASCII
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 white-space characters, i.e. the implemention doesn't
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 consider uniWhite."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 (let ((s1 (if (string-match "[\t\n\v\f\r ]+\\'" string) (replace-match "" t t string) string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 (if (string-match "\\`[\t\n\v\f\r ]+" s1) (replace-match "" t t s1) s1)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 (defun haskell-str-only-spaces-p (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
47 "Return t if STRING contains only whitespace (or is empty)."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
48 (string= "" (haskell-str-trim string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
49
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
50 (defun haskell-str-take (string n)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 "Return (up to) N character length prefix of STRING."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
52 (substring string 0 (min (length string) n)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
53
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 (defalias 'haskell-str-is-prefix-of-p 'string-prefix-p)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
55
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 (defun haskell-str-is-suffix-of-p (str1 str2 &optional ignore-case)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
57 "Return non-nil if STR1 is a suffix of STR2.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
58 If IGNORE-CASE is non-nil, the comparison is done without paying attention
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
59 to case differences.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
60
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
61 Dual to `haskell-str-is-prefix-of-p'"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
62 (let ((pos (- (length str2) (length str1))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 (if (>= pos 0)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 (eq t (compare-strings str1 nil nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 str2 pos nil ignore-case)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
66
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 (defconst haskell-str-literal-encode-ascii-array
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
68 [ "\\NUL" "\\SOH" "\\STX" "\\ETX" "\\EOT" "\\ENQ" "\\ACK" "\\a" "\\b" "\\t" "\\n" "\\v" "\\f" "\\r" "\\SO" "\\SI" "\\DLE" "\\DC1" "\\DC2" "\\DC3" "\\DC4" "\\NAK" "\\SYN" "\\ETB" "\\CAN" "\\EM" "\\SUB" "\\ESC" "\\FS" "\\GS" "\\RS" "\\US" " " "!" "\\\"" "#" "$" "%" "&" "'" "(" ")" "*" "+" "," "-" "." "/" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" "<" "=" ">" "?" "@" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "[" "\\\\" "]" "^" "_" "`" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "{" "|" "}" "~" "\\DEL" ]
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 "Array of encodings for 7-bit ASCII character points indexed by ASCII value.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
70
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 (defun haskell-str-literal-encode (str &optional no-quotes)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
72 "Encode STR according Haskell escape rules using 7-bit ASCII representation.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
73
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 The serialization has been implement to closely match the
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 behaviour of GHC's Show instance for Strings.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
76
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
77 If NO-QUOTES is non-nil, omit wrapping result in quotes.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
78
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 This is the dual operation to `haskell-str-literal-decode'."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
80
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
81 (let ((lastc -1))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
82 (let ((encode (lambda (c)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 (let ((lc lastc))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
84 (setq lastc c)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
85 (if (>= c 128) ;; if non-ASCII code point
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 (format "\\%d" c)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 ;; else, for ASCII code points
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
88 (if (or (and (= lc 14) (= c ?H)) ;; "\SO\&H"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 (and (>= lc 128) (>= c ?0) (<= c ?9))) ;; "\123\&4"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 (concat "\\&" (aref haskell-str-literal-encode-ascii-array c))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
91 (aref haskell-str-literal-encode-ascii-array c)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
92 ))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
93
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
94 (if no-quotes
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
95 (mapconcat encode str "")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
96 (concat "\"" (mapconcat encode str "") "\"")))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
97
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
98 (defconst haskell-str-literal-escapes-regexp
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
99 (concat "[\\]\\(?:"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
100 (regexp-opt (append
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
101 (mapcar (lambda (c) (format "%c" c))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
102 "abfnrtv\\\"'&") ;; "charesc" escape sequences
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 (mapcar (lambda (c) (format "^%c" c))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 "ABCDEFGHIJKLMNOPQRSTUVWXYZ@[\\]^_") ;; "cntrl" escape sequences
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 (mapcar (lambda (s) (format "%s" s))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 (split-string "NUL SOH STX ETX EOT ENQ ACK BEL BS HT LF VT FF CR
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
107 SO SI DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM SUB ESC
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 FS GS RS US SP DEL")))) ;; "ascii" (w\o "cntrl") escape sequences
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
109 "\\|" "[\t\n\v\f\r ]+[\\]" ;; whitespace gaps
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 "\\|" "[0-9]+" ;; decimal escape sequence
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 "\\|" "o[0-7]+" ;; octal escape sequence
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 "\\|" "x[0-9a-f]+" ;; hex escape sequence
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 "\\)?") ;; everything else is an invalid escape sequence
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 "Regexp for matching escape codes in string literals.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 See Haskell Report Sect 2.6,
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 URL `http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6',
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 for more details.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
118
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 (defconst haskell-str-literal-decode1-table
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 (let ((h (make-hash-table :test 'equal)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 (mapc (lambda (c) (puthash (concat "\\" (car c)) (cdr c) h))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 '(;; ascii-escapes
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 ("NUL" . "\x00") ("SOH" . "\x01") ("STX" . "\x02") ("ETX" . "\x03") ("EOT" . "\x04") ("ENQ" . "\x05")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 ("ACK" . "\x06") ("BEL" . "\x07") ("BS" . "\x08") ("HT" . "\x09") ("LF" . "\x0a") ("VT" . "\x0b")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 ("FF" . "\x0c") ("CR" . "\x0d") ("SO" . "\x0e") ("SI" . "\x0f") ("DLE" . "\x10") ("DC1" . "\x11")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 ("DC2" . "\x12") ("DC3" . "\x13") ("DC4" . "\x14") ("NAK" . "\x15") ("SYN" . "\x16") ("ETB" . "\x17")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 ("CAN" . "\x18") ("EM" . "\x19") ("SUB" . "\x1a") ("ESC" . "\x1b") ("FS" . "\x1c") ("GS" . "\x1d")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
128 ("RS" . "\x1e") ("US" . "\x1f") ("SP" . "\x20") ("DEL" . "\x7f" )
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 ;; C-compatible single-char escape sequences
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 ("a" . "\x07") ("b" . "\x08") ("f" . "\x0c") ("n" . "\x0a") ("r" . "\x0d") ("t" . "\x09") ("v" . "\x0b")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
131 ;; trivial escapes
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
132 ("\\" . "\\") ("\"" . "\"") ("'" . "'")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
133 ;; "empty" escape
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
134 ("&" . "")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
135 h)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
136 "Hash table containing irregular escape sequences and their decoded strings.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
137 Used by `haskell-str-literal-decode1'.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
138
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
139 (defun haskell-str-literal-decode1 (l)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
140 "Decode a single string literal escape sequence.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
141 L must contain exactly one escape sequence.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 This is an internal function used by `haskell-str-literal-decode'."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
143 (let ((case-fold-search nil))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
144 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
145 ((gethash l haskell-str-literal-decode1-table))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
146 ((string-match "\\`[\\][0-9]+\\'" l) (char-to-string (string-to-number (substring l 1) 10)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
147 ((string-match "\\`[\\]x[[:xdigit:]]+\\'" l) (char-to-string (string-to-number (substring l 2) 16)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
148 ((string-match "\\`[\\]o[0-7]+\\'" l) (char-to-string (string-to-number (substring l 2) 8)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
149 ((string-match "\\`[\\]\\^[@-_]\\'" l) (char-to-string (- (aref l 2) ?@))) ;; "cntrl" escapes
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
150 ((string-match "\\`[\\][\t\n\v\f\r ]+[\\]\\'" l) "") ;; whitespace gap
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
151 (t (error "Invalid escape sequence")))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
152
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
153 (defun haskell-str-literal-decode (estr &optional no-quotes)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
154 "Decode a Haskell string-literal.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
155 If NO-QUOTES is nil, ESTR must be surrounded by quotes.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
156
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
157 This is the dual operation to `haskell-str-literal-encode'."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
158 (if (and (not no-quotes)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
159 (string-match-p "\\`\"[^\\\"[:cntrl:]]*\"\\'" estr))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
160 (substring estr 1 -1) ;; optimized fast-path for trivial strings
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
161 (let ((s (if no-quotes ;; else: do general decoding
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
162 estr
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
163 (if (string-match-p "\\`\".*\"\\'" estr)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
164 (substring estr 1 -1)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
165 (error "String literal must be delimited by quotes"))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
166 (case-fold-search nil))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
167 (replace-regexp-in-string haskell-str-literal-escapes-regexp #'haskell-str-literal-decode1 s t t))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
168
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
169 (defun haskell-str-ellipsize (string n)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
170 "Return STRING truncated to (at most) N characters.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
171 If truncation occured, last character in string is replaced by `…'.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
172 See also `haskell-str-take'."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
173 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
174 ((<= (length string) n) string) ;; no truncation needed
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
175 ((< n 1) "")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
176 (t (concat (substring string 0 (1- n)) "…"))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
177
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
178 (provide 'haskell-str)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
179
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
180 ;;; haskell-str.el ends here