[elpa] externals/fountain-mode fff47c4 2/2: Add fountain-completion-additional-(characters|locations)

[Paul W. Rankin]

branch: externals/fountain-mode
commit fff47c484cff9daab5dbf081358d6856590a88e3
Author: Paul W. Rankin <address@hidden>
Commit: Paul W. Rankin <address@hidden>

    Add fountain-completion-additional-(characters|locations)
    
    Useful when working with multiple files. Must satisfy (and (listp LIST)
    (seq-every-p 'stringp LIST)).
    
    Also reworked fountain-completion-get-characters to only return a list
    of characters, moving completion login into fountain-completion-at-point.
---
 fountain-mode.el | 138 +++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 94 insertions(+), 44 deletions(-)

diff --git a/fountain-mode.el b/fountain-mode.el
index 04210a1..5044956 100644
--- a/fountain-mode.el
+++ b/fountain-mode.el
@@ -1018,9 +1018,6 @@ buffers."
   (setq-local page-delimiter fountain-page-break-regexp)
   (setq-local outline-level #'fountain-outline-level)
   (setq-local require-final-newline mode-require-final-newline)
-  ;; FIXME: `completion-cycle-threshold' is a user option, so
-  ;; hard-coding it to non-nil is dubious. On the other hand,
-  ;; completion without cycling in screenwriting is weird.
   (setq-local completion-cycle-threshold t)
   (setq-local completion-at-point-functions
               '(fountain-completion-at-point))
@@ -1278,54 +1275,90 @@ Each element is a cons (NAME . OCCUR) where NAME is a 
string, and
 OCCUR is an integer representing the character's number of
 occurrences. ")
 
+(defcustom fountain-completion-additional-characters
+  nil
+  "List of additional characters to offer for completion.
+Case insensitive, all character names will be made uppercase.
+
+This is more useful when working with multiple files and set with
+`add-dir-local-variable'."
+  :type '(repeat (string :tag "Character"))
+  :safe '(lambda (value)
+           (and (listp value)
+                (seq-every-p 'stringp value))))
+
+(defcustom fountain-completion-additional-locations
+  nil
+  "List of additional locations to offer for completion.
+Case insensitive, all locations will be made uppercase.
+
+This is more useful when working with multiple files and set with
+`add-dir-local-variable'."
+  :type '(repeat (string :tag "Location"))
+  :safe '(lambda (value)
+           (and (listp value)
+                (seq-every-p 'stringp value))))
 
 (defun fountain-completion-get-characters ()
-  "Return candidates for completing character.
+  "Return a list of characters for completion.
 
 First, return second-last speaking character, followed by each
 previously speaking character within scene. After that, return
-characters from `fountain-completion-characters'."
-  (lambda (string pred action)
-    (let (scene-characters alt-character contd-character rest-characters)
-      (save-excursion
-        (save-restriction
-          (widen)
-          (fountain-forward-character 0 'scene)
-          (while (not (or (fountain-match-scene-heading)
-                          (bobp)))
-            (when (fountain-match-character)
-              (let ((character (match-string-no-properties 4)))
-                (unless (member character scene-characters)
-                  (push (list character) scene-characters))))
-            (fountain-forward-character -1 'scene))))
-      (setq scene-characters (reverse scene-characters)
-            alt-character (cadr scene-characters)
-            contd-character (car scene-characters)
-            rest-characters (cddr scene-characters)
-            scene-characters nil)
-      (when rest-characters
-        (setq scene-characters rest-characters))
-      (when contd-character
-        (setq scene-characters
-              (cons contd-character scene-characters)))
-      (when alt-character
-        (setq scene-characters
-              (cons alt-character scene-characters)))
-      (if (eq action 'metadata)
-          (list 'metadata
-                (cons 'display-sort-function 'identity)
-                (cons 'cycle-sort-function 'identity))
-        (complete-with-action action
-                              (append scene-characters 
fountain-completion-characters)
-                              string pred)))))
+characters from `fountain-completion-additional-characters' then
+`fountain-completion-characters'.
+
+n.b. `fountain-completion-additional-characters' are offered as
+candidates ahead of `fountain-completion-characters' because
+these need to be manually set, and so are considered more
+important."
+  (let (scene-characters
+        alt-character
+        contd-character
+        rest-characters)
+    (save-excursion
+      (save-restriction
+        (widen)
+        (fountain-forward-character 0 'scene)
+        (while (not (or (bobp) (fountain-match-scene-heading)))
+          (when (fountain-match-character)
+            (let ((character (match-string-no-properties 4)))
+              (unless (member character scene-characters)
+                (push (list character) scene-characters))))
+          (fountain-forward-character -1 'scene))))
+    (setq scene-characters (reverse scene-characters)
+          alt-character (cadr scene-characters)
+          contd-character (car scene-characters)
+          rest-characters (cddr scene-characters)
+          scene-characters nil)
+    (when rest-characters
+      (setq scene-characters rest-characters))
+    (when contd-character
+      (setq scene-characters
+            (cons contd-character scene-characters)))
+    (when alt-character
+      (setq scene-characters
+            (cons alt-character scene-characters)))
+    (append scene-characters
+            (mapcar 'upcase fountain-completion-additional-characters)
+            fountain-completion-characters)))
 
 (defun fountain-completion-at-point ()
   "\\<fountain-mode-map>Return completion table for entity at point.
 Trigger completion with \\[fountain-dwim].
 
-Always delimits entity from beginning of line to point. If at a
-scene heading, return `fountain-scene-heading-candidates'. If
-previous line is blank, return result of
+1. If point is at a scene heading and matches
+`fountain-scene-heading-suffix-sep', offer completion candidates
+from `fountain-scene-heading-suffix-list'.
+
+2. If point is at a line matching
+`fountain-scene-heading-prefix-list', offer completion candidates
+from `fountain-completion-locations' and
+`fountain-completion-additional-locations'.
+
+3. If point is at beginning of line with a preceding blank line,
+offer completion candidates from `fountain-completion-characters'
+and `fountain-completion-additional-characters'. For more
+information of character completion sorting, see
 `fountain-completion-get-characters'.
 
 Added to `completion-at-point-functions'."
@@ -1342,25 +1375,42 @@ Added to `completion-at-point-functions'."
          (list (match-end 3)
                (point)
                (completion-table-case-fold
-                fountain-completion-locations)))
+                (append
+                 (mapcar 'upcase fountain-completion-additional-locations)
+                 fountain-completion-locations))))
         ((and (fountain-match-scene-heading)
               (match-string 1))
          ;; Return scene location completion (forced)
          (list (match-end 1)
                (point)
                (completion-table-case-fold
-                fountain-completion-locations)))
+                (append
+                 (mapcar 'upcase fountain-completion-additional-locations)
+                 fountain-completion-locations))))
         ((and (eolp)
               (fountain-blank-before-p))
          ;; Return character completion
          (list (line-beginning-position)
                (point)
                (completion-table-case-fold
-                (fountain-completion-get-characters))))))
+                (lambda (string pred action)
+                  (if (eq action 'metadata)
+                      (list 'metadata
+                            (cons 'display-sort-function 'identity)
+                            (cons 'cycle-sort-function 'identity))
+                    (complete-with-action
+                     action (fountain-completion-get-characters)
+                     string pred))))))))
 
 (defun fountain-completion-update ()
   "Update completion candidates for current buffer.
 
+While `fountain-completion-locations' are left unsorted for
+`completion-at-point' to perform sorting,
+`fountain-completion-characters' are sorted by number of lines.
+For more information on character completion sorting, see
+`fountain-completion-get-characters'.
+
 Add to `fountain-mode-hook' to have completion upon load."
   (interactive)
   (setq fountain-completion-locations nil