[svn.haxx.se] · SVN Dev · SVN Users · SVN Org · TSVN Dev · TSVN Users · Subclipse Dev · Subclipse Users · this month's index

Re: emacs macros for writing CHANGES

From: Ben Collins-Sussman <sussman_at_red-bean.com>
Date: 2007-11-03 01:38:37 CET

;; ------------------ Karl's amazing "running changelog" builder:

(defun kf-markup-flavor ()
  "Return a symbol indicating what kind of markup to use, such as
'xml', 'texi', 'html', 'ltx', or nil, based on the filename extension.
Use this instead of the major mode when you can't depend on the mode."
  (let ((extension (file-name-extension (buffer-name))))
    (if extension
          (if (string-match "\\([^<]+\\)<[0-9]>$" extension)
              (setq extension (match-string 1 extension)))
          (intern extension)))))

(defun kf-is-svn-path (path)
  "Return non-nil if PATH is under Subversion revision control."
  (let ((dir (if (file-directory-p path) path (file-name-directory path))))
    (file-directory-p (concat dir "/" ".svn"))))

(defun kf-log-path-derive (path)
  "Derive a relative directory path for absolute PATH, for a log entry."
    (if (kf-is-svn-path path)
        (let ((path2 path)
              (last-path nil))
          (while (kf-is-svn-path path2)
            (setq last-path path2)
            (string-match "\\(.*/\\)[^/]+\\(/\\|\\)$" path2)
            (setq path2 (match-string 1 path2)))
          (substring path (length last-path)))
      (let ((match (string-match
                    "\\(code/\\)\\|\\(src/\\)\\|\\(projects/\\)" path)))
        (if match
              (setq path (substring path (match-end 0)))
              ;; Kluge for Subversion developers.
              (if (string-match "subversion/" path)
                  (substring path (+ (match-beginning 0) 11))
          (string-match (expand-file-name "~/") path)
          (substring path (match-end 0)))))))

(defun kf-log-message-file (path)
  "Return the name of the appropriate log message accumulation file for PATH.
Usually this is the file `msg' in either the current directory, or in
the highest Subversion-controlled working copy directory above PATH,
if PATH is under Subversion control."
  (if (kf-is-svn-path path)
        (let (last-path)
          (while (kf-is-svn-path path)
            (setq last-path path)
            (string-match "\\(.*\\)/[^/]+$" path)
            (setq path (match-string 1 path)))
          (concat last-path "/floo.txt")))
      (if (string-match "subversion" default-directory)
          (concat (substring default-directory 0 (match-end 0)) "/floo.txt")

(defun kf-add-log-current-defun ()
  "Try to determine the current defun using `add-log-current-defun'
  first, falling back to various custom heuristics if that fails."
  (let* ((flavor (kf-markup-flavor))
         (default-defun (add-log-current-defun)))
         ((and (not default-defun) (eq major-mode 'c-mode))
          ;; Handle .h files as well as .c files.
            (search-forward "(" nil t)
            (forward-char -1)
            (forward-sexp -1)
             (progn (forward-sexp 1) (point)))))
         ((eq flavor 'xml)
            (when (search-backward "<title>" nil t)
              (forward-char 7)
               (progn (search-forward "</title>")
                      (forward-char -8)

(defun kf-log-message (short-file-names)
  "Add to an in-progress log message, based on context around point.
If prefix arg SHORT-FILE-NAMES is non-nil, then use basenames only in
log messages, otherwise use full paths. The current defun name is
always used.

If the log message already contains material about this defun, then put
point there, so adding to that material is easy.

Else if the log message already contains material about this file, put
point there, and push onto the kill ring the defun name with log
message dressing around it, plus the raw defun name, so yank and
yank-next are both useful.

Else if there is no material about this defun nor file anywhere in the
log message, then put point at the end of the message and insert a new
entry for file with defun.

See also the function `kf-log-message-file'."
  (interactive "P")
  (let ((this-file (if short-file-names
                       (file-name-nondirectory buffer-file-name)
                     (kf-log-path-derive buffer-file-name)))
        (this-defun (kf-add-log-current-defun))
        (log-file (kf-log-message-file buffer-file-name)))
    (find-file log-file)
    (goto-char (point-min))
    ;; Strip text properties from strings
    (set-text-properties 0 (length this-file) nil this-file)
    (set-text-properties 0 (length this-defun) nil this-defun)
    ;; If log message for defun already in progress, add to it
    (if (and
         this-defun ;; we have a defun to work with
         (search-forward this-defun nil t) ;; it's in the log msg already
         (save-excursion ;; and it's about the same file
             (if (re-search-backward ; Ick, I want a real filename regexp!
                  "^\\*\\s-+\\([a-zA-Z0-9-_.@=+^$/%!?(){}<>]+\\)" nil t)
                 (string-equal (match-string 1) this-file)
        (if (re-search-forward ":" nil t)
            (if (looking-at " ") (forward-char 1)))
      ;; Else no log message for this defun in progress...
      (goto-char (point-min))
      ;; But if log message for file already in progress, add to it.
      (if (search-forward this-file nil t)
            (if this-defun (progn
                             (kill-new (format "(%s): " this-defun))
                             (kill-new this-defun)))
            (search-forward ")" nil t)
            (if (looking-at " ") (forward-char 1)))
        ;; Found neither defun nor its file, so create new entry.
        (goto-char (point-max))
        (if (not (bolp)) (insert "\n"))
        (insert (format "\n* %s (%s): " this-file (or this-defun "")))
        ;; Finally, if no derived defun, put point where the user can
        ;; type it themselves.
        (if (not this-defun) (forward-char -3))))))

(global-set-key "\C-cl" 'kf-log-message)

To unsubscribe, e-mail: dev-unsubscribe@subversion.tigris.org
For additional commands, e-mail: dev-help@subversion.tigris.org
Received on Sat Nov 3 01:39:28 2007

This is an archived mail posted to the Subversion Dev mailing list.