Source

cljtags / src / main / clojure / cljtags / core.clj

Full commit
;-
; Copyright 2008 (c) Meikel Brandmeyer.
; All rights reserved.
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE.

(ns cljtags.core
  (:import
     (java.io File FileWriter)))

(defn- mangle-name
  "Replace - with _ in directories and filenames."
  [n]
  (.replace n \- \_))

(defn- namespace->directory
  "Translate a namespace to the corresponding directory."
  [n]
  (-> n mangle-name (.replace \. File/separatorChar)))

(defn- get-definition-position
  "Extract the namespace, file and line information from the passed
  Var. Return a triple of name, file and line number."
  [p m]
  (let [nspath (-> m :ns ns-name name namespace->directory)
        sl-pos (.lastIndexOf nspath (int File/separatorChar))
        nsbase (.substring nspath (inc sl-pos))
        file   (m :file)
        fbase  (.substring file 0 (.lastIndexOf file (int \.)))
        line   (m :line)]
    (list (name (m :name))
          ; XXX: Beh, ugly heuristic, but necessary...
          ; 1. Is the file basename equal to the last component of the
          ;    namespace (after mangling)? => Use it.
          ; 2. Does the file exists on the same level as the namespace's
          ;    master file? => Use it.
          ; Otherwise expect the file to be in the namespace directory.
          (let [c (apply str (interpose File/separator
                                        [p (.substring nspath 0 sl-pos) file]))]
            (cond
              (= fbase nsbase)      (str p File/separator nspath ".clj")
              (-> c File. .exists)  c
              :else                 (apply str (interpose File/separator
                                                          [p nspath file]))))
          line)))

(defn tags
  "Walk the given namespaces and generate a tags file containing
  all tags for the given namespaces."
  [options]
  (let [{:keys [prefix output namespaces]} options]
    (with-open [w (FileWriter. (File. output))]
      (binding [*out* w]
        (let [namespaces (map symbol namespaces)]
          (doseq [n namespaces] (require n))
          (let [vs (map (comp meta second)
                        (sort-by first (mapcat ns-interns namespaces)))
                vs (filter #(contains? % :file) vs)
                vs (map #(get-definition-position prefix %) vs)]
            (doseq [v vs]
              (println (apply str (interpose \tab v))))))))))