Minor merge of artbollocks mode changes.
[robmyers:scripts.git] / artbollocks-mode.el
1 ;; artbollocks-mode.el - A minor mode to guide art writers.
2 ;; Copyright (c) 2011 Rob Myers <rob@robmyers.org>
3 ;;
4 ;; Based on fic-mode.el
5 ;; Copyright (C) 2010, Trey Jackson <bigfaceworm(at)gmail(dot)com>
6 ;;
7 ;; Non-artbollocks words from: http://matt.might.net/articles/
8 ;;
9 ;; This program is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
13 ;;
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 ;; GNU General Public License for more details.
18 ;;
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
21
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;; Usage
24 ;;
25 ;; To use, save artbollocks-mode.el to a directory in your load-path.
26 ;;
27 ;; (require 'artbollocks-mode)
28 ;; (add-hook 'text-mode-hook 'turn-on-artbollocks-mode)
29 ;; (add-hook 'org-mode-hook 'turn-on-artbollocks-mode)
30 ;;
31 ;; or
32 ;;
33 ;; M-x artbollocks-mode
34 ;;
35 ;; NOTE: If you manually turn on artbollocks-mode,
36 ;; you you might need to force re-fontification initially:
37 ;;
38 ;;   M-x font-lock-fontify-buffer
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40
41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42 ;; Customization
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44
45 ;; Enable features individually
46
47 (defcustom lexical-illusions t
48   "Whether to check for lexical illusions"
49   :type '(boolean)
50   :group 'artbollocks-mode)
51
52 (defcustom passive-voice t
53   "Whether to check for passive voice"
54   :type '(boolean)
55   :group 'artbollocks-mode)
56
57 (defcustom weasel-words t
58   "Whether to check for weasel words"
59   :type '(boolean)
60   :group 'artbollocks-mode)
61
62 (defcustom artbollocks t
63   "Whether to check for artbollocks"
64   :type '(boolean)
65   :group 'artbollocks-mode)
66
67 ;; Lexical illusion face
68
69 (defcustom lexical-illusions-foreground-color "black"
70   "Lexical illusions face foreground colour"
71   :group 'artbollocks-mode)
72
73 (defcustom lexical-illusions-background-color "magenta"
74   "Lexical illusions face background color"
75   :group 'artbollocks-mode)
76
77 (defcustom font-lock-lexical-illusions-face 'font-lock-lexical-illusions-face
78   "The face for lexical illusions in artbollocks mode"
79   :group 'artbollocks-mode)
80
81 (make-face 'font-lock-lexical-illusions-face)
82 (modify-face 'font-lock-lexical-illusions-face
83              lexical-illusions-foreground-color
84              lexical-illusions-background-color
85              nil t nil t nil nil)
86
87 ;; Passive voice face
88
89 (defcustom passive-voice-foreground-color "Gray"
90   "Passive voice face foreground colour"
91   :group 'artbollocks-mode)
92
93 (defcustom passive-voice-background-color "White"
94   "Passive voice face background color"
95   :group 'artbollocks-mode)
96
97 (defcustom font-lock-passive-voice-face 'font-lock-passive-voice-face
98   "The face for passive voice words in artbollocks mode"
99   :group 'artbollocks-mode)
100
101 (make-face 'font-lock-passive-voice-face)
102 (modify-face 'font-lock-passive-voice-face passive-voice-foreground-color
103              passive-voice-background-color nil t nil t nil nil)
104
105 ;; Weasel words face
106
107 (defcustom weasel-words-foreground-color "Brown"
108   "Weasel words face foreground colour"
109   :group 'artbollocks-mode)
110
111 (defcustom weasel-words-background-color "White"
112   "Weasel words face background color"
113   :group 'artbollocks-mode)
114
115 (defcustom font-lock-weasel-words-face 'font-lock-weasel-words-face
116   "The face for weasel-words words in artbollocks mode"
117   :group 'artbollocks-mode)
118
119 (make-face 'font-lock-weasel-words-face)
120 (modify-face 'font-lock-weasel-words-face weasel-words-foreground-color
121              weasel-words-background-color nil t nil t nil nil)
122
123 ;; Artbollocks face
124
125 (defcustom artbollocks-foreground-color "Purple"
126   "Font foreground colour"
127   :group 'artbollocks-mode)
128
129 (defcustom artbollocks-background-color "White"
130   "Font background color"
131   :group 'artbollocks-mode)
132
133 (defcustom font-lock-artbollocks-face 'font-lock-artbollocks-face
134   "The face for artbollocks words in artbollocks mode"
135   :group 'artbollocks-mode)
136
137 (make-face 'font-lock-artbollocks-face)
138 (modify-face 'font-lock-artbollocks-face artbollocks-foreground-color
139              artbollocks-background-color nil t nil t nil nil)
140
141 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
142 ;; Lexical illusions
143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
144
145 (defconst lexical-illusions-regex "\\(\\w+\\)[ \t\r\n]+\\(\\1\\)")
146
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
148 ;; Passive voice
149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
150
151 (defconst passive-voice-regex "\\b\\(am\\|are\\|were\\|being\\|is\\|been\\|was\\|be\\)\\s-+\\(\\w+ed\\|awoken\\|been\\|born\\|beat\\|become\\|begun\\|bent\\|beset\\|bet\\|bid\\|bidden\\|bound\\|bitten\\|bled\\|blown\\|broken\\|bred\\|brought\\|broadcast\\|built\\|burnt\\|burst\\|bought\\|cast\\|caught\\|chosen\\|clung\\|come\\|cost\\|crept\\|cut\\|dealt\\|dug\\|dived\\|done\\|drawn\\|dreamt\\|driven\\|drunk\\|eaten\\|fallen\\|fed\\|felt\\|fought\\|found\\|fit\\|fled\\|flung\\|flown\\|forbidden\\|forgotten\\|foregone\\|forgiven\\|forsaken\\|frozen\\|gotten\\|given\\|gone\\|ground\\|grown\\|hung\\|heard\\|hidden\\|hit\\|held\\|hurt\\|kept\\|knelt\\|knit\\|known\\|laid\\|led\\|leapt\\|learnt\\|left\\|lent\\|let\\|lain\\|lighted\\|lost\\|made\\|meant\\|met\\|misspelt\\|mistaken\\|mown\\|overcome\\|overdone\\|overtaken\\|overthrown\\|paid\\|pled\\|proven\\|put\\|quit\\|read\\|rid\\|ridden\\|rung\\|risen\\|run\\|sawn\\|said\\|seen\\|sought\\|sold\\|sent\\|set\\|sewn\\|shaken\\|shaven\\|shorn\\|shed\\|shone\\|shod\\|shot\\|shown\\|shrunk\\|shut\\|sung\\|sunk\\|sat\\|slept\\|slain\\|slid\\|slung\\|slit\\|smitten\\|sown\\|spoken\\|sped\\|spent\\|spilt\\|spun\\|spit\\|split\\|spread\\|sprung\\|stood\\|stolen\\|stuck\\|stung\\|stunk\\|stridden\\|struck\\|strung\\|striven\\|sworn\\|swept\\|swollen\\|swum\\|swung\\|taken\\|taught\\|torn\\|told\\|thought\\|thrived\\|thrown\\|thrust\\|trodden\\|understood\\|upheld\\|upset\\|woken\\|worn\\|woven\\|wed\\|wept\\|wound\\|won\\|withheld\\|withstood\\|wrung\\|written\\)\\b")
152
153 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
154 ;; Weasel words
155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
156
157 (defconst weasel-words-regex "\\b\\(many\\|various\\|very\\|fairly\\|several\\|extremely\\|exceedingly\\|quite\\|remarkably\\|few\\|surprisingly\\|mostly\\|largely\\|huge\\|tiny\\|\\(\\(are\\|is\\) a number\\)\\|excellent\\|interestingly\\|significantly\\|substantially\\|clearly\\|vast\\|relatively\\|completely\\)\\b")
158
159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160 ;; Artbollocks
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
162
163 (defconst artbollocks-regex "\\b(a priori\\|ad hoc\\|affirmation\\|affirm\\|affirms\\|aporia\\|aporetic\\|appropriates\\|appropriation\\|archetypal\\|archetypical\\|archetype\\|archetypes\\|autonomous\\|autonomy\\|baudrillardian\\|baudrillarian\\|commodification\\|committed\\|commitment\\|commonalities\\|contemporaneity\\|context\\|contexts\\|contextual\\|contextualise\\|contextualises\\|contextualisation\\|contextialize\\|contextializes\\|contextualization\\|convention\\|conventional\\|conventions\\|coterminous\\|critique\\|cunning\\|cunningly\\|death of the author\\|debunk\\|debunked\\|debunking\\|debunks\\|deconstruct\\|deconstruction\\|deconstructs\\|deleuzian\\|desire\\|desires\\|discourse\\|discursive\\|disrupt\\|disrupts\\|engage\\|engagement\\|engages\\|episteme\\|epistemic\\|ergo\\|fetish\\|fetishes\\|fetishise\\|fetishised\\|fetishize\\|fetishized\\|gaze\\|gender\\|gendered\\|historicise\\|historicisation\\|historicize\\|historicization\\|hegemonic\\|hegemony\\|identity\\|identity politics\\|intensifies\\|intensify\\|intensifying\\|interrogate\\|interrogates\\|interrogation\\|intertextual\\|intertextuality\\|irony\\|ironic\\|ironical\\|ironically\\|ironisation\\|ironization\\|ironises\\|ironizes\\|jouissance\\|juxtapose\\|juxtaposes\\|juxtaposition\\|lacanian\\|lack\\|loci\\|locus\\|locuses\\|matrix\\|mocking\\|mockingly\\|modalities\\|modality\\|myth\\|mythologies\\|mythology\\|myths\\|narrative\\|narrativisation\\|narrativization\\|narrativity\\|nexus\\|nodal\\|node\\|normative\\|normativity\\|notion\\|notions\\|objective\\|objectivity\\|objectivities\\|objet petit a\\|ontology\\|ontological\\|operate\\|operates\\|otherness\\|othering\\|paradigm\\|paradigmatic\\|paradigms\\|parody\\|parodic\\|parodies\\|physicality\\|plenitude\\|poetics\\|popular notions\\|position\\|post hoc\\|postmodernism\\|postmodernist\\|postmodernity\\|postmodern\\|practice\\|practise\\|praxis\\|problematic\\|problematics\\|proposition\\|qua\\|reading\\|readings\\|reification\\|relation\\|relational\\|relationality\\|relations\\|representation\\|representations\\|rhizomatic\\|rhizome\\|situate\\|situated\\|situates\\|stereotype\\|stereotypes\\|strategy\\|strategies\\|subjective\\|subjectivity\\|subjectivities\\|subvert\\|subversion\\|subverts\\|text\\|textual\\|textuality\\|thinker\\|thinkers\\|trajectory\\|transgress\\|transgresses\\|transgression\\|transgressive\\|unfolding\\|undermine\\|undermining\\|undermines\\|work\\|works\\|wry\\|wryly\\|zizekian\\|zi┼żekian)\\b")
164
165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
166 ;; Highlighting
167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
168
169 (defun search-for-keyword (regex limit)
170   "Match the provided regex in the buffer"
171   (let ((match-data-to-set nil)
172         found)
173     (save-match-data
174       (while (and (null match-data-to-set)
175                   (re-search-forward regex limit t))
176             (setq match-data-to-set (match-data))))
177     (when match-data-to-set
178       (set-match-data match-data-to-set)
179       (goto-char (match-end 0)) 
180       t)))
181
182 (defun lexical-illusions-search-for-keyword (limit)
183   (search-for-keyword lexical-illusions-regex limit))
184
185 (defun passive-voice-search-for-keyword (limit)
186   (search-for-keyword passive-voice-regex limit))
187
188 (defun weasel-words-search-for-keyword (limit)
189   (search-for-keyword weasel-words-regex limit))
190
191 (defun artbollocks-search-for-keyword (limit)
192   (search-for-keyword artbollocks-regex limit))
193
194 (defconst lexicalkwlist '((lexical-illusions-search-for-keyword 
195                            (2 'font-lock-lexical-illusions-face t))))
196
197 (defconst passivekwlist '((passive-voice-search-for-keyword 
198                               (0 'font-lock-passive-voice-face t))))
199
200 (defconst weaselkwlist '((weasel-words-search-for-keyword 
201                              (0 'font-lock-weasel-words-face t))))
202
203 (defconst artbollockskwlist '((artbollocks-search-for-keyword 
204                                   (0 'font-lock-artbollocks-face t))))
205
206 (defun add-artbollocks-keywords ()
207   (when lexical-illusions
208     (font-lock-add-keywords nil lexicalkwlist))
209   (when passive-voice
210     (font-lock-add-keywords nil passivekwlist))
211   (when weasel-words
212     (font-lock-add-keywords nil weaselkwlist))
213   (when artbollocks
214     (font-lock-add-keywords nil artbollockskwlist)))
215
216 (defun remove-artbollocks-keywords ()
217   (font-lock-remove-keywords nil lexicalkwlist)
218   (font-lock-remove-keywords nil passivekwlist)
219   (font-lock-remove-keywords nil weaselkwlist)
220   (font-lock-remove-keywords nil artbollockskwlist))
221
222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
223 ;; Text metrics
224 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
225
226 (defun count-letters ()
227   (how-many "\\w" (point-min) (point-max)))
228
229 (defun count-syllables ()
230   ;; Naively count vowel runs as syllable markers
231   (how-many "[aeiouy]+" (point-min) (point-max)))
232
233 (defun count-words ()
234   (how-many "\\w+" (point-min) (point-max)))
235
236 (defun count-sentences()
237   ;; Avoid 8.8 but count this... as a sentence break
238   (how-many "\\w[!?.]" (point-min) (point-max)))
239
240 ;; FIXME: Avoid divide by zero where document is empty or small
241
242 (defun automated-readability-index ()
243   (let ((words (count-words)))
244     (- (+ (* 4.71 (/ (count-letters) words))
245           (* 0.5 (/ words (count-sentences))))
246        21.43)))
247
248 (defun flesch-reading-ease ()
249   (let ((words (count-words)))
250     (- 206.834
251        (* 1.015 (/ words (count-sentences)))
252        (* 84.6 (/ (count-syllables) words)))))
253
254 (defun flesch-kinkaid-grade-level ()
255   (let ((words (count-words)))
256     (- (+ (* 11.8 (/ (count-syllables) words))
257           (* 0.39 (/ words (count-sentences))))
258        15.59)))
259
260 (defun word-count ()
261   "count the number of words in the buffer"
262   (interactive)
263   (message "Word count: %s" (count-words)))
264
265 (defun sentence-count ()
266   "count the number of sentences in the buffer"
267   (interactive)
268   (message "Sentence count: %s" (count-sentences)))
269
270 (defun readability-index ()
271   "determine the automated readability index of the buffer"
272   (interactive)
273   (message "Readability index: %s" (automated-readability-index)))
274
275 (defun reading-ease ()
276   "determine the Flesch reading ease of the buffer"
277   (interactive)
278   (message "Reading ease: %s" (flesch-reading-ease)))
279
280 (defun grade-level ()
281   "determine the Flesch-Kinkaid grade level of the buffer"
282   (interactive)
283   (message "Grade level: %s" (flesch-kinkaid-grade-level)))
284
285 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
286 ;; The mode
287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
288
289 (defconst artbollocks-mode-keymap (make-keymap))
290 (define-key artbollocks-mode-keymap (kbd "C-c [") 'word-count)
291 (define-key artbollocks-mode-keymap (kbd "C-c ]") 'sentence-count)
292 (define-key artbollocks-mode-keymap (kbd "C-c \\") 'readability-index)
293 (define-key artbollocks-mode-keymap (kbd "C-c /") 'reading-ease)
294 (define-key artbollocks-mode-keymap (kbd "C-c =") 'grade-level)
295
296 ;;;###autoload
297 (define-minor-mode artbollocks-mode "highlight passive voice, weasel words and artbollocks in text, provide useful text metrics"
298   :lighter " AB"
299   :keymap artbollocks-mode-keymap
300   :group 'artbollocks-mode
301   (if artbollocks-mode
302       (add-artbollocks-keywords)
303     (remove-artbollocks-keywords)))
304
305 (defun turn-on-artbollocks-mode ()
306   "turn artbollocks-mode on"
307   (interactive)
308   (artbollocks-mode 1))
309
310 (provide 'artbollocks-mode)
311
312 ;; TODO
313 ;; Toggle adding word/sentence count to status bar
314 ;; Pluralization
315 ;; Incorporate diction commands if available (and advise on installation if not)
316 ;; Split general writing back out