modules/ml-string.cc

   1 #include "ml-string.h"
   2 #include "ml.h"
   3 #include "mlenv.h"
   4 #include "motorenv.h"
   5 #include "motoroutput.h"
   6 #include "util_const.h"
   7 #include "util_random.h"
   8 #include "util_string.h"
   9 #include "expr.h"
  10 #include "utf8.h"
  11 #include "utf16.h"
  12 #include "ustring.h"
  13 #include <vector>
  14 #include <boost/ptr_container/ptr_vector.hpp>
  15 #include <exception>
  16 #include <stdlib.h>
  17
  18 /*DOC:
  19 ==string function==
  20
  21 */
  22 /*DOC:
  23 ===concat===
  24  (concat STRING...) -> STRING
  25 パラメータの文字列を連結して一つの文字列を返す。
  26
  27 */
  28 //#AFUNC        concat  ml_concat
  29 //#WIKIFUNC     concat
  30 MNode*  ml_concat (MNode* cell, MlEnv* mlenv) {
  31     MNode*  arg = cell->cdr ();
  32     AutoDelete<ustring>  a1;
  33
  34     a1 = new ustring;
  35     a1 ()->reserve (256);
  36
  37     while (arg) {
  38         a1 ()->append (eval_str (arg->car (), mlenv));
  39         nextNode (arg);
  40     }
  41     return newMNode_str (a1.release ());
  42 }
  43
  44 /*DOC:
  45 ===megabyte===
  46  (megabyte NUMBER) -> STRING
  47
  48 */
  49 //#AFUNC        megabyte        ml_megabyte
  50 //#WIKIFUNC     megabyte
  51 MNode*  ml_megabyte (MNode* cell, MlEnv* mlenv) {
  52     MNode*  arg = cell->cdr ();
  53     double  val;
  54     ustring  u;
  55
  56     if (! arg)
  57         throw (uErrorWrongNumber);
  58
  59     val = eval_double (arg->car (), mlenv);
  60     nextNode (arg);
  61     if (arg)
  62         throw (uErrorWrongNumber);
  63
  64     if (val < 900) {
  65         u = to_ustring (val);
  66         return newMNode_str (new ustring (u));
  67     }
  68     val = floor (val / 1024. * 10.) / 10.;
  69     if (val < 900) {
  70         u = to_ustring (val);
  71         u.append (CharConst ("K"));
  72         return newMNode_str (new ustring (u));
  73     }
  74     val = floor (val / 1024. * 10. ) / 10.;
  75     if (val < 900) {
  76         u = to_ustring (val);
  77         u.append (CharConst ("M"));
  78         return newMNode_str (new ustring (u));
  79     }
  80     val = floor (val / 1024. * 10.) / 10.;
  81     if (val < 900) {
  82         u = to_ustring (val);
  83         u.append (CharConst ("G"));
  84         return newMNode_str (new ustring (u));
  85     }
  86     val = floor (val / 1024. * 10.) / 10.;
  87     if (val < 900) {
  88         u = to_ustring (val);
  89         u.append (CharConst ("T"));
  90         return newMNode_str (new ustring (u));
  91     }
  92     val = floor (val / 1024. * 10.) / 10.;
  93     u = to_ustring (val);
  94     u.append (CharConst ("P"));
  95     return newMNode_str (new ustring (u));
  96 }
  97
  98 /*DOC:
  99 ===c3===
 100  (c3 INTEGER) -> STRING
 101
 102 */
 103 //#AFUNC        c3      ml_c3
 104 //#WIKIFUNC     c3
 105 MNode*  ml_c3 (MNode* cell, MlEnv* mlenv) {
 106     MNode*  arg = cell->cdr ();
 107     ustring  u;
 108
 109     if (! arg)
 110         throw (uErrorWrongNumber);
 111
 112     u = eval_str (arg->car (), mlenv);
 113     nextNode (arg);
 114     if (arg)
 115         throw (uErrorWrongNumber);
 116
 117     return newMNode_str (new ustring (c3 (u)));
 118 }
 119
 120 /*DOC:
 121 ===regexp-match===
 122  (regexp-match REGEX TEXT [#i | :i BOOL]) -> BOOL
 123
 124 */
 125 //#AFUNC        regexp-match    ml_regexp_match
 126 //#WIKIFUNC     regexp-match
 127 MNode*  ml_regexp_match (MNode* cell, MlEnv* mlenv) {
 128     MNode*  arg = cell->cdr ();
 129     ustring  reg;
 130     ustring  t;
 131     boost::wregex::flag_type  f = boost::regex_constants::normal;
 132     bool  ans;
 133     std::vector<MNode*>  params;
 134     std::vector<MNode*>  keywords;
 135     static paramList  kwlist[] = {
 136         {CharConst ("i"), true},
 137         {NULL, 0, 0}
 138     };
 139
 140     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 141     reg = eval_str (params[0], mlenv);
 142     t = eval_str (params[1], mlenv);
 143     if (eval_bool (keywords[0], mlenv))
 144         f |= boost::regex_constants::icase;
 145
 146 #if 0
 147     mlenv->env->regtext = utow (t);
 148     std::wstring  wreg = utow (reg);
 149     boost::wregex  wre (wreg, f);
 150     ans = regex_search (mlenv->env->regtext, mlenv->env->regmatch, wre, boost::regex_constants::match_single_line);
 151 #endif
 152     ans = wsearch_env (mlenv, t, mlenv->env->regmatch, reg, f);
 153
 154     return newMNode_bool (ans);
 155 }
 156
 157 /*DOC:
 158 ===match-string===
 159  (match-string NUM) -> STRING
 160
 161 */
 162 //#AFUNC        match-string    ml_match_string
 163 //#WIKIFUNC     match-string
 164 MNode*  ml_match_string (MNode* cell, MlEnv* mlenv) {
 165     MNode*  arg = cell->cdr ();
 166     int  n;
 167     MNode*  ans = NULL;
 168
 169     if (! arg)
 170         throw (uErrorWrongNumber);
 171     n = eval_int (arg->car (), mlenv);
 172     nextNode (arg);
 173     if (arg)
 174         throw (uErrorWrongNumber);
 175
 176     if (0 <= n && n < mlenv->env->regmatch.size ()) {
 177         ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->env->regmatch[n].first, mlenv->env->regmatch[n].second))));
 178     }
 179
 180     return ans;
 181 }
 182
 183 /*DOC:
 184 ===prematch===
 185  (prematch) -> STRING
 186
 187 */
 188 //#AFUNC        prematch        ml_prematch
 189 //#WIKIFUNC     prematch
 190 MNode*  ml_prematch (MNode* cell, MlEnv* mlenv) {
 191     MNode*  arg = cell->cdr ();
 192     MNode*  ans = NULL;
 193     std::wstring::const_iterator  b = mlenv->env->regtext.begin ();
 194
 195     if (arg)
 196         throw (uErrorWrongNumber);
 197
 198     ans = newMNode_str (new ustring (wtou (std::wstring (b, mlenv->env->regmatch[0].first))));
 199
 200     return ans;
 201 }
 202
 203 /*DOC:
 204 ===postmatch===
 205  (postmatch) -> STRING
 206
 207 */
 208 //#AFUNC        postmatch       ml_postmatch
 209 //#WIKIFUNC     postmatch
 210 MNode*  ml_postmatch (MNode* cell, MlEnv* mlenv) {
 211     MNode*  arg = cell->cdr ();
 212     MNode*  ans = NULL;
 213     std::wstring::const_iterator  e = mlenv->env->regtext.end ();
 214
 215     if (arg)
 216         throw (uErrorWrongNumber);
 217
 218     ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->env->regmatch[0].second, e))));
 219
 220     return ans;
 221 }
 222
 223 /*DOC:
 224 ===string-filter===
 225  (string-filter REGEX STRING [#i | :i BOOL] [:max NUM]) -> STRING
 226
 227 */
 228 //#AFUNC        string-filter   ml_string_filter
 229 //#WIKIFUNC     string-filter
 230 MNode*  ml_string_filter (MNode* cell, MlEnv* mlenv) {
 231     MNode*  arg = cell->cdr ();
 232     ustring  reg;
 233     ustring  t;
 234     boost::wregex::flag_type  f = boost::regex_constants::normal;
 235     size_t  max = 0;
 236     std::vector<MNode*>  params;
 237     std::vector<MNode*>  keywords;
 238     static paramList  kwlist[] = {
 239         {CharConst ("i"), true},
 240         {CharConst ("max"), false},
 241         {NULL, 0, 0}
 242     };
 243
 244     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 245     reg = eval_str (params[0], mlenv);
 246     t = eval_str (params[1], mlenv);
 247     if (eval_bool (keywords[0], mlenv))
 248         f |= boost::regex_constants::icase;
 249     if (eval_bool (keywords[1], mlenv)) {
 250         max = eval_int (keywords[1], mlenv);
 251         if (max < 0)
 252             max = 0;
 253     }
 254
 255 #if 0
 256     mlenv->env->regtext = utow (t);
 257     std::wstring  wreg = utow (reg);
 258     boost::wregex  wre (wreg, f);
 259 //    if (regex_search (mlenv->env->regtext, mlenv->env->regmatch, wre, boost::regex_constants::match_single_line)) {
 260 #endif
 261     if (wsearch_env (mlenv, t, mlenv->env->regmatch, reg, f)) {
 262 //      return newMNode_str (new ustring (wtou (std::wstring (mlenv->env->regmatch[0].first, mlenv->env->regmatch[0].second))));
 263         ustring  ans = wtou (std::wstring (mlenv->env->regmatch[0].first, mlenv->env->regmatch[0].second));
 264         if (max > 0) {
 265             substring (ans, 0, max, true, ans);
 266         }
 267         return newMNode_str (new ustring (ans));
 268     } else {
 269         return newMNode_str (new ustring);
 270     }
 271 }
 272
 273 /*DOC:
 274 ===split===
 275  (split REGEX STRING) -> STRING_LIST
 276
 277 */
 278 //#AFUNC        split   ml_split
 279 //#WIKIFUNC     split
 280 MNode*  ml_split (MNode* cell, MlEnv* mlenv) {
 281     MNode*  arg = cell->cdr ();
 282     ustring  reg;
 283     ustring  t;
 284     MNodeList  ans;
 285
 286     if (! arg)
 287         throw (uErrorWrongNumber);
 288
 289     reg = eval_str (arg->car (), mlenv);
 290     nextNodeNonNil (arg);
 291     t = eval_str (arg->car (), mlenv);
 292     nextNode (arg);
 293
 294     if (arg)
 295         throw (uErrorWrongNumber);
 296
 297     try {
 298         std::wstring  wt = utow (t);
 299         std::wstring  wreg = utow (reg);
 300         boost::wregex  wre (wreg);
 301         WSplitter  sp (wt, wre);
 302
 303         while (sp.next ()) {
 304             ans.append (newMNode_str (new ustring (sp.cur ())));
 305         }
 306     } catch (boost::regex_error& err) {
 307         throw (uErrorRegexp);
 308     }
 309     return ans.release ();
 310 }
 311
 312 /*DOC:
 313 ===string-join===
 314  (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
 315
 316 */
 317 //#AFUNC        string-join     ml_string_join
 318 //#WIKIFUNC     string-join
 319 MNode*  ml_string_join (MNode* cell, MlEnv* mlenv) {
 320     MNode*  arg = cell->cdr ();
 321     ustring  sep;
 322     MNodePtr  val;
 323     ustring  var;
 324     ustring  u;
 325     ustring  ans;
 326     int  i, n, c;
 327     MNode*  v;
 328
 329     if (! arg)
 330         throw (uErrorWrongNumber);
 331
 332     sep = eval_str (arg->car (), mlenv);
 333     nextNodeNonNil (arg);
 334     c = 0;
 335     while (arg) {
 336         val = eval (arg->car (), mlenv);
 337         nextNode (arg);
 338
 339         if (val () && val ()->isSym ()) {
 340             var = val ()->to_string ();
 341             n = mlenv->getArySize (var);
 342             for (i = 1; i <= n; i ++) {
 343                 if (c == 0)
 344                     c ++;
 345                 else
 346                     ans.append (sep);
 347                 v = mlenv->getAry (var, i);
 348                 if (v)
 349                     ans.append (v->to_string ());
 350             }
 351         } else if (val () && val ()->isCons ()) {
 352             MNode*  a = val ();
 353             for (; a && a->isCons (); a = a->cdr ()) {
 354                 if (c == 0)
 355                     c ++;
 356                 else
 357                     ans.append (sep);
 358                 if (! isNil (a->car ()))
 359                     ans.append (a->car ()->to_string ());
 360             }
 361         } else {
 362             var = val ()->to_string ();
 363             if (c == 0)
 364                 c ++;
 365             else
 366                 ans.append (sep);
 367             ans.append (var);
 368         }
 369     }
 370     return newMNode_str (new ustring (ans));
 371 }
 372
 373 /*DOC:
 374 ===password-match===
 375  (password-match PASSWORD CRYPT) -> BOOL
 376
 377 */
 378 //#AFUNC        password-match  ml_password_match
 379 //#WIKIFUNC     password-match
 380 MNode*  ml_password_match (MNode* cell, MlEnv* mlenv) {
 381     MNode*  arg = cell->cdr ();
 382     ustring  pass;
 383     ustring  cpass;
 384
 385     if (! arg)
 386         throw (uErrorWrongNumber);
 387     pass = eval_str (arg->car (), mlenv);
 388     nextNodeNonNil (arg);
 389     cpass = eval_str (arg->car (), mlenv);
 390     nextNode (arg);
 391     if (arg)
 392         throw (uErrorWrongNumber);
 393
 394     return newMNode_bool (passMatch (pass, cpass));
 395 }
 396
 397 /*DOC:
 398 ===password-crypt===
 399  (password-crypt PASSWORD) -> STRING
 400
 401 */
 402 //#AFUNC        password-crypt  ml_password_crypt
 403 //#WIKIFUNC     password-crypt
 404 MNode*  ml_password_crypt (MNode* cell, MlEnv* mlenv) {
 405     MNode*  arg = cell->cdr ();
 406     ustring  pass;
 407
 408     if (! arg)
 409         throw (uErrorWrongNumber);
 410     pass = eval_str (arg->car (), mlenv);
 411     nextNode (arg);
 412     if (arg)
 413         throw (uErrorWrongNumber);
 414
 415     return newMNode_str (new ustring (passCrypt (pass)));
 416 }
 417
 418 /*DOC:
 419 ===substring===
 420  (substring STR INDEX LENGTH) -> STRING
 421  (substring STR INDEX) -> STRING
 422
 423 */
 424 //#AFUNC        substring       ml_substring
 425 //#WIKIFUNC     substring
 426 MNode*  ml_substring (MNode* cell, MlEnv* mlenv) {
 427     MNode*  arg = cell->cdr ();
 428     ustring  str;
 429     size_t  index;
 430     size_t  length;
 431     int  mode;
 432     ustring  ans;
 433
 434     if (! arg)
 435         throw (uErrorWrongNumber);
 436     str = eval_str (arg->car (), mlenv);
 437     nextNodeNonNil (arg);
 438     index = eval_int (arg->car (), mlenv);
 439     nextNode (arg);
 440     if (arg) {
 441         mode = 3;
 442         length = eval_int (arg->car (), mlenv);
 443         nextNode (arg);
 444     } else {
 445         mode = 2;
 446     }
 447     if (arg)
 448         throw (uErrorWrongNumber);
 449
 450     substring (str, index, length, mode == 3, ans);
 451     return newMNode_str (new ustring (ans));
 452 }
 453
 454 /*DOC:
 455 ===length===
 456  (length STR) -> NUMBER
 457
 458 */
 459 //#AFUNC        length  ml_length
 460 //#WIKIFUNC     length
 461 MNode*  ml_length (MNode* cell, MlEnv* mlenv) {
 462     MNode*  arg = cell->cdr ();
 463     ustring  str;
 464     size_t  ans;
 465
 466     if (! arg)
 467         throw (uErrorWrongNumber);
 468     str = eval_str (arg->car (), mlenv);
 469     nextNode (arg);
 470     if (arg)
 471         throw (uErrorWrongNumber);
 472
 473     ans = strLength (str);
 474     return newMNode_num (ans);
 475 }
 476
 477 /*DOC:
 478 ===pad0===
 479  (pad0 NUMBER STRING) -> STRING
 480  (pad0 NUMBER STRING_LIST) -> STRING_LIST
 481  (pad0 NUMBER_LIST STRING_LIST) -> STRING_LIST
 482
 483 */
 484 //#AFUNC        pad0    ml_pad0
 485 //#WIKIFUNC     pad0
 486 MNode*  ml_pad0 (MNode* cell, MlEnv* mlenv) {
 487     MNode*  arg = cell->cdr ();
 488     MNodePtr  num;
 489     MNodePtr  val;
 490     int  n;
 491     MNode*  np;
 492     MNode*  vp;
 493     MNodeList  ans;
 494
 495     if (! arg)
 496         throw (uErrorWrongNumber);
 497     num = np = eval (arg->car (), mlenv);
 498     nextNodeNonNil (arg);
 499     val = vp = eval (arg->car (), mlenv);
 500     nextNode (arg);
 501     if (arg)
 502         throw (uErrorWrongNumber);
 503
 504     n = 0;
 505     if (vp) {
 506         if (vp->isCons ()) {
 507             while (vp) {
 508                 if (np) {
 509                     if (np->isCons ()) {
 510                         n = to_int (np->car ());
 511                         np = np->cdr ();
 512                     } else {
 513                         n = to_int (np);
 514                     }
 515                 }
 516                 ans.append (newMNode_str (new ustring (zeroPad (n, to_string (vp->car ())))));
 517                 vp = vp->cdr ();
 518                 if (vp && ! vp->isCons ())
 519                     vp = NULL;
 520             }
 521             return ans.release ();
 522         } else {
 523             if (np) {
 524                 if (np->isCons ())
 525                     n = to_int (np->car ());
 526                 else
 527                     n = to_int (np);
 528             }
 529             return newMNode_str (new ustring (zeroPad (n, to_string (vp))));
 530         }
 531     }
 532
 533     return NULL;
 534 }
 535
 536 /*DOC:
 537 ===ellipsis===
 538  (ellipsis NUM STRING) -> STRING
 539
 540 */
 541 //#AFUNC        ellipsis        ml_ellipsis
 542 //#WIKIFUNC     ellipsis
 543 MNode*  ml_ellipsis (MNode* cell, MlEnv* mlenv) {
 544     MNode*  arg = cell->cdr ();
 545     int  num;
 546     ustring  str;
 547
 548     if (! arg)
 549         throw (uErrorWrongNumber);
 550     num = eval_int (arg->car (), mlenv);
 551     nextNodeNonNil (arg);
 552     str = eval_str (arg->car (), mlenv);
 553     nextNode (arg);
 554     if (arg)
 555         throw (uErrorWrongNumber);
 556
 557     str = ellipsis (str, num);
 558     return newMNode_str (new ustring (str));
 559 }
 560
 561 /*DOC:
 562 ===string-format===
 563  (string-format FORMAT LIST-OF-ARGS) -> STRING
 564  (string-format FORMAT ARGS...) -> STRING
 565
 566 |h:format|h:sample|h:note|
 567 |${''NUM''}|${1}||
 568 |${''NUM'':hex:''NUM''}|${1:hex:4}||
 569 |${''NUM'':HEX:''NUM''}|${1:HEX:4}||
 570 |${''NUM'':int:''NUM''}|${1:int:5}||
 571 |${''NUM'':int:''NUM'':c}|${1:int:5:c}||
 572 |${''NUM'':int:''NUM'':comma}|${1:int:5:comma}||
 573 |${''NUM'':int:''NUM'':clip}|${1:int:5:clip}||
 574 |${''NUM'':int:''NUM'':0}|${1:int:5:0}||
 575 |${''NUM'':float:''NUM'':''NUM''}|${1:float:4:3}||
 576 |${''NUM'':string:''NUM''}|${1:string:20}||
 577 |${''NUM'':string:''NUM'':right}|${1:string:20:right}||
 578 |${''NUM'':month}|${1:month}|Jan, Feb,...|
 579 |${''NUM'':Month}|${1:Month}|January, February,...|
 580 |${''NUM'':week}|${1:week}|Sun, Mon,...|
 581 |${''NUM'':Week}|${1:Week}|Sunday, Monday,...|
 582
 583 */
 584 //#AFUNC        string-format   ml_string_format
 585 //#WIKIFUNC     string-format
 586 MNode*  ml_string_format (MNode* cell, MlEnv* mlenv) {
 587     MNode*  arg = cell->cdr ();
 588     ustring  format;
 589     boost::ptr_vector<MNodePtr>  par;
 590     MNode*  a;
 591
 592     if (! arg)
 593         throw (uErrorWrongNumber);
 594     format = eval_str (arg->car (), mlenv);
 595     nextNode (arg);
 596     while (arg) {
 597         a = eval (arg->car (), mlenv);
 598         if (a && a->isCons ()) {
 599             MNodePtr  h;
 600             h = a;
 601             while (a) {
 602                 par.push_back (new MNodePtr);
 603                 par.back () = a->car ();
 604                 nextNode (a);
 605             }
 606         } else {
 607             par.push_back (new MNodePtr);
 608             par.back () = a;
 609         }
 610         nextNode (arg);
 611     }
 612
 613     return newMNode_str (new ustring (formatString (format, par)));
 614 }
 615
 616 /*DOC:
 617 ===random-key===
 618  (random-key) -> STRING
 619
 620 */
 621 //#AFUNC        random-key      ml_random_key
 622 //#WIKIFUNC     random-key
 623 MNode*  ml_random_key (MNode* cell, MlEnv* mlenv) {
 624     MNode*  arg = cell->cdr ();
 625
 626     if (arg)
 627         throw (uErrorWrongNumber);
 628
 629     return newMNode_str (new ustring (randomKey ()));
 630 }
 631
 632 /*DOC:
 633 ===to-string===
 634  (to-string OBJECT) -> STRING
 635
 636 */
 637 //#AFUNC        to-string       ml_to_string
 638 //#WIKIFUNC     to-string
 639 MNode*  ml_to_string (MNode* cell, MlEnv* mlenv) {
 640     MNode*  arg = cell->cdr ();
 641     ustring  text;
 642
 643     if (! arg)
 644         throw (uErrorWrongNumber);
 645     text = eval_str (arg->car (), mlenv);
 646     nextNode (arg);
 647     if (arg)
 648         throw (uErrorWrongNumber);
 649
 650     return newMNode_str (new ustring (text));
 651 }
 652
 653 /*DOC:
 654 ===to-lisp===
 655  (to-lisp STRING) -> OBJECT
 656
 657 */
 658 //#AFUNC        to-lisp ml_to_lisp
 659 //#WIKIFUNC     to-lisp
 660 MNode*  ml_to_lisp (MNode* cell, MlEnv* mlenv) {
 661     MNode*  arg = cell->cdr ();
 662     ustring  text;
 663     MotorSexp ml (NULL);
 664
 665     if (! arg)
 666         throw (uErrorWrongNumber);
 667     text = eval_str (arg->car (), mlenv);
 668     nextNode (arg);
 669     if (arg)
 670         throw (uErrorWrongNumber);
 671
 672     ml.scan (text);
 673
 674     return mlenv->retval = ml.top.cdr ();
 675 }