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://rubyforge.org/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 "octopus$" "octopi") 49 (:plural "\\(alias\\|status\\)$" "\\1es") 50 (:plural "\\(bu\\)s$" "\\1ses") 51 (:plural "tomato$" "tomatoes") 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 "octopi$" "octopus") 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)