fontwhich 0.2.1 → 0.3
raw patch · 4 files changed
+170/−86 lines, 4 files
Files
- ChangeLog.md +10/−1
- README.md +21/−17
- fontwhich.cabal +1/−1
- src/Main.hs +138/−67
ChangeLog.md view
@@ -1,8 +1,17 @@ # fontwhich releases +## 0.3 (2026-03-27)+- improve no coverage logic+- when no font output --unicode data+- for --language check that primary font has coverage+- check normalized lang is in fontconfig orth list+- new pango --sample-text option with --language+- add --list-langs option to list all fc orths+- add --all-langs which iterates over all orth langs+ ## 0.2.1 (2026-03-26) - check and warn about characters without font coverage-- output base font name when not text given+- output base font name when no text given ## 0.2 (2026-03-12) - add --unicode for unicode data output (uses `unicode-data`)
README.md view
@@ -11,7 +11,7 @@ `$ fontwhich --version` ```-0.2.1+0.3 ``` `$ fontwhich --help`@@ -19,18 +19,23 @@ ``` fontwhich -Usage: fontwhich [--version] [-f|--font FONT] [-l|--lang LANG] [-b|--utf8]- [-u|--unicode] [TEXT]+Usage: fontwhich [--version] [-f|--font FONT] [-b|--utf8] [-u|--unicode]+ [-s|--sample-text]+ (--list-langs | (-l|--lang LANG) | --all-langs | TEXT) Describes the fonts used to render text with pango+ https://github.com/juhp/fontwhich#readme Available options: -h,--help Show this help text --version Show version -f,--font FONT Base font [default: Sans]- -l,--lang LANG Language code -b,--utf8 Output UTF-8 hex codes -u,--unicode Output Unicode data+ -s,--sample-text Use Pango sample text for language+ --list-langs List language orthography+ -l,--lang LANG Language code+ --all-langs Output all orth languages ``` `$ fontwhich Hello 🌍 World 世界`@@ -42,19 +47,18 @@ '世界' : Noto Sans CJK JP ``` -`$ fontwhich -f Serif "こんにちは 😀 世界"`+`$ fontwhich -f Serif "世界こんにちは😀"` ```-'こんにちは ' : Noto Serif CJK JP-'😀' : Noto Color Emoji-' ' : Noto Serif CJK JP '世界' : Noto Serif CJK JP+'こんにちは' : Noto Serif CJK JP+'😀' : Noto Color Emoji ``` `$ fontwhich -l ja` ```-Primary Sans font for ja is: "Noto Sans CJK JP"+Primary Sans font for 'ja': "Noto Sans CJK JP" ``` `$ fontwhich --utf8 🌳`@@ -78,12 +82,12 @@ One can use both options together: -`$ fontwhich --utf8 🍊 --unicode`+`$ fontwhich --utf8 🌸 --unicode` ``` 4 bytes;-'🍊' [f0 9f 8d 8a] : Noto Color Emoji-🍊 <U+1F34A>: TANGERINE [Common]+'🌸' [f0 9f 8c b8] : Noto Color Emoji+🌸 <U+1F338>: CHERRY BLOSSOM [Common] ``` @@ -92,8 +96,8 @@ C library dependencies: -- Fedora: cairo-devel pango-devel gobject-introspection-devel-- Ubuntu: libcairo2-dev libpango1.0-dev libgirepository1.0-dev+- Fedora: cairo-gobject-devel gobject-introspection-devel pango-devel+- Ubuntu: libcairo2-dev libgirepository1.0-dev libpango1.0-dev Then: ```@@ -107,11 +111,11 @@ There is a copr repo: <https://copr.fedorainfracloud.org/coprs/petersen/fontwhich/> ## Misc-Code assisted with Gemini 3.1.+Initial code assisted with Gemini 3.1. -The tool is related conceptually to <https://github.com/sudipshil9862/whichfont> (C codebase).+The tool is related conceptually to the C project <https://github.com/sudipshil9862/whichfont>. -"fontwhich" as in "sandwhich" but with fonts.+"fontwhich" as in "sandwich" but with fonts. ## Collaborate
fontwhich.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: fontwhich-version: 0.2.1+version: 0.3 synopsis: Determine fonts used to render text description: Fontwhich is a commandline tool that used pango to determine which
src/Main.hs view
@@ -1,88 +1,124 @@--- SPDX-License-Identifier: BSD-3-Clause+-- SPDX-License-Identifier: GPL-3.0-or-later -import Control.Monad.Extra (filterM, forM_, when, whenJust)+import Control.Monad.Extra (filterM, forM_, unless, when, whenJust) import qualified Data.ByteString as B-import Data.Char (ord)-import Data.Maybe (fromMaybe)+import Data.Char (isAsciiLower, ord)+import Data.List (singleton)+import Data.Maybe (fromMaybe, isNothing) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified GI.Pango as Pango import qualified GI.PangoCairo.Interfaces.FontMap as PangoCairo import SimpleCmd (error', (+-+))-import SimpleCmdArgs hiding (str)-import System.Environment (getArgs, withArgs)+import SimpleCmdArgs (flagLongWith', optional, simpleCmdArgs, some, strArg,+ strOptionWith, switchWith, (<|>)) import Text.Printf (printf) import qualified Unicode.Char.General.Names as UN import qualified Unicode.Char.General.Scripts as US import Paths_fontwhich (version) -main :: IO ()-main = do- args <- getArgs- if null args- then withArgs ["--help"] main'- else main'+data Mode = ListLangs+ | Lang !String+ | AllLangs+ | InputText ![String] -main' :: IO ()-main' =+main :: IO ()+main = simpleCmdArgs (Just version) "fontwhich"- "Describes the fonts used to render text with pango" $- run+ ("Describes the fonts used to render text with pango" +-++ "https://github.com/juhp/fontwhich#readme") $+ runMain <$> optional (strOptionWith 'f' "font" "FONT" "Base font [default: Sans]")- <*> optional (strOptionWith 'l' "lang" "LANG" "Language code") <*> switchWith 'b' "utf8" "Output UTF-8 hex codes" <*> switchWith 'u' "unicode" "Output Unicode data"- <*> many (strArg "TEXT")+ <*> switchWith 's' "sample-text" "Use Pango sample text for language"+ <*> modeOpt+ where+ modeOpt =+ flagLongWith' ListLangs "list-langs" "List language orthography" <|>+ Lang <$> strOptionWith 'l' "lang" "LANG" "Language code" <|>+ flagLongWith' AllLangs "all-langs" "Output all orth languages" <|>+ InputText <$> some (strArg "TEXT") -run :: Maybe String -> Maybe String -> Bool -> Bool -> [String] -> IO ()-run mfont mlang hex unicode txt = do+runMain :: Maybe String -> Bool -> Bool -> Bool -> Mode -> IO ()+runMain mfont hex unicode sample mode = do -- Get a default Font Map and Context fontMap <- PangoCairo.fontMapGetDefault context <- Pango.fontMapCreateContext fontMap- attr <- Pango.attrListNew let baseName = fromMaybe "Sans" mfont baseFont <- Pango.fontDescriptionFromString $ T.pack baseName- mplang <- Pango.languageFromString $ T.pack <$> mlang+ runMode fontMap context baseName baseFont mode+ where+ runMode fontMap context baseName baseFont mode' =+ case mode' of+ ListLangs -> do+ putStrLn $ unwords orths+ InputText args -> run args Nothing+ Lang lang -> do+ (plang,code) <- determineLangCode lang+ t <-+ if sample+ -- for few langs we get itemization (eg ja)+ then words . T.unpack <$> Pango.languageGetSampleString (Just plang)+ else return []+ -- FIXME with iso-codes json + gettext perhaps+ -- Just LangName -> return ["To be implemented!"]+ run t $ Just (plang,code)+ AllLangs ->+ forM_ orths $ \orth -> do+ when sample $ putStr $ quoteStr orth ++ ": "+ runMode fontMap context baseName baseFont $ Lang orth+ where+ run txt mlangcode= do+ if null txt then do+ case mlangcode of+ Nothing -> error' "no language or text string specified"+ Just (plang,langcode) -> do+ mfontset <- Pango.fontMapLoadFontset fontMap context baseFont plang+ case mfontset of+ Nothing -> error' "no fontset found"+ Just fs -> do+ -- Get the first (primary) font in the fontset+ -- 'fontsetForeach' is the standard way to inspect them+ -- For a quick check, we can just look at the primary result+ -- In many cases, we want to see the first font that Pango resolves+ Pango.fontsetForeach fs $ \_ font -> do+ desc' <- Pango.fontDescribe font+ mfamily <- Pango.fontDescriptionGetFamily desc'+ whenJust mfamily $ \family -> do+ mlangs <- Pango.fontGetLanguages font+ let missing =+ case mlangs of+ Nothing -> ""+ Just langs ->+ if plang `elem` langs+ then ""+ else parenStr "missing coverage"+ putStrLn $ "Primary" +-+ baseName +-+ "font for" +-+ quoteStr langcode ++ ":" +-+ show family +-+ missing+ return True -- stop after first font+ else do+ let myText = T.pack $ unwords txt - if null txt then do- case mplang of- Nothing -> error' "no language determined"- Just plang -> do- maybeFontset <- Pango.fontMapLoadFontset fontMap context baseFont plang- case maybeFontset of- Nothing -> error' "no fontset found"- Just fs -> do- -- Get the first (primary) font in the fontset- -- 'fontsetForeach' is the standard way to inspect them- -- For a quick check, we can just look at the primary result- -- In many cases, we want to see the first font that Pango resolves- Pango.fontsetForeach fs $ \_ font -> do- desc' <- Pango.fontDescribe font- mfamily <- Pango.fontDescriptionGetFamily desc'- whenJust mfamily $ \family ->- putStrLn $ "Primary" +-+ baseName +-+ "font" +-+ maybe "" ("for" +-+) mlang +-+ "is:" +-+ show family- return True -- stop after first font- else do- let myText = T.pack $ unwords txt+ Pango.contextSetFontDescription context $ Just baseFont+ Pango.contextSetLanguage context (fst <$> mlangcode) - Pango.contextSetFontDescription context $ Just baseFont- Pango.contextSetLanguage context mplang+ let utf8Bytes = TE.encodeUtf8 myText+ when (hex || unicode) $+ putStr $ show (B.length utf8Bytes) +-+ "bytes;" - let utf8Bytes = TE.encodeUtf8 myText- when (hex || unicode) $- putStr $ show (B.length utf8Bytes) +-+ "bytes;"+ attr <- Pango.attrListNew+ -- start_index, length, cached_iter+ items <- Pango.itemize context myText 0 (fromIntegral $ B.length utf8Bytes) attr Nothing+ when (hex || unicode) $+ putStrLn $+ if length items > 1+ then ' ' : show (length items) +-+ "pango items"+ else ""+ mapM (itemString utf8Bytes) items >>=+ -- FIXME gather by font (eg for Japanese scripts)+ mapM_ (printItemInfo hex unicode) - -- start_index, length, cached_iter- items <- Pango.itemize context myText 0 (fromIntegral $ B.length utf8Bytes) attr Nothing- when (hex || unicode) $- putStrLn $- if length items > 1- then ' ' : show (length items) +-+ "pango items"- else ""- mapM (itemString utf8Bytes) items >>=- mapM_ (printItemInfo hex unicode)- where itemString :: B.ByteString -> Pango.Item -> IO (String, Pango.Item) itemString utf8Bytes item = do -- Offsets in Pango are bytes@@ -91,9 +127,16 @@ let itemBytes = B.take (fromIntegral len) $ B.drop (fromIntegral offset) utf8Bytes return (T.unpack $ TE.decodeUtf8 itemBytes, item) +surround :: Char -> Char -> String -> String+surround o c s =+ o : s ++ singleton c+ quoteStr :: String -> String-quoteStr str = '\'' : str ++ "'"+quoteStr = surround '\'' '\'' +parenStr :: String -> String+parenStr = surround '(' ')'+ printItemInfo :: Bool -> Bool -> (String, Pango.Item) -> IO () printItemInfo hex unicode (str,item) = do -- Get the Analysis struct from the Item@@ -105,31 +148,59 @@ mfamily <- case maybeFont of Nothing -> do- putStrLn "No font installed?"+ putStrLn "No fonts installed?" return Nothing Just font -> do notcovered <- filterM (fmap not . Pango.fontHasChar font) str- if null notcovered- then Pango.fontDescribe font >>= Pango.fontDescriptionGetFamily- else do+ unless (null notcovered) $ putStrLn $ "no font coverage for" +-+ quoteStr notcovered ++ "!"- return Nothing+ if notcovered == str+ then return Nothing+ else Pango.fontDescribe font >>= Pango.fontDescriptionGetFamily let hexStr = if hex then unwords $ map hexify str else ""- putStrLn $- quoteStr str +-+ hexStr +-+ ":" +-+ maybe "Unknown" T.unpack mfamily- when unicode $+ case mfamily of+ Just family ->+ putStrLn $ quoteStr str +-+ hexStr +-+ ":" +-+ T.unpack family+ Nothing ->+ unless (null hexStr) $+ putStrLn $ quoteStr str +-+ hexStr++ when (unicode || isNothing mfamily) $ forM_ str $ \char -> do putChar char let mname = UN.name char script = US.script char codepoint = printf "U+%04X" (ord char)- putStrLn $ " <" ++ codepoint ++ ">:" +-+ fromMaybe "unknown codepoint" mname +-+ '[' : show script ++ "]" -- +-+ '(' : US.scriptShortName script ++ ")"+ putStrLn $ " <" ++ codepoint ++ ">:" +-+ fromMaybe "unknown codepoint" mname +-+ '[' : show script ++ "]" -- +-+ parenStr (US.scriptShortName script) where hexify :: Char -> String hexify char = let bytes = TE.encodeUtf8 $ T.singleton char in '[' : unwords [printf "%02x" b | b <- B.unpack bytes] ++ "]"++-- generated by orth/orth.hs+orths :: [String]+orths =+ ["aa","ab","af","agr","ak","am","an","anp","ar","as","ast","av","ay","ayc","az-az","az-ir","ba","be","bem","ber-dz","ber-ma","bg","bh","bhb","bho","bi","bin","bm","bn","bo","br","brx","bs","bua","byn","ca","ce","ch","chm","chr","ckb","cmn","co","cop","crh","cs","csb","cu","cv","cy","da","de","doi","dsb","dv","dz","ee","el","en","eo","es","et","eu","fa","fat","ff","fi","fil","fj","fo","fr","fur","fy","ga","gd","gez","gl","gn","got","gu","gv","ha","hak","haw","he","hi","hif","hne","ho","hr","hsb","ht","hu","hy","hz","ia","id","ie","ig","ii","ik","io","is","it","iu","ja","jv","ka","kaa","kab","ki","kj","kk","kl","km","kn","ko","kok","kr","ks","ku-am","ku-iq","ku-ir","ku-tr","kum","kv","kw","kwm","ky","la","lah","lb","lez","lg","li","lij","ln","lo","lt","lv","lzh","mag","mai","mfe","mg","mh","mhr","mi","miq","mjw","mk","ml","mn-cn","mn-mn","mni","mnw","mo","mr","ms","mt","my","na","nan","nb","nds","ne","ng","nhn","niu","nl","nn","no","nqo","nr","nso","nv","ny","oc","om","or","os","ota","pa","pa-pk","pap-an","pap-aw","pes","pl","prs","ps-af","ps-pk","pt","qu","quz","raj","rif","rm","rn","ro","ru","rw","sa","sah","sat","sc","sco","sd","se","sel","sg","sgs","sh","shn","shs","si","sid","sk","sl","sm","sma","smj","smn","sms","sn","so","sq","sr","ss","st","su","sv","sw","syr","szl","ta","tcy","te","tg","th","the","ti-er","ti-et","tig","tk","tl","tn","to","tpi","tr","ts","tt","tw","ty","tyv","ug","uk","und-zmth","und-zsye","unm","ur","uz","ve","vi","vo","vot","wa","wae","wal","wen","wo","xh","yap","yi","yo","yue","yuw","za","zh-cn","zh-hk","zh-mo","zh-sg","zh-tw","zu"]++determineLangCode :: String -> IO (Pango.Language, String)+determineLangCode lang = do+ mplang <- Pango.languageFromString $ Just $ T.pack lang+ (plang,code) <-+ case mplang of+ Nothing -> error' "impossible happened: no Pango lang from string"+ Just l -> do+ lc <- T.unpack <$> Pango.languageToString l+ return (l,lc)+ if code `notElem` orths+ then+ if any (`elem` code) "-@"+ then determineLangCode $ takeWhile isAsciiLower code+ else do+ putStrLn $ "Unknown fontconfig langcode:" +-+ quoteStr code+ return (plang,code)+ else return (plang,code)