January 2011 - XEmacs-Patches - XEmacs Mailing List Archives

[COMMIT] Replace POSIX index(3) with C89 strchr(3), lwlib-fonts.c 13 years, 11 months

Aidan Kehoe

Buildbot is timing out for me right now, and I couldn’t actually reproduce the failure locally; hopefully this will do the trick despite that. APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1294753175 0 # Node ID c9d31263ab7db633744accb5195727a4a343a3d7 # Parent b249c479f9e1d0b94f449074793e12411720aed2 Replace POSIX index(3) with C89 strchr(3), lwlib-fonts.c 2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net> * lwlib-fonts.c (xft_open_font_by_name): Replace the POSIX index(3), not universally available even today, with the C89 strchr(3), hopefully fixing a few of the buildbots' problems. diff -r b249c479f9e1 -r c9d31263ab7d lwlib/ChangeLog --- a/lwlib/ChangeLog Mon Jan 10 20:00:57 2011 +0000 +++ b/lwlib/ChangeLog Tue Jan 11 13:39:35 2011 +0000 ＠＠ -1,3 +1,10 ＠＠ +2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net> + + * lwlib-fonts.c (xft_open_font_by_name): + Replace the POSIX index(3), not universally available even today, + with the C89 strchr(3), hopefully fixing a few of the buildbots' + problems. + 2010-06-13 Stephen J. Turnbull <stephen(a)xemacs.org> * lwlib-internal.h: Correct FSF address in permission notice. diff -r b249c479f9e1 -r c9d31263ab7d lwlib/lwlib-fonts.c --- a/lwlib/lwlib-fonts.c Mon Jan 10 20:00:57 2011 +0000 +++ b/lwlib/lwlib-fonts.c Tue Jan 11 13:39:35 2011 +0000 ＠＠ -76,7 +76,7 ＠＠ int count = 0; char *pos = name; /* extra parens shut up gcc */ - while ((pos = index (pos, '-'))) + while ((pos = strchr (pos, '-'))) { count++; pos++; ＠＠ -86,7 +86,7 ＠＠ if (count == 14 /* fully-qualified XLFD */ || (count < 14 /* heuristic for wildcarded XLFD */ && count >= 5 - && index (name, '*'))) + && strchr (name, '*'))) res = XftFontOpenXlfd (dpy, DefaultScreen (dpy), name); else res = XftFontOpenName (dpy, DefaultScreen (dpy), name); -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Replace POSIX index(3) with C89 strchr(3), lwlib-fonts.c 13 years, 11 months

Aidan Kehoe

changeset: 5335:c9d31263ab7d tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Tue Jan 11 13:39:35 2011 +0000 files: lwlib/ChangeLog lwlib/lwlib-fonts.c description: Replace POSIX index(3) with C89 strchr(3), lwlib-fonts.c 2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net> * lwlib-fonts.c (xft_open_font_by_name): Replace the POSIX index(3), not universally available even today, with the C89 strchr(3), hopefully fixing a few of the buildbots' problems. diff -r b249c479f9e1 -r c9d31263ab7d lwlib/ChangeLog --- a/lwlib/ChangeLog Mon Jan 10 20:00:57 2011 +0000 +++ b/lwlib/ChangeLog Tue Jan 11 13:39:35 2011 +0000 ＠＠ -1,3 +1,10 ＠＠ +2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net> + + * lwlib-fonts.c (xft_open_font_by_name): + Replace the POSIX index(3), not universally available even today, + with the C89 strchr(3), hopefully fixing a few of the buildbots' + problems. + 2010-06-13 Stephen J. Turnbull <stephen(a)xemacs.org> * lwlib-internal.h: Correct FSF address in permission notice. diff -r b249c479f9e1 -r c9d31263ab7d lwlib/lwlib-fonts.c --- a/lwlib/lwlib-fonts.c Mon Jan 10 20:00:57 2011 +0000 +++ b/lwlib/lwlib-fonts.c Tue Jan 11 13:39:35 2011 +0000 ＠＠ -76,7 +76,7 ＠＠ int count = 0; char *pos = name; /* extra parens shut up gcc */ - while ((pos = index (pos, '-'))) + while ((pos = strchr (pos, '-'))) { count++; pos++; ＠＠ -86,7 +86,7 ＠＠ if (count == 14 /* fully-qualified XLFD */ || (count < 14 /* heuristic for wildcarded XLFD */ && count >= 5 - && index (name, '*'))) + && strchr (name, '*'))) res = XftFontOpenXlfd (dpy, DefaultScreen (dpy), name); else res = XftFontOpenName (dpy, DefaultScreen (dpy), name); _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Replace some C++ comments with C89-style /* */ comments, mc-alloc.c 13 years, 11 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1294689657 0 # Node ID b249c479f9e1d0b94f449074793e12411720aed2 # Parent aa2705c83c24fe75d272acb541949dfba4d0666b Replace some C++ comments with C89-style /* */ comments, mc-alloc.c 2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> * mc-alloc.c (get_used_list_index): Replace some C++ comments with C-style /* comments. diff -r aa2705c83c24 -r b249c479f9e1 src/ChangeLog --- a/src/ChangeLog Mon Jan 10 17:55:06 2011 +0000 +++ b/src/ChangeLog Mon Jan 10 20:00:57 2011 +0000 ＠＠ -1,3 +1,8 ＠＠ +2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> + + * mc-alloc.c (get_used_list_index): + Replace some C++ comments with C-style /* comments. + 2011-01-02 Aidan Kehoe <kehoea(a)parhasard.net> * fns.c (FdeleteX, FremoveX, Fnsubstitute, Fsubstitute, syms_of_fns): diff -r aa2705c83c24 -r b249c479f9e1 src/mc-alloc.c --- a/src/mc-alloc.c Mon Jan 10 17:55:06 2011 +0000 +++ b/src/mc-alloc.c Mon Jan 10 20:00:57 2011 +0000 ＠＠ -1148,18 +1148,18 ＠＠ { if (size <= USED_LIST_MIN_OBJECT_SIZE) { - // printf ("size %d -> index %d\n", size, 0); + /* printf ("size %d -> index %d\n", size, 0); */ return 0; } if (size <= (size_t) USED_LIST_UPPER_THRESHOLD) { - // printf ("size %d -> index %d\n", size, - // ((size - USED_LIST_MIN_OBJECT_SIZE - 1) - // / USED_LIST_LIN_STEP) + 1); + /* printf ("size %d -> index %d\n", size, */ + /* ((size - USED_LIST_MIN_OBJECT_SIZE - 1) */ + /* / USED_LIST_LIN_STEP) + 1); */ return ((size - USED_LIST_MIN_OBJECT_SIZE - 1) / USED_LIST_LIN_STEP) + 1; } - // printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); + /* printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); */ return N_USED_PAGE_LISTS - 1; } -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Replace some C++ comments with C89-style /* */ comments, mc-alloc.c 13 years, 11 months

Aidan Kehoe

changeset: 5334:b249c479f9e1 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Mon Jan 10 20:00:57 2011 +0000 files: src/ChangeLog src/mc-alloc.c description: Replace some C++ comments with C89-style /* */ comments, mc-alloc.c 2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> * mc-alloc.c (get_used_list_index): Replace some C++ comments with C-style /* comments. diff -r aa2705c83c24 -r b249c479f9e1 src/ChangeLog --- a/src/ChangeLog Mon Jan 10 17:55:06 2011 +0000 +++ b/src/ChangeLog Mon Jan 10 20:00:57 2011 +0000 ＠＠ -1,3 +1,8 ＠＠ +2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> + + * mc-alloc.c (get_used_list_index): + Replace some C++ comments with C-style /* comments. + 2011-01-02 Aidan Kehoe <kehoea(a)parhasard.net> * fns.c (FdeleteX, FremoveX, Fnsubstitute, Fsubstitute, syms_of_fns): diff -r aa2705c83c24 -r b249c479f9e1 src/mc-alloc.c --- a/src/mc-alloc.c Mon Jan 10 17:55:06 2011 +0000 +++ b/src/mc-alloc.c Mon Jan 10 20:00:57 2011 +0000 ＠＠ -1148,18 +1148,18 ＠＠ { if (size <= USED_LIST_MIN_OBJECT_SIZE) { - // printf ("size %d -> index %d\n", size, 0); + /* printf ("size %d -> index %d\n", size, 0); */ return 0; } if (size <= (size_t) USED_LIST_UPPER_THRESHOLD) { - // printf ("size %d -> index %d\n", size, - // ((size - USED_LIST_MIN_OBJECT_SIZE - 1) - // / USED_LIST_LIN_STEP) + 1); + /* printf ("size %d -> index %d\n", size, */ + /* ((size - USED_LIST_MIN_OBJECT_SIZE - 1) */ + /* / USED_LIST_LIN_STEP) + 1); */ return ((size - USED_LIST_MIN_OBJECT_SIZE - 1) / USED_LIST_LIN_STEP) + 1; } - // printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); + /* printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); */ return N_USED_PAGE_LISTS - 1; } _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Correct a misplaced parenthesis in #'make-dialog-box, thank you Mats! 13 years, 11 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1294682106 0 # Node ID aa2705c83c24fe75d272acb541949dfba4d0666b # Parent 1dbc93b7ba1901154b335c5d993940e7975622f5 Correct a misplaced parenthesis in #'make-dialog-box, thank you Mats! 2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis here, thank you Mats Lidell in 87zkr9gqrh.fsf(a)mail.contactor.se ! diff -r 1dbc93b7ba19 -r aa2705c83c24 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jan 02 18:05:05 2011 +0000 +++ b/lisp/ChangeLog Mon Jan 10 17:55:06 2011 +0000 ＠＠ -1,3 +1,8 ＠＠ +2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> + + * dialog.el (make-dialog-box): Correct a misplaced parenthesis + here, thank you Mats Lidell in 87zkr9gqrh.fsf(a)mail.contactor.se ! + 2011-01-02 Aidan Kehoe <kehoea(a)parhasard.net> * dialog.el (make-dialog-box): diff -r 1dbc93b7ba19 -r aa2705c83c24 lisp/dialog.el --- a/lisp/dialog.el Sun Jan 02 18:05:05 2011 +0000 +++ b/lisp/dialog.el Mon Jan 10 17:55:06 2011 +0000 ＠＠ -663,9 +663,9 ＠＠ (remf rest :modal) (if modal (dialog-box-modal-loop `(make-dialog-box-internal ',type ',rest)) - (make-dialog-box-internal type rest)))) - (t - (make-dialog-box-internal type rest)))) + (make-dialog-box-internal type rest))) + (t + (make-dialog-box-internal type rest))))) (defun dialog-box-finish (result) "Exit a modal dialog box, returning RESULT. -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Correct a misplaced parenthesis in #'make-dialog-box, thank you Mats! 13 years, 11 months

Aidan Kehoe

changeset: 5333:aa2705c83c24 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Mon Jan 10 17:55:06 2011 +0000 files: lisp/ChangeLog lisp/dialog.el description: Correct a misplaced parenthesis in #'make-dialog-box, thank you Mats! 2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis here, thank you Mats Lidell in 87zkr9gqrh.fsf(a)mail.contactor.se ! diff -r 1dbc93b7ba19 -r aa2705c83c24 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jan 02 18:05:05 2011 +0000 +++ b/lisp/ChangeLog Mon Jan 10 17:55:06 2011 +0000 ＠＠ -1,3 +1,8 ＠＠ +2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net> + + * dialog.el (make-dialog-box): Correct a misplaced parenthesis + here, thank you Mats Lidell in 87zkr9gqrh.fsf(a)mail.contactor.se ! + 2011-01-02 Aidan Kehoe <kehoea(a)parhasard.net> * dialog.el (make-dialog-box): diff -r 1dbc93b7ba19 -r aa2705c83c24 lisp/dialog.el --- a/lisp/dialog.el Sun Jan 02 18:05:05 2011 +0000 +++ b/lisp/dialog.el Mon Jan 10 17:55:06 2011 +0000 ＠＠ -663,9 +663,9 ＠＠ (remf rest :modal) (if modal (dialog-box-modal-loop `(make-dialog-box-internal ',type ',rest)) - (make-dialog-box-internal type rest)))) - (t - (make-dialog-box-internal type rest)))) + (make-dialog-box-internal type rest))) + (t + (make-dialog-box-internal type rest))))) (defun dialog-box-finish (result) "Exit a modal dialog box, returning RESULT. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Use defun*, not cl-parsing-keywords, add-log.el 13 years, 11 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. xemacs-packages/xemacs-base/ChangeLog addition: 2011-01-08 Aidan Kehoe <kehoea(a)parhasard.net> * add-log.el (patch-to-change-log): Use defun*, not cl-parsing-keywords, now the latter is gone from 21.5. Isn't it a shame the diff command doesn't understand Lisp indentation. Document that an explicit nil was equivalent to the default for the :my-name and :my-email keys, something that cl-parsing-keywords did which defun* (correctly enough) doesn't. XEmacs Packages source patch: Diff command: cvs -q diff -Nu Files affected: xemacs-packages/xemacs-base/add-log.el Index: xemacs-packages/xemacs-base/add-log.el =================================================================== RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/xemacs-base/add-log.el,v retrieving revision 1.27 diff -u -u -r1.27 add-log.el --- xemacs-packages/xemacs-base/add-log.el 6 Oct 2010 14:47:57 -0000 1.27 +++ xemacs-packages/xemacs-base/add-log.el 8 Jan 2011 17:05:06 -0000 ＠＠ -1056,7 +1056,11 ＠＠ (insert-buffer-substring other-buf start))))))) ;;;###autoload -(defun patch-to-change-log (devdir &rest cl-keys) +(defun* patch-to-change-log (devdir &key dry-run keep-source-files + extent-property extent-property-value + (my-name (or add-log-full-name (user-full-name))) + (my-email (or add-log-mailing-address + (user-mail-address)))) "Convert the unified diff in the current buffer into a ChangeLog. DEVDIR (queried interactively) specifies the directory the diff was made relative to. The ChangeLog entries are added to the appropriate ＠＠ -1073,9 +1077,11 ＠＠ The following keys are allowed: - :my-name defines the name to use in ChangeLog entries - (defaults to `(or add-log-full-name (user-full-name))'), + (defaults to `(or add-log-full-name (user-full-name))'; an explicit nil is + regarded as equivalent to the default), - :my-email defines the email address to use in ChangeLog entries - (defaults to `(or add-log-mailing-address (user-mail-address))'), + (defaults to `(or add-log-mailing-address (user-mail-address))'; an + explicit nil is regarded as equivalent to the default), - :dry-run prevents `patch-to-changelog' from generating the ChangeLog entries: ChangeLog files are only loaded (defaults to nil), - :keep-source-files prevents `patch-to-changelog' from killing the source ＠＠ -1088,266 +1094,248 ＠＠ specify a value for the extent property (defaults to nil)." (interactive "DBase directory of patch: ") - (cl-parsing-keywords - ((:my-name (or add-log-full-name (user-full-name))) - (:my-email (or add-log-mailing-address (user-mail-address))) -:dry-run :keep-source-files :extent-property :extent-property-value) - () - (let* ((old-font-lock-auto-fontify font-lock-auto-fontify) - (font-lock-auto-fontify nil) - (file-re1 "^Index: \$[^\n]*\$") - (file-re2 "^\\+\\+\\+ \$.*?\$\$\t\\|\n\$") - (hunk-re "^＠＠ -[0-9]+,[0-9]+ \\+\$[0-9]+\$,\$[0-9]+\$ ＠＠") - (basename-re "\\`\$.*\$/\$.*\$\\'") - (lisp-defun-re "(def[a-z-]*\\*? \$[^ \n]+\$") -; (c-token-re "[][_a-zA-Z0-9]+") -; (ws-re "\$\\s-\\|\n\\+\$*") -; (c-multi-token-re (concat c-token-re "\$" ws-re c-token-re "\$*")) -; (c-defun-re (concat "^+\$" c-token-re ws-re "\$*" -; "\$" c-token-re "\$" ws-re "(" ws-re -; "\$" -; c-multi-token-re ws-re -; "\\(," ws-re c-multi-token-re ws-re "\$*" -; "\\)?" ws-re ")" ws-re "{" ws-re "$")) - (new-defun-re (concat "^\\+" lisp-defun-re)) - (nomore-defun-re (concat "^-" lisp-defun-re)) - (new-heuristic-fun-re - (concat "^\\+" (substring add-log-current-defun-header-regexp 1))) - (nomore-heuristic-fun-re - (concat "^-" (substring add-log-current-defun-header-regexp 1))) - (done-hash (make-hash-table :size 20 :test 'equal)) - (new-fun-hash (make-hash-table :size 20 :test 'equal)) - (nomore-fun-hash (make-hash-table :size 20 :test 'equal)) - (new-heuristic-fun-hash (make-hash-table :size 20 :test 'equal)) - (nomore-heuristic-fun-hash (make-hash-table :size 20 :test 'equal)) - change-log-buffer change-log-buffers change-log-directory - file absfile limit current-defun - dirname basename previous-dirname - all-entries first-file-re-p - insertion-marker - ) - - (flet - ((add-change-log-string - (str) - (with-current-buffer change-log-buffer - (goto-char insertion-marker) - (insert-before-markers str))) - - (add-entry - (filename line fun str) - (let ((entry (cons filename fun))) - (unless (or (gethash entry done-hash) - (string-match "\n." str)) - ;; (message "%s %S" str (gethash entry done-hash)) - (puthash entry t done-hash) - (push (cons str line) all-entries)))) - - (flush-change-log-entries - () - (setq all-entries (sort all-entries #'cdr-less-than-cdr)) - (mapc #'(lambda (entry) - (add-change-log-string (car entry))) - all-entries) - (setq all-entries nil)) - - (line-num () (1+ (count-lines (point-min) (point-at-bol)))) - - (finish-up-change-log-buffer - () - (push change-log-buffer change-log-buffers) - (unless cl-dry-run - (add-change-log-string "\n")) - (with-current-buffer change-log-buffer - (goto-char (point-min))))) - - (save-excursion - (goto-char (point-min)) - (while (or (prog1 (re-search-forward file-re1 nil t) - (setq first-file-re-p t)) - (prog1 (re-search-forward file-re2 nil t) - (setq first-file-re-p nil))) - (setq file (match-string 1)) - (if (string-match basename-re file) - (setq dirname (match-string 1 file) - basename (match-string 2 file)) - (setq dirname "" basename file)) - (setq absfile (expand-file-name file devdir)) - (setq limit - (save-excursion (or (re-search-forward - (if first-file-re-p file-re1 file-re2) - nil t) - (point-max)))) - (when (not (equal dirname previous-dirname)) - (if previous-dirname - (finish-up-change-log-buffer)) - (setq previous-dirname dirname) - (setq change-log-buffer - (let ((font-lock-auto-fontify - old-font-lock-auto-fontify)) - (find-file-noselect - ;; APA: find a change-log relative to current directory. - (with-temp-buffer - (cd (expand-file-name dirname devdir)) - (find-change-log))))) - (setq change-log-directory - (with-current-buffer change-log-buffer default-directory)) - (unless cl-dry-run - (when cl-extent-property - (with-current-buffer change-log-buffer - (set-extent-properties - (make-extent (point-min) (point-min)) - (list 'end-open nil - cl-extent-property cl-extent-property-value)))) - (setq insertion-marker (point-min-marker change-log-buffer)) - (add-change-log-string - (format (concat "%s " cl-my-name " <" cl-my-email - ">\n\n") - (iso8601-time-string))))) - ;; APA: Standardize on / in ChangeLog entry paths. - (let ((directory-sep-char ?/)) - (setq basename - (file-relative-name absfile change-log-directory))) - ;; now do each hunk in turn. - (unless cl-dry-run - (while (re-search-forward hunk-re limit t) - (let* ((hunk-start-line (line-num)) - (first-file-line (string-to-int (match-string 1))) - (hunk-limit - (save-excursion (or (and - (re-search-forward hunk-re limit - t) - (match-beginning 0)) - limit))) - ;; numlines is the number of lines in the hunk, not - ;; the number of file lines affected by the hunk, i.e. - ;; (match-string 2), which is generally less - (numlines (1- (- (save-excursion - (goto-char hunk-limit) - (line-num)) - hunk-start-line)))) - - ;; do added and/or removed functions. - (clrhash new-fun-hash) - (clrhash nomore-fun-hash) - (save-excursion - (while (re-search-forward new-defun-re hunk-limit t) - (puthash (match-string 1) - (1- (- (line-num) hunk-start-line)) - new-fun-hash))) - (save-excursion - (while (re-search-forward nomore-defun-re hunk-limit t) - (let ((fun (match-string 1))) - (if (gethash fun new-fun-hash) - (remhash fun new-fun-hash) - (puthash fun - (1- (- (line-num) hunk-start-line)) - nomore-fun-hash))))) - ;; do added and/or removed variable heuristics. - (clrhash new-heuristic-fun-hash) - (clrhash nomore-heuristic-fun-hash) - (save-excursion - (while (re-search-forward - new-heuristic-fun-re hunk-limit t) - (let ((fun (match-string 1))) - (unless (gethash fun new-fun-hash) - (puthash (match-string 1) + (let* ((my-name (or my-name add-log-full-name (user-full-name))) + (my-email (or my-email add-log-mailing-address (user-mail-address))) + (old-font-lock-auto-fontify font-lock-auto-fontify) + + (font-lock-auto-fontify nil) + (file-re1 "^Index: \$[^\n]*\$") + (file-re2 "^\\+\\+\\+ \$.*?\$\$\t\\|\n\$") + (hunk-re "^＠＠ -[0-9]+,[0-9]+ \\+\$[0-9]+\$,\$[0-9]+\$ ＠＠") + (basename-re "\\`\$.*\$/\$.*\$\\'") + (lisp-defun-re "(def[a-z-]*\\*? \$[^ \n]+\$") +; (c-token-re "[][_a-zA-Z0-9]+") +; (ws-re "\$\\s-\\|\n\\+\$*") +; (c-multi-token-re (concat c-token-re "\$" ws-re c-token-re "\$*")) +; (c-defun-re (concat "^+\$" c-token-re ws-re "\$*" +; "\$" c-token-re "\$" ws-re "(" ws-re +; "\$" +; c-multi-token-re ws-re +; "\\(," ws-re c-multi-token-re ws-re "\$*" +; "\\)?" ws-re ")" ws-re "{" ws-re "$")) + (new-defun-re (concat "^\\+" lisp-defun-re)) + (nomore-defun-re (concat "^-" lisp-defun-re)) + (new-heuristic-fun-re + (concat "^\\+" (substring add-log-current-defun-header-regexp 1))) + (nomore-heuristic-fun-re + (concat "^-" (substring add-log-current-defun-header-regexp 1))) + (done-hash (make-hash-table :size 20 :test 'equal)) + (new-fun-hash (make-hash-table :size 20 :test 'equal)) + (nomore-fun-hash (make-hash-table :size 20 :test 'equal)) + (new-heuristic-fun-hash (make-hash-table :size 20 :test 'equal)) + (nomore-heuristic-fun-hash (make-hash-table :size 20 :test 'equal)) + change-log-buffer change-log-buffers change-log-directory file + absfile limit current-defun dirname basename previous-dirname + all-entries first-file-re-p insertion-marker) + (flet + ((add-change-log-string (str) + (with-current-buffer change-log-buffer + (goto-char insertion-marker) + (insert-before-markers str))) + (add-entry (filename line fun str) + (let ((entry (cons filename fun))) + (unless (or (gethash entry done-hash) + (string-match "\n." str)) + ;; (message "%s %S" str (gethash entry done-hash)) + (puthash entry t done-hash) + (push (cons str line) all-entries)))) + (flush-change-log-entries () + (setq all-entries (sort all-entries #'cdr-less-than-cdr)) + (mapc #'(lambda (entry) + (add-change-log-string (car entry))) + all-entries) + (setq all-entries nil)) + (line-num () (1+ (count-lines (point-min) (point-at-bol)))) + (finish-up-change-log-buffer () + (push change-log-buffer change-log-buffers) + (unless dry-run + (add-change-log-string "\n")) + (with-current-buffer change-log-buffer + (goto-char (point-min))))) + (save-excursion + (goto-char (point-min)) + (while (or (prog1 (re-search-forward file-re1 nil t) + (setq first-file-re-p t)) + (prog1 (re-search-forward file-re2 nil t) + (setq first-file-re-p nil))) + (setq file (match-string 1)) + (if (string-match basename-re file) + (setq dirname (match-string 1 file) + basename (match-string 2 file)) + (setq dirname "" basename file)) + (setq absfile (expand-file-name file devdir)) + (setq limit + (save-excursion (or (re-search-forward + (if first-file-re-p file-re1 file-re2) + nil t) + (point-max)))) + (when (not (equal dirname previous-dirname)) + (if previous-dirname + (finish-up-change-log-buffer)) + (setq previous-dirname dirname) + (setq change-log-buffer + (let ((font-lock-auto-fontify + old-font-lock-auto-fontify)) + (find-file-noselect + ;; APA: find a change-log relative to current directory. + (with-temp-buffer + (cd (expand-file-name dirname devdir)) + (find-change-log))))) + (setq change-log-directory + (with-current-buffer change-log-buffer default-directory)) + (unless dry-run + (when extent-property + (with-current-buffer change-log-buffer + (set-extent-properties + (make-extent (point-min) (point-min)) + (list 'end-open nil + extent-property extent-property-value)))) + (setq insertion-marker (point-min-marker change-log-buffer)) + (add-change-log-string + (format (concat "%s " my-name " <" my-email + ">\n\n") + (iso8601-time-string))))) + ;; APA: Standardize on / in ChangeLog entry paths. + (let ((directory-sep-char ?/)) + (setq basename + (file-relative-name absfile change-log-directory))) + ;; now do each hunk in turn. + (unless dry-run + (while (re-search-forward hunk-re limit t) + (let* ((hunk-start-line (line-num)) + (first-file-line (string-to-int (match-string 1))) + (hunk-limit + (save-excursion (or (and + (re-search-forward hunk-re limit + t) + (match-beginning 0)) + limit))) + ;; numlines is the number of lines in the hunk, not + ;; the number of file lines affected by the hunk, i.e. + ;; (match-string 2), which is generally less + (numlines (1- (- (save-excursion + (goto-char hunk-limit) + (line-num)) + hunk-start-line)))) + + ;; do added and/or removed functions. + (clrhash new-fun-hash) + (clrhash nomore-fun-hash) + (save-excursion + (while (re-search-forward new-defun-re hunk-limit t) + (puthash (match-string 1) + (1- (- (line-num) hunk-start-line)) + new-fun-hash))) + (save-excursion + (while (re-search-forward nomore-defun-re hunk-limit t) + (let ((fun (match-string 1))) + (if (gethash fun new-fun-hash) + (remhash fun new-fun-hash) + (puthash fun + (1- (- (line-num) hunk-start-line)) + nomore-fun-hash))))) + ;; do added and/or removed variable heuristics. + (clrhash new-heuristic-fun-hash) + (clrhash nomore-heuristic-fun-hash) + (save-excursion + (while (re-search-forward + new-heuristic-fun-re hunk-limit t) + (let ((fun (match-string 1))) + (unless (gethash fun new-fun-hash) + (puthash (match-string 1) + (1- (- (line-num) hunk-start-line)) + new-heuristic-fun-hash))))) + (save-excursion + (while (re-search-forward + nomore-heuristic-fun-re hunk-limit t) + (let ((fun (match-string 1))) + (if (gethash fun new-heuristic-fun-hash) + (remhash fun new-heuristic-fun-hash) + (unless (gethash fun nomore-fun-hash) + (puthash fun (1- (- (line-num) hunk-start-line)) - new-heuristic-fun-hash))))) - (save-excursion - (while (re-search-forward - nomore-heuristic-fun-re hunk-limit t) - (let ((fun (match-string 1))) - (if (gethash fun new-heuristic-fun-hash) - (remhash fun new-heuristic-fun-hash) - (unless (gethash fun nomore-fun-hash) - (puthash fun - (1- (- (line-num) hunk-start-line)) - nomore-heuristic-fun-hash)))))) - (maphash - #'(lambda (fun val) - (add-entry - basename - ;; this is not a perfect measure of the actual - ;; file line, but good enough for sorting. - (+ first-file-line val) - fun - (format "\t* %s (%s): New.\n" basename fun))) - new-fun-hash) - (maphash - #'(lambda (fun val) - (add-entry - basename - (+ first-file-line val) - fun - (format "\t* %s (%s): Removed.\n" basename fun))) - nomore-fun-hash) - (maphash - #'(lambda (fun val) - (add-entry - basename - ;; this is not a perfect measure of the actual - ;; file line, but good enough for sorting. - (+ first-file-line val) - fun - (format "\t* %s (%s): New.\n" basename fun))) - new-heuristic-fun-hash) - (maphash - #'(lambda (fun val) - (add-entry - basename - (+ first-file-line val) - fun - (format "\t* %s (%s): Removed.\n" basename fun))) - nomore-heuristic-fun-hash) - - ;; now try to handle what changed. - (let (trylines - (trystart t) - (line-in-file first-file-line)) - - ;; accumulate a list of lines to check. we check - ;; only changed lines, and only the first such line - ;; per blank-line-delimited block (we assume all - ;; functions are preceded by a blank line). - (save-excursion - (dotimes (n numlines) - (forward-line 1) - (if (looking-at ".\n") - (setq trystart t)) - (when (not (eq ? (char-after))) - (when trystart - (setq trylines (cons line-in-file trylines)) - (setq trystart nil))) - ;; N is not an accurate gauge of the file line, - ;; because of the presence of deleted lines in the - ;; hunk. - (when (not (eq ?- (char-after))) - (incf line-in-file)))) - (setq trylines (nreverse trylines)) - (save-excursion - (let ((already-visiting-p (get-file-buffer absfile))) - (set-buffer (find-file-noselect absfile)) - (mapc #'(lambda (n) - (goto-line n) - (setq current-defun (add-log-current-defun)) - (add-entry - basename - (if current-defun n 0) - current-defun - (format (if current-defun - "\t* %s (%s):\n" "\t* %s:\n") - basename current-defun))) - trylines) - (unless (or already-visiting-p cl-keep-source-files) - (kill-buffer (current-buffer)))))))) - (flush-change-log-entries)) - )) - ;; the patch might be totally blank. - (if change-log-buffer - (finish-up-change-log-buffer)) - ;; return the list of ChangeLog buffers - change-log-buffers)))) + nomore-heuristic-fun-hash)))))) + (maphash + #'(lambda (fun val) + (add-entry + basename + ;; this is not a perfect measure of the actual + ;; file line, but good enough for sorting. + (+ first-file-line val) + fun + (format "\t* %s (%s): New.\n" basename fun))) + new-fun-hash) + (maphash + #'(lambda (fun val) + (add-entry + basename + (+ first-file-line val) + fun + (format "\t* %s (%s): Removed.\n" basename fun))) + nomore-fun-hash) + (maphash + #'(lambda (fun val) + (add-entry + basename + ;; this is not a perfect measure of the actual + ;; file line, but good enough for sorting. + (+ first-file-line val) + fun + (format "\t* %s (%s): New.\n" basename fun))) + new-heuristic-fun-hash) + (maphash + #'(lambda (fun val) + (add-entry + basename + (+ first-file-line val) + fun + (format "\t* %s (%s): Removed.\n" basename fun))) + nomore-heuristic-fun-hash) + ;; now try to handle what changed. + (let (trylines + (trystart t) + (line-in-file first-file-line)) + ;; accumulate a list of lines to check. we check only + ;; changed lines, and only the first such line per + ;; blank-line-delimited block (we assume all functions are + ;; preceded by a blank line). + (save-excursion + (dotimes (n numlines) + (forward-line 1) + (if (looking-at ".\n") + (setq trystart t)) + (when (not (eq ? (char-after))) + (when trystart + (setq trylines (cons line-in-file trylines)) + (setq trystart nil))) + ;; N is not an accurate gauge of the file line, + ;; because of the presence of deleted lines in the + ;; hunk. + (when (not (eq ?- (char-after))) + (incf line-in-file)))) + (setq trylines (nreverse trylines)) + (save-excursion + (let ((already-visiting-p (get-file-buffer absfile))) + (set-buffer (find-file-noselect absfile)) + (mapc #'(lambda (n) + (goto-line n) + (setq current-defun (add-log-current-defun)) + (add-entry + basename + (if current-defun n 0) + current-defun + (format (if current-defun + "\t* %s (%s):\n" "\t* %s:\n") + basename current-defun))) + trylines) + (unless (or already-visiting-p keep-source-files) + (kill-buffer (current-buffer)))))))) + (flush-change-log-entries)))) + ;; the patch might be totally blank. + (if change-log-buffer + (finish-up-change-log-buffer)) + ;; return the list of ChangeLog buffers + change-log-buffers))) ;;;###autoload (defun change-log-redate () -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

[COMMIT] Deal better with #'builtin-symbol-file returning full paths, find-func.el 13 years, 11 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed. 2011-01-08 Aidan Kehoe <kehoea(a)parhasard.net> * find-func.el (find-function-C-source): Deal better with #'builtin-symbol-file returning full paths in this function; check for readability of find-function-C-source-directory. Index: xemacs-packages/xemacs-devel/find-func.el =================================================================== RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/xemacs-devel/find-func.el,v retrieving revision 1.13 diff -u -u -r1.13 find-func.el --- xemacs-packages/xemacs-devel/find-func.el 22 Dec 2008 14:04:11 -0000 1.13 +++ xemacs-packages/xemacs-devel/find-func.el 8 Jan 2011 16:17:57 -0000 ＠＠ -178,10 +178,15 ＠＠ (defun find-function-C-source (fun-or-var file type) "Find the source location where SUBR-OR-VAR is defined in FILE. TYPE should be nil to find a function, or `defvar' to find a variable." - (unless find-function-C-source-directory + (unless (and find-function-C-source-directory + (file-readable-p find-function-C-source-directory)) (setq find-function-C-source-directory (read-directory-name "XEmacs C source dir: " nil nil t))) (setq file (expand-file-name file find-function-C-source-directory)) + (or (file-readable-p file) + (equal (file-name-directory file) find-function-C-source-directory) + (setq file (expand-file-name (file-name-nondirectory file) + find-function-C-source-directory))) (unless (file-readable-p file) (error "The C source file %s is not available" (file-name-nondirectory file))) -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

1 participants
0 comments

commit: Let's try that last commit again; remove some more duplicate declarations. 13 years, 11 months

Aidan Kehoe

changeset: 5332:1dbc93b7ba19 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Sun Jan 02 18:05:05 2011 +0000 files: src/ChangeLog src/fns.c description: Let's try that last commit again; remove some more duplicate declarations. src/ChangeLog addition: (syms_of_fns): Remove a couple more duplicate symbol declarations. diff -r 7ea837399734 -r 1dbc93b7ba19 src/ChangeLog --- a/src/ChangeLog Sun Jan 02 17:37:17 2011 +0000 +++ b/src/ChangeLog Sun Jan 02 18:05:05 2011 +0000 ＠＠ -5,6 +5,7 ＠＠ this file; don't assume that bignums are always available. Fixes some of the build problems the buildbot is showing me at the moment. + (syms_of_fns): Remove a couple more duplicate symbol declarations. 2011-01-01 Aidan Kehoe <kehoea(a)parhasard.net> diff -r 7ea837399734 -r 1dbc93b7ba19 src/fns.c --- a/src/fns.c Sun Jan 02 17:37:17 2011 +0000 +++ b/src/fns.c Sun Jan 02 18:05:05 2011 +0000 ＠＠ -63,7 +63,7 ＠＠ Lisp_Object Q_test_not, Q_count, Qnsubstitute, Qdelete_duplicates, Qmismatch; Lisp_Object Qintersection, Qset_difference, Qnset_difference; -Lisp_Object Qnunion, Qnintersection, Qsubsetp, Qnset_difference; +Lisp_Object Qnunion, Qnintersection, Qsubsetp; Lisp_Object Qbase64_conversion_error; ＠＠ -11730,8 +11730,6 ＠＠ DEFSYMBOL (Qset_difference); DEFSYMBOL (Qnset_difference); DEFSYMBOL (Qnunion); - DEFSYMBOL (Qset_difference); - DEFSYMBOL (Qnset_difference); DEFKEYWORD (Q_from_end); DEFKEYWORD (Q_initial_value); _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

2 participants
2 comments

commit: Use defmacro* when defining dolist, dotimes, do-symbols, macrolet, cl-macs.el 13 years, 11 months

Aidan Kehoe

changeset: 5326:60ba780f9078 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net> date: Sun Jan 02 00:06:14 2011 +0000 files: lisp/ChangeLog lisp/cl-macs.el description: Use defmacro* when defining dolist, dotimes, do-symbols, macrolet, cl-macs.el 2011-01-01 Aidan Kehoe <kehoea(a)parhasard.net> * cl-macs.el (dolist, dotimes, do-symbols, macrolet) (symbol-macrolet): Define these macros with defmacro* instead of parsing the argument list by hand, for the sake of style and readability; use backquote where appropriate, instead of calling #'list and and friends, for the same reason. diff -r 47298dcf2e8f -r 60ba780f9078 lisp/ChangeLog --- a/lisp/ChangeLog Sat Jan 01 20:08:44 2011 +0000 +++ b/lisp/ChangeLog Sun Jan 02 00:06:14 2011 +0000 ＠＠ -1,3 +1,12 ＠＠ +2011-01-01 Aidan Kehoe <kehoea(a)parhasard.net> + + * cl-macs.el (dolist, dotimes, do-symbols, macrolet) + (symbol-macrolet): + Define these macros with defmacro* instead of parsing the argument + list by hand, for the sake of style and readability; use backquote + where appropriate, instead of calling #'list and and friends, for + the same reason. + 2010-12-30 Aidan Kehoe <kehoea(a)parhasard.net> * x-misc.el (device-x-display): diff -r 47298dcf2e8f -r 60ba780f9078 lisp/cl-macs.el --- a/lisp/cl-macs.el Sat Jan 01 20:08:44 2011 +0000 +++ b/lisp/cl-macs.el Sun Jan 02 00:06:14 2011 +0000 ＠＠ -1679,51 +1679,42 ＠＠ (or (cdr endtest) '(nil))))) ;;;###autoload -(defmacro dolist (spec &rest body) +(defmacro* dolist ((var list &optional result) &body body) "Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. -Then evaluate RESULT to get return value, default nil. - -arguments: ((VAR LIST &optional RESULT) &body BODY)" - (let ((temp (gensym "--dolist-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (car spec)) - (list* 'while temp (list 'setq (car spec) (list 'car temp)) - (append body (list (list 'setq temp - (list 'cdr temp))))) - (if (cdr (cdr spec)) - (cons (list 'setq (car spec) nil) (cdr (cdr spec))) - '(nil)))))) +Then evaluate RESULT to get return value, default nil." + (let ((gensym (gensym))) + `(block nil + (let ((,gensym ,list) ,var) + (while ,gensym + (setq ,var (car ,gensym)) + ,＠body + (setq ,gensym (cdr ,gensym))) + ,＠(if result `((setq ,var nil) ,result)))))) ;;;###autoload -(defmacro dotimes (spec &rest body) +(defmacro* dotimes ((var count &optional result) &body body) "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default -nil. - -arguments: ((VAR COUNT &optional RESULT) &body BODY)" - (let ((temp (gensym "--dotimes-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) - (list* 'while (list '< (car spec) temp) - (append body (list (list 'incf (car spec))))) - (or (cdr (cdr spec)) '(nil)))))) +nil." + (let* ((limit (if (cl-const-expr-p count) count (gensym))) + (bind (if (cl-const-expr-p count) nil `((,limit ,count))))) + `(block nil + (let ((,var 0) ,＠bind) + (while (< ,var ,limit) + ,＠body + (setq ,var (1+ ,var))) + ,＠(if result (list result)))))) ;;;###autoload -(defmacro do-symbols (spec &rest body) - "Loop over all symbols. +(defmacro* do-symbols ((var &optional obarray result) &rest body) + "Loop over all interned symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol -from OBARRAY. - -arguments: ((VAR &optional OBARRAY RESULT) &body BODY)" - ;; Apparently this doesn't have an implicit block. - (list 'block nil - (list 'let (list (car spec)) - (list* 'mapatoms - (list 'function (list* 'lambda (list (car spec)) body)) - (and (cadr spec) (list (cadr spec)))) - (caddr spec)))) +from OBARRAY." + `(block nil + (mapatoms #'(lambda (,var) ,＠body) ,＠(and obarray (list obarray))) + ,＠(if result `((let (,var) ,result))))) ;;;###autoload (defmacro do-all-symbols (spec &rest body) ＠＠ -1806,37 +1797,34 ＠＠ ;; The following ought to have a better definition for use with newer ;; byte compilers. ;;;###autoload -(defmacro macrolet (bindings &rest body) +(defmacro* macrolet (((name arglist &optional docstring &body body) + &rest macros) &body form) "Make temporary macro definitions. -This is like `flet', but for macros instead of functions. - -arguments: (((NAME ARGLIST &optional DOCSTRING &body body) &rest MACROS) &body FORM)" - (if (cdr bindings) - (list 'macrolet - (list (car bindings)) (list* 'macrolet (cdr bindings) body)) - (if (null bindings) (cons 'progn body) - (let* ((name (caar bindings)) - (res (cl-transform-lambda (cdar bindings) name))) - (eval (car res)) - (cl-macroexpand-all (cons 'progn body) - (cons (list* name 'lambda (cdr res)) - cl-macro-environment)))))) +This is like `flet', but for macros instead of functions." + (cl-macroexpand-all (cons 'progn form) + (nconc + (loop + for (name . details) + in (cons (list* name arglist docstring body) macros) + collect + (list* name 'lambda + (prog1 + (cdr (setq details (cl-transform-lambda + details name))) + (eval (car details))))) + cl-macro-environment))) ;;;###autoload -(defmacro symbol-macrolet (bindings &rest body) +(defmacro* symbol-macrolet (((name expansion) &rest symbol-macros) &body form) "Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced -by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). - -arguments: (((NAME EXPANSION) &rest SYMBOL-MACROS) &body FORM)" - (if (cdr bindings) - (list 'symbol-macrolet - (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) - (if (null bindings) (cons 'progn body) - (cl-macroexpand-all (cons 'progn body) - (cons (list (symbol-name (caar bindings)) - (cadar bindings)) - cl-macro-environment))))) +by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." + (cl-macroexpand-all (cons 'progn form) + (append (list (list (symbol-name name) expansion)) + (loop + for (name expansion) in symbol-macros + collect (list (symbol-name name) expansion)) + cl-macro-environment))) (defvar cl-closure-vars nil) ;;;###autoload _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches

2 participants
2 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches January 2011