diff options
| -rwxr-xr-x | libtags.txr | 468 | ||||
| -rwxr-xr-x | tags.tl | 224 |
2 files changed, 610 insertions, 82 deletions
diff --git a/libtags.txr b/libtags.txr new file mode 100755 index 00000000..f41f5e4b --- /dev/null +++ b/libtags.txr @@ -0,0 +1,468 @@ +#!/usr/bin/env txr +@(do + ;; TODO + ;; #. etags support (update to new hash table format, etc.). + ;; #. Remove obsolete symbols (flip, etc.). + ;; #. Update to the new compat handling. There may be fewer if3s in the reg calls. + ;; #. merge into tags.tl the writing functions. + ;; #. handle reg_vars, etc. need to handle the reg_varl(sym,val) which is in the definition of reg_var. + ;; reg_var(sym, obj) too, with the -b option. + ;; (there are many cases where the reg_vars are used to initialize some variables. + ;; need special handling, probably.) + ;; #. others of my todos. + ;; + ;; #. *args-eff* not stored in var, so getting doubly stored. + ;; + ;; #. make sure some hard-to-determine things are printed to stderr, + ;; like the multiple occurrences of idents in the existing tags file. + ;; makes it easier to handle changes in the C source. + ;; + ;; #. Check if it still allows us to navigate to the right tags (e.g., acons-new vs acons_new). + + ;; FIXME Why is .l getting added. + ;; and .y too. + ;; with only *.c pattern. + ;; Should I add .shipped ones? + ;; probably better to assume maintainer, since libtags.txr is for + ;; developers of txr. + ;; so check the .l, .y, yy.tab.c, etc. + ;; not the .shipped ones. + + ;; libtags.txr can tag the source even without an existing tags file. + ;; It will just be less accurate. + ;; + ;; libtags.txr automatically ignores lines with any comments, so + ;; adding "/* OBS */" to for example num-chr does remove it. + ;; However, there may be no other comments, otherwise it will miss + ;; them. + ;; + ;; Even if some vars like path_sep_chars are declared and initialized + ;; at the same time, better to just tag the reg_var call directly. + ;; The user can navigate manually to the var in question; there would + ;; be too many useless false positives. + ;; also when they get assigned, like stderr_s, etc. + ;; *maybe* we can have a list of exceptions, of which path_sep_chars + ;; can be a part of. + ;; but even then, it's being assigned in a static_str, so that may + ;; be interesting to know. + ;; + ;; actually, completely unnecessary to specify that type is intrinsic, + ;; because they are in c files. + ;; any c files with such a tag is an intrinsic. + + ;; Note that libtags.txr should be run from the TXR source tree. + ;; Because it globs for *.c. + + (defvar *tags-lib*) + + (let ((*tags-lib* t)) + (load "tags")) + + (define-option-struct libtags-opts tags-opts + (v verbose :bool "Print diagnostic messages during processing.")) + + (defvarl output) + (defvarl emacs) + (defvarl verbose) + + (let ((o (new libtags-opts))) + o.(getopts *args*) + (set output (cond (o.output o.output) + (o.emacs "TAGS") + (t "tags"))) + (set emacs o.emacs) + (set verbose o.verbose)) + + (defvarl ix-tags (hash :equal-based)) + ;; FIXME Rename to sym-vars? + (defvarl var-syms (hash :equal-based)) + (defvarl fun-vars (hash :equal-based)) + + (defun update-ix-tags (tag newkey : oldkey) + ;; Remove the var_s tag because we need not tag it if we have the + ;; actual function. + (when oldkey + (del [ix-tags oldkey])) + (upd [ix-tags newkey] (append @1 (list tag)))) + + (defun qualify-sym (sym pkg) + (join (casequal pkg + ("user_package" "") + ("system_package" "sys:") + ("keyword_package" ":") + (t (when verbose + (put-line `@sym: in unknown package @pkg` *stderr*)) + pkg)) + sym)) + + (defun op-error-fun-p (fun) + (mequal fun + "op_error" "op_meta_error" + "op_qquote_error" "op_unquote_error"))) +@(bind var_s #/\w[\w\d]*_s/) +@(bind cident #/\w[\w\d]*/) +@(bind regfun #/reg_(op|mac|fun)/) +@(bind regvar #/reg_(varl?|symacro)|ffi_typedef/) +@(bind lpar "(") +@(bind rpar ")") +@;; +@(define get-interned-sym (sym))@\ +@ (local lit pkg)intern(lit("@lit"), @{pkg cident})@\ +@ (bind sym @(qualify-sym lit pkg))@\ +@(end) +@;; +@(define get-fun (fun))@\ +@ func_@/[\w\d]+/(@{fun cident}@(maybe), @/\d+/@(end))@\ +@(end) +@;; +@(define get-sym-fun (fun))@\ +@ (local fun-var)@\ +@ (cases)func_@/[\w\d]+/(if3(opt_compat && opt_compat <= @/\d+/, @\ +@ cident, @{fun cident})@(maybe), @/\d+/@(end))@\ +@ ;; TODO There may be missing cases here of func_ with compat opt handling. +@ (or)@(get-fun fun)@\ +@ (or)@{fun-var cident}@\ +@ (do (when verbose + (unless (or (starts-with "op_" fun-var) + [fun-vars fun-var]) + (put-line `@{fun-var}: undefined function variable` *stderr*))))@\ +@ (bind fun @(or [fun-vars fun-var] fun-var))@\ +@ (end)@\ +@(end) +@;; +@(define get-sym-fun (fun)) +@ (cases) +@ / +/@(get-sym-fun fun)@rpar; +@ (or) +@ / +/func_@/[\w\d]+/(if3(opt_compat && opt_compat <= @/\d+/, +@ (cases) +@ ;; For abs-path-p. +@ / +/@cident, @{fun cident})@(maybe), @/\d+/@(end))@rpar; +@ (or) +@ ;; For lexical-var-p. +@ / +/@cident, +@ / +/@{fun cident}@rpar@(maybe), @/\d+/@(end)@rpar@rpar; +@ (end) +@ (or) +@ ;; For match-regex, match-regex-right and match-regst-right. +@ / +/func_@/[\w\d]+/((opt_compat && opt_compat <= @/\d+/) ? +@ / +/@cident : @{fun cident}@(maybe), @/\d+/@(end))@rpar; +@ (end) +@(end) +@(define get-file-ix-tags (file)) +@ (next file) +@ (collect) +@ (local sym var fun pkg) +@ (all) +@ line +@ (and) +@ (cases) +@ / +/@(maybe)val @(end)@{var cident} = @(get-fun fun); +@ (do (set [fun-vars var] fun)) +@ (or) +@ / +/@(maybe)val @(end)@{var var_s} = @(get-interned-sym sym); +@ (do (if [var-syms var] + (when verbose + (put-line `@var: reassigned variable` *stderr*)) + (progn + (iflet ((tags [ix-tags var])) + ;; The variable is declared later in our search. + (progn + (each ((tag tags)) + (let ((old-ident tag.ident)) + (set tag.ident sym) + (typecase tag + (fun-tag (update-ix-tags tag old-ident)) + (var-tag (update-ix-tags tag sym)) + (t + ;; This would be a bug in libtags.txr, + ;; so print it regardless of --verbose. + (put-line `@(struct-type-name tag): unexpected struct type` + *stderr*))))) + (del [ix-tags var])) + ;; We may not find a corresponding C function or + ;; variable (either because of missing patterns in + ;; libtags.txr, or accidental omissions in the C + ;; source), in which case we will just tag the line of + ;; the var_s assignment. + (set [ix-tags var] (list (new tag + ident sym + path file + line line)))) + ;; Keep track of the symbols, because when we find a + ;; symbol corresponding to the above tag to insert into + ;; ix-tags, we remove the above tag, but some symbols + ;; are multiply bound, for example ‘and’ which is both + ;; an operator and a function. + (set [var-syms var] sym)))) +@ (or) +@ (cases) +@ / +/@regfun(@{var var_s}, @(get-sym-fun fun)); +@ (or) +@ / +/@regfun(@{var var_s}, +@ / +/@(get-sym-fun fun)); +@ (end) +@ (do + ;; op_error and company appear only in the var_s cases + ;; (because otherwise the interned symbol would be used + ;; only for throwing an error). + (unless (op-error-fun-p fun) + (iflet ((sym [var-syms var]) + ;; We store the path and line in case there is no such + ;; tagged function or variable in the tags file, so + ;; that we can still jump to the line where the symbol + ;; was interned. + (tag (new fun-tag + ident (or sym fun) + path file + line line)) + ((have sym))) + (update-ix-tags tag fun var) + (update-ix-tags tag var)))) +@ (or) +@ (cases) +@ / +/@regfun(@(get-interned-sym sym), @(get-sym-fun fun)); +@ (bind var nil) +@ (or) +@ / +/@regfun@lpar@(get-interned-sym sym), +@ (get-sym-fun fun) +@ (bind var nil) +@ (or) +@ ;; The assignment form always spans two or more lines. +@ / +/@regfun(@{var var_s} = @(get-interned-sym sym), +@ / +/@(get-sym-fun fun)); +@ (or) +@ / +/@regfun(@{var var_s} = intern(lit("@lit"), +@ / +/@{pkg cident}), @(get-sym-fun fun)); +@ (bind sym @(qualify-sym lit pkg)) +@ (end) +@ (do (when var + (if [var-syms var] + (when verbose + (put-line `@var: reassigned variable` *stderr*)) + (set [var-syms var] sym))) + (update-ix-tags (new fun-tag + ident sym + path file + line line) + fun var)) +@ (or) +@ (cases) +@ / +/@regvar(@{var var_s}, @(skip)); +@ (or) +@ ;; Cannot add a comma after the skip because the line +@ ;; contains many comma. +@ / +/ffi_typedef@lpar@{var var_s}, @(skip) +@ (end) +@ (do (iflet ((sym [var-syms var]) + (tag (new var-tag + ;; The var value is not used. + ;; (except in debugging, to print the undefined + ;; variables.) + ident (or sym var) + path file + line line)) + ((have sym))) + ;; FIXME Makes sense to have a list here? + ;; Or just following along with the style for funs? + (update-ix-tags tag + ;; Doesn't matter if we set the hash table + ;; key to sym, because in the output we + ;; separate the tags based on var-tag or + ;; tag/fun-tag. + ;; Only fun-tags need to have a key that + ;; corresponds to the existing tags. + sym var) + (update-ix-tags tag var))) +@ (or) +@ (cases) +@ / +/@regvar(@(get-interned-sym sym), @(skip)); +@ (bind var nil) +@ (or) +@ / +/@regvar@lpar@(get-interned-sym sym), +@ (bind var nil) +@ (or) +@ / +/@regvar(@{var var_s} = @(get-interned-sym sym), @(skip)); +@ (or) +@ / +/@regvar@lpar@{var var_s} = @(get-interned-sym sym), +@ (or) +@ / +/@regvar(@{var var_s} = intern(lit("@lit"), +@ / +/@{pkg cident}), @(skip)); +@ (bind sym @(qualify-sym lit pkg)) +@ (or) +@ / +/@regvar@lpar@{var var_s} = intern(lit("@lit"), +@ / +/@{pkg cident}), +@ (bind sym @(qualify-sym lit pkg)) +@ (end) +@ (do (when var + (if [var-syms var] + (when verbose + (put-line `@var: reassigned variable` *stderr*)) + (set [var-syms var] sym))) + (update-ix-tags (new var-tag + ident sym + path file + line line) + sym var)) +@ (end) +@ (end) +@ (end) +@(end) +@;; Move lib.c to the front, because many _f variables are +@;; defined there before being used elsewhere, for example in eval.c. +@;; (And with such an order, none are ever defined after being used.) +@;; However, if we ever need to do it, we could add the tags in question +@;; to another hash table and replace the _f variables in question as soon +@;; as we found suitable candidates. +@(next :list (cons "lib.c" (remqual "lib.c" (glob "*.c")))) +@(repeat) +@ file.c +@ (get-file-ix-tags `@file.c`) +@(end) +@(do + ;; Is nshuffle even getting detected as possible duplicate? + ;; FIXME The eval.c compat handling has changed. + ;; Need to update that. + + (when nil + (dohash (ident tag ix-tags) + (when (mequal tag.ident + ;; Obsolete symbols. + "flip" "slot-p") + (del [ix-tags ident])))) + + ;; TODO what if sym has _s? shouldn't happen, but could be more + ;; robust by using another kind of key. like (list ident "foo"). + + (when verbose + (let ((alist (keep-if (op ends-with "_s" (first @1)) + (hash-pairs ix-tags))) + (undefined nil) + (missing nil)) + (each ((pair alist)) + (tree-bind (key tags) pair + (each ((tag tags)) + (typecase tag + (fun-tag (push (list key (join "(" tag.ident ")")) undefined)) + (var-tag (push (list key) undefined)) + (tag (push (list key (join "(" tag.ident ")")) missing)) + (t (put-line `@(struct-type-name tag): unexpected struct type` + *stderr*)))))) + (upd undefined (nsort @1 : car)) + (upd missing (nsort @1 : car)) + (mapdo (op put-line `@(cat-str @1 " "): undefined variable` + *stderr*) + undefined) + (mapdo (op put-line `@(cat-str @1 " "): no corresponding function or value` + *stderr*) + missing) + (put-line `@(len undefined) undefined variables` *stderr*) + (put-line `@(len missing) missing corresponding functions` *stderr*) + (let ((vals (flow ix-tags hash-values flatten (nsort @1 : .ident)))) + (put-line `@(len vals) ix-tags` *stderr*)))) + + (defun merge-ix-tags (orig-tags) + (let ((tags orig-tags) + ;; Empty if no original tags file. + (orig-tags (group-by (op identity @1.ident) orig-tags)) + (ix-tags (hash-pairs ix-tags))) + (each ((pair ix-tags)) + ;; These idents are unique, because we store them into the hash + ;; table and have lists of ix-tags for each ident. + (tree-bind (ident ix-tags) pair + (condlet + ((((ends-with "_s" ident))) + ;; We don't want the tag to point to the declaration of the + ;; variable (which is what would happen if we duplicate the + ;; tag in the existing tags file), because that is of + ;; limited usefulness, so fall back to our info. + (upd tags (revappend ix-tags))) + (((orig-tags-orig orig-tags) + (orig-tags (keep-if (andf (op mequal + (short-suffix @1.path) + ;; We know that the identifiers are + ;; in C source (in particular, not + ;; in TXR Lisp source). + ".c" ".l" ".y") + ;; Assume that an open parenthesis means the tagged + ;; identifier is a function. + ;; This way we can skipped tagged struct members, which + ;; can share the same name as an existing function, but + ;; which we want to ignore (because we are tagging Lisp + ;; functions here). + (op find #\( @1.line)) + [orig-tags ident]))) + ;; We may tag Lisp identifiers several times (possibly with + ;; same-named static functions in different compilation + ;; units, but more likely from #ifdef blocks), but it's the + ;; best we can do without fully parsing the C. + (when (and verbose (> (len orig-tags) 1)) + (put-line `@ident: multiple occurrences in tags file` *stderr*)) + (tree-bind (: var-tags other-tags) (separate (op equal @1.type "v") + ix-tags) + (upd tags (revappend var-tags)) + (each-prod ((orig-tag orig-tags) + (ix-tag other-tags)) + (unless (equal orig-tag.ident ix-tag.ident) + (let ((tag (copy-struct orig-tag))) + (set tag.ident ix-tag.ident) + (push tag tags)))))) + (t + (when verbose + (whenlet ((orig-tags (keep-if (op mequal + (short-suffix @1.path) + ".c" ".l" ".y") + [orig-tags-orig ident]))) + (each-prod ((orig-tag orig-tags) + (ix-tag ix-tags)) + ;; FIXME args (for args_s) is duplicated four times. + (put-line `@ident | orig @{orig-tag.ident} @{orig-tag.path} | ix @{ix-tag.ident} @{ix-tag.path}`)))) + ;; The tags file doesn't contain a tag for our ident. + ;; Fall back to our info. + (upd tags (revappend ix-tags)))))) + ;; Not nsort so as not to modify orig-tags in caller. + (sort tags : .ident))) + + ;; We may as well merge the ctags file (i.e., sort the lines), since + ;; we have to read all the existing lines. + ;; + ;; Greatly adjusted from tags.tl. + ;; + ;; For some reason, acons-new is found only if it is placed before + ;; acons_new, and asin is found only if it is placed before asine. + ;; Is there some alphabetical ordering particularity? + ;; Will need to resort the ctags since me_op could be associated to op + ;; or do. + (defun write-tagfile (ix-tags) + (let* ((orig-tags (read-tagfile output)) + (ix-tags (merge-ix-tags orig-tags))) + (with-stream (stream (open-file output "w")) + (each ((tag ix-tags)) + (put-line tag.(text) stream))))) + + ;; Greatly adjusted from tags.tl. + ;; + ;; FIXME incomplete at the moment. + (defun write-etagfile (ix-tags) + (let ((orig-tags (read-etagfile output))) + (upd orig-tags (nsort @1 : car)) + (file-put "tags.out" orig-tags) + (with-stream (stream (open-file output "w")) + (each ((pair orig-tags)) + (tree-bind (path . etags) pair + (let ((str (with-out-string-stream (s) + (each ((etag etags)) + (unless (ends-with "_s" etag.ident) + (each ((ix-tag [keep-if (op find etag.ident @1 : .ident) + ix-tags .ctags])) + (put-line `duping @ix-tag`) + ;; (put-line `@{lisptag.ident}@[tag.(text) (len tag.ident)..:]` + ;; stream) + )) + (put-line etag.(etext) s))))) + (put-string `@{etag-sec-start}\n@{path},@(len str)\n@{str}` + stream))))))) + + (if emacs + (write-etagfile ix-tags) + (write-tagfile ix-tags))) @@ -1,5 +1,7 @@ #!/usr/bin/env txr +(defvar *tags-lib*) + ;; The etags format is described here: ;; https://git.savannah.gnu.org/cgit/emacs.git/tree/etc/ETAGS.EBNF. ;; @@ -8,6 +10,7 @@ (defparml etag-sec-start #\x0c) (defparml etag-pat-end #\x7f) (defparml etag-name-end #\x01) +(defparml etag-nonname-chars " \f\t\n\r()=,;'") (define-option-struct tags-opts nil (nil help :bool "List this help text and exit.") @@ -68,9 +71,7 @@ parent expattern (:method text (me) - `@{me.ident}\t@{me.path}\t/^@(escape me.line)$/ \ - @(if me.expattern `;/@(escape me.ident)/`);"\t \ - @{me.type}\tstruct:@{me.parent}`) + `@{me.ident}\t@{me.path}\t/^@(escape me.line)$/@(if me.expattern `\x3b/@(escape me.ident)/`)\x3b"\t@{me.type}\tstruct:@{me.parent}`) (:method make-qual-tag (me) (if me.parent (let ((qt (copy me))) @@ -78,8 +79,11 @@ qt)))) (defstruct orig-tag tag - orig-line - (:method text (me) me.orig-line)) + ;; We reuse the line slot as the already-escaped ctag pattern. + orig-fields + (:method text (me) + `@{me.ident}\t@{me.path}\t@{me.line} \ + @(if me.orig-fields `\t@(cat-str me.orig-fields #\tab)`)`)) (defvarl err-ret (gensym)) @@ -257,15 +261,70 @@ (put-line `@path: unable to determine file type` *stderr*) nil))))) + (defun parse-etag-path (stream) + (let ((line (get-line stream))) + (unless line + (throw 'syntax-error "trailing etag section starter")) + (match-case line + (`@{path #/[^,]+/},@{size #/\d+/}` path) + (@otherwise + (throwf 'syntax-error "bad etag path line: ~s" line))))) + + (defun get-etag-name (line) + (let ((etag-pat-end etag-pat-end) + (etag-name-end etag-name-end)) + (match-case line + (`@pat@{etag-pat-end}@ident@{etag-name-end}@rest` ident) + (`@pat@{etag-pat-end}@rest` + (labels ((nonname-char-p (ch) (in etag-nonname-chars ch))) + (when (nonname-char-p [pat -1]) + (set pat [pat 0..-1])) + (let ((pos [rpos-if nonname-char-p pat])) + (when pos (inc pos)) + [pat pos..:]))) + (@otherwise + (throwf 'syntax-error "bad etag line: ~s" line))))) + + ;; Does not support include sections. + ;; Does not support file properties. + (defun read-etagfile (path) + (with-stream (stream (open-file path)) + (let ((line (get-line stream))) + (unless line (return nil)) + (unless (equal line (tostringp etag-sec-start)) + (throwf 'syntax-error "bad etag section starter: ~s" line))) + (let ((all-tags ())) + (whilet ((path (parse-etag-path stream)) + (tags ()) + (t)) + (whilet ((line (get-line stream)) + (next (equal line (tostringp etag-sec-start))) + (t)) + (when (or (not line) next) + (push (cons path tags) all-tags) + (if next + (return) + (return-from read-etagfile all-tags))) + (push (new orig-tag + ident (get-etag-name line) + orig-line line) + tags)))))) + +(defun read-tagfile (path) + (catch (let ((lines (file-get-lines path))) + (collect-each ((line lines)) + (tree-bind (ident path pat . fields) (split-str line #\tab) + (new orig-tag + ident ident + path path + line pat + orig-fields fields)))) + (path-not-found (_)))) + (defun write-tagfile (tags o) (when o.merge - (catch - (let* ((lines (file-get-lines o.output)) - (orig-tags (collect-each ((line lines)) - (new orig-tag ident (m^ #/[^\t]*/ line) - orig-line line)))) - (set tags (merge tags orig-tags : .ident))) - (path-not-found (e)))) + (whenlet ((orig-tags (read-tagfile o.output))) + (set tags (merge tags orig-tags : .ident)))) (with-stream (stream (open-file o.output (if o.append "a" "w"))) (each ((tag tags)) (put-line tag.(text) stream)))) @@ -288,74 +347,75 @@ (when (eval expr) ^(progn ,*body))) (compile-only - (let ((o (new tags-opts))) - o.(getopts *args*) - (when o.help - (put-line "\nUsage:\n") - (put-line ` @{*load-path*} [options] {file|dir}*\n`) - (put-line "Directory arguments are recursively searched for .tl and .txr files.") - (put-line "If no arguments are given, the current directory is searched.") - o.(opthelp) - (exit t)) - - (unless o.out-args - (push "." o.out-args)) - - (unless (plusp (len o.output)) - (set o.output (if o.emacs "TAGS" "tags"))) - - (when (and o.merge (or o.append o.emacs)) - ;; The --merge option (without --emacs) currently results in - ;; duplicate tags if a file is retagged (e.g., "txr tags.tl foo.tl - ;; && txr tags.tl --merge foo.tl"). - ;; We could have --merge replace all existing tags of a retagged - ;; file with the latest ones, with and without --emacs, but for - ;; now don't bother (and therefore forbid combining --emacs with - ;; --merge). - (put-line `@{*load-path*}: @(if o.append `--append` `--emacs`)\ \ - and --merge are mutually exclusive`) - (exit nil)) - - (let* ((excf [apply orf (mapcar (do op fnmatch @@1) o.exclude)]) - (skips ()) - (*read-unknown-structs* t) - (tags (build - (ftw o.out-args - (lambda (path type stat . rest) - (caseql* type - (ftw-f (when (and (not [excf path]) - (not [excf (base-name path)]) - (not (some skips (op starts-with @1 path)))) + (unless *tags-lib* + (let ((o (new tags-opts))) + o.(getopts *args*) + (when o.help + (put-line "\nUsage:\n") + (put-line ` @{*load-path*} [options] {file|dir}*\n`) + (put-line "Directory arguments are recursively searched for .tl and .txr files.") + (put-line "If no arguments are given, the current directory is searched.") + o.(opthelp) + (exit t)) + + (unless o.out-args + (push "." o.out-args)) + + (unless (plusp (len o.output)) + (set o.output (if o.emacs "TAGS" "tags"))) + + (when (and o.merge (or o.append o.emacs)) + ;; The --merge option (without --emacs) currently results in + ;; duplicate tags if a file is retagged (e.g., "txr tags.tl foo.tl + ;; && txr tags.tl --merge foo.tl"). + ;; We could have --merge replace all existing tags of a retagged + ;; file with the latest ones, with and without --emacs, but for + ;; now don't bother (and therefore forbid combining --emacs with + ;; --merge). + (put-line `@{*load-path*}: @(if o.append `--append` `--emacs`)\ \ + and --merge are mutually exclusive`) + (exit nil)) + + (let* ((excf [apply orf (mapcar (do op fnmatch @@1) o.exclude)]) + (skips ()) + (*read-unknown-structs* t) + (tags (build + (ftw o.out-args + (lambda (path type stat . rest) + (caseql* type + (ftw-f (when (and (not [excf path]) + (not [excf (base-name path)]) + (not (some skips (op starts-with @1 path)))) + (cond + ((ends-with ".tl" path) + (pend (ignerr (collect-tags-tl path)))) + ((ends-with ".txr" path) + (pend (ignerr (collect-tags-txr path)))) + ((member path o.out-args) + (pend (ignerr (collect-tags-guess path)))) + (t ftw-continue)))) + (ftw-d (while (and skips (starts-with path (car skips))) + (pop skips)) (cond - ((ends-with ".tl" path) - (pend (ignerr (collect-tags-tl path)))) - ((ends-with ".txr" path) - (pend (ignerr (collect-tags-txr path)))) - ((member path o.out-args) - (pend (ignerr (collect-tags-guess path)))) - (t ftw-continue)))) - (ftw-d (while (and skips (starts-with path (car skips))) - (pop skips)) - (cond - ((or [excf path] [excf (base-name path)]) - (static-when (zerop ftw-actionretval) - (push `@path/` skips)) - ftw-skip-subtree))) - (t ftw-continue))) - (logior ftw-phys ftw-actionretval))))) - (if o.qual - (set tags (build - (pend tags) - (each ((tg tags)) - (if (typep tg 'slot-tag) - (iflet ((qt tg.(make-qual-tag))) - (add qt))))))) - (if o.emacs - (write-etagfile (flow tags - (remove-if (op equal @1.type "F")) - (nsort @1 : .linum) - (group-by .path) - (hash-alist) - (nsort @1 : car)) - o) - (write-tagfile (nsort tags : .ident) o))))) + ((or [excf path] [excf (base-name path)]) + (static-when (zerop ftw-actionretval) + (push `@path/` skips)) + ftw-skip-subtree))) + (t ftw-continue))) + (logior ftw-phys ftw-actionretval))))) + (if o.qual + (set tags (build + (pend tags) + (each ((tg tags)) + (if (typep tg 'slot-tag) + (iflet ((qt tg.(make-qual-tag))) + (add qt))))))) + (if o.emacs + (write-etagfile (flow tags + (remove-if (op equal @1.type "F")) + (nsort @1 : .linum) + (group-by .path) + (hash-alist) + (nsort @1 : car)) + o) + (write-tagfile (nsort tags : .ident) o)))))) |