site-lisp/rails/inflections.el

   1 ;;; inflections.el ---
   2
   3 ;; Copyright (C) 2006 Dmitry Galinsky <dima dot exe at gmail dot com>
   4
   5 ;; Authors: Dmitry Galinsky <dima dot exe at gmail dot com>,
   6 ;;          Howard Yeh <hayeah at gmail dot com>
   7
   8 ;; Keywords: ruby rails languages oop
   9 ;; $URL: svn+ssh://rubyforge/var/svn/emacs-rails/trunk/inflections.el $
  10 ;; $Id: inflections.el 178 2007-04-12 20:58:56Z dimaexe $
  11
  12 ;;; License
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License
  16 ;; as published by the Free Software Foundation; either version 2
  17 ;; of the License, or (at your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; if not, write to the Free Software
  26 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (defvar inflection-singulars    nil)
  31 (defvar inflection-plurals      nil)
  32 (defvar inflection-irregulars   nil)
  33 (defvar inflection-uncountables nil)
  34
  35 (defmacro define-inflectors (&rest specs)
  36   (loop for (type . rest) in specs do
  37         (case type
  38           (:singular (push rest inflection-singulars))
  39           (:plural (push rest inflection-plurals))
  40           (:irregular (push rest inflection-irregulars))
  41           (:uncountable (setf inflection-uncountables
  42                               (append rest inflection-uncountables))))))
  43
  44 (define-inflectors
  45   (:plural "$" "s")
  46   (:plural "s$" "s")
  47   (:plural "\\(ax\\|test\\)is$" "\\1es")
  48   (:plural "\\(octop\\|vir\\)us$" "\\1i")
  49   (:plural "\\(alias\\|status\\)$" "\\1es")
  50   (:plural "\\(bu\\)s$" "\\1ses")
  51   (:plural "\\(buffal\\|tomat\\)o$" "\\1oes")
  52   (:plural "\\([ti]\\)um$" "\\1a")
  53   (:plural "sis$" "ses")
  54   (:plural "\\(?:\\([^f]\\)fe\\|\\([lr]\\)f\\)$" "\\1\\2ves")
  55   (:plural "\\(hive\\)$" "\\1s")
  56   (:plural "\\([^aeiouy]\\|qu\\)y$" "\\1ies")
  57   (:plural "\\(x\\|ch\\|ss\\|sh\\)$" "\\1es")
  58   (:plural "\\(matr\\|vert\\|ind\\)ix\\|ex$" "\\1ices")
  59   (:plural "\\([m\\|l]\\)ouse$" "\\1ice")
  60   (:plural "^\\(ox\\)$" "\\1en")
  61   (:plural "\\(quiz\\)$" "\\1zes")
  62
  63   (:singular "s$" "")
  64   (:singular "\\(n\\)ews$" "\\1ews")
  65   (:singular "\\([ti]\\)a$" "\\1um")
  66   (:singular "\\(\\(a\\)naly\\|\\(b\\)a\\|\\(d\\)iagno\\|\\(p\\)arenthe\\|\\(p\\)rogno\\|\\(s\\)ynop\\|\\(t\\)he\\)ses$" "\\1\\2sis")
  67   (:singular "\\(^analy\\)ses$" "\\1sis")
  68   (:singular "\\([^f]\\)ves$" "\\1fe")
  69   (:singular "\\(hive\\)s$" "\\1")
  70   (:singular "\\(tive\\)s$" "\\1")
  71   (:singular "\\([lr]\\)ves$" "\\1f")
  72   (:singular "\\([^aeiouy]\\|qu\\)ies$" "\\1y")
  73   (:singular "\\(s\\)eries$" "\\1eries")
  74   (:singular "\\(m\\)ovies$" "\\1ovie")
  75   (:singular "\\(x\\|ch\\|ss\\|sh\\)es$" "\\1")
  76   (:singular "\\([m\\|l]\\)ice$" "\\1ouse")
  77   (:singular "\\(bus\\)es$" "\\1")
  78   (:singular "\\(o\\)es$" "\\1")
  79   (:singular "\\(shoe\\)s$" "\\1")
  80   (:singular "\\(cris\\|ax\\|test\\)es$" "\\1is")
  81   (:singular "\\(octop\\|vir\\)i$" "\\1us")
  82   (:singular "\\(alias\\|status\\)es$" "\\1")
  83   (:singular "^\\(ox\\)en" "\\1")
  84   (:singular "\\(vert\\|ind\\)ices$" "\\1ex")
  85   (:singular "\\(matr\\)ices$" "\\1ix")
  86   (:singular "\\(quiz\\)zes$" "\\1")
  87
  88   (:irregular "person" "people")
  89   (:irregular "man" "men")
  90   (:irregular "child" "children")
  91   (:irregular "sex" "sexes")
  92   (:irregular "move" "moves")
  93
  94   (:uncountable "equipment" "information" "rice" "money" "species" "series" "fish" "sheep"))
  95
  96 (defun singularize-string (str)
  97   (when (stringp str)
  98     (or (car (member str inflection-uncountables))
  99         (caar (member* str inflection-irregulars :key 'cadr :test 'equal))
 100         (loop for (from to) in inflection-singulars
 101               for singular = (string=~ from str (sub to))
 102               when singular do (return singular))
 103         str)))
 104
 105 (defun pluralize-string (str)
 106   (when (stringp str)
 107     (or (car (member str inflection-uncountables))
 108         (cadar (member* str inflection-irregulars :key 'car :test 'equal))
 109         (loop for (from to) in inflection-plurals
 110               for plurals = (string=~ from str (sub to))
 111               when plurals do (return plurals))
 112         str)))
 113
 114 (provide 'inflections)