Offer to create new symbolic mark type when marking.

src/ChangeLog

 2001-04-21  Joel Rosdahl  <joel@rosdahl.net>
 
+	* vars.el.in (kom-default-mark): New default value: ask for mark
+	type.
+
+	* commands1.el (lyskom-read-mark-type): Offer to allocate new mark
+	type automatically.
+	(lyskom-allocate-mark-type): New function.
+	(lyskom-mark-text): Pass new parameters to lyskom-read-mark-type.
+
+	* english-strings.el (lyskom-message): New strings for automatic
+	mark type creation.
+
+	* swedish-strings.el (lyskom-message): Ditto.
+
 	* Makefile ($(TARGET-EL)): Always update build date in vars.el.
 
 2001-04-01  Joel Rosdahl  <joel@rosdahl.net>

src/commands1.el

@@ -1861,7 +1861,7 @@ the user for what mark to use."
   (let ((mark
 	 (or mark
 	     kom-default-mark
-	     (lyskom-read-mark-type (lyskom-get-string 'what-mark)))))
+	     (lyskom-read-mark-type (lyskom-get-string 'what-mark) nil t))))
     (lyskom-format-insert 'marking-textno text-no)
 
     (if (blocking-do 'mark-text text-no mark)
@@ -1871,46 +1871,88 @@ the user for what mark to use."
       (lyskom-insert-string 'nope))     ;+++ lyskom-errno?
     (cache-del-text-stat text-no)))
 
-
-(defun lyskom-read-mark-type (prompt &optional nildefault)
+(defun lyskom-read-mark-type (prompt &optional nildefault create-nonexistent)
   "Ask user about symbolic mark type and return the (integer)
 mark-type.  Prompt with PROMPT.  If NILDEFAULT is non-nil, nil is
 returned if the user enters the empty string, otherwise the user is
-prompted again."
-  (let ((mark-type -1)
+prompted again. If CREATE-NONEXISTENT is t, the user is asked whether
+the symbolic mark association should be created if it doesn't already
+exist."
+  (let ((mark-type nil) ; nil: not yet set, 'default: default chosen
         (completion-ignore-case t)
-        (completions kom-symbolic-marks-alist)
-        (first-time t)
-        (default-chosen nil))
-    (while (and (not default-chosen)
+        (completions kom-symbolic-marks-alist))
+    (while (and (not (eq mark-type 'default))
                 (or (not (integerp mark-type))
                     (< mark-type 0)
                     (> mark-type 255)))
-      (if first-time
-          (setq first-time nil)
-        (lyskom-insert 'erroneous-mark))
-      (let ((mark (lyskom-completing-read
+      (let* ((mark (lyskom-completing-read
                     prompt
-                    (lyskom-maybe-frob-completion-table
-                     completions))))
-        (if (and nildefault
-                 (stringp mark)
-                 (string= mark ""))
-            (setq default-chosen t)
-          (setq mark-type
-                (let ((tmp (lyskom-string-assoc mark completions)))
-                  (if tmp
-                      ;; Correct completion.
-                      (cdr tmp)
-                    ;; Incorrect completion.  Check for an integer.
-                    (if (string-match "\\`[0-9]+\\'" mark)
-                        (string-to-int mark)
-                      -1)))))))
-    (if default-chosen
+                    (lyskom-maybe-frob-completion-table completions)))
+             (mark-assoc (lyskom-string-assoc mark completions)))
+        (cond
+         ;; Default completion.
+         ((and nildefault
+               (stringp mark)
+               (string= mark ""))
+          (setq mark-type 'default))
+
+         ;; Correct completion.
+         (mark-assoc
+          (setq mark-type (cdr mark-assoc)))
+
+         ;; Incorrect completion, integer entered.
+         ((string-match "\\`[0-9]+\\'" mark)
+          (setq mark-type (string-to-int mark)))
+
+         ;; Incorrect completion; create new symbolic mark type.
+         ((and create-nonexistent
+               (lyskom-j-or-n-p
+                (lyskom-format (lyskom-get-string
+                                'want-to-create-symbolic-mark)
+                               mark)))
+          (let ((new-mark-type (lyskom-allocate-mark-type)))
+            (if (not new-mark-type)
+                (lyskom-insert 'no-mark-types-left)
+              (lyskom-format-insert 'creating-symbolic-mark-type
+                                    mark
+                                    new-mark-type)
+              (setq kom-symbolic-marks-alist
+                    (cons (cons mark new-mark-type)
+                          kom-symbolic-marks-alist))
+              (lyskom-save-options
+               (current-buffer)
+               (lyskom-get-string 'saving-settings)
+               (lyskom-get-string 'saving-settings-done)
+               (lyskom-get-string 'could-not-save-options))
+              (setq mark-type new-mark-type))))
+
+         ;; Incorrect completion.
+         (t
+          (lyskom-insert 'erroneous-mark)))))
+
+    (if (eq mark-type 'default)
         nil
       mark-type)))
 
 
+(defun lyskom-allocate-mark-type ()
+  (setq kom-symbolic-marks-alist
+        (sort kom-symbolic-marks-alist
+              (function (lambda (x y) (< (cdr x) (cdr y))))))
+  (let ((i 0)
+        (list kom-symbolic-marks-alist)
+        (found nil))
+    (while (and list
+                (not found)
+                (< i 256))
+      (if (not (= i (cdr (car list))))
+          (setq found t)
+        (setq list (cdr list))
+        (setq i (1+ i))))
+    (if (< i 256)
+        i
+      nil)))
+
 ;;; ================================================================
 ;;;          ]terse alla markerade - Review marked texts
 

src/english-strings.el

@@ -366,6 +366,9 @@ and you have finished reading. Please come back later.
     (text-to-unmark . "Unmark which text? ")
     (what-mark . "Set which mark type (name or 0-255)? ")
     (erroneous-mark . "Erroneous mark type.\n")
+    (want-to-create-symbolic-mark . "The mark type \"%#1s\" does not exist. Do you want to create it? ")
+    (creating-symbolic-mark-type . "Creating mark type \"%#1s\" (%#2d).\n")
+    (no-mark-types-left . "Sorry, there are no free mark types. Remove an old one first.")
     (unmarking-textno . "Unmarking text %#1n...")
     (marking-textno . "Marking text %#1n...")
     (list-which-mark . "List texts with which mark type (name or 0-255, RET for all)? ")

src/swedish-strings.el

@@ -342,6 +342,9 @@ du har l
     (text-to-unmark . "Vilket inlgg vill du avmarkera? ")
     (what-mark . "Vilken typ av markering vill du stta (namn eller 0-255)? ")
     (erroneous-mark . "Felaktig markeringstyp.\n")
+    (want-to-create-symbolic-mark . "Markeringstypen \"%#1s\" finns inte. Vill du skapa den? ")
+    (creating-symbolic-mark-type . "Skapar markeringstypen \"%#1s\" (%#2d).\n")
+    (no-mark-types-left . "Ledsen, det finns inga lediga markeringstyper. Rensa bland de gamla frst.")
     (unmarking-textno . "Avmarkering av text %#1n...")
     (marking-textno . "Markering av text %#1n...")
     (list-which-mark . "Lista vilken markeringstyp (namn eller 0-255, RET fr alla)? ")

src/vars.el.in

@@ -205,7 +205,7 @@ The value of this variable is the file name on which to save new texts."
   "*Where to prioritize conferences. See kom-write-texts-in-window."
   server)
 
-(def-kom-var kom-default-mark 100
+(def-kom-var kom-default-mark nil
   "*If non-nil (must be an integer), the user is not asked for type of mark."
   server)