- (if (null comment-list)
- nil
- (let ((generic-mode-syntax-table (make-syntax-table)))
- (make-local-variable 'comment-start)
- (make-local-variable 'comment-start-skip)
- (make-local-variable 'comment-end)
- (mapcar 'generic-mode-set-a-comment comment-list)
- (set-syntax-table generic-mode-syntax-table))))
-
-(defun generic-mode-set-a-comment (comment)
- (and (char-or-string-p comment)
- (if (stringp comment)
- (cond
- ((eq (length comment) 1)
- (generic-mode-set-comment-char
- (string-to-char comment)))
- ((eq (length comment) 2)
- (generic-mode-set-comment-string comment))
- (t
- (error "Character string %s must be one or two characters long"
- comment))
- )
- (generic-mode-set-comment-char comment)))
- (if (consp comment)
- (generic-mode-set-comment-pair comment)))
-
-(defun generic-mode-set-comment-char (comment-char)
- "Set the given character as a comment character for generic mode."
- (if (not comment-char)
- nil
- (setq
- comment-end ""
- comment-start (char-to-string comment-char)
- comment-start-skip (concat comment-start "+ *")
- )
-
- (modify-syntax-entry comment-char "<"
- generic-mode-syntax-table)
- (modify-syntax-entry ?\n ">"
- generic-mode-syntax-table)))
-
-(defun generic-mode-set-comment-string (comment-string)
- "Set the given string as a comment string for generic mode."
- (if (not comment-string)
- nil
- (setq
- comment-end ""
- comment-start comment-string
- comment-start-skip (concat comment-start " *")
- )
-
- (let ((first (elt comment-string 0))
- (second (elt comment-string 1)))
- ;; C++ style comments
- (if (char-equal first second)
- (progn
- (modify-syntax-entry first "<12b"
- generic-mode-syntax-table)
- (modify-syntax-entry ?\n ">b"
- generic-mode-syntax-table)))
- ;; Some other two character string
- (modify-syntax-entry first "<1"
- generic-mode-syntax-table)
- (modify-syntax-entry second "<2"
- generic-mode-syntax-table)
- (modify-syntax-entry ?\n ">"
- generic-mode-syntax-table))))
-
-(defun generic-mode-set-comment-pair (comment-pair)
- "Set the given comment pair as a comment start and end for generic mode."
- (let ((generic-comment-start (car comment-pair))
- (generic-comment-end (cdr comment-pair))
- )
- (setq
- comment-end generic-comment-end
- comment-start generic-comment-start
- comment-start-skip (concat generic-comment-start " *")
- )
-
- ;; Sanity checks
- (if (not (and (stringp generic-comment-start)
- (stringp generic-comment-end)))
- (error "Elements of cons pair must be strings"))
- (if (not (and (equal (length generic-comment-start) 2)
- (equal (length generic-comment-end) 2)))
- (error "Start and end must be exactly two characters long"))
-
- (let ((first (elt generic-comment-start 0))
- (second (elt generic-comment-start 1))
- (third (elt generic-comment-end 0))
- (fourth (elt generic-comment-end 1))
- )
-
- (modify-syntax-entry first ". 1" generic-mode-syntax-table)
- (modify-syntax-entry second ". 2" generic-mode-syntax-table)
-
- (modify-syntax-entry
- third
- (concat
- "."
- (cond
- ((char-equal first third) " 13")
- ((char-equal second third) " 23")
- (t " 3"))
- )
- generic-mode-syntax-table)
-
- (modify-syntax-entry
- fourth
- (concat
- "."
- (cond
- ((char-equal first fourth) " 14")
- ((char-equal second fourth) " 24")
- (t " 4"))
- )
- generic-mode-syntax-table)
- )))
+ (let ((st (make-syntax-table))
+ (chars nil)
+ (comstyles))
+ (make-local-variable 'comment-start)
+ (make-local-variable 'comment-start-skip)
+ (make-local-variable 'comment-end)
+
+ ;; Go through all the comments
+ (dolist (start comment-list)
+ (let ((end ?\n) (comstyle ""))
+ ;; Normalize
+ (when (consp start)
+ (setq end (or (cdr start) end))
+ (setq start (car start)))
+ (when (char-valid-p start) (setq start (char-to-string start)))
+ (when (char-valid-p end) (setq end (char-to-string end)))
+
+ ;; Setup the vars for `comment-region'
+ (if comment-start
+ ;; We have already setup a comment-style, so use style b
+ (progn
+ (setq comstyle "b")
+ (setq comment-start-skip
+ (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*")))
+ ;; First comment-style
+ (setq comment-start start)
+ (setq comment-end (if (string-equal end "\n") "" end))
+ (setq comment-start-skip (concat (regexp-quote start) "+\\s-*")))
+
+ ;; Reuse comstyles if necessary
+ (setq comstyle
+ (or (cdr (assoc start comstyles))
+ (cdr (assoc end comstyles))
+ comstyle))
+ (push (cons start comstyle) comstyles)
+ (push (cons end comstyle) comstyles)
+
+ ;; Setup the syntax table
+ (if (= (length start) 1)
+ (modify-syntax-entry (string-to-char start)
+ (concat "< " comstyle) st)
+ (let ((c0 (elt start 0)) (c1 (elt start 1)))
+ ;; Store the relevant info but don't update yet
+ (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
+ (push (cons c1 (concat (cdr (assoc c1 chars))
+ (concat "2" comstyle))) chars)))
+ (if (= (length end) 1)
+ (modify-syntax-entry (string-to-char end)
+ (concat ">" comstyle) st)
+ (let ((c0 (elt end 0)) (c1 (elt end 1)))
+ ;; Store the relevant info but don't update yet
+ (push (cons c0 (concat (cdr (assoc c0 chars))
+ (concat "3" comstyle))) chars)
+ (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
+
+ ;; Process the chars that were part of a 2-char comment marker
+ (dolist (cs (nreverse chars))
+ (modify-syntax-entry (car cs)
+ (concat (char-to-string (char-syntax (car cs)))
+ " " (cdr cs))
+ st))
+ (set-syntax-table st)))